source: git/Singular/iparith.cc @ 665ca8

spielwiese
Last change on this file since 665ca8 was 1ca456, checked in by Hans Schoenemann <hannes@…>, 11 years ago
fix: int overflow in interpreter
  • Property mode set to 100644
File size: 216.4 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  int64 c=(int64)a * (int64)b;
872  if ((c>INT_MAX)||(c<INT_MIN))
873    WarnS("int overflow(*), result may be wrong");
874  res->data = (char *)((long)((int)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  iiRETURNEXPR.Init();
1591  return FALSE;
1592}
1593static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1594{
1595  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1596  leftv sl=NULL;
1597  if ((v->e==NULL)&&(v->name!=NULL))
1598  {
1599    map m=(map)u->Data();
1600    sl=iiMap(m,v->name);
1601  }
1602  else
1603  {
1604    Werror("%s(<name>) expected",u->Name());
1605  }
1606  if (sl==NULL) return TRUE;
1607  memcpy(res,sl,sizeof(sleftv));
1608  omFreeBin((ADDRESS)sl, sleftv_bin);
1609  return FALSE;
1610}
1611#ifdef HAVE_FACTORY
1612static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1613{
1614  intvec *c=(intvec*)u->Data();
1615  intvec* p=(intvec*)v->Data();
1616  int rl=p->length();
1617  number *x=(number *)omAlloc(rl*sizeof(number));
1618  number *q=(number *)omAlloc(rl*sizeof(number));
1619  int i;
1620  for(i=rl-1;i>=0;i--)
1621  {
1622    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1623    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1624  }
1625  number n=n_ChineseRemainder(x,q,rl,coeffs_BIGINT);
1626  for(i=rl-1;i>=0;i--)
1627  {
1628    n_Delete(&(q[i]),coeffs_BIGINT);
1629    n_Delete(&(x[i]),coeffs_BIGINT);
1630  }
1631  omFree(x); omFree(q);
1632  res->data=(char *)n;
1633  return FALSE;
1634}
1635#endif
1636#if 0
1637static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1638{
1639  lists c=(lists)u->CopyD(); // list of poly
1640  intvec* p=(intvec*)v->Data();
1641  int rl=p->length();
1642  poly r=NULL,h, result=NULL;
1643  number *x=(number *)omAlloc(rl*sizeof(number));
1644  number *q=(number *)omAlloc(rl*sizeof(number));
1645  int i;
1646  for(i=rl-1;i>=0;i--)
1647  {
1648    q[i]=nlInit((*p)[i]);
1649  }
1650  loop
1651  {
1652    for(i=rl-1;i>=0;i--)
1653    {
1654      if (c->m[i].Typ()!=POLY_CMD)
1655      {
1656        Werror("poly expected at pos %d",i+1);
1657        for(i=rl-1;i>=0;i--)
1658        {
1659          nlDelete(&(q[i]),currRing);
1660        }
1661        omFree(x); omFree(q); // delete c
1662        return TRUE;
1663      }
1664      h=((poly)c->m[i].Data());
1665      if (r==NULL) r=h;
1666      else if (pLmCmp(r,h)==-1) r=h;
1667    }
1668    if (r==NULL) break;
1669    for(i=rl-1;i>=0;i--)
1670    {
1671      h=((poly)c->m[i].Data());
1672      if (pLmCmp(r,h)==0)
1673      {
1674        x[i]=pGetCoeff(h);
1675        h=pLmFreeAndNext(h);
1676        c->m[i].data=(char*)h;
1677      }
1678      else
1679        x[i]=nlInit(0);
1680    }
1681    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1682    for(i=rl-1;i>=0;i--)
1683    {
1684      nlDelete(&(x[i]),currRing);
1685    }
1686    h=pHead(r);
1687    pSetCoeff(h,n);
1688    result=pAdd(result,h);
1689  }
1690  for(i=rl-1;i>=0;i--)
1691  {
1692    nlDelete(&(q[i]),currRing);
1693  }
1694  omFree(x); omFree(q);
1695  res->data=(char *)result;
1696  return FALSE;
1697}
1698#endif
1699#ifdef HAVE_FACTORY
1700static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1701{
1702  lists c=(lists)u->CopyD(); // list of ideal
1703  lists pl=NULL;
1704  intvec *p=NULL;
1705  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1706  else                    p=(intvec*)v->Data();
1707  int rl=c->nr+1;
1708  ideal result;
1709  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1710  int i;
1711  int return_type=c->m[0].Typ();
1712  if ((return_type!=IDEAL_CMD)
1713  && (return_type!=MODUL_CMD)
1714  && (return_type!=MATRIX_CMD))
1715  {
1716    WerrorS("ideal/module/matrix expected");
1717    omFree(x); // delete c
1718    return TRUE;
1719  }
1720  for(i=rl-1;i>=0;i--)
1721  {
1722    if (c->m[i].Typ()!=return_type)
1723    {
1724      Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1725      omFree(x); // delete c
1726      return TRUE;
1727    }
1728    x[i]=((ideal)c->m[i].Data());
1729  }
1730  number *q=(number *)omAlloc(rl*sizeof(number));
1731  if (p!=NULL)
1732  {
1733    for(i=rl-1;i>=0;i--)
1734    {
1735      q[i]=n_Init((*p)[i], currRing->cf);
1736    }
1737  }
1738  else
1739  {
1740    for(i=rl-1;i>=0;i--)
1741    {
1742      if (pl->m[i].Typ()==INT_CMD)
1743      {
1744        q[i]=n_Init((int)(long)pl->m[i].Data(),currRing->cf);
1745      }
1746      else if (pl->m[i].Typ()==BIGINT_CMD)
1747      {
1748        q[i]=n_Init_bigint((number)(pl->m[i].Data()),coeffs_BIGINT,currRing->cf);
1749      }
1750      else
1751      {
1752        Werror("bigint expected at pos %d",i+1);
1753        for(i++;i<rl;i++)
1754        {
1755          n_Delete(&(q[i]),currRing->cf);
1756        }
1757        omFree(x); // delete c
1758        omFree(q); // delete pl
1759        return TRUE;
1760      }
1761    }
1762  }
1763  result=id_ChineseRemainder(x,q,rl,currRing);
1764  for(i=rl-1;i>=0;i--)
1765  {
1766    n_Delete(&(q[i]),currRing->cf);
1767  }
1768  omFree(q);
1769  res->data=(char *)result;
1770  res->rtyp=return_type;
1771  return FALSE;
1772}
1773#endif
1774static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1775{
1776  poly p=(poly)v->Data();
1777  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1778  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1779  return FALSE;
1780}
1781static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1782{
1783  int i=pVar((poly)v->Data());
1784  if (i==0)
1785  {
1786    WerrorS("ringvar expected");
1787    return TRUE;
1788  }
1789  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1790  return FALSE;
1791}
1792static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1793{
1794  poly p = pInit();
1795  int i;
1796  for (i=1; i<=currRing->N; i++)
1797  {
1798    pSetExp(p, i, 1);
1799  }
1800  pSetm(p);
1801  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1802                                    (ideal)(v->Data()), p);
1803  pDelete(&p);
1804  return FALSE;
1805}
1806static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1807{
1808  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1809  return FALSE;
1810}
1811static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1812{
1813  short *iv=iv2array((intvec *)v->Data(),currRing);
1814  ideal I=(ideal)u->Data();
1815  int d=-1;
1816  int i;
1817  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1818  omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1819  res->data = (char *)((long)d);
1820  return FALSE;
1821}
1822static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1823{
1824  poly p=(poly)u->Data();
1825  if (p!=NULL)
1826  {
1827    short *iv=iv2array((intvec *)v->Data(),currRing);
1828    int d=(int)pDegW(p,iv);
1829    omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1830    res->data = (char *)(long(d));
1831  }
1832  else
1833    res->data=(char *)(long)(-1);
1834  return FALSE;
1835}
1836static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1837{
1838  int i=pVar((poly)v->Data());
1839  if (i==0)
1840  {
1841    WerrorS("ringvar expected");
1842    return TRUE;
1843  }
1844  res->data=(char *)pDiff((poly)(u->Data()),i);
1845  return FALSE;
1846}
1847static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1848{
1849  int i=pVar((poly)v->Data());
1850  if (i==0)
1851  {
1852    WerrorS("ringvar expected");
1853    return TRUE;
1854  }
1855  res->data=(char *)idDiff((matrix)(u->Data()),i);
1856  return FALSE;
1857}
1858static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1859{
1860  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1861  return FALSE;
1862}
1863static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1864{
1865  assumeStdFlag(v);
1866#ifdef HAVE_RINGS
1867  if (rField_is_Ring(currRing))
1868  {
1869    //ring origR = currRing;
1870    //ring tempR = rCopy(origR);
1871    //coeffs new_cf=nInitChar(n_Q,NULL);
1872    //nKillChar(tempR->cf);
1873    //tempR->cf=new_cf;
1874    //rComplete(tempR);
1875    ideal vid = (ideal)v->Data();
1876    int i = idPosConstant(vid);
1877    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1878    { /* ideal v contains unit; dim = -1 */
1879      res->data = (char *)-1;
1880      return FALSE;
1881    }
1882    //rChangeCurrRing(tempR);
1883    //ideal vv = idrCopyR(vid, origR, currRing);
1884    ideal vv = id_Copy(vid, currRing);
1885    //ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1886    ideal ww = id_Copy((ideal)w->Data(), currRing);
1887    /* drop degree zero generator from vv (if any) */
1888    if (i != -1) pDelete(&vv->m[i]);
1889    long d = (long)scDimInt(vv, ww);
1890    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
1891    res->data = (char *)d;
1892    idDelete(&vv); idDelete(&ww);
1893    //rChangeCurrRing(origR);
1894    //rDelete(tempR);
1895    return FALSE;
1896  }
1897#endif
1898  if(currQuotient==NULL)
1899    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1900  else
1901  {
1902    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1903    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1904    idDelete(&q);
1905  }
1906  return FALSE;
1907}
1908static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1909{
1910  ideal vi=(ideal)v->Data();
1911  int vl= IDELEMS(vi);
1912  ideal ui=(ideal)u->Data();
1913  int ul= IDELEMS(ui);
1914  ideal R; matrix U;
1915  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1916  if (m==NULL) return TRUE;
1917  // now make sure that all matices have the corect size:
1918  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
1919  int i;
1920  if (MATCOLS(U) != ul)
1921  {
1922    int mul=si_min(ul,MATCOLS(U));
1923    matrix UU=mpNew(ul,ul);
1924    int j;
1925    for(i=mul;i>0;i--)
1926    {
1927      for(j=mul;j>0;j--)
1928      {
1929        MATELEM(UU,i,j)=MATELEM(U,i,j);
1930        MATELEM(U,i,j)=NULL;
1931      }
1932    }
1933    idDelete((ideal *)&U);
1934    U=UU;
1935  }
1936  // make sure that U is a diagonal matrix of units
1937  for(i=ul;i>0;i--)
1938  {
1939    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1940  }
1941  lists L=(lists)omAllocBin(slists_bin);
1942  L->Init(3);
1943  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1944  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1945  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1946  res->data=(char *)L;
1947  return FALSE;
1948}
1949static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1950{
1951  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1952  //setFlag(res,FLAG_STD);
1953  return FALSE;
1954}
1955static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1956{
1957  poly p=pOne();
1958  intvec *iv=(intvec*)v->Data();
1959  for(int i=iv->length()-1; i>=0; i--)
1960  {
1961    pSetExp(p,(*iv)[i],1);
1962  }
1963  pSetm(p);
1964  res->data=(char *)idElimination((ideal)u->Data(),p);
1965  pLmDelete(&p);
1966  //setFlag(res,FLAG_STD);
1967  return FALSE;
1968}
1969static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
1970{
1971  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1972  return iiExport(v,0,(idhdl)u->data);
1973}
1974static BOOLEAN jjERROR(leftv, leftv u)
1975{
1976  WerrorS((char *)u->Data());
1977  extern int inerror;
1978  inerror=3;
1979  return TRUE;
1980}
1981static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
1982{
1983  number uu=(number)u->Data();number vv=(number)v->Data();
1984  lists L=(lists)omAllocBin(slists_bin);
1985  number a,b;
1986  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
1987  L->Init(3);
1988  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
1989  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
1990  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
1991  res->rtyp=LIST_CMD;
1992  res->data=(char *)L;
1993  return FALSE;
1994}
1995static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1996{
1997  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1998  int p0=ABS(uu),p1=ABS(vv);
1999  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
2000
2001  while ( p1!=0 )
2002  {
2003    q=p0 / p1;
2004    r=p0 % p1;
2005    p0 = p1; p1 = r;
2006    r = g0 - g1 * q;
2007    g0 = g1; g1 = r;
2008    r = f0 - f1 * q;
2009    f0 = f1; f1 = r;
2010  }
2011  int a = f0;
2012  int b = g0;
2013  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2014  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2015  lists L=(lists)omAllocBin(slists_bin);
2016  L->Init(3);
2017  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2018  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2019  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2020  res->rtyp=LIST_CMD;
2021  res->data=(char *)L;
2022  return FALSE;
2023}
2024#ifdef HAVE_FACTORY
2025static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2026{
2027  poly r,pa,pb;
2028  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2029  if (ret) return TRUE;
2030  lists L=(lists)omAllocBin(slists_bin);
2031  L->Init(3);
2032  res->data=(char *)L;
2033  L->m[0].data=(void *)r;
2034  L->m[0].rtyp=POLY_CMD;
2035  L->m[1].data=(void *)pa;
2036  L->m[1].rtyp=POLY_CMD;
2037  L->m[2].data=(void *)pb;
2038  L->m[2].rtyp=POLY_CMD;
2039  return FALSE;
2040}
2041extern int singclap_factorize_retry;
2042static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2043{
2044  intvec *v=NULL;
2045  int sw=(int)(long)dummy->Data();
2046  int fac_sw=sw;
2047  if ((sw<0)||(sw>2)) fac_sw=1;
2048  singclap_factorize_retry=0;
2049  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2050  if (f==NULL)
2051    return TRUE;
2052  switch(sw)
2053  {
2054    case 0:
2055    case 2:
2056    {
2057      lists l=(lists)omAllocBin(slists_bin);
2058      l->Init(2);
2059      l->m[0].rtyp=IDEAL_CMD;
2060      l->m[0].data=(void *)f;
2061      l->m[1].rtyp=INTVEC_CMD;
2062      l->m[1].data=(void *)v;
2063      res->data=(void *)l;
2064      res->rtyp=LIST_CMD;
2065      return FALSE;
2066    }
2067    case 1:
2068      res->data=(void *)f;
2069      return FALSE;
2070    case 3:
2071      {
2072        poly p=f->m[0];
2073        int i=IDELEMS(f);
2074        f->m[0]=NULL;
2075        while(i>1)
2076        {
2077          i--;
2078          p=pMult(p,f->m[i]);
2079          f->m[i]=NULL;
2080        }
2081        res->data=(void *)p;
2082        res->rtyp=POLY_CMD;
2083      }
2084      return FALSE;
2085  }
2086  WerrorS("invalid switch");
2087  return TRUE;
2088}
2089static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2090{
2091  ideal_list p,h;
2092  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2093  p=h;
2094  int l=0;
2095  while (p!=NULL) { p=p->next;l++; }
2096  lists L=(lists)omAllocBin(slists_bin);
2097  L->Init(l);
2098  l=0;
2099  while(h!=NULL)
2100  {
2101    L->m[l].data=(char *)h->d;
2102    L->m[l].rtyp=IDEAL_CMD;
2103    p=h->next;
2104    omFreeSize(h,sizeof(*h));
2105    h=p;
2106    l++;
2107  }
2108  res->data=(void *)L;
2109  return FALSE;
2110}
2111#endif /* HAVE_FACTORY */
2112static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2113{
2114  if (rField_is_Q(currRing))
2115  {
2116    number uu=(number)u->Data();
2117    number vv=(number)v->Data();
2118    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2119    return FALSE;
2120  }
2121  else return TRUE;
2122}
2123static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2124{
2125  if (rField_is_Q(currRing))
2126  {
2127    ideal uu=(ideal)u->Data();
2128    number vv=(number)v->Data();
2129    res->data=(void*)id_Farey(uu,vv,currRing);
2130    res->rtyp=u->Typ();
2131    return FALSE;
2132  }
2133  else return TRUE;
2134}
2135static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2136{
2137  ring r=(ring)u->Data();
2138  idhdl w;
2139  int op=iiOp;
2140  nMapFunc nMap;
2141
2142  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2143  {
2144    int *perm=NULL;
2145    int *par_perm=NULL;
2146    int par_perm_size=0;
2147    BOOLEAN bo;
2148    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2149    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2150    {
2151      // Allow imap/fetch to be make an exception only for:
2152      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2153            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2154             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2155           ||
2156           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2157            (rField_is_Zp(currRing, r->cf->ch) ||
2158             rField_is_Zp_a(currRing, r->cf->ch))) )
2159      {
2160        par_perm_size=rPar(r);
2161      }
2162      else
2163      {
2164        goto err_fetch;
2165      }
2166    }
2167    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2168    {
2169      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2170      if (par_perm_size!=0)
2171        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2172      op=IMAP_CMD;
2173      if (iiOp==IMAP_CMD)
2174      {
2175        int r_par=0;
2176        char ** r_par_names=NULL;
2177        if (r->cf->extRing!=NULL)
2178        {
2179          r_par=r->cf->extRing->N;
2180          r_par_names=r->cf->extRing->names;
2181        }
2182        int c_par=0;
2183        char ** c_par_names=NULL;
2184        if (currRing->cf->extRing!=NULL)
2185        {
2186          c_par=currRing->cf->extRing->N;
2187          c_par_names=currRing->cf->extRing->names;
2188        }
2189        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2190                   currRing->names,currRing->N,c_par_names, c_par,
2191                   perm,par_perm, currRing->cf->type);
2192      }
2193      else
2194      {
2195        int i;
2196        if (par_perm_size!=0)
2197          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2198        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2199      }
2200    }
2201    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2202    {
2203      int i;
2204      for(i=0;i<si_min(r->N,currRing->N);i++)
2205      {
2206        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2207      }
2208      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2209      {
2210        Print("// par nr %d: %s -> %s\n",
2211              i,rParameter(r)[i],rParameter(currRing)[i]);
2212      }
2213    }
2214    sleftv tmpW;
2215    memset(&tmpW,0,sizeof(sleftv));
2216    tmpW.rtyp=IDTYP(w);
2217    tmpW.data=IDDATA(w);
2218    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2219                         perm,par_perm,par_perm_size,nMap)))
2220    {
2221      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2222    }
2223    if (perm!=NULL)
2224      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2225    if (par_perm!=NULL)
2226      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2227    return bo;
2228  }
2229  else
2230  {
2231    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2232  }
2233  return TRUE;
2234err_fetch:
2235  Werror("no identity map from %s",u->Fullname());
2236  return TRUE;
2237}
2238static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2239{
2240  /*4
2241  * look for the substring what in the string where
2242  * return the position of the first char of what in where
2243  * or 0
2244  */
2245  char *where=(char *)u->Data();
2246  char *what=(char *)v->Data();
2247  char *found = strstr(where,what);
2248  if (found != NULL)
2249  {
2250    res->data=(char *)((found-where)+1);
2251  }
2252  /*else res->data=NULL;*/
2253  return FALSE;
2254}
2255static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2256{
2257  res->data=(char *)fractalWalkProc(u,v);
2258  setFlag( res, FLAG_STD );
2259  return FALSE;
2260}
2261static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2262{
2263  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2264  int p0=ABS(uu),p1=ABS(vv);
2265  int r;
2266  while ( p1!=0 )
2267  {
2268    r=p0 % p1;
2269    p0 = p1; p1 = r;
2270  }
2271  res->rtyp=INT_CMD;
2272  res->data=(char *)(long)p0;
2273  return FALSE;
2274}
2275static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2276{
2277  number a=(number) u->Data();
2278  number b=(number) v->Data();
2279  if (n_IsZero(a,coeffs_BIGINT))
2280  {
2281    if (n_IsZero(b,coeffs_BIGINT)) res->data=(char *)n_Init(1,coeffs_BIGINT);
2282    else                           res->data=(char *)n_Copy(b,coeffs_BIGINT);
2283  }
2284  else
2285  {
2286    if (n_IsZero(b,coeffs_BIGINT))  res->data=(char *)n_Copy(a,coeffs_BIGINT);
2287    else res->data=(char *)n_Gcd(a, b, coeffs_BIGINT);
2288  }
2289  return FALSE;
2290}
2291static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2292{
2293  number a=(number) u->Data();
2294  number b=(number) v->Data();
2295  if (nIsZero(a))
2296  {
2297    if (nIsZero(b)) res->data=(char *)nInit(1);
2298    else            res->data=(char *)nCopy(b);
2299  }
2300  else
2301  {
2302    if (nIsZero(b))  res->data=(char *)nCopy(a);
2303    else res->data=(char *)nGcd(a, b, currRing);
2304  }
2305  return FALSE;
2306}
2307#ifdef HAVE_FACTORY
2308static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2309{
2310  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2311                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2312  return FALSE;
2313}
2314#endif /* HAVE_FACTORY */
2315static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2316{
2317#ifdef HAVE_RINGS
2318  if (rField_is_Ring_Z(currRing))
2319  {
2320    ring origR = currRing;
2321    ring tempR = rCopy(origR);
2322    coeffs new_cf=nInitChar(n_Q,NULL);
2323    nKillChar(tempR->cf);
2324    tempR->cf=new_cf;
2325    rComplete(tempR);
2326    ideal uid = (ideal)u->Data();
2327    rChangeCurrRing(tempR);
2328    ideal uu = idrCopyR(uid, origR, currRing);
2329    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2330    uuAsLeftv.rtyp = IDEAL_CMD;
2331    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2332    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2333    assumeStdFlag(&uuAsLeftv);
2334    Print("// NOTE: computation of Hilbert series etc. is being\n");
2335    Print("//       performed for generic fibre, that is, over Q\n");
2336    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2337    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2338    int returnWithTrue = 1;
2339    switch((int)(long)v->Data())
2340    {
2341      case 1:
2342        res->data=(void *)iv;
2343        returnWithTrue = 0;
2344      case 2:
2345        res->data=(void *)hSecondSeries(iv);
2346        delete iv;
2347        returnWithTrue = 0;
2348    }
2349    if (returnWithTrue)
2350    {
2351      WerrorS(feNotImplemented);
2352      delete iv;
2353    }
2354    idDelete(&uu);
2355    rChangeCurrRing(origR);
2356    rDelete(tempR);
2357    if (returnWithTrue) return TRUE; else return FALSE;
2358  }
2359#endif
2360  assumeStdFlag(u);
2361  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2362  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2363  switch((int)(long)v->Data())
2364  {
2365    case 1:
2366      res->data=(void *)iv;
2367      return FALSE;
2368    case 2:
2369      res->data=(void *)hSecondSeries(iv);
2370      delete iv;
2371      return FALSE;
2372  }
2373  WerrorS(feNotImplemented);
2374  delete iv;
2375  return TRUE;
2376}
2377static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2378{
2379  int i=pVar((poly)v->Data());
2380  if (i==0)
2381  {
2382    WerrorS("ringvar expected");
2383    return TRUE;
2384  }
2385  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2386  int d=pWTotaldegree(p);
2387  pLmDelete(p);
2388  if (d==1)
2389    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2390  else
2391    WerrorS("variable must have weight 1");
2392  return (d!=1);
2393}
2394static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2395{
2396  int i=pVar((poly)v->Data());
2397  if (i==0)
2398  {
2399    WerrorS("ringvar expected");
2400    return TRUE;
2401  }
2402  pFDegProc deg;
2403  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2404    deg=p_Totaldegree;
2405   else
2406    deg=currRing->pFDeg;
2407  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2408  int d=deg(p,currRing);
2409  pLmDelete(p);
2410  if (d==1)
2411    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2412  else
2413    WerrorS("variable must have weight 1");
2414  return (d!=1);
2415}
2416static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2417{
2418  intvec *w=new intvec(rVar(currRing));
2419  intvec *vw=(intvec*)u->Data();
2420  ideal v_id=(ideal)v->Data();
2421  pFDegProc save_FDeg=currRing->pFDeg;
2422  pLDegProc save_LDeg=currRing->pLDeg;
2423  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2424  currRing->pLexOrder=FALSE;
2425  kHomW=vw;
2426  kModW=w;
2427  pSetDegProcs(currRing,kHomModDeg);
2428  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2429  currRing->pLexOrder=save_pLexOrder;
2430  kHomW=NULL;
2431  kModW=NULL;
2432  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2433  if (w!=NULL) delete w;
2434  return FALSE;
2435}
2436static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2437{
2438  assumeStdFlag(u);
2439  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2440                    currQuotient);
2441  return FALSE;
2442}
2443static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2444{
2445  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2446  setFlag(res,FLAG_STD);
2447  return FALSE;
2448}
2449static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2450{
2451  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2452}
2453static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2454{
2455  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2456  return FALSE;
2457}
2458static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2459{
2460  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2461  return FALSE;
2462}
2463static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2464{
2465  assumeStdFlag(u);
2466  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2467  res->data = (char *)scKBase((int)(long)v->Data(),
2468                              (ideal)(u->Data()),currQuotient, w_u);
2469  if (w_u!=NULL)
2470  {
2471    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2472  }
2473  return FALSE;
2474}
2475static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2476static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2477{
2478  return jjPREIMAGE(res,u,v,NULL);
2479}
2480static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2481{
2482  return mpKoszul(res, u,v,NULL);
2483}
2484static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2485{
2486  sleftv h;
2487  memset(&h,0,sizeof(sleftv));
2488  h.rtyp=INT_CMD;
2489  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2490  return mpKoszul(res, u, &h, v);
2491}
2492static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2493{
2494  int ul= IDELEMS((ideal)u->Data());
2495  int vl= IDELEMS((ideal)v->Data());
2496  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2497                   hasFlag(u,FLAG_STD));
2498  if (m==NULL) return TRUE;
2499  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2500  return FALSE;
2501}
2502static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2503{
2504  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2505  idhdl h=(idhdl)v->data;
2506  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2507  res->data = (char *)idLiftStd((ideal)u->Data(),
2508                                &(h->data.umatrix),testHomog);
2509  setFlag(res,FLAG_STD); v->flag=0;
2510  return FALSE;
2511}
2512static BOOLEAN jjLOAD2(leftv res, leftv, leftv v)
2513{
2514  return jjLOAD(res, v,TRUE);
2515}
2516static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2517{
2518  char * s=(char *)u->Data();
2519  if(strcmp(s, "with")==0)
2520    return jjLOAD(res, v, TRUE);
2521  WerrorS("invalid second argument");
2522  WerrorS("load(\"libname\" [,\"with\"]);");
2523  return TRUE;
2524}
2525static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2526{
2527  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2528  tHomog hom=testHomog;
2529  if (w_u!=NULL)
2530  {
2531    w_u=ivCopy(w_u);
2532    hom=isHomog;
2533  }
2534  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2535  if (w_v!=NULL)
2536  {
2537    w_v=ivCopy(w_v);
2538    hom=isHomog;
2539  }
2540  if ((w_u!=NULL) && (w_v==NULL))
2541    w_v=ivCopy(w_u);
2542  if ((w_v!=NULL) && (w_u==NULL))
2543    w_u=ivCopy(w_v);
2544  ideal u_id=(ideal)u->Data();
2545  ideal v_id=(ideal)v->Data();
2546  if (w_u!=NULL)
2547  {
2548     if ((*w_u).compare((w_v))!=0)
2549     {
2550       WarnS("incompatible weights");
2551       delete w_u; w_u=NULL;
2552       hom=testHomog;
2553     }
2554     else
2555     {
2556       if ((!idTestHomModule(u_id,currQuotient,w_v))
2557       || (!idTestHomModule(v_id,currQuotient,w_v)))
2558       {
2559         WarnS("wrong weights");
2560         delete w_u; w_u=NULL;
2561         hom=testHomog;
2562       }
2563     }
2564  }
2565  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2566  if (w_u!=NULL)
2567  {
2568    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2569  }
2570  delete w_v;
2571  return FALSE;
2572}
2573static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2574{
2575  number q=(number)v->Data();
2576  if (n_IsZero(q,coeffs_BIGINT))
2577  {
2578    WerrorS(ii_div_by_0);
2579    return TRUE;
2580  }
2581  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2582  return FALSE;
2583}
2584static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2585{
2586  number q=(number)v->Data();
2587  if (nIsZero(q))
2588  {
2589    WerrorS(ii_div_by_0);
2590    return TRUE;
2591  }
2592  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2593  return FALSE;
2594}
2595static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2596static BOOLEAN jjMONITOR1(leftv res, leftv v)
2597{
2598  return jjMONITOR2(res,v,NULL);
2599}
2600static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2601{
2602#if 0
2603  char *opt=(char *)v->Data();
2604  int mode=0;
2605  while(*opt!='\0')
2606  {
2607    if (*opt=='i') mode |= PROT_I;
2608    else if (*opt=='o') mode |= PROT_O;
2609    opt++;
2610  }
2611  monitor((char *)(u->Data()),mode);
2612#else
2613  si_link l=(si_link)u->Data();
2614  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2615  if(strcmp(l->m->type,"ASCII")!=0)
2616  {
2617    Werror("ASCII link required, not `%s`",l->m->type);
2618    slClose(l);
2619    return TRUE;
2620  }
2621  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2622  if ( l->name[0]!='\0') // "" is the stop condition
2623  {
2624    const char *opt;
2625    int mode=0;
2626    if (v==NULL) opt=(const char*)"i";
2627    else         opt=(const char *)v->Data();
2628    while(*opt!='\0')
2629    {
2630      if (*opt=='i') mode |= PROT_I;
2631      else if (*opt=='o') mode |= PROT_O;
2632      opt++;
2633    }
2634    monitor((FILE *)l->data,mode);
2635  }
2636  else
2637    monitor(NULL,0);
2638  return FALSE;
2639#endif
2640}
2641static BOOLEAN jjMONOM(leftv res, leftv v)
2642{
2643  intvec *iv=(intvec *)v->Data();
2644  poly p=pOne();
2645  int i,e;
2646  BOOLEAN err=FALSE;
2647  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2648  {
2649    e=(*iv)[i-1];
2650    if (e>=0) pSetExp(p,i,e);
2651    else err=TRUE;
2652  }
2653  if (iv->length()==(currRing->N+1))
2654  {
2655    res->rtyp=VECTOR_CMD;
2656    e=(*iv)[currRing->N];
2657    if (e>=0) pSetComp(p,e);
2658    else err=TRUE;
2659  }
2660  pSetm(p);
2661  res->data=(char*)p;
2662  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2663  return err;
2664}
2665static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2666{
2667  // u: the name of the new type
2668  // v: the elements
2669  newstruct_desc d=newstructFromString((const char *)v->Data());
2670  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2671  return d==NULL;
2672}
2673static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2674{
2675  idhdl h=(idhdl)u->data;
2676  int i=(int)(long)v->Data();
2677  int p=0;
2678  if ((0<i)
2679  && (rParameter(IDRING(h))!=NULL)
2680  && (i<=(p=rPar(IDRING(h)))))
2681    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2682  else
2683  {
2684    Werror("par number %d out of range 1..%d",i,p);
2685    return TRUE;
2686  }
2687  return FALSE;
2688}
2689#ifdef HAVE_PLURAL
2690static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2691{
2692  if( currRing->qideal != NULL )
2693  {
2694    WerrorS("basering must NOT be a qring!");
2695    return TRUE;
2696  }
2697
2698  if (iiOp==NCALGEBRA_CMD)
2699  {
2700    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2701  }
2702  else
2703  {
2704    ring r=rCopy(currRing);
2705    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2706    res->data=r;
2707    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2708    return result;
2709  }
2710}
2711static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2712{
2713  if( currRing->qideal != NULL )
2714  {
2715    WerrorS("basering must NOT be a qring!");
2716    return TRUE;
2717  }
2718
2719  if (iiOp==NCALGEBRA_CMD)
2720  {
2721    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2722  }
2723  else
2724  {
2725    ring r=rCopy(currRing);
2726    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2727    res->data=r;
2728    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2729    return result;
2730  }
2731}
2732static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2733{
2734  if( currRing->qideal != NULL )
2735  {
2736    WerrorS("basering must NOT be a qring!");
2737    return TRUE;
2738  }
2739
2740  if (iiOp==NCALGEBRA_CMD)
2741  {
2742    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2743  }
2744  else
2745  {
2746    ring r=rCopy(currRing);
2747    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2748    res->data=r;
2749    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2750    return result;
2751  }
2752}
2753static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2754{
2755  if( currRing->qideal != NULL )
2756  {
2757    WerrorS("basering must NOT be a qring!");
2758    return TRUE;
2759  }
2760
2761  if (iiOp==NCALGEBRA_CMD)
2762  {
2763    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2764  }
2765  else
2766  {
2767    ring r=rCopy(currRing);
2768    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2769    res->data=r;
2770    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2771    return result;
2772  }
2773}
2774static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2775{
2776  res->data=NULL;
2777
2778  if (rIsPluralRing(currRing))
2779  {
2780    const poly q = (poly)b->Data();
2781
2782    if( q != NULL )
2783    {
2784      if( (poly)a->Data() != NULL )
2785      {
2786        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2787        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2788      }
2789    }
2790  }
2791  return FALSE;
2792}
2793static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2794{
2795  /* number, poly, vector, ideal, module, matrix */
2796  ring  r = (ring)a->Data();
2797  if (r == currRing)
2798  {
2799    res->data = b->Data();
2800    res->rtyp = b->rtyp;
2801    return FALSE;
2802  }
2803  if (!rIsLikeOpposite(currRing, r))
2804  {
2805    Werror("%s is not an opposite ring to current ring",a->Fullname());
2806    return TRUE;
2807  }
2808  idhdl w;
2809  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2810  {
2811    int argtype = IDTYP(w);
2812    switch (argtype)
2813    {
2814    case NUMBER_CMD:
2815      {
2816        /* since basefields are equal, we can apply nCopy */
2817        res->data = nCopy((number)IDDATA(w));
2818        res->rtyp = argtype;
2819        break;
2820      }
2821    case POLY_CMD:
2822    case VECTOR_CMD:
2823      {
2824        poly    q = (poly)IDDATA(w);
2825        res->data = pOppose(r,q,currRing);
2826        res->rtyp = argtype;
2827        break;
2828      }
2829    case IDEAL_CMD:
2830    case MODUL_CMD:
2831      {
2832        ideal   Q = (ideal)IDDATA(w);
2833        res->data = idOppose(r,Q,currRing);
2834        res->rtyp = argtype;
2835        break;
2836      }
2837    case MATRIX_CMD:
2838      {
2839        ring save = currRing;
2840        rChangeCurrRing(r);
2841        matrix  m = (matrix)IDDATA(w);
2842        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2843        rChangeCurrRing(save);
2844        ideal   S = idOppose(r,Q,currRing);
2845        id_Delete(&Q, r);
2846        res->data = id_Module2Matrix(S,currRing);
2847        res->rtyp = argtype;
2848        break;
2849      }
2850    default:
2851      {
2852        WerrorS("unsupported type in oppose");
2853        return TRUE;
2854      }
2855    }
2856  }
2857  else
2858  {
2859    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2860    return TRUE;
2861  }
2862  return FALSE;
2863}
2864#endif /* HAVE_PLURAL */
2865
2866static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2867{
2868  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2869    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2870  id_DelMultiples((ideal)(res->data),currRing);
2871  return FALSE;
2872}
2873static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2874{
2875  int i=(int)(long)u->Data();
2876  int j=(int)(long)v->Data();
2877  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2878  return FALSE;
2879}
2880static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2881{
2882  matrix m =(matrix)u->Data();
2883  int isRowEchelon = (int)(long)v->Data();
2884  if (isRowEchelon != 1) isRowEchelon = 0;
2885  int rank = luRank(m, isRowEchelon);
2886  res->data =(char *)(long)rank;
2887  return FALSE;
2888}
2889static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2890{
2891  si_link l=(si_link)u->Data();
2892  leftv r=slRead(l,v);
2893  if (r==NULL)
2894  {
2895    const char *s;
2896    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2897    else                            s=sNoName;
2898    Werror("cannot read from `%s`",s);
2899    return TRUE;
2900  }
2901  memcpy(res,r,sizeof(sleftv));
2902  omFreeBin((ADDRESS)r, sleftv_bin);
2903  return FALSE;
2904}
2905static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2906{
2907  assumeStdFlag(v);
2908  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2909  return FALSE;
2910}
2911static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2912{
2913  assumeStdFlag(v);
2914  ideal ui=(ideal)u->Data();
2915  ideal vi=(ideal)v->Data();
2916  res->data = (char *)kNF(vi,currQuotient,ui);
2917  return FALSE;
2918}
2919#if 0
2920static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2921{
2922  int maxl=(int)(long)v->Data();
2923  if (maxl<0)
2924  {
2925    WerrorS("length for res must not be negative");
2926    return TRUE;
2927  }
2928  int l=0;
2929  //resolvente r;
2930  syStrategy r;
2931  intvec *weights=NULL;
2932  int wmaxl=maxl;
2933  ideal u_id=(ideal)u->Data();
2934
2935  maxl--;
2936  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2937  {
2938    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
2939    if (currQuotient!=NULL)
2940    {
2941      Warn(
2942      "full resolution in a qring may be infinite, setting max length to %d",
2943      maxl+1);
2944    }
2945  }
2946  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2947  if (weights!=NULL)
2948  {
2949    if (!idTestHomModule(u_id,currQuotient,weights))
2950    {
2951      WarnS("wrong weights given:");weights->show();PrintLn();
2952      weights=NULL;
2953    }
2954  }
2955  intvec *ww=NULL;
2956  int add_row_shift=0;
2957  if (weights!=NULL)
2958  {
2959     ww=ivCopy(weights);
2960     add_row_shift = ww->min_in();
2961     (*ww) -= add_row_shift;
2962  }
2963  else
2964    idHomModule(u_id,currQuotient,&ww);
2965  weights=ww;
2966
2967  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2968  {
2969    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2970  }
2971  else if (iiOp==SRES_CMD)
2972  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2973    r=sySchreyer(u_id,maxl+1);
2974  else if (iiOp == LRES_CMD)
2975  {
2976    int dummy;
2977    if((currQuotient!=NULL)||
2978    (!idHomIdeal (u_id,NULL)))
2979    {
2980       WerrorS
2981       ("`lres` not implemented for inhomogeneous input or qring");
2982       return TRUE;
2983    }
2984    r=syLaScala3(u_id,&dummy);
2985  }
2986  else if (iiOp == KRES_CMD)
2987  {
2988    int dummy;
2989    if((currQuotient!=NULL)||
2990    (!idHomIdeal (u_id,NULL)))
2991    {
2992       WerrorS
2993       ("`kres` not implemented for inhomogeneous input or qring");
2994       return TRUE;
2995    }
2996    r=syKosz(u_id,&dummy);
2997  }
2998  else
2999  {
3000    int dummy;
3001    if((currQuotient!=NULL)||
3002    (!idHomIdeal (u_id,NULL)))
3003    {
3004       WerrorS
3005       ("`hres` not implemented for inhomogeneous input or qring");
3006       return TRUE;
3007    }
3008    r=syHilb(u_id,&dummy);
3009  }
3010  if (r==NULL) return TRUE;
3011  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3012  r->list_length=wmaxl;
3013  res->data=(void *)r;
3014  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3015  {
3016    intvec *w=ivCopy(r->weights[0]);
3017    if (weights!=NULL) (*w) += add_row_shift;
3018    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3019    w=NULL;
3020  }
3021  else
3022  {
3023//#if 0
3024// need to set weights for ALL components (sres)
3025    if (weights!=NULL)
3026    {
3027      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3028      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3029      (r->weights)[0] = ivCopy(weights);
3030    }
3031//#endif
3032  }
3033  if (ww!=NULL) { delete ww; ww=NULL; }
3034  return FALSE;
3035}
3036#else
3037static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3038{
3039  int maxl=(int)(long)v->Data();
3040  if (maxl<0)
3041  {
3042    WerrorS("length for res must not be negative");
3043    return TRUE;
3044  }
3045  syStrategy r;
3046  intvec *weights=NULL;
3047  int wmaxl=maxl;
3048  ideal u_id=(ideal)u->Data();
3049
3050  maxl--;
3051  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3052  {
3053    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3054    if (currQuotient!=NULL)
3055    {
3056      Warn(
3057      "full resolution in a qring may be infinite, setting max length to %d",
3058      maxl+1);
3059    }
3060  }
3061  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3062  if (weights!=NULL)
3063  {
3064    if (!idTestHomModule(u_id,currQuotient,weights))
3065    {
3066      WarnS("wrong weights given:");weights->show();PrintLn();
3067      weights=NULL;
3068    }
3069  }
3070  intvec *ww=NULL;
3071  int add_row_shift=0;
3072  if (weights!=NULL)
3073  {
3074     ww=ivCopy(weights);
3075     add_row_shift = ww->min_in();
3076     (*ww) -= add_row_shift;
3077  }
3078  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3079  {
3080    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3081  }
3082  else if (iiOp==SRES_CMD)
3083  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3084    r=sySchreyer(u_id,maxl+1);
3085  else if (iiOp == LRES_CMD)
3086  {
3087    int dummy;
3088    if((currQuotient!=NULL)||
3089    (!idHomIdeal (u_id,NULL)))
3090    {
3091       WerrorS
3092       ("`lres` not implemented for inhomogeneous input or qring");
3093       return TRUE;
3094    }
3095    if(currRing->N == 1)
3096      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3097    r=syLaScala3(u_id,&dummy);
3098  }
3099  else if (iiOp == KRES_CMD)
3100  {
3101    int dummy;
3102    if((currQuotient!=NULL)||
3103    (!idHomIdeal (u_id,NULL)))
3104    {
3105       WerrorS
3106       ("`kres` not implemented for inhomogeneous input or qring");
3107       return TRUE;
3108    }
3109    r=syKosz(u_id,&dummy);
3110  }
3111  else
3112  {
3113    int dummy;
3114    if((currQuotient!=NULL)||
3115    (!idHomIdeal (u_id,NULL)))
3116    {
3117       WerrorS
3118       ("`hres` not implemented for inhomogeneous input or qring");
3119       return TRUE;
3120    }
3121    ideal u_id_copy=idCopy(u_id);
3122    idSkipZeroes(u_id_copy);
3123    r=syHilb(u_id_copy,&dummy);
3124    idDelete(&u_id_copy);
3125  }
3126  if (r==NULL) return TRUE;
3127  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3128  r->list_length=wmaxl;
3129  res->data=(void *)r;
3130  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3131  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3132  {
3133    ww=ivCopy(r->weights[0]);
3134    if (weights!=NULL) (*ww) += add_row_shift;
3135    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3136  }
3137  else
3138  {
3139    if (weights!=NULL)
3140    {
3141      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3142    }
3143  }
3144
3145  // test the La Scala case' output
3146  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3147  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3148
3149  if(iiOp != HRES_CMD)
3150    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3151  else
3152    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3153
3154  return FALSE;
3155}
3156#endif
3157static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3158{
3159  number n1; number n2; number temp; int i;
3160
3161  if ((u->Typ() == BIGINT_CMD) ||
3162     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3163  {
3164    temp = (number)u->Data();
3165    n1 = n_Copy(temp,coeffs_BIGINT);
3166  }
3167  else if (u->Typ() == INT_CMD)
3168  {
3169    i = (int)(long)u->Data();
3170    n1 = n_Init(i, coeffs_BIGINT);
3171  }
3172  else
3173  {
3174    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3175    return TRUE;
3176  }
3177
3178  if ((v->Typ() == BIGINT_CMD) ||
3179     ((v->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3180  {
3181    temp = (number)v->Data();
3182    n2 = n_Copy(temp,coeffs_BIGINT);
3183  }
3184  else if (v->Typ() == INT_CMD)
3185  {
3186    i = (int)(long)v->Data();
3187    n2 = n_Init(i, coeffs_BIGINT);
3188  }
3189  else
3190  {
3191    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3192    return TRUE;
3193  }
3194
3195  lists l = primeFactorisation(n1, n2);
3196  n_Delete(&n1, coeffs_BIGINT); n_Delete(&n2, coeffs_BIGINT);
3197  res->data = (char*)l;
3198  return FALSE;
3199}
3200static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3201{
3202  ring r;
3203  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3204  res->data = (char *)r;
3205  return (i==-1);
3206}
3207#define SIMPL_LMDIV 32
3208#define SIMPL_LMEQ  16
3209#define SIMPL_MULT 8
3210#define SIMPL_EQU  4
3211#define SIMPL_NULL 2
3212#define SIMPL_NORM 1
3213static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3214{
3215  int sw = (int)(long)v->Data();
3216  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3217  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3218  if (sw & SIMPL_LMDIV)
3219  {
3220    id_DelDiv(id,currRing);
3221  }
3222  if (sw & SIMPL_LMEQ)
3223  {
3224    id_DelLmEquals(id,currRing);
3225  }
3226  if (sw & SIMPL_MULT)
3227  {
3228    id_DelMultiples(id,currRing);
3229  }
3230  else if(sw & SIMPL_EQU)
3231  {
3232    id_DelEquals(id,currRing);
3233  }
3234  if (sw & SIMPL_NULL)
3235  {
3236    idSkipZeroes(id);
3237  }
3238  if (sw & SIMPL_NORM)
3239  {
3240    id_Norm(id,currRing);
3241  }
3242  res->data = (char * )id;
3243  return FALSE;
3244}
3245#ifdef HAVE_FACTORY
3246extern int singclap_factorize_retry;
3247static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3248{
3249  intvec *v=NULL;
3250  int sw=(int)(long)dummy->Data();
3251  int fac_sw=sw;
3252  if (sw<0) fac_sw=1;
3253  singclap_factorize_retry=0;
3254  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3255  if (f==NULL)
3256    return TRUE;
3257  switch(sw)
3258  {
3259    case 0:
3260    case 2:
3261    {
3262      lists l=(lists)omAllocBin(slists_bin);
3263      l->Init(2);
3264      l->m[0].rtyp=IDEAL_CMD;
3265      l->m[0].data=(void *)f;
3266      l->m[1].rtyp=INTVEC_CMD;
3267      l->m[1].data=(void *)v;
3268      res->data=(void *)l;
3269      res->rtyp=LIST_CMD;
3270      return FALSE;
3271    }
3272    case 1:
3273      res->data=(void *)f;
3274      return FALSE;
3275    case 3:
3276      {
3277        poly p=f->m[0];
3278        int i=IDELEMS(f);
3279        f->m[0]=NULL;
3280        while(i>1)
3281        {
3282          i--;
3283          p=pMult(p,f->m[i]);
3284          f->m[i]=NULL;
3285        }
3286        res->data=(void *)p;
3287        res->rtyp=POLY_CMD;
3288      }
3289      return FALSE;
3290  }
3291  WerrorS("invalid switch");
3292  return FALSE;
3293}
3294#endif
3295static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3296{
3297  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3298  return FALSE;
3299}
3300static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3301{
3302  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3303  //return (res->data== (void*)(long)-2);
3304  return FALSE;
3305}
3306static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3307{
3308  int sw = (int)(long)v->Data();
3309  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3310  poly p = (poly)u->CopyD(POLY_CMD);
3311  if (sw & SIMPL_NORM)
3312  {
3313    pNorm(p);
3314  }
3315  res->data = (char * )p;
3316  return FALSE;
3317}
3318static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3319{
3320  ideal result;
3321  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3322  tHomog hom=testHomog;
3323  ideal u_id=(ideal)(u->Data());
3324  if (w!=NULL)
3325  {
3326    if (!idTestHomModule(u_id,currQuotient,w))
3327    {
3328      WarnS("wrong weights:");w->show();PrintLn();
3329      w=NULL;
3330    }
3331    else
3332    {
3333      w=ivCopy(w);
3334      hom=isHomog;
3335    }
3336  }
3337  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3338  idSkipZeroes(result);
3339  res->data = (char *)result;
3340  setFlag(res,FLAG_STD);
3341  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3342  return FALSE;
3343}
3344static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3345static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3346/* destroys i0, p0 */
3347/* result (with attributes) in res */
3348/* i0: SB*/
3349/* t0: type of p0*/
3350/* p0 new elements*/
3351/* a attributes of i0*/
3352{
3353  int tp;
3354  if (t0==IDEAL_CMD) tp=POLY_CMD;
3355  else               tp=VECTOR_CMD;
3356  for (int i=IDELEMS(p0)-1; i>=0; i--)
3357  {
3358    poly p=p0->m[i];
3359    p0->m[i]=NULL;
3360    if (p!=NULL)
3361    {
3362      sleftv u0,v0;
3363      memset(&u0,0,sizeof(sleftv));
3364      memset(&v0,0,sizeof(sleftv));
3365      v0.rtyp=tp;
3366      v0.data=(void*)p;
3367      u0.rtyp=t0;
3368      u0.data=i0;
3369      u0.attribute=a;
3370      setFlag(&u0,FLAG_STD);
3371      jjSTD_1(res,&u0,&v0);
3372      i0=(ideal)res->data;
3373      res->data=NULL;
3374      a=res->attribute;
3375      res->attribute=NULL;
3376      u0.CleanUp();
3377      v0.CleanUp();
3378      res->CleanUp();
3379    }
3380  }
3381  idDelete(&p0);
3382  res->attribute=a;
3383  res->data=(void *)i0;
3384  res->rtyp=t0;
3385}
3386static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3387{
3388  ideal result;
3389  assumeStdFlag(u);
3390  ideal i1=(ideal)(u->Data());
3391  ideal i0;
3392  int r=v->Typ();
3393  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3394  {
3395    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3396    i0->m[0]=(poly)v->Data();
3397    int ii0=idElem(i0); /* size of i0 */
3398    i1=idSimpleAdd(i1,i0); //
3399    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3400    idDelete(&i0);
3401    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3402    tHomog hom=testHomog;
3403
3404    if (w!=NULL)
3405    {
3406      if (!idTestHomModule(i1,currQuotient,w))
3407      {
3408        // no warnung: this is legal, if i in std(i,p)
3409        // is homogeneous, but p not
3410        w=NULL;
3411      }
3412      else
3413      {
3414        w=ivCopy(w);
3415        hom=isHomog;
3416      }
3417    }
3418    BITSET save1;
3419    SI_SAVE_OPT1(save1);
3420    si_opt_1|=Sy_bit(OPT_SB_1);
3421    /* ii0 appears to be the position of the first element of il that
3422       does not belong to the old SB ideal */
3423    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3424    SI_RESTORE_OPT1(save1);
3425    idDelete(&i1);
3426    idSkipZeroes(result);
3427    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3428    res->data = (char *)result;
3429  }
3430  else /*IDEAL/MODULE*/
3431  {
3432    attr *aa=u->Attribute();
3433    attr a=NULL;
3434    if (aa!=NULL) a=(*aa)->Copy();
3435    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3436  }
3437  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3438  return FALSE;
3439}
3440static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3441{
3442  idhdl h=(idhdl)u->data;
3443  int i=(int)(long)v->Data();
3444  if ((0<i) && (i<=IDRING(h)->N))
3445    res->data=omStrDup(IDRING(h)->names[i-1]);
3446  else
3447  {
3448    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3449    return TRUE;
3450  }
3451  return FALSE;
3452}
3453static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3454{
3455// input: u: a list with links of type
3456//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3457//        v: timeout for select in milliseconds
3458//           or 0 for polling
3459// returns: ERROR (via Werror): timeout negative
3460//           -1: the read state of all links is eof
3461//            0: timeout (or polling): none ready
3462//           i>0: (at least) L[i] is ready
3463  lists Lforks = (lists)u->Data();
3464  int t = (int)(long)v->Data();
3465  if(t < 0)
3466  {
3467    WerrorS("negative timeout"); return TRUE;
3468  }
3469  int i = slStatusSsiL(Lforks, t*1000);
3470  if(i == -2) /* error */
3471  {
3472    return TRUE;
3473  }
3474  res->data = (void*)(long)i;
3475  return FALSE;
3476}
3477static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3478{
3479// input: u: a list with links of type
3480//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3481//        v: timeout for select in milliseconds
3482//           or 0 for polling
3483// returns: ERROR (via Werror): timeout negative
3484//           -1: the read state of all links is eof
3485//           0: timeout (or polling): none ready
3486//           1: all links are ready
3487//              (caution: at least one is ready, but some maybe dead)
3488  lists Lforks = (lists)u->CopyD();
3489  int timeout = 1000*(int)(long)v->Data();
3490  if(timeout < 0)
3491  {
3492    WerrorS("negative timeout"); return TRUE;
3493  }
3494  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3495  int i;
3496  int ret = -1;
3497  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3498  {
3499    i = slStatusSsiL(Lforks, timeout);
3500    if(i > 0) /* Lforks[i] is ready */
3501    {
3502      ret = 1;
3503      Lforks->m[i-1].CleanUp();
3504      Lforks->m[i-1].rtyp=DEF_CMD;
3505      Lforks->m[i-1].data=NULL;
3506      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3507    }
3508    else /* terminate the for loop */
3509    {
3510      if(i == -2) /* error */
3511      {
3512        return TRUE;
3513      }
3514      if(i == 0) /* timeout */
3515      {
3516        ret = 0;
3517      }
3518      break;
3519    }
3520  }
3521  Lforks->Clean();
3522  res->data = (void*)(long)ret;
3523  return FALSE;
3524}
3525static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3526{
3527  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3528  return FALSE;
3529}
3530#define jjWRONG2 (proc2)jjWRONG
3531#define jjWRONG3 (proc3)jjWRONG
3532static BOOLEAN jjWRONG(leftv, leftv)
3533{
3534  return TRUE;
3535}
3536
3537/*=================== operations with 1 arg.: static proc =================*/
3538/* must be ordered: first operations for chars (infix ops),
3539 * then alphabetically */
3540
3541static BOOLEAN jjDUMMY(leftv res, leftv u)
3542{
3543  res->data = (char *)u->CopyD();
3544  return FALSE;
3545}
3546static BOOLEAN jjNULL(leftv, leftv)
3547{
3548  return FALSE;
3549}
3550//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3551//{
3552//  res->data = (char *)((int)(long)u->Data()+1);
3553//  return FALSE;
3554//}
3555//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3556//{
3557//  res->data = (char *)((int)(long)u->Data()-1);
3558//  return FALSE;
3559//}
3560static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3561{
3562  if (IDTYP((idhdl)u->data)==INT_CMD)
3563  {
3564    int i=IDINT((idhdl)u->data);
3565    if (iiOp==PLUSPLUS) i++;
3566    else                i--;
3567    IDDATA((idhdl)u->data)=(char *)(long)i;
3568    return FALSE;
3569  }
3570  return TRUE;
3571}
3572static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3573{
3574  number n=(number)u->CopyD(BIGINT_CMD);
3575  n=n_Neg(n,coeffs_BIGINT);
3576  res->data = (char *)n;
3577  return FALSE;
3578}
3579static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3580{
3581  res->data = (char *)(-(long)u->Data());
3582  return FALSE;
3583}
3584static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3585{
3586  number n=(number)u->CopyD(NUMBER_CMD);
3587  n=nNeg(n);
3588  res->data = (char *)n;
3589  return FALSE;
3590}
3591static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3592{
3593  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3594  return FALSE;
3595}
3596static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3597{
3598  poly m1=pISet(-1);
3599  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3600  return FALSE;
3601}
3602static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3603{
3604  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3605  (*iv)*=(-1);
3606  res->data = (char *)iv;
3607  return FALSE;
3608}
3609static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3610{
3611  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3612  (*bim)*=(-1);
3613  res->data = (char *)bim;
3614  return FALSE;
3615}
3616static BOOLEAN jjPROC1(leftv res, leftv u)
3617{
3618  return jjPROC(res,u,NULL);
3619}
3620static BOOLEAN jjBAREISS(leftv res, leftv v)
3621{
3622  //matrix m=(matrix)v->Data();
3623  //lists l=mpBareiss(m,FALSE);
3624  intvec *iv;
3625  ideal m;
3626  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3627  lists l=(lists)omAllocBin(slists_bin);
3628  l->Init(2);
3629  l->m[0].rtyp=MODUL_CMD;
3630  l->m[1].rtyp=INTVEC_CMD;
3631  l->m[0].data=(void *)m;
3632  l->m[1].data=(void *)iv;
3633  res->data = (char *)l;
3634  return FALSE;
3635}
3636//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3637//{
3638//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3639//  ivTriangMat(m);
3640//  res->data = (char *)m;
3641//  return FALSE;
3642//}
3643static BOOLEAN jjBI2N(leftv res, leftv u)
3644{
3645  BOOLEAN bo=FALSE;
3646  number n=(number)u->CopyD();
3647  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3648  if (nMap!=NULL)
3649    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3650  else
3651  {
3652    WerrorS("cannot convert bigint to this field");
3653    bo=TRUE;
3654  }
3655  n_Delete(&n,coeffs_BIGINT);
3656  return bo;
3657}
3658static BOOLEAN jjBI2P(leftv res, leftv u)
3659{
3660  sleftv tmp;
3661  BOOLEAN bo=jjBI2N(&tmp,u);
3662  if (!bo)
3663  {
3664    number n=(number) tmp.data;
3665    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3666    else
3667    {
3668      res->data=(void *)pNSet(n);
3669    }
3670  }
3671  return bo;
3672}
3673static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3674{
3675  return iiExprArithM(res,u,iiOp);
3676}
3677static BOOLEAN jjCHAR(leftv res, leftv v)
3678{
3679  res->data = (char *)(long)rChar((ring)v->Data());
3680  return FALSE;
3681}
3682static BOOLEAN jjCOLS(leftv res, leftv v)
3683{
3684  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3685  return FALSE;
3686}
3687static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3688{
3689  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3690  return FALSE;
3691}
3692static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3693{
3694  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3695  return FALSE;
3696}
3697static BOOLEAN jjCONTENT(leftv res, leftv v)
3698{
3699  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3700  poly p=(poly)v->CopyD(POLY_CMD);
3701  if (p!=NULL) p_Cleardenom(p, currRing);
3702  res->data = (char *)p;
3703  return FALSE;
3704}
3705static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3706{
3707  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3708  return FALSE;
3709}
3710static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3711{
3712  res->data = (char *)(long)nSize((number)v->Data());
3713  return FALSE;
3714}
3715static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3716{
3717  lists l=(lists)v->Data();
3718  res->data = (char *)(long)(lSize(l)+1);
3719  return FALSE;
3720}
3721static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3722{
3723  matrix m=(matrix)v->Data();
3724  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3725  return FALSE;
3726}
3727static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3728{
3729  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3730  return FALSE;
3731}
3732static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3733{
3734  ring r=(ring)v->Data();
3735  int elems=-1;
3736  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3737  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3738  {
3739#ifdef HAVE_FACTORY
3740    extern int ipower ( int b, int n ); /* factory/cf_util */
3741    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3742#else
3743    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3744#endif
3745  }
3746  res->data = (char *)(long)elems;
3747  return FALSE;
3748}
3749static BOOLEAN jjDEG(leftv res, leftv v)
3750{
3751  int dummy;
3752  poly p=(poly)v->Data();
3753  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3754  else res->data=(char *)-1;
3755  return FALSE;
3756}
3757static BOOLEAN jjDEG_M(leftv res, leftv u)
3758{
3759  ideal I=(ideal)u->Data();
3760  int d=-1;
3761  int dummy;
3762  int i;
3763  for(i=IDELEMS(I)-1;i>=0;i--)
3764    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3765  res->data = (char *)(long)d;
3766  return FALSE;
3767}
3768static BOOLEAN jjDEGREE(leftv res, leftv v)
3769{
3770  SPrintStart();
3771#ifdef HAVE_RINGS
3772  if (rField_is_Ring_Z(currRing))
3773  {
3774    ring origR = currRing;
3775    ring tempR = rCopy(origR);
3776    coeffs new_cf=nInitChar(n_Q,NULL);
3777    nKillChar(tempR->cf);
3778    tempR->cf=new_cf;
3779    rComplete(tempR);
3780    ideal vid = (ideal)v->Data();
3781    rChangeCurrRing(tempR);
3782    ideal vv = idrCopyR(vid, origR, currRing);
3783    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3784    vvAsLeftv.rtyp = IDEAL_CMD;
3785    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3786    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3787    assumeStdFlag(&vvAsLeftv);
3788    Print("// NOTE: computation of degree is being performed for\n");
3789    Print("//       generic fibre, that is, over Q\n");
3790    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3791    scDegree(vv,module_w,currQuotient);
3792    idDelete(&vv);
3793    rChangeCurrRing(origR);
3794    rDelete(tempR);
3795  }
3796#endif
3797  assumeStdFlag(v);
3798  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3799  scDegree((ideal)v->Data(),module_w,currQuotient);
3800  char *s=SPrintEnd();
3801  int l=strlen(s)-1;
3802  s[l]='\0';
3803  res->data=(void*)s;
3804  return FALSE;
3805}
3806static BOOLEAN jjDEFINED(leftv res, leftv v)
3807{
3808  if ((v->rtyp==IDHDL)
3809  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3810  {
3811    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3812  }
3813  else if (v->rtyp!=0) res->data=(void *)(-1);
3814  return FALSE;
3815}
3816
3817/// Return the denominator of the input number
3818/// NOTE: the input number is normalized as a side effect
3819static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3820{
3821  number n = reinterpret_cast<number>(v->Data());
3822  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3823  return FALSE;
3824}
3825
3826/// Return the numerator of the input number
3827/// NOTE: the input number is normalized as a side effect
3828static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3829{
3830  number n = reinterpret_cast<number>(v->Data());
3831  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3832  return FALSE;
3833}
3834
3835
3836
3837
3838#ifdef HAVE_FACTORY
3839static BOOLEAN jjDET(leftv res, leftv v)
3840{
3841  matrix m=(matrix)v->Data();
3842  poly p;
3843  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3844  {
3845    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3846    p=sm_CallDet(I, currRing);
3847    idDelete(&I);
3848  }
3849  else
3850    p=singclap_det(m,currRing);
3851  res ->data = (char *)p;
3852  return FALSE;
3853}
3854static BOOLEAN jjDET_BI(leftv res, leftv v)
3855{
3856  bigintmat * m=(bigintmat*)v->Data();
3857  int i,j;
3858  i=m->rows();j=m->cols();
3859  if(i==j)
3860    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3861  else
3862  {
3863    Werror("det of %d x %d bigintmat",i,j);
3864    return TRUE;
3865  }
3866  return FALSE;
3867}
3868static BOOLEAN jjDET_I(leftv res, leftv v)
3869{
3870  intvec * m=(intvec*)v->Data();
3871  int i,j;
3872  i=m->rows();j=m->cols();
3873  if(i==j)
3874    res->data = (char *)(long)singclap_det_i(m,currRing);
3875  else
3876  {
3877    Werror("det of %d x %d intmat",i,j);
3878    return TRUE;
3879  }
3880  return FALSE;
3881}
3882static BOOLEAN jjDET_S(leftv res, leftv v)
3883{
3884  ideal I=(ideal)v->Data();
3885  poly p;
3886  if (IDELEMS(I)<1) return TRUE;
3887  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3888  {
3889    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3890    p=singclap_det(m,currRing);
3891    idDelete((ideal *)&m);
3892  }
3893  else
3894    p=sm_CallDet(I, currRing);
3895  res->data = (char *)p;
3896  return FALSE;
3897}
3898#endif
3899static BOOLEAN jjDIM(leftv res, leftv v)
3900{
3901  assumeStdFlag(v);
3902#ifdef HAVE_RINGS
3903  if (rField_is_Ring(currRing))
3904  {
3905    //ring origR = currRing;
3906    //ring tempR = rCopy(origR);
3907    //coeffs new_cf=nInitChar(n_Q,NULL);
3908    //nKillChar(tempR->cf);
3909    //tempR->cf=new_cf;
3910    //rComplete(tempR);
3911    ideal vid = (ideal)v->Data();
3912    int i = idPosConstant(vid);
3913    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3914    { /* ideal v contains unit; dim = -1 */
3915      res->data = (char *)-1;
3916      return FALSE;
3917    }
3918    //rChangeCurrRing(tempR);
3919    //ideal vv = idrCopyR(vid, origR, currRing);
3920    ideal vv = id_Head(vid,currRing);
3921    /* drop degree zero generator from vv (if any) */
3922    if (i != -1) pDelete(&vv->m[i]);
3923    long d = (long)scDimInt(vv, currQuotient);
3924    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
3925    res->data = (char *)d;
3926    idDelete(&vv);
3927    //rChangeCurrRing(origR);
3928    //rDelete(tempR);
3929    return FALSE;
3930  }
3931#endif
3932  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3933  return FALSE;
3934}
3935static BOOLEAN jjDUMP(leftv, leftv v)
3936{
3937  si_link l = (si_link)v->Data();
3938  if (slDump(l))
3939  {
3940    const char *s;
3941    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3942    else                            s=sNoName;
3943    Werror("cannot dump to `%s`",s);
3944    return TRUE;
3945  }
3946  else
3947    return FALSE;
3948}
3949static BOOLEAN jjE(leftv res, leftv v)
3950{
3951  res->data = (char *)pOne();
3952  int co=(int)(long)v->Data();
3953  if (co>0)
3954  {
3955    pSetComp((poly)res->data,co);
3956    pSetm((poly)res->data);
3957  }
3958  else WerrorS("argument of gen must be positive");
3959  return (co<=0);
3960}
3961static BOOLEAN jjEXECUTE(leftv, leftv v)
3962{
3963  char * d = (char *)v->Data();
3964  char * s = (char *)omAlloc(strlen(d) + 13);
3965  strcpy( s, (char *)d);
3966  strcat( s, "\n;RETURN();\n");
3967  newBuffer(s,BT_execute);
3968  return yyparse();
3969}
3970#ifdef HAVE_FACTORY
3971static BOOLEAN jjFACSTD(leftv res, leftv v)
3972{
3973  lists L=(lists)omAllocBin(slists_bin);
3974  if (rField_is_Zp(currRing)
3975  || rField_is_Q(currRing)
3976  || rField_is_Zp_a(currRing)
3977  || rField_is_Q_a(currRing))
3978  {
3979    ideal_list p,h;
3980    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3981    if (h==NULL)
3982    {
3983      L->Init(1);
3984      L->m[0].data=(char *)idInit(1);
3985      L->m[0].rtyp=IDEAL_CMD;
3986    }
3987    else
3988    {
3989      p=h;
3990      int l=0;
3991      while (p!=NULL) { p=p->next;l++; }
3992      L->Init(l);
3993      l=0;
3994      while(h!=NULL)
3995      {
3996        L->m[l].data=(char *)h->d;
3997        L->m[l].rtyp=IDEAL_CMD;
3998        p=h->next;
3999        omFreeSize(h,sizeof(*h));
4000        h=p;
4001        l++;
4002      }
4003    }
4004  }
4005  else
4006  {
4007    WarnS("no factorization implemented");
4008    L->Init(1);
4009    iiExprArith1(&(L->m[0]),v,STD_CMD);
4010  }
4011  res->data=(void *)L;
4012  return FALSE;
4013}
4014static BOOLEAN jjFAC_P(leftv res, leftv u)
4015{
4016  intvec *v=NULL;
4017  singclap_factorize_retry=0;
4018  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4019  if (f==NULL) return TRUE;
4020  ivTest(v);
4021  lists l=(lists)omAllocBin(slists_bin);
4022  l->Init(2);
4023  l->m[0].rtyp=IDEAL_CMD;
4024  l->m[0].data=(void *)f;
4025  l->m[1].rtyp=INTVEC_CMD;
4026  l->m[1].data=(void *)v;
4027  res->data=(void *)l;
4028  return FALSE;
4029}
4030#endif
4031static BOOLEAN jjGETDUMP(leftv, leftv v)
4032{
4033  si_link l = (si_link)v->Data();
4034  if (slGetDump(l))
4035  {
4036    const char *s;
4037    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4038    else                            s=sNoName;
4039    Werror("cannot get dump from `%s`",s);
4040    return TRUE;
4041  }
4042  else
4043    return FALSE;
4044}
4045static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4046{
4047  assumeStdFlag(v);
4048  ideal I=(ideal)v->Data();
4049  res->data=(void *)iiHighCorner(I,0);
4050  return FALSE;
4051}
4052static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4053{
4054  assumeStdFlag(v);
4055  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4056  BOOLEAN delete_w=FALSE;
4057  ideal I=(ideal)v->Data();
4058  int i;
4059  poly p=NULL,po=NULL;
4060  int rk=id_RankFreeModule(I,currRing);
4061  if (w==NULL)
4062  {
4063    w = new intvec(rk);
4064    delete_w=TRUE;
4065  }
4066  for(i=rk;i>0;i--)
4067  {
4068    p=iiHighCorner(I,i);
4069    if (p==NULL)
4070    {
4071      WerrorS("module must be zero-dimensional");
4072      if (delete_w) delete w;
4073      return TRUE;
4074    }
4075    if (po==NULL)
4076    {
4077      po=p;
4078    }
4079    else
4080    {
4081      // now po!=NULL, p!=NULL
4082      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4083      if (d==0)
4084        d=pLmCmp(po,p);
4085      if (d > 0)
4086      {
4087        pDelete(&p);
4088      }
4089      else // (d < 0)
4090      {
4091        pDelete(&po); po=p;
4092      }
4093    }
4094  }
4095  if (delete_w) delete w;
4096  res->data=(void *)po;
4097  return FALSE;
4098}
4099static BOOLEAN jjHILBERT(leftv, leftv v)
4100{
4101#ifdef HAVE_RINGS
4102  if (rField_is_Ring_Z(currRing))
4103  {
4104    ring origR = currRing;
4105    ring tempR = rCopy(origR);
4106    coeffs new_cf=nInitChar(n_Q,NULL);
4107    nKillChar(tempR->cf);
4108    tempR->cf=new_cf;
4109    rComplete(tempR);
4110    ideal vid = (ideal)v->Data();
4111    rChangeCurrRing(tempR);
4112    ideal vv = idrCopyR(vid, origR, currRing);
4113    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4114    vvAsLeftv.rtyp = IDEAL_CMD;
4115    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4116    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4117    assumeStdFlag(&vvAsLeftv);
4118    Print("// NOTE: computation of Hilbert series etc. is being\n");
4119    Print("//       performed for generic fibre, that is, over Q\n");
4120    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4121    //scHilbertPoly(vv,currQuotient);
4122    hLookSeries(vv,module_w,currQuotient);
4123    idDelete(&vv);
4124    rChangeCurrRing(origR);
4125    rDelete(tempR);
4126    return FALSE;
4127  }
4128#endif
4129  assumeStdFlag(v);
4130  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4131  //scHilbertPoly((ideal)v->Data(),currQuotient);
4132  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4133  return FALSE;
4134}
4135static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4136{
4137#ifdef HAVE_RINGS
4138  if (rField_is_Ring_Z(currRing))
4139  {
4140    Print("// NOTE: computation of Hilbert series etc. is being\n");
4141    Print("//       performed for generic fibre, that is, over Q\n");
4142  }
4143#endif
4144  res->data=(void *)hSecondSeries((intvec *)v->Data());
4145  return FALSE;
4146}
4147static BOOLEAN jjHOMOG1(leftv res, leftv v)
4148{
4149  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4150  ideal v_id=(ideal)v->Data();
4151  if (w==NULL)
4152  {
4153    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4154    if (res->data!=NULL)
4155    {
4156      if (v->rtyp==IDHDL)
4157      {
4158        char *s_isHomog=omStrDup("isHomog");
4159        if (v->e==NULL)
4160          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4161        else
4162          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4163      }
4164      else if (w!=NULL) delete w;
4165    } // if res->data==NULL then w==NULL
4166  }
4167  else
4168  {
4169    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4170    if((res->data==NULL) && (v->rtyp==IDHDL))
4171    {
4172      if (v->e==NULL)
4173        atKill((idhdl)(v->data),"isHomog");
4174      else
4175        atKill((idhdl)(v->LData()),"isHomog");
4176    }
4177  }
4178  return FALSE;
4179}
4180static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4181{
4182  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4183  setFlag(res,FLAG_STD);
4184  return FALSE;
4185}
4186static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4187{
4188  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4189  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4190  if (IDELEMS((ideal)mat)==0)
4191  {
4192    idDelete((ideal *)&mat);
4193    mat=(matrix)idInit(1,1);
4194  }
4195  else
4196  {
4197    MATROWS(mat)=1;
4198    mat->rank=1;
4199    idTest((ideal)mat);
4200  }
4201  res->data=(char *)mat;
4202  return FALSE;
4203}
4204static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4205{
4206  map m=(map)v->CopyD(MAP_CMD);
4207  omFree((ADDRESS)m->preimage);
4208  m->preimage=NULL;
4209  ideal I=(ideal)m;
4210  I->rank=1;
4211  res->data=(char *)I;
4212  return FALSE;
4213}
4214static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4215{
4216  if (currRing!=NULL)
4217  {
4218    ring q=(ring)v->Data();
4219    if (rSamePolyRep(currRing, q))
4220    {
4221      if (q->qideal==NULL)
4222        res->data=(char *)idInit(1,1);
4223      else
4224        res->data=(char *)idCopy(q->qideal);
4225      return FALSE;
4226    }
4227  }
4228  WerrorS("can only get ideal from identical qring");
4229  return TRUE;
4230}
4231static BOOLEAN jjIm2Iv(leftv res, leftv v)
4232{
4233  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4234  iv->makeVector();
4235  res->data = iv;
4236  return FALSE;
4237}
4238static BOOLEAN jjIMPART(leftv res, leftv v)
4239{
4240  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4241  return FALSE;
4242}
4243static BOOLEAN jjINDEPSET(leftv res, leftv v)
4244{
4245  assumeStdFlag(v);
4246  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4247  return FALSE;
4248}
4249static BOOLEAN jjINTERRED(leftv res, leftv v)
4250{
4251  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4252  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4253  res->data = result;
4254  return FALSE;
4255}
4256static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4257{
4258  res->data = (char *)(long)pVar((poly)v->Data());
4259  return FALSE;
4260}
4261static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4262{
4263  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4264  return FALSE;
4265}
4266static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4267{
4268  res->data = (char *)0;
4269  return FALSE;
4270}
4271static BOOLEAN jjJACOB_P(leftv res, leftv v)
4272{
4273  ideal i=idInit(currRing->N,1);
4274  int k;
4275  poly p=(poly)(v->Data());
4276  for (k=currRing->N;k>0;k--)
4277  {
4278    i->m[k-1]=pDiff(p,k);
4279  }
4280  res->data = (char *)i;
4281  return FALSE;
4282}
4283/*2
4284 * compute Jacobi matrix of a module/matrix
4285 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4286 * where Mt := transpose(M)
4287 * Note that this is consistent with the current conventions for jacob in Singular,
4288 * whereas M2 computes its transposed.
4289 */
4290static BOOLEAN jjJACOB_M(leftv res, leftv a)
4291{
4292  ideal id = (ideal)a->Data();
4293  id = idTransp(id);
4294  int W = IDELEMS(id);
4295
4296  ideal result = idInit(W * currRing->N, id->rank);
4297  poly *p = result->m;
4298
4299  for( int v = 1; v <= currRing->N; v++ )
4300  {
4301    poly* q = id->m;
4302    for( int i = 0; i < W; i++, p++, q++ )
4303      *p = pDiff( *q, v );
4304  }
4305  idDelete(&id);
4306
4307  res->data = (char *)result;
4308  return FALSE;
4309}
4310
4311
4312static BOOLEAN jjKBASE(leftv res, leftv v)
4313{
4314  assumeStdFlag(v);
4315  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4316  return FALSE;
4317}
4318#ifdef MDEBUG
4319static BOOLEAN jjpHead(leftv res, leftv v)
4320{
4321  res->data=(char *)pHead((poly)v->Data());
4322  return FALSE;
4323}
4324#endif
4325static BOOLEAN jjL2R(leftv res, leftv v)
4326{
4327  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4328  if (res->data != NULL)
4329    return FALSE;
4330  else
4331    return TRUE;
4332}
4333static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4334{
4335  poly p=(poly)v->Data();
4336  if (p==NULL)
4337  {
4338    res->data=(char *)nInit(0);
4339  }
4340  else
4341  {
4342    res->data=(char *)nCopy(pGetCoeff(p));
4343  }
4344  return FALSE;
4345}
4346static BOOLEAN jjLEADEXP(leftv res, leftv v)
4347{
4348  poly p=(poly)v->Data();
4349  int s=currRing->N;
4350  if (v->Typ()==VECTOR_CMD) s++;
4351  intvec *iv=new intvec(s);
4352  if (p!=NULL)
4353  {
4354    for(int i = currRing->N;i;i--)
4355    {
4356      (*iv)[i-1]=pGetExp(p,i);
4357    }
4358    if (s!=currRing->N)
4359      (*iv)[currRing->N]=pGetComp(p);
4360  }
4361  res->data=(char *)iv;
4362  return FALSE;
4363}
4364static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4365{
4366  poly p=(poly)v->Data();
4367  if (p == NULL)
4368  {
4369    res->data = (char*) NULL;
4370  }
4371  else
4372  {
4373    poly lm = pLmInit(p);
4374    pSetCoeff(lm, nInit(1));
4375    res->data = (char*) lm;
4376  }
4377  return FALSE;
4378}
4379static BOOLEAN jjLOAD1(leftv res, leftv v)
4380{
4381  return jjLOAD(res, v,FALSE);
4382}
4383static BOOLEAN jjLISTRING(leftv res, leftv v)
4384{
4385  ring r=rCompose((lists)v->Data());
4386  if (r==NULL) return TRUE;
4387  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4388  res->data=(char *)r;
4389  return FALSE;
4390}
4391#if SIZEOF_LONG == 8
4392static number jjLONG2N(long d)
4393{
4394  int i=(int)d;
4395  if ((long)i == d)
4396  {
4397    return n_Init(i, coeffs_BIGINT);
4398  }
4399  else
4400  {
4401     struct snumber_dummy
4402     {
4403      mpz_t z;
4404      mpz_t n;
4405      #if defined(LDEBUG)
4406      int debug;
4407      #endif
4408      BOOLEAN s;
4409    };
4410    typedef struct snumber_dummy  *number_dummy;
4411
4412    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4413    #if defined(LDEBUG)
4414    z->debug=123456;
4415    #endif
4416    z->s=3;
4417    mpz_init_set_si(z->z,d);
4418    return (number)z;
4419  }
4420}
4421#else
4422#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4423#endif
4424static BOOLEAN jjPFAC1(leftv res, leftv v)
4425{
4426  /* call method jjPFAC2 with second argument = 0 (meaning that no
4427     valid bound for the prime factors has been given) */
4428  sleftv tmp;
4429  memset(&tmp, 0, sizeof(tmp));
4430  tmp.rtyp = INT_CMD;
4431  return jjPFAC2(res, v, &tmp);
4432}
4433static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4434{
4435  /* computes the LU-decomposition of a matrix M;
4436     i.e., M = P * L * U, where
4437        - P is a row permutation matrix,
4438        - L is in lower triangular form,
4439        - U is in upper row echelon form
4440     Then, we also have P * M = L * U.
4441     A list [P, L, U] is returned. */
4442  matrix mat = (const matrix)v->Data();
4443  if (!idIsConstant((ideal)mat))
4444  {
4445    WerrorS("matrix must be constant");
4446    return TRUE;
4447  }
4448  matrix pMat;
4449  matrix lMat;
4450  matrix uMat;
4451
4452  luDecomp(mat, pMat, lMat, uMat);
4453
4454  lists ll = (lists)omAllocBin(slists_bin);
4455  ll->Init(3);
4456  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4457  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4458  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4459  res->data=(char*)ll;
4460
4461  return FALSE;
4462}
4463static BOOLEAN jjMEMORY(leftv res, leftv v)
4464{
4465  omUpdateInfo();
4466  switch(((int)(long)v->Data()))
4467  {
4468  case 0:
4469    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4470    break;
4471  case 1:
4472    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4473    break;
4474  case 2:
4475    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4476    break;
4477  default:
4478    omPrintStats(stdout);
4479    omPrintInfo(stdout);
4480    omPrintBinStats(stdout);
4481    res->data = (char *)0;
4482    res->rtyp = NONE;
4483  }
4484  return FALSE;
4485  res->data = (char *)0;
4486  return FALSE;
4487}
4488//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4489//{
4490//  return jjMONITOR2(res,v,NULL);
4491//}
4492static BOOLEAN jjMSTD(leftv res, leftv v)
4493{
4494  int t=v->Typ();
4495  ideal r,m;
4496  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4497  lists l=(lists)omAllocBin(slists_bin);
4498  l->Init(2);
4499  l->m[0].rtyp=t;
4500  l->m[0].data=(char *)r;
4501  setFlag(&(l->m[0]),FLAG_STD);
4502  l->m[1].rtyp=t;
4503  l->m[1].data=(char *)m;
4504  res->data=(char *)l;
4505  return FALSE;
4506}
4507static BOOLEAN jjMULT(leftv res, leftv v)
4508{
4509  assumeStdFlag(v);
4510  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4511  return FALSE;
4512}
4513static BOOLEAN jjMINRES_R(leftv res, leftv v)
4514{
4515  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4516
4517  syStrategy tmp=(syStrategy)v->Data();
4518  tmp = syMinimize(tmp); // enrich itself!
4519
4520  res->data=(char *)tmp;
4521
4522  if (weights!=NULL)
4523    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4524
4525  return FALSE;
4526}
4527static BOOLEAN jjN2BI(leftv res, leftv v)
4528{
4529  number n,i; i=(number)v->Data();
4530  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4531  if (nMap!=NULL)
4532    n=nMap(i,currRing->cf,coeffs_BIGINT);
4533  else goto err;
4534  res->data=(void *)n;
4535  return FALSE;
4536err:
4537  WerrorS("cannot convert to bigint"); return TRUE;
4538}
4539static BOOLEAN jjNAMEOF(leftv res, leftv v)
4540{
4541  res->data = (char *)v->name;
4542  if (res->data==NULL) res->data=omStrDup("");
4543  v->name=NULL;
4544  return FALSE;
4545}
4546static BOOLEAN jjNAMES(leftv res, leftv v)
4547{
4548  res->data=ipNameList(((ring)v->Data())->idroot);
4549  return FALSE;
4550}
4551static BOOLEAN jjNVARS(leftv res, leftv v)
4552{
4553  res->data = (char *)(long)(((ring)(v->Data()))->N);
4554  return FALSE;
4555}
4556static BOOLEAN jjOpenClose(leftv, leftv v)
4557{
4558  si_link l=(si_link)v->Data();
4559  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4560  else                return slClose(l);
4561}
4562static BOOLEAN jjORD(leftv res, leftv v)
4563{
4564  poly p=(poly)v->Data();
4565  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4566  return FALSE;
4567}
4568static BOOLEAN jjPAR1(leftv res, leftv v)
4569{
4570  int i=(int)(long)v->Data();
4571  int p=0;
4572  p=rPar(currRing);
4573  if ((0<i) && (i<=p))
4574  {
4575    res->data=(char *)n_Param(i,currRing);
4576  }
4577  else
4578  {
4579    Werror("par number %d out of range 1..%d",i,p);
4580    return TRUE;
4581  }
4582  return FALSE;
4583}
4584static BOOLEAN jjPARDEG(leftv res, leftv v)
4585{
4586  number nn=(number)v->Data();
4587  res->data = (char *)(long)n_ParDeg(nn, currRing);
4588  return FALSE;
4589}
4590static BOOLEAN jjPARSTR1(leftv res, leftv v)
4591{
4592  if (currRing==NULL)
4593  {
4594    WerrorS("no ring active");
4595    return TRUE;
4596  }
4597  int i=(int)(long)v->Data();
4598  int p=0;
4599  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4600    res->data=omStrDup(rParameter(currRing)[i-1]);
4601  else
4602  {
4603    Werror("par number %d out of range 1..%d",i,p);
4604    return TRUE;
4605  }
4606  return FALSE;
4607}
4608static BOOLEAN jjP2BI(leftv res, leftv v)
4609{
4610  poly p=(poly)v->Data();
4611  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4612  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4613  {
4614    WerrorS("poly must be constant");
4615    return TRUE;
4616  }
4617  number i=pGetCoeff(p);
4618  number n;
4619  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4620  if (nMap!=NULL)
4621    n=nMap(i,currRing->cf,coeffs_BIGINT);
4622  else goto err;
4623  res->data=(void *)n;
4624  return FALSE;
4625err:
4626  WerrorS("cannot convert to bigint"); return TRUE;
4627}
4628static BOOLEAN jjP2I(leftv res, leftv v)
4629{
4630  poly p=(poly)v->Data();
4631  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4632  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4633  {
4634    WerrorS("poly must be constant");
4635    return TRUE;
4636  }
4637  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4638  return FALSE;
4639}
4640static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4641{
4642  map mapping=(map)v->Data();
4643  syMake(res,omStrDup(mapping->preimage));
4644  return FALSE;
4645}
4646static BOOLEAN jjPRIME(leftv res, leftv v)
4647{
4648  int i = IsPrime((int)(long)(v->Data()));
4649  res->data = (char *)(long)(i > 1 ? i : 2);
4650  return FALSE;
4651}
4652static BOOLEAN jjPRUNE(leftv res, leftv v)
4653{
4654  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4655  ideal v_id=(ideal)v->Data();
4656  if (w!=NULL)
4657  {
4658    if (!idTestHomModule(v_id,currQuotient,w))
4659    {
4660      WarnS("wrong weights");
4661      w=NULL;
4662      // and continue at the non-homog case below
4663    }
4664    else
4665    {
4666      w=ivCopy(w);
4667      intvec **ww=&w;
4668      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4669      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4670      return FALSE;
4671    }
4672  }
4673  res->data = (char *)idMinEmbedding(v_id);
4674  return FALSE;
4675}
4676static BOOLEAN jjP2N(leftv res, leftv v)
4677{
4678  number n;
4679  poly p;
4680  if (((p=(poly)v->Data())!=NULL)
4681  && (pIsConstant(p)))
4682  {
4683    n=nCopy(pGetCoeff(p));
4684  }
4685  else
4686  {
4687    n=nInit(0);
4688  }
4689  res->data = (char *)n;
4690  return FALSE;
4691}
4692static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4693{
4694  char *s= (char *)v->Data();
4695  int i = 1;
4696  for(i=0; i<sArithBase.nCmdUsed; i++)
4697  {
4698    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4699    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4700    {
4701      res->data = (char *)1;
4702      return FALSE;
4703    }
4704  }
4705  //res->data = (char *)0;
4706  return FALSE;
4707}
4708static BOOLEAN jjRANK1(leftv res, leftv v)
4709{
4710  matrix m =(matrix)v->Data();
4711  int rank = luRank(m, 0);
4712  res->data =(char *)(long)rank;
4713  return FALSE;
4714}
4715static BOOLEAN jjREAD(leftv res, leftv v)
4716{
4717  return jjREAD2(res,v,NULL);
4718}
4719static BOOLEAN jjREGULARITY(leftv res, leftv v)
4720{
4721  res->data = (char *)(long)iiRegularity((lists)v->Data());
4722  return FALSE;
4723}
4724static BOOLEAN jjREPART(leftv res, leftv v)
4725{
4726  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4727  return FALSE;
4728}
4729static BOOLEAN jjRINGLIST(leftv res, leftv v)
4730{
4731  ring r=(ring)v->Data();
4732  if (r!=NULL)
4733    res->data = (char *)rDecompose((ring)v->Data());
4734  return (r==NULL)||(res->data==NULL);
4735}
4736static BOOLEAN jjROWS(leftv res, leftv v)
4737{
4738  ideal i = (ideal)v->Data();
4739  res->data = (char *)i->rank;
4740  return FALSE;
4741}
4742static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4743{
4744  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4745  return FALSE;
4746}
4747static BOOLEAN jjROWS_IV(leftv res, leftv v)
4748{
4749  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4750  return FALSE;
4751}
4752static BOOLEAN jjRPAR(leftv res, leftv v)
4753{
4754  res->data = (char *)(long)rPar(((ring)v->Data()));
4755  return FALSE;
4756}
4757static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4758{
4759#ifdef HAVE_PLURAL
4760  const bool bIsSCA = rIsSCA(currRing);
4761#else
4762  const bool bIsSCA = false;
4763#endif
4764
4765  if ((currQuotient!=NULL) && !bIsSCA)
4766  {
4767    WerrorS("qring not supported by slimgb at the moment");
4768    return TRUE;
4769  }
4770  if (rHasLocalOrMixedOrdering_currRing())
4771  {
4772    WerrorS("ordering must be global for slimgb");
4773    return TRUE;
4774  }
4775  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4776  tHomog hom=testHomog;
4777  ideal u_id=(ideal)u->Data();
4778  if (w!=NULL)
4779  {
4780    if (!idTestHomModule(u_id,currQuotient,w))
4781    {
4782      WarnS("wrong weights");
4783      w=NULL;
4784    }
4785    else
4786    {
4787      w=ivCopy(w);
4788      hom=isHomog;
4789    }
4790  }
4791
4792  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4793  res->data=(char *)t_rep_gb(currRing,
4794    u_id,u_id->rank);
4795  //res->data=(char *)t_rep_gb(currRing, u_id);
4796
4797  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4798  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4799  return FALSE;
4800}
4801static BOOLEAN jjSBA(leftv res, leftv v)
4802{
4803  ideal result;
4804  ideal v_id=(ideal)v->Data();
4805  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4806  tHomog hom=testHomog;
4807  if (w!=NULL)
4808  {
4809    if (!idTestHomModule(v_id,currQuotient,w))
4810    {
4811      WarnS("wrong weights");
4812      w=NULL;
4813    }
4814    else
4815    {
4816      hom=isHomog;
4817      w=ivCopy(w);
4818    }
4819  }
4820  result=kSba(v_id,currQuotient,hom,&w,1,0);
4821  idSkipZeroes(result);
4822  res->data = (char *)result;
4823  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4824  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4825  return FALSE;
4826}
4827static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4828{
4829  ideal result;
4830  ideal v_id=(ideal)v->Data();
4831  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4832  tHomog hom=testHomog;
4833  if (w!=NULL)
4834  {
4835    if (!idTestHomModule(v_id,currQuotient,w))
4836    {
4837      WarnS("wrong weights");
4838      w=NULL;
4839    }
4840    else
4841    {
4842      hom=isHomog;
4843      w=ivCopy(w);
4844    }
4845  }
4846  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4847  idSkipZeroes(result);
4848  res->data = (char *)result;
4849  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4850  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4851  return FALSE;
4852}
4853static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4854{
4855  ideal result;
4856  ideal v_id=(ideal)v->Data();
4857  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4858  tHomog hom=testHomog;
4859  if (w!=NULL)
4860  {
4861    if (!idTestHomModule(v_id,currQuotient,w))
4862    {
4863      WarnS("wrong weights");
4864      w=NULL;
4865    }
4866    else
4867    {
4868      hom=isHomog;
4869      w=ivCopy(w);
4870    }
4871  }
4872  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4873  idSkipZeroes(result);
4874  res->data = (char *)result;
4875  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4876  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4877  return FALSE;
4878}
4879static BOOLEAN jjSTD(leftv res, leftv v)
4880{
4881  ideal result;
4882  ideal v_id=(ideal)v->Data();
4883  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4884  tHomog hom=testHomog;
4885  if (w!=NULL)
4886  {
4887    if (!idTestHomModule(v_id,currQuotient,w))
4888    {
4889      WarnS("wrong weights");
4890      w=NULL;
4891    }
4892    else
4893    {
4894      hom=isHomog;
4895      w=ivCopy(w);
4896    }
4897  }
4898  result=kStd(v_id,currQuotient,hom,&w);
4899  idSkipZeroes(result);
4900  res->data = (char *)result;
4901  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4902  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4903  return FALSE;
4904}
4905static BOOLEAN jjSort_Id(leftv res, leftv v)
4906{
4907  res->data = (char *)idSort((ideal)v->Data());
4908  return FALSE;
4909}
4910#ifdef HAVE_FACTORY
4911static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4912{
4913  singclap_factorize_retry=0;
4914  intvec *v=NULL;
4915  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4916  if (f==NULL) return TRUE;
4917  ivTest(v);
4918  lists l=(lists)omAllocBin(slists_bin);
4919  l->Init(2);
4920  l->m[0].rtyp=IDEAL_CMD;
4921  l->m[0].data=(void *)f;
4922  l->m[1].rtyp=INTVEC_CMD;
4923  l->m[1].data=(void *)v;
4924  res->data=(void *)l;
4925  return FALSE;
4926}
4927#endif
4928#if 1
4929static BOOLEAN jjSYZYGY(leftv res, leftv v)
4930{
4931  intvec *w=NULL;
4932  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4933  if (w!=NULL) delete w;
4934  return FALSE;
4935}
4936#else
4937// activate, if idSyz handle module weights correctly !
4938static BOOLEAN jjSYZYGY(leftv res, leftv v)
4939{
4940  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4941  ideal v_id=(ideal)v->Data();
4942  tHomog hom=testHomog;
4943  int add_row_shift=0;
4944  if (w!=NULL)
4945  {
4946    w=ivCopy(w);
4947    add_row_shift=w->min_in();
4948    (*w)-=add_row_shift;
4949    if (idTestHomModule(v_id,currQuotient,w))
4950      hom=isHomog;
4951    else
4952    {
4953      //WarnS("wrong weights");
4954      delete w; w=NULL;
4955      hom=testHomog;
4956    }
4957  }
4958  res->data = (char *)idSyzygies(v_id,hom,&w);
4959  if (w!=NULL)
4960  {
4961    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4962  }
4963  return FALSE;
4964}
4965#endif
4966static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4967{
4968  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4969  return FALSE;
4970}
4971static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
4972{
4973  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
4974  return FALSE;
4975}
4976static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4977{
4978  res->data = (char *)ivTranp((intvec*)(v->Data()));
4979  return FALSE;
4980}
4981#ifdef HAVE_PLURAL
4982static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4983{
4984  ring    r = (ring)a->Data();
4985  //if (rIsPluralRing(r))
4986  if (r->OrdSgn==1)
4987  {
4988    res->data = rOpposite(r);
4989  }
4990  else
4991  {
4992    WarnS("opposite only for global orderings");
4993    res->data = rCopy(r);
4994  }
4995  return FALSE;
4996}
4997static BOOLEAN jjENVELOPE(leftv res, leftv a)
4998{
4999  ring    r = (ring)a->Data();
5000  if (rIsPluralRing(r))
5001  {
5002    //    ideal   i;
5003//     if (a->rtyp == QRING_CMD)
5004//     {
5005//       i = r->qideal;
5006//       r->qideal = NULL;
5007//     }
5008    ring s = rEnvelope(r);
5009//     if (a->rtyp == QRING_CMD)
5010//     {
5011//       ideal is  = idOppose(r,i); /* twostd? */
5012//       is        = idAdd(is,i);
5013//       s->qideal = i;
5014//     }
5015    res->data = s;
5016  }
5017  else  res->data = rCopy(r);
5018  return FALSE;
5019}
5020static BOOLEAN jjTWOSTD(leftv res, leftv a)
5021{
5022  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5023  else  res->data=(ideal)a->CopyD();
5024  setFlag(res,FLAG_STD);
5025  setFlag(res,FLAG_TWOSTD);
5026  return FALSE;
5027}
5028#endif
5029
5030static BOOLEAN jjTYPEOF(leftv res, leftv v)
5031{
5032  int t=(int)(long)v->data;
5033  switch (t)
5034  {
5035    case INT_CMD:        res->data=omStrDup("int"); break;
5036    case POLY_CMD:       res->data=omStrDup("poly"); break;
5037    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5038    case STRING_CMD:     res->data=omStrDup("string"); break;
5039    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5040    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5041    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5042    case MODUL_CMD:      res->data=omStrDup("module"); break;
5043    case MAP_CMD:        res->data=omStrDup("map"); break;
5044    case PROC_CMD:       res->data=omStrDup("proc"); break;
5045    case RING_CMD:       res->data=omStrDup("ring"); break;
5046    case QRING_CMD:      res->data=omStrDup("qring"); break;
5047    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5048    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5049    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5050    case LIST_CMD:       res->data=omStrDup("list"); break;
5051    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5052    case LINK_CMD:       res->data=omStrDup("link"); break;
5053    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5054    case DEF_CMD:
5055    case NONE:           res->data=omStrDup("none"); break;
5056    default:
5057    {
5058      if (t>MAX_TOK)
5059        res->data=omStrDup(getBlackboxName(t));
5060      else
5061        res->data=omStrDup("?unknown type?");
5062      break;
5063    }
5064  }
5065  return FALSE;
5066}
5067static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5068{
5069  res->data=(char *)pIsUnivariate((poly)v->Data());
5070  return FALSE;
5071}
5072static BOOLEAN jjVAR1(leftv res, leftv v)
5073{
5074  int i=(int)(long)v->Data();
5075  if ((0<i) && (i<=currRing->N))
5076  {
5077    poly p=pOne();
5078    pSetExp(p,i,1);
5079    pSetm(p);
5080    res->data=(char *)p;
5081  }
5082  else
5083  {
5084    Werror("var number %d out of range 1..%d",i,currRing->N);
5085    return TRUE;
5086  }
5087  return FALSE;
5088}
5089static BOOLEAN jjVARSTR1(leftv res, leftv v)
5090{
5091  if (currRing==NULL)
5092  {
5093    WerrorS("no ring active");
5094    return TRUE;
5095  }
5096  int i=(int)(long)v->Data();
5097  if ((0<i) && (i<=currRing->N))
5098    res->data=omStrDup(currRing->names[i-1]);
5099  else
5100  {
5101    Werror("var number %d out of range 1..%d",i,currRing->N);
5102    return TRUE;
5103  }
5104  return FALSE;
5105}
5106static BOOLEAN jjVDIM(leftv res, leftv v)
5107{
5108  assumeStdFlag(v);
5109  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5110  return FALSE;
5111}
5112BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5113{
5114// input: u: a list with links of type
5115//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5116// returns: -1:  the read state of all links is eof
5117//          i>0: (at least) u[i] is ready
5118  lists Lforks = (lists)u->Data();
5119  int i = slStatusSsiL(Lforks, -1);
5120  if(i == -2) /* error */
5121  {
5122    return TRUE;
5123  }
5124  res->data = (void*)(long)i;
5125  return FALSE;
5126}
5127BOOLEAN jjWAITALL1(leftv res, leftv u)
5128{
5129// input: u: a list with links of type
5130//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5131// returns: -1: the read state of all links is eof
5132//           1: all links are ready
5133//              (caution: at least one is ready, but some maybe dead)
5134  lists Lforks = (lists)u->CopyD();
5135  int i;
5136  int j = -1;
5137  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5138  {
5139    i = slStatusSsiL(Lforks, -1);
5140    if(i == -2) /* error */
5141    {
5142      return TRUE;
5143    }
5144    if(i == -1)
5145    {
5146      break;
5147    }
5148    j = 1;
5149    Lforks->m[i-1].CleanUp();
5150    Lforks->m[i-1].rtyp=DEF_CMD;
5151    Lforks->m[i-1].data=NULL;
5152  }
5153  res->data = (void*)(long)j;
5154  Lforks->Clean();
5155  return FALSE;
5156}
5157static BOOLEAN jjLOAD(leftv, leftv v, BOOLEAN autoexport)
5158{
5159  char * s=(char *)v->CopyD();
5160  char libnamebuf[256];
5161  lib_types LT = type_of_LIB(s, libnamebuf);
5162#ifdef HAVE_DYNAMIC_LOADING
5163  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5164#endif /* HAVE_DYNAMIC_LOADING */
5165  switch(LT)
5166  {
5167      default:
5168      case LT_NONE:
5169        Werror("%s: unknown type", s);
5170        break;
5171      case LT_NOTFOUND:
5172        Werror("cannot open %s", s);
5173        break;
5174
5175      case LT_SINGULAR:
5176      {
5177        char *plib = iiConvName(s);
5178        idhdl pl = IDROOT->get(plib,0);
5179        if (pl==NULL)
5180        {
5181          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5182          IDPACKAGE(pl)->language = LANG_SINGULAR;
5183          IDPACKAGE(pl)->libname=omStrDup(plib);
5184        }
5185        else if (IDTYP(pl)!=PACKAGE_CMD)
5186        {
5187          Werror("can not create package `%s`",plib);
5188          omFree(plib);
5189          return TRUE;
5190        }
5191        package savepack=currPack;
5192        currPack=IDPACKAGE(pl);
5193        IDPACKAGE(pl)->loaded=TRUE;
5194        char libnamebuf[256];
5195        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5196        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5197        currPack=savepack;
5198        IDPACKAGE(pl)->loaded=(!bo);
5199        return bo;
5200      }
5201      case LT_MACH_O:
5202      case LT_ELF:
5203      case LT_HPUX:
5204#ifdef HAVE_DYNAMIC_LOADING
5205        return load_modules(s, libnamebuf, autoexport);
5206#else /* HAVE_DYNAMIC_LOADING */
5207        WerrorS("Dynamic modules are not supported by this version of Singular");
5208        break;
5209#endif /* HAVE_DYNAMIC_LOADING */
5210  }
5211  return TRUE;
5212}
5213
5214#ifdef INIT_BUG
5215#define XS(A) -((short)A)
5216#define jjstrlen       (proc1)1
5217#define jjpLength      (proc1)2
5218#define jjidElem       (proc1)3
5219#define jjmpDetBareiss (proc1)4
5220#define jjidFreeModule (proc1)5
5221#define jjidVec2Ideal  (proc1)6
5222#define jjrCharStr     (proc1)7
5223#ifndef MDEBUG
5224#define jjpHead        (proc1)8
5225#endif
5226#define jjidMinBase    (proc1)11
5227#define jjsyMinBase    (proc1)12
5228#define jjpMaxComp     (proc1)13
5229#define jjmpTrace      (proc1)14
5230#define jjmpTransp     (proc1)15
5231#define jjrOrdStr      (proc1)16
5232#define jjrVarStr      (proc1)18
5233#define jjrParStr      (proc1)19
5234#define jjCOUNT_RES    (proc1)22
5235#define jjDIM_R        (proc1)23
5236#define jjidTransp     (proc1)24
5237
5238extern struct sValCmd1 dArith1[];
5239void jjInitTab1()
5240{
5241  int i=0;
5242  for (;dArith1[i].cmd!=0;i++)
5243  {
5244    if (dArith1[i].res<0)
5245    {
5246      switch ((int)dArith1[i].p)
5247      {
5248        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5249        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5250        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5251        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5252#ifndef HAVE_FACTORY
5253        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5254#endif
5255        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5256        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5257#ifndef MDEBUG
5258        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5259#endif
5260        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5261        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5262        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5263        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5264        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5265        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5266        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5267        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5268        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5269        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5270        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5271        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5272      }
5273    }
5274  }
5275}
5276#else
5277#if defined(PROC_BUG)
5278#define XS(A) A
5279static BOOLEAN jjstrlen(leftv res, leftv v)
5280{
5281  res->data = (char *)strlen((char *)v->Data());
5282  return FALSE;
5283}
5284static BOOLEAN jjpLength(leftv res, leftv v)
5285{
5286  res->data = (char *)pLength((poly)v->Data());
5287  return FALSE;
5288}
5289static BOOLEAN jjidElem(leftv res, leftv v)
5290{
5291  res->data = (char *)idElem((ideal)v->Data());
5292  return FALSE;
5293}
5294static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5295{
5296  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5297  return FALSE;
5298}
5299static BOOLEAN jjidFreeModule(leftv res, leftv v)
5300{
5301  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5302  return FALSE;
5303}
5304static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5305{
5306  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5307  return FALSE;
5308}
5309static BOOLEAN jjrCharStr(leftv res, leftv v)
5310{
5311  res->data = rCharStr((ring)v->Data());
5312  return FALSE;
5313}
5314#ifndef MDEBUG
5315static BOOLEAN jjpHead(leftv res, leftv v)
5316{
5317  res->data = (char *)pHead((poly)v->Data());
5318  return FALSE;
5319}
5320#endif
5321static BOOLEAN jjidHead(leftv res, leftv v)
5322{
5323  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5324  return FALSE;
5325}
5326static BOOLEAN jjidMinBase(leftv res, leftv v)
5327{
5328  res->data = (char *)idMinBase((ideal)v->Data());
5329  return FALSE;
5330}
5331static BOOLEAN jjsyMinBase(leftv res, leftv v)
5332{
5333  res->data = (char *)syMinBase((ideal)v->Data());
5334  return FALSE;
5335}
5336static BOOLEAN jjpMaxComp(leftv res, leftv v)
5337{
5338  res->data = (char *)pMaxComp((poly)v->Data());
5339  return FALSE;
5340}
5341static BOOLEAN jjmpTrace(leftv res, leftv v)
5342{
5343  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5344  return FALSE;
5345}
5346static BOOLEAN jjmpTransp(leftv res, leftv v)
5347{
5348  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5349  return FALSE;
5350}
5351static BOOLEAN jjrOrdStr(leftv res, leftv v)
5352{
5353  res->data = rOrdStr((ring)v->Data());
5354  return FALSE;
5355}
5356static BOOLEAN jjrVarStr(leftv res, leftv v)
5357{
5358  res->data = rVarStr((ring)v->Data());
5359  return FALSE;
5360}
5361static BOOLEAN jjrParStr(leftv res, leftv v)
5362{
5363  res->data = rParStr((ring)v->Data());
5364  return FALSE;
5365}
5366static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5367{
5368  res->data=(char *)sySize((syStrategy)v->Data());
5369  return FALSE;
5370}
5371static BOOLEAN jjDIM_R(leftv res, leftv v)
5372{
5373  res->data = (char *)syDim((syStrategy)v->Data());
5374  return FALSE;
5375}
5376static BOOLEAN jjidTransp(leftv res, leftv v)
5377{
5378  res->data = (char *)idTransp((ideal)v->Data());
5379  return FALSE;
5380}
5381#else
5382#define XS(A)          -((short)A)
5383#define jjstrlen       (proc1)strlen
5384#define jjpLength      (proc1)pLength
5385#define jjidElem       (proc1)idElem
5386#define jjmpDetBareiss (proc1)mpDetBareiss
5387#define jjidFreeModule (proc1)idFreeModule
5388#define jjidVec2Ideal  (proc1)idVec2Ideal
5389#define jjrCharStr     (proc1)rCharStr
5390#ifndef MDEBUG
5391#define jjpHead        (proc1)pHeadProc
5392#endif
5393#define jjidHead       (proc1)idHead
5394#define jjidMinBase    (proc1)idMinBase
5395#define jjsyMinBase    (proc1)syMinBase
5396#define jjpMaxComp     (proc1)pMaxCompProc
5397#define jjrOrdStr      (proc1)rOrdStr
5398#define jjrVarStr      (proc1)rVarStr
5399#define jjrParStr      (proc1)rParStr
5400#define jjCOUNT_RES    (proc1)sySize
5401#define jjDIM_R        (proc1)syDim
5402#define jjidTransp     (proc1)idTransp
5403#endif
5404#endif
5405static BOOLEAN jjnInt(leftv res, leftv u)
5406{
5407  number n=(number)u->Data();
5408  res->data=(char *)(long)n_Int(n,currRing->cf);
5409  return FALSE;
5410}
5411static BOOLEAN jjnlInt(leftv res, leftv u)
5412{
5413  number n=(number)u->Data();
5414  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5415  return FALSE;
5416}
5417/*=================== operations with 3 args.: static proc =================*/
5418/* must be ordered: first operations for chars (infix ops),
5419 * then alphabetically */
5420static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5421{
5422  char *s= (char *)u->Data();
5423  int   r = (int)(long)v->Data();
5424  int   c = (int)(long)w->Data();
5425  int l = strlen(s);
5426
5427  if ( (r<1) || (r>l) || (c<0) )
5428  {
5429    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5430    return TRUE;
5431  }
5432  res->data = (char *)omAlloc((long)(c+1));
5433  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5434  return FALSE;
5435}
5436static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5437{
5438  intvec *iv = (intvec *)u->Data();
5439  int   r = (int)(long)v->Data();
5440  int   c = (int)(long)w->Data();
5441  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5442  {
5443    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5444           r,c,u->Fullname(),iv->rows(),iv->cols());
5445    return TRUE;
5446  }
5447  res->data=u->data; u->data=NULL;
5448  res->rtyp=u->rtyp; u->rtyp=0;
5449  res->name=u->name; u->name=NULL;
5450  Subexpr e=jjMakeSub(v);
5451          e->next=jjMakeSub(w);
5452  if (u->e==NULL) res->e=e;
5453  else
5454  {
5455    Subexpr h=u->e;
5456    while (h->next!=NULL) h=h->next;
5457    h->next=e;
5458    res->e=u->e;
5459    u->e=NULL;
5460  }
5461  return FALSE;
5462}
5463static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5464{
5465  bigintmat *bim = (bigintmat *)u->Data();
5466  int   r = (int)(long)v->Data();
5467  int   c = (int)(long)w->Data();
5468  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5469  {
5470    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5471           r,c,u->Fullname(),bim->rows(),bim->cols());
5472    return TRUE;
5473  }
5474  res->data=u->data; u->data=NULL;
5475  res->rtyp=u->rtyp; u->rtyp=0;
5476  res->name=u->name; u->name=NULL;
5477  Subexpr e=jjMakeSub(v);
5478          e->next=jjMakeSub(w);
5479  if (u->e==NULL)
5480    res->e=e;
5481  else
5482  {
5483    Subexpr h=u->e;
5484    while (h->next!=NULL) h=h->next;
5485    h->next=e;
5486    res->e=u->e;
5487    u->e=NULL;
5488  }
5489  return FALSE;
5490}
5491static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5492{
5493  matrix m= (matrix)u->Data();
5494  int   r = (int)(long)v->Data();
5495  int   c = (int)(long)w->Data();
5496  //Print("gen. elem %d, %d\n",r,c);
5497  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5498  {
5499    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5500      MATROWS(m),MATCOLS(m));
5501    return TRUE;
5502  }
5503  res->data=u->data; u->data=NULL;
5504  res->rtyp=u->rtyp; u->rtyp=0;
5505  res->name=u->name; u->name=NULL;
5506  Subexpr e=jjMakeSub(v);
5507          e->next=jjMakeSub(w);
5508  if (u->e==NULL)
5509    res->e=e;
5510  else
5511  {
5512    Subexpr h=u->e;
5513    while (h->next!=NULL) h=h->next;
5514    h->next=e;
5515    res->e=u->e;
5516    u->e=NULL;
5517  }
5518  return FALSE;
5519}
5520static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5521{
5522  sleftv t;
5523  sleftv ut;
5524  leftv p=NULL;
5525  intvec *iv=(intvec *)w->Data();
5526  int l;
5527  BOOLEAN nok;
5528
5529  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5530  {
5531    WerrorS("cannot build expression lists from unnamed objects");
5532    return TRUE;
5533  }
5534  memcpy(&ut,u,sizeof(ut));
5535  memset(&t,0,sizeof(t));
5536  t.rtyp=INT_CMD;
5537  for (l=0;l< iv->length(); l++)
5538  {
5539    t.data=(char *)(long)((*iv)[l]);
5540    if (p==NULL)
5541    {
5542      p=res;
5543    }
5544    else
5545    {
5546      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5547      p=p->next;
5548    }
5549    memcpy(u,&ut,sizeof(ut));
5550    if (u->Typ() == MATRIX_CMD)
5551      nok=jjBRACK_Ma(p,u,v,&t);
5552    else /* INTMAT_CMD */
5553      nok=jjBRACK_Im(p,u,v,&t);
5554    if (nok)
5555    {
5556      while (res->next!=NULL)
5557      {
5558        p=res->next->next;
5559        omFreeBin((ADDRESS)res->next, sleftv_bin);
5560        // res->e aufraeumen !!!!
5561        res->next=p;
5562      }
5563      return TRUE;
5564    }
5565  }
5566  return FALSE;
5567}
5568static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5569{
5570  sleftv t;
5571  sleftv ut;
5572  leftv p=NULL;
5573  intvec *iv=(intvec *)v->Data();
5574  int l;
5575  BOOLEAN nok;
5576
5577  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5578  {
5579    WerrorS("cannot build expression lists from unnamed objects");
5580    return TRUE;
5581  }
5582  memcpy(&ut,u,sizeof(ut));
5583  memset(&t,0,sizeof(t));
5584  t.rtyp=INT_CMD;
5585  for (l=0;l< iv->length(); l++)
5586  {
5587    t.data=(char *)(long)((*iv)[l]);
5588    if (p==NULL)
5589    {
5590      p=res;
5591    }
5592    else
5593    {
5594      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5595      p=p->next;
5596    }
5597    memcpy(u,&ut,sizeof(ut));
5598    if (u->Typ() == MATRIX_CMD)
5599      nok=jjBRACK_Ma(p,u,&t,w);
5600    else /* INTMAT_CMD */
5601      nok=jjBRACK_Im(p,u,&t,w);
5602    if (nok)
5603    {
5604      while (res->next!=NULL)
5605      {
5606        p=res->next->next;
5607        omFreeBin((ADDRESS)res->next, sleftv_bin);
5608        // res->e aufraeumen !!
5609        res->next=p;
5610      }
5611      return TRUE;
5612    }
5613  }
5614  return FALSE;
5615}
5616static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5617{
5618  sleftv t1,t2,ut;
5619  leftv p=NULL;
5620  intvec *vv=(intvec *)v->Data();
5621  intvec *wv=(intvec *)w->Data();
5622  int vl;
5623  int wl;
5624  BOOLEAN nok;
5625
5626  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5627  {
5628    WerrorS("cannot build expression lists from unnamed objects");
5629    return TRUE;
5630  }
5631  memcpy(&ut,u,sizeof(ut));
5632  memset(&t1,0,sizeof(sleftv));
5633  memset(&t2,0,sizeof(sleftv));
5634  t1.rtyp=INT_CMD;
5635  t2.rtyp=INT_CMD;
5636  for (vl=0;vl< vv->length(); vl++)
5637  {
5638    t1.data=(char *)(long)((*vv)[vl]);
5639    for (wl=0;wl< wv->length(); wl++)
5640    {
5641      t2.data=(char *)(long)((*wv)[wl]);
5642      if (p==NULL)
5643      {
5644        p=res;
5645      }
5646      else
5647      {
5648        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5649        p=p->next;
5650      }
5651      memcpy(u,&ut,sizeof(ut));
5652      if (u->Typ() == MATRIX_CMD)
5653        nok=jjBRACK_Ma(p,u,&t1,&t2);
5654      else /* INTMAT_CMD */
5655        nok=jjBRACK_Im(p,u,&t1,&t2);
5656      if (nok)
5657      {
5658        res->CleanUp();
5659        return TRUE;
5660      }
5661    }
5662  }
5663  return FALSE;
5664}
5665static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5666{
5667  v->next=(leftv)omAllocBin(sleftv_bin);
5668  memcpy(v->next,w,sizeof(sleftv));
5669  memset(w,0,sizeof(sleftv));
5670  return jjPROC(res,u,v);
5671}
5672static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5673{
5674  intvec *iv;
5675  ideal m;
5676  lists l=(lists)omAllocBin(slists_bin);
5677  int k=(int)(long)w->Data();
5678  if (k>=0)
5679  {
5680    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5681    l->Init(2);
5682    l->m[0].rtyp=MODUL_CMD;
5683    l->m[1].rtyp=INTVEC_CMD;
5684    l->m[0].data=(void *)m;
5685    l->m[1].data=(void *)iv;
5686  }
5687  else
5688  {
5689    m=sm_CallSolv((ideal)u->Data(), currRing);
5690    l->Init(1);
5691    l->m[0].rtyp=IDEAL_CMD;
5692    l->m[0].data=(void *)m;
5693  }
5694  res->data = (char *)l;
5695  return FALSE;
5696}
5697static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5698{
5699  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5700  {
5701    WerrorS("3rd argument must be a name of a matrix");
5702    return TRUE;
5703  }
5704  ideal i=(ideal)u->Data();
5705  int rank=(int)i->rank;
5706  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5707  if (r) return TRUE;
5708  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5709  return FALSE;
5710}
5711static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5712{
5713  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5714           (ideal)(v->Data()),(poly)(w->Data()));
5715  return FALSE;
5716}
5717static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5718{
5719  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5720  {
5721    WerrorS("3rd argument must be a name of a matrix");
5722    return TRUE;
5723  }
5724  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5725  poly p=(poly)u->CopyD(POLY_CMD);
5726  ideal i=idInit(1,1);
5727  i->m[0]=p;
5728  sleftv t;
5729  memset(&t,0,sizeof(t));
5730  t.data=(char *)i;
5731  t.rtyp=IDEAL_CMD;
5732  int rank=1;
5733  if (u->Typ()==VECTOR_CMD)
5734  {
5735    i->rank=rank=pMaxComp(p);
5736    t.rtyp=MODUL_CMD;
5737  }
5738  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5739  t.CleanUp();
5740  if (r) return TRUE;
5741  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5742  return FALSE;
5743}
5744static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5745{
5746  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5747    (intvec *)w->Data());
5748  //setFlag(res,FLAG_STD);
5749  return FALSE;
5750}
5751static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5752{
5753  /*4
5754  * look for the substring what in the string where
5755  * starting at position n
5756  * return the position of the first char of what in where
5757  * or 0
5758  */
5759  int n=(int)(long)w->Data();
5760  char *where=(char *)u->Data();
5761  char *what=(char *)v->Data();
5762  char *found;
5763  if ((1>n)||(n>(int)strlen(where)))
5764  {
5765    Werror("start position %d out of range",n);
5766    return TRUE;
5767  }
5768  found = strchr(where+n-1,*what);
5769  if (*(what+1)!='\0')
5770  {
5771    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5772    {
5773      found=strchr(found+1,*what);
5774    }
5775  }
5776  if (found != NULL)
5777  {
5778    res->data=(char *)((found-where)+1);
5779  }
5780  return FALSE;
5781}
5782static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5783{
5784  if ((int)(long)w->Data()==0)
5785    res->data=(char *)walkProc(u,v);
5786  else
5787    res->data=(char *)fractalWalkProc(u,v);
5788  setFlag( res, FLAG_STD );
5789  return FALSE;
5790}
5791static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5792{
5793  intvec *wdegree=(intvec*)w->Data();
5794  if (wdegree->length()!=currRing->N)
5795  {
5796    Werror("weight vector must have size %d, not %d",
5797           currRing->N,wdegree->length());
5798    return TRUE;
5799  }
5800#ifdef HAVE_RINGS
5801  if (rField_is_Ring_Z(currRing))
5802  {
5803    ring origR = currRing;
5804    ring tempR = rCopy(origR);
5805    coeffs new_cf=nInitChar(n_Q,NULL);
5806    nKillChar(tempR->cf);
5807    tempR->cf=new_cf;
5808    rComplete(tempR);
5809    ideal uid = (ideal)u->Data();
5810    rChangeCurrRing(tempR);
5811    ideal uu = idrCopyR(uid, origR, currRing);
5812    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5813    uuAsLeftv.rtyp = IDEAL_CMD;
5814    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5815    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5816    assumeStdFlag(&uuAsLeftv);
5817    Print("// NOTE: computation of Hilbert series etc. is being\n");
5818    Print("//       performed for generic fibre, that is, over Q\n");
5819    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5820    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5821    int returnWithTrue = 1;
5822    switch((int)(long)v->Data())
5823    {
5824      case 1:
5825        res->data=(void *)iv;
5826        returnWithTrue = 0;
5827      case 2:
5828        res->data=(void *)hSecondSeries(iv);
5829        delete iv;
5830        returnWithTrue = 0;
5831    }
5832    if (returnWithTrue)
5833    {
5834      WerrorS(feNotImplemented);
5835      delete iv;
5836    }
5837    idDelete(&uu);
5838    rChangeCurrRing(origR);
5839    rDelete(tempR);
5840    if (returnWithTrue) return TRUE; else return FALSE;
5841  }
5842#endif
5843  assumeStdFlag(u);
5844  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5845  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5846  switch((int)(long)v->Data())
5847  {
5848    case 1:
5849      res->data=(void *)iv;
5850      return FALSE;
5851    case 2:
5852      res->data=(void *)hSecondSeries(iv);
5853      delete iv;
5854      return FALSE;
5855  }
5856  WerrorS(feNotImplemented);
5857  delete iv;
5858  return TRUE;
5859}
5860static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5861{
5862  PrintS("TODO\n");
5863  int i=pVar((poly)v->Data());
5864  if (i==0)
5865  {
5866    WerrorS("ringvar expected");
5867    return TRUE;
5868  }
5869  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5870  int d=pWTotaldegree(p);
5871  pLmDelete(p);
5872  if (d==1)
5873    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5874  else
5875    WerrorS("variable must have weight 1");
5876  return (d!=1);
5877}
5878static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5879{
5880  PrintS("TODO\n");
5881  int i=pVar((poly)v->Data());
5882  if (i==0)
5883  {
5884    WerrorS("ringvar expected");
5885    return TRUE;
5886  }
5887  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5888  int d=pWTotaldegree(p);
5889  pLmDelete(p);
5890  if (d==1)
5891    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5892  else
5893    WerrorS("variable must have weight 1");
5894  return (d!=1);
5895}
5896static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5897{
5898  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5899  intvec* arg = (intvec*) u->Data();
5900  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5901
5902  for (i=0; i<n; i++)
5903  {
5904    (*im)[i] = (*arg)[i];
5905  }
5906
5907  res->data = (char *)im;
5908  return FALSE;
5909}
5910static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5911{
5912  short *iw=iv2array((intvec *)w->Data(),currRing);
5913  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5914  omFreeSize((ADDRESS)iw,(currRing->N+1)*sizeof(short));
5915  return FALSE;
5916}
5917static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5918{
5919  if (!pIsUnit((poly)v->Data()))
5920  {
5921    WerrorS("2nd argument must be a unit");
5922    return TRUE;
5923  }
5924  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
5925  return FALSE;
5926}
5927static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5928{
5929  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
5930                             (intvec *)w->Data(),currRing);
5931  return FALSE;
5932}
5933static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5934{
5935  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
5936  {
5937    WerrorS("2nd argument must be a diagonal matrix of units");
5938    return TRUE;
5939  }
5940  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5941                               (matrix)v->CopyD());
5942  return FALSE;
5943}
5944static BOOLEAN currRingIsOverIntegralDomain ()
5945{
5946  /* true for fields and Z, false otherwise */
5947  if (rField_is_Ring_PtoM(currRing)) return FALSE;
5948  if (rField_is_Ring_2toM(currRing)) return FALSE;
5949  if (rField_is_Ring_ModN(currRing)) return FALSE;
5950  return TRUE;
5951}
5952static BOOLEAN jjMINOR_M(leftv res, leftv v)
5953{
5954  /* Here's the use pattern for the minor command:
5955        minor ( matrix_expression m, int_expression minorSize,
5956                optional ideal_expression IasSB, optional int_expression k,
5957                optional string_expression algorithm,
5958                optional int_expression cachedMinors,
5959                optional int_expression cachedMonomials )
5960     This method here assumes that there are at least two arguments.
5961     - If IasSB is present, it must be a std basis. All minors will be
5962       reduced w.r.t. IasSB.
5963     - If k is absent, all non-zero minors will be computed.
5964       If k is present and k > 0, the first k non-zero minors will be
5965       computed.
5966       If k is present and k < 0, the first |k| minors (some of which
5967       may be zero) will be computed.
5968       If k is present and k = 0, an error is reported.
5969     - If algorithm is absent, all the following arguments must be absent too.
5970       In this case, a heuristic picks the best-suited algorithm (among
5971       Bareiss, Laplace, and Laplace with caching).
5972       If algorithm is present, it must be one of "Bareiss", "bareiss",
5973       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5974       "cache" two more arguments may be given, determining how many entries
5975       the cache may have at most, and how many cached monomials there are at
5976       most. (Cached monomials are counted over all cached polynomials.)
5977       If these two additional arguments are not provided, 200 and 100000
5978       will be used as defaults.
5979  */
5980  matrix m;
5981  leftv u=v->next;
5982  v->next=NULL;
5983  int v_typ=v->Typ();
5984  if (v_typ==MATRIX_CMD)
5985  {
5986     m = (const matrix)v->Data();
5987  }
5988  else
5989  {
5990    if (v_typ==0)
5991    {
5992      Werror("`%s` is undefined",v->Fullname());
5993      return TRUE;
5994    }
5995    // try to convert to MATRIX:
5996    int ii=iiTestConvert(v_typ,MATRIX_CMD);
5997    BOOLEAN bo;
5998    sleftv tmp;
5999    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6000    else bo=TRUE;
6001    if (bo)
6002    {
6003      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6004      return TRUE;
6005    }
6006    m=(matrix)tmp.data;
6007  }
6008  const int mk = (const int)(long)u->Data();
6009  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6010  bool noCacheMinors = true; bool noCacheMonomials = true;
6011  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6012
6013  /* here come the different cases of correct argument sets */
6014  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6015  {
6016    IasSB = (ideal)u->next->Data();
6017    noIdeal = false;
6018    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6019    {
6020      k = (int)(long)u->next->next->Data();
6021      noK = false;
6022      assume(k != 0);
6023      if ((u->next->next->next != NULL) &&
6024          (u->next->next->next->Typ() == STRING_CMD))
6025      {
6026        algorithm = (char*)u->next->next->next->Data();
6027        noAlgorithm = false;
6028        if ((u->next->next->next->next != NULL) &&
6029            (u->next->next->next->next->Typ() == INT_CMD))
6030        {
6031          cacheMinors = (int)(long)u->next->next->next->next->Data();
6032          noCacheMinors = false;
6033          if ((u->next->next->next->next->next != NULL) &&
6034              (u->next->next->next->next->next->Typ() == INT_CMD))
6035          {
6036            cacheMonomials =
6037               (int)(long)u->next->next->next->next->next->Data();
6038            noCacheMonomials = false;
6039          }
6040        }
6041      }
6042    }
6043  }
6044  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6045  {
6046    k = (int)(long)u->next->Data();
6047    noK = false;
6048    assume(k != 0);
6049    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6050    {
6051      algorithm = (char*)u->next->next->Data();
6052      noAlgorithm = false;
6053      if ((u->next->next->next != NULL) &&
6054          (u->next->next->next->Typ() == INT_CMD))
6055      {
6056        cacheMinors = (int)(long)u->next->next->next->Data();
6057        noCacheMinors = false;
6058        if ((u->next->next->next->next != NULL) &&
6059            (u->next->next->next->next->Typ() == INT_CMD))
6060        {
6061          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6062          noCacheMonomials = false;
6063        }
6064      }
6065    }
6066  }
6067  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6068  {
6069    algorithm = (char*)u->next->Data();
6070    noAlgorithm = false;
6071    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6072    {
6073      cacheMinors = (int)(long)u->next->next->Data();
6074      noCacheMinors = false;
6075      if ((u->next->next->next != NULL) &&
6076          (u->next->next->next->Typ() == INT_CMD))
6077      {
6078        cacheMonomials = (int)(long)u->next->next->next->Data();
6079        noCacheMonomials = false;
6080      }
6081    }
6082  }
6083
6084  /* upper case conversion for the algorithm if present */
6085  if (!noAlgorithm)
6086  {
6087    if (strcmp(algorithm, "bareiss") == 0)
6088      algorithm = (char*)"Bareiss";
6089    if (strcmp(algorithm, "laplace") == 0)
6090      algorithm = (char*)"Laplace";
6091    if (strcmp(algorithm, "cache") == 0)
6092      algorithm = (char*)"Cache";
6093  }
6094
6095  v->next=u;
6096  /* here come some tests */
6097  if (!noIdeal)
6098  {
6099    assumeStdFlag(u->next);
6100  }
6101  if ((!noK) && (k == 0))
6102  {
6103    WerrorS("Provided number of minors to be computed is zero.");
6104    return TRUE;
6105  }
6106  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6107      && (strcmp(algorithm, "Laplace") != 0)
6108      && (strcmp(algorithm, "Cache") != 0))
6109  {
6110    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6111    return TRUE;
6112  }
6113  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6114      && (!currRingIsOverIntegralDomain()))
6115  {
6116    Werror("Bareiss algorithm not defined over coefficient rings %s",
6117           "with zero divisors.");
6118    return TRUE;
6119  }
6120  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6121  {
6122    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6123           m->rows(), m->cols());
6124    return TRUE;
6125  }
6126  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6127      && (noCacheMinors || noCacheMonomials))
6128  {
6129    cacheMinors = 200;
6130    cacheMonomials = 100000;
6131  }
6132
6133  /* here come the actual procedure calls */
6134  if (noAlgorithm)
6135    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6136                                       (noIdeal ? 0 : IasSB), false);
6137  else if (strcmp(algorithm, "Cache") == 0)
6138    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6139                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6140                                   cacheMonomials, false);
6141  else
6142    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6143                              (noIdeal ? 0 : IasSB), false);
6144  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6145  res->rtyp = IDEAL_CMD;
6146  return FALSE;
6147}
6148static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6149{
6150  // u: the name of the new type
6151  // v: the parent type
6152  // w: the elements
6153  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6154                                            (const char *)w->Data());
6155  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6156  return (d==NULL);
6157}
6158static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6159{
6160  // handles preimage(r,phi,i) and kernel(r,phi)
6161  idhdl h;
6162  ring rr;
6163  map mapping;
6164  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6165
6166  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6167  {
6168    WerrorS("2nd/3rd arguments must have names");
6169    return TRUE;
6170  }
6171  rr=(ring)u->Data();
6172  const char *ring_name=u->Name();
6173  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6174  {
6175    if (h->typ==MAP_CMD)
6176    {
6177      mapping=IDMAP(h);
6178      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6179      if ((preim_ring==NULL)
6180      || (IDRING(preim_ring)!=currRing))
6181      {
6182        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6183        return TRUE;
6184      }
6185    }
6186    else if (h->typ==IDEAL_CMD)
6187    {
6188      mapping=IDMAP(h);
6189    }
6190    else
6191    {
6192      Werror("`%s` is no map nor ideal",IDID(h));
6193      return TRUE;
6194    }
6195  }
6196  else
6197  {
6198    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6199    return TRUE;
6200  }
6201  ideal image;
6202  if (kernel_cmd) image=idInit(1,1);
6203  else
6204  {
6205    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6206    {
6207      if (h->typ==IDEAL_CMD)
6208      {
6209        image=IDIDEAL(h);
6210      }
6211      else
6212      {
6213        Werror("`%s` is no ideal",IDID(h));
6214        return TRUE;
6215      }
6216    }
6217    else
6218    {
6219      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6220      return TRUE;
6221    }
6222  }
6223  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6224  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6225  {
6226    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6227  }
6228  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6229  if (kernel_cmd) idDelete(&image);
6230  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6231}
6232static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6233{
6234  int di, k;
6235  int i=(int)(long)u->Data();
6236  int r=(int)(long)v->Data();
6237  int c=(int)(long)w->Data();
6238  if ((r<=0) || (c<=0)) return TRUE;
6239  intvec *iv = new intvec(r, c, 0);
6240  if (iv->rows()==0)
6241  {
6242    delete iv;
6243    return TRUE;
6244  }
6245  if (i!=0)
6246  {
6247    if (i<0) i = -i;
6248    di = 2 * i + 1;
6249    for (k=0; k<iv->length(); k++)
6250    {
6251      (*iv)[k] = ((siRand() % di) - i);
6252    }
6253  }
6254  res->data = (char *)iv;
6255  return FALSE;
6256}
6257static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6258  int &ringvar, poly &monomexpr)
6259{
6260  monomexpr=(poly)w->Data();
6261  poly p=(poly)v->Data();
6262#if 0
6263  if (pLength(monomexpr)>1)
6264  {
6265    Werror("`%s` substitutes a ringvar only by a term",
6266      Tok2Cmdname(SUBST_CMD));
6267    return TRUE;
6268  }
6269#endif
6270  if ((ringvar=pVar(p))==0)
6271  {
6272    if ((p!=NULL) && rField_is_Extension(currRing))
6273    {
6274      assume(currRing->cf->extRing!=NULL);
6275      number n = pGetCoeff(p);
6276      ringvar= -n_IsParam(n, currRing);
6277    }
6278    if(ringvar==0)
6279    {
6280      WerrorS("ringvar/par expected");
6281      return TRUE;
6282    }
6283  }
6284  return FALSE;
6285}
6286static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6287{
6288  int ringvar;
6289  poly monomexpr;
6290  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6291  if (nok) return TRUE;
6292  poly p=(poly)u->Data();
6293  if (ringvar>0)
6294  {
6295    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6296    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
6297    {
6298      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
6299      //return TRUE;
6300    }
6301    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6302      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6303    else
6304      res->data= pSubstPoly(p,ringvar,monomexpr);
6305  }
6306  else
6307  {
6308    res->data=pSubstPar(p,-ringvar,monomexpr);
6309  }
6310  return FALSE;
6311}
6312static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6313{
6314  int ringvar;
6315  poly monomexpr;
6316  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6317  if (nok) return TRUE;
6318  if (ringvar>0)
6319  {
6320    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6321      res->data = id_Subst((ideal)u->CopyD(res->rtyp), ringvar, monomexpr, currRing);
6322    else
6323      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
6324  }
6325  else
6326  {
6327    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
6328  }
6329  return FALSE;
6330}
6331// we do not want to have jjSUBST_Id_X inlined:
6332static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6333                            int input_type);
6334static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6335{
6336  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6337}
6338static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6339{
6340  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6341}
6342static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6343{
6344  sleftv tmp;
6345  memset(&tmp,0,sizeof(tmp));
6346  // do not check the result, conversion from int/number to poly works always
6347  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6348  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6349  tmp.CleanUp();
6350  return b;
6351}
6352static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6353{
6354  int mi=(int)(long)v->Data();
6355  int ni=(int)(long)w->Data();
6356  if ((mi<1)||(ni<1))
6357  {
6358    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6359    return TRUE;
6360  }
6361  matrix m=mpNew(mi,ni);
6362  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6363  int i=si_min(IDELEMS(I),mi*ni);
6364  //for(i=i-1;i>=0;i--)
6365  //{
6366  //  m->m[i]=I->m[i];
6367  //  I->m[i]=NULL;
6368  //}
6369  memcpy(m->m,I->m,i*sizeof(poly));
6370  memset(I->m,0,i*sizeof(poly));
6371  id_Delete(&I,currRing);
6372  res->data = (char *)m;
6373  return FALSE;
6374}
6375static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6376{
6377  int mi=(int)(long)v->Data();
6378  int ni=(int)(long)w->Data();
6379  if ((mi<1)||(ni<1))
6380  {
6381    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6382    return TRUE;
6383  }
6384  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6385           mi,ni,currRing);
6386  return FALSE;
6387}
6388static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6389{
6390  int mi=(int)(long)v->Data();
6391  int ni=(int)(long)w->Data();
6392  if ((mi<1)||(ni<1))
6393  {
6394     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6395    return TRUE;
6396  }
6397  matrix m=mpNew(mi,ni);
6398  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6399  int r=si_min(MATROWS(I),mi);
6400  int c=si_min(MATCOLS(I),ni);
6401  int i,j;
6402  for(i=r;i>0;i--)
6403  {
6404    for(j=c;j>0;j--)
6405    {
6406      MATELEM(m,i,j)=MATELEM(I,i,j);
6407      MATELEM(I,i,j)=NULL;
6408    }
6409  }
6410  id_Delete((ideal *)&I,currRing);
6411  res->data = (char *)m;
6412  return FALSE;
6413}
6414static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6415{
6416  if (w->rtyp!=IDHDL) return TRUE;
6417  int ul= IDELEMS((ideal)u->Data());
6418  int vl= IDELEMS((ideal)v->Data());
6419  ideal m
6420    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6421             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6422  if (m==NULL) return TRUE;
6423  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6424  return FALSE;
6425}
6426static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6427{
6428  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6429  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6430  idhdl hv=(idhdl)v->data;
6431  idhdl hw=(idhdl)w->data;
6432  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6433  res->data = (char *)idLiftStd((ideal)u->Data(),
6434                                &(hv->data.umatrix),testHomog,
6435                                &(hw->data.uideal));
6436  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6437  return FALSE;
6438}
6439static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6440{
6441  assumeStdFlag(v);
6442  if (!idIsZeroDim((ideal)v->Data()))
6443  {
6444    Werror("`%s` must be 0-dimensional",v->Name());
6445    return TRUE;
6446  }
6447  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6448    (poly)w->CopyD());
6449  return FALSE;
6450}
6451static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6452{
6453  assumeStdFlag(v);
6454  if (!idIsZeroDim((ideal)v->Data()))
6455  {
6456    Werror("`%s` must be 0-dimensional",v->Name());
6457    return TRUE;
6458  }
6459  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6460    (matrix)w->CopyD());
6461  return FALSE;
6462}
6463static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6464{
6465  assumeStdFlag(v);
6466  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6467    0,(int)(long)w->Data());
6468  return FALSE;
6469}
6470static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6471{
6472  assumeStdFlag(v);
6473  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6474    0,(int)(long)w->Data());
6475  return FALSE;
6476}
6477#ifdef OLD_RES
6478static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6479{
6480  int maxl=(int)v->Data();
6481  ideal u_id=(ideal)u->Data();
6482  int l=0;
6483  resolvente r;
6484  intvec **weights=NULL;
6485  int wmaxl=maxl;
6486  maxl--;
6487  if ((maxl==-1) && (iiOp!=MRES_CMD))
6488    maxl = currRing->N-1;
6489  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6490  {
6491    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6492    if (iv!=NULL)
6493    {
6494      l=1;
6495      if (!idTestHomModule(u_id,currQuotient,iv))
6496      {
6497        WarnS("wrong weights");
6498        iv=NULL;
6499      }
6500      else
6501      {
6502        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6503        weights[0] = ivCopy(iv);
6504      }
6505    }
6506    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6507  }
6508  else
6509    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6510  if (r==NULL) return TRUE;
6511  int t3=u->Typ();
6512  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6513  return FALSE;
6514}
6515#endif
6516static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6517{
6518  res->data=(void *)rInit(u,v,w);
6519  return (res->data==NULL);
6520}
6521static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6522{
6523  int yes;
6524  jjSTATUS2(res, u, v);
6525  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6526  omFree((ADDRESS) res->data);
6527  res->data = (void *)(long)yes;
6528  return FALSE;
6529}
6530static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6531{
6532  intvec *vw=(intvec *)w->Data(); // weights of vars
6533  if (vw->length()!=currRing->N)
6534  {
6535    Werror("%d weights for %d variables",vw->length(),currRing->N);
6536    return TRUE;
6537  }
6538  ideal result;
6539  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6540  tHomog hom=testHomog;
6541  ideal u_id=(ideal)(u->Data());
6542  if (ww!=NULL)
6543  {
6544    if (!idTestHomModule(u_id,currQuotient,ww))
6545    {
6546      WarnS("wrong weights");
6547      ww=NULL;
6548    }
6549    else
6550    {
6551      ww=ivCopy(ww);
6552      hom=isHomog;
6553    }
6554  }
6555  result=kStd(u_id,
6556              currQuotient,
6557              hom,
6558              &ww,                  // module weights
6559              (intvec *)v->Data(),  // hilbert series
6560              0,0,                  // syzComp, newIdeal
6561              vw);                  // weights of vars
6562  idSkipZeroes(result);
6563  res->data = (char *)result;
6564  setFlag(res,FLAG_STD);
6565  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6566  return FALSE;
6567}
6568
6569/*=================== operations with many arg.: static proc =================*/
6570/* must be ordered: first operations for chars (infix ops),
6571 * then alphabetically */
6572static BOOLEAN jjBREAK0(leftv, leftv)
6573{
6574#ifdef HAVE_SDB
6575  sdb_show_bp();
6576#endif
6577  return FALSE;
6578}
6579static BOOLEAN jjBREAK1(leftv, leftv v)
6580{
6581#ifdef HAVE_SDB
6582  if(v->Typ()==PROC_CMD)
6583  {
6584    int lineno=0;
6585    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6586    {
6587      lineno=(int)(long)v->next->Data();
6588    }
6589    return sdb_set_breakpoint(v->Name(),lineno);
6590  }
6591  return TRUE;
6592#else
6593 return FALSE;
6594#endif
6595}
6596static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6597{
6598  return iiExprArith1(res,v,iiOp);
6599}
6600static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6601{
6602  leftv v=u->next;
6603  u->next=NULL;
6604  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6605  u->next=v;
6606  return b;
6607}
6608static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6609{
6610  leftv v = u->next;
6611  leftv w = v->next;
6612  u->next = NULL;
6613  v->next = NULL;
6614  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6615  u->next = v;
6616  v->next = w;
6617  return b;
6618}
6619
6620static BOOLEAN jjCOEF_M(leftv, leftv v)
6621{
6622  if((v->Typ() != VECTOR_CMD)
6623  || (v->next->Typ() != POLY_CMD)
6624  || (v->next->next->Typ() != MATRIX_CMD)
6625  || (v->next->next->next->Typ() != MATRIX_CMD))
6626     return TRUE;
6627  if (v->next->next->rtyp!=IDHDL) return TRUE;
6628  idhdl c=(idhdl)v->next->next->data;
6629  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6630  idhdl m=(idhdl)v->next->next->next->data;
6631  idDelete((ideal *)&(c->data.uideal));
6632  idDelete((ideal *)&(m->data.uideal));
6633  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6634    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6635  return FALSE;
6636}
6637
6638static BOOLEAN jjDIVISION4(leftv res, leftv v)
6639{ // may have 3 or 4 arguments
6640  leftv v1=v;
6641  leftv v2=v1->next;
6642  leftv v3=v2->next;
6643  leftv v4=v3->next;
6644  assumeStdFlag(v2);
6645
6646  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6647  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6648
6649  if((i1==0)||(i2==0)
6650  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6651  {
6652    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6653    return TRUE;
6654  }
6655
6656  sleftv w1,w2;
6657  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6658  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6659  ideal P=(ideal)w1.Data();
6660  ideal Q=(ideal)w2.Data();
6661
6662  int n=(int)(long)v3->Data();
6663  short *w=NULL;
6664  if(v4!=NULL)
6665  {
6666    w=iv2array((intvec *)v4->Data(),currRing);
6667    short *w0=w+1;
6668    int i=currRing->N;
6669    while(i>0&&*w0>0)
6670    {
6671      w0++;
6672      i--;
6673    }
6674    if(i>0)
6675      WarnS("not all weights are positive!");
6676  }
6677
6678  matrix T;
6679  ideal R;
6680  idLiftW(P,Q,n,T,R,w);
6681
6682  w1.CleanUp();
6683  w2.CleanUp();
6684  if(w!=NULL)
6685    omFree(w);
6686
6687  lists L=(lists) omAllocBin(slists_bin);
6688  L->Init(2);
6689  L->m[1].rtyp=v1->Typ();
6690  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6691  {
6692    if(v1->Typ()==POLY_CMD)
6693      p_Shift(&R->m[0],-1,currRing);
6694    L->m[1].data=(void *)R->m[0];
6695    R->m[0]=NULL;
6696    idDelete(&R);
6697  }
6698  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6699    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6700  else
6701  {
6702    L->m[1].rtyp=MODUL_CMD;
6703    L->m[1].data=(void *)R;
6704  }
6705  L->m[0].rtyp=MATRIX_CMD;
6706  L->m[0].data=(char *)T;
6707
6708  res->data=L;
6709  res->rtyp=LIST_CMD;
6710
6711  return FALSE;
6712}
6713
6714//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6715//{
6716//  int l=u->listLength();
6717//  if (l<2) return TRUE;
6718//  BOOLEAN b;
6719//  leftv v=u->next;
6720//  leftv zz=v;
6721//  leftv z=zz;
6722//  u->next=NULL;
6723//  do
6724//  {
6725//    leftv z=z->next;
6726//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6727//    if (b) break;
6728//  } while (z!=NULL);
6729//  u->next=zz;
6730//  return b;
6731//}
6732static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6733{
6734  int s=1;
6735  leftv h=v;
6736  if (h!=NULL) s=exprlist_length(h);
6737  ideal id=idInit(s,1);
6738  int rank=1;
6739  int i=0;
6740  poly p;
6741  while (h!=NULL)
6742  {
6743    switch(h->Typ())
6744    {
6745      case POLY_CMD:
6746      {
6747        p=(poly)h->CopyD(POLY_CMD);
6748        break;
6749      }
6750      case INT_CMD:
6751      {
6752        number n=nInit((int)(long)h->Data());
6753        if (!nIsZero(n))
6754        {
6755          p=pNSet(n);
6756        }
6757        else
6758        {
6759          p=NULL;
6760          nDelete(&n);
6761        }
6762        break;
6763      }
6764      case BIGINT_CMD:
6765      {
6766        number b=(number)h->Data();
6767        number n=n_Init_bigint(b,coeffs_BIGINT,currRing->cf);
6768        if (!nIsZero(n))
6769        {
6770          p=pNSet(n);
6771        }
6772        else
6773        {
6774          p=NULL;
6775          nDelete(&n);
6776        }
6777        break;
6778      }
6779      case NUMBER_CMD:
6780      {
6781        number n=(number)h->CopyD(NUMBER_CMD);
6782        if (!nIsZero(n))
6783        {
6784          p=pNSet(n);
6785        }
6786        else
6787        {
6788          p=NULL;
6789          nDelete(&n);
6790        }
6791        break;
6792      }
6793      case VECTOR_CMD:
6794      {
6795        p=(poly)h->CopyD(VECTOR_CMD);
6796        if (iiOp!=MODUL_CMD)
6797        {
6798          idDelete(&id);
6799          pDelete(&p);
6800          return TRUE;
6801        }
6802        rank=si_max(rank,(int)pMaxComp(p));
6803        break;
6804      }
6805      default:
6806      {
6807        idDelete(&id);
6808        return TRUE;
6809      }
6810    }
6811    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6812    {
6813      pSetCompP(p,1);
6814    }
6815    id->m[i]=p;
6816    i++;
6817    h=h->next;
6818  }
6819  id->rank=rank;
6820  res->data=(char *)id;
6821  return FALSE;
6822}
6823static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6824{
6825  leftv h=v;
6826  int l=v->listLength();
6827  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6828  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6829  int t=0;
6830  // try to convert to IDEAL_CMD
6831  while (h!=NULL)
6832  {
6833    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6834    {
6835      t=IDEAL_CMD;
6836    }
6837    else break;
6838    h=h->next;
6839  }
6840  // if failure, try MODUL_CMD
6841  if (t==0)
6842  {
6843    h=v;
6844    while (h!=NULL)
6845    {
6846      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6847      {
6848        t=MODUL_CMD;
6849      }
6850      else break;
6851      h=h->next;
6852    }
6853  }
6854  // check for success  in converting
6855  if (t==0)
6856  {
6857    WerrorS("cannot convert to ideal or module");
6858    return TRUE;
6859  }
6860  // call idMultSect
6861  h=v;
6862  int i=0;
6863  sleftv tmp;
6864  while (h!=NULL)
6865  {
6866    if (h->Typ()==t)
6867    {
6868      r[i]=(ideal)h->Data(); /*no copy*/
6869      h=h->next;
6870    }
6871    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6872    {
6873      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6874      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6875      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6876      return TRUE;
6877    }
6878    else
6879    {
6880      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6881      copied[i]=TRUE;
6882      h=tmp.next;
6883    }
6884    i++;
6885  }
6886  res->rtyp=t;
6887  res->data=(char *)idMultSect(r,i);
6888  while(i>0)
6889  {
6890    i--;
6891    if (copied[i]) idDelete(&(r[i]));
6892  }
6893  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6894  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6895  return FALSE;
6896}
6897static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6898{
6899  /* computation of the inverse of a quadratic matrix A
6900     using the L-U-decomposition of A;
6901     There are two valid parametrisations:
6902     1) exactly one argument which is just the matrix A,
6903     2) exactly three arguments P, L, U which already
6904        realise the L-U-decomposition of A, that is,
6905        P * A = L * U, and P, L, and U satisfy the
6906        properties decribed in method 'jjLU_DECOMP';
6907        see there;
6908     If A is invertible, the list [1, A^(-1)] is returned,
6909     otherwise the list [0] is returned. Thus, the user may
6910     inspect the first entry of the returned list to see
6911     whether A is invertible. */
6912  matrix iMat; int invertible;
6913  if (v->next == NULL)
6914  {
6915    if (v->Typ() != MATRIX_CMD)
6916    {
6917      Werror("expected either one or three matrices");
6918      return TRUE;
6919    }
6920    else
6921    {
6922      matrix aMat = (matrix)v->Data();
6923      int rr = aMat->rows();
6924      int cc = aMat->cols();
6925      if (rr != cc)
6926      {
6927        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6928        return TRUE;
6929      }
6930      if (!idIsConstant((ideal)aMat))
6931      {
6932        WerrorS("matrix must be constant");
6933        return TRUE;
6934      }
6935      invertible = luInverse(aMat, iMat);
6936    }
6937  }
6938  else if ((v->Typ() == MATRIX_CMD) &&
6939           (v->next->Typ() == MATRIX_CMD) &&
6940           (v->next->next != NULL) &&
6941           (v->next->next->Typ() == MATRIX_CMD) &&
6942           (v->next->next->next == NULL))
6943  {
6944     matrix pMat = (matrix)v->Data();
6945     matrix lMat = (matrix)v->next->Data();
6946     matrix uMat = (matrix)v->next->next->Data();
6947     int rr = uMat->rows();
6948     int cc = uMat->cols();
6949     if (rr != cc)
6950     {
6951       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
6952              rr, cc);
6953       return TRUE;
6954     }
6955      if (!idIsConstant((ideal)pMat)
6956      || (!idIsConstant((ideal)lMat))
6957      || (!idIsConstant((ideal)uMat))
6958      )
6959      {
6960        WerrorS("matricesx must be constant");
6961        return TRUE;
6962      }
6963     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
6964  }
6965  else
6966  {
6967    Werror("expected either one or three matrices");
6968    return TRUE;
6969  }
6970
6971  /* build the return structure; a list with either one or two entries */
6972  lists ll = (lists)omAllocBin(slists_bin);
6973  if (invertible)
6974  {
6975    ll->Init(2);
6976    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6977    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
6978  }
6979  else
6980  {
6981    ll->Init(1);
6982    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6983  }
6984
6985  res->data=(char*)ll;
6986  return FALSE;
6987}
6988static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
6989{
6990  /* for solving a linear equation system A * x = b, via the
6991     given LU-decomposition of the matrix A;
6992     There is one valid parametrisation:
6993     1) exactly four arguments P, L, U, b;
6994        P, L, and U realise the L-U-decomposition of A, that is,
6995        P * A = L * U, and P, L, and U satisfy the
6996        properties decribed in method 'jjLU_DECOMP';
6997        see there;
6998        b is the right-hand side vector of the equation system;
6999     The method will return a list of either 1 entry or three entries:
7000     1) [0] if there is no solution to the system;
7001     2) [1, x, H] if there is at least one solution;
7002        x is any solution of the given linear system,
7003        H is the matrix with column vectors spanning the homogeneous
7004        solution space.
7005     The method produces an error if matrix and vector sizes do not fit. */
7006  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
7007      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
7008      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
7009      (v->next->next->next == NULL) ||
7010      (v->next->next->next->Typ() != MATRIX_CMD) ||
7011      (v->next->next->next->next != NULL))
7012  {
7013    WerrorS("expected exactly three matrices and one vector as input");
7014    return TRUE;
7015  }
7016  matrix pMat = (matrix)v->Data();
7017  matrix lMat = (matrix)v->next->Data();
7018  matrix uMat = (matrix)v->next->next->Data();
7019  matrix bVec = (matrix)v->next->next->next->Data();
7020  matrix xVec; int solvable; matrix homogSolSpace;
7021  if (pMat->rows() != pMat->cols())
7022  {
7023    Werror("first matrix (%d x %d) is not quadratic",
7024           pMat->rows(), pMat->cols());
7025    return TRUE;
7026  }
7027  if (lMat->rows() != lMat->cols())
7028  {
7029    Werror("second matrix (%d x %d) is not quadratic",
7030           lMat->rows(), lMat->cols());
7031    return TRUE;
7032  }
7033  if (lMat->rows() != uMat->rows())
7034  {
7035    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7036           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7037    return TRUE;
7038  }
7039  if (uMat->rows() != bVec->rows())
7040  {
7041    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7042           uMat->rows(), uMat->cols(), bVec->rows());
7043    return TRUE;
7044  }
7045  if (!idIsConstant((ideal)pMat)
7046  ||(!idIsConstant((ideal)lMat))
7047  ||(!idIsConstant((ideal)uMat))
7048  )
7049  {
7050    WerrorS("matrices must be constant");
7051    return TRUE;
7052  }
7053  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7054
7055  /* build the return structure; a list with either one or three entries */
7056  lists ll = (lists)omAllocBin(slists_bin);
7057  if (solvable)
7058  {
7059    ll->Init(3);
7060    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
7061    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7062    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7063  }
7064  else
7065  {
7066    ll->Init(1);
7067    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
7068  }
7069
7070  res->data=(char*)ll;
7071  return FALSE;
7072}
7073static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7074{
7075  int i=0;
7076  leftv h=v;
7077  if (h!=NULL) i=exprlist_length(h);
7078  intvec *iv=new intvec(i);
7079  i=0;
7080  while (h!=NULL)
7081  {
7082    if(h->Typ()==INT_CMD)
7083    {
7084      (*iv)[i]=(int)(long)h->Data();
7085    }
7086    else
7087    {
7088      delete iv;
7089      return TRUE;
7090    }
7091    i++;
7092    h=h->next;
7093  }
7094  res->data=(char *)iv;
7095  return FALSE;
7096}
7097static BOOLEAN jjJET4(leftv res, leftv u)
7098{
7099  leftv u1=u;
7100  leftv u2=u1->next;
7101  leftv u3=u2->next;
7102  leftv u4=u3->next;
7103  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7104  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
7105  {
7106    if(!pIsUnit((poly)u2->Data()))
7107    {
7108      WerrorS("2nd argument must be a unit");
7109      return TRUE;
7110    }
7111    res->rtyp=u1->Typ();
7112    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7113                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7114    return FALSE;
7115  }
7116  else
7117  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7118  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
7119  {
7120    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7121    {
7122      WerrorS("2nd argument must be a diagonal matrix of units");
7123      return TRUE;
7124    }
7125    res->rtyp=u1->Typ();
7126    res->data=(char*)idSeries(
7127                              (int)(long)u3->Data(),
7128                              idCopy((ideal)u1->Data()),
7129                              mp_Copy((matrix)u2->Data(), currRing),
7130                              (intvec*)u4->Data()
7131                             );
7132    return FALSE;
7133  }
7134  else
7135  {
7136    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7137           Tok2Cmdname(iiOp));
7138    return TRUE;
7139  }
7140}
7141static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7142{
7143  if ((yyInRingConstruction)
7144  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7145  {
7146    memcpy(res,u,sizeof(sleftv));
7147    memset(u,0,sizeof(sleftv));
7148    return FALSE;
7149  }
7150  leftv v=u->next;
7151  BOOLEAN b;
7152  if(v==NULL)
7153    b=iiExprArith1(res,u,iiOp);
7154  else
7155  {
7156    u->next=NULL;
7157    b=iiExprArith2(res,u,iiOp,v);
7158    u->next=v;
7159  }
7160  return b;
7161}
7162BOOLEAN jjLIST_PL(leftv res, leftv v)
7163{
7164  int sl=0;
7165  if (v!=NULL) sl = v->listLength();
7166  lists L;
7167  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7168  {
7169    int add_row_shift = 0;
7170    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7171    if (weights!=NULL)  add_row_shift=weights->min_in();
7172    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7173  }
7174  else
7175  {
7176    L=(lists)omAllocBin(slists_bin);
7177    leftv h=NULL;
7178    int i;
7179    int rt;
7180
7181    L->Init(sl);
7182    for (i=0;i<sl;i++)
7183    {
7184      if (h!=NULL)
7185      { /* e.g. not in the first step:
7186         * h is the pointer to the old sleftv,
7187         * v is the pointer to the next sleftv
7188         * (in this moment) */
7189         h->next=v;
7190      }
7191      h=v;
7192      v=v->next;
7193      h->next=NULL;
7194      rt=h->Typ();
7195      if (rt==0)
7196      {
7197        L->Clean();
7198        Werror("`%s` is undefined",h->Fullname());
7199        return TRUE;
7200      }
7201      if ((rt==RING_CMD)||(rt==QRING_CMD))
7202      {
7203        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7204        ((ring)L->m[i].data)->ref++;
7205      }
7206      else
7207        L->m[i].Copy(h);
7208    }
7209  }
7210  res->data=(char *)L;
7211  return FALSE;
7212}
7213static BOOLEAN jjNAMES0(leftv res, leftv)
7214{
7215  res->data=(void *)ipNameList(IDROOT);
7216  return FALSE;
7217}
7218static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7219{
7220  if(v==NULL)
7221  {
7222    res->data=(char *)showOption();
7223    return FALSE;
7224  }
7225  res->rtyp=NONE;
7226  return setOption(res,v);
7227}
7228static BOOLEAN jjREDUCE4(leftv res, leftv u)
7229{
7230  leftv u1=u;
7231  leftv u2=u1->next;
7232  leftv u3=u2->next;
7233  leftv u4=u3->next;
7234  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7235  {
7236    int save_d=Kstd1_deg;
7237    Kstd1_deg=(int)(long)u3->Data();
7238    kModW=(intvec *)u4->Data();
7239    BITSET save2;
7240    SI_SAVE_OPT2(save2);
7241    si_opt_2|=Sy_bit(V_DEG_STOP);
7242    u2->next=NULL;
7243    BOOLEAN r=jjCALL2ARG(res,u);
7244    kModW=NULL;
7245    Kstd1_deg=save_d;
7246    SI_RESTORE_OPT2(save2);
7247    u->next->next=u3;
7248    return r;
7249  }
7250  else
7251  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7252     (u4->Typ()==INT_CMD))
7253  {
7254    assumeStdFlag(u3);
7255    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7256    {
7257      WerrorS("2nd argument must be a diagonal matrix of units");
7258      return TRUE;
7259    }
7260    res->rtyp=IDEAL_CMD;
7261    res->data=(char*)redNF(
7262                           idCopy((ideal)u3->Data()),
7263                           idCopy((ideal)u1->Data()),
7264                           mp_Copy((matrix)u2->Data(), currRing),
7265                           (int)(long)u4->Data()
7266                          );
7267    return FALSE;
7268  }
7269  else
7270  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7271     (u4->Typ()==INT_CMD))
7272  {
7273    assumeStdFlag(u3);
7274    if(!pIsUnit((poly)u2->Data()))
7275    {
7276      WerrorS("2nd argument must be a unit");
7277      return TRUE;
7278    }
7279    res->rtyp=POLY_CMD;
7280    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7281                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7282    return FALSE;
7283  }
7284  else
7285  {
7286    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7287    return TRUE;
7288  }
7289}
7290static BOOLEAN jjREDUCE5(leftv res, leftv u)
7291{
7292  leftv u1=u;
7293  leftv u2=u1->next;
7294  leftv u3=u2->next;
7295  leftv u4=u3->next;
7296  leftv u5=u4->next;
7297  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7298     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7299  {
7300    assumeStdFlag(u3);
7301    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7302    {
7303      WerrorS("2nd argument must be a diagonal matrix of units");
7304      return TRUE;
7305    }
7306    res->rtyp=IDEAL_CMD;
7307    res->data=(char*)redNF(
7308                           idCopy((ideal)u3->Data()),
7309                           idCopy((ideal)u1->Data()),
7310                           mp_Copy((matrix)u2->Data(),currRing),
7311                           (int)(long)u4->Data(),
7312                           (intvec*)u5->Data()
7313                          );
7314    return FALSE;
7315  }
7316  else
7317  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7318     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7319  {
7320    assumeStdFlag(u3);
7321    if(!pIsUnit((poly)u2->Data()))
7322    {
7323      WerrorS("2nd argument must be a unit");
7324      return TRUE;
7325    }
7326    res->rtyp=POLY_CMD;
7327    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7328                           pCopy((poly)u2->Data()),
7329                           (int)(long)u4->Data(),(intvec*)u5->Data());
7330    return FALSE;
7331  }
7332  else
7333  {
7334    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7335           Tok2Cmdname(iiOp));
7336    return TRUE;
7337  }
7338}
7339static BOOLEAN jjRESERVED0(leftv, leftv)
7340{
7341  int i=1;
7342  int nCount = (sArithBase.nCmdUsed-1)/3;
7343  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7344  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7345  //      sArithBase.nCmdAllocated);
7346  for(i=0; i<nCount; i++)
7347  {
7348    Print("%-20s",sArithBase.sCmds[i+1].name);
7349    if(i+1+nCount<sArithBase.nCmdUsed)
7350      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7351    if(i+1+2*nCount<sArithBase.nCmdUsed)
7352      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7353    //if ((i%3)==1) PrintLn();
7354    PrintLn();
7355  }
7356  PrintLn();
7357  printBlackboxTypes();
7358  return FALSE;
7359}
7360static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7361{
7362  if (v == NULL)
7363  {
7364    res->data = omStrDup("");
7365    return FALSE;
7366  }
7367  int n = v->listLength();
7368  if (n == 1)
7369  {
7370    res->data = v->String();
7371    return FALSE;
7372  }
7373
7374  char** slist = (char**) omAlloc(n*sizeof(char*));
7375  int i, j;
7376
7377  for (i=0, j=0; i<n; i++, v = v ->next)
7378  {
7379    slist[i] = v->String();
7380    assume(slist[i] != NULL);
7381    j+=strlen(slist[i]);
7382  }
7383  char* s = (char*) omAlloc((j+1)*sizeof(char));
7384  *s='\0';
7385  for (i=0;i<n;i++)
7386  {
7387    strcat(s, slist[i]);
7388    omFree(slist[i]);
7389  }
7390  omFreeSize(slist, n*sizeof(char*));
7391  res->data = s;
7392  return FALSE;
7393}
7394static BOOLEAN jjTEST(leftv, leftv v)
7395{
7396  do
7397  {
7398    if (v->Typ()!=INT_CMD)
7399      return TRUE;
7400    test_cmd((int)(long)v->Data());
7401    v=v->next;
7402  }
7403  while (v!=NULL);
7404  return FALSE;
7405}
7406
7407#if defined(__alpha) && !defined(linux)
7408extern "C"
7409{
7410  void usleep(unsigned long usec);
7411};
7412#endif
7413static BOOLEAN jjFactModD_M(leftv res, leftv v)
7414{
7415  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7416     see a detailed documentation in /kernel/linearAlgebra.h
7417
7418     valid argument lists:
7419     - (poly h, int d),
7420     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7421     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7422                                                          in list of ring vars,
7423     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7424                                                optional: all 4 optional args
7425     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7426      by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
7427      has exactly two distinct monic factors [possibly with exponent > 1].)
7428     result:
7429     - list with the two factors f and g such that
7430       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7431
7432  poly h      = NULL;
7433  int  d      =    1;
7434  poly f0     = NULL;
7435  poly g0     = NULL;
7436  int  xIndex =    1;   /* default index if none provided */
7437  int  yIndex =    2;   /* default index if none provided */
7438
7439  leftv u = v; int factorsGiven = 0;
7440  if ((u == NULL) || (u->Typ() != POLY_CMD))
7441  {
7442    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7443    return TRUE;
7444  }
7445  else h = (poly)u->Data();
7446  u = u->next;
7447  if ((u == NULL) || (u->Typ() != INT_CMD))
7448  {
7449    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7450    return TRUE;
7451  }
7452  else d = (int)(long)u->Data();
7453  u = u->next;
7454  if ((u != NULL) && (u->Typ() == POLY_CMD))
7455  {
7456    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7457    {
7458      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7459      return TRUE;
7460    }
7461    else
7462    {
7463      f0 = (poly)u->Data();
7464      g0 = (poly)u->next->Data();
7465      factorsGiven = 1;
7466      u = u->next->next;
7467    }
7468  }
7469  if ((u != NULL) && (u->Typ() == INT_CMD))
7470  {
7471    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7472    {
7473      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7474      return TRUE;
7475    }
7476    else
7477    {
7478      xIndex = (int)(long)u->Data();
7479      yIndex = (int)(long)u->next->Data();
7480      u = u->next->next;
7481    }
7482  }
7483  if (u != NULL)
7484  {
7485    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7486    return TRUE;
7487  }
7488
7489  /* checks for provided arguments */
7490  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7491  {
7492    WerrorS("expected non-constant polynomial argument(s)");
7493    return TRUE;
7494  }
7495  int n = rVar(currRing);
7496  if ((xIndex < 1) || (n < xIndex))
7497  {
7498    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7499    return TRUE;
7500  }
7501  if ((yIndex < 1) || (n < yIndex))
7502  {
7503    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7504    return TRUE;
7505  }
7506  if (xIndex == yIndex)
7507  {
7508    WerrorS("expected distinct indices for variables x and y");
7509    return TRUE;
7510  }
7511
7512  /* computation of f0 and g0 if missing */
7513  if (factorsGiven == 0)
7514  {
7515#ifdef HAVE_FACTORY
7516    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7517    intvec* v = NULL;
7518    ideal i = singclap_factorize(h0, &v, 0,currRing);
7519
7520    ivTest(v);
7521
7522    if (i == NULL) return TRUE;
7523
7524    idTest(i);
7525
7526    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7527    {
7528      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7529      return TRUE;
7530    }
7531    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7532    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7533    idDelete(&i);
7534#else
7535    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
7536    return TRUE;
7537#endif
7538  }
7539
7540  poly f; poly g;
7541  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7542  lists L = (lists)omAllocBin(slists_bin);
7543  L->Init(2);
7544  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7545  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7546  res->rtyp = LIST_CMD;
7547  res->data = (char*)L;
7548  return FALSE;
7549}
7550static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7551{
7552  if ((v->Typ() != LINK_CMD) ||
7553      (v->next->Typ() != STRING_CMD) ||
7554      (v->next->next->Typ() != STRING_CMD) ||
7555      (v->next->next->next->Typ() != INT_CMD))
7556    return TRUE;
7557  jjSTATUS3(res, v, v->next, v->next->next);
7558#if defined(HAVE_USLEEP)
7559  if (((long) res->data) == 0L)
7560  {
7561    int i_s = (int)(long) v->next->next->next->Data();
7562    if (i_s > 0)
7563    {
7564      usleep((int)(long) v->next->next->next->Data());
7565      jjSTATUS3(res, v, v->next, v->next->next);
7566    }
7567  }
7568#elif defined(HAVE_SLEEP)
7569  if (((int) res->data) == 0)
7570  {
7571    int i_s = (int) v->next->next->next->Data();
7572    if (i_s > 0)
7573    {
7574      sleep((is - 1)/1000000 + 1);
7575      jjSTATUS3(res, v, v->next, v->next->next);
7576    }
7577  }
7578#endif
7579  return FALSE;
7580}
7581static BOOLEAN jjSUBST_M(leftv res, leftv u)
7582{
7583  leftv v = u->next; // number of args > 0
7584  if (v==NULL) return TRUE;
7585  leftv w = v->next;
7586  if (w==NULL) return TRUE;
7587  leftv rest = w->next;;
7588
7589  u->next = NULL;
7590  v->next = NULL;
7591  w->next = NULL;
7592  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7593  if ((rest!=NULL) && (!b))
7594  {
7595    sleftv tmp_res;
7596    leftv tmp_next=res->next;
7597    res->next=rest;
7598    memset(&tmp_res,0,sizeof(tmp_res));
7599    b = iiExprArithM(&tmp_res,res,iiOp);
7600    memcpy(res,&tmp_res,sizeof(tmp_res));
7601    res->next=tmp_next;
7602  }
7603  u->next = v;
7604  v->next = w;
7605  // rest was w->next, but is already cleaned
7606  return b;
7607}
7608static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7609{
7610  if ((INPUT->Typ() != MATRIX_CMD) ||
7611      (INPUT->next->Typ() != NUMBER_CMD) ||
7612      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7613      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7614  {
7615    WerrorS("expected (matrix, number, number, number) as arguments");
7616    return TRUE;
7617  }
7618  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7619  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7620                                    (number)(v->Data()),
7621                                    (number)(w->Data()),
7622                                    (number)(x->Data()));
7623  return FALSE;
7624}
7625static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7626{ ideal result;
7627  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7628  leftv v = u->next;  /* one additional polynomial or ideal */
7629  leftv h = v->next;  /* Hilbert vector */
7630  leftv w = h->next;  /* weight vector */
7631  assumeStdFlag(u);
7632  ideal i1=(ideal)(u->Data());
7633  ideal i0;
7634  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7635  || (h->Typ()!=INTVEC_CMD)
7636  || (w->Typ()!=INTVEC_CMD))
7637  {
7638    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7639    return TRUE;
7640  }
7641  intvec *vw=(intvec *)w->Data(); // weights of vars
7642  /* merging std_hilb_w and std_1 */
7643  if (vw->length()!=currRing->N)
7644  {
7645    Werror("%d weights for %d variables",vw->length(),currRing->N);
7646    return TRUE;
7647  }
7648  int r=v->Typ();
7649  BOOLEAN cleanup_i0=FALSE;
7650  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7651  {
7652    i0=idInit(1,i1->rank);
7653    i0->m[0]=(poly)v->Data();
7654    cleanup_i0=TRUE;
7655  }
7656  else if (r==IDEAL_CMD)/* IDEAL */
7657  {
7658    i0=(ideal)v->Data();
7659  }
7660  else
7661  {
7662    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7663    return TRUE;
7664  }
7665  int ii0=idElem(i0);
7666  i1 = idSimpleAdd(i1,i0);
7667  if (cleanup_i0)
7668  {
7669    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7670    idDelete(&i0);
7671  }
7672  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7673  tHomog hom=testHomog;
7674  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7675  if (ww!=NULL)
7676  {
7677    if (!idTestHomModule(i1,currQuotient,ww))
7678    {
7679      WarnS("wrong weights");
7680      ww=NULL;
7681    }
7682    else
7683    {
7684      ww=ivCopy(ww);
7685      hom=isHomog;
7686    }
7687  }
7688  BITSET save1;
7689  SI_SAVE_OPT1(save1);
7690  si_opt_1|=Sy_bit(OPT_SB_1);
7691  result=kStd(i1,
7692              currQuotient,
7693              hom,
7694              &ww,                  // module weights
7695              (intvec *)h->Data(),  // hilbert series
7696              0,                    // syzComp, whatever it is...
7697              IDELEMS(i1)-ii0,      // new ideal
7698              vw);                  // weights of vars
7699  SI_RESTORE_OPT1(save1);
7700  idDelete(&i1);
7701  idSkipZeroes(result);
7702  res->data = (char *)result;
7703  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7704  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7705  return FALSE;
7706}
7707
7708
7709static Subexpr jjMakeSub(leftv e)
7710{
7711  assume( e->Typ()==INT_CMD );
7712  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7713  r->start =(int)(long)e->Data();
7714  return r;
7715}
7716#define D(A) (A)
7717#define IPARITH
7718#include "table.h"
7719
7720#include "iparith.inc"
7721
7722/*=================== operations with 2 args. ============================*/
7723/* must be ordered: first operations for chars (infix ops),
7724 * then alphabetically */
7725
7726BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7727{
7728  memset(res,0,sizeof(sleftv));
7729  BOOLEAN call_failed=FALSE;
7730
7731  if (!errorreported)
7732  {
7733#ifdef SIQ
7734    if (siq>0)
7735    {
7736      //Print("siq:%d\n",siq);
7737      command d=(command)omAlloc0Bin(sip_command_bin);
7738      memcpy(&d->arg1,a,sizeof(sleftv));
7739      //a->Init();
7740      memcpy(&d->arg2,b,sizeof(sleftv));
7741      //b->Init();
7742      d->argc=2;
7743      d->op=op;
7744      res->data=(char *)d;
7745      res->rtyp=COMMAND;
7746      return FALSE;
7747    }
7748#endif
7749    int at=a->Typ();
7750    int bt=b->Typ();
7751    if (at>MAX_TOK)
7752    {
7753      blackbox *bb=getBlackboxStuff(at);
7754      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7755      else          return TRUE;
7756    }
7757    else if ((bt>MAX_TOK)&&(op!='('))
7758    {
7759      blackbox *bb=getBlackboxStuff(bt);
7760      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7761      else          return TRUE;
7762    }
7763    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7764    int index=i;
7765
7766    iiOp=op;
7767    while (dArith2[i].cmd==op)
7768    {
7769      if ((at==dArith2[i].arg1)
7770      && (bt==dArith2[i].arg2))
7771      {
7772        res->rtyp=dArith2[i].res;
7773        if (currRing!=NULL)
7774        {
7775          if (check_valid(dArith2[i].valid_for,op)) break;
7776        }
7777        if (TEST_V_ALLWARN)
7778          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7779        if ((call_failed=dArith2[i].p(res,a,b)))
7780        {
7781          break;// leave loop, goto error handling
7782        }
7783        a->CleanUp();
7784        b->CleanUp();
7785        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7786        return FALSE;
7787      }
7788      i++;
7789    }
7790    // implicite type conversion ----------------------------------------------
7791    if (dArith2[i].cmd!=op)
7792    {
7793      int ai,bi;
7794      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7795      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7796      BOOLEAN failed=FALSE;
7797      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7798      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7799      while (dArith2[i].cmd==op)
7800      {
7801        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7802        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7803        {
7804          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7805          {
7806            res->rtyp=dArith2[i].res;
7807            if (currRing!=NULL)
7808            {
7809              if (check_valid(dArith2[i].valid_for,op)) break;
7810            }
7811            if (TEST_V_ALLWARN)
7812              Print("call %s(%s,%s)\n",iiTwoOps(op),
7813              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7814            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7815            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7816            || (call_failed=dArith2[i].p(res,an,bn)));
7817            // everything done, clean up temp. variables
7818            if (failed)
7819            {
7820              // leave loop, goto error handling
7821              break;
7822            }
7823            else
7824            {
7825              // everything ok, clean up and return
7826              an->CleanUp();
7827              bn->CleanUp();
7828              omFreeBin((ADDRESS)an, sleftv_bin);
7829              omFreeBin((ADDRESS)bn, sleftv_bin);
7830              a->CleanUp();
7831              b->CleanUp();
7832              return FALSE;
7833            }
7834          }
7835        }
7836        i++;
7837      }
7838      an->CleanUp();
7839      bn->CleanUp();
7840      omFreeBin((ADDRESS)an, sleftv_bin);
7841      omFreeBin((ADDRESS)bn, sleftv_bin);
7842    }
7843    // error handling ---------------------------------------------------
7844    const char *s=NULL;
7845    if (!errorreported)
7846    {
7847      if ((at==0) && (a->Fullname()!=sNoName))
7848      {
7849        s=a->Fullname();
7850      }
7851      else if ((bt==0) && (b->Fullname()!=sNoName))
7852      {
7853        s=b->Fullname();
7854      }
7855      if (s!=NULL)
7856        Werror("`%s` is not defined",s);
7857      else
7858      {
7859        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7860        s = iiTwoOps(op);
7861        if (proccall)
7862        {
7863          Werror("%s(`%s`,`%s`) failed"
7864                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7865        }
7866        else
7867        {
7868          Werror("`%s` %s `%s` failed"
7869                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7870        }
7871        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7872        {
7873          while (dArith2[i].cmd==op)
7874          {
7875            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7876            && (dArith2[i].res!=0)
7877            && (dArith2[i].p!=jjWRONG2))
7878            {
7879              if (proccall)
7880                Werror("expected %s(`%s`,`%s`)"
7881                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7882              else
7883                Werror("expected `%s` %s `%s`"
7884                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7885            }
7886            i++;
7887          }
7888        }
7889      }
7890    }
7891    res->rtyp = UNKNOWN;
7892  }
7893  a->CleanUp();
7894  b->CleanUp();
7895  return TRUE;
7896}
7897
7898/*==================== operations with 1 arg. ===============================*/
7899/* must be ordered: first operations for chars (infix ops),
7900 * then alphabetically */
7901
7902BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7903{
7904  memset(res,0,sizeof(sleftv));
7905  BOOLEAN call_failed=FALSE;
7906
7907  if (!errorreported)
7908  {
7909#ifdef SIQ
7910    if (siq>0)
7911    {
7912      //Print("siq:%d\n",siq);
7913      command d=(command)omAlloc0Bin(sip_command_bin);
7914      memcpy(&d->arg1,a,sizeof(sleftv));
7915      //a->Init();
7916      d->op=op;
7917      d->argc=1;
7918      res->data=(char *)d;
7919      res->rtyp=COMMAND;
7920      return FALSE;
7921    }
7922#endif
7923    int at=a->Typ();
7924    if (at>MAX_TOK)
7925    {
7926      blackbox *bb=getBlackboxStuff(at);
7927      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7928      else          return TRUE;
7929    }
7930
7931    BOOLEAN failed=FALSE;
7932    iiOp=op;
7933    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7934    int ti = i;
7935    while (dArith1[i].cmd==op)
7936    {
7937      if (at==dArith1[i].arg)
7938      {
7939        int r=res->rtyp=dArith1[i].res;
7940        if (currRing!=NULL)
7941        {
7942          if (check_valid(dArith1[i].valid_for,op)) break;
7943        }
7944        if (TEST_V_ALLWARN)
7945          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
7946        if (r<0)
7947        {
7948          res->rtyp=-r;
7949          #ifdef PROC_BUG
7950          dArith1[i].p(res,a);
7951          #else
7952          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
7953          #endif
7954        }
7955        else if ((call_failed=dArith1[i].p(res,a)))
7956        {
7957          break;// leave loop, goto error handling
7958        }
7959        if (a->Next()!=NULL)
7960        {
7961          res->next=(leftv)omAllocBin(sleftv_bin);
7962          failed=iiExprArith1(res->next,a->next,op);
7963        }
7964        a->CleanUp();
7965        return failed;
7966      }
7967      i++;
7968    }
7969    // implicite type conversion --------------------------------------------
7970    if (dArith1[i].cmd!=op)
7971    {
7972      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7973      i=ti;
7974      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
7975      while (dArith1[i].cmd==op)
7976      {
7977        int ai;
7978        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
7979        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
7980        {
7981          int r=res->rtyp=dArith1[i].res;
7982          if (currRing!=NULL)
7983          {
7984            if (check_valid(dArith1[i].valid_for,op)) break;
7985          }
7986          if (r<0)
7987          {
7988            res->rtyp=-r;
7989            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
7990            if (!failed)
7991            {
7992              #ifdef PROC_BUG
7993              dArith1[i].p(res,a);
7994              #else
7995              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
7996              #endif
7997            }
7998          }
7999          else
8000          {
8001            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
8002            || (call_failed=dArith1[i].p(res,an)));
8003          }
8004          // everything done, clean up temp. variables
8005          if (failed)
8006          {
8007            // leave loop, goto error handling
8008            break;
8009          }
8010          else
8011          {
8012            if (TEST_V_ALLWARN)
8013              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(an->rtyp));
8014            if (an->Next() != NULL)
8015            {
8016              res->next = (leftv)omAllocBin(sleftv_bin);
8017              failed=iiExprArith1(res->next,an->next,op);
8018            }
8019            // everything ok, clean up and return
8020            an->CleanUp();
8021            omFreeBin((ADDRESS)an, sleftv_bin);
8022            a->CleanUp();
8023            return failed;
8024          }
8025        }
8026        i++;
8027      }
8028      an->CleanUp();
8029      omFreeBin((ADDRESS)an, sleftv_bin);
8030    }
8031    // error handling
8032    if (!errorreported)
8033    {
8034      if ((at==0) && (a->Fullname()!=sNoName))
8035      {
8036        Werror("`%s` is not defined",a->Fullname());
8037      }
8038      else
8039      {
8040        i=ti;
8041        const char *s = iiTwoOps(op);
8042        Werror("%s(`%s`) failed"
8043                ,s,Tok2Cmdname(at));
8044        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8045        {
8046          while (dArith1[i].cmd==op)
8047          {
8048            if ((dArith1[i].res!=0)
8049            && (dArith1[i].p!=jjWRONG))
8050              Werror("expected %s(`%s`)"
8051                ,s,Tok2Cmdname(dArith1[i].arg));
8052            i++;
8053          }
8054        }
8055      }
8056    }
8057    res->rtyp = UNKNOWN;
8058  }
8059  a->CleanUp();
8060  return TRUE;
8061}
8062
8063/*=================== operations with 3 args. ============================*/
8064/* must be ordered: first operations for chars (infix ops),
8065 * then alphabetically */
8066
8067BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8068{
8069  memset(res,0,sizeof(sleftv));
8070  BOOLEAN call_failed=FALSE;
8071
8072  if (!errorreported)
8073  {
8074#ifdef SIQ
8075    if (siq>0)
8076    {
8077      //Print("siq:%d\n",siq);
8078      command d=(command)omAlloc0Bin(sip_command_bin);
8079      memcpy(&d->arg1,a,sizeof(sleftv));
8080      //a->Init();
8081      memcpy(&d->arg2,b,sizeof(sleftv));
8082      //b->Init();
8083      memcpy(&d->arg3,c,sizeof(sleftv));
8084      //c->Init();
8085      d->op=op;
8086      d->argc=3;
8087      res->data=(char *)d;
8088      res->rtyp=COMMAND;
8089      return FALSE;
8090    }
8091#endif
8092    int at=a->Typ();
8093    if (at>MAX_TOK)
8094    {
8095      blackbox *bb=getBlackboxStuff(at);
8096      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
8097      else          return TRUE;
8098    }
8099    int bt=b->Typ();
8100    int ct=c->Typ();
8101
8102    iiOp=op;
8103    int i=0;
8104    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8105    while (dArith3[i].cmd==op)
8106    {
8107      if ((at==dArith3[i].arg1)
8108      && (bt==dArith3[i].arg2)
8109      && (ct==dArith3[i].arg3))
8110      {
8111        res->rtyp=dArith3[i].res;
8112        if (currRing!=NULL)
8113        {
8114          if (check_valid(dArith3[i].valid_for,op)) break;
8115        }
8116        if (TEST_V_ALLWARN)
8117          Print("call %s(%s,%s,%s)\n",
8118            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8119        if ((call_failed=dArith3[i].p(res,a,b,c)))
8120        {
8121          break;// leave loop, goto error handling
8122        }
8123        a->CleanUp();
8124        b->CleanUp();
8125        c->CleanUp();
8126        return FALSE;
8127      }
8128      i++;
8129    }
8130    // implicite type conversion ----------------------------------------------
8131    if (dArith3[i].cmd!=op)
8132    {
8133      int ai,bi,ci;
8134      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8135      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8136      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8137      BOOLEAN failed=FALSE;
8138      i=0;
8139      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8140      while (dArith3[i].cmd==op)
8141      {
8142        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
8143        {
8144          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
8145          {
8146            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
8147            {
8148              res->rtyp=dArith3[i].res;
8149              if (currRing!=NULL)
8150              {
8151                if (check_valid(dArith3[i].valid_for,op)) break;
8152              }
8153              if (TEST_V_ALLWARN)
8154                Print("call %s(%s,%s,%s)\n",
8155                  iiTwoOps(op),Tok2Cmdname(an->rtyp),
8156                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
8157              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
8158                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
8159                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
8160                || (call_failed=dArith3[i].p(res,an,bn,cn)));
8161              // everything done, clean up temp. variables
8162              if (failed)
8163              {
8164                // leave loop, goto error handling
8165                break;
8166              }
8167              else
8168              {
8169                // everything ok, clean up and return
8170                an->CleanUp();
8171                bn->CleanUp();
8172                cn->CleanUp();
8173                omFreeBin((ADDRESS)an, sleftv_bin);
8174                omFreeBin((ADDRESS)bn, sleftv_bin);
8175                omFreeBin((ADDRESS)cn, sleftv_bin);
8176                a->CleanUp();
8177                b->CleanUp();
8178                c->CleanUp();
8179        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8180                return FALSE;
8181              }
8182            }
8183          }
8184        }
8185        i++;
8186      }
8187      an->CleanUp();
8188      bn->CleanUp();
8189      cn->CleanUp();
8190      omFreeBin((ADDRESS)an, sleftv_bin);
8191      omFreeBin((ADDRESS)bn, sleftv_bin);
8192      omFreeBin((ADDRESS)cn, sleftv_bin);
8193    }
8194    // error handling ---------------------------------------------------
8195    if (!errorreported)
8196    {
8197      const char *s=NULL;
8198      if ((at==0) && (a->Fullname()!=sNoName))
8199      {
8200        s=a->Fullname();
8201      }
8202      else if ((bt==0) && (b->Fullname()!=sNoName))
8203      {
8204        s=b->Fullname();
8205      }
8206      else if ((ct==0) && (c->Fullname()!=sNoName))
8207      {
8208        s=c->Fullname();
8209      }
8210      if (s!=NULL)
8211        Werror("`%s` is not defined",s);
8212      else
8213      {
8214        i=0;
8215        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8216        const char *s = iiTwoOps(op);
8217        Werror("%s(`%s`,`%s`,`%s`) failed"
8218                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8219        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8220        {
8221          while (dArith3[i].cmd==op)
8222          {
8223            if(((at==dArith3[i].arg1)
8224            ||(bt==dArith3[i].arg2)
8225            ||(ct==dArith3[i].arg3))
8226            && (dArith3[i].res!=0))
8227            {
8228              Werror("expected %s(`%s`,`%s`,`%s`)"
8229                  ,s,Tok2Cmdname(dArith3[i].arg1)
8230                  ,Tok2Cmdname(dArith3[i].arg2)
8231                  ,Tok2Cmdname(dArith3[i].arg3));
8232            }
8233            i++;
8234          }
8235        }
8236      }
8237    }
8238    res->rtyp = UNKNOWN;
8239  }
8240  a->CleanUp();
8241  b->CleanUp();
8242  c->CleanUp();
8243        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8244  return TRUE;
8245}
8246/*==================== operations with many arg. ===============================*/
8247/* must be ordered: first operations for chars (infix ops),
8248 * then alphabetically */
8249
8250BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8251{
8252  // cnt = 0: all
8253  // cnt = 1: only first one
8254  leftv next;
8255  BOOLEAN failed = TRUE;
8256  if(v==NULL) return failed;
8257  res->rtyp = LIST_CMD;
8258  if(cnt) v->next = NULL;
8259  next = v->next;             // saving next-pointer
8260  failed = jjLIST_PL(res, v);
8261  v->next = next;             // writeback next-pointer
8262  return failed;
8263}
8264
8265BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8266{
8267  memset(res,0,sizeof(sleftv));
8268
8269  if (!errorreported)
8270  {
8271#ifdef SIQ
8272    if (siq>0)
8273    {
8274      //Print("siq:%d\n",siq);
8275      command d=(command)omAlloc0Bin(sip_command_bin);
8276      d->op=op;
8277      res->data=(char *)d;
8278      if (a!=NULL)
8279      {
8280        d->argc=a->listLength();
8281        // else : d->argc=0;
8282        memcpy(&d->arg1,a,sizeof(sleftv));
8283        switch(d->argc)
8284        {
8285          case 3:
8286            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8287            a->next->next->Init();
8288            /* no break */
8289          case 2:
8290            memcpy(&d->arg2,a->next,sizeof(sleftv));
8291            a->next->Init();
8292            a->next->next=d->arg2.next;
8293            d->arg2.next=NULL;
8294            /* no break */
8295          case 1:
8296            a->Init();
8297            a->next=d->arg1.next;
8298            d->arg1.next=NULL;
8299        }
8300        if (d->argc>3) a->next=NULL;
8301        a->name=NULL;
8302        a->rtyp=0;
8303        a->data=NULL;
8304        a->e=NULL;
8305        a->attribute=NULL;
8306        a->CleanUp();
8307      }
8308      res->rtyp=COMMAND;
8309      return FALSE;
8310    }
8311#endif
8312    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8313    {
8314      blackbox *bb=getBlackboxStuff(a->Typ());
8315      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
8316      else          return TRUE;
8317    }
8318    BOOLEAN failed=FALSE;
8319    int args=0;
8320    if (a!=NULL) args=a->listLength();
8321
8322    iiOp=op;
8323    int i=0;
8324    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8325    while (dArithM[i].cmd==op)
8326    {
8327      if ((args==dArithM[i].number_of_args)
8328      || (dArithM[i].number_of_args==-1)
8329      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8330      {
8331        res->rtyp=dArithM[i].res;
8332        if (currRing!=NULL)
8333        {
8334          if (check_valid(dArithM[i].valid_for,op)) break;
8335        }
8336        if (TEST_V_ALLWARN)
8337          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8338        if (dArithM[i].p(res,a))
8339        {
8340          break;// leave loop, goto error handling
8341        }
8342        if (a!=NULL) a->CleanUp();
8343        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8344        return failed;
8345      }
8346      i++;
8347    }
8348    // error handling
8349    if (!errorreported)
8350    {
8351      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8352      {
8353        Werror("`%s` is not defined",a->Fullname());
8354      }
8355      else
8356      {
8357        const char *s = iiTwoOps(op);
8358        Werror("%s(...) failed",s);
8359      }
8360    }
8361    res->rtyp = UNKNOWN;
8362  }
8363  if (a!=NULL) a->CleanUp();
8364        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8365  return TRUE;
8366}
8367
8368/*=================== general utilities ============================*/
8369int IsCmd(const char *n, int & tok)
8370{
8371  int i;
8372  int an=1;
8373  int en=sArithBase.nLastIdentifier;
8374
8375  loop
8376  //for(an=0; an<sArithBase.nCmdUsed; )
8377  {
8378    if(an>=en-1)
8379    {
8380      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8381      {
8382        i=an;
8383        break;
8384      }
8385      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8386      {
8387        i=en;
8388        break;
8389      }
8390      else
8391      {
8392        // -- blackbox extensions:
8393        // return 0;
8394        return blackboxIsCmd(n,tok);
8395      }
8396    }
8397    i=(an+en)/2;
8398    if (*n < *(sArithBase.sCmds[i].name))
8399    {
8400      en=i-1;
8401    }
8402    else if (*n > *(sArithBase.sCmds[i].name))
8403    {
8404      an=i+1;
8405    }
8406    else
8407    {
8408      int v=strcmp(n,sArithBase.sCmds[i].name);
8409      if(v<0)
8410      {
8411        en=i-1;
8412      }
8413      else if(v>0)
8414      {
8415        an=i+1;
8416      }
8417      else /*v==0*/
8418      {
8419        break;
8420      }
8421    }
8422  }
8423  lastreserved=sArithBase.sCmds[i].name;
8424  tok=sArithBase.sCmds[i].tokval;
8425  if(sArithBase.sCmds[i].alias==2)
8426  {
8427    Warn("outdated identifier `%s` used - please change your code",
8428    sArithBase.sCmds[i].name);
8429    sArithBase.sCmds[i].alias=1;
8430  }
8431  if (currRingHdl==NULL)
8432  {
8433    #ifdef SIQ
8434    if (siq<=0)
8435    {
8436    #endif
8437      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8438      {
8439        WerrorS("no ring active");
8440        return 0;
8441      }
8442    #ifdef SIQ
8443    }
8444    #endif
8445  }
8446  if (!expected_parms)
8447  {
8448    switch (tok)
8449    {
8450      case IDEAL_CMD:
8451      case INT_CMD:
8452      case INTVEC_CMD:
8453      case MAP_CMD:
8454      case MATRIX_CMD:
8455      case MODUL_CMD:
8456      case POLY_CMD:
8457      case PROC_CMD:
8458      case RING_CMD:
8459      case STRING_CMD:
8460        cmdtok = tok;
8461        break;
8462    }
8463  }
8464  return sArithBase.sCmds[i].toktype;
8465}
8466static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8467{
8468  // user defined types are not in the pre-computed table:
8469  if (op>MAX_TOK) return 0;
8470
8471  int a=0;
8472  int e=len;
8473  int p=len/2;
8474  do
8475  {
8476     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8477     if (op<dArithTab[p].cmd) e=p-1;
8478     else   a = p+1;
8479     p=a+(e-a)/2;
8480  }
8481  while ( a <= e);
8482
8483  // catch missing a cmd:
8484  assume(0);
8485  return 0;
8486}
8487
8488const char * Tok2Cmdname(int tok)
8489{
8490  int i = 0;
8491  if (tok <= 0)
8492  {
8493    return sArithBase.sCmds[0].name;
8494  }
8495  if (tok==ANY_TYPE) return "any_type";
8496  if (tok==COMMAND) return "command";
8497  if (tok==NONE) return "nothing";
8498  //if (tok==IFBREAK) return "if_break";
8499  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8500  //if (tok==ORDER_VECTOR) return "ordering";
8501  //if (tok==REF_VAR) return "ref";
8502  //if (tok==OBJECT) return "object";
8503  //if (tok==PRINT_EXPR) return "print_expr";
8504  if (tok==IDHDL) return "identifier";
8505  if (tok>MAX_TOK) return getBlackboxName(tok);
8506  for(i=0; i<sArithBase.nCmdUsed; i++)
8507    //while (sArithBase.sCmds[i].tokval!=0)
8508  {
8509    if ((sArithBase.sCmds[i].tokval == tok)&&
8510        (sArithBase.sCmds[i].alias==0))
8511    {
8512      return sArithBase.sCmds[i].name;
8513    }
8514  }
8515  return sArithBase.sCmds[0].name;
8516}
8517
8518
8519/*---------------------------------------------------------------------*/
8520/**
8521 * @brief compares to entry of cmdsname-list
8522
8523 @param[in] a
8524 @param[in] b
8525
8526 @return <ReturnValue>
8527**/
8528/*---------------------------------------------------------------------*/
8529static int _gentable_sort_cmds( const void *a, const void *b )
8530{
8531  cmdnames *pCmdL = (cmdnames*)a;
8532  cmdnames *pCmdR = (cmdnames*)b;
8533
8534  if(a==NULL || b==NULL)             return 0;
8535
8536  /* empty entries goes to the end of the list for later reuse */
8537  if(pCmdL->name==NULL) return 1;
8538  if(pCmdR->name==NULL) return -1;
8539
8540  /* $INVALID$ must come first */
8541  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8542  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8543
8544  /* tokval=-1 are reserved names at the end */
8545  if (pCmdL->tokval==-1)
8546  {
8547    if (pCmdR->tokval==-1)
8548       return strcmp(pCmdL->name, pCmdR->name);
8549    /* pCmdL->tokval==-1, pCmdL goes at the end */
8550    return 1;
8551  }
8552  /* pCmdR->tokval==-1, pCmdR goes at the end */
8553  if(pCmdR->tokval==-1) return -1;
8554
8555  return strcmp(pCmdL->name, pCmdR->name);
8556}
8557
8558/*---------------------------------------------------------------------*/
8559/**
8560 * @brief initialisation of arithmetic structured data
8561
8562 @retval 0 on success
8563
8564**/
8565/*---------------------------------------------------------------------*/
8566int iiInitArithmetic()
8567{
8568  //printf("iiInitArithmetic()\n");
8569  memset(&sArithBase, 0, sizeof(sArithBase));
8570  iiInitCmdName();
8571  /* fix last-identifier */
8572#if 0
8573  /* we expect that gentable allready did every thing */
8574  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8575      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8576    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8577  }
8578#endif
8579  //Print("L=%d\n", sArithBase.nLastIdentifier);
8580
8581  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8582  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8583
8584  //iiArithAddCmd("Top", 0,-1,0);
8585
8586
8587  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8588  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8589  //         sArithBase.sCmds[i].name,
8590  //         sArithBase.sCmds[i].alias,
8591  //         sArithBase.sCmds[i].tokval,
8592  //         sArithBase.sCmds[i].toktype);
8593  //}
8594  //iiArithRemoveCmd("Top");
8595  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8596  //iiArithRemoveCmd("mygcd");
8597  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8598  return 0;
8599}
8600
8601int iiArithFindCmd(const char *szName)
8602{
8603  int an=0;
8604  int i = 0,v = 0;
8605  int en=sArithBase.nLastIdentifier;
8606
8607  loop
8608  //for(an=0; an<sArithBase.nCmdUsed; )
8609  {
8610    if(an>=en-1)
8611    {
8612      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8613      {
8614        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8615        return an;
8616      }
8617      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8618      {
8619        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8620        return en;
8621      }
8622      else
8623      {
8624        //Print("RET- 1\n");
8625        return -1;
8626      }
8627    }
8628    i=(an+en)/2;
8629    if (*szName < *(sArithBase.sCmds[i].name))
8630    {
8631      en=i-1;
8632    }
8633    else if (*szName > *(sArithBase.sCmds[i].name))
8634    {
8635      an=i+1;
8636    }
8637    else
8638    {
8639      v=strcmp(szName,sArithBase.sCmds[i].name);
8640      if(v<0)
8641      {
8642        en=i-1;
8643      }
8644      else if(v>0)
8645      {
8646        an=i+1;
8647      }
8648      else /*v==0*/
8649      {
8650        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8651        return i;
8652      }
8653    }
8654  }
8655  //if(i>=0 && i<sArithBase.nCmdUsed)
8656  //  return i;
8657  //Print("RET-2\n");
8658  return -2;
8659}
8660
8661char *iiArithGetCmd( int nPos )
8662{
8663  if(nPos<0) return NULL;
8664  if(nPos<sArithBase.nCmdUsed)
8665    return sArithBase.sCmds[nPos].name;
8666  return NULL;
8667}
8668
8669int iiArithRemoveCmd(const char *szName)
8670{
8671  int nIndex;
8672  if(szName==NULL) return -1;
8673
8674  nIndex = iiArithFindCmd(szName);
8675  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8676  {
8677    Print("'%s' not found (%d)\n", szName, nIndex);
8678    return -1;
8679  }
8680  omFree(sArithBase.sCmds[nIndex].name);
8681  sArithBase.sCmds[nIndex].name=NULL;
8682  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8683        (&_gentable_sort_cmds));
8684  sArithBase.nCmdUsed--;
8685
8686  /* fix last-identifier */
8687  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8688      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8689  {
8690    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8691  }
8692  //Print("L=%d\n", sArithBase.nLastIdentifier);
8693  return 0;
8694}
8695
8696int iiArithAddCmd(
8697  const char *szName,
8698  short nAlias,
8699  short nTokval,
8700  short nToktype,
8701  short nPos
8702  )
8703{
8704  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8705  //       nTokval, nToktype, nPos);
8706  if(nPos>=0)
8707  {
8708    // no checks: we rely on a correct generated code in iparith.inc
8709    assume(nPos < sArithBase.nCmdAllocated);
8710    assume(szName!=NULL);
8711    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8712    sArithBase.sCmds[nPos].alias   = nAlias;
8713    sArithBase.sCmds[nPos].tokval  = nTokval;
8714    sArithBase.sCmds[nPos].toktype = nToktype;
8715    sArithBase.nCmdUsed++;
8716    //if(nTokval>0) sArithBase.nLastIdentifier++;
8717  }
8718  else
8719  {
8720    if(szName==NULL) return -1;
8721    int nIndex = iiArithFindCmd(szName);
8722    if(nIndex>=0)
8723    {
8724      Print("'%s' already exists at %d\n", szName, nIndex);
8725      return -1;
8726    }
8727
8728    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8729    {
8730      /* needs to create new slots */
8731      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8732      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8733      if(sArithBase.sCmds==NULL) return -1;
8734      sArithBase.nCmdAllocated++;
8735    }
8736    /* still free slots available */
8737    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8738    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8739    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8740    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8741    sArithBase.nCmdUsed++;
8742
8743    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8744          (&_gentable_sort_cmds));
8745    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8746        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8747    {
8748      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8749    }
8750    //Print("L=%d\n", sArithBase.nLastIdentifier);
8751  }
8752  return 0;
8753}
8754
8755static BOOLEAN check_valid(const int p, const int op)
8756{
8757  #ifdef HAVE_PLURAL
8758  if (rIsPluralRing(currRing))
8759  {
8760    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8761    {
8762      WerrorS("not implemented for non-commutative rings");
8763      return TRUE;
8764    }
8765    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8766    {
8767      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8768      return FALSE;
8769    }
8770    /* else, ALLOW_PLURAL */
8771  }
8772  #endif
8773  #ifdef HAVE_RINGS
8774  if (rField_is_Ring(currRing))
8775  {
8776    if ((p & RING_MASK)==0 /*NO_RING*/)
8777    {
8778      WerrorS("not implemented for rings with rings as coeffients");
8779      return TRUE;
8780    }
8781    /* else ALLOW_RING */
8782    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8783    &&(!rField_is_Domain(currRing)))
8784    {
8785      WerrorS("domain required as coeffients");
8786      return TRUE;
8787    }
8788    /* else ALLOW_ZERODIVISOR */
8789  }
8790  #endif
8791  return FALSE;
8792}
Note: See TracBrowser for help on using the repository browser.