source: git/Singular/iparith.cc @ 4b7db8

spielwiese
Last change on this file since 4b7db8 was 4b7db8, checked in by Hans Schoenemann <hannes@…>, 11 years ago
fix: how to build ring from lists without order for components (rCompose)
  • Property mode set to 100644
File size: 216.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/*
6* ABSTRACT: table driven kernel interface, used by interpreter
7*/
8
9#include <stdlib.h>
10#include <string.h>
11#include <ctype.h>
12#include <stdio.h>
13#include <time.h>
14#include <unistd.h>
15
16#include "config.h"
17#include <coeffs/bigintmat.h>
18#include <kernel/mod2.h>
19#include <Singular/tok.h>
20#include <misc/options.h>
21#include <Singular/ipid.h>
22#include <misc/intvec.h>
23#include <omalloc/omalloc.h>
24#include <kernel/polys.h>
25#include <kernel/febase.h>
26#include <Singular/sdb.h>
27#include <kernel/ideals.h>
28#include <polys/prCopy.h>
29#include <polys/matpol.h>
30#include <kernel/kstd1.h>
31#include <kernel/timer.h>
32
33#include <kernel/preimage.h>
34
35#include <Singular/subexpr.h>
36#include <Singular/lists.h>
37#include <kernel/modulop.h>
38#ifdef HAVE_RINGS
39#include <coeffs/rmodulon.h>
40#include <coeffs/rmodulo2m.h>
41#include <coeffs/rintegers.h>
42#endif
43#include <coeffs/numbers.h>
44#include <kernel/stairc.h>
45#include <polys/monomials/maps.h>
46#include <Singular/maps_ip.h>
47#include <kernel/syz.h>
48#include <polys/weight.h>
49#include <Singular/ipconv.h>
50#include <Singular/ipprint.h>
51#include <Singular/attrib.h>
52#include <Singular/silink.h>
53#include <polys/sparsmat.h>
54#include <kernel/units.h>
55#include <Singular/janet.h>
56#include <kernel/GMPrat.h>
57#include <kernel/tgb.h>
58#include <kernel/walkProc.h>
59#include <polys/mod_raw.h>
60#include <Singular/MinorInterface.h>
61#include <kernel/linearAlgebra.h>
62#include <Singular/misc_ip.h>
63#include <Singular/linearAlgebra_ip.h>
64#ifdef HAVE_FACTORY
65#  include <polys/clapsing.h>
66#  include <kernel/kstdfac.h>
67#endif /* HAVE_FACTORY */
68#ifdef HAVE_FACTORY
69#  include <kernel/fglm.h>
70#  include <Singular/fglm.h>
71#endif /* HAVE_FACTORY */
72#include <Singular/interpolation.h>
73
74#include <Singular/blackbox.h>
75#include <Singular/newstruct.h>
76#include <Singular/ipshell.h>
77//#include <kernel/mpr_inout.h>
78
79#include <kernel/timer.h>
80
81#include <polys/coeffrings.h>
82
83lists rDecompose(const ring r);
84ring rCompose(const lists  L, const BOOLEAN check_comp=TRUE);
85
86
87// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
88
89#ifdef HAVE_PLURAL
90  #include <kernel/ratgring.h>
91  #include <kernel/nc.h>
92  #include <polys/nc/nc.h>
93  #include <polys/nc/sca.h>
94  #define ALLOW_PLURAL     1
95  #define NO_PLURAL        0
96  #define COMM_PLURAL      2
97  #define  PLURAL_MASK 3
98#else /* HAVE_PLURAL */
99  #define ALLOW_PLURAL     0
100  #define NO_PLURAL        0
101  #define COMM_PLURAL      0
102  #define  PLURAL_MASK     0
103#endif /* HAVE_PLURAL */
104
105#ifdef HAVE_RINGS
106  #define RING_MASK        4
107  #define ZERODIVISOR_MASK 8
108#else
109  #define RING_MASK        0
110  #define ZERODIVISOR_MASK 0
111#endif
112#define ALLOW_RING       4
113#define NO_RING          0
114#define NO_ZERODIVISOR   8
115#define ALLOW_ZERODIVISOR  0
116
117static BOOLEAN check_valid(const int p, const int op);
118
119/*=============== types =====================*/
120struct sValCmdTab
121{
122  short cmd;
123  short start;
124};
125
126typedef sValCmdTab jjValCmdTab[];
127
128struct _scmdnames
129{
130  char *name;
131  short alias;
132  short tokval;
133  short toktype;
134};
135typedef struct _scmdnames cmdnames;
136
137
138typedef char * (*Proc1)(char *);
139struct sValCmd1
140{
141  proc1 p;
142  short cmd;
143  short res;
144  short arg;
145  short valid_for;
146};
147
148typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
149struct sValCmd2
150{
151  proc2 p;
152  short cmd;
153  short res;
154  short arg1;
155  short arg2;
156  short valid_for;
157};
158
159typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
160struct sValCmd3
161{
162  proc3 p;
163  short cmd;
164  short res;
165  short arg1;
166  short arg2;
167  short arg3;
168  short valid_for;
169};
170struct sValCmdM
171{
172  proc1 p;
173  short cmd;
174  short res;
175  short number_of_args; /* -1: any, -2: any >0, .. */
176  short valid_for;
177};
178
179typedef struct
180{
181  cmdnames *sCmds;             /**< array of existing commands */
182  struct sValCmd1 *psValCmd1;
183  struct sValCmd2 *psValCmd2;
184  struct sValCmd3 *psValCmd3;
185  struct sValCmdM *psValCmdM;
186  int nCmdUsed;      /**< number of commands used */
187  int nCmdAllocated; /**< number of commands-slots allocated */
188  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
189} SArithBase;
190
191/*---------------------------------------------------------------------*
192 * File scope Variables (Variables share by several functions in
193 *                       the same file )
194 *
195 *---------------------------------------------------------------------*/
196static SArithBase sArithBase;  /**< Base entry for arithmetic */
197
198/*---------------------------------------------------------------------*
199 * Extern Functions declarations
200 *
201 *---------------------------------------------------------------------*/
202static int _gentable_sort_cmds(const void *a, const void *b);
203extern int iiArithRemoveCmd(char *szName);
204extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
205                         short nToktype, short nPos=-1);
206
207/*============= proc =======================*/
208static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport = FALSE);
209static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
210static Subexpr jjMakeSub(leftv e);
211
212/*============= vars ======================*/
213extern int cmdtok;
214extern BOOLEAN expected_parms;
215
216#define ii_div_by_0 "div. by 0"
217
218int iiOp; /* the current operation*/
219
220/*=================== simple helpers =================*/
221poly pHeadProc(poly p)
222{
223  return pHead(p);
224}
225
226int iiTokType(int op)
227{
228  for (int i=0;i<sArithBase.nCmdUsed;i++)
229  {
230    if (sArithBase.sCmds[i].tokval==op)
231      return sArithBase.sCmds[i].toktype;
232  }
233  return 0;
234}
235
236/*=================== operations with 2 args.: static proc =================*/
237/* must be ordered: first operations for chars (infix ops),
238 * then alphabetically */
239
240static BOOLEAN jjOP_BIM_I(leftv res, leftv u, leftv v)
241{
242  bigintmat* aa= (bigintmat *)u->Data();
243  int bb = (int)(long)(v->Data());
244  if (errorreported) return TRUE;
245  bigintmat *cc=NULL;
246  switch (iiOp)
247  {
248    case '+': cc=bimAdd(aa,bb); break;
249    case '-': cc=bimSub(aa,bb); break;
250    case '*': cc=bimMult(aa,bb); break;
251  }
252  res->data=(char *)cc;
253  return cc==NULL;
254}
255static BOOLEAN jjOP_I_BIM(leftv res, leftv u, leftv v)
256{
257  return jjOP_BIM_I(res, v, u);
258}
259static BOOLEAN jjOP_BIM_BI(leftv res, leftv u, leftv v)
260{
261  bigintmat* aa= (bigintmat *)u->Data();
262  number bb = (number)(v->Data());
263  if (errorreported) return TRUE;
264  bigintmat *cc=NULL;
265  switch (iiOp)
266  {
267    case '*': cc=bimMult(aa,bb,coeffs_BIGINT); break;
268  }
269  res->data=(char *)cc;
270  return cc==NULL;
271}
272static BOOLEAN jjOP_BI_BIM(leftv res, leftv u, leftv v)
273{
274  return jjOP_BIM_BI(res, v, u);
275}
276static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
277{
278  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
279  int bb = (int)(long)(v->Data());
280  if (errorreported) return TRUE;
281  switch (iiOp)
282  {
283    case '+': (*aa) += bb; break;
284    case '-': (*aa) -= bb; break;
285    case '*': (*aa) *= bb; break;
286    case '/':
287    case INTDIV_CMD: (*aa) /= bb; break;
288    case '%': (*aa) %= bb; break;
289  }
290  res->data=(char *)aa;
291  return FALSE;
292}
293static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
294{
295  return jjOP_IV_I(res,v,u);
296}
297static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
298{
299  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
300  int bb = (int)(long)(v->Data());
301  int i=si_min(aa->rows(),aa->cols());
302  switch (iiOp)
303  {
304    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
305              break;
306    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
307              break;
308  }
309  res->data=(char *)aa;
310  return FALSE;
311}
312static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
313{
314  return jjOP_IM_I(res,v,u);
315}
316static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
317{
318  int l=(int)(long)v->Data();
319  if (l>0)
320  {
321    int d=(int)(long)u->Data();
322    intvec *vv=new intvec(l);
323    int i;
324    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
325    res->data=(char *)vv;
326  }
327  return (l<=0);
328}
329static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
330{
331  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
332  return FALSE;
333}
334static void jjEQUAL_REST(leftv res,leftv u,leftv v);
335static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
336{
337  intvec*    a = (intvec * )(u->Data());
338  intvec*    b = (intvec * )(v->Data());
339  int r=a->compare(b);
340  switch  (iiOp)
341  {
342    case '<':
343      res->data  = (char *) (r<0);
344      break;
345    case '>':
346      res->data  = (char *) (r>0);
347      break;
348    case LE:
349      res->data  = (char *) (r<=0);
350      break;
351    case GE:
352      res->data  = (char *) (r>=0);
353      break;
354    case EQUAL_EQUAL:
355    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
356      res->data  = (char *) (r==0);
357      break;
358  }
359  jjEQUAL_REST(res,u,v);
360  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
361  return FALSE;
362}
363static BOOLEAN jjCOMPARE_BIM(leftv res, leftv u, leftv v)
364{
365  bigintmat*    a = (bigintmat * )(u->Data());
366  bigintmat*    b = (bigintmat * )(v->Data());
367  int r=a->compare(b);
368  switch  (iiOp)
369  {
370    case '<':
371      res->data  = (char *) (r<0);
372      break;
373    case '>':
374      res->data  = (char *) (r>0);
375      break;
376    case LE:
377      res->data  = (char *) (r<=0);
378      break;
379    case GE:
380      res->data  = (char *) (r>=0);
381      break;
382    case EQUAL_EQUAL:
383    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
384      res->data  = (char *) (r==0);
385      break;
386  }
387  jjEQUAL_REST(res,u,v);
388  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
389  return FALSE;
390}
391static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
392{
393  intvec* a = (intvec * )(u->Data());
394  int     b = (int)(long)(v->Data());
395  int r=a->compare(b);
396  switch  (iiOp)
397  {
398    case '<':
399      res->data  = (char *) (r<0);
400      break;
401    case '>':
402      res->data  = (char *) (r>0);
403      break;
404    case LE:
405      res->data  = (char *) (r<=0);
406      break;
407    case GE:
408      res->data  = (char *) (r>=0);
409      break;
410    case EQUAL_EQUAL:
411    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
412      res->data  = (char *) (r==0);
413      break;
414  }
415  jjEQUAL_REST(res,u,v);
416  return FALSE;
417}
418static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
419{
420  poly p=(poly)u->Data();
421  poly q=(poly)v->Data();
422  int r=pCmp(p,q);
423  if (r==0)
424  {
425    number h=nSub(pGetCoeff(p),pGetCoeff(q));
426    /* compare lead coeffs */
427    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
428    nDelete(&h);
429  }
430  else if (p==NULL)
431  {
432    if (q==NULL)
433    {
434      /* compare 0, 0 */
435      r=0;
436    }
437    else if(pIsConstant(q))
438    {
439      /* compare 0, const */
440      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
441    }
442  }
443  else if (q==NULL)
444  {
445    if (pIsConstant(p))
446    {
447      /* compare const, 0 */
448      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
449    }
450  }
451  switch  (iiOp)
452  {
453    case '<':
454      res->data  = (char *) (r < 0);
455      break;
456    case '>':
457      res->data  = (char *) (r > 0);
458      break;
459    case LE:
460      res->data  = (char *) (r <= 0);
461      break;
462    case GE:
463      res->data  = (char *) (r >= 0);
464      break;
465    //case EQUAL_EQUAL:
466    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
467    //  res->data  = (char *) (r == 0);
468    //  break;
469  }
470  jjEQUAL_REST(res,u,v);
471  return FALSE;
472}
473static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
474{
475  char*    a = (char * )(u->Data());
476  char*    b = (char * )(v->Data());
477  int result = strcmp(a,b);
478  switch  (iiOp)
479  {
480    case '<':
481      res->data  = (char *) (result  < 0);
482      break;
483    case '>':
484      res->data  = (char *) (result  > 0);
485      break;
486    case LE:
487      res->data  = (char *) (result  <= 0);
488      break;
489    case GE:
490      res->data  = (char *) (result  >= 0);
491      break;
492    case EQUAL_EQUAL:
493    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
494      res->data  = (char *) (result  == 0);
495      break;
496  }
497  jjEQUAL_REST(res,u,v);
498  return FALSE;
499}
500static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
501{
502  if (u->Next()!=NULL)
503  {
504    u=u->next;
505    res->next = (leftv)omAllocBin(sleftv_bin);
506    return iiExprArith2(res->next,u,iiOp,v);
507  }
508  else if (v->Next()!=NULL)
509  {
510    v=v->next;
511    res->next = (leftv)omAllocBin(sleftv_bin);
512    return iiExprArith2(res->next,u,iiOp,v);
513  }
514  return FALSE;
515}
516static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
517{
518  int b=(int)(long)u->Data();
519  int e=(int)(long)v->Data();
520  int rc = 1;
521  BOOLEAN overflow=FALSE;
522  if (e >= 0)
523  {
524    if (b==0)
525    {
526      rc=(e==0);
527    }
528    else
529    {
530      int oldrc;
531      while ((e--)!=0)
532      {
533        oldrc=rc;
534        rc *= b;
535        if (!overflow)
536        {
537          if(rc/b!=oldrc) overflow=TRUE;
538        }
539      }
540      if (overflow)
541        WarnS("int overflow(^), result may be wrong");
542    }
543    res->data = (char *)((long)rc);
544    if (u!=NULL) return jjOP_REST(res,u,v);
545    return FALSE;
546  }
547  else
548  {
549    WerrorS("exponent must be non-negative");
550    return TRUE;
551  }
552}
553static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
554{
555  int e=(int)(long)v->Data();
556  number n=(number)u->Data();
557  if (e>=0)
558  {
559    n_Power(n,e,(number*)&res->data,coeffs_BIGINT);
560  }
561  else
562  {
563    WerrorS("exponent must be non-negative");
564    return TRUE;
565  }
566  if (u!=NULL) return jjOP_REST(res,u,v);
567  return FALSE;
568}
569static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
570{
571  int e=(int)(long)v->Data();
572  number n=(number)u->Data();
573  int d=0;
574  if (e<0)
575  {
576    n=nInvers(n);
577    e=-e;
578    d=1;
579  }
580  nPower(n,e,(number*)&res->data);
581  if (d) nDelete(&n);
582  if (u!=NULL) return jjOP_REST(res,u,v);
583  return FALSE;
584}
585static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
586{
587  int v_i=(int)(long)v->Data();
588  if (v_i<0)
589  {
590    WerrorS("exponent must be non-negative");
591    return TRUE;
592  }
593  poly u_p=(poly)u->CopyD(POLY_CMD);
594  if ((u_p!=NULL)
595  && ((v_i!=0) &&
596      ((long)pTotaldegree(u_p) > (signed long)currRing->bitmask / (signed long)v_i)))
597  {
598    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
599                                    pTotaldegree(u_p),v_i,currRing->bitmask);
600    pDelete(&u_p);
601    return TRUE;
602  }
603  res->data = (char *)pPower(u_p,v_i);
604  if (u!=NULL) return jjOP_REST(res,u,v);
605  return errorreported; /* pPower may set errorreported via Werror */
606}
607static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
608{
609  res->data = (char *)id_Power((ideal)(u->Data()),(int)(long)(v->Data()), currRing);
610  if (u!=NULL) return jjOP_REST(res,u,v);
611  return FALSE;
612}
613static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
614{
615  u=u->next;
616  v=v->next;
617  if (u==NULL)
618  {
619    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
620    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
621    {
622      do
623      {
624        if (res->next==NULL)
625          res->next = (leftv)omAlloc0Bin(sleftv_bin);
626        leftv tmp_v=v->next;
627        v->next=NULL;
628        BOOLEAN b=iiExprArith1(res->next,v,'-');
629        v->next=tmp_v;
630        if (b)
631          return TRUE;
632        v=tmp_v;
633        res=res->next;
634      } while (v!=NULL);
635      return FALSE;
636    }
637    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
638    {
639      res->next = (leftv)omAlloc0Bin(sleftv_bin);
640      res=res->next;
641      res->data = v->CopyD();
642      res->rtyp = v->Typ();
643      v=v->next;
644      if (v==NULL) return FALSE;
645    }
646  }
647  if (v!=NULL)                     /* u<>NULL, v<>NULL */
648  {
649    do
650    {
651      res->next = (leftv)omAlloc0Bin(sleftv_bin);
652      leftv tmp_u=u->next; u->next=NULL;
653      leftv tmp_v=v->next; v->next=NULL;
654      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
655      u->next=tmp_u;
656      v->next=tmp_v;
657      if (b)
658        return TRUE;
659      u=tmp_u;
660      v=tmp_v;
661      res=res->next;
662    } while ((u!=NULL) && (v!=NULL));
663    return FALSE;
664  }
665  loop                             /* u<>NULL, v==NULL */
666  {
667    res->next = (leftv)omAlloc0Bin(sleftv_bin);
668    res=res->next;
669    res->data = u->CopyD();
670    res->rtyp = u->Typ();
671    u=u->next;
672    if (u==NULL) return FALSE;
673  }
674}
675static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
676{
677  idhdl packhdl;
678  switch(u->Typ())
679  {
680      case 0:
681        Print("%s of type 'ANY'. Trying load.\n", v->name);
682        if(iiTryLoadLib(u, u->name))
683        {
684          Werror("'%s' no such package", u->name);
685          return TRUE;
686        }
687        syMake(u,u->name,NULL);
688        // else: use next case !!! no break !!!
689      case PACKAGE_CMD:
690        packhdl = (idhdl)u->data;
691        if((!IDPACKAGE(packhdl)->loaded)
692        && (IDPACKAGE(packhdl)->language > LANG_TOP))
693        {
694          Werror("'%s' not loaded", u->name);
695          return TRUE;
696        }
697        if(v->rtyp == IDHDL)
698        {
699          v->name = omStrDup(v->name);
700        }
701        v->req_packhdl=IDPACKAGE(packhdl);
702        syMake(v, v->name, packhdl);
703        memcpy(res, v, sizeof(sleftv));
704        memset(v, 0, sizeof(sleftv));
705        break;
706      case DEF_CMD:
707        break;
708      default:
709        WerrorS("<package>::<id> expected");
710        return TRUE;
711  }
712  return FALSE;
713}
714static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
715{
716  unsigned int a=(unsigned int)(unsigned long)u->Data();
717  unsigned int b=(unsigned int)(unsigned long)v->Data();
718  unsigned int c=a+b;
719  res->data = (char *)((long)c);
720  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
721  {
722    WarnS("int overflow(+), result may be wrong");
723  }
724  return jjPLUSMINUS_Gen(res,u,v);
725}
726static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
727{
728  res->data = (char *)(n_Add((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
729  return jjPLUSMINUS_Gen(res,u,v);
730}
731static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
732{
733  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
734  return jjPLUSMINUS_Gen(res,u,v);
735}
736static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
737{
738  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
739  return jjPLUSMINUS_Gen(res,u,v);
740}
741static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
742{
743  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
744  if (res->data==NULL)
745  {
746     WerrorS("intmat size not compatible");
747     return TRUE;
748  }
749  return jjPLUSMINUS_Gen(res,u,v);
750}
751static BOOLEAN jjPLUS_BIM(leftv res, leftv u, leftv v)
752{
753  res->data = (char *)bimAdd((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
754  if (res->data==NULL)
755  {
756    WerrorS("bigintmat size not compatible");
757    return TRUE;
758  }
759  return jjPLUSMINUS_Gen(res,u,v);
760}
761static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
762{
763  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
764  res->data = (char *)(mp_Add(A , B, currRing));
765  if (res->data==NULL)
766  {
767     Werror("matrix size not compatible(%dx%d, %dx%d)",
768             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
769     return TRUE;
770  }
771  return jjPLUSMINUS_Gen(res,u,v);
772}
773static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
774{
775  matrix m=(matrix)u->Data();
776  matrix p= mp_InitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)),currRing);
777  if (iiOp=='+')
778    res->data = (char *)mp_Add(m , p,currRing);
779  else
780    res->data = (char *)mp_Sub(m , p,currRing);
781  idDelete((ideal *)&p);
782  return jjPLUSMINUS_Gen(res,u,v);
783}
784static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
785{
786  return jjPLUS_MA_P(res,v,u);
787}
788static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
789{
790  char*    a = (char * )(u->Data());
791  char*    b = (char * )(v->Data());
792  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
793  strcpy(r,a);
794  strcat(r,b);
795  res->data=r;
796  return jjPLUSMINUS_Gen(res,u,v);
797}
798static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
799{
800  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
801  return jjPLUSMINUS_Gen(res,u,v);
802}
803static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
804{
805  void *ap=u->Data(); void *bp=v->Data();
806  int aa=(int)(long)ap;
807  int bb=(int)(long)bp;
808  int cc=aa-bb;
809  unsigned int a=(unsigned int)(unsigned long)ap;
810  unsigned int b=(unsigned int)(unsigned long)bp;
811  unsigned int c=a-b;
812  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
813  {
814    WarnS("int overflow(-), result may be wrong");
815  }
816  res->data = (char *)((long)cc);
817  return jjPLUSMINUS_Gen(res,u,v);
818}
819static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
820{
821  res->data = (char *)(n_Sub((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
822  return jjPLUSMINUS_Gen(res,u,v);
823}
824static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
825{
826  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
827  return jjPLUSMINUS_Gen(res,u,v);
828}
829static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
830{
831  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
832  return jjPLUSMINUS_Gen(res,u,v);
833}
834static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
835{
836  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
837  if (res->data==NULL)
838  {
839     WerrorS("intmat size not compatible");
840     return TRUE;
841  }
842  return jjPLUSMINUS_Gen(res,u,v);
843}
844static BOOLEAN jjMINUS_BIM(leftv res, leftv u, leftv v)
845{
846  res->data = (char *)bimSub((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
847  if (res->data==NULL)
848  {
849    WerrorS("bigintmat size not compatible");
850    return TRUE;
851  }
852  return jjPLUSMINUS_Gen(res,u,v);
853}
854static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
855{
856  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
857  res->data = (char *)(mp_Sub(A , B, currRing));
858  if (res->data==NULL)
859  {
860     Werror("matrix size not compatible(%dx%d, %dx%d)",
861             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
862     return TRUE;
863  }
864  return jjPLUSMINUS_Gen(res,u,v);
865  return FALSE;
866}
867static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
868{
869  int a=(int)(long)u->Data();
870  int b=(int)(long)v->Data();
871  int c=a * b;
872  if ((b!=0) && (c/b !=a))
873    WarnS("int overflow(*), result may be wrong");
874  res->data = (char *)((long)c);
875  if ((u->Next()!=NULL) || (v->Next()!=NULL))
876    return jjOP_REST(res,u,v);
877  return FALSE;
878}
879static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
880{
881  res->data = (char *)(n_Mult( (number)u->Data(), (number)v->Data(),coeffs_BIGINT));
882  if ((v->next!=NULL) || (u->next!=NULL))
883    return jjOP_REST(res,u,v);
884  return FALSE;
885}
886static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
887{
888  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
889  number n=(number)res->data;
890  nNormalize(n);
891  res->data=(char *)n;
892  if ((v->next!=NULL) || (u->next!=NULL))
893    return jjOP_REST(res,u,v);
894  return FALSE;
895}
896static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
897{
898  poly a;
899  poly b;
900  if (v->next==NULL)
901  {
902    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
903    if (u->next==NULL)
904    {
905      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
906      if ((a!=NULL) && (b!=NULL)
907      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask)-(long)pTotaldegree(b)))
908      {
909        Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
910          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
911        pDelete(&a);
912        pDelete(&b);
913        return TRUE;
914      }
915      res->data = (char *)(pMult( a, b));
916      pNormalize((poly)res->data);
917      return FALSE;
918    }
919    // u->next exists: copy v
920    b=pCopy((poly)v->Data());
921    if ((a!=NULL) && (b!=NULL)
922    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
923    {
924      Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
925          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
926      pDelete(&a);
927      pDelete(&b);
928      return TRUE;
929    }
930    res->data = (char *)(pMult( a, b));
931    pNormalize((poly)res->data);
932    return jjOP_REST(res,u,v);
933  }
934  // v->next exists: copy u
935  a=pCopy((poly)u->Data());
936  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
937  if ((a!=NULL) && (b!=NULL)
938  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
939  {
940    pDelete(&a);
941    pDelete(&b);
942    WerrorS("OVERFLOW");
943    return TRUE;
944  }
945  res->data = (char *)(pMult( a, b));
946  pNormalize((poly)res->data);
947  return jjOP_REST(res,u,v);
948}
949static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
950{
951  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
952  id_Normalize((ideal)res->data,currRing);
953  if ((v->next!=NULL) || (u->next!=NULL))
954    return jjOP_REST(res,u,v);
955  return FALSE;
956}
957static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
958{
959  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
960  if (res->data==NULL)
961  {
962     WerrorS("intmat size not compatible");
963     return TRUE;
964  }
965  if ((v->next!=NULL) || (u->next!=NULL))
966    return jjOP_REST(res,u,v);
967  return FALSE;
968}
969static BOOLEAN jjTIMES_BIM(leftv res, leftv u, leftv v)
970{
971  res->data = (char *)bimMult((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
972  if (res->data==NULL)
973  {
974    WerrorS("bigintmat size not compatible");
975    return TRUE;
976  }
977  if ((v->next!=NULL) || (u->next!=NULL))
978    return jjOP_REST(res,u,v);
979  return FALSE;
980}
981static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
982{
983  number n=n_Init_bigint((number)v->Data(),coeffs_BIGINT,currRing->cf);
984  poly p=pNSet(n);
985  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
986  res->data = (char *)I;
987  return FALSE;
988}
989static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
990{
991  return jjTIMES_MA_BI1(res,v,u);
992}
993static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
994{
995  poly p=(poly)v->CopyD(POLY_CMD);
996  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
997  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
998  if (r>0) I->rank=r;
999  id_Normalize(I,currRing);
1000  res->data = (char *)I;
1001  return FALSE;
1002}
1003static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
1004{
1005  poly p=(poly)u->CopyD(POLY_CMD);
1006  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1007  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD),currRing);
1008  if (r>0) I->rank=r;
1009  id_Normalize(I,currRing);
1010  res->data = (char *)I;
1011  return FALSE;
1012}
1013static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
1014{
1015  number n=(number)v->CopyD(NUMBER_CMD);
1016  poly p=pNSet(n);
1017  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1018  id_Normalize((ideal)res->data,currRing);
1019  return FALSE;
1020}
1021static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
1022{
1023  return jjTIMES_MA_N1(res,v,u);
1024}
1025static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
1026{
1027  res->data = (char *)mp_MultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data(),currRing);
1028  id_Normalize((ideal)res->data,currRing);
1029  return FALSE;
1030}
1031static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
1032{
1033  return jjTIMES_MA_I1(res,v,u);
1034}
1035static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
1036{
1037  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
1038  res->data = (char *)mp_Mult(A,B,currRing);
1039  if (res->data==NULL)
1040  {
1041     Werror("matrix size not compatible(%dx%d, %dx%d)",
1042             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
1043     return TRUE;
1044  }
1045  id_Normalize((ideal)res->data,currRing);
1046  if ((v->next!=NULL) || (u->next!=NULL))
1047    return jjOP_REST(res,u,v);
1048  return FALSE;
1049}
1050static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
1051{
1052  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1053  res->data = (char *) (n_GreaterZero(h,coeffs_BIGINT)||(n_IsZero(h,coeffs_BIGINT)));
1054  n_Delete(&h,coeffs_BIGINT);
1055  return FALSE;
1056}
1057static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
1058{
1059  res->data = (char *)(long)((int)((long)u->Data()) >= (int)((long)v->Data()));
1060  return FALSE;
1061}
1062static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
1063{
1064  res->data = (char *)(long) (nGreater((number)u->Data(),(number)v->Data())
1065                       || nEqual((number)u->Data(),(number)v->Data()));
1066  return FALSE;
1067}
1068static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
1069{
1070  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1071  res->data = (char *)(long) (n_GreaterZero(h,coeffs_BIGINT)&&(!n_IsZero(h,coeffs_BIGINT)));
1072  n_Delete(&h,coeffs_BIGINT);
1073  return FALSE;
1074}
1075static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
1076{
1077  res->data = (char *)(long)((int)((long)u->Data()) > (int)((long)v->Data()));
1078  return FALSE;
1079}
1080static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
1081{
1082  res->data = (char *)(long)(nGreater((number)u->Data(),(number)v->Data()));
1083  return FALSE;
1084}
1085static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
1086{
1087  return jjGE_BI(res,v,u);
1088}
1089static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
1090{
1091  res->data = (char *)(long)((int)((long)u->Data()) <= (int)((long)v->Data()));
1092  return FALSE;
1093}
1094static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
1095{
1096  return jjGE_N(res,v,u);
1097}
1098static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
1099{
1100  return jjGT_BI(res,v,u);
1101}
1102static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
1103{
1104  res->data = (char *)(long)((int)((long)u->Data()) < (int)((long)v->Data()));
1105  return FALSE;
1106}
1107static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
1108{
1109  return jjGT_N(res,v,u);
1110}
1111static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
1112{
1113  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1114  int a= (int)(long)u->Data();
1115  int b= (int)(long)v->Data();
1116  if (b==0)
1117  {
1118    WerrorS(ii_div_by_0);
1119    return TRUE;
1120  }
1121  int c=a%b;
1122  int r=0;
1123  switch (iiOp)
1124  {
1125    case '%':
1126        r=c;            break;
1127    case '/':
1128    case INTDIV_CMD:
1129        r=((a-c) /b);   break;
1130  }
1131  res->data=(void *)((long)r);
1132  return FALSE;
1133}
1134static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1135{
1136  number q=(number)v->Data();
1137  if (n_IsZero(q,coeffs_BIGINT))
1138  {
1139    WerrorS(ii_div_by_0);
1140    return TRUE;
1141  }
1142  q = n_IntDiv((number)u->Data(),q,coeffs_BIGINT);
1143  n_Normalize(q,coeffs_BIGINT);
1144  res->data = (char *)q;
1145  return FALSE;
1146}
1147static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1148{
1149  number q=(number)v->Data();
1150  if (nIsZero(q))
1151  {
1152    WerrorS(ii_div_by_0);
1153    return TRUE;
1154  }
1155  q = nDiv((number)u->Data(),q);
1156  nNormalize(q);
1157  res->data = (char *)q;
1158  return FALSE;
1159}
1160static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1161{
1162  poly q=(poly)v->Data();
1163  if (q==NULL)
1164  {
1165    WerrorS(ii_div_by_0);
1166    return TRUE;
1167  }
1168  poly p=(poly)(u->Data());
1169  if (p==NULL)
1170  {
1171    res->data=NULL;
1172    return FALSE;
1173  }
1174  if ((pNext(q)!=NULL) && (!rField_is_Ring(currRing)))
1175  { /* This means that q != 0 consists of at least two terms.
1176       Moreover, currRing is over a field. */
1177#ifdef HAVE_FACTORY
1178    if(pGetComp(p)==0)
1179    {
1180      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1181                                         q /*(poly)(v->Data())*/ ,currRing));
1182    }
1183    else
1184    {
1185      int comps=pMaxComp(p);
1186      ideal I=idInit(comps,1);
1187      p=pCopy(p);
1188      poly h;
1189      int i;
1190      // conversion to a list of polys:
1191      while (p!=NULL)
1192      {
1193        i=pGetComp(p)-1;
1194        h=pNext(p);
1195        pNext(p)=NULL;
1196        pSetComp(p,0);
1197        I->m[i]=pAdd(I->m[i],p);
1198        p=h;
1199      }
1200      // division and conversion to vector:
1201      h=NULL;
1202      p=NULL;
1203      for(i=comps-1;i>=0;i--)
1204      {
1205        if (I->m[i]!=NULL)
1206        {
1207          h=singclap_pdivide(I->m[i],q,currRing);
1208          pSetCompP(h,i+1);
1209          p=pAdd(p,h);
1210        }
1211      }
1212      idDelete(&I);
1213      res->data=(void *)p;
1214    }
1215#else /* HAVE_FACTORY */
1216    WerrorS("division only by a monomial");
1217    return TRUE;
1218#endif /* HAVE_FACTORY */
1219  }
1220  else
1221  { /* This means that q != 0 consists of just one term,
1222       or that currRing is over a coefficient ring. */
1223#ifdef HAVE_RINGS
1224    if (!rField_is_Domain(currRing))
1225    {
1226      WerrorS("division only defined over coefficient domains");
1227      return TRUE;
1228    }
1229    if (pNext(q)!=NULL)
1230    {
1231      WerrorS("division over a coefficient domain only implemented for terms");
1232      return TRUE;
1233    }
1234#endif
1235    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1236  }
1237  pNormalize((poly)res->data);
1238  return FALSE;
1239}
1240static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1241{
1242  poly q=(poly)v->Data();
1243  if (q==NULL)
1244  {
1245    WerrorS(ii_div_by_0);
1246    return TRUE;
1247  }
1248  matrix m=(matrix)(u->Data());
1249  int r=m->rows();
1250  int c=m->cols();
1251  matrix mm=mpNew(r,c);
1252  int i,j;
1253  for(i=r;i>0;i--)
1254  {
1255    for(j=c;j>0;j--)
1256    {
1257      if (pNext(q)!=NULL)
1258      {
1259      #ifdef HAVE_FACTORY
1260        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1261                                           q /*(poly)(v->Data())*/, currRing );
1262#else /* HAVE_FACTORY */
1263        WerrorS("division only by a monomial");
1264        return TRUE;
1265#endif /* HAVE_FACTORY */
1266      }
1267      else
1268        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1269    }
1270  }
1271  id_Normalize((ideal)mm,currRing);
1272  res->data=(char *)mm;
1273  return FALSE;
1274}
1275static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1276{
1277  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1278  jjEQUAL_REST(res,u,v);
1279  return FALSE;
1280}
1281static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1282{
1283  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1284  jjEQUAL_REST(res,u,v);
1285  return FALSE;
1286}
1287static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1288{
1289  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1290  jjEQUAL_REST(res,u,v);
1291  return FALSE;
1292}
1293static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1294{
1295  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1296  jjEQUAL_REST(res,u,v);
1297  return FALSE;
1298}
1299static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1300{
1301  poly p=(poly)u->Data();
1302  poly q=(poly)v->Data();
1303  res->data = (char *) ((long)pEqualPolys(p,q));
1304  jjEQUAL_REST(res,u,v);
1305  return FALSE;
1306}
1307static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1308{
1309  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1310  {
1311    int save_iiOp=iiOp;
1312    if (iiOp==NOTEQUAL)
1313      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1314    else
1315      iiExprArith2(res,u->next,iiOp,v->next);
1316    iiOp=save_iiOp;
1317  }
1318  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1319}
1320static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1321{
1322  res->data = (char *)((long)u->Data() && (long)v->Data());
1323  return FALSE;
1324}
1325static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1326{
1327  res->data = (char *)((long)u->Data() || (long)v->Data());
1328  return FALSE;
1329}
1330static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1331{
1332  res->rtyp=u->rtyp; u->rtyp=0;
1333  res->data=u->data; u->data=NULL;
1334  res->name=u->name; u->name=NULL;
1335  res->e=u->e;       u->e=NULL;
1336  if (res->e==NULL) res->e=jjMakeSub(v);
1337  else
1338  {
1339    Subexpr sh=res->e;
1340    while (sh->next != NULL) sh=sh->next;
1341    sh->next=jjMakeSub(v);
1342  }
1343  return FALSE;
1344}
1345static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1346{
1347  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1348  {
1349    WerrorS("indexed object must have a name");
1350    return TRUE;
1351  }
1352  intvec * iv=(intvec *)v->Data();
1353  leftv p=NULL;
1354  int i;
1355  sleftv t;
1356  memset(&t,0,sizeof(t));
1357  t.rtyp=INT_CMD;
1358  for (i=0;i<iv->length(); i++)
1359  {
1360    t.data=(char *)((long)(*iv)[i]);
1361    if (p==NULL)
1362    {
1363      p=res;
1364    }
1365    else
1366    {
1367      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1368      p=p->next;
1369    }
1370    p->rtyp=IDHDL;
1371    p->data=u->data;
1372    p->name=u->name;
1373    p->flag=u->flag;
1374    p->e=jjMakeSub(&t);
1375  }
1376  u->rtyp=0;
1377  u->data=NULL;
1378  u->name=NULL;
1379  return FALSE;
1380}
1381static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1382{
1383  poly p=(poly)u->Data();
1384  int i=(int)(long)v->Data();
1385  int j=0;
1386  while (p!=NULL)
1387  {
1388    j++;
1389    if (j==i)
1390    {
1391      res->data=(char *)pHead(p);
1392      return FALSE;
1393    }
1394    pIter(p);
1395  }
1396  return FALSE;
1397}
1398static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1399{
1400  poly p=(poly)u->Data();
1401  poly r=NULL;
1402  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1403  int i;
1404  int sum=0;
1405  for(i=iv->length()-1;i>=0;i--)
1406    sum+=(*iv)[i];
1407  int j=0;
1408  while ((p!=NULL) && (sum>0))
1409  {
1410    j++;
1411    for(i=iv->length()-1;i>=0;i--)
1412    {
1413      if (j==(*iv)[i])
1414      {
1415        r=pAdd(r,pHead(p));
1416        sum-=j;
1417        (*iv)[i]=0;
1418        break;
1419      }
1420    }
1421    pIter(p);
1422  }
1423  delete iv;
1424  res->data=(char *)r;
1425  return FALSE;
1426}
1427static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1428{
1429  poly p=(poly)u->CopyD(VECTOR_CMD);
1430  poly r=p; // pointer to the beginning of component i
1431  poly o=NULL;
1432  unsigned i=(unsigned)(long)v->Data();
1433  while (p!=NULL)
1434  {
1435    if (pGetComp(p)!=i)
1436    {
1437      if (r==p) r=pNext(p);
1438      if (o!=NULL)
1439      {
1440        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1441        p=pNext(o);
1442      }
1443      else
1444        pLmDelete(&p);
1445    }
1446    else
1447    {
1448      pSetComp(p, 0);
1449      p_SetmComp(p, currRing);
1450      o=p;
1451      p=pNext(o);
1452    }
1453  }
1454  res->data=(char *)r;
1455  return FALSE;
1456}
1457static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1458{
1459  poly p=(poly)u->CopyD(VECTOR_CMD);
1460  if (p!=NULL)
1461  {
1462    poly r=pOne();
1463    poly hp=r;
1464    intvec *iv=(intvec *)v->Data();
1465    int i;
1466    loop
1467    {
1468      for(i=0;i<iv->length();i++)
1469      {
1470        if (((int)pGetComp(p))==(*iv)[i])
1471        {
1472          poly h;
1473          pSplit(p,&h);
1474          pNext(hp)=p;
1475          p=h;
1476          pIter(hp);
1477          break;
1478        }
1479      }
1480      if (p==NULL) break;
1481      if (i==iv->length())
1482      {
1483        pLmDelete(&p);
1484        if (p==NULL) break;
1485      }
1486    }
1487    pLmDelete(&r);
1488    res->data=(char *)r;
1489  }
1490  return FALSE;
1491}
1492static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1493static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1494{
1495  if(u->name==NULL) return TRUE;
1496  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1497  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1498  omFree((ADDRESS)u->name);
1499  u->name=NULL;
1500  char *n=omStrDup(nn);
1501  omFree((ADDRESS)nn);
1502  syMake(res,n);
1503  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1504  return FALSE;
1505}
1506static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1507{
1508  intvec * iv=(intvec *)v->Data();
1509  leftv p=NULL;
1510  int i;
1511  long slen = strlen(u->name) + 14;
1512  char *n = (char*) omAlloc(slen);
1513
1514  for (i=0;i<iv->length(); i++)
1515  {
1516    if (p==NULL)
1517    {
1518      p=res;
1519    }
1520    else
1521    {
1522      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1523      p=p->next;
1524    }
1525    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1526    syMake(p,omStrDup(n));
1527  }
1528  omFree((ADDRESS)u->name);
1529  u->name = NULL;
1530  omFreeSize(n, slen);
1531  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1532  return FALSE;
1533}
1534static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1535{
1536  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1537  memset(tmp,0,sizeof(sleftv));
1538  BOOLEAN b;
1539  if (v->Typ()==INTVEC_CMD)
1540    b=jjKLAMMER_IV(tmp,u,v);
1541  else
1542    b=jjKLAMMER(tmp,u,v);
1543  if (b)
1544  {
1545    omFreeBin(tmp,sleftv_bin);
1546    return TRUE;
1547  }
1548  leftv h=res;
1549  while (h->next!=NULL) h=h->next;
1550  h->next=tmp;
1551  return FALSE;
1552}
1553BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1554{
1555  void *d;
1556  Subexpr e;
1557  int typ;
1558  BOOLEAN t=FALSE;
1559  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1560  {
1561    idrec tmp_proc;
1562    tmp_proc.id="_auto";
1563    tmp_proc.typ=PROC_CMD;
1564    tmp_proc.data.pinf=(procinfo *)u->Data();
1565    tmp_proc.ref=1;
1566    d=u->data; u->data=(void *)&tmp_proc;
1567    e=u->e; u->e=NULL;
1568    t=TRUE;
1569    typ=u->rtyp; u->rtyp=IDHDL;
1570  }
1571  leftv sl;
1572  if (u->req_packhdl==currPack)
1573    sl = iiMake_proc((idhdl)u->data,NULL,v);
1574  else
1575    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1576  if (t)
1577  {
1578    u->rtyp=typ;
1579    u->data=d;
1580    u->e=e;
1581  }
1582  if (sl==NULL)
1583  {
1584    return TRUE;
1585  }
1586  else
1587  {
1588    memcpy(res,sl,sizeof(sleftv));
1589  }
1590  return FALSE;
1591}
1592static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1593{
1594  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1595  leftv sl=NULL;
1596  if ((v->e==NULL)&&(v->name!=NULL))
1597  {
1598    map m=(map)u->Data();
1599    sl=iiMap(m,v->name);
1600  }
1601  else
1602  {
1603    Werror("%s(<name>) expected",u->Name());
1604  }
1605  if (sl==NULL) return TRUE;
1606  memcpy(res,sl,sizeof(sleftv));
1607  omFreeBin((ADDRESS)sl, sleftv_bin);
1608  return FALSE;
1609}
1610#ifdef HAVE_FACTORY
1611static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1612{
1613  intvec *c=(intvec*)u->Data();
1614  intvec* p=(intvec*)v->Data();
1615  int rl=p->length();
1616  number *x=(number *)omAlloc(rl*sizeof(number));
1617  number *q=(number *)omAlloc(rl*sizeof(number));
1618  int i;
1619  for(i=rl-1;i>=0;i--)
1620  {
1621    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1622    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1623  }
1624  number n=n_ChineseRemainder(x,q,rl,coeffs_BIGINT);
1625  for(i=rl-1;i>=0;i--)
1626  {
1627    n_Delete(&(q[i]),coeffs_BIGINT);
1628    n_Delete(&(x[i]),coeffs_BIGINT);
1629  }
1630  omFree(x); omFree(q);
1631  res->data=(char *)n;
1632  return FALSE;
1633}
1634#endif
1635#if 0
1636static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1637{
1638  lists c=(lists)u->CopyD(); // list of poly
1639  intvec* p=(intvec*)v->Data();
1640  int rl=p->length();
1641  poly r=NULL,h, result=NULL;
1642  number *x=(number *)omAlloc(rl*sizeof(number));
1643  number *q=(number *)omAlloc(rl*sizeof(number));
1644  int i;
1645  for(i=rl-1;i>=0;i--)
1646  {
1647    q[i]=nlInit((*p)[i]);
1648  }
1649  loop
1650  {
1651    for(i=rl-1;i>=0;i--)
1652    {
1653      if (c->m[i].Typ()!=POLY_CMD)
1654      {
1655        Werror("poly expected at pos %d",i+1);
1656        for(i=rl-1;i>=0;i--)
1657        {
1658          nlDelete(&(q[i]),currRing);
1659        }
1660        omFree(x); omFree(q); // delete c
1661        return TRUE;
1662      }
1663      h=((poly)c->m[i].Data());
1664      if (r==NULL) r=h;
1665      else if (pLmCmp(r,h)==-1) r=h;
1666    }
1667    if (r==NULL) break;
1668    for(i=rl-1;i>=0;i--)
1669    {
1670      h=((poly)c->m[i].Data());
1671      if (pLmCmp(r,h)==0)
1672      {
1673        x[i]=pGetCoeff(h);
1674        h=pLmFreeAndNext(h);
1675        c->m[i].data=(char*)h;
1676      }
1677      else
1678        x[i]=nlInit(0);
1679    }
1680    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1681    for(i=rl-1;i>=0;i--)
1682    {
1683      nlDelete(&(x[i]),currRing);
1684    }
1685    h=pHead(r);
1686    pSetCoeff(h,n);
1687    result=pAdd(result,h);
1688  }
1689  for(i=rl-1;i>=0;i--)
1690  {
1691    nlDelete(&(q[i]),currRing);
1692  }
1693  omFree(x); omFree(q);
1694  res->data=(char *)result;
1695  return FALSE;
1696}
1697#endif
1698#ifdef HAVE_FACTORY
1699static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1700{
1701  lists c=(lists)u->CopyD(); // list of ideal
1702  lists pl=NULL;
1703  intvec *p=NULL;
1704  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1705  else                    p=(intvec*)v->Data();
1706  int rl=c->nr+1;
1707  ideal result;
1708  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1709  int i;
1710  int return_type=c->m[0].Typ();
1711  if ((return_type!=IDEAL_CMD)
1712  && (return_type!=MODUL_CMD)
1713  && (return_type!=MATRIX_CMD))
1714  {
1715    WerrorS("ideal/module/matrix expected");
1716    omFree(x); // delete c
1717    return TRUE;
1718  }
1719  for(i=rl-1;i>=0;i--)
1720  {
1721    if (c->m[i].Typ()!=return_type)
1722    {
1723      Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1724      omFree(x); // delete c
1725      return TRUE;
1726    }
1727    x[i]=((ideal)c->m[i].Data());
1728  }
1729  number *q=(number *)omAlloc(rl*sizeof(number));
1730  if (p!=NULL)
1731  {
1732    for(i=rl-1;i>=0;i--)
1733    {
1734      q[i]=n_Init((*p)[i], currRing->cf);
1735    }
1736  }
1737  else
1738  {
1739    for(i=rl-1;i>=0;i--)
1740    {
1741      if (pl->m[i].Typ()==INT_CMD)
1742      {
1743        q[i]=n_Init((int)(long)pl->m[i].Data(),currRing->cf);
1744      }
1745      else if (pl->m[i].Typ()==BIGINT_CMD)
1746      {
1747        q[i]=n_Init_bigint((number)(pl->m[i].Data()),coeffs_BIGINT,currRing->cf);
1748      }
1749      else
1750      {
1751        Werror("bigint expected at pos %d",i+1);
1752        for(i++;i<rl;i++)
1753        {
1754          n_Delete(&(q[i]),currRing->cf);
1755        }
1756        omFree(x); // delete c
1757        omFree(q); // delete pl
1758        return TRUE;
1759      }
1760    }
1761  }
1762  result=id_ChineseRemainder(x,q,rl,currRing);
1763  for(i=rl-1;i>=0;i--)
1764  {
1765    n_Delete(&(q[i]),currRing->cf);
1766  }
1767  omFree(q);
1768  res->data=(char *)result;
1769  res->rtyp=return_type;
1770  return FALSE;
1771}
1772#endif
1773static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1774{
1775  poly p=(poly)v->Data();
1776  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1777  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1778  return FALSE;
1779}
1780static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1781{
1782  int i=pVar((poly)v->Data());
1783  if (i==0)
1784  {
1785    WerrorS("ringvar expected");
1786    return TRUE;
1787  }
1788  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1789  return FALSE;
1790}
1791static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1792{
1793  poly p = pInit();
1794  int i;
1795  for (i=1; i<=currRing->N; i++)
1796  {
1797    pSetExp(p, i, 1);
1798  }
1799  pSetm(p);
1800  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1801                                    (ideal)(v->Data()), p);
1802  pDelete(&p);
1803  return FALSE;
1804}
1805static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1806{
1807  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1808  return FALSE;
1809}
1810static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1811{
1812  short *iv=iv2array((intvec *)v->Data(),currRing);
1813  ideal I=(ideal)u->Data();
1814  int d=-1;
1815  int i;
1816  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1817  omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1818  res->data = (char *)((long)d);
1819  return FALSE;
1820}
1821static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1822{
1823  poly p=(poly)u->Data();
1824  if (p!=NULL)
1825  {
1826    short *iv=iv2array((intvec *)v->Data(),currRing);
1827    int d=(int)pDegW(p,iv);
1828    omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1829    res->data = (char *)(long(d));
1830  }
1831  else
1832    res->data=(char *)(long)(-1);
1833  return FALSE;
1834}
1835static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1836{
1837  int i=pVar((poly)v->Data());
1838  if (i==0)
1839  {
1840    WerrorS("ringvar expected");
1841    return TRUE;
1842  }
1843  res->data=(char *)pDiff((poly)(u->Data()),i);
1844  return FALSE;
1845}
1846static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1847{
1848  int i=pVar((poly)v->Data());
1849  if (i==0)
1850  {
1851    WerrorS("ringvar expected");
1852    return TRUE;
1853  }
1854  res->data=(char *)idDiff((matrix)(u->Data()),i);
1855  return FALSE;
1856}
1857static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1858{
1859  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1860  return FALSE;
1861}
1862static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1863{
1864  assumeStdFlag(v);
1865#ifdef HAVE_RINGS
1866  if (rField_is_Ring(currRing))
1867  {
1868    ring origR = currRing;
1869    ring tempR = rCopy(origR);
1870    coeffs new_cf=nInitChar(n_Q,NULL);
1871    nKillChar(tempR->cf);
1872    tempR->cf=new_cf;
1873    rComplete(tempR);
1874    ideal vid = (ideal)v->Data();
1875    int i = idPosConstant(vid);
1876    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1877    { /* ideal v contains unit; dim = -1 */
1878      res->data = (char *)-1;
1879      return FALSE;
1880    }
1881    rChangeCurrRing(tempR);
1882    ideal vv = idrCopyR(vid, origR, currRing);
1883    ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1884    /* drop degree zero generator from vv (if any) */
1885    if (i != -1) pDelete(&vv->m[i]);
1886    long d = (long)scDimInt(vv, ww);
1887    if (rField_is_Ring_Z(origR) && (i == -1)) d++;
1888    res->data = (char *)d;
1889    idDelete(&vv); idDelete(&ww);
1890    rChangeCurrRing(origR);
1891    rDelete(tempR);
1892    return FALSE;
1893  }
1894#endif
1895  if(currQuotient==NULL)
1896    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1897  else
1898  {
1899    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1900    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1901    idDelete(&q);
1902  }
1903  return FALSE;
1904}
1905static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1906{
1907  ideal vi=(ideal)v->Data();
1908  int vl= IDELEMS(vi);
1909  ideal ui=(ideal)u->Data();
1910  int ul= IDELEMS(ui);
1911  ideal R; matrix U;
1912  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1913  if (m==NULL) return TRUE;
1914  // now make sure that all matices have the corect size:
1915  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
1916  int i;
1917  if (MATCOLS(U) != ul)
1918  {
1919    int mul=si_min(ul,MATCOLS(U));
1920    matrix UU=mpNew(ul,ul);
1921    int j;
1922    for(i=mul;i>0;i--)
1923    {
1924      for(j=mul;j>0;j--)
1925      {
1926        MATELEM(UU,i,j)=MATELEM(U,i,j);
1927        MATELEM(U,i,j)=NULL;
1928      }
1929    }
1930    idDelete((ideal *)&U);
1931    U=UU;
1932  }
1933  // make sure that U is a diagonal matrix of units
1934  for(i=ul;i>0;i--)
1935  {
1936    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1937  }
1938  lists L=(lists)omAllocBin(slists_bin);
1939  L->Init(3);
1940  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1941  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1942  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1943  res->data=(char *)L;
1944  return FALSE;
1945}
1946static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1947{
1948  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1949  //setFlag(res,FLAG_STD);
1950  return FALSE;
1951}
1952static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1953{
1954  poly p=pOne();
1955  intvec *iv=(intvec*)v->Data();
1956  for(int i=iv->length()-1; i>=0; i--)
1957  {
1958    pSetExp(p,(*iv)[i],1);
1959  }
1960  pSetm(p);
1961  res->data=(char *)idElimination((ideal)u->Data(),p);
1962  pLmDelete(&p);
1963  //setFlag(res,FLAG_STD);
1964  return FALSE;
1965}
1966static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
1967{
1968  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1969  return iiExport(v,0,(idhdl)u->data);
1970}
1971static BOOLEAN jjERROR(leftv, leftv u)
1972{
1973  WerrorS((char *)u->Data());
1974  extern int inerror;
1975  inerror=3;
1976  return TRUE;
1977}
1978static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
1979{
1980  number uu=(number)u->Data();number vv=(number)v->Data();
1981  lists L=(lists)omAllocBin(slists_bin);
1982  number a,b;
1983  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
1984  L->Init(3);
1985  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
1986  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
1987  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
1988  res->rtyp=LIST_CMD;
1989  res->data=(char *)L;
1990  return FALSE;
1991}
1992static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1993{
1994  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1995  int p0=ABS(uu),p1=ABS(vv);
1996  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
1997
1998  while ( p1!=0 )
1999  {
2000    q=p0 / p1;
2001    r=p0 % p1;
2002    p0 = p1; p1 = r;
2003    r = g0 - g1 * q;
2004    g0 = g1; g1 = r;
2005    r = f0 - f1 * q;
2006    f0 = f1; f1 = r;
2007  }
2008  int a = f0;
2009  int b = g0;
2010  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2011  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2012  lists L=(lists)omAllocBin(slists_bin);
2013  L->Init(3);
2014  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2015  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2016  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2017  res->rtyp=LIST_CMD;
2018  res->data=(char *)L;
2019  return FALSE;
2020}
2021#ifdef HAVE_FACTORY
2022static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2023{
2024  poly r,pa,pb;
2025  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2026  if (ret) return TRUE;
2027  lists L=(lists)omAllocBin(slists_bin);
2028  L->Init(3);
2029  res->data=(char *)L;
2030  L->m[0].data=(void *)r;
2031  L->m[0].rtyp=POLY_CMD;
2032  L->m[1].data=(void *)pa;
2033  L->m[1].rtyp=POLY_CMD;
2034  L->m[2].data=(void *)pb;
2035  L->m[2].rtyp=POLY_CMD;
2036  return FALSE;
2037}
2038extern int singclap_factorize_retry;
2039static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2040{
2041  intvec *v=NULL;
2042  int sw=(int)(long)dummy->Data();
2043  int fac_sw=sw;
2044  if ((sw<0)||(sw>2)) fac_sw=1;
2045  singclap_factorize_retry=0;
2046  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2047  if (f==NULL)
2048    return TRUE;
2049  switch(sw)
2050  {
2051    case 0:
2052    case 2:
2053    {
2054      lists l=(lists)omAllocBin(slists_bin);
2055      l->Init(2);
2056      l->m[0].rtyp=IDEAL_CMD;
2057      l->m[0].data=(void *)f;
2058      l->m[1].rtyp=INTVEC_CMD;
2059      l->m[1].data=(void *)v;
2060      res->data=(void *)l;
2061      res->rtyp=LIST_CMD;
2062      return FALSE;
2063    }
2064    case 1:
2065      res->data=(void *)f;
2066      return FALSE;
2067    case 3:
2068      {
2069        poly p=f->m[0];
2070        int i=IDELEMS(f);
2071        f->m[0]=NULL;
2072        while(i>1)
2073        {
2074          i--;
2075          p=pMult(p,f->m[i]);
2076          f->m[i]=NULL;
2077        }
2078        res->data=(void *)p;
2079        res->rtyp=POLY_CMD;
2080      }
2081      return FALSE;
2082  }
2083  WerrorS("invalid switch");
2084  return TRUE;
2085}
2086static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2087{
2088  ideal_list p,h;
2089  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2090  p=h;
2091  int l=0;
2092  while (p!=NULL) { p=p->next;l++; }
2093  lists L=(lists)omAllocBin(slists_bin);
2094  L->Init(l);
2095  l=0;
2096  while(h!=NULL)
2097  {
2098    L->m[l].data=(char *)h->d;
2099    L->m[l].rtyp=IDEAL_CMD;
2100    p=h->next;
2101    omFreeSize(h,sizeof(*h));
2102    h=p;
2103    l++;
2104  }
2105  res->data=(void *)L;
2106  return FALSE;
2107}
2108#endif /* HAVE_FACTORY */
2109static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2110{
2111  if (rField_is_Q(currRing))
2112  {
2113    number uu=(number)u->Data();
2114    number vv=(number)v->Data();
2115    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2116    return FALSE;
2117  }
2118  else return TRUE;
2119}
2120static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2121{
2122  if (rField_is_Q(currRing))
2123  {
2124    ideal uu=(ideal)u->Data();
2125    number vv=(number)v->Data();
2126    res->data=(void*)id_Farey(uu,vv,currRing);
2127    res->rtyp=u->Typ();
2128    return FALSE;
2129  }
2130  else return TRUE;
2131}
2132static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2133{
2134  ring r=(ring)u->Data();
2135  idhdl w;
2136  int op=iiOp;
2137  nMapFunc nMap;
2138
2139  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2140  {
2141    int *perm=NULL;
2142    int *par_perm=NULL;
2143    int par_perm_size=0;
2144    BOOLEAN bo;
2145    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2146    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2147    {
2148      // Allow imap/fetch to be make an exception only for:
2149      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2150            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2151             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2152           ||
2153           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2154            (rField_is_Zp(currRing, r->cf->ch) ||
2155             rField_is_Zp_a(currRing, r->cf->ch))) )
2156      {
2157        par_perm_size=rPar(r);
2158      }
2159      else
2160      {
2161        goto err_fetch;
2162      }
2163    }
2164    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2165    {
2166      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2167      if (par_perm_size!=0)
2168        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2169      op=IMAP_CMD;
2170      if (iiOp==IMAP_CMD)
2171      {
2172        int r_par=0;
2173        char ** r_par_names=NULL;
2174        if (r->cf->extRing!=NULL)
2175        {
2176          r_par=r->cf->extRing->N;
2177          r_par_names=r->cf->extRing->names;
2178        }
2179        int c_par=0;
2180        char ** c_par_names=NULL;
2181        if (currRing->cf->extRing!=NULL)
2182        {
2183          c_par=currRing->cf->extRing->N;
2184          c_par_names=currRing->cf->extRing->names;
2185        }
2186        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2187                   currRing->names,currRing->N,c_par_names, c_par,
2188                   perm,par_perm, currRing->cf->type);
2189      }
2190      else
2191      {
2192        int i;
2193        if (par_perm_size!=0)
2194          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2195        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2196      }
2197    }
2198    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2199    {
2200      int i;
2201      for(i=0;i<si_min(r->N,currRing->N);i++)
2202      {
2203        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2204      }
2205      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2206      {
2207        Print("// par nr %d: %s -> %s\n",
2208              i,rParameter(r)[i],rParameter(currRing)[i]);
2209      }
2210    }
2211    sleftv tmpW;
2212    memset(&tmpW,0,sizeof(sleftv));
2213    tmpW.rtyp=IDTYP(w);
2214    tmpW.data=IDDATA(w);
2215    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2216                         perm,par_perm,par_perm_size,nMap)))
2217    {
2218      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2219    }
2220    if (perm!=NULL)
2221      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2222    if (par_perm!=NULL)
2223      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2224    return bo;
2225  }
2226  else
2227  {
2228    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2229  }
2230  return TRUE;
2231err_fetch:
2232  Werror("no identity map from %s",u->Fullname());
2233  return TRUE;
2234}
2235static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2236{
2237  /*4
2238  * look for the substring what in the string where
2239  * return the position of the first char of what in where
2240  * or 0
2241  */
2242  char *where=(char *)u->Data();
2243  char *what=(char *)v->Data();
2244  char *found = strstr(where,what);
2245  if (found != NULL)
2246  {
2247    res->data=(char *)((found-where)+1);
2248  }
2249  /*else res->data=NULL;*/
2250  return FALSE;
2251}
2252static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2253{
2254  res->data=(char *)fractalWalkProc(u,v);
2255  setFlag( res, FLAG_STD );
2256  return FALSE;
2257}
2258static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2259{
2260  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2261  int p0=ABS(uu),p1=ABS(vv);
2262  int r;
2263  while ( p1!=0 )
2264  {
2265    r=p0 % p1;
2266    p0 = p1; p1 = r;
2267  }
2268  res->rtyp=INT_CMD;
2269  res->data=(char *)(long)p0;
2270  return FALSE;
2271}
2272static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2273{
2274  number a=(number) u->Data();
2275  number b=(number) v->Data();
2276  if (n_IsZero(a,coeffs_BIGINT))
2277  {
2278    if (n_IsZero(b,coeffs_BIGINT)) res->data=(char *)n_Init(1,coeffs_BIGINT);
2279    else                           res->data=(char *)n_Copy(b,coeffs_BIGINT);
2280  }
2281  else
2282  {
2283    if (n_IsZero(b,coeffs_BIGINT))  res->data=(char *)n_Copy(a,coeffs_BIGINT);
2284    else res->data=(char *)n_Gcd(a, b, coeffs_BIGINT);
2285  }
2286  return FALSE;
2287}
2288static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2289{
2290  number a=(number) u->Data();
2291  number b=(number) v->Data();
2292  if (nIsZero(a))
2293  {
2294    if (nIsZero(b)) res->data=(char *)nInit(1);
2295    else            res->data=(char *)nCopy(b);
2296  }
2297  else
2298  {
2299    if (nIsZero(b))  res->data=(char *)nCopy(a);
2300    else res->data=(char *)nGcd(a, b, currRing);
2301  }
2302  return FALSE;
2303}
2304#ifdef HAVE_FACTORY
2305static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2306{
2307  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2308                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2309  return FALSE;
2310}
2311#endif /* HAVE_FACTORY */
2312static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2313{
2314#ifdef HAVE_RINGS
2315  if (rField_is_Ring_Z(currRing))
2316  {
2317    ring origR = currRing;
2318    ring tempR = rCopy(origR);
2319    coeffs new_cf=nInitChar(n_Q,NULL);
2320    nKillChar(tempR->cf);
2321    tempR->cf=new_cf;
2322    rComplete(tempR);
2323    ideal uid = (ideal)u->Data();
2324    rChangeCurrRing(tempR);
2325    ideal uu = idrCopyR(uid, origR, currRing);
2326    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2327    uuAsLeftv.rtyp = IDEAL_CMD;
2328    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2329    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2330    assumeStdFlag(&uuAsLeftv);
2331    Print("// NOTE: computation of Hilbert series etc. is being\n");
2332    Print("//       performed for generic fibre, that is, over Q\n");
2333    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2334    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2335    int returnWithTrue = 1;
2336    switch((int)(long)v->Data())
2337    {
2338      case 1:
2339        res->data=(void *)iv;
2340        returnWithTrue = 0;
2341      case 2:
2342        res->data=(void *)hSecondSeries(iv);
2343        delete iv;
2344        returnWithTrue = 0;
2345    }
2346    if (returnWithTrue)
2347    {
2348      WerrorS(feNotImplemented);
2349      delete iv;
2350    }
2351    idDelete(&uu);
2352    rChangeCurrRing(origR);
2353    rDelete(tempR);
2354    if (returnWithTrue) return TRUE; else return FALSE;
2355  }
2356#endif
2357  assumeStdFlag(u);
2358  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2359  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2360  switch((int)(long)v->Data())
2361  {
2362    case 1:
2363      res->data=(void *)iv;
2364      return FALSE;
2365    case 2:
2366      res->data=(void *)hSecondSeries(iv);
2367      delete iv;
2368      return FALSE;
2369  }
2370  WerrorS(feNotImplemented);
2371  delete iv;
2372  return TRUE;
2373}
2374static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2375{
2376  int i=pVar((poly)v->Data());
2377  if (i==0)
2378  {
2379    WerrorS("ringvar expected");
2380    return TRUE;
2381  }
2382  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2383  int d=pWTotaldegree(p);
2384  pLmDelete(p);
2385  if (d==1)
2386    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2387  else
2388    WerrorS("variable must have weight 1");
2389  return (d!=1);
2390}
2391static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2392{
2393  int i=pVar((poly)v->Data());
2394  if (i==0)
2395  {
2396    WerrorS("ringvar expected");
2397    return TRUE;
2398  }
2399  pFDegProc deg;
2400  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2401    deg=p_Totaldegree;
2402   else
2403    deg=currRing->pFDeg;
2404  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2405  int d=deg(p,currRing);
2406  pLmDelete(p);
2407  if (d==1)
2408    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2409  else
2410    WerrorS("variable must have weight 1");
2411  return (d!=1);
2412}
2413static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2414{
2415  intvec *w=new intvec(rVar(currRing));
2416  intvec *vw=(intvec*)u->Data();
2417  ideal v_id=(ideal)v->Data();
2418  pFDegProc save_FDeg=currRing->pFDeg;
2419  pLDegProc save_LDeg=currRing->pLDeg;
2420  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2421  currRing->pLexOrder=FALSE;
2422  kHomW=vw;
2423  kModW=w;
2424  pSetDegProcs(currRing,kHomModDeg);
2425  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2426  currRing->pLexOrder=save_pLexOrder;
2427  kHomW=NULL;
2428  kModW=NULL;
2429  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2430  if (w!=NULL) delete w;
2431  return FALSE;
2432}
2433static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2434{
2435  assumeStdFlag(u);
2436  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2437                    currQuotient);
2438  return FALSE;
2439}
2440static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2441{
2442  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2443  setFlag(res,FLAG_STD);
2444  return FALSE;
2445}
2446static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2447{
2448  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2449}
2450static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2451{
2452  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2453  return FALSE;
2454}
2455static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2456{
2457  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2458  return FALSE;
2459}
2460static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2461{
2462  assumeStdFlag(u);
2463  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2464  res->data = (char *)scKBase((int)(long)v->Data(),
2465                              (ideal)(u->Data()),currQuotient, w_u);
2466  if (w_u!=NULL)
2467  {
2468    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2469  }
2470  return FALSE;
2471}
2472static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2473static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2474{
2475  return jjPREIMAGE(res,u,v,NULL);
2476}
2477static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2478{
2479  return mpKoszul(res, u,v,NULL);
2480}
2481static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2482{
2483  sleftv h;
2484  memset(&h,0,sizeof(sleftv));
2485  h.rtyp=INT_CMD;
2486  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2487  return mpKoszul(res, u, &h, v);
2488}
2489static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2490{
2491  BITSET save_test=test;
2492  int ul= IDELEMS((ideal)u->Data());
2493  int vl= IDELEMS((ideal)v->Data());
2494  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2495                   hasFlag(u,FLAG_STD));
2496  if (m==NULL) return TRUE;
2497  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2498  test=save_test;
2499  return FALSE;
2500}
2501static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2502{
2503  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2504  idhdl h=(idhdl)v->data;
2505  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2506  res->data = (char *)idLiftStd((ideal)u->Data(),
2507                                &(h->data.umatrix),testHomog);
2508  setFlag(res,FLAG_STD); v->flag=0;
2509  return FALSE;
2510}
2511static BOOLEAN jjLOAD2(leftv res, leftv, leftv v)
2512{
2513  return jjLOAD(res, v,TRUE);
2514}
2515static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2516{
2517  char * s=(char *)u->Data();
2518  if(strcmp(s, "with")==0)
2519    return jjLOAD(res, v, TRUE);
2520  WerrorS("invalid second argument");
2521  WerrorS("load(\"libname\" [,\"with\"]);");
2522  return TRUE;
2523}
2524static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2525{
2526  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2527  tHomog hom=testHomog;
2528  if (w_u!=NULL)
2529  {
2530    w_u=ivCopy(w_u);
2531    hom=isHomog;
2532  }
2533  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2534  if (w_v!=NULL)
2535  {
2536    w_v=ivCopy(w_v);
2537    hom=isHomog;
2538  }
2539  if ((w_u!=NULL) && (w_v==NULL))
2540    w_v=ivCopy(w_u);
2541  if ((w_v!=NULL) && (w_u==NULL))
2542    w_u=ivCopy(w_v);
2543  ideal u_id=(ideal)u->Data();
2544  ideal v_id=(ideal)v->Data();
2545  if (w_u!=NULL)
2546  {
2547     if ((*w_u).compare((w_v))!=0)
2548     {
2549       WarnS("incompatible weights");
2550       delete w_u; w_u=NULL;
2551       hom=testHomog;
2552     }
2553     else
2554     {
2555       if ((!idTestHomModule(u_id,currQuotient,w_v))
2556       || (!idTestHomModule(v_id,currQuotient,w_v)))
2557       {
2558         WarnS("wrong weights");
2559         delete w_u; w_u=NULL;
2560         hom=testHomog;
2561       }
2562     }
2563  }
2564  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2565  if (w_u!=NULL)
2566  {
2567    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2568  }
2569  delete w_v;
2570  return FALSE;
2571}
2572static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2573{
2574  number q=(number)v->Data();
2575  if (n_IsZero(q,coeffs_BIGINT))
2576  {
2577    WerrorS(ii_div_by_0);
2578    return TRUE;
2579  }
2580  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2581  return FALSE;
2582}
2583static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2584{
2585  number q=(number)v->Data();
2586  if (nIsZero(q))
2587  {
2588    WerrorS(ii_div_by_0);
2589    return TRUE;
2590  }
2591  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2592  return FALSE;
2593}
2594static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2595static BOOLEAN jjMONITOR1(leftv res, leftv v)
2596{
2597  return jjMONITOR2(res,v,NULL);
2598}
2599static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2600{
2601#if 0
2602  char *opt=(char *)v->Data();
2603  int mode=0;
2604  while(*opt!='\0')
2605  {
2606    if (*opt=='i') mode |= PROT_I;
2607    else if (*opt=='o') mode |= PROT_O;
2608    opt++;
2609  }
2610  monitor((char *)(u->Data()),mode);
2611#else
2612  si_link l=(si_link)u->Data();
2613  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2614  if(strcmp(l->m->type,"ASCII")!=0)
2615  {
2616    Werror("ASCII link required, not `%s`",l->m->type);
2617    slClose(l);
2618    return TRUE;
2619  }
2620  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2621  if ( l->name[0]!='\0') // "" is the stop condition
2622  {
2623    const char *opt;
2624    int mode=0;
2625    if (v==NULL) opt=(const char*)"i";
2626    else         opt=(const char *)v->Data();
2627    while(*opt!='\0')
2628    {
2629      if (*opt=='i') mode |= PROT_I;
2630      else if (*opt=='o') mode |= PROT_O;
2631      opt++;
2632    }
2633    monitor((FILE *)l->data,mode);
2634  }
2635  else
2636    monitor(NULL,0);
2637  return FALSE;
2638#endif
2639}
2640static BOOLEAN jjMONOM(leftv res, leftv v)
2641{
2642  intvec *iv=(intvec *)v->Data();
2643  poly p=pOne();
2644  int i,e;
2645  BOOLEAN err=FALSE;
2646  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2647  {
2648    e=(*iv)[i-1];
2649    if (e>=0) pSetExp(p,i,e);
2650    else err=TRUE;
2651  }
2652  if (iv->length()==(currRing->N+1))
2653  {
2654    res->rtyp=VECTOR_CMD;
2655    e=(*iv)[currRing->N];
2656    if (e>=0) pSetComp(p,e);
2657    else err=TRUE;
2658  }
2659  pSetm(p);
2660  res->data=(char*)p;
2661  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2662  return err;
2663}
2664static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2665{
2666  // u: the name of the new type
2667  // v: the elements
2668  newstruct_desc d=newstructFromString((const char *)v->Data());
2669  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2670  return d==NULL;
2671}
2672static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2673{
2674  idhdl h=(idhdl)u->data;
2675  int i=(int)(long)v->Data();
2676  int p=0;
2677  if ((0<i)
2678  && (rParameter(IDRING(h))!=NULL)
2679  && (i<=(p=rPar(IDRING(h)))))
2680    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2681  else
2682  {
2683    Werror("par number %d out of range 1..%d",i,p);
2684    return TRUE;
2685  }
2686  return FALSE;
2687}
2688#ifdef HAVE_PLURAL
2689static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2690{
2691  if( currRing->qideal != NULL )
2692  {
2693    WerrorS("basering must NOT be a qring!");
2694    return TRUE;
2695  }
2696
2697  if (iiOp==NCALGEBRA_CMD)
2698  {
2699    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2700  }
2701  else
2702  {
2703    ring r=rCopy(currRing);
2704    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2705    res->data=r;
2706    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2707    return result;
2708  }
2709}
2710static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2711{
2712  if( currRing->qideal != NULL )
2713  {
2714    WerrorS("basering must NOT be a qring!");
2715    return TRUE;
2716  }
2717
2718  if (iiOp==NCALGEBRA_CMD)
2719  {
2720    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2721  }
2722  else
2723  {
2724    ring r=rCopy(currRing);
2725    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2726    res->data=r;
2727    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2728    return result;
2729  }
2730}
2731static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2732{
2733  if( currRing->qideal != NULL )
2734  {
2735    WerrorS("basering must NOT be a qring!");
2736    return TRUE;
2737  }
2738
2739  if (iiOp==NCALGEBRA_CMD)
2740  {
2741    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2742  }
2743  else
2744  {
2745    ring r=rCopy(currRing);
2746    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2747    res->data=r;
2748    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2749    return result;
2750  }
2751}
2752static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2753{
2754  if( currRing->qideal != NULL )
2755  {
2756    WerrorS("basering must NOT be a qring!");
2757    return TRUE;
2758  }
2759
2760  if (iiOp==NCALGEBRA_CMD)
2761  {
2762    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2763  }
2764  else
2765  {
2766    ring r=rCopy(currRing);
2767    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2768    res->data=r;
2769    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2770    return result;
2771  }
2772}
2773static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2774{
2775  res->data=NULL;
2776
2777  if (rIsPluralRing(currRing))
2778  {
2779    const poly q = (poly)b->Data();
2780
2781    if( q != NULL )
2782    {
2783      if( (poly)a->Data() != NULL )
2784      {
2785        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2786        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2787      }
2788    }
2789  }
2790  return FALSE;
2791}
2792static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2793{
2794  /* number, poly, vector, ideal, module, matrix */
2795  ring  r = (ring)a->Data();
2796  if (r == currRing)
2797  {
2798    res->data = b->Data();
2799    res->rtyp = b->rtyp;
2800    return FALSE;
2801  }
2802  if (!rIsLikeOpposite(currRing, r))
2803  {
2804    Werror("%s is not an opposite ring to current ring",a->Fullname());
2805    return TRUE;
2806  }
2807  idhdl w;
2808  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2809  {
2810    int argtype = IDTYP(w);
2811    switch (argtype)
2812    {
2813    case NUMBER_CMD:
2814      {
2815        /* since basefields are equal, we can apply nCopy */
2816        res->data = nCopy((number)IDDATA(w));
2817        res->rtyp = argtype;
2818        break;
2819      }
2820    case POLY_CMD:
2821    case VECTOR_CMD:
2822      {
2823        poly    q = (poly)IDDATA(w);
2824        res->data = pOppose(r,q,currRing);
2825        res->rtyp = argtype;
2826        break;
2827      }
2828    case IDEAL_CMD:
2829    case MODUL_CMD:
2830      {
2831        ideal   Q = (ideal)IDDATA(w);
2832        res->data = idOppose(r,Q,currRing);
2833        res->rtyp = argtype;
2834        break;
2835      }
2836    case MATRIX_CMD:
2837      {
2838        ring save = currRing;
2839        rChangeCurrRing(r);
2840        matrix  m = (matrix)IDDATA(w);
2841        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2842        rChangeCurrRing(save);
2843        ideal   S = idOppose(r,Q,currRing);
2844        id_Delete(&Q, r);
2845        res->data = id_Module2Matrix(S,currRing);
2846        res->rtyp = argtype;
2847        break;
2848      }
2849    default:
2850      {
2851        WerrorS("unsupported type in oppose");
2852        return TRUE;
2853      }
2854    }
2855  }
2856  else
2857  {
2858    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2859    return TRUE;
2860  }
2861  return FALSE;
2862}
2863#endif /* HAVE_PLURAL */
2864
2865static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2866{
2867  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2868    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2869  id_DelMultiples((ideal)(res->data),currRing);
2870  return FALSE;
2871}
2872static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2873{
2874  int i=(int)(long)u->Data();
2875  int j=(int)(long)v->Data();
2876  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2877  return FALSE;
2878}
2879static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2880{
2881  matrix m =(matrix)u->Data();
2882  int isRowEchelon = (int)(long)v->Data();
2883  if (isRowEchelon != 1) isRowEchelon = 0;
2884  int rank = luRank(m, isRowEchelon);
2885  res->data =(char *)(long)rank;
2886  return FALSE;
2887}
2888static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2889{
2890  si_link l=(si_link)u->Data();
2891  leftv r=slRead(l,v);
2892  if (r==NULL)
2893  {
2894    const char *s;
2895    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2896    else                            s=sNoName;
2897    Werror("cannot read from `%s`",s);
2898    return TRUE;
2899  }
2900  memcpy(res,r,sizeof(sleftv));
2901  omFreeBin((ADDRESS)r, sleftv_bin);
2902  return FALSE;
2903}
2904static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2905{
2906  assumeStdFlag(v);
2907  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2908  return FALSE;
2909}
2910static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2911{
2912  assumeStdFlag(v);
2913  ideal ui=(ideal)u->Data();
2914  ideal vi=(ideal)v->Data();
2915  res->data = (char *)kNF(vi,currQuotient,ui);
2916  return FALSE;
2917}
2918#if 0
2919static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2920{
2921  int maxl=(int)(long)v->Data();
2922  if (maxl<0)
2923  {
2924    WerrorS("length for res must not be negative");
2925    return TRUE;
2926  }
2927  int l=0;
2928  //resolvente r;
2929  syStrategy r;
2930  intvec *weights=NULL;
2931  int wmaxl=maxl;
2932  ideal u_id=(ideal)u->Data();
2933
2934  maxl--;
2935  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2936  {
2937    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
2938    if (currQuotient!=NULL)
2939    {
2940      Warn(
2941      "full resolution in a qring may be infinite, setting max length to %d",
2942      maxl+1);
2943    }
2944  }
2945  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2946  if (weights!=NULL)
2947  {
2948    if (!idTestHomModule(u_id,currQuotient,weights))
2949    {
2950      WarnS("wrong weights given:");weights->show();PrintLn();
2951      weights=NULL;
2952    }
2953  }
2954  intvec *ww=NULL;
2955  int add_row_shift=0;
2956  if (weights!=NULL)
2957  {
2958     ww=ivCopy(weights);
2959     add_row_shift = ww->min_in();
2960     (*ww) -= add_row_shift;
2961  }
2962  else
2963    idHomModule(u_id,currQuotient,&ww);
2964  weights=ww;
2965
2966  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2967  {
2968    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2969  }
2970  else if (iiOp==SRES_CMD)
2971  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2972    r=sySchreyer(u_id,maxl+1);
2973  else if (iiOp == LRES_CMD)
2974  {
2975    int dummy;
2976    if((currQuotient!=NULL)||
2977    (!idHomIdeal (u_id,NULL)))
2978    {
2979       WerrorS
2980       ("`lres` not implemented for inhomogeneous input or qring");
2981       return TRUE;
2982    }
2983    r=syLaScala3(u_id,&dummy);
2984  }
2985  else if (iiOp == KRES_CMD)
2986  {
2987    int dummy;
2988    if((currQuotient!=NULL)||
2989    (!idHomIdeal (u_id,NULL)))
2990    {
2991       WerrorS
2992       ("`kres` not implemented for inhomogeneous input or qring");
2993       return TRUE;
2994    }
2995    r=syKosz(u_id,&dummy);
2996  }
2997  else
2998  {
2999    int dummy;
3000    if((currQuotient!=NULL)||
3001    (!idHomIdeal (u_id,NULL)))
3002    {
3003       WerrorS
3004       ("`hres` not implemented for inhomogeneous input or qring");
3005       return TRUE;
3006    }
3007    r=syHilb(u_id,&dummy);
3008  }
3009  if (r==NULL) return TRUE;
3010  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3011  r->list_length=wmaxl;
3012  res->data=(void *)r;
3013  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3014  {
3015    intvec *w=ivCopy(r->weights[0]);
3016    if (weights!=NULL) (*w) += add_row_shift;
3017    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3018    w=NULL;
3019  }
3020  else
3021  {
3022//#if 0
3023// need to set weights for ALL components (sres)
3024    if (weights!=NULL)
3025    {
3026      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3027      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3028      (r->weights)[0] = ivCopy(weights);
3029    }
3030//#endif
3031  }
3032  if (ww!=NULL) { delete ww; ww=NULL; }
3033  return FALSE;
3034}
3035#else
3036static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3037{
3038  int maxl=(int)(long)v->Data();
3039  if (maxl<0)
3040  {
3041    WerrorS("length for res must not be negative");
3042    return TRUE;
3043  }
3044  syStrategy r;
3045  intvec *weights=NULL;
3046  int wmaxl=maxl;
3047  ideal u_id=(ideal)u->Data();
3048
3049  maxl--;
3050  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3051  {
3052    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3053    if (currQuotient!=NULL)
3054    {
3055      Warn(
3056      "full resolution in a qring may be infinite, setting max length to %d",
3057      maxl+1);
3058    }
3059  }
3060  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3061  if (weights!=NULL)
3062  {
3063    if (!idTestHomModule(u_id,currQuotient,weights))
3064    {
3065      WarnS("wrong weights given:");weights->show();PrintLn();
3066      weights=NULL;
3067    }
3068  }
3069  intvec *ww=NULL;
3070  int add_row_shift=0;
3071  if (weights!=NULL)
3072  {
3073     ww=ivCopy(weights);
3074     add_row_shift = ww->min_in();
3075     (*ww) -= add_row_shift;
3076  }
3077  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3078  {
3079    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3080  }
3081  else if (iiOp==SRES_CMD)
3082  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3083    r=sySchreyer(u_id,maxl+1);
3084  else if (iiOp == LRES_CMD)
3085  {
3086    int dummy;
3087    if((currQuotient!=NULL)||
3088    (!idHomIdeal (u_id,NULL)))
3089    {
3090       WerrorS
3091       ("`lres` not implemented for inhomogeneous input or qring");
3092       return TRUE;
3093    }
3094    if(currRing->N == 1)
3095      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3096    r=syLaScala3(u_id,&dummy);
3097  }
3098  else if (iiOp == KRES_CMD)
3099  {
3100    int dummy;
3101    if((currQuotient!=NULL)||
3102    (!idHomIdeal (u_id,NULL)))
3103    {
3104       WerrorS
3105       ("`kres` not implemented for inhomogeneous input or qring");
3106       return TRUE;
3107    }
3108    r=syKosz(u_id,&dummy);
3109  }
3110  else
3111  {
3112    int dummy;
3113    if((currQuotient!=NULL)||
3114    (!idHomIdeal (u_id,NULL)))
3115    {
3116       WerrorS
3117       ("`hres` not implemented for inhomogeneous input or qring");
3118       return TRUE;
3119    }
3120    ideal u_id_copy=idCopy(u_id);
3121    idSkipZeroes(u_id_copy);
3122    r=syHilb(u_id_copy,&dummy);
3123    idDelete(&u_id_copy);
3124  }
3125  if (r==NULL) return TRUE;
3126  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3127  r->list_length=wmaxl;
3128  res->data=(void *)r;
3129  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3130  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3131  {
3132    ww=ivCopy(r->weights[0]);
3133    if (weights!=NULL) (*ww) += add_row_shift;
3134    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3135  }
3136  else
3137  {
3138    if (weights!=NULL)
3139    {
3140      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3141    }
3142  }
3143
3144  // test the La Scala case' output
3145  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3146  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3147
3148  if(iiOp != HRES_CMD)
3149    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3150  else
3151    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3152
3153  return FALSE;
3154}
3155#endif
3156static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3157{
3158  number n1; number n2; number temp; int i;
3159
3160  if ((u->Typ() == BIGINT_CMD) ||
3161     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3162  {
3163    temp = (number)u->Data();
3164    n1 = n_Copy(temp,coeffs_BIGINT);
3165  }
3166  else if (u->Typ() == INT_CMD)
3167  {
3168    i = (int)(long)u->Data();
3169    n1 = n_Init(i, coeffs_BIGINT);
3170  }
3171  else
3172  {
3173    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3174    return TRUE;
3175  }
3176
3177  if ((v->Typ() == BIGINT_CMD) ||
3178     ((v->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3179  {
3180    temp = (number)v->Data();
3181    n2 = n_Copy(temp,coeffs_BIGINT);
3182  }
3183  else if (v->Typ() == INT_CMD)
3184  {
3185    i = (int)(long)v->Data();
3186    n2 = n_Init(i, coeffs_BIGINT);
3187  }
3188  else
3189  {
3190    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3191    return TRUE;
3192  }
3193
3194  lists l = primeFactorisation(n1, n2);
3195  n_Delete(&n1, coeffs_BIGINT); n_Delete(&n2, coeffs_BIGINT);
3196  res->data = (char*)l;
3197  return FALSE;
3198}
3199static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3200{
3201  ring r;
3202  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3203  res->data = (char *)r;
3204  return (i==-1);
3205}
3206#define SIMPL_LMDIV 32
3207#define SIMPL_LMEQ  16
3208#define SIMPL_MULT 8
3209#define SIMPL_EQU  4
3210#define SIMPL_NULL 2
3211#define SIMPL_NORM 1
3212static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3213{
3214  int sw = (int)(long)v->Data();
3215  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3216  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3217  if (sw & SIMPL_LMDIV)
3218  {
3219    id_DelDiv(id,currRing);
3220  }
3221  if (sw & SIMPL_LMEQ)
3222  {
3223    id_DelLmEquals(id,currRing);
3224  }
3225  if (sw & SIMPL_MULT)
3226  {
3227    id_DelMultiples(id,currRing);
3228  }
3229  else if(sw & SIMPL_EQU)
3230  {
3231    id_DelEquals(id,currRing);
3232  }
3233  if (sw & SIMPL_NULL)
3234  {
3235    idSkipZeroes(id);
3236  }
3237  if (sw & SIMPL_NORM)
3238  {
3239    id_Norm(id,currRing);
3240  }
3241  res->data = (char * )id;
3242  return FALSE;
3243}
3244#ifdef HAVE_FACTORY
3245extern int singclap_factorize_retry;
3246static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3247{
3248  intvec *v=NULL;
3249  int sw=(int)(long)dummy->Data();
3250  int fac_sw=sw;
3251  if (sw<0) fac_sw=1;
3252  singclap_factorize_retry=0;
3253  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3254  if (f==NULL)
3255    return TRUE;
3256  switch(sw)
3257  {
3258    case 0:
3259    case 2:
3260    {
3261      lists l=(lists)omAllocBin(slists_bin);
3262      l->Init(2);
3263      l->m[0].rtyp=IDEAL_CMD;
3264      l->m[0].data=(void *)f;
3265      l->m[1].rtyp=INTVEC_CMD;
3266      l->m[1].data=(void *)v;
3267      res->data=(void *)l;
3268      res->rtyp=LIST_CMD;
3269      return FALSE;
3270    }
3271    case 1:
3272      res->data=(void *)f;
3273      return FALSE;
3274    case 3:
3275      {
3276        poly p=f->m[0];
3277        int i=IDELEMS(f);
3278        f->m[0]=NULL;
3279        while(i>1)
3280        {
3281          i--;
3282          p=pMult(p,f->m[i]);
3283          f->m[i]=NULL;
3284        }
3285        res->data=(void *)p;
3286        res->rtyp=POLY_CMD;
3287      }
3288      return FALSE;
3289  }
3290  WerrorS("invalid switch");
3291  return FALSE;
3292}
3293#endif
3294static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3295{
3296  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3297  return FALSE;
3298}
3299static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3300{
3301  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3302  //return (res->data== (void*)(long)-2);
3303  return FALSE;
3304}
3305static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3306{
3307  int sw = (int)(long)v->Data();
3308  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3309  poly p = (poly)u->CopyD(POLY_CMD);
3310  if (sw & SIMPL_NORM)
3311  {
3312    pNorm(p);
3313  }
3314  res->data = (char * )p;
3315  return FALSE;
3316}
3317static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3318{
3319  ideal result;
3320  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3321  tHomog hom=testHomog;
3322  ideal u_id=(ideal)(u->Data());
3323  if (w!=NULL)
3324  {
3325    if (!idTestHomModule(u_id,currQuotient,w))
3326    {
3327      WarnS("wrong weights:");w->show();PrintLn();
3328      w=NULL;
3329    }
3330    else
3331    {
3332      w=ivCopy(w);
3333      hom=isHomog;
3334    }
3335  }
3336  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3337  idSkipZeroes(result);
3338  res->data = (char *)result;
3339  setFlag(res,FLAG_STD);
3340  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3341  return FALSE;
3342}
3343static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3344static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3345/* destroys i0, p0 */
3346/* result (with attributes) in res */
3347/* i0: SB*/
3348/* t0: type of p0*/
3349/* p0 new elements*/
3350/* a attributes of i0*/
3351{
3352  int tp;
3353  if (t0==IDEAL_CMD) tp=POLY_CMD;
3354  else               tp=VECTOR_CMD;
3355  for (int i=IDELEMS(p0)-1; i>=0; i--)
3356  {
3357    poly p=p0->m[i];
3358    p0->m[i]=NULL;
3359    if (p!=NULL)
3360    {
3361      sleftv u0,v0;
3362      memset(&u0,0,sizeof(sleftv));
3363      memset(&v0,0,sizeof(sleftv));
3364      v0.rtyp=tp;
3365      v0.data=(void*)p;
3366      u0.rtyp=t0;
3367      u0.data=i0;
3368      u0.attribute=a;
3369      setFlag(&u0,FLAG_STD);
3370      jjSTD_1(res,&u0,&v0);
3371      i0=(ideal)res->data;
3372      res->data=NULL;
3373      a=res->attribute;
3374      res->attribute=NULL;
3375      u0.CleanUp();
3376      v0.CleanUp();
3377      res->CleanUp();
3378    }
3379  }
3380  idDelete(&p0);
3381  res->attribute=a;
3382  res->data=(void *)i0;
3383  res->rtyp=t0;
3384}
3385static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3386{
3387  ideal result;
3388  assumeStdFlag(u);
3389  ideal i1=(ideal)(u->Data());
3390  ideal i0;
3391  int r=v->Typ();
3392  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3393  {
3394    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3395    i0->m[0]=(poly)v->Data();
3396    int ii0=idElem(i0); /* size of i0 */
3397    i1=idSimpleAdd(i1,i0); //
3398    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3399    idDelete(&i0);
3400    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3401    tHomog hom=testHomog;
3402
3403    if (w!=NULL)
3404    {
3405      if (!idTestHomModule(i1,currQuotient,w))
3406      {
3407        // no warnung: this is legal, if i in std(i,p)
3408        // is homogeneous, but p not
3409        w=NULL;
3410      }
3411      else
3412      {
3413        w=ivCopy(w);
3414        hom=isHomog;
3415      }
3416    }
3417    BITSET save_test=test;
3418    test|=Sy_bit(OPT_SB_1);
3419    /* ii0 appears to be the position of the first element of il that
3420       does not belong to the old SB ideal */
3421    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3422    test=save_test;
3423    idDelete(&i1);
3424    idSkipZeroes(result);
3425    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3426    res->data = (char *)result;
3427  }
3428  else /*IDEAL/MODULE*/
3429  {
3430    attr *aa=u->Attribute();
3431    attr a=NULL;
3432    if (aa!=NULL) a=(*aa)->Copy();
3433    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3434  }
3435  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3436  return FALSE;
3437}
3438static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3439{
3440  idhdl h=(idhdl)u->data;
3441  int i=(int)(long)v->Data();
3442  if ((0<i) && (i<=IDRING(h)->N))
3443    res->data=omStrDup(IDRING(h)->names[i-1]);
3444  else
3445  {
3446    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3447    return TRUE;
3448  }
3449  return FALSE;
3450}
3451static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3452{
3453// input: u: a list with links of type
3454//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3455//        v: timeout for select in milliseconds
3456//           or 0 for polling
3457// returns: ERROR (via Werror): timeout negative
3458//           -1: the read state of all links is eof
3459//            0: timeout (or polling): none ready
3460//           i>0: (at least) L[i] is ready
3461  lists Lforks = (lists)u->Data();
3462  int t = (int)(long)v->Data();
3463  if(t < 0)
3464  {
3465    WerrorS("negative timeout"); return TRUE;
3466  }
3467  int i = slStatusSsiL(Lforks, t*1000);
3468  if(i == -2) /* error */
3469  {
3470    return TRUE;
3471  }
3472  res->data = (void*)(long)i;
3473  return FALSE;
3474}
3475static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3476{
3477// input: u: a list with links of type
3478//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3479//        v: timeout for select in milliseconds
3480//           or 0 for polling
3481// returns: ERROR (via Werror): timeout negative
3482//           -1: the read state of all links is eof
3483//           0: timeout (or polling): none ready
3484//           1: all links are ready
3485//              (caution: at least one is ready, but some maybe dead)
3486  lists Lforks = (lists)u->CopyD();
3487  int timeout = 1000*(int)(long)v->Data();
3488  if(timeout < 0)
3489  {
3490    WerrorS("negative timeout"); return TRUE;
3491  }
3492  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3493  int i;
3494  int ret = -1;
3495  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3496  {
3497    i = slStatusSsiL(Lforks, timeout);
3498    if(i > 0) /* Lforks[i] is ready */
3499    {
3500      ret = 1;
3501      Lforks->m[i-1].CleanUp();
3502      Lforks->m[i-1].rtyp=DEF_CMD;
3503      Lforks->m[i-1].data=NULL;
3504      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3505    }
3506    else /* terminate the for loop */
3507    {
3508      if(i == -2) /* error */
3509      {
3510        return TRUE;
3511      }
3512      if(i == 0) /* timeout */
3513      {
3514        ret = 0;
3515      }
3516      break;
3517    }
3518  }
3519  Lforks->Clean();
3520  res->data = (void*)(long)ret;
3521  return FALSE;
3522}
3523static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3524{
3525  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3526  return FALSE;
3527}
3528#define jjWRONG2 (proc2)jjWRONG
3529#define jjWRONG3 (proc3)jjWRONG
3530static BOOLEAN jjWRONG(leftv, leftv)
3531{
3532  return TRUE;
3533}
3534
3535/*=================== operations with 1 arg.: static proc =================*/
3536/* must be ordered: first operations for chars (infix ops),
3537 * then alphabetically */
3538
3539static BOOLEAN jjDUMMY(leftv res, leftv u)
3540{
3541  res->data = (char *)u->CopyD();
3542  return FALSE;
3543}
3544static BOOLEAN jjNULL(leftv, leftv)
3545{
3546  return FALSE;
3547}
3548//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3549//{
3550//  res->data = (char *)((int)(long)u->Data()+1);
3551//  return FALSE;
3552//}
3553//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3554//{
3555//  res->data = (char *)((int)(long)u->Data()-1);
3556//  return FALSE;
3557//}
3558static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3559{
3560  if (IDTYP((idhdl)u->data)==INT_CMD)
3561  {
3562    int i=IDINT((idhdl)u->data);
3563    if (iiOp==PLUSPLUS) i++;
3564    else                i--;
3565    IDDATA((idhdl)u->data)=(char *)(long)i;
3566    return FALSE;
3567  }
3568  return TRUE;
3569}
3570static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3571{
3572  number n=(number)u->CopyD(BIGINT_CMD);
3573  n=n_Neg(n,coeffs_BIGINT);
3574  res->data = (char *)n;
3575  return FALSE;
3576}
3577static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3578{
3579  res->data = (char *)(-(long)u->Data());
3580  return FALSE;
3581}
3582static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3583{
3584  number n=(number)u->CopyD(NUMBER_CMD);
3585  n=nNeg(n);
3586  res->data = (char *)n;
3587  return FALSE;
3588}
3589static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3590{
3591  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3592  return FALSE;
3593}
3594static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3595{
3596  poly m1=pISet(-1);
3597  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3598  return FALSE;
3599}
3600static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3601{
3602  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3603  (*iv)*=(-1);
3604  res->data = (char *)iv;
3605  return FALSE;
3606}
3607static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3608{
3609  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3610  (*bim)*=(-1);
3611  res->data = (char *)bim;
3612  return FALSE;
3613}
3614static BOOLEAN jjPROC1(leftv res, leftv u)
3615{
3616  return jjPROC(res,u,NULL);
3617}
3618static BOOLEAN jjBAREISS(leftv res, leftv v)
3619{
3620  //matrix m=(matrix)v->Data();
3621  //lists l=mpBareiss(m,FALSE);
3622  intvec *iv;
3623  ideal m;
3624  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3625  lists l=(lists)omAllocBin(slists_bin);
3626  l->Init(2);
3627  l->m[0].rtyp=MODUL_CMD;
3628  l->m[1].rtyp=INTVEC_CMD;
3629  l->m[0].data=(void *)m;
3630  l->m[1].data=(void *)iv;
3631  res->data = (char *)l;
3632  return FALSE;
3633}
3634//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3635//{
3636//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3637//  ivTriangMat(m);
3638//  res->data = (char *)m;
3639//  return FALSE;
3640//}
3641static BOOLEAN jjBI2N(leftv res, leftv u)
3642{
3643  BOOLEAN bo=FALSE;
3644  number n=(number)u->CopyD();
3645  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3646  if (nMap!=NULL)
3647    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3648  else
3649  {
3650    WerrorS("cannot convert bigint to this field");
3651    bo=TRUE;
3652  }
3653  n_Delete(&n,coeffs_BIGINT);
3654  return bo;
3655}
3656static BOOLEAN jjBI2P(leftv res, leftv u)
3657{
3658  sleftv tmp;
3659  BOOLEAN bo=jjBI2N(&tmp,u);
3660  if (!bo)
3661  {
3662    number n=(number) tmp.data;
3663    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3664    else
3665    {
3666      res->data=(void *)pNSet(n);
3667    }
3668  }
3669  return bo;
3670}
3671static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3672{
3673  return iiExprArithM(res,u,iiOp);
3674}
3675static BOOLEAN jjCHAR(leftv res, leftv v)
3676{
3677  res->data = (char *)(long)rChar((ring)v->Data());
3678  return FALSE;
3679}
3680static BOOLEAN jjCOLS(leftv res, leftv v)
3681{
3682  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3683  return FALSE;
3684}
3685static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3686{
3687  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3688  return FALSE;
3689}
3690static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3691{
3692  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3693  return FALSE;
3694}
3695static BOOLEAN jjCONTENT(leftv res, leftv v)
3696{
3697  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3698  poly p=(poly)v->CopyD(POLY_CMD);
3699  if (p!=NULL) p_Cleardenom(p, currRing);
3700  res->data = (char *)p;
3701  return FALSE;
3702}
3703static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3704{
3705  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3706  return FALSE;
3707}
3708static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3709{
3710  res->data = (char *)(long)nSize((number)v->Data());
3711  return FALSE;
3712}
3713static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3714{
3715  lists l=(lists)v->Data();
3716  res->data = (char *)(long)(lSize(l)+1);
3717  return FALSE;
3718}
3719static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3720{
3721  matrix m=(matrix)v->Data();
3722  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3723  return FALSE;
3724}
3725static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3726{
3727  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3728  return FALSE;
3729}
3730static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3731{
3732  ring r=(ring)v->Data();
3733  int elems=-1;
3734  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3735  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3736  {
3737#ifdef HAVE_FACTORY
3738    extern int ipower ( int b, int n ); /* factory/cf_util */
3739    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3740#else
3741    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3742#endif
3743  }
3744  res->data = (char *)(long)elems;
3745  return FALSE;
3746}
3747static BOOLEAN jjDEG(leftv res, leftv v)
3748{
3749  int dummy;
3750  poly p=(poly)v->Data();
3751  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3752  else res->data=(char *)-1;
3753  return FALSE;
3754}
3755static BOOLEAN jjDEG_M(leftv res, leftv u)
3756{
3757  ideal I=(ideal)u->Data();
3758  int d=-1;
3759  int dummy;
3760  int i;
3761  for(i=IDELEMS(I)-1;i>=0;i--)
3762    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3763  res->data = (char *)(long)d;
3764  return FALSE;
3765}
3766static BOOLEAN jjDEGREE(leftv res, leftv v)
3767{
3768  SPrintStart();
3769#ifdef HAVE_RINGS
3770  if (rField_is_Ring_Z(currRing))
3771  {
3772    ring origR = currRing;
3773    ring tempR = rCopy(origR);
3774    coeffs new_cf=nInitChar(n_Q,NULL);
3775    nKillChar(tempR->cf);
3776    tempR->cf=new_cf;
3777    rComplete(tempR);
3778    ideal vid = (ideal)v->Data();
3779    rChangeCurrRing(tempR);
3780    ideal vv = idrCopyR(vid, origR, currRing);
3781    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3782    vvAsLeftv.rtyp = IDEAL_CMD;
3783    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3784    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3785    assumeStdFlag(&vvAsLeftv);
3786    Print("// NOTE: computation of degree is being performed for\n");
3787    Print("//       generic fibre, that is, over Q\n");
3788    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3789    scDegree(vv,module_w,currQuotient);
3790    idDelete(&vv);
3791    rChangeCurrRing(origR);
3792    rDelete(tempR);
3793  }
3794#endif
3795  assumeStdFlag(v);
3796  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3797  scDegree((ideal)v->Data(),module_w,currQuotient);
3798  char *s=SPrintEnd();
3799  int l=strlen(s)-1;
3800  s[l]='\0';
3801  res->data=(void*)s;
3802  return FALSE;
3803}
3804static BOOLEAN jjDEFINED(leftv res, leftv v)
3805{
3806  if ((v->rtyp==IDHDL)
3807  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3808  {
3809    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3810  }
3811  else if (v->rtyp!=0) res->data=(void *)(-1);
3812  return FALSE;
3813}
3814
3815/// Return the denominator of the input number
3816/// NOTE: the input number is normalized as a side effect
3817static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3818{
3819  number n = reinterpret_cast<number>(v->Data());
3820  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3821  return FALSE;
3822}
3823
3824/// Return the numerator of the input number
3825/// NOTE: the input number is normalized as a side effect
3826static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3827{
3828  number n = reinterpret_cast<number>(v->Data());
3829  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3830  return FALSE;
3831}
3832
3833
3834
3835
3836#ifdef HAVE_FACTORY
3837static BOOLEAN jjDET(leftv res, leftv v)
3838{
3839  matrix m=(matrix)v->Data();
3840  poly p;
3841  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3842  {
3843    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3844    p=sm_CallDet(I, currRing);
3845    idDelete(&I);
3846  }
3847  else
3848    p=singclap_det(m,currRing);
3849  res ->data = (char *)p;
3850  return FALSE;
3851}
3852static BOOLEAN jjDET_BI(leftv res, leftv v)
3853{
3854  bigintmat * m=(bigintmat*)v->Data();
3855  int i,j;
3856  i=m->rows();j=m->cols();
3857  if(i==j)
3858    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3859  else
3860  {
3861    Werror("det of %d x %d bigintmat",i,j);
3862    return TRUE;
3863  }
3864  return FALSE;
3865}
3866static BOOLEAN jjDET_I(leftv res, leftv v)
3867{
3868  intvec * m=(intvec*)v->Data();
3869  int i,j;
3870  i=m->rows();j=m->cols();
3871  if(i==j)
3872    res->data = (char *)(long)singclap_det_i(m,currRing);
3873  else
3874  {
3875    Werror("det of %d x %d intmat",i,j);
3876    return TRUE;
3877  }
3878  return FALSE;
3879}
3880static BOOLEAN jjDET_S(leftv res, leftv v)
3881{
3882  ideal I=(ideal)v->Data();
3883  poly p;
3884  if (IDELEMS(I)<1) return TRUE;
3885  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3886  {
3887    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3888    p=singclap_det(m,currRing);
3889    idDelete((ideal *)&m);
3890  }
3891  else
3892    p=sm_CallDet(I, currRing);
3893  res->data = (char *)p;
3894  return FALSE;
3895}
3896#endif
3897static BOOLEAN jjDIM(leftv res, leftv v)
3898{
3899  assumeStdFlag(v);
3900#ifdef HAVE_RINGS
3901  if (rField_is_Ring(currRing))
3902  {
3903    ring origR = currRing;
3904    ring tempR = rCopy(origR);
3905    coeffs new_cf=nInitChar(n_Q,NULL);
3906    nKillChar(tempR->cf);
3907    tempR->cf=new_cf;
3908    rComplete(tempR);
3909    ideal vid = (ideal)v->Data();
3910    int i = idPosConstant(vid);
3911    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3912    { /* ideal v contains unit; dim = -1 */
3913      res->data = (char *)-1;
3914      return FALSE;
3915    }
3916    rChangeCurrRing(tempR);
3917    ideal vv = idrCopyR(vid, origR, currRing);
3918    /* drop degree zero generator from vv (if any) */
3919    if (i != -1) pDelete(&vv->m[i]);
3920    long d = (long)scDimInt(vv, currQuotient);
3921    if (rField_is_Ring_Z(origR) && (i == -1)) d++;
3922    res->data = (char *)d;
3923    idDelete(&vv);
3924    rChangeCurrRing(origR);
3925    rDelete(tempR);
3926    return FALSE;
3927  }
3928#endif
3929  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3930  return FALSE;
3931}
3932static BOOLEAN jjDUMP(leftv, leftv v)
3933{
3934  si_link l = (si_link)v->Data();
3935  if (slDump(l))
3936  {
3937    const char *s;
3938    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3939    else                            s=sNoName;
3940    Werror("cannot dump to `%s`",s);
3941    return TRUE;
3942  }
3943  else
3944    return FALSE;
3945}
3946static BOOLEAN jjE(leftv res, leftv v)
3947{
3948  res->data = (char *)pOne();
3949  int co=(int)(long)v->Data();
3950  if (co>0)
3951  {
3952    pSetComp((poly)res->data,co);
3953    pSetm((poly)res->data);
3954  }
3955  else WerrorS("argument of gen must be positive");
3956  return (co<=0);
3957}
3958static BOOLEAN jjEXECUTE(leftv, leftv v)
3959{
3960  char * d = (char *)v->Data();
3961  char * s = (char *)omAlloc(strlen(d) + 13);
3962  strcpy( s, (char *)d);
3963  strcat( s, "\n;RETURN();\n");
3964  newBuffer(s,BT_execute);
3965  return yyparse();
3966}
3967#ifdef HAVE_FACTORY
3968static BOOLEAN jjFACSTD(leftv res, leftv v)
3969{
3970  lists L=(lists)omAllocBin(slists_bin);
3971  if (rField_is_Zp(currRing)
3972  || rField_is_Q(currRing)
3973  || rField_is_Zp_a(currRing)
3974  || rField_is_Q_a(currRing))
3975  {
3976    ideal_list p,h;
3977    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3978    if (h==NULL)
3979    {
3980      L->Init(1);
3981      L->m[0].data=(char *)idInit(1);
3982      L->m[0].rtyp=IDEAL_CMD;
3983    }
3984    else
3985    {
3986      p=h;
3987      int l=0;
3988      while (p!=NULL) { p=p->next;l++; }
3989      L->Init(l);
3990      l=0;
3991      while(h!=NULL)
3992      {
3993        L->m[l].data=(char *)h->d;
3994        L->m[l].rtyp=IDEAL_CMD;
3995        p=h->next;
3996        omFreeSize(h,sizeof(*h));
3997        h=p;
3998        l++;
3999      }
4000    }
4001  }
4002  else
4003  {
4004    WarnS("no factorization implemented");
4005    L->Init(1);
4006    iiExprArith1(&(L->m[0]),v,STD_CMD);
4007  }
4008  res->data=(void *)L;
4009  return FALSE;
4010}
4011static BOOLEAN jjFAC_P(leftv res, leftv u)
4012{
4013  intvec *v=NULL;
4014  singclap_factorize_retry=0;
4015  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4016  if (f==NULL) return TRUE;
4017  ivTest(v);
4018  lists l=(lists)omAllocBin(slists_bin);
4019  l->Init(2);
4020  l->m[0].rtyp=IDEAL_CMD;
4021  l->m[0].data=(void *)f;
4022  l->m[1].rtyp=INTVEC_CMD;
4023  l->m[1].data=(void *)v;
4024  res->data=(void *)l;
4025  return FALSE;
4026}
4027#endif
4028static BOOLEAN jjGETDUMP(leftv, leftv v)
4029{
4030  si_link l = (si_link)v->Data();
4031  if (slGetDump(l))
4032  {
4033    const char *s;
4034    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4035    else                            s=sNoName;
4036    Werror("cannot get dump from `%s`",s);
4037    return TRUE;
4038  }
4039  else
4040    return FALSE;
4041}
4042static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4043{
4044  assumeStdFlag(v);
4045  ideal I=(ideal)v->Data();
4046  res->data=(void *)iiHighCorner(I,0);
4047  return FALSE;
4048}
4049static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4050{
4051  assumeStdFlag(v);
4052  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4053  BOOLEAN delete_w=FALSE;
4054  ideal I=(ideal)v->Data();
4055  int i;
4056  poly p=NULL,po=NULL;
4057  int rk=id_RankFreeModule(I,currRing);
4058  if (w==NULL)
4059  {
4060    w = new intvec(rk);
4061    delete_w=TRUE;
4062  }
4063  for(i=rk;i>0;i--)
4064  {
4065    p=iiHighCorner(I,i);
4066    if (p==NULL)
4067    {
4068      WerrorS("module must be zero-dimensional");
4069      if (delete_w) delete w;
4070      return TRUE;
4071    }
4072    if (po==NULL)
4073    {
4074      po=p;
4075    }
4076    else
4077    {
4078      // now po!=NULL, p!=NULL
4079      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4080      if (d==0)
4081        d=pLmCmp(po,p);
4082      if (d > 0)
4083      {
4084        pDelete(&p);
4085      }
4086      else // (d < 0)
4087      {
4088        pDelete(&po); po=p;
4089      }
4090    }
4091  }
4092  if (delete_w) delete w;
4093  res->data=(void *)po;
4094  return FALSE;
4095}
4096static BOOLEAN jjHILBERT(leftv, leftv v)
4097{
4098#ifdef HAVE_RINGS
4099  if (rField_is_Ring_Z(currRing))
4100  {
4101    ring origR = currRing;
4102    ring tempR = rCopy(origR);
4103    coeffs new_cf=nInitChar(n_Q,NULL);
4104    nKillChar(tempR->cf);
4105    tempR->cf=new_cf;
4106    rComplete(tempR);
4107    ideal vid = (ideal)v->Data();
4108    rChangeCurrRing(tempR);
4109    ideal vv = idrCopyR(vid, origR, currRing);
4110    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4111    vvAsLeftv.rtyp = IDEAL_CMD;
4112    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4113    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4114    assumeStdFlag(&vvAsLeftv);
4115    Print("// NOTE: computation of Hilbert series etc. is being\n");
4116    Print("//       performed for generic fibre, that is, over Q\n");
4117    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4118    //scHilbertPoly(vv,currQuotient);
4119    hLookSeries(vv,module_w,currQuotient);
4120    idDelete(&vv);
4121    rChangeCurrRing(origR);
4122    rDelete(tempR);
4123    return FALSE;
4124  }
4125#endif
4126  assumeStdFlag(v);
4127  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4128  //scHilbertPoly((ideal)v->Data(),currQuotient);
4129  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4130  return FALSE;
4131}
4132static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4133{
4134#ifdef HAVE_RINGS
4135  if (rField_is_Ring_Z(currRing))
4136  {
4137    Print("// NOTE: computation of Hilbert series etc. is being\n");
4138    Print("//       performed for generic fibre, that is, over Q\n");
4139  }
4140#endif
4141  res->data=(void *)hSecondSeries((intvec *)v->Data());
4142  return FALSE;
4143}
4144static BOOLEAN jjHOMOG1(leftv res, leftv v)
4145{
4146  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4147  ideal v_id=(ideal)v->Data();
4148  if (w==NULL)
4149  {
4150    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4151    if (res->data!=NULL)
4152    {
4153      if (v->rtyp==IDHDL)
4154      {
4155        char *s_isHomog=omStrDup("isHomog");
4156        if (v->e==NULL)
4157          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4158        else
4159          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4160      }
4161      else if (w!=NULL) delete w;
4162    } // if res->data==NULL then w==NULL
4163  }
4164  else
4165  {
4166    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4167    if((res->data==NULL) && (v->rtyp==IDHDL))
4168    {
4169      if (v->e==NULL)
4170        atKill((idhdl)(v->data),"isHomog");
4171      else
4172        atKill((idhdl)(v->LData()),"isHomog");
4173    }
4174  }
4175  return FALSE;
4176}
4177static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4178{
4179  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4180  setFlag(res,FLAG_STD);
4181  return FALSE;
4182}
4183static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4184{
4185  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4186  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4187  if (IDELEMS((ideal)mat)==0)
4188  {
4189    idDelete((ideal *)&mat);
4190    mat=(matrix)idInit(1,1);
4191  }
4192  else
4193  {
4194    MATROWS(mat)=1;
4195    mat->rank=1;
4196    idTest((ideal)mat);
4197  }
4198  res->data=(char *)mat;
4199  return FALSE;
4200}
4201static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4202{
4203  map m=(map)v->CopyD(MAP_CMD);
4204  omFree((ADDRESS)m->preimage);
4205  m->preimage=NULL;
4206  ideal I=(ideal)m;
4207  I->rank=1;
4208  res->data=(char *)I;
4209  return FALSE;
4210}
4211static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4212{
4213  if (currRing!=NULL)
4214  {
4215    ring q=(ring)v->Data();
4216    if (rSamePolyRep(currRing, q))
4217    {
4218      if (q->qideal==NULL)
4219        res->data=(char *)idInit(1,1);
4220      else
4221        res->data=(char *)idCopy(q->qideal);
4222      return FALSE;
4223    }
4224  }
4225  WerrorS("can only get ideal from identical qring");
4226  return TRUE;
4227}
4228static BOOLEAN jjIm2Iv(leftv res, leftv v)
4229{
4230  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4231  iv->makeVector();
4232  res->data = iv;
4233  return FALSE;
4234}
4235static BOOLEAN jjIMPART(leftv res, leftv v)
4236{
4237  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4238  return FALSE;
4239}
4240static BOOLEAN jjINDEPSET(leftv res, leftv v)
4241{
4242  assumeStdFlag(v);
4243  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4244  return FALSE;
4245}
4246static BOOLEAN jjINTERRED(leftv res, leftv v)
4247{
4248  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4249  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4250  res->data = result;
4251  return FALSE;
4252}
4253static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4254{
4255  res->data = (char *)(long)pVar((poly)v->Data());
4256  return FALSE;
4257}
4258static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4259{
4260  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4261  return FALSE;
4262}
4263static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4264{
4265  res->data = (char *)0;
4266  return FALSE;
4267}
4268static BOOLEAN jjJACOB_P(leftv res, leftv v)
4269{
4270  ideal i=idInit(currRing->N,1);
4271  int k;
4272  poly p=(poly)(v->Data());
4273  for (k=currRing->N;k>0;k--)
4274  {
4275    i->m[k-1]=pDiff(p,k);
4276  }
4277  res->data = (char *)i;
4278  return FALSE;
4279}
4280/*2
4281 * compute Jacobi matrix of a module/matrix
4282 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4283 * where Mt := transpose(M)
4284 * Note that this is consistent with the current conventions for jacob in Singular,
4285 * whereas M2 computes its transposed.
4286 */
4287static BOOLEAN jjJACOB_M(leftv res, leftv a)
4288{
4289  ideal id = (ideal)a->Data();
4290  id = idTransp(id);
4291  int W = IDELEMS(id);
4292
4293  ideal result = idInit(W * currRing->N, id->rank);
4294  poly *p = result->m;
4295
4296  for( int v = 1; v <= currRing->N; v++ )
4297  {
4298    poly* q = id->m;
4299    for( int i = 0; i < W; i++, p++, q++ )
4300      *p = pDiff( *q, v );
4301  }
4302  idDelete(&id);
4303
4304  res->data = (char *)result;
4305  return FALSE;
4306}
4307
4308
4309static BOOLEAN jjKBASE(leftv res, leftv v)
4310{
4311  assumeStdFlag(v);
4312  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4313  return FALSE;
4314}
4315#ifdef MDEBUG
4316static BOOLEAN jjpHead(leftv res, leftv v)
4317{
4318  res->data=(char *)pHead((poly)v->Data());
4319  return FALSE;
4320}
4321#endif
4322static BOOLEAN jjL2R(leftv res, leftv v)
4323{
4324  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4325  if (res->data != NULL)
4326    return FALSE;
4327  else
4328    return TRUE;
4329}
4330static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4331{
4332  poly p=(poly)v->Data();
4333  if (p==NULL)
4334  {
4335    res->data=(char *)nInit(0);
4336  }
4337  else
4338  {
4339    res->data=(char *)nCopy(pGetCoeff(p));
4340  }
4341  return FALSE;
4342}
4343static BOOLEAN jjLEADEXP(leftv res, leftv v)
4344{
4345  poly p=(poly)v->Data();
4346  int s=currRing->N;
4347  if (v->Typ()==VECTOR_CMD) s++;
4348  intvec *iv=new intvec(s);
4349  if (p!=NULL)
4350  {
4351    for(int i = currRing->N;i;i--)
4352    {
4353      (*iv)[i-1]=pGetExp(p,i);
4354    }
4355    if (s!=currRing->N)
4356      (*iv)[currRing->N]=pGetComp(p);
4357  }
4358  res->data=(char *)iv;
4359  return FALSE;
4360}
4361static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4362{
4363  poly p=(poly)v->Data();
4364  if (p == NULL)
4365  {
4366    res->data = (char*) NULL;
4367  }
4368  else
4369  {
4370    poly lm = pLmInit(p);
4371    pSetCoeff(lm, nInit(1));
4372    res->data = (char*) lm;
4373  }
4374  return FALSE;
4375}
4376static BOOLEAN jjLOAD1(leftv res, leftv v)
4377{
4378  return jjLOAD(res, v,FALSE);
4379}
4380static BOOLEAN jjLISTRING(leftv res, leftv v)
4381{
4382  ring r=rCompose((lists)v->Data());
4383  if (r==NULL) return TRUE;
4384  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4385  res->data=(char *)r;
4386  return FALSE;
4387}
4388#if SIZEOF_LONG == 8
4389static number jjLONG2N(long d)
4390{
4391  int i=(int)d;
4392  if ((long)i == d)
4393  {
4394    return n_Init(i, coeffs_BIGINT);
4395  }
4396  else
4397  {
4398     struct snumber_dummy
4399     {
4400      mpz_t z;
4401      mpz_t n;
4402      #if defined(LDEBUG)
4403      int debug;
4404      #endif
4405      BOOLEAN s;
4406    };
4407    typedef struct snumber_dummy  *number_dummy;
4408
4409    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4410    #if defined(LDEBUG)
4411    z->debug=123456;
4412    #endif
4413    z->s=3;
4414    mpz_init_set_si(z->z,d);
4415    return (number)z;
4416  }
4417}
4418#else
4419#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4420#endif
4421static BOOLEAN jjPFAC1(leftv res, leftv v)
4422{
4423  /* call method jjPFAC2 with second argument = 0 (meaning that no
4424     valid bound for the prime factors has been given) */
4425  sleftv tmp;
4426  memset(&tmp, 0, sizeof(tmp));
4427  tmp.rtyp = INT_CMD;
4428  return jjPFAC2(res, v, &tmp);
4429}
4430static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4431{
4432  /* computes the LU-decomposition of a matrix M;
4433     i.e., M = P * L * U, where
4434        - P is a row permutation matrix,
4435        - L is in lower triangular form,
4436        - U is in upper row echelon form
4437     Then, we also have P * M = L * U.
4438     A list [P, L, U] is returned. */
4439  matrix mat = (const matrix)v->Data();
4440  if (!idIsConstant((ideal)mat))
4441  {
4442    WerrorS("matrix must be constant");
4443    return TRUE;
4444  }
4445  matrix pMat;
4446  matrix lMat;
4447  matrix uMat;
4448
4449  luDecomp(mat, pMat, lMat, uMat);
4450
4451  lists ll = (lists)omAllocBin(slists_bin);
4452  ll->Init(3);
4453  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4454  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4455  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4456  res->data=(char*)ll;
4457
4458  return FALSE;
4459}
4460static BOOLEAN jjMEMORY(leftv res, leftv v)
4461{
4462  omUpdateInfo();
4463  switch(((int)(long)v->Data()))
4464  {
4465  case 0:
4466    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4467    break;
4468  case 1:
4469    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4470    break;
4471  case 2:
4472    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4473    break;
4474  default:
4475    omPrintStats(stdout);
4476    omPrintInfo(stdout);
4477    omPrintBinStats(stdout);
4478    res->data = (char *)0;
4479    res->rtyp = NONE;
4480  }
4481  return FALSE;
4482  res->data = (char *)0;
4483  return FALSE;
4484}
4485//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4486//{
4487//  return jjMONITOR2(res,v,NULL);
4488//}
4489static BOOLEAN jjMSTD(leftv res, leftv v)
4490{
4491  int t=v->Typ();
4492  ideal r,m;
4493  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4494  lists l=(lists)omAllocBin(slists_bin);
4495  l->Init(2);
4496  l->m[0].rtyp=t;
4497  l->m[0].data=(char *)r;
4498  setFlag(&(l->m[0]),FLAG_STD);
4499  l->m[1].rtyp=t;
4500  l->m[1].data=(char *)m;
4501  res->data=(char *)l;
4502  return FALSE;
4503}
4504static BOOLEAN jjMULT(leftv res, leftv v)
4505{
4506  assumeStdFlag(v);
4507  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4508  return FALSE;
4509}
4510static BOOLEAN jjMINRES_R(leftv res, leftv v)
4511{
4512  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4513
4514  syStrategy tmp=(syStrategy)v->Data();
4515  tmp = syMinimize(tmp); // enrich itself!
4516
4517  res->data=(char *)tmp;
4518
4519  if (weights!=NULL)
4520    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4521
4522  return FALSE;
4523}
4524static BOOLEAN jjN2BI(leftv res, leftv v)
4525{
4526  number n,i; i=(number)v->Data();
4527  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4528  if (nMap!=NULL)
4529    n=nMap(i,currRing->cf,coeffs_BIGINT);
4530  else goto err;
4531  res->data=(void *)n;
4532  return FALSE;
4533err:
4534  WerrorS("cannot convert to bigint"); return TRUE;
4535}
4536static BOOLEAN jjNAMEOF(leftv res, leftv v)
4537{
4538  res->data = (char *)v->name;
4539  if (res->data==NULL) res->data=omStrDup("");
4540  v->name=NULL;
4541  return FALSE;
4542}
4543static BOOLEAN jjNAMES(leftv res, leftv v)
4544{
4545  res->data=ipNameList(((ring)v->Data())->idroot);
4546  return FALSE;
4547}
4548static BOOLEAN jjNVARS(leftv res, leftv v)
4549{
4550  res->data = (char *)(long)(((ring)(v->Data()))->N);
4551  return FALSE;
4552}
4553static BOOLEAN jjOpenClose(leftv, leftv v)
4554{
4555  si_link l=(si_link)v->Data();
4556  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4557  else                return slClose(l);
4558}
4559static BOOLEAN jjORD(leftv res, leftv v)
4560{
4561  poly p=(poly)v->Data();
4562  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4563  return FALSE;
4564}
4565static BOOLEAN jjPAR1(leftv res, leftv v)
4566{
4567  int i=(int)(long)v->Data();
4568  int p=0;
4569  p=rPar(currRing);
4570  if ((0<i) && (i<=p))
4571  {
4572    res->data=(char *)n_Param(i,currRing);
4573  }
4574  else
4575  {
4576    Werror("par number %d out of range 1..%d",i,p);
4577    return TRUE;
4578  }
4579  return FALSE;
4580}
4581static BOOLEAN jjPARDEG(leftv res, leftv v)
4582{
4583  number nn=(number)v->Data();
4584  res->data = (char *)(long)n_ParDeg(nn, currRing);
4585  return FALSE;
4586}
4587static BOOLEAN jjPARSTR1(leftv res, leftv v)
4588{
4589  if (currRing==NULL)
4590  {
4591    WerrorS("no ring active");
4592    return TRUE;
4593  }
4594  int i=(int)(long)v->Data();
4595  int p=0;
4596  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4597    res->data=omStrDup(rParameter(currRing)[i-1]);
4598  else
4599  {
4600    Werror("par number %d out of range 1..%d",i,p);
4601    return TRUE;
4602  }
4603  return FALSE;
4604}
4605static BOOLEAN jjP2BI(leftv res, leftv v)
4606{
4607  poly p=(poly)v->Data();
4608  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4609  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4610  {
4611    WerrorS("poly must be constant");
4612    return TRUE;
4613  }
4614  number i=pGetCoeff(p);
4615  number n;
4616  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4617  if (nMap!=NULL)
4618    n=nMap(i,currRing->cf,coeffs_BIGINT);
4619  else goto err;
4620  res->data=(void *)n;
4621  return FALSE;
4622err:
4623  WerrorS("cannot convert to bigint"); return TRUE;
4624}
4625static BOOLEAN jjP2I(leftv res, leftv v)
4626{
4627  poly p=(poly)v->Data();
4628  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4629  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4630  {
4631    WerrorS("poly must be constant");
4632    return TRUE;
4633  }
4634  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4635  return FALSE;
4636}
4637static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4638{
4639  map mapping=(map)v->Data();
4640  syMake(res,omStrDup(mapping->preimage));
4641  return FALSE;
4642}
4643static BOOLEAN jjPRIME(leftv res, leftv v)
4644{
4645  int i = IsPrime((int)(long)(v->Data()));
4646  res->data = (char *)(long)(i > 1 ? i : 2);
4647  return FALSE;
4648}
4649static BOOLEAN jjPRUNE(leftv res, leftv v)
4650{
4651  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4652  ideal v_id=(ideal)v->Data();
4653  if (w!=NULL)
4654  {
4655    if (!idTestHomModule(v_id,currQuotient,w))
4656    {
4657      WarnS("wrong weights");
4658      w=NULL;
4659      // and continue at the non-homog case below
4660    }
4661    else
4662    {
4663      w=ivCopy(w);
4664      intvec **ww=&w;
4665      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4666      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4667      return FALSE;
4668    }
4669  }
4670  res->data = (char *)idMinEmbedding(v_id);
4671  return FALSE;
4672}
4673static BOOLEAN jjP2N(leftv res, leftv v)
4674{
4675  number n;
4676  poly p;
4677  if (((p=(poly)v->Data())!=NULL)
4678  && (pIsConstant(p)))
4679  {
4680    n=nCopy(pGetCoeff(p));
4681  }
4682  else
4683  {
4684    n=nInit(0);
4685  }
4686  res->data = (char *)n;
4687  return FALSE;
4688}
4689static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4690{
4691  char *s= (char *)v->Data();
4692  int i = 1;
4693  for(i=0; i<sArithBase.nCmdUsed; i++)
4694  {
4695    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4696    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4697    {
4698      res->data = (char *)1;
4699      return FALSE;
4700    }
4701  }
4702  //res->data = (char *)0;
4703  return FALSE;
4704}
4705static BOOLEAN jjRANK1(leftv res, leftv v)
4706{
4707  matrix m =(matrix)v->Data();
4708  int rank = luRank(m, 0);
4709  res->data =(char *)(long)rank;
4710  return FALSE;
4711}
4712static BOOLEAN jjREAD(leftv res, leftv v)
4713{
4714  return jjREAD2(res,v,NULL);
4715}
4716static BOOLEAN jjREGULARITY(leftv res, leftv v)
4717{
4718  res->data = (char *)(long)iiRegularity((lists)v->Data());
4719  return FALSE;
4720}
4721static BOOLEAN jjREPART(leftv res, leftv v)
4722{
4723  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4724  return FALSE;
4725}
4726static BOOLEAN jjRINGLIST(leftv res, leftv v)
4727{
4728  ring r=(ring)v->Data();
4729  if (r!=NULL)
4730    res->data = (char *)rDecompose((ring)v->Data());
4731  return (r==NULL)||(res->data==NULL);
4732}
4733static BOOLEAN jjROWS(leftv res, leftv v)
4734{
4735  ideal i = (ideal)v->Data();
4736  res->data = (char *)i->rank;
4737  return FALSE;
4738}
4739static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4740{
4741  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4742  return FALSE;
4743}
4744static BOOLEAN jjROWS_IV(leftv res, leftv v)
4745{
4746  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4747  return FALSE;
4748}
4749static BOOLEAN jjRPAR(leftv res, leftv v)
4750{
4751  res->data = (char *)(long)rPar(((ring)v->Data()));
4752  return FALSE;
4753}
4754static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4755{
4756#ifdef HAVE_PLURAL
4757  const bool bIsSCA = rIsSCA(currRing);
4758#else
4759  const bool bIsSCA = false;
4760#endif
4761
4762  if ((currQuotient!=NULL) && !bIsSCA)
4763  {
4764    WerrorS("qring not supported by slimgb at the moment");
4765    return TRUE;
4766  }
4767  if (rHasLocalOrMixedOrdering_currRing())
4768  {
4769    WerrorS("ordering must be global for slimgb");
4770    return TRUE;
4771  }
4772  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4773  tHomog hom=testHomog;
4774  ideal u_id=(ideal)u->Data();
4775  if (w!=NULL)
4776  {
4777    if (!idTestHomModule(u_id,currQuotient,w))
4778    {
4779      WarnS("wrong weights");
4780      w=NULL;
4781    }
4782    else
4783    {
4784      w=ivCopy(w);
4785      hom=isHomog;
4786    }
4787  }
4788
4789  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4790  res->data=(char *)t_rep_gb(currRing,
4791    u_id,u_id->rank);
4792  //res->data=(char *)t_rep_gb(currRing, u_id);
4793
4794  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4795  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4796  return FALSE;
4797}
4798static BOOLEAN jjSBA(leftv res, leftv v)
4799{
4800  ideal result;
4801  ideal v_id=(ideal)v->Data();
4802  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4803  tHomog hom=testHomog;
4804  if (w!=NULL)
4805  {
4806    if (!idTestHomModule(v_id,currQuotient,w))
4807    {
4808      WarnS("wrong weights");
4809      w=NULL;
4810    }
4811    else
4812    {
4813      hom=isHomog;
4814      w=ivCopy(w);
4815    }
4816  }
4817  result=kSba(v_id,currQuotient,hom,&w,1,0);
4818  idSkipZeroes(result);
4819  res->data = (char *)result;
4820  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4821  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4822  return FALSE;
4823}
4824static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4825{
4826  ideal result;
4827  ideal v_id=(ideal)v->Data();
4828  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4829  tHomog hom=testHomog;
4830  if (w!=NULL)
4831  {
4832    if (!idTestHomModule(v_id,currQuotient,w))
4833    {
4834      WarnS("wrong weights");
4835      w=NULL;
4836    }
4837    else
4838    {
4839      hom=isHomog;
4840      w=ivCopy(w);
4841    }
4842  }
4843  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4844  idSkipZeroes(result);
4845  res->data = (char *)result;
4846  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4847  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4848  return FALSE;
4849}
4850static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4851{
4852  ideal result;
4853  ideal v_id=(ideal)v->Data();
4854  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4855  tHomog hom=testHomog;
4856  if (w!=NULL)
4857  {
4858    if (!idTestHomModule(v_id,currQuotient,w))
4859    {
4860      WarnS("wrong weights");
4861      w=NULL;
4862    }
4863    else
4864    {
4865      hom=isHomog;
4866      w=ivCopy(w);
4867    }
4868  }
4869  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4870  idSkipZeroes(result);
4871  res->data = (char *)result;
4872  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4873  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4874  return FALSE;
4875}
4876static BOOLEAN jjSTD(leftv res, leftv v)
4877{
4878  ideal result;
4879  ideal v_id=(ideal)v->Data();
4880  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4881  tHomog hom=testHomog;
4882  if (w!=NULL)
4883  {
4884    if (!idTestHomModule(v_id,currQuotient,w))
4885    {
4886      WarnS("wrong weights");
4887      w=NULL;
4888    }
4889    else
4890    {
4891      hom=isHomog;
4892      w=ivCopy(w);
4893    }
4894  }
4895  result=kStd(v_id,currQuotient,hom,&w);
4896  idSkipZeroes(result);
4897  res->data = (char *)result;
4898  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4899  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4900  return FALSE;
4901}
4902static BOOLEAN jjSort_Id(leftv res, leftv v)
4903{
4904  res->data = (char *)idSort((ideal)v->Data());
4905  return FALSE;
4906}
4907#ifdef HAVE_FACTORY
4908static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4909{
4910  singclap_factorize_retry=0;
4911  intvec *v=NULL;
4912  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4913  if (f==NULL) return TRUE;
4914  ivTest(v);
4915  lists l=(lists)omAllocBin(slists_bin);
4916  l->Init(2);
4917  l->m[0].rtyp=IDEAL_CMD;
4918  l->m[0].data=(void *)f;
4919  l->m[1].rtyp=INTVEC_CMD;
4920  l->m[1].data=(void *)v;
4921  res->data=(void *)l;
4922  return FALSE;
4923}
4924#endif
4925#if 1
4926static BOOLEAN jjSYZYGY(leftv res, leftv v)
4927{
4928  intvec *w=NULL;
4929  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4930  if (w!=NULL) delete w;
4931  return FALSE;
4932}
4933#else
4934// activate, if idSyz handle module weights correctly !
4935static BOOLEAN jjSYZYGY(leftv res, leftv v)
4936{
4937  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4938  ideal v_id=(ideal)v->Data();
4939  tHomog hom=testHomog;
4940  int add_row_shift=0;
4941  if (w!=NULL)
4942  {
4943    w=ivCopy(w);
4944    add_row_shift=w->min_in();
4945    (*w)-=add_row_shift;
4946    if (idTestHomModule(v_id,currQuotient,w))
4947      hom=isHomog;
4948    else
4949    {
4950      //WarnS("wrong weights");
4951      delete w; w=NULL;
4952      hom=testHomog;
4953    }
4954  }
4955  res->data = (char *)idSyzygies(v_id,hom,&w);
4956  if (w!=NULL)
4957  {
4958    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4959  }
4960  return FALSE;
4961}
4962#endif
4963static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4964{
4965  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4966  return FALSE;
4967}
4968static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
4969{
4970  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
4971  return FALSE;
4972}
4973static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4974{
4975  res->data = (char *)ivTranp((intvec*)(v->Data()));
4976  return FALSE;
4977}
4978#ifdef HAVE_PLURAL
4979static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4980{
4981  ring    r = (ring)a->Data();
4982  //if (rIsPluralRing(r))
4983  if (r->OrdSgn==1)
4984  {
4985    res->data = rOpposite(r);
4986  }
4987  else
4988  {
4989    WarnS("opposite only for global orderings");
4990    res->data = rCopy(r);
4991  }
4992  return FALSE;
4993}
4994static BOOLEAN jjENVELOPE(leftv res, leftv a)
4995{
4996  ring    r = (ring)a->Data();
4997  if (rIsPluralRing(r))
4998  {
4999    //    ideal   i;
5000//     if (a->rtyp == QRING_CMD)
5001//     {
5002//       i = r->qideal;
5003//       r->qideal = NULL;
5004//     }
5005    ring s = rEnvelope(r);
5006//     if (a->rtyp == QRING_CMD)
5007//     {
5008//       ideal is  = idOppose(r,i); /* twostd? */
5009//       is        = idAdd(is,i);
5010//       s->qideal = i;
5011//     }
5012    res->data = s;
5013  }
5014  else  res->data = rCopy(r);
5015  return FALSE;
5016}
5017static BOOLEAN jjTWOSTD(leftv res, leftv a)
5018{
5019  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5020  else  res->data=(ideal)a->CopyD();
5021  setFlag(res,FLAG_STD);
5022  setFlag(res,FLAG_TWOSTD);
5023  return FALSE;
5024}
5025#endif
5026
5027static BOOLEAN jjTYPEOF(leftv res, leftv v)
5028{
5029  int t=(int)(long)v->data;
5030  switch (t)
5031  {
5032    case INT_CMD:        res->data=omStrDup("int"); break;
5033    case POLY_CMD:       res->data=omStrDup("poly"); break;
5034    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5035    case STRING_CMD:     res->data=omStrDup("string"); break;
5036    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5037    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5038    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5039    case MODUL_CMD:      res->data=omStrDup("module"); break;
5040    case MAP_CMD:        res->data=omStrDup("map"); break;
5041    case PROC_CMD:       res->data=omStrDup("proc"); break;
5042    case RING_CMD:       res->data=omStrDup("ring"); break;
5043    case QRING_CMD:      res->data=omStrDup("qring"); break;
5044    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5045    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5046    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5047    case LIST_CMD:       res->data=omStrDup("list"); break;
5048    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5049    case LINK_CMD:       res->data=omStrDup("link"); break;
5050    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5051    case DEF_CMD:
5052    case NONE:           res->data=omStrDup("none"); break;
5053    default:
5054    {
5055      if (t>MAX_TOK)
5056        res->data=omStrDup(getBlackboxName(t));
5057      else
5058        res->data=omStrDup("?unknown type?");
5059      break;
5060    }
5061  }
5062  return FALSE;
5063}
5064static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5065{
5066  res->data=(char *)pIsUnivariate((poly)v->Data());
5067  return FALSE;
5068}
5069static BOOLEAN jjVAR1(leftv res, leftv v)
5070{
5071  int i=(int)(long)v->Data();
5072  if ((0<i) && (i<=currRing->N))
5073  {
5074    poly p=pOne();
5075    pSetExp(p,i,1);
5076    pSetm(p);
5077    res->data=(char *)p;
5078  }
5079  else
5080  {
5081    Werror("var number %d out of range 1..%d",i,currRing->N);
5082    return TRUE;
5083  }
5084  return FALSE;
5085}
5086static BOOLEAN jjVARSTR1(leftv res, leftv v)
5087{
5088  if (currRing==NULL)
5089  {
5090    WerrorS("no ring active");
5091    return TRUE;
5092  }
5093  int i=(int)(long)v->Data();
5094  if ((0<i) && (i<=currRing->N))
5095    res->data=omStrDup(currRing->names[i-1]);
5096  else
5097  {
5098    Werror("var number %d out of range 1..%d",i,currRing->N);
5099    return TRUE;
5100  }
5101  return FALSE;
5102}
5103static BOOLEAN jjVDIM(leftv res, leftv v)
5104{
5105  assumeStdFlag(v);
5106  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5107  return FALSE;
5108}
5109BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5110{
5111// input: u: a list with links of type
5112//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5113// returns: -1:  the read state of all links is eof
5114//          i>0: (at least) u[i] is ready
5115  lists Lforks = (lists)u->Data();
5116  int i = slStatusSsiL(Lforks, -1);
5117  if(i == -2) /* error */
5118  {
5119    return TRUE;
5120  }
5121  res->data = (void*)(long)i;
5122  return FALSE;
5123}
5124BOOLEAN jjWAITALL1(leftv res, leftv u)
5125{
5126// input: u: a list with links of type
5127//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5128// returns: -1: the read state of all links is eof
5129//           1: all links are ready
5130//              (caution: at least one is ready, but some maybe dead)
5131  lists Lforks = (lists)u->CopyD();
5132  int i;
5133  int j = -1;
5134  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5135  {
5136    i = slStatusSsiL(Lforks, -1);
5137    if(i == -2) /* error */
5138    {
5139      return TRUE;
5140    }
5141    if(i == -1)
5142    {
5143      break;
5144    }
5145    j = 1;
5146    Lforks->m[i-1].CleanUp();
5147    Lforks->m[i-1].rtyp=DEF_CMD;
5148    Lforks->m[i-1].data=NULL;
5149  }
5150  res->data = (void*)(long)j;
5151  Lforks->Clean();
5152  return FALSE;
5153}
5154static BOOLEAN jjLOAD(leftv, leftv v, BOOLEAN autoexport)
5155{
5156  char * s=(char *)v->CopyD();
5157  char libnamebuf[256];
5158  lib_types LT = type_of_LIB(s, libnamebuf);
5159#ifdef HAVE_DYNAMIC_LOADING
5160  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5161#endif /* HAVE_DYNAMIC_LOADING */
5162  switch(LT)
5163  {
5164      default:
5165      case LT_NONE:
5166        Werror("%s: unknown type", s);
5167        break;
5168      case LT_NOTFOUND:
5169        Werror("cannot open %s", s);
5170        break;
5171
5172      case LT_SINGULAR:
5173      {
5174        char *plib = iiConvName(s);
5175        idhdl pl = IDROOT->get(plib,0);
5176        if (pl==NULL)
5177        {
5178          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5179          IDPACKAGE(pl)->language = LANG_SINGULAR;
5180          IDPACKAGE(pl)->libname=omStrDup(plib);
5181        }
5182        else if (IDTYP(pl)!=PACKAGE_CMD)
5183        {
5184          Werror("can not create package `%s`",plib);
5185          omFree(plib);
5186          return TRUE;
5187        }
5188        package savepack=currPack;
5189        currPack=IDPACKAGE(pl);
5190        IDPACKAGE(pl)->loaded=TRUE;
5191        char libnamebuf[256];
5192        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5193        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5194        currPack=savepack;
5195        IDPACKAGE(pl)->loaded=(!bo);
5196        return bo;
5197      }
5198      case LT_MACH_O:
5199      case LT_ELF:
5200      case LT_HPUX:
5201#ifdef HAVE_DYNAMIC_LOADING
5202        return load_modules(s, libnamebuf, autoexport);
5203#else /* HAVE_DYNAMIC_LOADING */
5204        WerrorS("Dynamic modules are not supported by this version of Singular");
5205        break;
5206#endif /* HAVE_DYNAMIC_LOADING */
5207  }
5208  return TRUE;
5209}
5210
5211#ifdef INIT_BUG
5212#define XS(A) -((short)A)
5213#define jjstrlen       (proc1)1
5214#define jjpLength      (proc1)2
5215#define jjidElem       (proc1)3
5216#define jjmpDetBareiss (proc1)4
5217#define jjidFreeModule (proc1)5
5218#define jjidVec2Ideal  (proc1)6
5219#define jjrCharStr     (proc1)7
5220#ifndef MDEBUG
5221#define jjpHead        (proc1)8
5222#endif
5223#define jjidMinBase    (proc1)11
5224#define jjsyMinBase    (proc1)12
5225#define jjpMaxComp     (proc1)13
5226#define jjmpTrace      (proc1)14
5227#define jjmpTransp     (proc1)15
5228#define jjrOrdStr      (proc1)16
5229#define jjrVarStr      (proc1)18
5230#define jjrParStr      (proc1)19
5231#define jjCOUNT_RES    (proc1)22
5232#define jjDIM_R        (proc1)23
5233#define jjidTransp     (proc1)24
5234
5235extern struct sValCmd1 dArith1[];
5236void jjInitTab1()
5237{
5238  int i=0;
5239  for (;dArith1[i].cmd!=0;i++)
5240  {
5241    if (dArith1[i].res<0)
5242    {
5243      switch ((int)dArith1[i].p)
5244      {
5245        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5246        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5247        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5248        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5249#ifndef HAVE_FACTORY
5250        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5251#endif
5252        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5253        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5254#ifndef MDEBUG
5255        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5256#endif
5257        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5258        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5259        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5260        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5261        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5262        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5263        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5264        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5265        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5266        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5267        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5268        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5269      }
5270    }
5271  }
5272}
5273#else
5274#if defined(PROC_BUG)
5275#define XS(A) A
5276static BOOLEAN jjstrlen(leftv res, leftv v)
5277{
5278  res->data = (char *)strlen((char *)v->Data());
5279  return FALSE;
5280}
5281static BOOLEAN jjpLength(leftv res, leftv v)
5282{
5283  res->data = (char *)pLength((poly)v->Data());
5284  return FALSE;
5285}
5286static BOOLEAN jjidElem(leftv res, leftv v)
5287{
5288  res->data = (char *)idElem((ideal)v->Data());
5289  return FALSE;
5290}
5291static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5292{
5293  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5294  return FALSE;
5295}
5296static BOOLEAN jjidFreeModule(leftv res, leftv v)
5297{
5298  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5299  return FALSE;
5300}
5301static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5302{
5303  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5304  return FALSE;
5305}
5306static BOOLEAN jjrCharStr(leftv res, leftv v)
5307{
5308  res->data = rCharStr((ring)v->Data());
5309  return FALSE;
5310}
5311#ifndef MDEBUG
5312static BOOLEAN jjpHead(leftv res, leftv v)
5313{
5314  res->data = (char *)pHead((poly)v->Data());
5315  return FALSE;
5316}
5317#endif
5318static BOOLEAN jjidHead(leftv res, leftv v)
5319{
5320  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5321  return FALSE;
5322}
5323static BOOLEAN jjidMinBase(leftv res, leftv v)
5324{
5325  res->data = (char *)idMinBase((ideal)v->Data());
5326  return FALSE;
5327}
5328static BOOLEAN jjsyMinBase(leftv res, leftv v)
5329{
5330  res->data = (char *)syMinBase((ideal)v->Data());
5331  return FALSE;
5332}
5333static BOOLEAN jjpMaxComp(leftv res, leftv v)
5334{
5335  res->data = (char *)pMaxComp((poly)v->Data());
5336  return FALSE;
5337}
5338static BOOLEAN jjmpTrace(leftv res, leftv v)
5339{
5340  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5341  return FALSE;
5342}
5343static BOOLEAN jjmpTransp(leftv res, leftv v)
5344{
5345  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5346  return FALSE;
5347}
5348static BOOLEAN jjrOrdStr(leftv res, leftv v)
5349{
5350  res->data = rOrdStr((ring)v->Data());
5351  return FALSE;
5352}
5353static BOOLEAN jjrVarStr(leftv res, leftv v)
5354{
5355  res->data = rVarStr((ring)v->Data());
5356  return FALSE;
5357}
5358static BOOLEAN jjrParStr(leftv res, leftv v)
5359{
5360  res->data = rParStr((ring)v->Data());
5361  return FALSE;
5362}
5363static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5364{
5365  res->data=(char *)sySize((syStrategy)v->Data());
5366  return FALSE;
5367}
5368static BOOLEAN jjDIM_R(leftv res, leftv v)
5369{
5370  res->data = (char *)syDim((syStrategy)v->Data());
5371  return FALSE;
5372}
5373static BOOLEAN jjidTransp(leftv res, leftv v)
5374{
5375  res->data = (char *)idTransp((ideal)v->Data());
5376  return FALSE;
5377}
5378#else
5379#define XS(A)          -((short)A)
5380#define jjstrlen       (proc1)strlen
5381#define jjpLength      (proc1)pLength
5382#define jjidElem       (proc1)idElem
5383#define jjmpDetBareiss (proc1)mpDetBareiss
5384#define jjidFreeModule (proc1)idFreeModule
5385#define jjidVec2Ideal  (proc1)idVec2Ideal
5386#define jjrCharStr     (proc1)rCharStr
5387#ifndef MDEBUG
5388#define jjpHead        (proc1)pHeadProc
5389#endif
5390#define jjidHead       (proc1)idHead
5391#define jjidMinBase    (proc1)idMinBase
5392#define jjsyMinBase    (proc1)syMinBase
5393#define jjpMaxComp     (proc1)pMaxCompProc
5394#define jjrOrdStr      (proc1)rOrdStr
5395#define jjrVarStr      (proc1)rVarStr
5396#define jjrParStr      (proc1)rParStr
5397#define jjCOUNT_RES    (proc1)sySize
5398#define jjDIM_R        (proc1)syDim
5399#define jjidTransp     (proc1)idTransp
5400#endif
5401#endif
5402static BOOLEAN jjnInt(leftv res, leftv u)
5403{
5404  number n=(number)u->Data();
5405  res->data=(char *)(long)n_Int(n,currRing->cf);
5406  return FALSE;
5407}
5408static BOOLEAN jjnlInt(leftv res, leftv u)
5409{
5410  number n=(number)u->Data();
5411  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5412  return FALSE;
5413}
5414/*=================== operations with 3 args.: static proc =================*/
5415/* must be ordered: first operations for chars (infix ops),
5416 * then alphabetically */
5417static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5418{
5419  char *s= (char *)u->Data();
5420  int   r = (int)(long)v->Data();
5421  int   c = (int)(long)w->Data();
5422  int l = strlen(s);
5423
5424  if ( (r<1) || (r>l) || (c<0) )
5425  {
5426    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5427    return TRUE;
5428  }
5429  res->data = (char *)omAlloc((long)(c+1));
5430  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5431  return FALSE;
5432}
5433static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5434{
5435  intvec *iv = (intvec *)u->Data();
5436  int   r = (int)(long)v->Data();
5437  int   c = (int)(long)w->Data();
5438  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5439  {
5440    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5441           r,c,u->Fullname(),iv->rows(),iv->cols());
5442    return TRUE;
5443  }
5444  res->data=u->data; u->data=NULL;
5445  res->rtyp=u->rtyp; u->rtyp=0;
5446  res->name=u->name; u->name=NULL;
5447  Subexpr e=jjMakeSub(v);
5448          e->next=jjMakeSub(w);
5449  if (u->e==NULL) res->e=e;
5450  else
5451  {
5452    Subexpr h=u->e;
5453    while (h->next!=NULL) h=h->next;
5454    h->next=e;
5455    res->e=u->e;
5456    u->e=NULL;
5457  }
5458  return FALSE;
5459}
5460static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5461{
5462  bigintmat *bim = (bigintmat *)u->Data();
5463  int   r = (int)(long)v->Data();
5464  int   c = (int)(long)w->Data();
5465  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5466  {
5467    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5468           r,c,u->Fullname(),bim->rows(),bim->cols());
5469    return TRUE;
5470  }
5471  res->data=u->data; u->data=NULL;
5472  res->rtyp=u->rtyp; u->rtyp=0;
5473  res->name=u->name; u->name=NULL;
5474  Subexpr e=jjMakeSub(v);
5475          e->next=jjMakeSub(w);
5476  if (u->e==NULL)
5477    res->e=e;
5478  else
5479  {
5480    Subexpr h=u->e;
5481    while (h->next!=NULL) h=h->next;
5482    h->next=e;
5483    res->e=u->e;
5484    u->e=NULL;
5485  }
5486  return FALSE;
5487}
5488static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5489{
5490  matrix m= (matrix)u->Data();
5491  int   r = (int)(long)v->Data();
5492  int   c = (int)(long)w->Data();
5493  //Print("gen. elem %d, %d\n",r,c);
5494  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5495  {
5496    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5497      MATROWS(m),MATCOLS(m));
5498    return TRUE;
5499  }
5500  res->data=u->data; u->data=NULL;
5501  res->rtyp=u->rtyp; u->rtyp=0;
5502  res->name=u->name; u->name=NULL;
5503  Subexpr e=jjMakeSub(v);
5504          e->next=jjMakeSub(w);
5505  if (u->e==NULL)
5506    res->e=e;
5507  else
5508  {
5509    Subexpr h=u->e;
5510    while (h->next!=NULL) h=h->next;
5511    h->next=e;
5512    res->e=u->e;
5513    u->e=NULL;
5514  }
5515  return FALSE;
5516}
5517static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5518{
5519  sleftv t;
5520  sleftv ut;
5521  leftv p=NULL;
5522  intvec *iv=(intvec *)w->Data();
5523  int l;
5524  BOOLEAN nok;
5525
5526  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5527  {
5528    WerrorS("cannot build expression lists from unnamed objects");
5529    return TRUE;
5530  }
5531  memcpy(&ut,u,sizeof(ut));
5532  memset(&t,0,sizeof(t));
5533  t.rtyp=INT_CMD;
5534  for (l=0;l< iv->length(); l++)
5535  {
5536    t.data=(char *)(long)((*iv)[l]);
5537    if (p==NULL)
5538    {
5539      p=res;
5540    }
5541    else
5542    {
5543      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5544      p=p->next;
5545    }
5546    memcpy(u,&ut,sizeof(ut));
5547    if (u->Typ() == MATRIX_CMD)
5548      nok=jjBRACK_Ma(p,u,v,&t);
5549    else /* INTMAT_CMD */
5550      nok=jjBRACK_Im(p,u,v,&t);
5551    if (nok)
5552    {
5553      while (res->next!=NULL)
5554      {
5555        p=res->next->next;
5556        omFreeBin((ADDRESS)res->next, sleftv_bin);
5557        // res->e aufraeumen !!!!
5558        res->next=p;
5559      }
5560      return TRUE;
5561    }
5562  }
5563  return FALSE;
5564}
5565static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5566{
5567  sleftv t;
5568  sleftv ut;
5569  leftv p=NULL;
5570  intvec *iv=(intvec *)v->Data();
5571  int l;
5572  BOOLEAN nok;
5573
5574  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5575  {
5576    WerrorS("cannot build expression lists from unnamed objects");
5577    return TRUE;
5578  }
5579  memcpy(&ut,u,sizeof(ut));
5580  memset(&t,0,sizeof(t));
5581  t.rtyp=INT_CMD;
5582  for (l=0;l< iv->length(); l++)
5583  {
5584    t.data=(char *)(long)((*iv)[l]);
5585    if (p==NULL)
5586    {
5587      p=res;
5588    }
5589    else
5590    {
5591      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5592      p=p->next;
5593    }
5594    memcpy(u,&ut,sizeof(ut));
5595    if (u->Typ() == MATRIX_CMD)
5596      nok=jjBRACK_Ma(p,u,&t,w);
5597    else /* INTMAT_CMD */
5598      nok=jjBRACK_Im(p,u,&t,w);
5599    if (nok)
5600    {
5601      while (res->next!=NULL)
5602      {
5603        p=res->next->next;
5604        omFreeBin((ADDRESS)res->next, sleftv_bin);
5605        // res->e aufraeumen !!
5606        res->next=p;
5607      }
5608      return TRUE;
5609    }
5610  }
5611  return FALSE;
5612}
5613static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5614{
5615  sleftv t1,t2,ut;
5616  leftv p=NULL;
5617  intvec *vv=(intvec *)v->Data();
5618  intvec *wv=(intvec *)w->Data();
5619  int vl;
5620  int wl;
5621  BOOLEAN nok;
5622
5623  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5624  {
5625    WerrorS("cannot build expression lists from unnamed objects");
5626    return TRUE;
5627  }
5628  memcpy(&ut,u,sizeof(ut));
5629  memset(&t1,0,sizeof(sleftv));
5630  memset(&t2,0,sizeof(sleftv));
5631  t1.rtyp=INT_CMD;
5632  t2.rtyp=INT_CMD;
5633  for (vl=0;vl< vv->length(); vl++)
5634  {
5635    t1.data=(char *)(long)((*vv)[vl]);
5636    for (wl=0;wl< wv->length(); wl++)
5637    {
5638      t2.data=(char *)(long)((*wv)[wl]);
5639      if (p==NULL)
5640      {
5641        p=res;
5642      }
5643      else
5644      {
5645        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5646        p=p->next;
5647      }
5648      memcpy(u,&ut,sizeof(ut));
5649      if (u->Typ() == MATRIX_CMD)
5650        nok=jjBRACK_Ma(p,u,&t1,&t2);
5651      else /* INTMAT_CMD */
5652        nok=jjBRACK_Im(p,u,&t1,&t2);
5653      if (nok)
5654      {
5655        res->CleanUp();
5656        return TRUE;
5657      }
5658    }
5659  }
5660  return FALSE;
5661}
5662static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5663{
5664  v->next=(leftv)omAllocBin(sleftv_bin);
5665  memcpy(v->next,w,sizeof(sleftv));
5666  memset(w,0,sizeof(sleftv));
5667  return jjPROC(res,u,v);
5668}
5669static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5670{
5671  intvec *iv;
5672  ideal m;
5673  lists l=(lists)omAllocBin(slists_bin);
5674  int k=(int)(long)w->Data();
5675  if (k>=0)
5676  {
5677    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5678    l->Init(2);
5679    l->m[0].rtyp=MODUL_CMD;
5680    l->m[1].rtyp=INTVEC_CMD;
5681    l->m[0].data=(void *)m;
5682    l->m[1].data=(void *)iv;
5683  }
5684  else
5685  {
5686    m=sm_CallSolv((ideal)u->Data(), currRing);
5687    l->Init(1);
5688    l->m[0].rtyp=IDEAL_CMD;
5689    l->m[0].data=(void *)m;
5690  }
5691  res->data = (char *)l;
5692  return FALSE;
5693}
5694static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5695{
5696  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5697  {
5698    WerrorS("3rd argument must be a name of a matrix");
5699    return TRUE;
5700  }
5701  ideal i=(ideal)u->Data();
5702  int rank=(int)i->rank;
5703  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5704  if (r) return TRUE;
5705  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5706  return FALSE;
5707}
5708static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5709{
5710  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5711           (ideal)(v->Data()),(poly)(w->Data()));
5712  return FALSE;
5713}
5714static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5715{
5716  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5717  {
5718    WerrorS("3rd argument must be a name of a matrix");
5719    return TRUE;
5720  }
5721  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5722  poly p=(poly)u->CopyD(POLY_CMD);
5723  ideal i=idInit(1,1);
5724  i->m[0]=p;
5725  sleftv t;
5726  memset(&t,0,sizeof(t));
5727  t.data=(char *)i;
5728  t.rtyp=IDEAL_CMD;
5729  int rank=1;
5730  if (u->Typ()==VECTOR_CMD)
5731  {
5732    i->rank=rank=pMaxComp(p);
5733    t.rtyp=MODUL_CMD;
5734  }
5735  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5736  t.CleanUp();
5737  if (r) return TRUE;
5738  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5739  return FALSE;
5740}
5741static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5742{
5743  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5744    (intvec *)w->Data());
5745  //setFlag(res,FLAG_STD);
5746  return FALSE;
5747}
5748static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5749{
5750  /*4
5751  * look for the substring what in the string where
5752  * starting at position n
5753  * return the position of the first char of what in where
5754  * or 0
5755  */
5756  int n=(int)(long)w->Data();
5757  char *where=(char *)u->Data();
5758  char *what=(char *)v->Data();
5759  char *found;
5760  if ((1>n)||(n>(int)strlen(where)))
5761  {
5762    Werror("start position %d out of range",n);
5763    return TRUE;
5764  }
5765  found = strchr(where+n-1,*what);
5766  if (*(what+1)!='\0')
5767  {
5768    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5769    {
5770      found=strchr(found+1,*what);
5771    }
5772  }
5773  if (found != NULL)
5774  {
5775    res->data=(char *)((found-where)+1);
5776  }
5777  return FALSE;
5778}
5779static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5780{
5781  if ((int)(long)w->Data()==0)
5782    res->data=(char *)walkProc(u,v);
5783  else
5784    res->data