source: git/Singular/iparith.cc @ 273fed

spielwiese
Last change on this file since 273fed was 22579cf, checked in by Oleksandr Motsak <motsak@…>, 13 years ago
FIX: betti and convertion to list should not change a resolution (syzstr)! FIX: La Scala must return min/full-res and should forget about syRing! FIX: is syRing NOT needed after La Scala resolution is finished... FIX: printing of resolution will not change the resolution anymore? (convetion to list?) From: Oleksandr Motsak <motsak@mathematik.uni-kl.de> git-svn-id: file:///usr/local/Singular/svn/trunk@13975 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 205.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT: table driven kernel interface, used by interpreter
8*/
9
10#include <stdlib.h>
11#include <string.h>
12#include <ctype.h>
13#include <stdio.h>
14#include <time.h>
15#include <unistd.h>
16
17#include <kernel/mod2.h>
18#include <Singular/tok.h>
19#include <kernel/options.h>
20#include <Singular/ipid.h>
21#include <kernel/intvec.h>
22#include <omalloc/omalloc.h>
23#include <kernel/polys.h>
24#include <kernel/febase.h>
25#include <Singular/sdb.h>
26#include <kernel/longalg.h>
27#include <kernel/longtrans.h>
28#include <kernel/ideals.h>
29#include <kernel/prCopy.h>
30#include <kernel/matpol.h>
31#include <kernel/kstd1.h>
32#include <kernel/timer.h>
33#include <kernel/ring.h>
34#include <Singular/subexpr.h>
35#include <Singular/lists.h>
36#include <kernel/modulop.h>
37#ifdef HAVE_RINGS
38#include <kernel/rmodulon.h>
39#include <kernel/rmodulo2m.h>
40#include <kernel/rintegers.h>
41#endif
42#include <kernel/numbers.h>
43#include <kernel/stairc.h>
44#include <kernel/maps.h>
45#include <Singular/maps_ip.h>
46#include <kernel/syz.h>
47#include <kernel/weight.h>
48#include <Singular/ipconv.h>
49#include <Singular/ipprint.h>
50#include <Singular/attrib.h>
51#include <Singular/silink.h>
52#include <kernel/sparsmat.h>
53#include <kernel/units.h>
54#include <Singular/janet.h>
55#include <kernel/GMPrat.h>
56#include <kernel/tgb.h>
57#include <kernel/walkProc.h>
58#include <kernel/mod_raw.h>
59#include <Singular/MinorInterface.h>
60#include <kernel/linearAlgebra.h>
61#include <Singular/misc_ip.h>
62#ifdef HAVE_FACTORY
63#  include <kernel/clapsing.h>
64#  include <kernel/kstdfac.h>
65#endif /* HAVE_FACTORY */
66#ifdef HAVE_FACTORY
67#  include <kernel/fglm.h>
68#endif /* HAVE_FACTORY */
69#include <Singular/interpolation.h>
70
71#include <Singular/blackbox.h>
72#include <Singular/newstruct.h>
73#include <Singular/ipshell.h>
74#include <kernel/mpr_inout.h>
75
76#include <kernel/timer.h>
77
78#ifdef HAVE_PLURAL
79  #include <kernel/gring.h>
80  #include <kernel/sca.h>
81  #define ALLOW_PLURAL     1
82  #define NO_PLURAL        0
83  #define COMM_PLURAL      2
84  #define  PLURAL_MASK 3
85#else /* HAVE_PLURAL */
86  #define ALLOW_PLURAL     0
87  #define NO_PLURAL        0
88  #define COMM_PLURAL      0
89  #define  PLURAL_MASK     0
90#endif /* HAVE_PLURAL */
91
92#ifdef HAVE_RINGS
93  #define RING_MASK        4
94#else
95  #define RING_MASK        0
96#endif
97#define ALLOW_RING       4
98#define NO_RING          0
99
100/*=============== types =====================*/
101struct sValCmdTab
102{
103  short cmd;
104  short start;
105};
106
107typedef sValCmdTab jjValCmdTab[];
108
109struct _scmdnames
110{
111  char *name;
112  short alias;
113  short tokval;
114  short toktype;
115};
116typedef struct _scmdnames cmdnames;
117
118
119typedef char * (*Proc1)(char *);
120struct sValCmd1
121{
122  proc1 p;
123  short cmd;
124  short res;
125  short arg;
126  short valid_for;
127};
128
129typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
130struct sValCmd2
131{
132  proc2 p;
133  short cmd;
134  short res;
135  short arg1;
136  short arg2;
137  short valid_for;
138};
139
140typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
141struct sValCmd3
142{
143  proc3 p;
144  short cmd;
145  short res;
146  short arg1;
147  short arg2;
148  short arg3;
149  short valid_for;
150};
151struct sValCmdM
152{
153  proc1 p;
154  short cmd;
155  short res;
156  short number_of_args; /* -1: any, -2: any >0, .. */
157  short valid_for;
158};
159
160typedef struct
161{
162  cmdnames *sCmds;             /**< array of existing commands */
163  struct sValCmd1 *psValCmd1;
164  struct sValCmd2 *psValCmd2;
165  struct sValCmd3 *psValCmd3;
166  struct sValCmdM *psValCmdM;
167  int nCmdUsed;      /**< number of commands used */
168  int nCmdAllocated; /**< number of commands-slots allocated */
169  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
170} SArithBase;
171
172/*---------------------------------------------------------------------*
173 * File scope Variables (Variables share by several functions in
174 *                       the same file )
175 *
176 *---------------------------------------------------------------------*/
177static SArithBase sArithBase;  /**< Base entry for arithmetic */
178
179/*---------------------------------------------------------------------*
180 * Extern Functions declarations
181 *
182 *---------------------------------------------------------------------*/
183static int _gentable_sort_cmds(const void *a, const void *b);
184extern int iiArithRemoveCmd(char *szName);
185extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
186                         short nToktype, short nPos=-1);
187
188/*============= proc =======================*/
189static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport = FALSE);
190static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
191#ifdef MDEBUG
192#define jjMakeSub(A) jjDBMakeSub(A,__FILE__,__LINE__)
193static Subexpr jjDBMakeSub(leftv e,const char *f,const  int l);
194#else
195static Subexpr jjMakeSub(leftv e);
196#endif
197
198/*============= vars ======================*/
199extern int cmdtok;
200extern BOOLEAN expected_parms;
201
202#define ii_div_by_0 "div. by 0"
203#define ii_not_for_plural "not implemented for non-commutative rings"
204#define ii_not_for_ring "not implemented for rings with rings as coeffients"
205
206int iiOp; /* the current operation*/
207
208/*=================== operations with 2 args.: static proc =================*/
209/* must be ordered: first operations for chars (infix ops),
210 * then alphabetically */
211
212static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
213{
214  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
215  int bb = (int)(long)(v->Data());
216  if (errorreported) return TRUE;
217  switch (iiOp)
218  {
219    case '+': (*aa) += bb; break;
220    case '-': (*aa) -= bb; break;
221    case '*': (*aa) *= bb; break;
222    case '/':
223    case INTDIV_CMD: (*aa) /= bb; break;
224    case '%':
225    case INTMOD_CMD: (*aa) %= bb; break;
226  }
227  res->data=(char *)aa;
228  return FALSE;
229}
230static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
231{
232  return jjOP_IV_I(res,v,u);
233}
234static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
235{
236  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
237  int bb = (int)(long)(v->Data());
238  int i=si_min(aa->rows(),aa->cols());
239  switch (iiOp)
240  {
241    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
242              break;
243    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
244              break;
245  }
246  res->data=(char *)aa;
247  return FALSE;
248}
249static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
250{
251  return jjOP_IM_I(res,v,u);
252}
253static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
254{
255  int l=(int)(long)v->Data();
256  if (l>0)
257  {
258    int d=(int)(long)u->Data();
259    intvec *vv=new intvec(l);
260    int i;
261    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
262    res->data=(char *)vv;
263  }
264  return (l<=0);
265}
266static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
267{
268  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
269  return FALSE;
270}
271static void jjEQUAL_REST(leftv res,leftv u,leftv v);
272static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
273{
274  intvec*    a = (intvec * )(u->Data());
275  intvec*    b = (intvec * )(v->Data());
276  int r=a->compare(b);
277  switch  (iiOp)
278  {
279    case '<':
280      res->data  = (char *) (r<0);
281      break;
282    case '>':
283      res->data  = (char *) (r>0);
284      break;
285    case LE:
286      res->data  = (char *) (r<=0);
287      break;
288    case GE:
289      res->data  = (char *) (r>=0);
290      break;
291    case EQUAL_EQUAL:
292    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
293      res->data  = (char *) (r==0);
294      break;
295  }
296  jjEQUAL_REST(res,u,v);
297  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
298  return FALSE;
299}
300static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
301{
302  intvec* a = (intvec * )(u->Data());
303  int     b = (int)(long)(v->Data());
304  int r=a->compare(b);
305  switch  (iiOp)
306  {
307    case '<':
308      res->data  = (char *) (r<0);
309      break;
310    case '>':
311      res->data  = (char *) (r>0);
312      break;
313    case LE:
314      res->data  = (char *) (r<=0);
315      break;
316    case GE:
317      res->data  = (char *) (r>=0);
318      break;
319    case EQUAL_EQUAL:
320    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
321      res->data  = (char *) (r==0);
322      break;
323  }
324  jjEQUAL_REST(res,u,v);
325  return FALSE;
326}
327static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
328{
329  poly p=(poly)u->Data();
330  poly q=(poly)v->Data();
331  int r=pCmp(p,q);
332  if (r==0)
333  {
334    number h=nSub(pGetCoeff(p),pGetCoeff(q));
335    /* compare lead coeffs */
336    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
337    nDelete(&h);
338  }
339  else if (p==NULL)
340  {
341    if (q==NULL)
342    {
343      /* compare 0, 0 */
344      r=0;
345    }
346    else if(pIsConstant(q))
347    {
348      /* compare 0, const */
349      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
350    }
351  }
352  else if (q==NULL)
353  {
354    if (pIsConstant(p))
355    {
356      /* compare const, 0 */
357      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
358    }
359  }
360  switch  (iiOp)
361  {
362    case '<':
363      res->data  = (char *) (r < 0);
364      break;
365    case '>':
366      res->data  = (char *) (r > 0);
367      break;
368    case LE:
369      res->data  = (char *) (r <= 0);
370      break;
371    case GE:
372      res->data  = (char *) (r >= 0);
373      break;
374    //case EQUAL_EQUAL:
375    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
376    //  res->data  = (char *) (r == 0);
377    //  break;
378  }
379  jjEQUAL_REST(res,u,v);
380  return FALSE;
381}
382static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
383{
384  char*    a = (char * )(u->Data());
385  char*    b = (char * )(v->Data());
386  int result = strcmp(a,b);
387  switch  (iiOp)
388  {
389    case '<':
390      res->data  = (char *) (result  < 0);
391      break;
392    case '>':
393      res->data  = (char *) (result  > 0);
394      break;
395    case LE:
396      res->data  = (char *) (result  <= 0);
397      break;
398    case GE:
399      res->data  = (char *) (result  >= 0);
400      break;
401    case EQUAL_EQUAL:
402    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
403      res->data  = (char *) (result  == 0);
404      break;
405  }
406  jjEQUAL_REST(res,u,v);
407  return FALSE;
408}
409static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
410{
411  if (u->Next()!=NULL)
412  {
413    u=u->next;
414    res->next = (leftv)omAllocBin(sleftv_bin);
415    return iiExprArith2(res->next,u,iiOp,v);
416  }
417  else if (v->Next()!=NULL)
418  {
419    v=v->next;
420    res->next = (leftv)omAllocBin(sleftv_bin);
421    return iiExprArith2(res->next,u,iiOp,v);
422  }
423  return FALSE;
424}
425static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
426{
427  int b=(int)(long)u->Data();
428  int e=(int)(long)v->Data();
429  int rc = 1;
430  BOOLEAN overflow=FALSE;
431  if (e >= 0)
432  {
433    if (b==0)
434    {
435      rc=(e==0);
436    }
437    else
438    {
439      int oldrc;
440      while ((e--)!=0)
441      {
442        oldrc=rc;
443        rc *= b;
444        if (!overflow)
445        {
446          if(rc/b!=oldrc) overflow=TRUE;
447        }
448      }
449      if (overflow)
450        WarnS("int overflow(^), result may be wrong");
451    }
452    res->data = (char *)((long)rc);
453    if (u!=NULL) return jjOP_REST(res,u,v);
454    return FALSE;
455  }
456  else
457  {
458    WerrorS("exponent must be non-negative");
459    return TRUE;
460  }
461}
462static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
463{
464  int e=(int)(long)v->Data();
465  number n=(number)u->Data();
466  if (e>=0)
467  {
468    nlPower(n,e,(number*)&res->data);
469  }
470  else
471  {
472    WerrorS("exponent must be non-negative");
473    return TRUE;
474  }
475  if (u!=NULL) return jjOP_REST(res,u,v);
476  return FALSE;
477}
478static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
479{
480  int e=(int)(long)v->Data();
481  number n=(number)u->Data();
482  int d=0;
483  if (e<0)
484  {
485    n=nInvers(n);
486    e=-e;
487    d=1;
488  }
489  nPower(n,e,(number*)&res->data);
490  if (d) nDelete(&n);
491  if (u!=NULL) return jjOP_REST(res,u,v);
492  return FALSE;
493}
494static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
495{
496  int v_i=(int)(long)v->Data();
497  if (v_i<0)
498  {
499    WerrorS("exponent must be non-negative");
500    return TRUE;
501  }
502  poly u_p=(poly)u->CopyD(POLY_CMD);
503  int dummy;
504  if ((u_p!=NULL)
505  && (pTotaldegree(u_p)*(signed long)v_i > (signed long)currRing->bitmask))
506  {
507    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
508                                    pTotaldegree(u_p),v_i,currRing->bitmask);
509    pDelete(&u_p);
510    return TRUE;
511  }
512  res->data = (char *)pPower(u_p,v_i);
513  if (u!=NULL) return jjOP_REST(res,u,v);
514  return errorreported; /* pPower may set errorreported via Werror */
515}
516static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
517{
518  res->data = (char *)idPower((ideal)(u->Data()),(int)(long)(v->Data()));
519  if (u!=NULL) return jjOP_REST(res,u,v);
520  return FALSE;
521}
522static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
523{
524  u=u->next;
525  v=v->next;
526  if (u==NULL)
527  {
528    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
529    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
530    {
531      do
532      {
533        if (res->next==NULL)
534          res->next = (leftv)omAlloc0Bin(sleftv_bin);
535        leftv tmp_v=v->next;
536        v->next=NULL;
537        BOOLEAN b=iiExprArith1(res->next,v,'-');
538        v->next=tmp_v;
539        if (b)
540          return TRUE;
541        v=tmp_v;
542        res=res->next;
543      } while (v!=NULL);
544      return FALSE;
545    }
546    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
547    {
548      res->next = (leftv)omAlloc0Bin(sleftv_bin);
549      res=res->next;
550      res->data = v->CopyD();
551      res->rtyp = v->Typ();
552      v=v->next;
553      if (v==NULL) return FALSE;
554    }
555  }
556  if (v!=NULL)                     /* u<>NULL, v<>NULL */
557  {
558    do
559    {
560      res->next = (leftv)omAlloc0Bin(sleftv_bin);
561      leftv tmp_u=u->next; u->next=NULL;
562      leftv tmp_v=v->next; v->next=NULL;
563      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
564      u->next=tmp_u;
565      v->next=tmp_v;
566      if (b)
567        return TRUE;
568      u=tmp_u;
569      v=tmp_v;
570      res=res->next;
571    } while ((u!=NULL) && (v!=NULL));
572    return FALSE;
573  }
574  loop                             /* u<>NULL, v==NULL */
575  {
576    res->next = (leftv)omAlloc0Bin(sleftv_bin);
577    res=res->next;
578    res->data = u->CopyD();
579    res->rtyp = u->Typ();
580    u=u->next;
581    if (u==NULL) return FALSE;
582  }
583}
584static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
585{
586  idhdl packhdl;
587  switch(u->Typ())
588  {
589      case 0:
590        Print("%s of type 'ANY'. Trying load.\n", v->name);
591        if(iiTryLoadLib(u, u->name))
592        {
593          Werror("'%s' no such package", u->name);
594          return TRUE;
595        }
596        syMake(u,u->name,NULL);
597        // else: use next case !!! no break !!!
598      case PACKAGE_CMD:
599        packhdl = (idhdl)u->data;
600        if((!IDPACKAGE(packhdl)->loaded)
601        && (IDPACKAGE(packhdl)->language > LANG_TOP))
602        {
603          Werror("'%s' not loaded", u->name);
604          return TRUE;
605        }
606        if(v->rtyp == IDHDL)
607        {
608          v->name = omStrDup(v->name);
609        }
610        v->req_packhdl=IDPACKAGE(packhdl);
611        syMake(v, v->name, packhdl);
612        memcpy(res, v, sizeof(sleftv));
613        memset(v, 0, sizeof(sleftv));
614        break;
615      case DEF_CMD:
616        break;
617      default:
618        WerrorS("<package>::<id> expected");
619        return TRUE;
620  }
621  return FALSE;
622}
623static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
624{
625  unsigned int a=(unsigned int)(unsigned long)u->Data();
626  unsigned int b=(unsigned int)(unsigned long)v->Data();
627  unsigned int c=a+b;
628  res->data = (char *)((long)c);
629  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
630  {
631    WarnS("int overflow(+), result may be wrong");
632  }
633  return jjPLUSMINUS_Gen(res,u,v);
634}
635static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
636{
637  res->data = (char *)(nlAdd((number)u->Data(), (number)v->Data()));
638  return jjPLUSMINUS_Gen(res,u,v);
639}
640static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
641{
642  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
643  return jjPLUSMINUS_Gen(res,u,v);
644}
645static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
646{
647  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
648  return jjPLUSMINUS_Gen(res,u,v);
649}
650static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
651{
652  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
653  if (res->data==NULL)
654  {
655     WerrorS("intmat size not compatible");
656     return TRUE;
657  }
658  return jjPLUSMINUS_Gen(res,u,v);
659  return FALSE;
660}
661static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
662{
663  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
664  res->data = (char *)(mpAdd(A , B));
665  if (res->data==NULL)
666  {
667     Werror("matrix size not compatible(%dx%d, %dx%d)",
668             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
669     return TRUE;
670  }
671  return jjPLUSMINUS_Gen(res,u,v);
672}
673static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
674{
675  matrix m=(matrix)u->Data();
676  matrix p= mpInitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)));
677  if (iiOp=='+')
678    res->data = (char *)mpAdd(m , p);
679  else
680    res->data = (char *)mpSub(m , p);
681  idDelete((ideal *)&p);
682  return jjPLUSMINUS_Gen(res,u,v);
683}
684static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
685{
686  return jjPLUS_MA_P(res,v,u);
687}
688static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
689{
690  char*    a = (char * )(u->Data());
691  char*    b = (char * )(v->Data());
692  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
693  strcpy(r,a);
694  strcat(r,b);
695  res->data=r;
696  return jjPLUSMINUS_Gen(res,u,v);
697}
698static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
699{
700  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
701  return jjPLUSMINUS_Gen(res,u,v);
702}
703static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
704{
705  void *ap=u->Data(); void *bp=v->Data();
706  int aa=(int)(long)ap;
707  int bb=(int)(long)bp;
708  int cc=aa-bb;
709  unsigned int a=(unsigned int)(unsigned long)ap;
710  unsigned int b=(unsigned int)(unsigned long)bp;
711  unsigned int c=a-b;
712  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
713  {
714    WarnS("int overflow(-), result may be wrong");
715  }
716  res->data = (char *)((long)cc);
717  return jjPLUSMINUS_Gen(res,u,v);
718}
719static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
720{
721  res->data = (char *)(nlSub((number)u->Data(), (number)v->Data()));
722  return jjPLUSMINUS_Gen(res,u,v);
723}
724static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
725{
726  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
727  return jjPLUSMINUS_Gen(res,u,v);
728}
729static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
730{
731  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
732  return jjPLUSMINUS_Gen(res,u,v);
733}
734static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
735{
736  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
737  if (res->data==NULL)
738  {
739     WerrorS("intmat size not compatible");
740     return TRUE;
741  }
742  return jjPLUSMINUS_Gen(res,u,v);
743}
744static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
745{
746  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
747  res->data = (char *)(mpSub(A , B));
748  if (res->data==NULL)
749  {
750     Werror("matrix size not compatible(%dx%d, %dx%d)",
751             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
752     return TRUE;
753  }
754  return jjPLUSMINUS_Gen(res,u,v);
755  return FALSE;
756}
757static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
758{
759  int a=(int)(long)u->Data();
760  int b=(int)(long)v->Data();
761  int c=a * b;
762  if ((b!=0) && (c/b !=a))
763    WarnS("int overflow(*), result may be wrong");
764  res->data = (char *)((long)c);
765  if ((u->Next()!=NULL) || (v->Next()!=NULL))
766    return jjOP_REST(res,u,v);
767  return FALSE;
768}
769static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
770{
771  res->data = (char *)(nlMult( (number)u->Data(), (number)v->Data()));
772  if ((v->next!=NULL) || (u->next!=NULL))
773    return jjOP_REST(res,u,v);
774  return FALSE;
775}
776static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
777{
778  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
779  number n=(number)res->data;
780  nNormalize(n);
781  res->data=(char *)n;
782  if ((v->next!=NULL) || (u->next!=NULL))
783    return jjOP_REST(res,u,v);
784  return FALSE;
785}
786static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
787{
788  poly a;
789  poly b;
790  int dummy;
791  if (v->next==NULL)
792  {
793    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
794    if (u->next==NULL)
795    {
796      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
797      if ((a!=NULL) && (b!=NULL)
798      && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
799      {
800        Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
801          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
802        pDelete(&a);
803        pDelete(&b);
804        return TRUE;
805      }
806      res->data = (char *)(pMult( a, b));
807      pNormalize((poly)res->data);
808      return FALSE;
809    }
810    // u->next exists: copy v
811    b=pCopy((poly)v->Data());
812    if ((a!=NULL) && (b!=NULL)
813    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
814    {
815      Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
816          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
817      pDelete(&a);
818      pDelete(&b);
819      return TRUE;
820    }
821    res->data = (char *)(pMult( a, b));
822    pNormalize((poly)res->data);
823    return jjOP_REST(res,u,v);
824  }
825  // v->next exists: copy u
826  a=pCopy((poly)u->Data());
827  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
828  if ((a!=NULL) && (b!=NULL)
829  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
830  {
831    pDelete(&a);
832    pDelete(&b);
833    WerrorS("OVERFLOW");
834    return TRUE;
835  }
836  res->data = (char *)(pMult( a, b));
837  pNormalize((poly)res->data);
838  return jjOP_REST(res,u,v);
839}
840static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
841{
842  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
843  idNormalize((ideal)res->data);
844  if ((v->next!=NULL) || (u->next!=NULL))
845    return jjOP_REST(res,u,v);
846  return FALSE;
847}
848static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
849{
850  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
851  if (res->data==NULL)
852  {
853     WerrorS("intmat size not compatible");
854     return TRUE;
855  }
856  if ((v->next!=NULL) || (u->next!=NULL))
857    return jjOP_REST(res,u,v);
858  return FALSE;
859}
860static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
861{
862  number n=nInit_bigint((number)v->Data());
863  poly p=pNSet(n);
864  ideal I= (ideal)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
865  res->data = (char *)I;
866  return FALSE;
867}
868static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
869{
870  return jjTIMES_MA_BI1(res,v,u);
871}
872static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
873{
874  poly p=(poly)v->CopyD(POLY_CMD);
875  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
876  ideal I= (ideal)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
877  if (r>0) I->rank=r;
878  idNormalize(I);
879  res->data = (char *)I;
880  return FALSE;
881}
882static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
883{
884  poly p=(poly)u->CopyD(POLY_CMD);
885  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
886  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD));
887  if (r>0) I->rank=r;
888  idNormalize(I);
889  res->data = (char *)I;
890  return FALSE;
891}
892static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
893{
894  number n=(number)v->CopyD(NUMBER_CMD);
895  poly p=pNSet(n);
896  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
897  idNormalize((ideal)res->data);
898  return FALSE;
899}
900static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
901{
902  return jjTIMES_MA_N1(res,v,u);
903}
904static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
905{
906  res->data = (char *)mpMultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data());
907  idNormalize((ideal)res->data);
908  return FALSE;
909}
910static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
911{
912  return jjTIMES_MA_I1(res,v,u);
913}
914static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
915{
916  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
917  res->data = (char *)mpMult(A,B);
918  if (res->data==NULL)
919  {
920     Werror("matrix size not compatible(%dx%d, %dx%d)",
921             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
922     return TRUE;
923  }
924  idNormalize((ideal)res->data);
925  if ((v->next!=NULL) || (u->next!=NULL))
926    return jjOP_REST(res,u,v);
927  return FALSE;
928}
929static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
930{
931  number h=nlSub((number)u->Data(),(number)v->Data());
932  res->data = (char *) (nlGreaterZero(h)||(nlIsZero(h)));
933  nlDelete(&h,NULL);
934  return FALSE;
935}
936static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
937{
938  res->data = (char *)((int)((long)u->Data()) >= (int)((long)v->Data()));
939  return FALSE;
940}
941static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
942{
943  res->data = (char *) (nGreater((number)u->Data(),(number)v->Data())
944                       || nEqual((number)u->Data(),(number)v->Data()));
945  return FALSE;
946}
947static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
948{
949  number h=nlSub((number)u->Data(),(number)v->Data());
950  res->data = (char *) (nlGreaterZero(h)&&(!nlIsZero(h)));
951  nlDelete(&h,NULL);
952  return FALSE;
953}
954static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
955{
956  res->data = (char *)((int)((long)u->Data()) > (int)((long)v->Data()));
957  return FALSE;
958}
959static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
960{
961  res->data = (char *) (nGreater((number)u->Data(),(number)v->Data()));
962  return FALSE;
963}
964static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
965{
966  return jjGE_BI(res,v,u);
967}
968static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
969{
970  res->data = (char *)((int)((long)u->Data()) <= (int)((long)v->Data()));
971  return FALSE;
972}
973static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
974{
975  return jjGE_N(res,v,u);
976}
977static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
978{
979  return jjGT_BI(res,v,u);
980}
981static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
982{
983  res->data = (char *)((int)((long)u->Data()) < (int)((long)v->Data()));
984  return FALSE;
985}
986static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
987{
988  return jjGT_N(res,v,u);
989}
990static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
991{
992  int a= (int)(long)u->Data();
993  int b= (int)(long)v->Data();
994  if (b==0)
995  {
996    WerrorS(ii_div_by_0);
997    return TRUE;
998  }
999  int bb=ABS(b);
1000  int c=a%bb;
1001  if(c<0) c+=bb;
1002  int r=0;
1003  switch (iiOp)
1004  {
1005    case INTMOD_CMD:
1006        r=c;            break;
1007    case '%':
1008        r= (a % b);     break;
1009    case INTDIV_CMD:
1010        r=((a-c) /b);   break;
1011    case '/':
1012        r= (a / b);     break;
1013  }
1014  res->data=(void *)((long)r);
1015  return FALSE;
1016}
1017static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1018{
1019  number q=(number)v->Data();
1020  if (nlIsZero(q))
1021  {
1022    WerrorS(ii_div_by_0);
1023    return TRUE;
1024  }
1025  q = nlIntDiv((number)u->Data(),q);
1026  nlNormalize(q);
1027  res->data = (char *)q;
1028  return FALSE;
1029}
1030static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1031{
1032  number q=(number)v->Data();
1033  if (nIsZero(q))
1034  {
1035    WerrorS(ii_div_by_0);
1036    return TRUE;
1037  }
1038  q = nDiv((number)u->Data(),q);
1039  nNormalize(q);
1040  res->data = (char *)q;
1041  return FALSE;
1042}
1043static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1044{
1045  poly q=(poly)v->Data();
1046  if (q==NULL)
1047  {
1048    WerrorS(ii_div_by_0);
1049    return TRUE;
1050  }
1051  poly p=(poly)(u->Data());
1052  if (p==NULL)
1053  {
1054    res->data=NULL;
1055    return FALSE;
1056  }
1057  if ((pNext(q)!=NULL) && (!rField_is_Ring()))
1058  { /* This means that q != 0 consists of at least two terms.
1059       Moreover, currRing is over a field. */
1060#ifdef HAVE_FACTORY
1061    if(pGetComp(p)==0)
1062    {
1063      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1064                                         q /*(poly)(v->Data())*/ ));
1065    }
1066    else
1067    {
1068      int comps=pMaxComp(p);
1069      ideal I=idInit(comps,1);
1070      p=pCopy(p);
1071      poly h;
1072      int i;
1073      // conversion to a list of polys:
1074      while (p!=NULL)
1075      {
1076        i=pGetComp(p)-1;
1077        h=pNext(p);
1078        pNext(p)=NULL;
1079        pSetComp(p,0);
1080        I->m[i]=pAdd(I->m[i],p);
1081        p=h;
1082      }
1083      // division and conversion to vector:
1084      h=NULL;
1085      p=NULL;
1086      for(i=comps-1;i>=0;i--)
1087      {
1088        if (I->m[i]!=NULL)
1089        {
1090          h=singclap_pdivide(I->m[i],q);
1091          pSetCompP(h,i+1);
1092          p=pAdd(p,h);
1093        }
1094      }
1095      idDelete(&I);
1096      res->data=(void *)p;
1097    }
1098#else /* HAVE_FACTORY */
1099    WerrorS("division only by a monomial");
1100    return TRUE;
1101#endif /* HAVE_FACTORY */
1102  }
1103  else
1104  { /* This means that q != 0 consists of just one term,
1105       or that currRing is over a coefficient ring. */
1106#ifdef HAVE_RINGS
1107    if (!rField_is_Domain())
1108    {
1109      WerrorS("division only defined over coefficient domains");
1110      return TRUE;
1111    }
1112    if (pNext(q)!=NULL)
1113    {
1114      WerrorS("division over a coefficient domain only implemented for terms");
1115      return TRUE;
1116    }
1117#endif
1118    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1119  }
1120  pNormalize((poly)res->data);
1121  return FALSE;
1122}
1123static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1124{
1125  poly q=(poly)v->Data();
1126  if (q==NULL)
1127  {
1128    WerrorS(ii_div_by_0);
1129    return TRUE;
1130  }
1131  matrix m=(matrix)(u->Data());
1132  int r=m->rows();
1133  int c=m->cols();
1134  matrix mm=mpNew(r,c);
1135  int i,j;
1136  for(i=r;i>0;i--)
1137  {
1138    for(j=c;j>0;j--)
1139    {
1140      if (pNext(q)!=NULL)
1141      {
1142      #ifdef HAVE_FACTORY
1143        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1144                                           q /*(poly)(v->Data())*/ );
1145#else /* HAVE_FACTORY */
1146        WerrorS("division only by a monomial");
1147        return TRUE;
1148#endif /* HAVE_FACTORY */
1149      }
1150      else
1151        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1152    }
1153  }
1154  idNormalize((ideal)mm);
1155  res->data=(char *)mm;
1156  return FALSE;
1157}
1158static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1159{
1160  res->data = (char *)((long)nlEqual((number)u->Data(),(number)v->Data()));
1161  jjEQUAL_REST(res,u,v);
1162  return FALSE;
1163}
1164static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1165{
1166  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1167  jjEQUAL_REST(res,u,v);
1168  return FALSE;
1169}
1170static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1171{
1172  res->data = (char *)((long)mpEqual((matrix)u->Data(),(matrix)v->Data()));
1173  jjEQUAL_REST(res,u,v);
1174  return FALSE;
1175}
1176static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1177{
1178  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1179  jjEQUAL_REST(res,u,v);
1180  return FALSE;
1181}
1182static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1183{
1184  poly p=(poly)u->Data();
1185  poly q=(poly)v->Data();
1186  res->data = (char *) ((long)pEqualPolys(p,q));
1187  jjEQUAL_REST(res,u,v);
1188  return FALSE;
1189}
1190static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1191{
1192  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1193  {
1194    int save_iiOp=iiOp;
1195    if (iiOp==NOTEQUAL)
1196      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1197    else
1198      iiExprArith2(res,u->next,iiOp,v->next);
1199    iiOp=save_iiOp;
1200  }
1201  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1202}
1203static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1204{
1205  res->data = (char *)((long)u->Data() && (long)v->Data());
1206  return FALSE;
1207}
1208static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1209{
1210  res->data = (char *)((long)u->Data() || (long)v->Data());
1211  return FALSE;
1212}
1213static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1214{
1215  res->rtyp=u->rtyp; u->rtyp=0;
1216  res->data=u->data; u->data=NULL;
1217  res->name=u->name; u->name=NULL;
1218  res->e=u->e;       u->e=NULL;
1219  if (res->e==NULL) res->e=jjMakeSub(v);
1220  else
1221  {
1222    Subexpr sh=res->e;
1223    while (sh->next != NULL) sh=sh->next;
1224    sh->next=jjMakeSub(v);
1225  }
1226  return FALSE;
1227}
1228static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1229{
1230  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1231  {
1232    WerrorS("indexed object must have a name");
1233    return TRUE;
1234  }
1235  intvec * iv=(intvec *)v->Data();
1236  leftv p=NULL;
1237  int i;
1238  sleftv t;
1239  memset(&t,0,sizeof(t));
1240  t.rtyp=INT_CMD;
1241  for (i=0;i<iv->length(); i++)
1242  {
1243    t.data=(char *)((long)(*iv)[i]);
1244    if (p==NULL)
1245    {
1246      p=res;
1247    }
1248    else
1249    {
1250      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1251      p=p->next;
1252    }
1253    p->rtyp=IDHDL;
1254    p->data=u->data;
1255    p->name=u->name;
1256    p->flag=u->flag;
1257    p->e=jjMakeSub(&t);
1258  }
1259  u->rtyp=0;
1260  u->data=NULL;
1261  u->name=NULL;
1262  return FALSE;
1263}
1264static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1265{
1266  poly p=(poly)u->Data();
1267  int i=(int)(long)v->Data();
1268  int j=0;
1269  while (p!=NULL)
1270  {
1271    j++;
1272    if (j==i)
1273    {
1274      res->data=(char *)pHead(p);
1275      return FALSE;
1276    }
1277    pIter(p);
1278  }
1279  return FALSE;
1280}
1281static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1282{
1283  poly p=(poly)u->Data();
1284  poly r=NULL;
1285  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1286  int i;
1287  int sum=0;
1288  for(i=iv->length()-1;i>=0;i--)
1289    sum+=(*iv)[i];
1290  int j=0;
1291  while ((p!=NULL) && (sum>0))
1292  {
1293    j++;
1294    for(i=iv->length()-1;i>=0;i--)
1295    {
1296      if (j==(*iv)[i])
1297      {
1298        r=pAdd(r,pHead(p));
1299        sum-=j;
1300        (*iv)[i]=0;
1301        break;
1302      }
1303    }
1304    pIter(p);
1305  }
1306  delete iv;
1307  res->data=(char *)r;
1308  return FALSE;
1309}
1310static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1311{
1312  poly p=(poly)u->CopyD(VECTOR_CMD);
1313  poly r=p; // pointer to the beginning of component i
1314  poly o=NULL;
1315  int i=(int)(long)v->Data();
1316  while (p!=NULL)
1317  {
1318    if (pGetComp(p)!=i)
1319    {
1320      if (r==p) r=pNext(p);
1321      if (o!=NULL)
1322      {
1323        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1324        p=pNext(o);
1325      }
1326      else
1327        pLmDelete(&p);
1328    }
1329    else
1330    {
1331      pSetComp(p, 0);
1332      p_SetmComp(p, currRing);
1333      o=p;
1334      p=pNext(o);
1335    }
1336  }
1337  res->data=(char *)r;
1338  return FALSE;
1339}
1340static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1341{
1342  poly p=(poly)u->CopyD(VECTOR_CMD);
1343  if (p!=NULL)
1344  {
1345    poly r=pOne();
1346    poly hp=r;
1347    intvec *iv=(intvec *)v->Data();
1348    int i;
1349    loop
1350    {
1351      for(i=0;i<iv->length();i++)
1352      {
1353        if (pGetComp(p)==(*iv)[i])
1354        {
1355          poly h;
1356          pSplit(p,&h);
1357          pNext(hp)=p;
1358          p=h;
1359          pIter(hp);
1360          break;
1361        }
1362      }
1363      if (p==NULL) break;
1364      if (i==iv->length())
1365      {
1366        pLmDelete(&p);
1367        if (p==NULL) break;
1368      }
1369    }
1370    pLmDelete(&r);
1371    res->data=(char *)r;
1372  }
1373  return FALSE;
1374}
1375static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1376static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1377{
1378  if(u->name==NULL) return TRUE;
1379  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1380  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1381  omFree((ADDRESS)u->name);
1382  u->name=NULL;
1383  char *n=omStrDup(nn);
1384  omFree((ADDRESS)nn);
1385  syMake(res,n);
1386  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1387  return FALSE;
1388}
1389static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1390{
1391  intvec * iv=(intvec *)v->Data();
1392  leftv p=NULL;
1393  int i;
1394  long slen = strlen(u->name) + 14;
1395  char *n = (char*) omAlloc(slen);
1396
1397  for (i=0;i<iv->length(); i++)
1398  {
1399    if (p==NULL)
1400    {
1401      p=res;
1402    }
1403    else
1404    {
1405      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1406      p=p->next;
1407    }
1408    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1409    syMake(p,omStrDup(n));
1410  }
1411  omFree((ADDRESS)u->name);
1412  u->name = NULL;
1413  omFreeSize(n, slen);
1414  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1415  return FALSE;
1416}
1417static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1418{
1419  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1420  memset(tmp,0,sizeof(sleftv));
1421  BOOLEAN b;
1422  if (v->Typ()==INTVEC_CMD)
1423    b=jjKLAMMER_IV(tmp,u,v);
1424  else
1425    b=jjKLAMMER(tmp,u,v);
1426  if (b)
1427  {
1428    omFreeBin(tmp,sleftv_bin);
1429    return TRUE;
1430  }
1431  leftv h=res;
1432  while (h->next!=NULL) h=h->next;
1433  h->next=tmp;
1434  return FALSE;
1435}
1436BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1437{
1438  void *d;
1439  Subexpr e;
1440  int typ;
1441  BOOLEAN t=FALSE;
1442  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1443  {
1444    idrec tmp_proc;
1445    tmp_proc.id="_auto";
1446    tmp_proc.typ=PROC_CMD;
1447    tmp_proc.data.pinf=(procinfo *)u->Data();
1448    tmp_proc.ref=1;
1449    d=u->data; u->data=(void *)&tmp_proc;
1450    e=u->e; u->e=NULL;
1451    t=TRUE;
1452    typ=u->rtyp; u->rtyp=IDHDL;
1453  }
1454  leftv sl;
1455  if (u->req_packhdl==currPack)
1456    sl = iiMake_proc((idhdl)u->data,NULL,v);
1457  else
1458    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1459  if (t)
1460  {
1461    u->rtyp=typ;
1462    u->data=d;
1463    u->e=e;
1464  }
1465  if (sl==NULL)
1466  {
1467    return TRUE;
1468  }
1469  else
1470  {
1471    memcpy(res,sl,sizeof(sleftv));
1472  }
1473  return FALSE;
1474}
1475static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1476{
1477  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1478  leftv sl=NULL;
1479  if ((v->e==NULL)&&(v->name!=NULL))
1480  {
1481    map m=(map)u->Data();
1482    sl=iiMap(m,v->name);
1483  }
1484  else
1485  {
1486    Werror("%s(<name>) expected",u->Name());
1487  }
1488  if (sl==NULL) return TRUE;
1489  memcpy(res,sl,sizeof(sleftv));
1490  omFreeBin((ADDRESS)sl, sleftv_bin);
1491  return FALSE;
1492}
1493static BOOLEAN jjCALL2MANY(leftv res, leftv u, leftv v)
1494{
1495  u->next=(leftv)omAllocBin(sleftv_bin);
1496  memcpy(u->next,v,sizeof(sleftv));
1497  BOOLEAN r=iiExprArithM(res,u,iiOp);
1498  v->Init();
1499  // iiExprArithM did the CleanUp
1500  return r;
1501}
1502#ifdef HAVE_FACTORY
1503static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1504{
1505  intvec *c=(intvec*)u->Data();
1506  intvec* p=(intvec*)v->Data();
1507  int rl=p->length();
1508  number *x=(number *)omAlloc(rl*sizeof(number));
1509  number *q=(number *)omAlloc(rl*sizeof(number));
1510  int i;
1511  for(i=rl-1;i>=0;i--)
1512  {
1513    q[i]=nlInit((*p)[i], NULL);
1514    x[i]=nlInit((*c)[i], NULL);
1515  }
1516  number n=nlChineseRemainder(x,q,rl);
1517  for(i=rl-1;i>=0;i--)
1518  {
1519    nlDelete(&(q[i]),NULL);
1520    nlDelete(&(x[i]),NULL);
1521  }
1522  omFree(x); omFree(q);
1523  res->data=(char *)n;
1524  return FALSE;
1525}
1526#endif
1527#if 0
1528static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1529{
1530  lists c=(lists)u->CopyD(); // list of poly
1531  intvec* p=(intvec*)v->Data();
1532  int rl=p->length();
1533  poly r=NULL,h, result=NULL;
1534  number *x=(number *)omAlloc(rl*sizeof(number));
1535  number *q=(number *)omAlloc(rl*sizeof(number));
1536  int i;
1537  for(i=rl-1;i>=0;i--)
1538  {
1539    q[i]=nlInit((*p)[i]);
1540  }
1541  loop
1542  {
1543    for(i=rl-1;i>=0;i--)
1544    {
1545      if (c->m[i].Typ()!=POLY_CMD)
1546      {
1547        Werror("poly expected at pos %d",i+1);
1548        for(i=rl-1;i>=0;i--)
1549        {
1550          nlDelete(&(q[i]),currRing);
1551        }
1552        omFree(x); omFree(q); // delete c
1553        return TRUE;
1554      }
1555      h=((poly)c->m[i].Data());
1556      if (r==NULL) r=h;
1557      else if (pLmCmp(r,h)==-1) r=h;
1558    }
1559    if (r==NULL) break;
1560    for(i=rl-1;i>=0;i--)
1561    {
1562      h=((poly)c->m[i].Data());
1563      if (pLmCmp(r,h)==0)
1564      {
1565        x[i]=pGetCoeff(h);
1566        h=pLmFreeAndNext(h);
1567        c->m[i].data=(char*)h;
1568      }
1569      else
1570        x[i]=nlInit(0);
1571    }
1572    number n=nlChineseRemainder(x,q,rl);
1573    for(i=rl-1;i>=0;i--)
1574    {
1575      nlDelete(&(x[i]),currRing);
1576    }
1577    h=pHead(r);
1578    pSetCoeff(h,n);
1579    result=pAdd(result,h);
1580  }
1581  for(i=rl-1;i>=0;i--)
1582  {
1583    nlDelete(&(q[i]),currRing);
1584  }
1585  omFree(x); omFree(q);
1586  res->data=(char *)result;
1587  return FALSE;
1588}
1589#endif
1590#ifdef HAVE_FACTORY
1591static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1592{
1593  if ((currRing==NULL) || rField_is_Q())
1594  {
1595    lists c=(lists)u->CopyD(); // list of ideal
1596    lists pl=NULL;
1597    intvec *p=NULL;
1598    if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1599    else                    p=(intvec*)v->Data();
1600    int rl=c->nr+1;
1601    poly r=NULL,h;
1602    ideal result;
1603    ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1604    int i;
1605    int return_type=c->m[0].Typ();
1606    if ((return_type!=IDEAL_CMD)
1607    && (return_type!=MODUL_CMD)
1608    && (return_type!=MATRIX_CMD))
1609    {
1610      WerrorS("ideal/module/matrix expected");
1611      omFree(x); // delete c
1612      return TRUE;
1613    }
1614    for(i=rl-1;i>=0;i--)
1615    {
1616      if (c->m[i].Typ()!=return_type)
1617      {
1618        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1619        omFree(x); // delete c
1620        return TRUE;
1621      }
1622      x[i]=((ideal)c->m[i].Data());
1623    }
1624    number *q=(number *)omAlloc(rl*sizeof(number));
1625    if (p!=NULL)
1626    {
1627      for(i=rl-1;i>=0;i--)
1628      {
1629        q[i]=nlInit((*p)[i], currRing);
1630      }
1631    }
1632    else
1633    {
1634      for(i=rl-1;i>=0;i--)
1635      {
1636        if (pl->m[i].Typ()==INT_CMD)
1637        {
1638          q[i]=nlInit((int)(long)pl->m[i].Data(),currRing);
1639        }
1640        else if (pl->m[i].Typ()==BIGINT_CMD)
1641        {
1642          q[i]=nlCopy((number)(pl->m[i].Data()));
1643        }
1644        else
1645        {
1646          Werror("bigint expected at pos %d",i+1);
1647          for(i++;i<rl;i++)
1648          {
1649            nlDelete(&(q[i]),currRing);
1650          }
1651          omFree(x); // delete c
1652          omFree(q); // delete pl
1653          return TRUE;
1654        }
1655      }
1656    }
1657    result=idChineseRemainder(x,q,rl);
1658    for(i=rl-1;i>=0;i--)
1659    {
1660      nlDelete(&(q[i]),currRing);
1661    }
1662    omFree(q);
1663    res->data=(char *)result;
1664    res->rtyp=return_type;
1665    return FALSE;
1666  }
1667  else return TRUE;
1668}
1669#endif
1670static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1671{
1672  poly p=(poly)v->Data();
1673  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1674  res->data=(char *)mpCoeffProc((poly)u->Data(),p /*(poly)v->Data()*/);
1675  return FALSE;
1676}
1677static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1678{
1679  int i=pVar((poly)v->Data());
1680  if (i==0)
1681  {
1682    WerrorS("ringvar expected");
1683    return TRUE;
1684  }
1685  res->data=(char *)mpCoeffs((ideal)u->CopyD(),i);
1686  return FALSE;
1687}
1688static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1689{
1690  poly p = pInit();
1691  int i;
1692  for (i=1; i<=pVariables; i++)
1693  {
1694    pSetExp(p, i, 1);
1695  }
1696  pSetm(p);
1697  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1698                                    (ideal)(v->Data()), p);
1699  pDelete(&p);
1700  return FALSE;
1701}
1702static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1703{
1704  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1705  return FALSE;
1706}
1707static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1708{
1709  short *iv=iv2array((intvec *)v->Data());
1710  ideal I=(ideal)u->Data();
1711  int d=-1;
1712  int i;
1713  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1714  omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
1715  res->data = (char *)((long)d);
1716  return FALSE;
1717}
1718static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1719{
1720  poly p=(poly)u->Data();
1721  if (p!=NULL)
1722  {
1723    short *iv=iv2array((intvec *)v->Data());
1724    int d=(int)pDegW(p,iv);
1725    omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
1726    res->data = (char *)(long(d));
1727  }
1728  else
1729    res->data=(char *)(long)(-1);
1730  return FALSE;
1731}
1732static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1733{
1734  int i=pVar((poly)v->Data());
1735  if (i==0)
1736  {
1737    WerrorS("ringvar expected");
1738    return TRUE;
1739  }
1740  res->data=(char *)pDiff((poly)(u->Data()),i);
1741  return FALSE;
1742}
1743static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1744{
1745  int i=pVar((poly)v->Data());
1746  if (i==0)
1747  {
1748    WerrorS("ringvar expected");
1749    return TRUE;
1750  }
1751  res->data=(char *)idDiff((matrix)(u->Data()),i);
1752  return FALSE;
1753}
1754static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1755{
1756  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1757  return FALSE;
1758}
1759static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1760{
1761  assumeStdFlag(v);
1762#ifdef HAVE_RINGS
1763  if (rField_is_Ring(currRing))
1764  {
1765    ring origR = currRing;
1766    ring tempR = rCopy(origR);
1767    tempR->ringtype = 0; tempR->ch = 0;
1768    rComplete(tempR);
1769    ideal vid = (ideal)v->Data();
1770    int i = idPosConstant(vid);
1771    if ((i != -1) && (nIsUnit(pGetCoeff(vid->m[i]))))
1772    { /* ideal v contains unit; dim = -1 */
1773      res->data = (char *)-1;
1774      return FALSE;
1775    }
1776    rChangeCurrRing(tempR);
1777    ideal vv = idrCopyR(vid, origR, currRing);
1778    ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1779    /* drop degree zero generator from vv (if any) */
1780    if (i != -1) pDelete(&vv->m[i]);
1781    long d = (long)scDimInt(vv, ww);   
1782    if (rField_is_Ring_Z(origR) && (i == -1)) d++;
1783    res->data = (char *)d;
1784    idDelete(&vv); idDelete(&ww);
1785    rChangeCurrRing(origR);
1786    rDelete(tempR);
1787    return FALSE;
1788  }
1789#endif
1790  if(currQuotient==NULL)
1791    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1792  else
1793  {
1794    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1795    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1796    idDelete(&q);
1797  }
1798  return FALSE;
1799}
1800static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1801{
1802  ideal vi=(ideal)v->Data();
1803  int vl= IDELEMS(vi);
1804  ideal ui=(ideal)u->Data();
1805  int ul= IDELEMS(ui);
1806  ideal R; matrix U;
1807  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1808  // now make sure that all matices have the corect size:
1809  matrix T = idModule2formatedMatrix(m,vl,ul);
1810  int i;
1811  if (MATCOLS(U) != ul)
1812  {
1813    int mul=si_min(ul,MATCOLS(U));
1814    matrix UU=mpNew(ul,ul);
1815    int j;
1816    for(i=mul;i>0;i--)
1817    {
1818      for(j=mul;j>0;j--)
1819      {
1820        MATELEM(UU,i,j)=MATELEM(U,i,j);
1821        MATELEM(U,i,j)=NULL;
1822      }
1823    }
1824    idDelete((ideal *)&U);
1825    U=UU;
1826  }
1827  // make sure that U is a diagonal matrix of units
1828  for(i=ul;i>0;i--)
1829  {
1830    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1831  }
1832  lists L=(lists)omAllocBin(slists_bin);
1833  L->Init(3);
1834  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1835  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1836  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1837  res->data=(char *)L;
1838  return FALSE;
1839}
1840static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1841{
1842  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1843  //setFlag(res,FLAG_STD);
1844  return FALSE;
1845}
1846static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1847{
1848  poly p=pOne();
1849  intvec *iv=(intvec*)v->Data();
1850  for(int i=iv->length()-1; i>=0; i--)
1851  {
1852    pSetExp(p,(*iv)[i],1);
1853  }
1854  pSetm(p);
1855  res->data=(char *)idElimination((ideal)u->Data(),p);
1856  pLmDelete(&p);
1857  //setFlag(res,FLAG_STD);
1858  return FALSE;
1859}
1860static BOOLEAN jjEXPORTTO(leftv res, leftv u, leftv v)
1861{
1862  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1863  return iiExport(v,0,(idhdl)u->data);
1864}
1865static BOOLEAN jjERROR(leftv res, leftv u)
1866{
1867  WerrorS((char *)u->Data());
1868  extern int inerror;
1869  inerror=3;
1870  return TRUE;
1871}
1872static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1873{
1874  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1875  int p0=ABS(uu),p1=ABS(vv);
1876  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
1877
1878  while ( p1!=0 )
1879  {
1880    q=p0 / p1;
1881    r=p0 % p1;
1882    p0 = p1; p1 = r;
1883    r = g0 - g1 * q;
1884    g0 = g1; g1 = r;
1885    r = f0 - f1 * q;
1886    f0 = f1; f1 = r;
1887  }
1888  int a = f0;
1889  int b = g0;
1890  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
1891  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
1892  lists L=(lists)omAllocBin(slists_bin);
1893  L->Init(3);
1894  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
1895  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
1896  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
1897  res->rtyp=LIST_CMD;
1898  res->data=(char *)L;
1899  return FALSE;
1900}
1901#ifdef HAVE_FACTORY
1902static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
1903{
1904  poly r,pa,pb;
1905  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb);
1906  if (ret) return TRUE;
1907  lists L=(lists)omAllocBin(slists_bin);
1908  L->Init(3);
1909  res->data=(char *)L;
1910  L->m[0].data=(void *)r;
1911  L->m[0].rtyp=POLY_CMD;
1912  L->m[1].data=(void *)pa;
1913  L->m[1].rtyp=POLY_CMD;
1914  L->m[2].data=(void *)pb;
1915  L->m[2].rtyp=POLY_CMD;
1916  return FALSE;
1917}
1918extern int singclap_factorize_retry;
1919static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
1920{
1921  intvec *v=NULL;
1922  int sw=(int)(long)dummy->Data();
1923  int fac_sw=sw;
1924  if ((sw<0)||(sw>2)) fac_sw=1;
1925  singclap_factorize_retry=0;
1926  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw);
1927  if (f==NULL)
1928    return TRUE;
1929  switch(sw)
1930  {
1931    case 0:
1932    case 2:
1933    {
1934      lists l=(lists)omAllocBin(slists_bin);
1935      l->Init(2);
1936      l->m[0].rtyp=IDEAL_CMD;
1937      l->m[0].data=(void *)f;
1938      l->m[1].rtyp=INTVEC_CMD;
1939      l->m[1].data=(void *)v;
1940      res->data=(void *)l;
1941      res->rtyp=LIST_CMD;
1942      return FALSE;
1943    }
1944    case 1:
1945      res->data=(void *)f;
1946      return FALSE;
1947    case 3:
1948      {
1949        poly p=f->m[0];
1950        int i=IDELEMS(f);
1951        f->m[0]=NULL;
1952        while(i>1)
1953        {
1954          i--;
1955          p=pMult(p,f->m[i]);
1956          f->m[i]=NULL;
1957        }
1958        res->data=(void *)p;
1959        res->rtyp=POLY_CMD;
1960      }
1961      return FALSE;
1962  }
1963  WerrorS("invalid switch");
1964  return TRUE;
1965}
1966static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
1967{
1968  ideal_list p,h;
1969  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
1970  p=h;
1971  int l=0;
1972  while (p!=NULL) { p=p->next;l++; }
1973  lists L=(lists)omAllocBin(slists_bin);
1974  L->Init(l);
1975  l=0;
1976  while(h!=NULL)
1977  {
1978    L->m[l].data=(char *)h->d;
1979    L->m[l].rtyp=IDEAL_CMD;
1980    p=h->next;
1981    omFreeSize(h,sizeof(*h));
1982    h=p;
1983    l++;
1984  }
1985  res->data=(void *)L;
1986  return FALSE;
1987}
1988#endif /* HAVE_FACTORY */
1989static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
1990{
1991  if (rField_is_Q())
1992  {
1993    number uu=(number)u->Data();
1994    number vv=(number)v->Data();
1995    res->data=(char *)nlFarey(uu,vv);
1996    return FALSE;
1997  }
1998  else return TRUE;
1999}
2000static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2001{
2002  if (rField_is_Q())
2003  {
2004    ideal uu=(ideal)u->Data();
2005    number vv=(number)v->Data();
2006    res->data=(void*)idFarey(uu,vv);
2007    res->rtyp=u->Typ();
2008    return FALSE;
2009  }
2010  else return TRUE;
2011}
2012static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2013{
2014  ring r=(ring)u->Data();
2015  idhdl w;
2016  int op=iiOp;
2017  nMapFunc nMap;
2018
2019  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2020  {
2021    int *perm=NULL;
2022    int *par_perm=NULL;
2023    int par_perm_size=0;
2024    BOOLEAN bo;
2025    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2026    if ((nMap=nSetMap(r))==NULL)
2027    {
2028      if (rEqual(r,currRing))
2029      {
2030        nMap=nCopy;
2031      }
2032      else
2033      // Allow imap/fetch to be make an exception only for:
2034      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2035            (rField_is_Q() || rField_is_Q_a() ||
2036             (rField_is_Zp() || rField_is_Zp_a())))
2037           ||
2038           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2039            (rField_is_Zp(currRing, rInternalChar(r)) ||
2040             rField_is_Zp_a(currRing, rInternalChar(r)))) )
2041      {
2042        par_perm_size=rPar(r);
2043        BITSET save_test=test;
2044        if ((r->minpoly != NULL) || (r->minideal != NULL))
2045          naSetChar(rInternalChar(r),r);
2046        else ntSetChar(rInternalChar(r),r);
2047        nSetChar(currRing);
2048        test=save_test;
2049      }
2050      else
2051      {
2052        goto err_fetch;
2053      }
2054    }
2055    if ((iiOp!=FETCH_CMD) || (r->N!=pVariables) || (rPar(r)!=rPar(currRing)))
2056    {
2057      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2058      if (par_perm_size!=0)
2059        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2060      op=IMAP_CMD;
2061      if (iiOp==IMAP_CMD)
2062      {
2063        maFindPerm(r->names,       r->N,       r->parameter,        r->P,
2064                   currRing->names,currRing->N,currRing->parameter, currRing->P,
2065                   perm,par_perm, currRing->ch);
2066      }
2067      else
2068      {
2069        int i;
2070        if (par_perm_size!=0)
2071          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2072        for(i=si_min(r->N,pVariables);i>0;i--) perm[i]=i;
2073      }
2074    }
2075    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2076    {
2077      int i;
2078      for(i=0;i<si_min(r->N,pVariables);i++)
2079      {
2080        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2081      }
2082      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2083      {
2084        Print("// par nr %d: %s -> %s\n",
2085              i,r->parameter[i],currRing->parameter[i]);
2086      }
2087    }
2088    sleftv tmpW;
2089    memset(&tmpW,0,sizeof(sleftv));
2090    tmpW.rtyp=IDTYP(w);
2091    tmpW.data=IDDATA(w);
2092    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2093                         perm,par_perm,par_perm_size,nMap)))
2094    {
2095      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2096    }
2097    if (perm!=NULL)
2098      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2099    if (par_perm!=NULL)
2100      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2101    return bo;
2102  }
2103  else
2104  {
2105    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2106  }
2107  return TRUE;
2108err_fetch:
2109  Werror("no identity map from %s",u->Fullname());
2110  return TRUE;
2111}
2112static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2113{
2114  /*4
2115  * look for the substring what in the string where
2116  * return the position of the first char of what in where
2117  * or 0
2118  */
2119  char *where=(char *)u->Data();
2120  char *what=(char *)v->Data();
2121  char *found = strstr(where,what);
2122  if (found != NULL)
2123  {
2124    res->data=(char *)((found-where)+1);
2125  }
2126  /*else res->data=NULL;*/
2127  return FALSE;
2128}
2129static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2130{
2131  res->data=(char *)fractalWalkProc(u,v);
2132  setFlag( res, FLAG_STD );
2133  return FALSE;
2134}
2135static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2136{
2137  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2138  int p0=ABS(uu),p1=ABS(vv);
2139  int r;
2140  while ( p1!=0 )
2141  {
2142    r=p0 % p1;
2143    p0 = p1; p1 = r;
2144  }
2145  res->rtyp=INT_CMD;
2146  res->data=(char *)(long)p0;
2147  return FALSE;
2148}
2149static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2150{
2151  number a=(number) u->Data();
2152  number b=(number) v->Data();
2153  if (nlIsZero(a))
2154  {
2155    if (nlIsZero(b)) res->data=(char *)nlInit(1, NULL);
2156    else             res->data=(char *)nlCopy(b);
2157  }
2158  else
2159  {
2160    if (nlIsZero(b))  res->data=(char *)nlCopy(a);
2161    else res->data=(char *)nlGcd(a, b, NULL);
2162  }
2163  return FALSE;
2164}
2165static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2166{
2167  number a=(number) u->Data();
2168  number b=(number) v->Data();
2169  if (nIsZero(a))
2170  {
2171    if (nIsZero(b)) res->data=(char *)nInit(1);
2172    else            res->data=(char *)nCopy(b);
2173  }
2174  else
2175  {
2176    if (nIsZero(b))  res->data=(char *)nCopy(a);
2177    else res->data=(char *)nGcd(a, b, currRing);
2178  }
2179  return FALSE;
2180}
2181#ifdef HAVE_FACTORY
2182static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2183{
2184  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2185                                 (poly)(v->CopyD(POLY_CMD)));
2186  return FALSE;
2187}
2188#endif /* HAVE_FACTORY */
2189static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2190{
2191  assumeStdFlag(u);
2192  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2193  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2194  switch((int)(long)v->Data())
2195  {
2196    case 1:
2197      res->data=(void *)iv;
2198      return FALSE;
2199    case 2:
2200      res->data=(void *)hSecondSeries(iv);
2201      delete iv;
2202      return FALSE;
2203  }
2204  WerrorS(feNotImplemented);
2205  delete iv;
2206  return TRUE;
2207}
2208static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2209{
2210  int i=pVar((poly)v->Data());
2211  if (i==0)
2212  {
2213    WerrorS("ringvar expected");
2214    return TRUE;
2215  }
2216  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2217  int d=pWTotaldegree(p);
2218  pLmDelete(p);
2219  if (d==1)
2220    res->data = (char *)pHomogen((poly)u->Data(),i);
2221  else
2222    WerrorS("variable must have weight 1");
2223  return (d!=1);
2224}
2225static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2226{
2227  int i=pVar((poly)v->Data());
2228  if (i==0)
2229  {
2230    WerrorS("ringvar expected");
2231    return TRUE;
2232  }
2233  pFDegProc deg;
2234  if (pLexOrder && (currRing->order[0]==ringorder_lp))
2235    deg=p_Totaldegree;
2236   else
2237    deg=pFDeg;
2238  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2239  int d=deg(p,currRing);
2240  pLmDelete(p);
2241  if (d==1)
2242    res->data = (char *)idHomogen((ideal)u->Data(),i);
2243  else
2244    WerrorS("variable must have weight 1");
2245  return (d!=1);
2246}
2247static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2248{
2249  intvec *w=new intvec(rVar(currRing));
2250  intvec *vw=(intvec*)u->Data();
2251  ideal v_id=(ideal)v->Data();
2252  pFDegProc save_FDeg=pFDeg;
2253  pLDegProc save_LDeg=pLDeg;
2254  BOOLEAN save_pLexOrder=pLexOrder;
2255  pLexOrder=FALSE;
2256  kHomW=vw;
2257  kModW=w;
2258  pSetDegProcs(kHomModDeg);
2259  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2260  pLexOrder=save_pLexOrder;
2261  kHomW=NULL;
2262  kModW=NULL;
2263  pRestoreDegProcs(save_FDeg,save_LDeg);
2264  if (w!=NULL) delete w;
2265  return FALSE;
2266}
2267static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2268{
2269  assumeStdFlag(u);
2270  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2271                    currQuotient);
2272  return FALSE;
2273}
2274static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2275{
2276  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2277  setFlag(res,FLAG_STD);
2278  return FALSE;
2279}
2280static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2281{
2282  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2283}
2284static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2285{
2286  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2287  return FALSE;
2288}
2289static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2290{
2291  res->data = (char *)idJet((ideal)u->Data(),(int)(long)v->Data());
2292  return FALSE;
2293}
2294static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2295{
2296#ifdef HAVE_RINGS
2297  if (rField_is_Ring(currRing))
2298  {
2299    WerrorS("kbase: only defined over ground fields");
2300    return TRUE;
2301  }
2302#endif
2303  assumeStdFlag(u);
2304  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2305  res->data = (char *)scKBase((int)(long)v->Data(),
2306                              (ideal)(u->Data()),currQuotient, w_u);
2307  if (w_u!=NULL)
2308  {
2309    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2310  }
2311  return FALSE;
2312}
2313static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2314static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2315{
2316  return jjPREIMAGE(res,u,v,NULL);
2317}
2318static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2319{
2320  return mpKoszul(res, u,v);
2321}
2322static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2323{
2324  sleftv h;
2325  memset(&h,0,sizeof(sleftv));
2326  h.rtyp=INT_CMD;
2327  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2328  return mpKoszul(res, u, &h, v);
2329}
2330static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2331{
2332  ideal m;
2333  BITSET save_test=test;
2334  int ul= IDELEMS((ideal)u->Data());
2335  int vl= IDELEMS((ideal)v->Data());
2336  m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD));
2337  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
2338  test=save_test;
2339  return FALSE;
2340}
2341static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2342{
2343  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2344  idhdl h=(idhdl)v->data;
2345  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2346  res->data = (char *)idLiftStd((ideal)u->Data(),
2347                                &(h->data.umatrix),testHomog);
2348  setFlag(res,FLAG_STD); v->flag=0;
2349  return FALSE;
2350}
2351static BOOLEAN jjLOAD2(leftv res, leftv u,leftv v)
2352{
2353  return jjLOAD(res, v,TRUE);
2354}
2355static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2356{
2357  char * s=(char *)u->Data();
2358  if(strcmp(s, "with")==0)
2359    return jjLOAD(res, v, TRUE);
2360  WerrorS("invalid second argument");
2361  WerrorS("load(\"libname\" [,\"with\"]);");
2362  return TRUE;
2363}
2364static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2365{
2366  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2367  tHomog hom=testHomog;
2368  if (w_u!=NULL)
2369  {
2370    w_u=ivCopy(w_u);
2371    hom=isHomog;
2372  }
2373  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2374  if (w_v!=NULL)
2375  {
2376    w_v=ivCopy(w_v);
2377    hom=isHomog;
2378  }
2379  if ((w_u!=NULL) && (w_v==NULL))
2380    w_v=ivCopy(w_u);
2381  if ((w_v!=NULL) && (w_u==NULL))
2382    w_u=ivCopy(w_v);
2383  ideal u_id=(ideal)u->Data();
2384  ideal v_id=(ideal)v->Data();
2385  if (w_u!=NULL)
2386  {
2387     if ((*w_u).compare((w_v))!=0)
2388     {
2389       WarnS("incompatible weights");
2390       delete w_u; w_u=NULL;
2391       hom=testHomog;
2392     }
2393     else
2394     {
2395       if ((!idTestHomModule(u_id,currQuotient,w_v))
2396       || (!idTestHomModule(v_id,currQuotient,w_v)))
2397       {
2398         WarnS("wrong weights");
2399         delete w_u; w_u=NULL;
2400         hom=testHomog;
2401       }
2402     }
2403  }
2404  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2405  if (w_u!=NULL)
2406  {
2407    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2408  }
2409  delete w_v;
2410  return FALSE;
2411}
2412static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2413{
2414  number q=(number)v->Data();
2415  if (nlIsZero(q))
2416  {
2417    WerrorS(ii_div_by_0);
2418    return TRUE;
2419  }
2420  res->data =(char *) nlIntMod((number)u->Data(),q);
2421  return FALSE;
2422}
2423static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2424{
2425  number q=(number)v->Data();
2426  if (nIsZero(q))
2427  {
2428    WerrorS(ii_div_by_0);
2429    return TRUE;
2430  }
2431  res->data =(char *) nIntMod((number)u->Data(),q);
2432  return FALSE;
2433}
2434static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2435static BOOLEAN jjMONITOR1(leftv res, leftv v)
2436{
2437  return jjMONITOR2(res,v,NULL);
2438}
2439static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v)
2440{
2441#if 0
2442  char *opt=(char *)v->Data();
2443  int mode=0;
2444  while(*opt!='\0')
2445  {
2446    if (*opt=='i') mode |= PROT_I;
2447    else if (*opt=='o') mode |= PROT_O;
2448    opt++;
2449  }
2450  monitor((char *)(u->Data()),mode);
2451#else
2452  si_link l=(si_link)u->Data();
2453  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2454  if(strcmp(l->m->type,"ASCII")!=0)
2455  {
2456    Werror("ASCII link required, not `%s`",l->m->type);
2457    slClose(l);
2458    return TRUE;
2459  }
2460  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2461  if ( l->name[0]!='\0') // "" is the stop condition
2462  {
2463    const char *opt;
2464    int mode=0;
2465    if (v==NULL) opt=(const char*)"i";
2466    else         opt=(const char *)v->Data();
2467    while(*opt!='\0')
2468    {
2469      if (*opt=='i') mode |= PROT_I;
2470      else if (*opt=='o') mode |= PROT_O;
2471      opt++;
2472    }
2473    monitor((FILE *)l->data,mode);
2474  }
2475  else
2476    monitor(NULL,0);
2477  return FALSE;
2478#endif
2479}
2480static BOOLEAN jjMONOM(leftv res, leftv v)
2481{
2482  intvec *iv=(intvec *)v->Data();
2483  poly p=pOne();
2484  int i,e;
2485  BOOLEAN err=FALSE;
2486  for(i=si_min(pVariables,iv->length()); i>0; i--)
2487  {
2488    e=(*iv)[i-1];
2489    if (e>=0) pSetExp(p,i,e);
2490    else err=TRUE;
2491  }
2492  if (iv->length()==(pVariables+1))
2493  {
2494    res->rtyp=VECTOR_CMD;
2495    e=(*iv)[pVariables];
2496    if (e>=0) pSetComp(p,e);
2497    else err=TRUE;
2498  }
2499  pSetm(p);
2500  res->data=(char*)p;
2501  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2502  return err;
2503}
2504static BOOLEAN jjNEWSTRUCT2(leftv res, leftv u, leftv v)
2505{
2506  // u: the name of the new type
2507  // v: the elements
2508  newstruct_desc d=newstructFromString((const char *)v->Data());
2509  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2510  return d==NULL;
2511}
2512static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2513{
2514  idhdl h=(idhdl)u->data;
2515  int i=(int)(long)v->Data();
2516  int p=0;
2517  if ((0<i)
2518  && (IDRING(h)->parameter!=NULL)
2519  && (i<=(p=rPar(IDRING(h)))))
2520    res->data=omStrDup(IDRING(h)->parameter[i-1]);
2521  else
2522  {
2523    Werror("par number %d out of range 1..%d",i,p);
2524    return TRUE;
2525  }
2526  return FALSE;
2527}
2528#ifdef HAVE_PLURAL
2529static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2530{
2531  if( currRing->qideal != NULL )
2532  {
2533    WerrorS("basering must NOT be a qring!");
2534    return TRUE;
2535  }
2536
2537  if (iiOp==NCALGEBRA_CMD)
2538  {
2539    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing);
2540  }
2541  else
2542  {
2543    ring r=rCopy(currRing);
2544    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r);
2545    res->data=r;
2546    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2547    return result;
2548  }
2549}
2550static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2551{
2552  if( currRing->qideal != NULL )
2553  {
2554    WerrorS("basering must NOT be a qring!");
2555    return TRUE;
2556  }
2557
2558  if (iiOp==NCALGEBRA_CMD)
2559  {
2560    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing);
2561  }
2562  else
2563  {
2564    ring r=rCopy(currRing);
2565    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r);
2566    res->data=r;
2567    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2568    return result;
2569  }
2570}
2571static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2572{
2573  if( currRing->qideal != NULL )
2574  {
2575    WerrorS("basering must NOT be a qring!");
2576    return TRUE;
2577  }
2578
2579  if (iiOp==NCALGEBRA_CMD)
2580  {
2581    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing);
2582  }
2583  else
2584  {
2585    ring r=rCopy(currRing);
2586    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r);
2587    res->data=r;
2588    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2589    return result;
2590  }
2591}
2592static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2593{
2594  if( currRing->qideal != NULL )
2595  {
2596    WerrorS("basering must NOT be a qring!");
2597    return TRUE;
2598  }
2599
2600  if (iiOp==NCALGEBRA_CMD)
2601  {
2602    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing);
2603  }
2604  else
2605  {
2606    ring r=rCopy(currRing);
2607    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r);
2608    res->data=r;
2609    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2610    return result;
2611  }
2612}
2613static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2614{
2615  res->data=NULL;
2616
2617  if (rIsPluralRing(currRing))
2618  {
2619    const poly q = (poly)b->Data();
2620
2621    if( q != NULL )
2622    {
2623      if( (poly)a->Data() != NULL )
2624      {
2625        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2626        res->data = nc_p_Bracket_qq(p,q); // p will be destroyed!
2627      }
2628    }
2629  }
2630  return FALSE;
2631}
2632static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2633{
2634  /* number, poly, vector, ideal, module, matrix */
2635  ring  r = (ring)a->Data();
2636  if (r == currRing)
2637  {
2638    res->data = b->Data();
2639    res->rtyp = b->rtyp;
2640    return FALSE;
2641  }
2642  if (!rIsLikeOpposite(currRing, r))
2643  {
2644    Werror("%s is not an opposite ring to current ring",a->Fullname());
2645    return TRUE;
2646  }
2647  idhdl w;
2648  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2649  {
2650    int argtype = IDTYP(w);
2651    switch (argtype)
2652    {
2653    case NUMBER_CMD:
2654      {
2655        /* since basefields are equal, we can apply nCopy */
2656        res->data = nCopy((number)IDDATA(w));
2657        res->rtyp = argtype;
2658        break;
2659      }
2660    case POLY_CMD:
2661    case VECTOR_CMD:
2662      {
2663        poly    q = (poly)IDDATA(w);
2664        res->data = pOppose(r,q);
2665        res->rtyp = argtype;
2666        break;
2667      }
2668    case IDEAL_CMD:
2669    case MODUL_CMD:
2670      {
2671        ideal   Q = (ideal)IDDATA(w);
2672        res->data = idOppose(r,Q);
2673        res->rtyp = argtype;
2674        break;
2675      }
2676    case MATRIX_CMD:
2677      {
2678        ring save = currRing;
2679        rChangeCurrRing(r);
2680        matrix  m = (matrix)IDDATA(w);
2681        ideal   Q = idMatrix2Module(mpCopy(m));
2682        rChangeCurrRing(save);
2683        ideal   S = idOppose(r,Q);
2684        id_Delete(&Q, r);
2685        res->data = idModule2Matrix(S);
2686        res->rtyp = argtype;
2687        break;
2688      }
2689    default:
2690      {
2691        WerrorS("unsupported type in oppose");
2692        return TRUE;
2693      }
2694    }
2695  }
2696  else
2697  {
2698    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2699    return TRUE;
2700  }
2701  return FALSE;
2702}
2703#endif /* HAVE_PLURAL */
2704
2705static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2706{
2707  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2708    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2709  idDelMultiples((ideal)(res->data));
2710  return FALSE;
2711}
2712static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2713{
2714  int i=(int)(long)u->Data();
2715  int j=(int)(long)v->Data();
2716  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2717  return FALSE;
2718}
2719static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2720{
2721  matrix m =(matrix)u->Data();
2722  int isRowEchelon = (int)(long)v->Data();
2723  if (isRowEchelon != 1) isRowEchelon = 0;
2724  int rank = luRank(m, isRowEchelon);
2725  res->data =(char *)(long)rank;
2726  return FALSE;
2727}
2728static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2729{
2730  si_link l=(si_link)u->Data();
2731  leftv r=slRead(l,v);
2732  if (r==NULL)
2733  {
2734    const char *s;
2735    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2736    else                            s=sNoName;
2737    Werror("cannot read from `%s`",s);
2738    return TRUE;
2739  }
2740  memcpy(res,r,sizeof(sleftv));
2741  omFreeBin((ADDRESS)r, sleftv_bin);
2742  return FALSE;
2743}
2744static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2745{
2746  assumeStdFlag(v);
2747  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2748  return FALSE;
2749}
2750static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2751{
2752  assumeStdFlag(v);
2753  ideal ui=(ideal)u->Data();
2754  idTest(ui);
2755  ideal vi=(ideal)v->Data();
2756  idTest(vi);
2757  res->data = (char *)kNF(vi,currQuotient,ui);
2758  return FALSE;
2759}
2760#if 0
2761static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2762{
2763  int maxl=(int)(long)v->Data();
2764  if (maxl<0)
2765  {
2766    WerrorS("length for res must not be negative");
2767    return TRUE;
2768  }
2769  int l=0;
2770  //resolvente r;
2771  syStrategy r;
2772  intvec *weights=NULL;
2773  int wmaxl=maxl;
2774  ideal u_id=(ideal)u->Data();
2775
2776  maxl--;
2777  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2778  {
2779    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2780    if (currQuotient!=NULL)
2781    {
2782      Warn(
2783      "full resolution in a qring may be infinite, setting max length to %d",
2784      maxl+1);
2785    }
2786  }
2787  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2788  if (weights!=NULL)
2789  {
2790    if (!idTestHomModule(u_id,currQuotient,weights))
2791    {
2792      WarnS("wrong weights given:");weights->show();PrintLn();
2793      weights=NULL;
2794    }
2795  }
2796  intvec *ww=NULL;
2797  int add_row_shift=0;
2798  if (weights!=NULL)
2799  {
2800     ww=ivCopy(weights);
2801     add_row_shift = ww->min_in();
2802     (*ww) -= add_row_shift;
2803  }
2804  else
2805    idHomModule(u_id,currQuotient,&ww);
2806  weights=ww;
2807
2808  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2809  {
2810    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2811  }
2812  else if (iiOp==SRES_CMD)
2813  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2814    r=sySchreyer(u_id,maxl+1);
2815  else if (iiOp == LRES_CMD)
2816  {
2817    int dummy;
2818    if((currQuotient!=NULL)||
2819    (!idHomIdeal (u_id,NULL)))
2820    {
2821       WerrorS
2822       ("`lres` not implemented for inhomogeneous input or qring");
2823       return TRUE;
2824    }
2825    r=syLaScala3(u_id,&dummy);
2826  }
2827  else if (iiOp == KRES_CMD)
2828  {
2829    int dummy;
2830    if((currQuotient!=NULL)||
2831    (!idHomIdeal (u_id,NULL)))
2832    {
2833       WerrorS
2834       ("`kres` not implemented for inhomogeneous input or qring");
2835       return TRUE;
2836    }
2837    r=syKosz(u_id,&dummy);
2838  }
2839  else
2840  {
2841    int dummy;
2842    if((currQuotient!=NULL)||
2843    (!idHomIdeal (u_id,NULL)))
2844    {
2845       WerrorS
2846       ("`hres` not implemented for inhomogeneous input or qring");
2847       return TRUE;
2848    }
2849    r=syHilb(u_id,&dummy);
2850  }
2851  if (r==NULL) return TRUE;
2852  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
2853  r->list_length=wmaxl;
2854  res->data=(void *)r;
2855  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
2856  {
2857    intvec *w=ivCopy(r->weights[0]);
2858    if (weights!=NULL) (*w) += add_row_shift;
2859    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
2860    w=NULL;
2861  }
2862  else
2863  {
2864//#if 0
2865// need to set weights for ALL components (sres)
2866    if (weights!=NULL)
2867    {
2868      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
2869      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
2870      (r->weights)[0] = ivCopy(weights);
2871    }
2872//#endif
2873  }
2874  if (ww!=NULL) { delete ww; ww=NULL; }
2875  return FALSE;
2876}
2877#else
2878static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2879{
2880  int maxl=(int)(long)v->Data();
2881  if (maxl<0)
2882  {
2883    WerrorS("length for res must not be negative");
2884    return TRUE;
2885  }
2886  int l=0;
2887  //resolvente r;
2888  syStrategy r;
2889  intvec *weights=NULL;
2890  int wmaxl=maxl;
2891  ideal u_id=(ideal)u->Data();
2892
2893  maxl--;
2894  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2895  {
2896    maxl = pVariables-1+2*(iiOp==MRES_CMD);
2897    if (currQuotient!=NULL)
2898    {
2899      Warn(
2900      "full resolution in a qring may be infinite, setting max length to %d",
2901      maxl+1);
2902    }
2903  }
2904  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2905  if (weights!=NULL)
2906  {
2907    if (!idTestHomModule(u_id,currQuotient,weights))
2908    {
2909      WarnS("wrong weights given:");weights->show();PrintLn();
2910      weights=NULL;
2911    }
2912  }
2913  intvec *ww=NULL;
2914  int add_row_shift=0;
2915  if (weights!=NULL)
2916  {
2917     ww=ivCopy(weights);
2918     add_row_shift = ww->min_in();
2919     (*ww) -= add_row_shift;
2920  }
2921  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2922  {
2923    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2924  }
2925  else if (iiOp==SRES_CMD)
2926  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2927    r=sySchreyer(u_id,maxl+1);
2928  else if (iiOp == LRES_CMD)
2929  {
2930    int dummy;
2931    if((currQuotient!=NULL)||
2932    (!idHomIdeal (u_id,NULL)))
2933    {
2934       WerrorS
2935       ("`lres` not implemented for inhomogeneous input or qring");
2936       return TRUE;
2937    }
2938    r=syLaScala3(u_id,&dummy);
2939  }
2940  else if (iiOp == KRES_CMD)
2941  {
2942    int dummy;
2943    if((currQuotient!=NULL)||
2944    (!idHomIdeal (u_id,NULL)))
2945    {
2946       WerrorS
2947       ("`kres` not implemented for inhomogeneous input or qring");
2948       return TRUE;
2949    }
2950    r=syKosz(u_id,&dummy);
2951  }
2952  else
2953  {
2954    int dummy;
2955    if((currQuotient!=NULL)||
2956    (!idHomIdeal (u_id,NULL)))
2957    {
2958       WerrorS
2959       ("`hres` not implemented for inhomogeneous input or qring");
2960       return TRUE;
2961    }
2962    ideal u_id_copy=idCopy(u_id);
2963    idSkipZeroes(u_id_copy);
2964    r=syHilb(u_id_copy,&dummy);
2965    idDelete(&u_id_copy);
2966  }
2967  if (r==NULL) return TRUE;
2968  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
2969  r->list_length=wmaxl;
2970  res->data=(void *)r;
2971  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
2972  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
2973  {
2974    ww=ivCopy(r->weights[0]);
2975    if (weights!=NULL) (*ww) += add_row_shift;
2976    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
2977  }
2978  else
2979  {
2980    if (weights!=NULL)
2981    {
2982      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
2983    }
2984  }
2985
2986  // test the La Scala case' output
2987  assume( (iiOp == LRES_CMD) == (r->syRing != NULL) );
2988  assume( (iiOp == LRES_CMD) == (r->resPairs != NULL) );
2989  assume( (r->minres != NULL) || (r->fullres != NULL) );
2990
2991  return FALSE;
2992}
2993#endif
2994static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
2995{
2996  number n1; number n2; number temp; int i;
2997
2998  if ((u->Typ() == BIGINT_CMD) ||
2999     ((u->Typ() == NUMBER_CMD) && rField_is_Q()))
3000  {
3001    temp = (number)u->Data();
3002    n1 = nlCopy(temp);
3003  }
3004  else if (u->Typ() == INT_CMD)
3005  {
3006    i = (int)(long)u->Data();
3007    n1 = nlInit(i, NULL);
3008  }
3009  else
3010  {
3011    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3012    return TRUE;
3013  }
3014
3015  if ((v->Typ() == BIGINT_CMD) ||
3016     ((v->Typ() == NUMBER_CMD) && rField_is_Q()))
3017  {
3018    temp = (number)v->Data();
3019    n2 = nlCopy(temp);
3020  }
3021  else if (v->Typ() == INT_CMD)
3022  {
3023    i = (int)(long)v->Data();
3024    n2 = nlInit(i, NULL);
3025  }
3026  else
3027  {
3028    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3029    return TRUE;
3030  }
3031
3032  lists l = primeFactorisation(n1, n2);
3033  nlDelete(&n1, NULL); nlDelete(&n2, NULL);
3034  res->data = (char*)l;
3035  return FALSE;
3036}
3037static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3038{
3039  ring r;
3040  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3041  res->data = (char *)r;
3042  return (i==-1);
3043}
3044#define SIMPL_LMDIV 32
3045#define SIMPL_LMEQ  16
3046#define SIMPL_MULT 8
3047#define SIMPL_EQU  4
3048#define SIMPL_NULL 2
3049#define SIMPL_NORM 1
3050static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3051{
3052  int sw = (int)(long)v->Data();
3053  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3054  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3055  if (sw & SIMPL_LMDIV)
3056  {
3057    idDelDiv(id);
3058  }
3059  if (sw & SIMPL_LMEQ)
3060  {
3061    idDelLmEquals(id);
3062  }
3063  if (sw & SIMPL_MULT)
3064  {
3065    idDelMultiples(id);
3066  }
3067  else if(sw & SIMPL_EQU)
3068  {
3069    idDelEquals(id);
3070  }
3071  if (sw & SIMPL_NULL)
3072  {
3073    idSkipZeroes(id);
3074  }
3075  if (sw & SIMPL_NORM)
3076  {
3077    idNorm(id);
3078  }
3079  res->data = (char * )id;
3080  return FALSE;
3081}
3082static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3083{
3084  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3085  return FALSE;
3086}
3087static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3088{
3089  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3090  //return (res->data== (void*)(long)-2);
3091  return FALSE;
3092}
3093static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3094{
3095  int sw = (int)(long)v->Data();
3096  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3097  poly p = (poly)u->CopyD(POLY_CMD);
3098  if (sw & SIMPL_NORM)
3099  {
3100    pNorm(p);
3101  }
3102  res->data = (char * )p;
3103  return FALSE;
3104}
3105static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3106{
3107  ideal result;
3108  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3109  tHomog hom=testHomog;
3110  ideal u_id=(ideal)(u->Data());
3111  if (w!=NULL)
3112  {
3113    if (!idTestHomModule(u_id,currQuotient,w))
3114    {
3115      WarnS("wrong weights:");w->show();PrintLn();
3116      w=NULL;
3117    }
3118    else
3119    {
3120      w=ivCopy(w);
3121      hom=isHomog;
3122    }
3123  }
3124  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3125  idSkipZeroes(result);
3126  res->data = (char *)result;
3127  setFlag(res,FLAG_STD);
3128  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3129  return FALSE;
3130}
3131static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3132static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3133/* destroys i0, p0 */
3134/* result (with attributes) in res */
3135/* i0: SB*/
3136/* t0: type of p0*/
3137/* p0 new elements*/
3138/* a attributes of i0*/
3139{
3140  int tp;
3141  if (t0==IDEAL_CMD) tp=POLY_CMD;
3142  else               tp=VECTOR_CMD;
3143  for (int i=IDELEMS(p0)-1; i>=0; i--)
3144  {
3145    poly p=p0->m[i];
3146    p0->m[i]=NULL;
3147    if (p!=NULL)
3148    {
3149      sleftv u0,v0;
3150      memset(&u0,0,sizeof(sleftv));
3151      memset(&v0,0,sizeof(sleftv));
3152      v0.rtyp=tp;
3153      v0.data=(void*)p;
3154      u0.rtyp=t0;
3155      u0.data=i0;
3156      u0.attribute=a;
3157      setFlag(&u0,FLAG_STD);
3158      jjSTD_1(res,&u0,&v0);
3159      i0=(ideal)res->data;
3160      res->data=NULL;
3161      a=res->attribute;
3162      res->attribute=NULL;
3163      u0.CleanUp();
3164      v0.CleanUp();
3165      res->CleanUp();
3166    }
3167  }
3168  idDelete(&p0);
3169  res->attribute=a;
3170  res->data=(void *)i0;
3171  res->rtyp=t0;
3172}
3173static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3174{
3175  ideal result;
3176  assumeStdFlag(u);
3177  ideal i1=(ideal)(u->Data());
3178  ideal i0;
3179  int r=v->Typ();
3180  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3181  {
3182    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3183    i0->m[0]=(poly)v->Data();
3184    int ii0=idElem(i0); /* size of i0 */
3185    i1=idSimpleAdd(i1,i0); //
3186    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3187    idDelete(&i0);
3188    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3189    tHomog hom=testHomog;
3190
3191    if (w!=NULL)
3192    {
3193      if (!idTestHomModule(i1,currQuotient,w))
3194      {
3195        // no warnung: this is legal, if i in std(i,p)
3196        // is homogeneous, but p not
3197        w=NULL;
3198      }
3199      else
3200      {
3201        w=ivCopy(w);
3202        hom=isHomog;
3203      }
3204    }
3205    BITSET save_test=test;
3206    test|=Sy_bit(OPT_SB_1);
3207    /* ii0 appears to be the position of the first element of il that
3208       does not belong to the old SB ideal */
3209    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3210    test=save_test;
3211    idDelete(&i1);
3212    idSkipZeroes(result);
3213    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3214    res->data = (char *)result;
3215  }
3216  else /*IDEAL/MODULE*/
3217  {
3218    attr a=NULL;
3219    if (u->attribute!=NULL) a=u->attribute->Copy();
3220    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3221  }
3222  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3223  return FALSE;
3224}
3225static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3226{
3227  idhdl h=(idhdl)u->data;
3228  int i=(int)(long)v->Data();
3229  if ((0<i) && (i<=IDRING(h)->N))
3230    res->data=omStrDup(IDRING(h)->names[i-1]);
3231  else
3232  {
3233    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3234    return TRUE;
3235  }
3236  return FALSE;
3237}
3238static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3239{
3240// input: u: a list with links of type
3241//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3242//        v: timeout for select in milliseconds
3243//           or 0 for polling
3244// returns: ERROR (via Werror): timeout negative
3245//           -1: the read state of all links is eof
3246//            0: timeout (or polling): none ready
3247//           i>0: (at least) L[i] is ready
3248  lists Lforks = (lists)u->Data();
3249  int t = (int)(long)v->Data();
3250  if(t < 0)
3251  {
3252    WerrorS("negative timeout"); return TRUE;
3253  }
3254  int i = slStatusSsiL(Lforks, t*1000);
3255  if(i == -2) /* error */
3256  {
3257    return TRUE;
3258  }
3259  res->data = (void*)(long)i;
3260  return FALSE;
3261}
3262static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3263{
3264// input: u: a list with links of type
3265//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3266//        v: timeout for select in milliseconds
3267//           or 0 for polling
3268// returns: ERROR (via Werror): timeout negative
3269//           -1: the read state of all links is eof
3270//           0: timeout (or polling): none ready
3271//           1: all links are ready
3272//              (caution: at least one is ready, but some maybe dead)
3273  lists Lforks = (lists)u->CopyD();
3274  int timeout = 1000*(int)(long)v->Data();
3275  if(timeout < 0)
3276  {
3277    WerrorS("negative timeout"); return TRUE;
3278  }
3279  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3280  int i;
3281  int ret = -1;
3282  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3283  {
3284    i = slStatusSsiL(Lforks, timeout);
3285    if(i > 0) /* Lforks[i] is ready */
3286    {
3287      ret = 1;
3288      Lforks->m[i-1].CleanUp();
3289      Lforks->m[i-1].rtyp=DEF_CMD;
3290      Lforks->m[i-1].data=NULL;
3291      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3292    }
3293    else /* terminate the for loop */
3294    {
3295      if(i == -2) /* error */
3296      {
3297        return TRUE;
3298      }
3299      if(i == 0) /* timeout */
3300      {
3301        ret = 0;
3302      }
3303      break;
3304    }
3305  }
3306  Lforks->Clean();
3307  res->data = (void*)(long)ret;
3308  return FALSE;
3309}
3310static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3311{
3312  res->data = (char *)mpWedge((matrix)u->Data(),(int)(long)v->Data());
3313  return FALSE;
3314}
3315#define jjWRONG2 (proc2)jjWRONG
3316#define jjWRONG3 (proc3)jjWRONG
3317static BOOLEAN jjWRONG(leftv res, leftv u)
3318{
3319  return TRUE;
3320}
3321
3322/*=================== operations with 1 arg.: static proc =================*/
3323/* must be ordered: first operations for chars (infix ops),
3324 * then alphabetically */
3325
3326static BOOLEAN jjDUMMY(leftv res, leftv u)
3327{
3328  res->data = (char *)u->CopyD();
3329  return FALSE;
3330}
3331static BOOLEAN jjNULL(leftv res, leftv u)
3332{
3333  return FALSE;
3334}
3335//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3336//{
3337//  res->data = (char *)((int)(long)u->Data()+1);
3338//  return FALSE;
3339//}
3340//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3341//{
3342//  res->data = (char *)((int)(long)u->Data()-1);
3343//  return FALSE;
3344//}
3345static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3346{
3347  if (IDTYP((idhdl)u->data)==INT_CMD)
3348  {
3349    int i=IDINT((idhdl)u->data);
3350    if (iiOp==PLUSPLUS) i++;
3351    else                i--;
3352    IDDATA((idhdl)u->data)=(char *)(long)i;
3353    return FALSE;
3354  }
3355  return TRUE;
3356}
3357static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3358{
3359  number n=(number)u->CopyD(BIGINT_CMD);
3360  n=nlNeg(n);
3361  res->data = (char *)n;
3362  return FALSE;
3363}
3364static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3365{
3366  res->data = (char *)(-(long)u->Data());
3367  return FALSE;
3368}
3369static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3370{
3371  number n=(number)u->CopyD(NUMBER_CMD);
3372  n=nNeg(n);
3373  res->data = (char *)n;
3374  return FALSE;
3375}
3376static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3377{
3378  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3379  return FALSE;
3380}
3381static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3382{
3383  poly m1=pISet(-1);
3384  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),m1);
3385  return FALSE;
3386}
3387static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3388{
3389  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3390  (*iv)*=(-1);
3391  res->data = (char *)iv;
3392  return FALSE;
3393}
3394static BOOLEAN jjPROC1(leftv res, leftv u)
3395{
3396  return jjPROC(res,u,NULL);
3397}
3398static BOOLEAN jjBAREISS(leftv res, leftv v)
3399{
3400  //matrix m=(matrix)v->Data();
3401  //lists l=mpBareiss(m,FALSE);
3402  intvec *iv;
3403  ideal m;
3404  smCallBareiss((ideal)v->Data(),0,0,m,&iv);
3405  lists l=(lists)omAllocBin(slists_bin);
3406  l->Init(2);
3407  l->m[0].rtyp=MODUL_CMD;
3408  l->m[1].rtyp=INTVEC_CMD;
3409  l->m[0].data=(void *)m;
3410  l->m[1].data=(void *)iv;
3411  res->data = (char *)l;
3412  return FALSE;
3413}
3414//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3415//{
3416//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3417//  ivTriangMat(m);
3418//  res->data = (char *)m;
3419//  return FALSE;
3420//}
3421static BOOLEAN jjBI2N(leftv res, leftv u)
3422{
3423  if (rField_is_Q())
3424  {
3425    res->data=u->CopyD();
3426    return FALSE;
3427  }
3428  else
3429  {
3430    BOOLEAN bo=FALSE;
3431    number n=(number)u->CopyD();
3432    if (rField_is_Zp())
3433    {
3434      res->data=(void *)npMap0(n);
3435    }
3436    else if (rField_is_Q_a())
3437    {
3438      res->data=(void *)naMap00(n);
3439    }
3440    else if (rField_is_Zp_a())
3441    {
3442      res->data=(void *)naMap0P(n);
3443    }
3444#ifdef HAVE_RINGS
3445    else if (rField_is_Ring_Z())
3446    {
3447      res->data=(void *)nrzMapQ(n);
3448    }
3449    else if (rField_is_Ring_ModN())
3450    {
3451      res->data=(void *)nrnMapQ(n);
3452    }
3453    else if (rField_is_Ring_PtoM())
3454    {
3455      res->data=(void *)nrnMapQ(n);
3456    }
3457    else if (rField_is_Ring_2toM())
3458    {
3459      res->data=(void *)nr2mMapQ(n);
3460    }
3461#endif
3462    else
3463    {
3464      WerrorS("cannot convert bigint to this field");
3465      bo=TRUE;
3466    }
3467    nlDelete(&n,NULL);
3468    return bo;
3469  }
3470}
3471static BOOLEAN jjBI2P(leftv res, leftv u)
3472{
3473  sleftv tmp;
3474  BOOLEAN bo=jjBI2N(&tmp,u);
3475  if (!bo)
3476  {
3477    number n=(number) tmp.data;
3478    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3479    else
3480    {
3481      res->data=(void *)pNSet(n);
3482    }
3483  }
3484  return bo;
3485}
3486static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3487{
3488  return iiExprArithM(res,u,iiOp);
3489}
3490static BOOLEAN jjCHAR(leftv res, leftv v)
3491{
3492  res->data = (char *)(long)rChar((ring)v->Data());
3493  return FALSE;
3494}
3495static BOOLEAN jjCOLS(leftv res, leftv v)
3496{
3497  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3498  return FALSE;
3499}
3500static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3501{
3502  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3503  return FALSE;
3504}
3505static BOOLEAN jjCONTENT(leftv res, leftv v)
3506{
3507  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3508  poly p=(poly)v->CopyD(POLY_CMD);
3509  if (p!=NULL) p_Cleardenom(p, currRing);
3510  res->data = (char *)p;
3511  return FALSE;
3512}
3513static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3514{
3515  res->data = (char *)(long)nlSize((number)v->Data());
3516  return FALSE;
3517}
3518static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3519{
3520  res->data = (char *)(long)nSize((number)v->Data());
3521  return FALSE;
3522}
3523static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3524{
3525  lists l=(lists)v->Data();
3526  res->data = (char *)(long)(l->nr+1);
3527  return FALSE;
3528}
3529static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3530{
3531  matrix m=(matrix)v->Data();
3532  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3533  return FALSE;
3534}
3535static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3536{
3537  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3538  return FALSE;
3539}
3540static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3541{
3542  ring r=(ring)v->Data();
3543  int elems=-1;
3544  if (rField_is_Zp(r)||rField_is_GF(r)) elems=rInternalChar(r);
3545  else if (rField_is_Zp_a(r) && (r->minpoly!=NULL))
3546  {
3547#ifdef HAVE_FACTORY
3548    extern int ipower ( int b, int n ); /* factory/cf_util */
3549    elems=ipower(ABS(rInternalChar(r)),naParDeg(r->minpoly));
3550#else
3551    elems=(int)pow(ABS((double) rInternalChar(r)),(double)naParDeg(r->minpoly));
3552#endif
3553  }
3554  res->data = (char *)(long)elems;
3555  return FALSE;
3556}
3557static BOOLEAN jjDEG(leftv res, leftv v)
3558{
3559  int dummy;
3560  poly p=(poly)v->Data();
3561  if (p!=NULL) res->data = (char *)pLDeg(p,&dummy,currRing);
3562  else res->data=(char *)-1;
3563  return FALSE;
3564}
3565static BOOLEAN jjDEG_M(leftv res, leftv u)
3566{
3567  ideal I=(ideal)u->Data();
3568  int d=-1;
3569  int dummy;
3570  int i;
3571  for(i=IDELEMS(I)-1;i>=0;i--)
3572    if (I->m[i]!=NULL) d=si_max(d,(int)pLDeg(I->m[i],&dummy,currRing));
3573  res->data = (char *)(long)d;
3574  return FALSE;
3575}
3576static BOOLEAN jjDEGREE(leftv res, leftv v)
3577{
3578  assumeStdFlag(v);
3579  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3580  scDegree((ideal)v->Data(),module_w,currQuotient);
3581  return FALSE;
3582}
3583static BOOLEAN jjDEFINED(leftv res, leftv v)
3584{
3585  if ((v->rtyp==IDHDL)
3586  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3587  {
3588    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3589  }
3590  else if (v->rtyp!=0) res->data=(void *)(-1);
3591  return FALSE;
3592}
3593#ifdef HAVE_FACTORY
3594static BOOLEAN jjDET(leftv res, leftv v)
3595{
3596  matrix m=(matrix)v->Data();
3597  poly p;
3598  if (smCheckDet((ideal)m,m->cols(),TRUE))
3599  {
3600    ideal I=idMatrix2Module(mpCopy(m));
3601    p=smCallDet(I);
3602    idDelete(&I);
3603  }
3604  else
3605    p=singclap_det(m);
3606  res ->data = (char *)p;
3607  return FALSE;
3608}
3609static BOOLEAN jjDET_I(leftv res, leftv v)
3610{
3611  intvec * m=(intvec*)v->Data();
3612  int i,j;
3613  i=m->rows();j=m->cols();
3614  if(i==j)
3615    res->data = (char *)(long)singclap_det_i(m);
3616  else
3617  {
3618    Werror("det of %d x %d intmat",i,j);
3619    return TRUE;
3620  }
3621  return FALSE;
3622}
3623static BOOLEAN jjDET_S(leftv res, leftv v)
3624{
3625  ideal I=(ideal)v->Data();
3626  poly p;
3627  if (IDELEMS(I)<1) return TRUE;
3628  if (smCheckDet(I,IDELEMS(I),FALSE))
3629  {
3630    matrix m=idModule2Matrix(idCopy(I));
3631    p=singclap_det(m);
3632    idDelete((ideal *)&m);
3633  }
3634  else
3635    p=smCallDet(I);
3636  res->data = (char *)p;
3637  return FALSE;
3638}
3639#endif
3640static BOOLEAN jjDIM(leftv res, leftv v)
3641{
3642  assumeStdFlag(v);
3643#ifdef HAVE_RINGS
3644  if (rField_is_Ring(currRing))
3645  {
3646    ring origR = currRing;
3647    ring tempR = rCopy(origR);
3648    tempR->ringtype = 0; tempR->ch = 0;
3649    rComplete(tempR);
3650    ideal vid = (ideal)v->Data();
3651    int i = idPosConstant(vid);
3652    if ((i != -1) && (nIsUnit(pGetCoeff(vid->m[i]))))
3653    { /* ideal v contains unit; dim = -1 */
3654      res->data = (char *)-1;
3655      return FALSE;
3656    }
3657    rChangeCurrRing(tempR); rComplete(tempR);
3658    ideal vv = idrCopyR(vid, origR, currRing);
3659    /* drop degree zero generator from vv (if any) */
3660    if (i != -1) pDelete(&vv->m[i]);
3661    long d = (long)scDimInt(vv, currQuotient);   
3662    if (rField_is_Ring_Z(origR) && (i == -1)) d++;
3663    res->data = (char *)d;
3664    idDelete(&vv);
3665    rChangeCurrRing(origR);
3666    rDelete(tempR);
3667    return FALSE;
3668  }
3669#endif
3670  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3671  return FALSE;
3672}
3673static BOOLEAN jjDUMP(leftv res, leftv v)
3674{
3675  si_link l = (si_link)v->Data();
3676  if (slDump(l))
3677  {
3678    const char *s;
3679    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3680    else                            s=sNoName;
3681    Werror("cannot dump to `%s`",s);
3682    return TRUE;
3683  }
3684  else
3685    return FALSE;
3686}
3687static BOOLEAN jjE(leftv res, leftv v)
3688{
3689  res->data = (char *)pOne();
3690  int co=(int)(long)v->Data();
3691  if (co>0)
3692  {
3693    pSetComp((poly)res->data,co);
3694    pSetm((poly)res->data);
3695  }
3696  else WerrorS("argument of gen must be positive");
3697  return (co<=0);
3698}
3699static BOOLEAN jjEXECUTE(leftv res, leftv v)
3700{
3701  char * d = (char *)v->Data();
3702  char * s = (char *)omAlloc(strlen(d) + 13);
3703  strcpy( s, (char *)d);
3704  strcat( s, "\n;RETURN();\n");
3705  newBuffer(s,BT_execute);
3706  return yyparse();
3707}
3708#ifdef HAVE_FACTORY
3709static BOOLEAN jjFACSTD(leftv res, leftv v)
3710{
3711  ideal_list p,h;
3712  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3713  lists L=(lists)omAllocBin(slists_bin);
3714  if (h==NULL)
3715  {
3716    L->Init(1);
3717    L->m[0].data=(char *)idInit(0,1);
3718    L->m[0].rtyp=IDEAL_CMD;
3719  }
3720  else
3721  {
3722    p=h;
3723    int l=0;
3724    while (p!=NULL) { p=p->next;l++; }
3725    L->Init(l);
3726    l=0;
3727    while(h!=NULL)
3728    {
3729      L->m[l].data=(char *)h->d;
3730      L->m[l].rtyp=IDEAL_CMD;
3731      p=h->next;
3732      omFreeSize(h,sizeof(*h));
3733      h=p;
3734      l++;
3735    }
3736  }
3737  res->data=(void *)L;
3738  return FALSE;
3739}
3740static BOOLEAN jjFAC_P(leftv res, leftv u)
3741{
3742  intvec *v=NULL;
3743  singclap_factorize_retry=0;
3744  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0);
3745  if (f==NULL) return TRUE;
3746  ivTest(v);
3747  lists l=(lists)omAllocBin(slists_bin);
3748  l->Init(2);
3749  l->m[0].rtyp=IDEAL_CMD;
3750  l->m[0].data=(void *)f;
3751  l->m[1].rtyp=INTVEC_CMD;
3752  l->m[1].data=(void *)v;
3753  res->data=(void *)l;
3754  return FALSE;
3755}
3756#endif
3757static BOOLEAN jjGETDUMP(leftv res, leftv v)
3758{
3759  si_link l = (si_link)v->Data();
3760  if (slGetDump(l))
3761  {
3762    const char *s;
3763    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3764    else                            s=sNoName;
3765    Werror("cannot get dump from `%s`",s);
3766    return TRUE;
3767  }
3768  else
3769    return FALSE;
3770}
3771static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
3772{
3773  assumeStdFlag(v);
3774  ideal I=(ideal)v->Data();
3775  res->data=(void *)iiHighCorner(I,0);
3776  return FALSE;
3777}
3778static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
3779{
3780  assumeStdFlag(v);
3781  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3782  BOOLEAN delete_w=FALSE;
3783  ideal I=(ideal)v->Data();
3784  int i;
3785  poly p=NULL,po=NULL;
3786  int rk=idRankFreeModule(I);
3787  if (w==NULL)
3788  {
3789    w = new intvec(rk);
3790    delete_w=TRUE;
3791  }
3792  for(i=rk;i>0;i--)
3793  {
3794    p=iiHighCorner(I,i);
3795    if (p==NULL)
3796    {
3797      WerrorS("module must be zero-dimensional");
3798      if (delete_w) delete w;
3799      return TRUE;
3800    }
3801    if (po==NULL)
3802    {
3803      po=p;
3804    }
3805    else
3806    {
3807      // now po!=NULL, p!=NULL
3808      int d=(pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - pFDeg(p,currRing)+(*w)[i-1]);
3809      if (d==0)
3810        d=pLmCmp(po,p);
3811      if (d > 0)
3812      {
3813        pDelete(&p);
3814      }
3815      else // (d < 0)
3816      {
3817        pDelete(&po); po=p;
3818      }
3819    }
3820  }
3821  if (delete_w) delete w;
3822  res->data=(void *)po;
3823  return FALSE;
3824}
3825static BOOLEAN jjHILBERT(leftv res, leftv v)
3826{
3827  assumeStdFlag(v);
3828  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3829  //scHilbertPoly((ideal)v->Data(),currQuotient);
3830  hLookSeries((ideal)v->Data(),module_w,currQuotient);
3831  return FALSE;
3832}
3833static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
3834{
3835  res->data=(void *)hSecondSeries((intvec *)v->Data());
3836  return FALSE;
3837}
3838static BOOLEAN jjHOMOG1(leftv res, leftv v)
3839{
3840  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3841  ideal v_id=(ideal)v->Data();
3842  if (w==NULL)
3843  {
3844    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
3845    if (res->data!=NULL)
3846    {
3847      if (v->rtyp==IDHDL)
3848      {
3849        char *s_isHomog=omStrDup("isHomog");
3850        if (v->e==NULL)
3851          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
3852        else
3853          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
3854      }
3855      else if (w!=NULL) delete w;
3856    } // if res->data==NULL then w==NULL
3857  }
3858  else
3859  {
3860    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
3861    if((res->data==NULL) && (v->rtyp==IDHDL))
3862    {
3863      if (v->e==NULL)
3864        atKill((idhdl)(v->data),"isHomog");
3865      else
3866        atKill((idhdl)(v->LData()),"isHomog");
3867    }
3868  }
3869  return FALSE;
3870}
3871static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
3872{
3873  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
3874  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
3875  if (IDELEMS((ideal)mat)==0)
3876  {
3877    idDelete((ideal *)&mat);
3878    mat=(matrix)idInit(1,1);
3879  }
3880  else
3881  {
3882    MATROWS(mat)=1;
3883    mat->rank=1;
3884    idTest((ideal)mat);
3885  }
3886  res->data=(char *)mat;
3887  return FALSE;
3888}
3889static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
3890{
3891  map m=(map)v->CopyD(MAP_CMD);
3892  omFree((ADDRESS)m->preimage);
3893  m->preimage=NULL;
3894  ideal I=(ideal)m;
3895  I->rank=1;
3896  res->data=(char *)I;
3897  return FALSE;
3898}
3899static BOOLEAN jjIDEAL_R(leftv res, leftv v)
3900{
3901  if (currRing!=NULL)
3902  {
3903    ring q=(ring)v->Data();
3904    if (rSamePolyRep(currRing, q))
3905    {
3906      if (q->qideal==NULL)
3907        res->data=(char *)idInit(1,1);
3908      else
3909        res->data=(char *)idCopy(q->qideal);
3910      return FALSE;
3911    }
3912  }
3913  WerrorS("can only get ideal from identical qring");
3914  return TRUE;
3915}
3916static BOOLEAN jjIm2Iv(leftv res, leftv v)
3917{
3918  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
3919  iv->makeVector();
3920  res->data = iv;
3921  return FALSE;
3922}
3923static BOOLEAN jjIMPART(leftv res, leftv v)
3924{
3925  res->data = (char *)nImPart((number)v->Data());
3926  return FALSE;
3927}
3928static BOOLEAN jjINDEPSET(leftv res, leftv v)
3929{
3930  assumeStdFlag(v);
3931  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
3932  return FALSE;
3933}
3934static BOOLEAN jjINTERRED(leftv res, leftv v)
3935{
3936  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
3937  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
3938  res->data = result;
3939  return FALSE;
3940}
3941static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
3942{
3943  res->data = (char *)(long)pVar((poly)v->Data());
3944  return FALSE;
3945}
3946static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
3947{
3948  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
3949  return FALSE;
3950}
3951static BOOLEAN jjIS_RINGVAR0(leftv res, leftv v)
3952{
3953  res->data = (char *)0;
3954  return FALSE;
3955}
3956static BOOLEAN jjJACOB_P(leftv res, leftv v)
3957{
3958  ideal i=idInit(pVariables,1);
3959  int k;
3960  poly p=(poly)(v->Data());
3961  for (k=pVariables;k>0;k--)
3962  {
3963    i->m[k-1]=pDiff(p,k);
3964  }
3965  res->data = (char *)i;
3966  return FALSE;
3967}
3968/*2
3969 * compute Jacobi matrix of a module/matrix
3970 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(pVariables))  ),
3971 * where Mt := transpose(M)
3972 * Note that this is consistent with the current conventions for jacob in Singular,
3973 * whereas M2 computes its transposed.
3974 */
3975static BOOLEAN jjJACOB_M(leftv res, leftv a)
3976{
3977  ideal id = (ideal)a->Data();
3978  id = idTransp(id);
3979  int W = IDELEMS(id);
3980
3981  ideal result = idInit(W * pVariables, id->rank);
3982  poly *p = result->m;
3983
3984  for( int v = 1; v <= pVariables; v++ )
3985  {
3986    poly* q = id->m;
3987    for( int i = 0; i < W; i++, p++, q++ )
3988      *p = pDiff( *q, v );
3989  }
3990  idDelete(&id);
3991
3992  res->data = (char *)result;
3993  return FALSE;
3994}
3995
3996
3997static BOOLEAN jjKBASE(leftv res, leftv v)
3998{
3999#ifdef HAVE_RINGS
4000  if (rField_is_Ring(currRing))
4001  {
4002    WerrorS("kbase: only defined over ground fields");
4003    return TRUE;
4004  }
4005#endif
4006  assumeStdFlag(v);
4007  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4008  return FALSE;
4009}
4010#ifdef MDEBUG
4011static BOOLEAN jjpHead(leftv res, leftv v)
4012{
4013  res->data=(char *)pHead((poly)v->Data());
4014  return FALSE;
4015}
4016#endif
4017static BOOLEAN jjL2R(leftv res, leftv v)
4018{
4019  res->data=(char *)syConvList((lists)v->Data());
4020  if (res->data != NULL)
4021    return FALSE;
4022  else
4023    return TRUE;
4024}
4025static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4026{
4027  poly p=(poly)v->Data();
4028  if (p==NULL)
4029  {
4030    res->data=(char *)nInit(0);
4031  }
4032  else
4033  {
4034    res->data=(char *)nCopy(pGetCoeff(p));
4035  }
4036  return FALSE;
4037}
4038static BOOLEAN jjLEADEXP(leftv res, leftv v)
4039{
4040  poly p=(poly)v->Data();
4041  int s=pVariables;
4042  if (v->Typ()==VECTOR_CMD) s++;
4043  intvec *iv=new intvec(s);
4044  if (p!=NULL)
4045  {
4046    for(int i = pVariables;i;i--)
4047    {
4048      (*iv)[i-1]=pGetExp(p,i);
4049    }
4050    if (s!=pVariables)
4051      (*iv)[pVariables]=pGetComp(p);
4052  }
4053  res->data=(char *)iv;
4054  return FALSE;
4055}
4056static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4057{
4058  poly p=(poly)v->Data();
4059  if (p == NULL)
4060  {
4061    res->data = (char*) NULL;
4062  }
4063  else
4064  {
4065    poly lm = pLmInit(p);
4066    pSetCoeff(lm, nInit(1));
4067    res->data = (char*) lm;
4068  }
4069  return FALSE;
4070}
4071static BOOLEAN jjLOAD1(leftv res, leftv v)
4072{
4073  return jjLOAD(res, v,FALSE);
4074}
4075static BOOLEAN jjLISTRING(leftv res, leftv v)
4076{
4077  ring r=rCompose((lists)v->Data());
4078  if (r==NULL) return TRUE;
4079  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4080  res->data=(char *)r;
4081  return FALSE;
4082}
4083#if SIZEOF_LONG == 8
4084static number jjLONG2N(long d)
4085{
4086  int i=(int)d;
4087  if ((long)i == d)
4088  {
4089    return nlInit(i, NULL);
4090  }
4091  else
4092  {
4093#if !defined(OM_NDEBUG) && !defined(NDEBUG)
4094    omCheckBin(rnumber_bin);
4095#endif
4096    number z=(number)omAllocBin(rnumber_bin);
4097    #if defined(LDEBUG)
4098    z->debug=123456;
4099    #endif
4100    z->s=3;
4101    mpz_init_set_si(z->z,d);
4102    return z;
4103  }
4104}
4105#else
4106#define jjLONG2N(D) nlInit((int)D, NULL)
4107#endif
4108static BOOLEAN jjPFAC1(leftv res, leftv v)
4109{
4110  /* call method jjPFAC2 with second argument = 0 (meaning that no
4111     valid bound for the prime factors has been given) */
4112  sleftv tmp;
4113  memset(&tmp, 0, sizeof(tmp));
4114  tmp.rtyp = INT_CMD;
4115  return jjPFAC2(res, v, &tmp);
4116}
4117static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4118{
4119  /* computes the LU-decomposition of a matrix M;
4120     i.e., M = P * L * U, where
4121        - P is a row permutation matrix,
4122        - L is in lower triangular form,
4123        - U is in upper row echelon form
4124     Then, we also have P * M = L * U.
4125     A list [P, L, U] is returned. */
4126  matrix mat = (const matrix)v->Data();
4127  int rr = mat->rows();
4128  int cc = mat->cols();
4129  matrix pMat;
4130  matrix lMat;
4131  matrix uMat;
4132
4133  luDecomp(mat, pMat, lMat, uMat);
4134
4135  lists ll = (lists)omAllocBin(slists_bin);
4136  ll->Init(3);
4137  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4138  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4139  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4140  res->data=(char*)ll;
4141
4142  return FALSE;
4143}
4144static BOOLEAN jjMEMORY(leftv res, leftv v)
4145{
4146  omUpdateInfo();
4147  long d;
4148  switch(((int)(long)v->Data()))
4149  {
4150  case 0:
4151    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4152    break;
4153  case 1:
4154    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4155    break;
4156  case 2:
4157    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4158    break;
4159  default:
4160    omPrintStats(stdout);
4161    omPrintInfo(stdout);
4162    omPrintBinStats(stdout);
4163    res->data = (char *)0;
4164    res->rtyp = NONE;
4165  }
4166  return FALSE;
4167  res->data = (char *)0;
4168  return FALSE;
4169}
4170//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4171//{
4172//  return jjMONITOR2(res,v,NULL);
4173//}
4174static BOOLEAN jjMSTD(leftv res, leftv v)
4175{
4176  int t=v->Typ();
4177  ideal r,m;
4178  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4179  lists l=(lists)omAllocBin(slists_bin);
4180  l->Init(2);
4181  l->m[0].rtyp=t;
4182  l->m[0].data=(char *)r;
4183  setFlag(&(l->m[0]),FLAG_STD);
4184  l->m[1].rtyp=t;
4185  l->m[1].data=(char *)m;
4186  res->data=(char *)l;
4187  return FALSE;
4188}
4189static BOOLEAN jjMULT(leftv res, leftv v)
4190{
4191  assumeStdFlag(v);
4192  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4193  return FALSE;
4194}
4195static BOOLEAN jjMINRES_R(leftv res, leftv v)
4196{
4197  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4198
4199  syStrategy tmp=(syStrategy)v->Data();
4200  tmp = syMinimize(tmp); // enrich itself!
4201
4202  res->data=(char *)tmp; 
4203 
4204  if (weights!=NULL)
4205    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4206
4207  return FALSE;
4208}
4209static BOOLEAN jjN2BI(leftv res, leftv v)
4210{
4211  number n,i; i=(number)v->Data();
4212  if (rField_is_Zp())
4213  {
4214    n=nlInit(npInt(i,currRing),NULL);
4215  }
4216  else if (rField_is_Q()) n=nlBigInt(i);
4217#ifdef HAVE_RINGS
4218  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM()) n=nlMapGMP(i);
4219  else if (rField_is_Ring_2toM()) n=nlInit((unsigned long) i,NULL);
4220#endif
4221  else goto err;
4222  res->data=(void *)n;
4223  return FALSE;
4224err:
4225  WerrorS("cannot convert to bigint"); return TRUE;
4226}
4227static BOOLEAN jjNAMEOF(leftv res, leftv v)
4228{
4229  res->data = (char *)v->name;
4230  if (res->data==NULL) res->data=omStrDup("");
4231  v->name=NULL;
4232  return FALSE;
4233}
4234static BOOLEAN jjNAMES(leftv res, leftv v)
4235{
4236  res->data=ipNameList(((ring)v->Data())->idroot);
4237  return FALSE;
4238}
4239static BOOLEAN jjNVARS(leftv res, leftv v)
4240{
4241  res->data = (char *)(long)(((ring)(v->Data()))->N);
4242  return FALSE;
4243}
4244static BOOLEAN jjOpenClose(leftv res, leftv v)
4245{
4246  si_link l=(si_link)v->Data();
4247  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4248  else                return slClose(l);
4249}
4250static BOOLEAN jjORD(leftv res, leftv v)
4251{
4252  poly p=(poly)v->Data();
4253  res->data=(char *)( p==NULL ? -1 : pFDeg(p,currRing) );
4254  return FALSE;
4255}
4256static BOOLEAN jjPAR1(leftv res, leftv v)
4257{
4258  int i=(int)(long)v->Data();
4259  int p=0;
4260  p=rPar(currRing);
4261  if ((0<i) && (i<=p))
4262  {
4263    res->data=(char *)nPar(i);
4264  }
4265  else
4266  {
4267    Werror("par number %d out of range 1..%d",i,p);
4268    return TRUE;
4269  }
4270  return FALSE;
4271}
4272static BOOLEAN jjPARDEG(leftv res, leftv v)
4273{
4274  res->data = (char *)(long)nParDeg((number)v->Data());
4275  return FALSE;
4276}
4277static BOOLEAN jjPARSTR1(leftv res, leftv v)
4278{
4279  if (currRing==NULL)
4280  {
4281    WerrorS("no ring active");
4282    return TRUE;
4283  }
4284  int i=(int)(long)v->Data();
4285  int p=0;
4286  if ((0<i) && (currRing->parameter!=NULL) && (i<=(p=rPar(currRing))))
4287    res->data=omStrDup(currRing->parameter[i-1]);
4288  else
4289  {
4290    Werror("par number %d out of range 1..%d",i,p);
4291    return TRUE;
4292  }
4293  return FALSE;
4294}
4295static BOOLEAN jjP2BI(leftv res, leftv v)
4296{
4297  poly p=(poly)v->Data();
4298  if (p==NULL) { res->data=(char *)nlInit(0,NULL); return FALSE; }
4299  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4300  {
4301    WerrorS("poly must be constant");
4302    return TRUE;
4303  }
4304  number i=pGetCoeff(p);
4305  number n;
4306  if (rField_is_Zp())
4307  {
4308    n=nlInit(npInt(i,currRing), NULL);
4309  }
4310  else if (rField_is_Q()) n=nlBigInt(i);
4311#ifdef HAVE_RINGS
4312  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM())
4313    n=nlMapGMP(i);
4314  else if (rField_is_Ring_2toM())
4315    n=nlInit((unsigned long) i, NULL);
4316#endif
4317  else goto err;
4318  res->data=(void *)n;
4319  return FALSE;
4320err:
4321  WerrorS("cannot convert to bigint"); return TRUE;
4322}
4323static BOOLEAN jjP2I(leftv res, leftv v)
4324{
4325  poly p=(poly)v->Data();
4326  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4327  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4328  {
4329    WerrorS("poly must be constant");
4330    return TRUE;
4331  }
4332  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing);
4333  return FALSE;
4334}
4335static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4336{
4337  map mapping=(map)v->Data();
4338  syMake(res,omStrDup(mapping->preimage));
4339  return FALSE;
4340}
4341static BOOLEAN jjPRIME(leftv res, leftv v)
4342{
4343  int i = IsPrime((int)(long)(v->Data()));
4344  res->data = (char *)(long)(i > 1 ? i : 2);
4345  return FALSE;
4346}
4347static BOOLEAN jjPRUNE(leftv res, leftv v)
4348{
4349  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4350  ideal v_id=(ideal)v->Data();
4351  if (w!=NULL)
4352  {
4353    if (!idTestHomModule(v_id,currQuotient,w))
4354    {
4355      WarnS("wrong weights");
4356      w=NULL;
4357      // and continue at the non-homog case below
4358    }
4359    else
4360    {
4361      w=ivCopy(w);
4362      intvec **ww=&w;
4363      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4364      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4365      return FALSE;
4366    }
4367  }
4368  res->data = (char *)idMinEmbedding(v_id);
4369  return FALSE;
4370}
4371static BOOLEAN jjP2N(leftv res, leftv v)
4372{
4373  number n;
4374  poly p;
4375  if (((p=(poly)v->Data())!=NULL)
4376  && (pIsConstant(p)))
4377  {
4378    n=nCopy(pGetCoeff(p));
4379  }
4380  else
4381  {
4382    n=nInit(0);
4383  }
4384  res->data = (char *)n;
4385  return FALSE;
4386}
4387static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4388{
4389  char *s= (char *)v->Data();
4390  int i = 1;
4391  int l = strlen(s);
4392  for(i=0; i<sArithBase.nCmdUsed; i++)
4393  {
4394    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4395    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4396    {
4397      res->data = (char *)1;
4398      return FALSE;
4399    }
4400  }
4401  //res->data = (char *)0;
4402  return FALSE;
4403}
4404static BOOLEAN jjRANK1(leftv res, leftv v)
4405{
4406  matrix m =(matrix)v->Data();
4407  int rank = luRank(m, 0);
4408  res->data =(char *)(long)rank;
4409  return FALSE;
4410}
4411static BOOLEAN jjREAD(leftv res, leftv v)
4412{
4413  return jjREAD2(res,v,NULL);
4414}
4415static BOOLEAN jjREGULARITY(leftv res, leftv v)
4416{
4417  res->data = (char *)(long)iiRegularity((lists)v->Data());
4418  return FALSE;
4419}
4420static BOOLEAN jjREPART(leftv res, leftv v)
4421{
4422  res->data = (char *)nRePart((number)v->Data());
4423  return FALSE;
4424}
4425static BOOLEAN jjRINGLIST(leftv res, leftv v)
4426{
4427  ring r=(ring)v->Data();
4428  if (r!=NULL)
4429    res->data = (char *)rDecompose((ring)v->Data());
4430  return (r==NULL)||(res->data==NULL);
4431}
4432static BOOLEAN jjROWS(leftv res, leftv v)
4433{
4434  ideal i = (ideal)v->Data();
4435  res->data = (char *)i->rank;
4436  return FALSE;
4437}
4438static BOOLEAN jjROWS_IV(leftv res, leftv v)
4439{
4440  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4441  return FALSE;
4442}
4443static BOOLEAN jjRPAR(leftv res, leftv v)
4444{
4445  res->data = (char *)(long)rPar(((ring)v->Data()));
4446  return FALSE;
4447}
4448static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4449{
4450#ifdef HAVE_PLURAL
4451  const bool bIsSCA = rIsSCA(currRing);
4452#else
4453  const bool bIsSCA = false;
4454#endif
4455
4456  if ((currQuotient!=NULL) && !bIsSCA)
4457  {
4458    WerrorS("qring not supported by slimgb at the moment");
4459    return TRUE;
4460  }
4461  if (rHasLocalOrMixedOrdering_currRing())
4462  {
4463    WerrorS("ordering must be global for slimgb");
4464    return TRUE;
4465  }
4466  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4467  tHomog hom=testHomog;
4468  ideal u_id=(ideal)u->Data();
4469  if (w!=NULL)
4470  {
4471    if (!idTestHomModule(u_id,currQuotient,w))
4472    {
4473      WarnS("wrong weights");
4474      w=NULL;
4475    }
4476    else
4477    {
4478      w=ivCopy(w);
4479      hom=isHomog;
4480    }
4481  }
4482
4483  assume(u_id->rank>=idRankFreeModule(u_id));
4484  res->data=(char *)t_rep_gb(currRing,
4485    u_id,u_id->rank);
4486  //res->data=(char *)t_rep_gb(currRing, u_id);
4487
4488  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4489  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4490  return FALSE;
4491}
4492static BOOLEAN jjSTD(leftv res, leftv v)
4493{
4494  ideal result;
4495  ideal v_id=(ideal)v->Data();
4496  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4497  tHomog hom=testHomog;
4498  if (w!=NULL)
4499  {
4500    if (!idTestHomModule(v_id,currQuotient,w))
4501    {
4502      WarnS("wrong weights");
4503      w=NULL;
4504    }
4505    else
4506    {
4507      hom=isHomog;
4508      w=ivCopy(w);
4509    }
4510  }
4511  result=kStd(v_id,currQuotient,hom,&w);
4512  idSkipZeroes(result);
4513  res->data = (char *)result;
4514  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4515  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4516  return FALSE;
4517}
4518static BOOLEAN jjSort_Id(leftv res, leftv v)
4519{
4520  res->data = (char *)idSort((ideal)v->Data());
4521  return FALSE;
4522}
4523#ifdef HAVE_FACTORY
4524extern int singclap_factorize_retry;
4525static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4526{
4527  intvec *v=NULL;
4528  singclap_factorize_retry=0;
4529  ideal f=singclap_sqrfree((poly)(u->CopyD()));
4530  if (f==NULL)
4531    return TRUE;
4532  res->data=(void *)f;
4533  return FALSE;
4534}
4535#endif
4536#if 1
4537static BOOLEAN jjSYZYGY(leftv res, leftv v)
4538{
4539  intvec *w=NULL;
4540  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4541  if (w!=NULL) delete w;
4542  return FALSE;
4543}
4544#else
4545// activate, if idSyz handle module weights correctly !
4546static BOOLEAN jjSYZYGY(leftv res, leftv v)
4547{
4548  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4549  ideal v_id=(ideal)v->Data();
4550  tHomog hom=testHomog;
4551  int add_row_shift=0;
4552  if (w!=NULL)
4553  {
4554    w=ivCopy(w);
4555    add_row_shift=w->min_in();
4556    (*w)-=add_row_shift;
4557    if (idTestHomModule(v_id,currQuotient,w))
4558      hom=isHomog;
4559    else
4560    {
4561      //WarnS("wrong weights");
4562      delete w; w=NULL;
4563      hom=testHomog;
4564    }
4565  }
4566  res->data = (char *)idSyzygies(v_id,hom,&w);
4567  if (w!=NULL)
4568  {
4569    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4570  }
4571  return FALSE;
4572}
4573#endif
4574static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4575{
4576  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4577  return FALSE;
4578}
4579static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4580{
4581  res->data = (char *)ivTranp((intvec*)(v->Data()));
4582  return FALSE;
4583}
4584#ifdef HAVE_PLURAL
4585static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4586{
4587  ring    r = (ring)a->Data();
4588  //if (rIsPluralRing(r))
4589  if (r->OrdSgn==1)
4590  {
4591    res->data = rOpposite(r);
4592  }
4593  else
4594  {
4595    WarnS("opposite only for global orderings");
4596    res->data = rCopy(r);
4597  }
4598  return FALSE;
4599}
4600static BOOLEAN jjENVELOPE(leftv res, leftv a)
4601{
4602  ring    r = (ring)a->Data();
4603  if (rIsPluralRing(r))
4604  {
4605    //    ideal   i;
4606//     if (a->rtyp == QRING_CMD)
4607//     {
4608//       i = r->qideal;
4609//       r->qideal = NULL;
4610//     }
4611    ring s = rEnvelope(r);
4612//     if (a->rtyp == QRING_CMD)
4613//     {
4614//       ideal is  = idOppose(r,i); /* twostd? */
4615//       is        = idAdd(is,i);
4616//       s->qideal = i;
4617//     }
4618    res->data = s;
4619  }
4620  else  res->data = rCopy(r);
4621  return FALSE;
4622}
4623static BOOLEAN jjTWOSTD(leftv res, leftv a)
4624{
4625  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
4626  else  res->data=(ideal)a->CopyD();
4627  setFlag(res,FLAG_STD);
4628  setFlag(res,FLAG_TWOSTD);
4629  return FALSE;
4630}
4631#endif
4632
4633static BOOLEAN jjTYPEOF(leftv res, leftv v)
4634{
4635  int t=(int)(long)v->data;
4636  switch (t)
4637  {
4638    case INT_CMD:        res->data=omStrDup("int"); break;
4639    case POLY_CMD:       res->data=omStrDup("poly"); break;
4640    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
4641    case STRING_CMD:     res->data=omStrDup("string"); break;
4642    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
4643    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
4644    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
4645    case MODUL_CMD:      res->data=omStrDup("module"); break;
4646    case MAP_CMD:        res->data=omStrDup("map"); break;
4647    case PROC_CMD:       res->data=omStrDup("proc"); break;
4648    case RING_CMD:       res->data=omStrDup("ring"); break;
4649    case QRING_CMD:      res->data=omStrDup("qring"); break;
4650    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
4651    case NUMBER_CMD:     res->data=omStrDup("number"); break;
4652    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
4653    case LIST_CMD:       res->data=omStrDup("list"); break;
4654    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
4655    case LINK_CMD:       res->data=omStrDup("link"); break;
4656    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
4657    case DEF_CMD:
4658    case NONE:           res->data=omStrDup("none"); break;
4659    default:
4660    {
4661      if (t>MAX_TOK)
4662        res->data=omStrDup(getBlackboxName(t));
4663      else
4664        res->data=omStrDup("?unknown type?");
4665      break;
4666    }
4667  }
4668  return FALSE;
4669}
4670static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
4671{
4672  res->data=(char *)pIsUnivariate((poly)v->Data());
4673  return FALSE;
4674}
4675static BOOLEAN jjVAR1(leftv res, leftv v)
4676{
4677  int i=(int)(long)v->Data();
4678  if ((0<i) && (i<=currRing->N))
4679  {
4680    poly p=pOne();
4681    pSetExp(p,i,1);
4682    pSetm(p);
4683    res->data=(char *)p;
4684  }
4685  else
4686  {
4687    Werror("var number %d out of range 1..%d",i,currRing->N);
4688    return TRUE;
4689  }
4690  return FALSE;
4691}
4692static BOOLEAN jjVARSTR1(leftv res, leftv v)
4693{
4694  if (currRing==NULL)
4695  {
4696    WerrorS("no ring active");
4697    return TRUE;
4698  }
4699  int i=(int)(long)v->Data();
4700  if ((0<i) && (i<=currRing->N))
4701    res->data=omStrDup(currRing->names[i-1]);
4702  else
4703  {
4704    Werror("var number %d out of range 1..%d",i,currRing->N);
4705    return TRUE;
4706  }
4707  return FALSE;
4708}
4709static BOOLEAN jjVDIM(leftv res, leftv v)
4710{
4711#ifdef HAVE_RINGS
4712  if (rField_is_Ring(currRing))
4713  {
4714    WerrorS("vdim: only defined over ground fields");
4715    return TRUE;
4716  }
4717#endif
4718  assumeStdFlag(v);
4719  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
4720  return FALSE;
4721}
4722BOOLEAN jjWAIT1ST1(leftv res, leftv u)
4723{
4724// input: u: a list with links of type
4725//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4726// returns: -1:  the read state of all links is eof
4727//          i>0: (at least) u[i] is ready
4728  lists Lforks = (lists)u->Data();
4729  int i = slStatusSsiL(Lforks, -1);
4730  if(i == -2) /* error */
4731  {
4732    return TRUE;
4733  }
4734  res->data = (void*)(long)i;
4735  return FALSE;
4736}
4737BOOLEAN jjWAITALL1(leftv res, leftv u)
4738{
4739// input: u: a list with links of type
4740//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4741// returns: -1: the read state of all links is eof
4742//           1: all links are ready
4743//              (caution: at least one is ready, but some maybe dead)
4744  lists Lforks = (lists)u->CopyD();
4745  int i;
4746  int j = -1;
4747  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
4748  {
4749    i = slStatusSsiL(Lforks, -1);
4750    if(i == -2) /* error */
4751    {
4752      return TRUE;
4753    }
4754    if(i == -1)
4755    {
4756      break;
4757    }
4758    j = 1;
4759    Lforks->m[i-1].CleanUp();
4760    Lforks->m[i-1].rtyp=DEF_CMD;
4761    Lforks->m[i-1].data=NULL;
4762  }
4763  res->data = (void*)(long)j;
4764  Lforks->Clean();
4765  return FALSE;
4766}
4767static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport)
4768{
4769  char * s=(char *)v->CopyD();
4770  char libnamebuf[256];
4771  lib_types LT = type_of_LIB(s, libnamebuf);
4772#ifdef HAVE_DYNAMIC_LOADING
4773  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
4774#endif /* HAVE_DYNAMIC_LOADING */
4775  switch(LT)
4776  {
4777      default:
4778      case LT_NONE:
4779        Werror("%s: unknown type", s);
4780        break;
4781      case LT_NOTFOUND:
4782        Werror("cannot open %s", s);
4783        break;
4784
4785      case LT_SINGULAR:
4786      {
4787        char *plib = iiConvName(s);
4788        idhdl pl = IDROOT->get(plib,0);
4789        if (pl==NULL)
4790        {
4791          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
4792          IDPACKAGE(pl)->language = LANG_SINGULAR;
4793          IDPACKAGE(pl)->libname=omStrDup(plib);
4794        }
4795        else if (IDTYP(pl)!=PACKAGE_CMD)
4796        {
4797          Werror("can not create package `%s`",plib);
4798          omFree(plib);
4799          return TRUE;
4800        }
4801        package savepack=currPack;
4802        currPack=IDPACKAGE(pl);
4803        IDPACKAGE(pl)->loaded=TRUE;
4804        char libnamebuf[256];
4805        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
4806        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
4807        currPack=savepack;
4808        IDPACKAGE(pl)->loaded=(!bo);
4809        return bo;
4810      }
4811      case LT_MACH_O:
4812      case LT_ELF:
4813      case LT_HPUX:
4814#ifdef HAVE_DYNAMIC_LOADING
4815        return load_modules(s, libnamebuf, autoexport);
4816#else /* HAVE_DYNAMIC_LOADING */
4817        WerrorS("Dynamic modules are not supported by this version of Singular");
4818        break;
4819#endif /* HAVE_DYNAMIC_LOADING */
4820  }
4821  return TRUE;
4822}
4823
4824#ifdef INIT_BUG
4825#define XS(A) -((short)A)
4826#define jjstrlen       (proc1)1
4827#define jjpLength      (proc1)2
4828#define jjidElem       (proc1)3
4829#define jjmpDetBareiss (proc1)4
4830#define jjidFreeModule (proc1)5
4831#define jjidVec2Ideal  (proc1)6
4832#define jjrCharStr     (proc1)7
4833#ifndef MDEBUG
4834#define jjpHead        (proc1)8
4835#endif
4836#define jjidHead       (proc1)9
4837#define jjidMaxIdeal   (proc1)10
4838#define jjidMinBase    (proc1)11
4839#define jjsyMinBase    (proc1)12
4840#define jjpMaxComp     (proc1)13
4841#define jjmpTrace      (proc1)14
4842#define jjmpTransp     (proc1)15
4843#define jjrOrdStr      (proc1)16
4844#define jjrVarStr      (proc1)18
4845#define jjrParStr      (proc1)19
4846#define jjCOUNT_RES    (proc1)22
4847#define jjDIM_R        (proc1)23
4848#define jjidTransp     (proc1)24
4849
4850extern struct sValCmd1 dArith1[];
4851void jjInitTab1()
4852{
4853  int i=0;
4854  for (;dArith1[i].cmd!=0;i++)
4855  {
4856    if (dArith1[i].res<0)
4857    {
4858      switch ((int)dArith1[i].p)
4859      {
4860        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
4861        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
4862        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
4863        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
4864#ifndef HAVE_FACTORY
4865        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
4866#endif
4867        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
4868        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
4869#ifndef MDEBUG
4870        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
4871#endif
4872        case (int)jjidHead:       dArith1[i].p=(proc1)idHead; break;
4873        case (int)jjidMaxIdeal:   dArith1[i].p=(proc1)idMaxIdeal; break;
4874        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
4875        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
4876        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
4877        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
4878        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
4879        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
4880        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
4881        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
4882        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
4883        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
4884        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
4885        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
4886      }
4887    }
4888  }
4889}
4890#else
4891#if defined(PROC_BUG)
4892#define XS(A) A
4893static BOOLEAN jjstrlen(leftv res, leftv v)
4894{
4895  res->data = (char *)strlen((char *)v->Data());
4896  return FALSE;
4897}
4898static BOOLEAN jjpLength(leftv res, leftv v)
4899{
4900  res->data = (char *)pLength((poly)v->Data());
4901  return FALSE;
4902}
4903static BOOLEAN jjidElem(leftv res, leftv v)
4904{
4905  res->data = (char *)idElem((ideal)v->Data());
4906  return FALSE;
4907}
4908static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
4909{
4910  res->data = (char *)mpDetBareiss((matrix)v->Data());
4911  return FALSE;
4912}
4913static BOOLEAN jjidFreeModule(leftv res, leftv v)
4914{
4915  res->data = (char *)idFreeModule((int)(long)v->Data());
4916  return FALSE;
4917}
4918static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
4919{
4920  res->data = (char *)idVec2Ideal((poly)v->Data());
4921  return FALSE;
4922}
4923static BOOLEAN jjrCharStr(leftv res, leftv v)
4924{
4925  res->data = rCharStr((ring)v->Data());
4926  return FALSE;
4927}
4928#ifndef MDEBUG
4929static BOOLEAN jjpHead(leftv res, leftv v)
4930{
4931  res->data = (char *)pHead((poly)v->Data());
4932  return FALSE;
4933}
4934#endif
4935static BOOLEAN jjidHead(leftv res, leftv v)
4936{
4937  res->data = (char *)idHead((ideal)v->Data());
4938  return FALSE;
4939}
4940static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4941{
4942  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4943  return FALSE;
4944}
4945static BOOLEAN jjidMinBase(leftv res, leftv v)
4946{
4947  res->data = (char *)idMinBase((ideal)v->Data());
4948  return FALSE;
4949}
4950static BOOLEAN jjsyMinBase(leftv res, leftv v)
4951{
4952  res->data = (char *)syMinBase((ideal)v->Data());
4953  return FALSE;
4954}
4955static BOOLEAN jjpMaxComp(leftv res, leftv v)
4956{
4957  res->data = (char *)pMaxComp((poly)v->Data());
4958  return FALSE;
4959}
4960static BOOLEAN jjmpTrace(leftv res, leftv v)
4961{
4962  res->data = (char *)mpTrace((matrix)v->Data());
4963  return FALSE;
4964}
4965static BOOLEAN jjmpTransp(leftv res, leftv v)
4966{
4967  res->data = (char *)mpTransp((matrix)v->Data());
4968  return FALSE;
4969}
4970static BOOLEAN jjrOrdStr(leftv res, leftv v)
4971{
4972  res->data = rOrdStr((ring)v->Data());
4973  return FALSE;
4974}
4975static BOOLEAN jjrVarStr(leftv res, leftv v)
4976{
4977  res->data = rVarStr((ring)v->Data());
4978  return FALSE;
4979}
4980static BOOLEAN jjrParStr(leftv res, leftv v)
4981{
4982  res->data = rParStr((ring)v->Data());
4983  return FALSE;
4984}
4985static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
4986{
4987  res->data=(char *)sySize((syStrategy)v->Data());
4988  return FALSE;
4989}
4990static BOOLEAN jjDIM_R(leftv res, leftv v)
4991{
4992  res->data = (char *)syDim((syStrategy)v->Data());
4993  return FALSE;
4994}
4995static BOOLEAN jjidTransp(leftv res, leftv v)
4996{
4997  res->data = (char *)idTransp((ideal)v->Data());
4998  return FALSE;
4999}
5000#else
5001#define XS(A)          -((short)A)
5002#define jjstrlen       (proc1)strlen
5003#define jjpLength      (proc1)pLength
5004#define jjidElem       (proc1)idElem
5005#define jjmpDetBareiss (proc1)mpDetBareiss
5006#define jjidFreeModule (proc1)idFreeModule
5007#define jjidVec2Ideal  (proc1)idVec2Ideal
5008#define jjrCharStr     (proc1)rCharStr
5009#ifndef MDEBUG
5010#define jjpHead        (proc1)pHeadProc
5011#endif
5012#define jjidHead       (proc1)idHead
5013#define jjidMaxIdeal   (proc1)idMaxIdeal
5014#define jjidMinBase    (proc1)idMinBase
5015#define jjsyMinBase    (proc1)syMinBase
5016#define jjpMaxComp     (proc1)pMaxCompProc
5017#define jjmpTrace      (proc1)mpTrace
5018#define jjmpTransp     (proc1)mpTransp
5019#define jjrOrdStr      (proc1)rOrdStr
5020#define jjrVarStr      (proc1)rVarStr
5021#define jjrParStr      (proc1)rParStr
5022#define jjCOUNT_RES    (proc1)sySize
5023#define jjDIM_R        (proc1)syDim
5024#define jjidTransp     (proc1)idTransp
5025#endif
5026#endif
5027static BOOLEAN jjnInt(leftv res, leftv u)
5028{
5029  number n=(number)u->Data();
5030  res->data=(char *)(long)n_Int(n,currRing);
5031  return FALSE;
5032}
5033static BOOLEAN jjnlInt(leftv res, leftv u)
5034{
5035  number n=(number)u->Data();
5036  res->data=(char *)(long)nlInt(n,NULL /*dummy for nlInt*/);
5037  return FALSE;
5038}
5039/*=================== operations with 3 args.: static proc =================*/
5040/* must be ordered: first operations for chars (infix ops),
5041 * then alphabetically */
5042static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5043{
5044  char *s= (char *)u->Data();
5045  int   r = (int)(long)v->Data();
5046  int   c = (int)(long)w->Data();
5047  int l = strlen(s);
5048
5049  if ( (r<1) || (r>l) || (c<0) )
5050  {
5051    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5052    return TRUE;
5053  }
5054  res->data = (char *)omAlloc((long)(c+1));
5055  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5056  return FALSE;
5057}
5058static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5059{
5060  intvec *iv = (intvec *)u->Data();
5061  int   r = (int)(long)v->Data();
5062  int   c = (int)(long)w->Data();
5063  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5064  {
5065    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5066           r,c,u->Fullname(),iv->rows(),iv->cols());
5067    return TRUE;
5068  }
5069  res->data=u->data; u->data=NULL;
5070  res->rtyp=u->rtyp; u->rtyp=0;
5071  res->name=u->name; u->name=NULL;
5072  Subexpr e=jjMakeSub(v);
5073          e->next=jjMakeSub(w);
5074  if (u->e==NULL) res->e=e;
5075  else
5076  {
5077    Subexpr h=u->e;
5078    while (h->next!=NULL) h=h->next;
5079    h->next=e;
5080    res->e=u->e;
5081    u->e=NULL;
5082  }
5083  return FALSE;
5084}
5085static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5086{
5087  matrix m= (matrix)u->Data();
5088  int   r = (int)(long)v->Data();
5089  int   c = (int)(long)w->Data();
5090  //Print("gen. elem %d, %d\n",r,c);
5091  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5092  {
5093    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5094      MATROWS(m),MATCOLS(m));
5095    return TRUE;
5096  }
5097  res->data=u->data; u->data=NULL;
5098  res->rtyp=u->rtyp; u->rtyp=0;
5099  res->name=u->name; u->name=NULL;
5100  Subexpr e=jjMakeSub(v);
5101          e->next=jjMakeSub(w);
5102  if (u->e==NULL)
5103    res->e=e;
5104  else
5105  {
5106    Subexpr h=u->e;
5107    while (h->next!=NULL) h=h->next;
5108    h->next=e;
5109    res->e=u->e;
5110    u->e=NULL;
5111  }
5112  return FALSE;
5113}
5114static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5115{
5116  sleftv t;
5117  sleftv ut;
5118  leftv p=NULL;
5119  intvec *iv=(intvec *)w->Data();
5120  int l;
5121  BOOLEAN nok;
5122
5123  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5124  {
5125    WerrorS("cannot build expression lists from unnamed objects");
5126    return TRUE;
5127  }
5128  memcpy(&ut,u,sizeof(ut));
5129  memset(&t,0,sizeof(t));
5130  t.rtyp=INT_CMD;
5131  for (l=0;l< iv->length(); l++)
5132  {
5133    t.data=(char *)(long)((*iv)[l]);
5134    if (p==NULL)
5135    {
5136      p=res;
5137    }
5138    else
5139    {
5140      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5141      p=p->next;
5142    }
5143    memcpy(u,&ut,sizeof(ut));
5144    if (u->Typ() == MATRIX_CMD)
5145      nok=jjBRACK_Ma(p,u,v,&t);
5146    else /* INTMAT_CMD */
5147      nok=jjBRACK_Im(p,u,v,&t);
5148    if (nok)
5149    {
5150      while (res->next!=NULL)
5151      {
5152        p=res->next->next;
5153        omFreeBin((ADDRESS)res->next, sleftv_bin);
5154        // res->e aufraeumen !!!!
5155        res->next=p;
5156      }
5157      return TRUE;
5158    }
5159  }
5160  return FALSE;
5161}
5162static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5163{
5164  sleftv t;
5165  sleftv ut;
5166  leftv p=NULL;
5167  intvec *iv=(intvec *)v->Data();
5168  int l;
5169  BOOLEAN nok;
5170
5171  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5172  {
5173    WerrorS("cannot build expression lists from unnamed objects");
5174    return TRUE;
5175  }
5176  memcpy(&ut,u,sizeof(ut));
5177  memset(&t,0,sizeof(t));
5178  t.rtyp=INT_CMD;
5179  for (l=0;l< iv->length(); l++)
5180  {
5181    t.data=(char *)(long)((*iv)[l]);
5182    if (p==NULL)
5183    {
5184      p=res;
5185    }
5186    else
5187    {
5188      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5189      p=p->next;
5190    }
5191    memcpy(u,&ut,sizeof(ut));
5192    if (u->Typ() == MATRIX_CMD)
5193      nok=jjBRACK_Ma(p,u,&t,w);
5194    else /* INTMAT_CMD */
5195      nok=jjBRACK_Im(p,u,&t,w);
5196    if (nok)
5197    {
5198      while (res->next!=NULL)
5199      {
5200        p=res->next->next;
5201        omFreeBin((ADDRESS)res->next, sleftv_bin);
5202        // res->e aufraeumen !!
5203        res->next=p;
5204      }
5205      return TRUE;
5206    }
5207  }
5208  return FALSE;
5209}
5210static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5211{
5212  sleftv t1,t2,ut;
5213  leftv p=NULL;
5214  intvec *vv=(intvec *)v->Data();
5215  intvec *wv=(intvec *)w->Data();
5216  int vl;
5217  int wl;
5218  BOOLEAN nok;
5219
5220  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5221  {
5222    WerrorS("cannot build expression lists from unnamed objects");
5223    return TRUE;
5224  }
5225  memcpy(&ut,u,sizeof(ut));
5226  memset(&t1,0,sizeof(sleftv));
5227  memset(&t2,0,sizeof(sleftv));
5228  t1.rtyp=INT_CMD;
5229  t2.rtyp=INT_CMD;
5230  for (vl=0;vl< vv->length(); vl++)
5231  {
5232    t1.data=(char *)(long)((*vv)[vl]);
5233    for (wl=0;wl< wv->length(); wl++)
5234    {
5235      t2.data=(char *)(long)((*wv)[wl]);
5236      if (p==NULL)
5237      {
5238        p=res;
5239      }
5240      else
5241      {
5242        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5243        p=p->next;
5244      }
5245      memcpy(u,&ut,sizeof(ut));
5246      if (u->Typ() == MATRIX_CMD)
5247        nok=jjBRACK_Ma(p,u,&t1,&t2);
5248      else /* INTMAT_CMD */
5249        nok=jjBRACK_Im(p,u,&t1,&t2);
5250      if (nok)
5251      {
5252        res->CleanUp();
5253        return TRUE;
5254      }
5255    }
5256  }
5257  return FALSE;
5258}
5259static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5260{
5261  v->next=(leftv)omAllocBin(sleftv_bin);
5262  memcpy(v->next,w,sizeof(sleftv));
5263  memset(w,0,sizeof(sleftv));
5264  return jjPROC(res,u,v);
5265}
5266static BOOLEAN jjCALL3MANY(leftv res, leftv u, leftv v, leftv w)
5267{
5268  u->next=(leftv)omAllocBin(sleftv_bin);
5269  memcpy(u->next,v,sizeof(sleftv));
5270  u->next->next=(leftv)omAllocBin(sleftv_bin);
5271  memcpy(u->next->next,w,sizeof(sleftv));
5272  BOOLEAN r=iiExprArithM(res,u,iiOp);
5273  v->Init();
5274  w->Init();
5275  //w->rtyp=0; w->data=NULL;
5276  // iiExprArithM did the CleanUp
5277  return r;
5278}
5279static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5280{
5281  intvec *iv;
5282  ideal m;
5283  lists l=(lists)omAllocBin(slists_bin);
5284  int k=(int)(long)w->Data();
5285  if (k>=0)
5286  {
5287    smCallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv);
5288    l->Init(2);
5289    l->m[0].rtyp=MODUL_CMD;
5290    l->m[1].rtyp=INTVEC_CMD;
5291    l->m[0].data=(void *)m;
5292    l->m[1].data=(void *)iv;
5293  }
5294  else
5295  {
5296    m=smCallSolv((ideal)u->Data());
5297    l->Init(1);
5298    l->m[0].rtyp=IDEAL_CMD;
5299    l->m[0].data=(void *)m;
5300  }
5301  res->data = (char *)l;
5302  return FALSE;
5303}
5304static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5305{
5306  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5307  {
5308    WerrorS("3rd argument must be a name of a matrix");
5309    return TRUE;
5310  }
5311  ideal i=(ideal)u->Data();
5312  int rank=(int)i->rank;
5313  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5314  if (r) return TRUE;
5315  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5316  return FALSE;
5317}
5318static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5319{
5320  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5321           (ideal)(v->Data()),(poly)(w->Data()));
5322  return FALSE;
5323}
5324static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5325{
5326  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5327  {
5328    WerrorS("3rd argument must be a name of a matrix");
5329    return TRUE;
5330  }
5331  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5332  poly p=(poly)u->CopyD(POLY_CMD);
5333  ideal i=idInit(1,1);
5334  i->m[0]=p;
5335  sleftv t;
5336  memset(&t,0,sizeof(t));
5337  t.data=(char *)i;
5338  t.rtyp=IDEAL_CMD;
5339  int rank=1;
5340  if (u->Typ()==VECTOR_CMD)
5341  {
5342    i->rank=rank=pMaxComp(p);
5343    t.rtyp=MODUL_CMD;
5344  }
5345  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5346  t.CleanUp();
5347  if (r) return TRUE;
5348  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5349  return FALSE;
5350}
5351static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5352{
5353  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5354    (intvec *)w->Data());
5355  //setFlag(res,FLAG_STD);
5356  return FALSE;
5357}
5358static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5359{
5360  /*4
5361  * look for the substring what in the string where
5362  * starting at position n
5363  * return the position of the first char of what in where
5364  * or 0
5365  */
5366  int n=(int)(long)w->Data();
5367  char *where=(char *)u->Data();
5368  char *what=(char *)v->Data();
5369  char *found;
5370  if ((1>n)||(n>(int)strlen(where)))
5371  {
5372    Werror("start position %d out of range",n);
5373    return TRUE;
5374  }
5375  found = strchr(where+n-1,*what);
5376  if (*(what+1)!='\0')
5377  {
5378    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5379    {
5380      found=strchr(found+1,*what);
5381    }
5382  }
5383  if (found != NULL)
5384  {
5385    res->data=(char *)((found-where)+1);
5386  }
5387  return FALSE;
5388}
5389static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5390{
5391  if ((int)(long)w->Data()==0)
5392    res->data=(char *)walkProc(u,v);
5393  else
5394    res->data=(char *)fractalWalkProc(u,v);
5395  setFlag( res, FLAG_STD );
5396  return FALSE;
5397}
5398static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5399{
5400  assumeStdFlag(u);
5401  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5402  intvec *wdegree=(intvec*)w->Data();
5403  if (wdegree->length()!=pVariables)
5404  {
5405    Werror("weight vector must have size %d, not %d",
5406           pVariables,wdegree->length());
5407    return TRUE;
5408  }
5409  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5410  switch((int)(long)v->Data())
5411  {
5412    case 1:
5413      res->data=(void *)iv;
5414      return FALSE;
5415    case 2:
5416      res->data=(void *)hSecondSeries(iv);
5417      delete iv;
5418      return FALSE;
5419  }
5420  WerrorS(feNotImplemented);
5421  delete iv;
5422  return TRUE;
5423}
5424static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5425{
5426  PrintS("TODO\n");
5427  int i=pVar((poly)v->Data());
5428  if (i==0)
5429  {
5430    WerrorS("ringvar expected");
5431    return TRUE;
5432  }
5433  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5434  int d=pWTotaldegree(p);
5435  pLmDelete(p);
5436  if (d==1)
5437    res->data = (char *)idHomogen((ideal)u->Data(),i);
5438  else
5439    WerrorS("variable must have weight 1");
5440  return (d!=1);
5441}
5442static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5443{
5444  PrintS("TODO\n");
5445  int i=pVar((poly)v->Data());
5446  if (i==0)
5447  {
5448    WerrorS("ringvar expected");
5449    return TRUE;
5450  }
5451  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5452  int d=pWTotaldegree(p);
5453  pLmDelete(p);
5454  if (d==1)
5455    res->data = (char *)pHomogen((poly)u->Data(),i);
5456  else
5457    WerrorS("variable must have weight 1");
5458  return (d!=1);
5459}
5460static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5461{
5462  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5463  intvec* arg = (intvec*) u->Data();
5464  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5465
5466  for (i=0; i<n; i++)
5467  {
5468    (*im)[i] = (*arg)[i];
5469  }
5470
5471  res->data = (char *)im;
5472  return FALSE;
5473}
5474static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5475{
5476  short *iw=iv2array((intvec *)w->Data());
5477  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5478  omFreeSize((ADDRESS)iw,(pVariables+1)*sizeof(short));
5479  return FALSE;
5480}
5481static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5482{
5483  if (!pIsUnit((poly)v->Data()))
5484  {
5485    WerrorS("2nd argument must be a unit");
5486    return TRUE;
5487  }
5488  res->data = (char *)pSeries((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD());
5489  return FALSE;
5490}
5491static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5492{
5493  res->data = (char *)idJetW((ideal)u->Data(),(int)(long)v->Data(),
5494                             (intvec *)w->Data());
5495  return FALSE;
5496}
5497static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5498{
5499  if (!mpIsDiagUnit((matrix)v->Data()))
5500  {
5501    WerrorS("2nd argument must be a diagonal matrix of units");
5502    return TRUE;
5503  }
5504  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5505                               (matrix)v->CopyD());
5506  return FALSE;
5507}
5508static BOOLEAN currRingIsOverIntegralDomain ()
5509{
5510  /* true for fields and Z, false otherwise */
5511  if (rField_is_Ring_PtoM()) return FALSE;
5512  if (rField_is_Ring_2toM()) return FALSE;
5513  if (rField_is_Ring_ModN()) return FALSE;
5514  return TRUE;
5515}
5516static BOOLEAN jjMINOR_M(leftv res, leftv v)
5517{
5518  /* Here's the use pattern for the minor command:
5519        minor ( matrix_expression m, int_expression minorSize,
5520                optional ideal_expression IasSB, optional int_expression k,
5521                optional string_expression algorithm,
5522                optional int_expression cachedMinors,
5523                optional int_expression cachedMonomials )
5524     This method here assumes that there are at least two arguments.
5525     - If IasSB is present, it must be a std basis. All minors will be
5526       reduced w.r.t. IasSB.
5527     - If k is absent, all non-zero minors will be computed.
5528       If k is present and k > 0, the first k non-zero minors will be
5529       computed.
5530       If k is present and k < 0, the first |k| minors (some of which
5531       may be zero) will be computed.
5532       If k is present and k = 0, an error is reported.
5533     - If algorithm is absent, all the following arguments must be absent too.
5534       In this case, a heuristic picks the best-suited algorithm (among
5535       Bareiss, Laplace, and Laplace with caching).
5536       If algorithm is present, it must be one of "Bareiss", "bareiss",
5537       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5538       "cache" two more arguments may be given, determining how many entries
5539       the cache may have at most, and how many cached monomials there are at
5540       most. (Cached monomials are counted over all cached polynomials.)
5541       If these two additional arguments are not provided, 200 and 100000
5542       will be used as defaults.
5543  */
5544  matrix m;
5545  leftv u=v->next;
5546  v->next=NULL;
5547  int v_typ=v->Typ();
5548  if (v_typ==MATRIX_CMD)
5549  {
5550     m = (const matrix)v->Data();
5551  }
5552  else
5553  {
5554    if (v_typ==0)
5555    {
5556      Werror("`%s` is undefined",v->Fullname());
5557      return TRUE;
5558    }
5559    // try to convert to MATRIX:
5560    int ii=iiTestConvert(v_typ,MATRIX_CMD);
5561    BOOLEAN bo;
5562    sleftv tmp;
5563    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
5564    else bo=TRUE;
5565    if (bo)
5566    {
5567      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
5568      return TRUE;
5569    }
5570    m=(matrix)tmp.data;
5571  }
5572  const int mk = (const int)(long)u->Data();
5573  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
5574  bool noCacheMinors = true; bool noCacheMonomials = true;
5575  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
5576
5577  /* here come the different cases of correct argument sets */
5578  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
5579  {
5580    IasSB = (ideal)u->next->Data();
5581    noIdeal = false;
5582    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5583    {
5584      k = (int)(long)u->next->next->Data();
5585      noK = false;
5586      assume(k != 0);
5587      if ((u->next->next->next != NULL) &&
5588          (u->next->next->next->Typ() == STRING_CMD))
5589      {
5590        algorithm = (char*)u->next->next->next->Data();
5591        noAlgorithm = false;
5592        if ((u->next->next->next->next != NULL) &&
5593            (u->next->next->next->next->Typ() == INT_CMD))
5594        {
5595          cacheMinors = (int)(long)u->next->next->next->next->Data();
5596          noCacheMinors = false;
5597          if ((u->next->next->next->next->next != NULL) &&
5598              (u->next->next->next->next->next->Typ() == INT_CMD))
5599          {
5600            cacheMonomials =
5601               (int)(long)u->next->next->next->next->next->Data();
5602            noCacheMonomials = false;
5603          }
5604        }
5605      }
5606    }
5607  }
5608  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
5609  {
5610    k = (int)(long)u->next->Data();
5611    noK = false;
5612    assume(k != 0);
5613    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
5614    {
5615      algorithm = (char*)u->next->next->Data();
5616      noAlgorithm = false;
5617      if ((u->next->next->next != NULL) &&
5618          (u->next->next->next->Typ() == INT_CMD))
5619      {
5620        cacheMinors = (int)(long)u->next->next->next->Data();
5621        noCacheMinors = false;
5622        if ((u->next->next->next->next != NULL) &&
5623            (u->next->next->next->next->Typ() == INT_CMD))
5624        {
5625          cacheMonomials = (int)(long)u->next->next->next->next->Data();
5626          noCacheMonomials = false;
5627        }
5628      }
5629    }
5630  }
5631  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
5632  {
5633    algorithm = (char*)u->next->Data();
5634    noAlgorithm = false;
5635    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5636    {
5637      cacheMinors = (int)(long)u->next->next->Data();
5638      noCacheMinors = false;
5639      if ((u->next->next->next != NULL) &&
5640          (u->next->next->next->Typ() == INT_CMD))
5641      {
5642        cacheMonomials = (int)(long)u->next->next->next->Data();
5643        noCacheMonomials = false;
5644      }
5645    }
5646  }
5647
5648  /* upper case conversion for the algorithm if present */
5649  if (!noAlgorithm)
5650  {
5651    if (strcmp(algorithm, "bareiss") == 0)
5652      algorithm = (char*)"Bareiss";
5653    if (strcmp(algorithm, "laplace") == 0)
5654      algorithm = (char*)"Laplace";
5655    if (strcmp(algorithm, "cache") == 0)
5656      algorithm = (char*)"Cache";
5657  }
5658
5659  v->next=u;
5660  /* here come some tests */
5661  if (!noIdeal)
5662  {
5663    assumeStdFlag(u->next);
5664  }
5665  if ((!noK) && (k == 0))
5666  {
5667    WerrorS("Provided number of minors to be computed is zero.");
5668    return TRUE;
5669  }
5670  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
5671      && (strcmp(algorithm, "Laplace") != 0)
5672      && (strcmp(algorithm, "Cache") != 0))
5673  {
5674    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
5675    return TRUE;
5676  }
5677  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
5678      && (!currRingIsOverIntegralDomain()))
5679  {
5680    Werror("Bareiss algorithm not defined over coefficient rings %s",
5681           "with zero divisors.");
5682    return TRUE;
5683  }
5684  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
5685  {
5686    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
5687           m->rows(), m->cols());
5688    return TRUE;
5689  }
5690  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
5691      && (noCacheMinors || noCacheMonomials))
5692  {
5693    cacheMinors = 200;
5694    cacheMonomials = 100000;
5695  }
5696
5697  /* here come the actual procedure calls */
5698  if (noAlgorithm)
5699    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
5700                                       (noIdeal ? 0 : IasSB), false);
5701  else if (strcmp(algorithm, "Cache") == 0)
5702    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
5703                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
5704                                   cacheMonomials, false);
5705  else
5706    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
5707                              (noIdeal ? 0 : IasSB), false);
5708  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
5709  res->rtyp = IDEAL_CMD;
5710  return FALSE;
5711}
5712static BOOLEAN jjNEWSTRUCT3(leftv res, leftv u, leftv v, leftv w)
5713{
5714  // u: the name of the new type
5715  // v: the parent type
5716  // w: the elements
5717  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
5718                                            (const char *)w->Data());
5719  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
5720  return d==NULL;
5721}
5722static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
5723{
5724  // handles preimage(r,phi,i) and kernel(r,phi)
5725  idhdl h;
5726  ring rr;
5727  map mapping;
5728  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
5729
5730  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
5731  {
5732    WerrorS("2nd/3rd arguments must have names");
5733    return TRUE;
5734  }
5735  rr=(ring)u->Data();
5736  const char *ring_name=u->Name();
5737  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
5738  {
5739    if (h->typ==MAP_CMD)
5740    {
5741      mapping=IDMAP(h);
5742      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
5743      if ((preim_ring==NULL)
5744      || (IDRING(preim_ring)!=currRing))
5745      {
5746        Werror("preimage ring `%s` is not the basering",mapping->preimage);
5747        return TRUE;
5748      }
5749    }
5750    else if (h->typ==IDEAL_CMD)
5751    {
5752      mapping=IDMAP(h);
5753    }
5754    else
5755    {
5756      Werror("`%s` is no map nor ideal",IDID(h));
5757      return TRUE;
5758    }
5759  }
5760  else
5761  {
5762    Werror("`%s` is not defined in `%s`",v->name,ring_name);
5763    return TRUE;
5764  }
5765  ideal image;
5766  if (kernel_cmd) image=idInit(1,1);
5767  else
5768  {
5769    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
5770    {
5771      if (h->typ==IDEAL_CMD)
5772      {
5773        image=IDIDEAL(h);
5774      }
5775      else
5776      {
5777        Werror("`%s` is no ideal",IDID(h));
5778        return TRUE;
5779      }
5780    }
5781    else
5782    {
5783      Werror("`%s` is not defined in `%s`",w->name,ring_name);
5784      return TRUE;
5785    }
5786  }
5787  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
5788  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
5789  {
5790    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
5791  }
5792  res->data=(char *)maGetPreimage(rr,mapping,image);
5793  if (kernel_cmd) idDelete(&image);
5794  return (res->data==NULL/* is of type ideal, should not be NULL*/);
5795}
5796static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
5797{
5798  int di, k;
5799  int i=(int)(long)u->Data();
5800  int r=(int)(long)v->Data();
5801  int c=(int)(long)w->Data();
5802  if ((r<=0) || (c<=0)) return TRUE;
5803  intvec *iv = new intvec(r, c, 0);
5804  if (iv->rows()==0)
5805  {
5806    delete iv;
5807    return TRUE;
5808  }
5809  if (i!=0)
5810  {
5811    if (i<0) i = -i;
5812    di = 2 * i + 1;
5813    for (k=0; k<iv->length(); k++)
5814    {
5815      (*iv)[k] = ((siRand() % di) - i);
5816    }
5817  }
5818  res->data = (char *)iv;
5819  return FALSE;
5820}
5821static BOOLEAN jjSUBST_Test(leftv v,leftv w,
5822  int &ringvar, poly &monomexpr)
5823{
5824  monomexpr=(poly)w->Data();
5825  poly p=(poly)v->Data();
5826  #if 0
5827  if (pLength(monomexpr)>1)
5828  {
5829    Werror("`%s` substitutes a ringvar only by a term",
5830      Tok2Cmdname(SUBST_CMD));
5831    return TRUE;
5832  }
5833  #endif
5834  if (!(ringvar=pVar(p)))
5835  {
5836    if (rField_is_Extension(currRing))
5837    {
5838      assume(currRing->algring!=NULL);
5839      lnumber n=(lnumber)pGetCoeff(p);
5840      ringvar=-p_Var(n->z,currRing->algring);
5841    }
5842    if(ringvar==0)
5843    {
5844      WerrorS("ringvar/par expected");
5845      return TRUE;
5846    }
5847  }
5848  return FALSE;
5849}
5850static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
5851{
5852  int ringvar;
5853  poly monomexpr;
5854  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
5855  if (nok) return TRUE;
5856  poly p=(poly)u->Data();
5857  if (ringvar>0)
5858  {
5859    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
5860    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
5861    {
5862      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask);
5863      //return TRUE;
5864    }
5865    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
5866      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
5867    else
5868      res->data= pSubstPoly(p,ringvar,monomexpr);
5869  }
5870  else
5871  {
5872    res->data=pSubstPar(p,-ringvar,monomexpr);
5873  }
5874  return FALSE;
5875}
5876static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
5877{
5878  int ringvar;
5879  poly monomexpr;
5880  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
5881  if (nok) return TRUE;
5882  if (ringvar>0)
5883  {
5884    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
5885      res->data = idSubst((ideal)u->CopyD(res->rtyp),ringvar,monomexpr);
5886    else
5887      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
5888  }
5889  else
5890  {
5891    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
5892  }
5893  return FALSE;
5894}
5895// we do not want to have jjSUBST_Id_X inlined:
5896static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
5897                            int input_type);
5898static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
5899{
5900  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
5901}
5902static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
5903{
5904  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
5905}
5906static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
5907{
5908  sleftv tmp;
5909  memset(&tmp,0,sizeof(tmp));
5910  // do not check the result, conversion from int/number to poly works always
5911  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
5912  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
5913  tmp.CleanUp();
5914  return b;
5915}
5916static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
5917{
5918  matrix m=mpNew((int)(long)v->Data(),(int)(long)w->Data());
5919  ideal I=(ideal)u->CopyD(IDEAL_CMD);
5920  int i=si_min(IDELEMS(I),(int)(long)v->Data()*(int)(long)w->Data());
5921  //for(i=i-1;i>=0;i--)
5922  //{
5923  //  m->m[i]=I->m[i];
5924  //  I->m[i]=NULL;
5925  //}
5926  memcpy4(m->m,I->m,i*sizeof(poly));
5927  memset(I->m,0,i*sizeof(poly));
5928  idDelete(&I);
5929  res->data = (char *)m;
5930  return FALSE;
5931}
5932static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
5933{
5934  res->data = (char *)idModule2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
5935           (int)(long)v->Data(),(int)(long)w->Data());
5936  return FALSE;
5937}
5938static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
5939{
5940  matrix m=mpNew((int)(long)v->Data(),(int)(long)w->Data());
5941  matrix I=(matrix)u->CopyD(MATRIX_CMD);
5942  int r=si_min(MATROWS(I),(int)(long)v->Data());
5943  int c=si_min(MATCOLS(I),(int)(long)w->Data());
5944  int i,j;
5945  for(i=r;i>0;i--)
5946  {
5947    for(j=c;j>0;j--)
5948    {
5949      MATELEM(m,i,j)=MATELEM(I,i,j);
5950      MATELEM(I,i,j)=NULL;
5951    }
5952  }
5953  idDelete((ideal *)&I);
5954  res->data = (char *)m;
5955  return FALSE;
5956}
5957static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
5958{
5959  if (w->rtyp!=IDHDL) return TRUE;
5960  BITSET save_test=test;
5961  int ul= IDELEMS((ideal)u->Data());
5962  int vl= IDELEMS((ideal)v->Data());
5963  ideal m
5964    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
5965             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
5966  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
5967  test=save_test;
5968  return FALSE;
5969}
5970static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
5971{
5972  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
5973  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
5974  idhdl hv=(idhdl)v->data;
5975  idhdl hw=(idhdl)w->data;
5976  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
5977  res->data = (char *)idLiftStd((ideal)u->Data(),
5978                                &(hv->data.umatrix),testHomog,
5979                                &(hw->data.uideal));
5980  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
5981  return FALSE;
5982}
5983static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
5984{
5985  assumeStdFlag(v);
5986  if (!idIsZeroDim((ideal)v->Data()))
5987  {
5988    Werror("`%s` must be 0-dimensional",v->Name());
5989    return TRUE;
5990  }
5991  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
5992    (poly)w->CopyD());
5993  return FALSE;
5994}
5995static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
5996{
5997  assumeStdFlag(v);
5998  if (!idIsZeroDim((ideal)v->Data()))
5999  {
6000    Werror("`%s` must be 0-dimensional",v->Name());
6001    return TRUE;
6002  }
6003  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6004    (matrix)w->CopyD());
6005  return FALSE;
6006}
6007static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6008{
6009  assumeStdFlag(v);
6010  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6011    0,(int)(long)w->Data());
6012  return FALSE;
6013}
6014static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6015{
6016  assumeStdFlag(v);
6017  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6018    0,(int)(long)w->Data());
6019  return FALSE;
6020}
6021#ifdef OLD_RES
6022static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6023{
6024  int maxl=(int)v->Data();
6025  ideal u_id=(ideal)u->Data();
6026  int l=0;
6027  resolvente r;
6028  intvec **weights=NULL;
6029  int wmaxl=maxl;
6030  maxl--;
6031  if ((maxl==-1) && (iiOp!=MRES_CMD))
6032    maxl = pVariables-1;
6033  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6034  {
6035    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6036    if (iv!=NULL)
6037    {
6038      l=1;
6039      if (!idTestHomModule(u_id,currQuotient,iv))
6040      {
6041        WarnS("wrong weights");
6042        iv=NULL;
6043      }
6044      else
6045      {
6046        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6047        weights[0] = ivCopy(iv);
6048      }
6049    }
6050    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6051  }
6052  else
6053    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6054  if (r==NULL) return TRUE;
6055  int t3=u->Typ();
6056  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6057  return FALSE;
6058}
6059#endif
6060static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6061{
6062  res->data=(void *)rInit(u,v,w);
6063  return (res->data==NULL);
6064}
6065static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6066{
6067  int yes;
6068  jjSTATUS2(res, u, v);
6069  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6070  omFree((ADDRESS) res->data);
6071  res->data = (void *)(long)yes;
6072  return FALSE;
6073}
6074static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6075{
6076  intvec *vw=(intvec *)w->Data(); // weights of vars
6077  if (vw->length()!=currRing->N)
6078  {
6079    Werror("%d weights for %d variables",vw->length(),currRing->N);
6080    return TRUE;
6081  }
6082  ideal result;
6083  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6084  tHomog hom=testHomog;
6085  ideal u_id=(ideal)(u->Data());
6086  if (ww!=NULL)
6087  {
6088    if (!idTestHomModule(u_id,currQuotient,ww))
6089    {
6090      WarnS("wrong weights");
6091      ww=NULL;
6092    }
6093    else
6094    {
6095      ww=ivCopy(ww);
6096      hom=isHomog;
6097    }
6098  }
6099  result=kStd(u_id,
6100              currQuotient,
6101              hom,
6102              &ww,                  // module weights
6103              (intvec *)v->Data(),  // hilbert series
6104              0,0,                  // syzComp, newIdeal
6105              vw);                  // weights of vars
6106  idSkipZeroes(result);
6107  res->data = (char *)result;
6108  setFlag(res,FLAG_STD);
6109  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6110  return FALSE;
6111}
6112
6113/*=================== operations with many arg.: static proc =================*/
6114/* must be ordered: first operations for chars (infix ops),
6115 * then alphabetically */
6116static BOOLEAN jjBREAK0(leftv res, leftv v)
6117{
6118#ifdef HAVE_SDB
6119  sdb_show_bp();
6120#endif
6121  return FALSE;
6122}
6123static BOOLEAN jjBREAK1(leftv res, leftv v)
6124{
6125#ifdef HAVE_SDB
6126  if(v->Typ()==PROC_CMD)
6127  {
6128    int lineno=0;
6129    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6130    {
6131      lineno=(int)(long)v->next->Data();
6132    }
6133    return sdb_set_breakpoint(v->Name(),lineno);
6134  }
6135  return TRUE;
6136#else
6137 return FALSE;
6138#endif
6139}
6140static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6141{
6142  return iiExprArith1(res,v,iiOp);
6143}
6144static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6145{
6146  leftv v=u->next;
6147  u->next=NULL;
6148  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6149  u->next=v;
6150  return b;
6151}
6152static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6153{
6154  leftv v = u->next;
6155  leftv w = v->next;
6156  u->next = NULL;
6157  v->next = NULL;
6158  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6159  u->next = v;
6160  v->next = w;
6161  return b;
6162}
6163
6164static BOOLEAN jjCOEF_M(leftv res, leftv v)
6165{
6166  if((v->Typ() != VECTOR_CMD)
6167  || (v->next->Typ() != POLY_CMD)
6168  || (v->next->next->Typ() != MATRIX_CMD)
6169  || (v->next->next->next->Typ() != MATRIX_CMD))
6170     return TRUE;
6171  if (v->next->next->rtyp!=IDHDL) return TRUE;
6172  idhdl c=(idhdl)v->next->next->data;
6173  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6174  idhdl m=(idhdl)v->next->next->next->data;
6175  idDelete((ideal *)&(c->data.uideal));
6176  idDelete((ideal *)&(m->data.uideal));
6177  mpCoef2((poly)v->Data(),(poly)v->next->Data(),
6178    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix));
6179  return FALSE;
6180}
6181
6182static BOOLEAN jjDIVISION4(leftv res, leftv v)
6183{ // may have 3 or 4 arguments
6184  leftv v1=v;
6185  leftv v2=v1->next;
6186  leftv v3=v2->next;
6187  leftv v4=v3->next;
6188  assumeStdFlag(v2);
6189
6190  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6191  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6192
6193  if((i1==0)||(i2==0)
6194  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6195  {
6196    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6197    return TRUE;
6198  }
6199
6200  sleftv w1,w2;
6201  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6202  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6203  ideal P=(ideal)w1.Data();
6204  ideal Q=(ideal)w2.Data();
6205
6206  int n=(int)(long)v3->Data();
6207  short *w=NULL;
6208  if(v4!=NULL)
6209  {
6210    w=iv2array((intvec *)v4->Data());
6211    short *w0=w+1;
6212    int i=pVariables;
6213    while(i>0&&*w0>0)
6214    {
6215      w0++;
6216      i--;
6217    }
6218    if(i>0)
6219      WarnS("not all weights are positive!");
6220  }
6221
6222  matrix T;
6223  ideal R;
6224  idLiftW(P,Q,n,T,R,w);
6225
6226  w1.CleanUp();
6227  w2.CleanUp();
6228  if(w!=NULL)
6229    omFree(w);
6230
6231  lists L=(lists) omAllocBin(slists_bin);
6232  L->Init(2);
6233  L->m[1].rtyp=v1->Typ();
6234  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6235  {
6236    if(v1->Typ()==POLY_CMD)
6237      pShift(&R->m[0],-1);
6238    L->m[1].data=(void *)R->m[0];
6239    R->m[0]=NULL;
6240    idDelete(&R);
6241  }
6242  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6243    L->m[1].data=(void *)idModule2Matrix(R);
6244  else
6245  {
6246    L->m[1].rtyp=MODUL_CMD;
6247    L->m[1].data=(void *)R;
6248  }
6249  L->m[0].rtyp=MATRIX_CMD;
6250  L->m[0].data=(char *)T;
6251
6252  res->data=L;
6253  res->rtyp=LIST_CMD;
6254
6255  return FALSE;
6256}
6257
6258//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6259//{
6260//  int l=u->listLength();
6261//  if (l<2) return TRUE;
6262//  BOOLEAN b;
6263//  leftv v=u->next;
6264//  leftv zz=v;
6265//  leftv z=zz;
6266//  u->next=NULL;
6267//  do
6268//  {
6269//    leftv z=z->next;
6270//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6271//    if (b) break;
6272//  } while (z!=NULL);
6273//  u->next=zz;
6274//  return b;
6275//}
6276static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6277{
6278  int s=1;
6279  leftv h=v;
6280  if (h!=NULL) s=exprlist_length(h);
6281  ideal id=idInit(s,1);
6282  int rank=1;
6283  int i=0;
6284  poly p;
6285  while (h!=NULL)
6286  {
6287    switch(h->Typ())
6288    {
6289      case POLY_CMD:
6290      {
6291        p=(poly)h->CopyD(POLY_CMD);
6292        break;
6293      }
6294      case INT_CMD:
6295      {
6296        number n=nInit((int)(long)h->Data());
6297        if (!nIsZero(n))
6298        {
6299          p=pNSet(n);
6300        }
6301        else
6302        {
6303          p=NULL;
6304          nDelete(&n);
6305        }
6306        break;
6307      }
6308      case BIGINT_CMD:
6309      {
6310        number b=(number)h->Data();
6311        number n=nInit_bigint(b);
6312        if (!nIsZero(n))
6313        {
6314          p=pNSet(n);
6315        }
6316        else
6317        {
6318          p=NULL;
6319          nDelete(&n);
6320        }
6321        break;
6322      }
6323      case NUMBER_CMD:
6324      {
6325        number n=(number)h->CopyD(NUMBER_CMD);
6326        if (!nIsZero(n))
6327        {
6328          p=pNSet(n);
6329        }
6330        else
6331        {
6332          p=NULL;
6333          nDelete(&n);
6334        }
6335        break;
6336      }
6337      case VECTOR_CMD:
6338      {
6339        p=(poly)h->CopyD(VECTOR_CMD);
6340        if (iiOp!=MODUL_CMD)
6341        {
6342          idDelete(&id);
6343          pDelete(&p);
6344          return TRUE;
6345        }
6346        rank=si_max(rank,(int)pMaxComp(p));
6347        break;
6348      }
6349      default:
6350      {
6351        idDelete(&id);
6352        return TRUE;
6353      }
6354    }
6355    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6356    {
6357      pSetCompP(p,1);
6358    }
6359    id->m[i]=p;
6360    i++;
6361    h=h->next;
6362  }
6363  id->rank=rank;
6364  res->data=(char *)id;
6365  return FALSE;
6366}
6367static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6368{
6369  leftv h=v;
6370  int l=v->listLength();
6371  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6372  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6373  int t=0;
6374  // try to convert to IDEAL_CMD
6375  while (h!=NULL)
6376  {
6377    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6378    {
6379      t=IDEAL_CMD;
6380    }
6381    else break;
6382    h=h->next;
6383  }
6384  // if failure, try MODUL_CMD
6385  if (t==0)
6386  {
6387    h=v;
6388    while (h!=NULL)
6389    {
6390      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6391      {
6392        t=MODUL_CMD;
6393      }
6394      else break;
6395      h=h->next;
6396    }
6397  }
6398  // check for success  in converting
6399  if (t==0)
6400  {
6401    WerrorS("cannot convert to ideal or module");
6402    return TRUE;
6403  }
6404  // call idMultSect
6405  h=v;
6406  int i=0;
6407  sleftv tmp;
6408  while (h!=NULL)
6409  {
6410    if (h->Typ()==t)
6411    {
6412      r[i]=(ideal)h->Data(); /*no copy*/
6413      h=h->next;
6414    }
6415    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6416    {
6417      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6418      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6419      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6420      return TRUE;
6421    }
6422    else
6423    {
6424      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6425      copied[i]=TRUE;
6426      h=tmp.next;
6427    }
6428    i++;
6429  }
6430  res->rtyp=t;
6431  res->data=(char *)idMultSect(r,i);
6432  while(i>0)
6433  {
6434    i--;
6435    if (copied[i]) idDelete(&(r[i]));
6436  }
6437  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6438  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6439  return FALSE;
6440}
6441static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6442{
6443  /* computation of the inverse of a quadratic matrix A
6444     using the L-U-decomposition of A;
6445     There are two valid parametrisations:
6446     1) exactly one argument which is just the matrix A,
6447     2) exactly three arguments P, L, U which already
6448        realise the L-U-decomposition of A, that is,
6449        P * A = L * U, and P, L, and U satisfy the
6450        properties decribed in method 'jjLU_DECOMP';
6451        see there;
6452     If A is invertible, the list [1, A^(-1)] is returned,
6453     otherwise the list [0] is returned. Thus, the user may
6454     inspect the first entry of the returned list to see
6455     whether A is invertible. */
6456  matrix iMat; int invertible;
6457  if (v->next == NULL)
6458  {
6459    if (v->Typ() != MATRIX_CMD)
6460    {
6461      Werror("expected either one or three matrices");
6462      return TRUE;
6463    }
6464    else
6465    {
6466      matrix aMat = (matrix)v->Data();
6467      int rr = aMat->rows();
6468      int cc = aMat->cols();
6469      if (rr != cc)
6470      {
6471        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6472        return TRUE;
6473      }
6474      invertible = luInverse(aMat, iMat);
6475    }
6476  }
6477  else if ((v->Typ() == MATRIX_CMD) &&
6478           (v->next->Typ() == MATRIX_CMD) &&
6479           (v->next->next != NULL) &&
6480           (v->next->next->Typ() == MATRIX_CMD) &&
6481           (v->next->next->next == NULL))
6482  {
6483     matrix pMat = (matrix)v->Data();
6484     matrix lMat = (matrix)v->next->Data();
6485     matrix uMat = (matrix)v->next->next->Data();
6486     int rr = uMat->rows();
6487     int cc = uMat->cols();
6488     if (rr != cc)
6489     {
6490       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
6491              rr, cc);
6492       return TRUE;
6493     }
6494     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
6495  }
6496  else
6497  {
6498    Werror("expected either one or three matrices");
6499    return TRUE;
6500  }
6501
6502  /* build the return structure; a list with either one or two entries */
6503  lists ll = (lists)omAllocBin(slists_bin);
6504  if (invertible)
6505  {
6506    ll->Init(2);
6507    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6508    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
6509  }
6510  else
6511  {
6512    ll->Init(1);
6513    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6514  }
6515
6516  res->data=(char*)ll;
6517  return FALSE;
6518}
6519static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
6520{
6521  /* for solving a linear equation system A * x = b, via the
6522     given LU-decomposition of the matrix A;
6523     There is one valid parametrisation:
6524     1) exactly four arguments P, L, U, b;
6525        P, L, and U realise the L-U-decomposition of A, that is,
6526        P * A = L * U, and P, L, and U satisfy the
6527        properties decribed in method 'jjLU_DECOMP';
6528        see there;
6529        b is the right-hand side vector of the equation system;
6530     The method will return a list of either 1 entry or three entries:
6531     1) [0] if there is no solution to the system;
6532     2) [1, x, H] if there is at least one solution;
6533        x is any solution of the given linear system,
6534        H is the matrix with column vectors spanning the homogeneous
6535        solution space.
6536     The method produces an error if matrix and vector sizes do not fit. */
6537  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
6538      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
6539      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
6540      (v->next->next->next == NULL) ||
6541      (v->next->next->next->Typ() != MATRIX_CMD) ||
6542      (v->next->next->next->next != NULL))
6543  {
6544    WerrorS("expected exactly three matrices and one vector as input");
6545    return TRUE;
6546  }
6547  matrix pMat = (matrix)v->Data();
6548  matrix lMat = (matrix)v->next->Data();
6549  matrix uMat = (matrix)v->next->next->Data();
6550  matrix bVec = (matrix)v->next->next->next->Data();
6551  matrix xVec; int solvable; matrix homogSolSpace;
6552  if (pMat->rows() != pMat->cols())
6553  {
6554    Werror("first matrix (%d x %d) is not quadratic",
6555           pMat->rows(), pMat->cols());
6556    return TRUE;
6557  }
6558  if (lMat->rows() != lMat->cols())
6559  {
6560    Werror("second matrix (%d x %d) is not quadratic",
6561           lMat->rows(), lMat->cols());
6562    return TRUE;
6563  }
6564  if (lMat->rows() != uMat->rows())
6565  {
6566    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
6567           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
6568    return TRUE;
6569  }
6570  if (uMat->rows() != bVec->rows())
6571  {
6572    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
6573           uMat->rows(), uMat->cols(), bVec->rows());
6574    return TRUE;
6575  }
6576  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
6577
6578  /* build the return structure; a list with either one or three entries */
6579  lists ll = (lists)omAllocBin(slists_bin);
6580  if (solvable)
6581  {
6582    ll->Init(3);
6583    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
6584    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
6585    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
6586  }
6587  else
6588  {
6589    ll->Init(1);
6590    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
6591  }
6592
6593  res->data=(char*)ll;
6594  return FALSE;
6595}
6596static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
6597{
6598  int i=0;
6599  leftv h=v;
6600  if (h!=NULL) i=exprlist_length(h);
6601  intvec *iv=new intvec(i);
6602  i=0;
6603  while (h!=NULL)
6604  {
6605    if(h->Typ()==INT_CMD)
6606    {
6607      (*iv)[i]=(int)(long)h->Data();
6608    }
6609    else
6610    {
6611      delete iv;
6612      return TRUE;
6613    }
6614    i++;
6615    h=h->next;
6616  }
6617  res->data=(char *)iv;
6618  return FALSE;
6619}
6620static BOOLEAN jjJET4(leftv res, leftv u)
6621{
6622  leftv u1=u;
6623  leftv u2=u1->next;
6624  leftv u3=u2->next;
6625  leftv u4=u3->next;
6626  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
6627  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
6628  {
6629    if(!pIsUnit((poly)u2->Data()))
6630    {
6631      WerrorS("2nd argument must be a unit");
6632      return TRUE;
6633    }
6634    res->rtyp=u1->Typ();
6635    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
6636                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
6637    return FALSE;
6638  }
6639  else
6640  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
6641  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
6642  {
6643    if(!mpIsDiagUnit((matrix)u2->Data()))
6644    {
6645      WerrorS("2nd argument must be a diagonal matrix of units");
6646      return TRUE;
6647    }
6648    res->rtyp=u1->Typ();
6649    res->data=(char*)idSeries((int)(long)u3->Data(),idCopy((ideal)u1->Data()),
6650                              mpCopy((matrix)u2->Data()),(intvec*)u4->Data());
6651    return FALSE;
6652  }
6653  else
6654  {
6655    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
6656           Tok2Cmdname(iiOp));
6657    return TRUE;
6658  }
6659}
6660static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
6661{
6662  if ((yyInRingConstruction)
6663  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
6664  {
6665    memcpy(res,u,sizeof(sleftv));
6666    memset(u,0,sizeof(sleftv));
6667    return FALSE;
6668  }
6669  leftv v=u->next;
6670  BOOLEAN b;
6671  if(v==NULL)
6672    b=iiExprArith1(res,u,iiOp);
6673  else
6674  {
6675    u->next=NULL;
6676    b=iiExprArith2(res,u,iiOp,v);
6677    u->next=v;
6678  }
6679  return b;
6680}
6681static BOOLEAN jjLIST_PL(leftv res, leftv v)
6682{
6683  int sl=0;
6684  if (v!=NULL) sl = v->listLength();
6685  lists L;
6686  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
6687  {
6688    int add_row_shift = 0;
6689    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
6690    if (weights!=NULL)  add_row_shift=weights->min_in();
6691    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
6692  }
6693  else
6694  {
6695    L=(lists)omAllocBin(slists_bin);
6696    leftv h=NULL;
6697    int i;
6698    int rt;
6699
6700    L->Init(sl);
6701    for (i=0;i<sl;i++)
6702    {
6703      if (h!=NULL)
6704      { /* e.g. not in the first step:
6705         * h is the pointer to the old sleftv,
6706         * v is the pointer to the next sleftv
6707         * (in this moment) */
6708         h->next=v;
6709      }
6710      h=v;
6711      v=v->next;
6712      h->next=NULL;
6713      rt=h->Typ();
6714      if (rt==0)
6715      {
6716        L->Clean();
6717        Werror("`%s` is undefined",h->Fullname());
6718        return TRUE;
6719      }
6720      if ((rt==RING_CMD)||(rt==QRING_CMD))
6721      {
6722        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
6723        ((ring)L->m[i].data)->ref++;
6724      }
6725      else
6726        L->m[i].Copy(h);
6727    }
6728  }
6729  res->data=(char *)L;
6730  return FALSE;
6731}
6732static BOOLEAN jjNAMES0(leftv res, leftv v)
6733{
6734  res->data=(void *)ipNameList(IDROOT);
6735  return FALSE;
6736}
6737static BOOLEAN jjOPTION_PL(leftv res, leftv v)
6738{
6739  if(v==NULL)
6740  {
6741    res->data=(char *)showOption();
6742    return FALSE;
6743  }
6744  res->rtyp=NONE;
6745  return setOption(res,v);
6746}
6747static BOOLEAN jjREDUCE4(leftv res, leftv u)
6748{
6749  leftv u1=u;
6750  leftv u2=u1->next;
6751  leftv u3=u2->next;
6752  leftv u4=u3->next;
6753  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
6754  {
6755    int save_d=Kstd1_deg;
6756    Kstd1_deg=(int)(long)u3->Data();
6757    kModW=(intvec *)u4->Data();
6758    BITSET save=verbose;
6759    verbose|=Sy_bit(V_DEG_STOP);
6760    u2->next=NULL;
6761    BOOLEAN r=jjCALL2ARG(res,u);
6762    kModW=NULL;
6763    Kstd1_deg=save_d;
6764    verbose=save;
6765    u->next->next=u3;
6766    return r;
6767  }
6768  else
6769  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6770     (u4->Typ()==INT_CMD))
6771  {
6772    assumeStdFlag(u3);
6773    if(!mpIsDiagUnit((matrix)u2->Data()))
6774    {
6775      WerrorS("2nd argument must be a diagonal matrix of units");
6776      return TRUE;
6777    }
6778    res->rtyp=IDEAL_CMD;
6779    res->data=(char*)redNF(idCopy((ideal)u3->Data()),idCopy((ideal)u1->Data()),
6780                           mpCopy((matrix)u2->Data()),(int)(long)u4->Data());
6781    return FALSE;
6782  }
6783  else
6784  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6785     (u4->Typ()==INT_CMD))
6786  {
6787    assumeStdFlag(u3);
6788    if(!pIsUnit((poly)u2->Data()))
6789    {
6790      WerrorS("2nd argument must be a unit");
6791      return TRUE;
6792    }
6793    res->rtyp=POLY_CMD;
6794    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
6795                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
6796    return FALSE;
6797  }
6798  else
6799  {
6800    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
6801    return TRUE;
6802  }
6803}
6804static BOOLEAN jjREDUCE5(leftv res, leftv u)
6805{
6806  leftv u1=u;
6807  leftv u2=u1->next;
6808  leftv u3=u2->next;
6809  leftv u4=u3->next;
6810  leftv u5=u4->next;
6811  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6812     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
6813  {
6814    assumeStdFlag(u3);
6815    if(!mpIsDiagUnit((matrix)u2->Data()))
6816    {
6817      WerrorS("2nd argument must be a diagonal matrix of units");
6818      return TRUE;
6819    }
6820    res->rtyp=IDEAL_CMD;
6821    res->data=(char*)redNF(idCopy((ideal)u3->Data()),idCopy((ideal)u1->Data()),
6822                           mpCopy((matrix)u2->Data()),
6823                           (int)(long)u4->Data(),(intvec*)u5->Data());
6824    return FALSE;
6825  }
6826  else
6827  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
6828     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
6829  {
6830    assumeStdFlag(u3);
6831    if(!pIsUnit((poly)u2->Data()))
6832    {
6833      WerrorS("2nd argument must be a unit");
6834      return TRUE;
6835    }
6836    res->rtyp=POLY_CMD;
6837    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
6838                           pCopy((poly)u2->Data()),
6839                           (int)(long)u4->Data(),(intvec*)u5->Data());
6840    return FALSE;
6841  }
6842  else
6843  {
6844    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
6845           Tok2Cmdname(iiOp));
6846    return TRUE;
6847  }
6848}
6849static BOOLEAN jjRESERVED0(leftv res, leftv v)
6850{
6851  int i=1;
6852  int nCount = (sArithBase.nCmdUsed-1)/3;
6853  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
6854  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
6855  //      sArithBase.nCmdAllocated);
6856  for(i=0; i<nCount; i++)
6857  {
6858    Print("%-20s",sArithBase.sCmds[i+1].name);
6859    if(i+1+nCount<sArithBase.nCmdUsed)
6860      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
6861    if(i+1+2*nCount<sArithBase.nCmdUsed)
6862      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
6863    //if ((i%3)==1) PrintLn();
6864    PrintLn();
6865  }
6866  PrintLn();
6867  printBlackboxTypes();
6868  return FALSE;
6869}
6870static BOOLEAN jjSTRING_PL(leftv res, leftv v)
6871{
6872  if (v == NULL)
6873  {
6874    res->data = omStrDup("");
6875    return FALSE;
6876  }
6877  int n = v->listLength();
6878  if (n == 1)
6879  {
6880    res->data = v->String();
6881    return FALSE;
6882  }
6883
6884  char** slist = (char**) omAlloc(n*sizeof(char*));
6885  int i, j;
6886
6887  for (i=0, j=0; i<n; i++, v = v ->next)
6888  {
6889    slist[i] = v->String();
6890    assume(slist[i] != NULL);
6891    j+=strlen(slist[i]);
6892  }
6893  char* s = (char*) omAlloc((j+1)*sizeof(char));
6894  *s='\0';
6895  for (i=0;i<n;i++)
6896  {
6897    strcat(s, slist[i]);
6898    omFree(slist[i]);
6899  }
6900  omFreeSize(slist, n*sizeof(char*));
6901  res->data = s;
6902  return FALSE;
6903}
6904static BOOLEAN jjTEST(leftv res, leftv v)
6905{
6906  do
6907  {
6908    if (v->Typ()!=INT_CMD)
6909      return TRUE;
6910    test_cmd((int)(long)v->Data());
6911    v=v->next;
6912  }
6913  while (v!=NULL);
6914  return FALSE;
6915}
6916
6917#if defined(__alpha) && !defined(linux)
6918extern "C"
6919{
6920  void usleep(unsigned long usec);
6921};
6922#endif
6923static BOOLEAN jjFactModD_M(leftv res, leftv v)
6924{
6925  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
6926     see a detailed documentation in /kernel/linearAlgebra.h
6927     
6928     valid argument lists:
6929     - (poly h, int d),
6930     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
6931     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
6932                                                          in list of ring vars,
6933     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
6934                                                optional: all 4 optional args
6935     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
6936      by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
6937      has exactly two distinct monic factors [possibly with exponent > 1].)
6938     result:
6939     - list with the two factors f and g such that
6940       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
6941 
6942  poly h      = NULL;
6943  int  d      =    1;
6944  poly f0     = NULL;
6945  poly g0     = NULL;
6946  int  xIndex =    1;   /* default index if none provided */
6947  int  yIndex =    2;   /* default index if none provided */
6948 
6949  leftv u = v; int factorsGiven = 0;
6950  if ((u == NULL) || (u->Typ() != POLY_CMD))
6951  {
6952    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
6953    return TRUE;
6954  }
6955  else h = (poly)u->Data();
6956  u = u->next;
6957  if ((u == NULL) || (u->Typ() != INT_CMD))
6958  {
6959    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
6960    return TRUE;
6961  }
6962  else d = (int)(long)u->Data();
6963  u = u->next;
6964  if ((u != NULL) && (u->Typ() == POLY_CMD))
6965  {
6966    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
6967    {
6968      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
6969      return TRUE;
6970    }
6971    else
6972    {
6973      f0 = (poly)u->Data();
6974      g0 = (poly)u->next->Data();
6975      factorsGiven = 1;
6976      u = u->next->next;
6977    }
6978  }
6979  if ((u != NULL) && (u->Typ() == INT_CMD))
6980  {
6981    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
6982    {
6983      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
6984      return TRUE;
6985    }
6986    else
6987    {
6988      xIndex = (int)(long)u->Data();
6989      yIndex = (int)(long)u->next->Data();
6990      u = u->next->next;
6991    }
6992  }
6993  if (u != NULL)
6994  {
6995    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
6996    return TRUE;
6997  }
6998 
6999  /* checks for provided arguments */
7000  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7001  {
7002    WerrorS("expected non-constant polynomial argument(s)");
7003    return TRUE;
7004  }
7005  int n = rVar(currRing);
7006  if ((xIndex < 1) || (n < xIndex))
7007  {
7008    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7009    return TRUE;
7010  }
7011  if ((yIndex < 1) || (n < yIndex))
7012  {
7013    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7014    return TRUE;
7015  }
7016  if (xIndex == yIndex)
7017  {
7018    WerrorS("expected distinct indices for variables x and y");
7019    return TRUE;
7020  }
7021 
7022  /* computation of f0 and g0 if missing */
7023  if (factorsGiven == 0)
7024  {
7025#ifdef HAVE_FACTORY
7026    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7027    intvec* v = NULL;
7028    ideal i = singclap_factorize(h0, &v, 0);
7029
7030    ivTest(v);
7031
7032    if (i == NULL) return TRUE;
7033
7034    idTest(i);
7035   
7036    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7037    {
7038      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7039      return TRUE;
7040    }
7041    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7042    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7043    idDelete(&i);
7044#else
7045    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
7046    return TRUE;
7047#endif
7048  }
7049 
7050  poly f; poly g;
7051  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7052  lists L = (lists)omAllocBin(slists_bin);
7053  L->Init(2);
7054  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7055  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7056  res->rtyp = LIST_CMD;
7057  res->data = (char*)L;
7058  return FALSE;
7059}
7060static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7061{
7062  if ((v->Typ() != LINK_CMD) ||
7063      (v->next->Typ() != STRING_CMD) ||
7064      (v->next->next->Typ() != STRING_CMD) ||
7065      (v->next->next->next->Typ() != INT_CMD))
7066    return TRUE;
7067  jjSTATUS3(res, v, v->next, v->next->next);
7068#if defined(HAVE_USLEEP)
7069  if (((long) res->data) == 0L)
7070  {
7071    int i_s = (int)(long) v->next->next->next->Data();
7072    if (i_s > 0)
7073    {
7074      usleep((int)(long) v->next->next->next->Data());
7075      jjSTATUS3(res, v, v->next, v->next->next);
7076    }
7077  }
7078#elif defined(HAVE_SLEEP)
7079  if (((int) res->data) == 0)
7080  {
7081    int i_s = (int) v->next->next->next->Data();
7082    if (i_s > 0)
7083    {
7084      sleep((is - 1)/1000000 + 1);
7085      jjSTATUS3(res, v, v->next, v->next->next);
7086    }
7087  }
7088#endif
7089  return FALSE;
7090}
7091static BOOLEAN jjSUBST_M(leftv res, leftv u)
7092{
7093  leftv v = u->next; // number of args > 0
7094  if (v==NULL) return TRUE;
7095  leftv w = v->next;
7096  if (w==NULL) return TRUE;
7097  leftv rest = w->next;;
7098
7099  u->next = NULL;
7100  v->next = NULL;
7101  w->next = NULL;
7102  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7103  if ((rest!=NULL) && (!b))
7104  {
7105    sleftv tmp_res;
7106    leftv tmp_next=res->next;
7107    res->next=rest;
7108    memset(&tmp_res,0,sizeof(tmp_res));
7109    b = iiExprArithM(&tmp_res,res,iiOp);
7110    memcpy(res,&tmp_res,sizeof(tmp_res));
7111    res->next=tmp_next;
7112  }
7113  u->next = v;
7114  v->next = w;
7115  // rest was w->next, but is already cleaned
7116  return b;
7117}
7118static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7119{
7120  if ((INPUT->Typ() != MATRIX_CMD) ||
7121      (INPUT->next->Typ() != NUMBER_CMD) ||
7122      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7123      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7124  {
7125    WerrorS("expected (matrix, number, number, number) as arguments");
7126    return TRUE;
7127  }
7128  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7129  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7130                                    (number)(v->Data()),
7131                                    (number)(w->Data()),
7132                                    (number)(x->Data()));
7133  return FALSE;
7134}
7135static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7136{ ideal result;
7137  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7138  leftv v = u->next;  /* one additional polynomial or ideal */
7139  leftv h = v->next;  /* Hilbert vector */
7140  leftv w = h->next;  /* weight vector */
7141  assumeStdFlag(u);
7142  ideal i1=(ideal)(u->Data());
7143  ideal i0;
7144  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7145  || (h->Typ()!=INTVEC_CMD)
7146  || (w->Typ()!=INTVEC_CMD))
7147  {
7148    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7149    return TRUE;
7150  }
7151  intvec *vw=(intvec *)w->Data(); // weights of vars
7152  /* merging std_hilb_w and std_1 */
7153  if (vw->length()!=currRing->N)
7154  {
7155    Werror("%d weights for %d variables",vw->length(),currRing->N);
7156    return TRUE;
7157  }
7158  int r=v->Typ();
7159  BOOLEAN cleanup_i0=FALSE;
7160  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7161  {
7162    i0=idInit(1,i1->rank);
7163    i0->m[0]=(poly)v->Data();
7164    BOOLEAN cleanup_i0=TRUE;
7165  }
7166  else if (r==IDEAL_CMD)/* IDEAL */
7167  {
7168    i0=(ideal)v->Data();
7169  }
7170  else
7171  {
7172    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7173    return TRUE;
7174  }
7175  int ii0=idElem(i0);
7176  i1 = idSimpleAdd(i1,i0);
7177  if (cleanup_i0)
7178  {
7179    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7180    idDelete(&i0);
7181  }
7182  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7183  tHomog hom=testHomog;
7184  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7185  if (ww!=NULL)
7186  {
7187    if (!idTestHomModule(i1,currQuotient,ww))
7188    {
7189      WarnS("wrong weights");
7190      ww=NULL;
7191    }
7192    else
7193    {
7194      ww=ivCopy(ww);
7195      hom=isHomog;
7196    }
7197  }
7198  BITSET save_test=test;
7199  test|=Sy_bit(OPT_SB_1);
7200  result=kStd(i1,
7201              currQuotient,
7202              hom,
7203              &ww,                  // module weights
7204              (intvec *)h->Data(),  // hilbert series
7205              0,                    // syzComp, whatever it is...
7206              IDELEMS(i1)-ii0,      // new ideal
7207              vw);                  // weights of vars
7208  test=save_test;
7209  idDelete(&i1);
7210  idSkipZeroes(result);
7211  res->data = (char *)result;
7212  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7213  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7214  return FALSE;
7215}
7216
7217
7218#ifdef MDEBUG
7219static Subexpr jjDBMakeSub(leftv e,const char *f,const int l)
7220#else
7221static Subexpr jjMakeSub(leftv e)
7222#endif
7223{
7224  assume( e->Typ()==INT_CMD );
7225  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7226  r->start =(int)(long)e->Data();
7227  return r;
7228}
7229#define D(A) (A)
7230#define IPARITH
7231#include "table.h"
7232
7233#include <iparith.inc>
7234
7235/*=================== operations with 2 args. ============================*/
7236/* must be ordered: first operations for chars (infix ops),
7237 * then alphabetically */
7238
7239BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7240{
7241  memset(res,0,sizeof(sleftv));
7242  BOOLEAN call_failed=FALSE;
7243
7244  if (!errorreported)
7245  {
7246#ifdef SIQ
7247    if (siq>0)
7248    {
7249      //Print("siq:%d\n",siq);
7250      command d=(command)omAlloc0Bin(sip_command_bin);
7251      memcpy(&d->arg1,a,sizeof(sleftv));
7252      //a->Init();
7253      memcpy(&d->arg2,b,sizeof(sleftv));
7254      //b->Init();
7255      d->argc=2;
7256      d->op=op;
7257      res->data=(char *)d;
7258      res->rtyp=COMMAND;
7259      return FALSE;
7260    }
7261#endif
7262    int at=a->Typ();
7263    if (at>MAX_TOK)
7264    {
7265      blackbox *bb=getBlackboxStuff(at);
7266      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7267      else          return TRUE;
7268    }
7269    int bt=b->Typ();
7270    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7271    int index=i;
7272
7273    iiOp=op;
7274    while (dArith2[i].cmd==op)
7275    {
7276      if ((at==dArith2[i].arg1)
7277      && (bt==dArith2[i].arg2))
7278      {
7279        res->rtyp=dArith2[i].res;
7280        if (currRing!=NULL)
7281        {
7282          #ifdef HAVE_PLURAL
7283          if (rIsPluralRing(currRing))
7284          {
7285            if ((dArith2[i].valid_for & PLURAL_MASK)==0 /*NO_PLURAL*/)
7286            {
7287              WerrorS(ii_not_for_plural);
7288              break;
7289            }
7290            else if ((dArith2[i].valid_for & PLURAL_MASK)==2 /*, COMM_PLURAL */)
7291            {
7292              Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(i));
7293            }
7294            /* else, ALLOW_PLURAL */
7295          }
7296          #endif
7297          #ifdef HAVE_RINGS
7298          if (rField_is_Ring(currRing))
7299          {
7300            if ((dArith2[i].valid_for & RING_MASK)==0 /*NO_RING*/)
7301            {
7302              WerrorS(ii_not_for_ring);
7303              break;
7304            }
7305            /* else ALLOW_RING */
7306          }
7307          #endif
7308        }
7309        if (TEST_V_ALLWARN)
7310          Print("call %s(%s,%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(at),Tok2Cmdname(bt));
7311        if ((call_failed=dArith2[i].p(res,a,b)))
7312        {
7313          break;// leave loop, goto error handling
7314        }
7315        a->CleanUp();
7316        b->CleanUp();
7317        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7318        return FALSE;
7319      }
7320      i++;
7321    }
7322    // implicite type conversion ----------------------------------------------
7323    if (dArith2[i].cmd!=op)
7324    {
7325      int ai,bi;
7326      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7327      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7328      BOOLEAN failed=FALSE;
7329      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7330      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7331      while (dArith2[i].cmd==op)
7332      {
7333        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7334        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7335        {
7336          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7337          {
7338            res->rtyp=dArith2[i].res;
7339            if (currRing!=NULL)
7340            {
7341              #ifdef HAVE_PLURAL
7342              if (rIsPluralRing(currRing))
7343              {
7344                if ((dArith2[i].valid_for & PLURAL_MASK)==0 /*NO_PLURAL*/)
7345                {
7346                  WerrorS(ii_not_for_plural);
7347                  break;
7348                }
7349                else if ((dArith2[i].valid_for &PLURAL_MASK)==2 /*, COMM_PLURAL */)
7350                {
7351                  Warn("assume commutative subalgebra for cmd `%s`",
7352                        Tok2Cmdname(i));
7353                }
7354                /* else, ALLOW_PLURAL */
7355              }
7356              #endif
7357              #ifdef HAVE_RINGS
7358              if (rField_is_Ring(currRing))
7359              {
7360                if ((dArith2[i].valid_for & RING_MASK)==0 /*NO_RING*/)
7361                {
7362                  WerrorS(ii_not_for_ring);
7363                  break;
7364                }
7365                /* else ALLOW_RING */
7366              }
7367              #endif
7368            }
7369            if (TEST_V_ALLWARN)
7370              Print("call %s(%s,%s)\n",Tok2Cmdname(iiOp),
7371              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7372            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7373            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7374            || (call_failed=dArith2[i].p(res,an,bn)));
7375            // everything done, clean up temp. variables
7376            if (failed)
7377            {
7378              // leave loop, goto error handling
7379              break;
7380            }
7381            else
7382            {
7383              // everything ok, clean up and return
7384              an->CleanUp();
7385              bn->CleanUp();
7386              omFreeBin((ADDRESS)an, sleftv_bin);
7387              omFreeBin((ADDRESS)bn, sleftv_bin);
7388              a->CleanUp();
7389              b->CleanUp();
7390              return FALSE;
7391            }
7392          }
7393        }
7394        i++;
7395      }
7396      an->CleanUp();
7397      bn->CleanUp();
7398      omFreeBin((ADDRESS)an, sleftv_bin);
7399      omFreeBin((ADDRESS)bn, sleftv_bin);
7400    }
7401    // error handling ---------------------------------------------------
7402    const char *s=NULL;
7403    if (!errorreported)
7404    {
7405      if ((at==0) && (a->Fullname()!=sNoName))
7406      {
7407        s=a->Fullname();
7408      }
7409      else if ((bt==0) && (b->Fullname()!=sNoName))
7410      {
7411        s=b->Fullname();
7412      }
7413      if (s!=NULL)
7414        Werror("`%s` is not defined",s);
7415      else
7416      {
7417        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7418        s = iiTwoOps(op);
7419        if (proccall)
7420        {
7421          Werror("%s(`%s`,`%s`) failed"
7422                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7423        }
7424        else
7425        {
7426          Werror("`%s` %s `%s` failed"
7427                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7428        }
7429        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7430        {
7431          while (dArith2[i].cmd==op)
7432          {
7433            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7434            && (dArith2[i].res!=0)
7435            && (dArith2[i].p!=jjWRONG2))
7436            {
7437              if (proccall)
7438                Werror("expected %s(`%s`,`%s`)"
7439                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7440              else
7441                Werror("expected `%s` %s `%s`"
7442                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7443            }
7444            i++;
7445          }
7446        }
7447      }
7448    }
7449    res->rtyp = UNKNOWN;
7450  }
7451  a->CleanUp();
7452  b->CleanUp();
7453  return TRUE;
7454}
7455
7456/*==================== operations with 1 arg. ===============================*/
7457/* must be ordered: first operations for chars (infix ops),
7458 * then alphabetically */
7459
7460BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7461{
7462  memset(res,0,sizeof(sleftv));
7463  BOOLEAN call_failed=FALSE;
7464
7465  if (!errorreported)
7466  {
7467#ifdef SIQ
7468    if (siq>0)
7469    {
7470      //Print("siq:%d\n",siq);
7471      command d=(command)omAlloc0Bin(sip_command_bin);
7472      memcpy(&d->arg1,a,sizeof(sleftv));
7473      //a->Init();
7474      d->op=op;
7475      d->argc=1;
7476      res->data=(char *)d;
7477      res->rtyp=COMMAND;
7478      return FALSE;
7479    }
7480#endif
7481    int at=a->Typ();
7482    if (at>MAX_TOK)
7483    {
7484      blackbox *bb=getBlackboxStuff(at);
7485      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7486      else          return TRUE;
7487    }
7488
7489    BOOLEAN failed=FALSE;
7490    iiOp=op;
7491    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7492    int ti = i;
7493    while (dArith1[i].cmd==op)
7494    {
7495      if (at==dArith1[i].arg)
7496      {
7497        int r=res->rtyp=dArith1[i].res;
7498        if (currRing!=NULL)
7499        {
7500          #ifdef HAVE_PLURAL
7501          if ((currRing!=NULL) && (rIsPluralRing(currRing)))
7502          {
7503            if ((dArith1[i].valid_for &PLURAL_MASK)==0 /*NO_PLURAL*/)
7504            {
7505              WerrorS(ii_not_for_plural);
7506              break;
7507            }
7508            else if ((dArith1[i].valid_for &PLURAL_MASK)==2 /*, COMM_PLURAL */)
7509            {
7510              Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(i));
7511            }
7512            /* else, ALLOW_PLURAL */
7513          }
7514          #endif
7515          #ifdef HAVE_RINGS
7516          if (rField_is_Ring(currRing))
7517          {
7518            if ((dArith1[i].valid_for & RING_MASK)==0 /*NO_RING*/)
7519            {
7520              WerrorS(ii_not_for_ring);
7521              break;
7522            }
7523            /* else ALLOW_RING */
7524          }
7525          #endif
7526        }
7527        if (TEST_V_ALLWARN)
7528          Print("call %s(%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(at));
7529        if (r<0)
7530        {
7531          res->rtyp=-r;
7532          #ifdef PROC_BUG
7533          dArith1[i].p(res,a);
7534          #else
7535          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
7536          #endif
7537        }
7538        else if ((call_failed=dArith1[i].p(res,a)))
7539        {
7540          break;// leave loop, goto error handling
7541        }
7542        if (a->Next()!=NULL)
7543        {
7544          res->next=(leftv)omAllocBin(sleftv_bin);
7545          failed=iiExprArith1(res->next,a->next,op);
7546        }
7547        a->CleanUp();
7548        return failed;
7549      }
7550      i++;
7551    }
7552    // implicite type conversion --------------------------------------------
7553    if (dArith1[i].cmd!=op)
7554    {
7555      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7556      i=ti;
7557      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
7558      while (dArith1[i].cmd==op)
7559      {
7560        int ai;
7561        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
7562        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
7563        {
7564          int r=res->rtyp=dArith1[i].res;
7565          #ifdef HAVE_PLURAL
7566          if ((currRing!=NULL) && (rIsPluralRing(currRing)))
7567          {
7568            if ((dArith1[i].valid_for &PLURAL_MASK)==0 /*NO_PLURAL*/)
7569            {
7570              WerrorS(ii_not_for_plural);
7571              break;
7572            }
7573            else if ((dArith1[i].valid_for &PLURAL_MASK)==2 /*, COMM_PLURAL */)
7574            {
7575              Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(i));
7576            }
7577            /* else, ALLOW_PLURAL */
7578          }
7579          #endif
7580          if (r<0)
7581          {
7582            res->rtyp=-r;
7583            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
7584            if (!failed)
7585            {
7586              #ifdef PROC_BUG
7587              dArith1[i].p(res,a);
7588              #else
7589              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
7590              #endif
7591            }
7592          }
7593          else
7594          {
7595            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
7596            || (call_failed=dArith1[i].p(res,an)));
7597          }
7598          // everything done, clean up temp. variables
7599          if (failed)
7600          {
7601            // leave loop, goto error handling
7602            break;
7603          }
7604          else
7605          {
7606            if (TEST_V_ALLWARN)
7607              Print("call %s(%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(an->rtyp));
7608            if (an->Next() != NULL)
7609            {
7610              res->next = (leftv)omAllocBin(sleftv_bin);
7611              failed=iiExprArith1(res->next,an->next,op);
7612            }
7613            // everything ok, clean up and return
7614            an->CleanUp();
7615            omFreeBin((ADDRESS)an, sleftv_bin);
7616            a->CleanUp();
7617            return failed;
7618          }
7619        }
7620        i++;
7621      }
7622      an->CleanUp();
7623      omFreeBin((ADDRESS)an, sleftv_bin);
7624    }
7625    // error handling
7626    if (!errorreported)
7627    {
7628      if ((at==0) && (a->Fullname()!=sNoName))
7629      {
7630        Werror("`%s` is not defined",a->Fullname());
7631      }
7632      else
7633      {
7634        i=ti;
7635        const char *s = iiTwoOps(op);
7636        Werror("%s(`%s`) failed"
7637                ,s,Tok2Cmdname(at));
7638        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7639        {
7640          while (dArith1[i].cmd==op)
7641          {
7642            if ((dArith1[i].res!=0)
7643            && (dArith1[i].p!=jjWRONG))
7644              Werror("expected %s(`%s`)"
7645                ,s,Tok2Cmdname(dArith1[i].arg));
7646            i++;
7647          }
7648        }
7649      }
7650    }
7651    res->rtyp = UNKNOWN;
7652  }
7653  a->CleanUp();
7654  return TRUE;
7655}
7656
7657/*=================== operations with 3 args. ============================*/
7658/* must be ordered: first operations for chars (infix ops),
7659 * then alphabetically */
7660
7661BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
7662{
7663  memset(res,0,sizeof(sleftv));
7664  BOOLEAN call_failed=FALSE;
7665
7666  if (!errorreported)
7667  {
7668#ifdef SIQ
7669    if (siq>0)
7670    {
7671      //Print("siq:%d\n",siq);
7672      command d=(command)omAlloc0Bin(sip_command_bin);
7673      memcpy(&d->arg1,a,sizeof(sleftv));
7674      //a->Init();
7675      memcpy(&d->arg2,b,sizeof(sleftv));
7676      //b->Init();
7677      memcpy(&d->arg3,c,sizeof(sleftv));
7678      //c->Init();
7679      d->op=op;
7680      d->argc=3;
7681      res->data=(char *)d;
7682      res->rtyp=COMMAND;
7683      return FALSE;
7684    }
7685#endif
7686    int at=a->Typ();
7687    if (at>MAX_TOK)
7688    {
7689      blackbox *bb=getBlackboxStuff(at);
7690      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
7691      else          return TRUE;
7692    }
7693    int bt=b->Typ();
7694    int ct=c->Typ();
7695
7696    iiOp=op;
7697    int i=0;
7698    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7699    while (dArith3[i].cmd==op)
7700    {
7701      if ((at==dArith3[i].arg1)
7702      && (bt==dArith3[i].arg2)
7703      && (ct==dArith3[i].arg3))
7704      {
7705        res->rtyp=dArith3[i].res;
7706        if (currRing!=NULL)
7707        {
7708          #ifdef HAVE_PLURAL
7709          if (rIsPluralRing(currRing))
7710          {
7711            if ((dArith3[i].valid_for &PLURAL_MASK)==0 /*NO_PLURAL*/)
7712            {
7713              WerrorS(ii_not_for_plural);
7714              break;
7715            }
7716            else if ((dArith3[i].valid_for &PLURAL_MASK)==2 /*, COMM_PLURAL */)
7717            {
7718              Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(i));
7719            }
7720            /* else, ALLOW_PLURAL */
7721          }
7722          #endif
7723          #ifdef HAVE_RINGS
7724          if (rField_is_Ring(currRing))
7725          {
7726            if ((dArith3[i].valid_for & RING_MASK)==0 /*NO_RING*/)
7727            {
7728              WerrorS(ii_not_for_ring);
7729              break;
7730            }
7731            /* else ALLOW_RING */
7732          }
7733          #endif
7734        }
7735        if (TEST_V_ALLWARN)
7736          Print("call %s(%s,%s,%s)\n",
7737            Tok2Cmdname(iiOp),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
7738        if ((call_failed=dArith3[i].p(res,a,b,c)))
7739        {
7740          break;// leave loop, goto error handling
7741        }
7742        a->CleanUp();
7743        b->CleanUp();
7744        c->CleanUp();
7745        return FALSE;
7746      }
7747      i++;
7748    }
7749    // implicite type conversion ----------------------------------------------
7750    if (dArith3[i].cmd!=op)
7751    {
7752      int ai,bi,ci;
7753      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7754      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7755      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
7756      BOOLEAN failed=FALSE;
7757      i=0;
7758      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7759      while (dArith3[i].cmd==op)
7760      {
7761        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
7762        {
7763          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
7764          {
7765            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
7766            {
7767              res->rtyp=dArith3[i].res;
7768              #ifdef HAVE_PLURAL
7769              if ((currRing!=NULL)
7770              && (rIsPluralRing(currRing)))
7771              {
7772                if ((dArith3[i].valid_for &PLURAL_MASK)==0 /*NO_PLURAL*/)
7773                {
7774                   WerrorS(ii_not_for_plural);
7775                   break;
7776                 }
7777                 else if ((dArith3[i].valid_for &PLURAL_MASK)==2 /*, COMM_PLURAL */)
7778                 {
7779                   Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(i));
7780                 }
7781                 /* else, ALLOW_PLURAL */
7782              }
7783              #endif
7784              if (TEST_V_ALLWARN)
7785                Print("call %s(%s,%s,%s)\n",
7786                  Tok2Cmdname(iiOp),Tok2Cmdname(an->rtyp),
7787                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
7788              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
7789                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
7790                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
7791                || (call_failed=dArith3[i].p(res,an,bn,cn)));
7792              // everything done, clean up temp. variables
7793              if (failed)
7794              {
7795                // leave loop, goto error handling
7796                break;
7797              }
7798              else
7799              {
7800                // everything ok, clean up and return
7801                an->CleanUp();
7802                bn->CleanUp();
7803                cn->CleanUp();
7804                omFreeBin((ADDRESS)an, sleftv_bin);
7805                omFreeBin((ADDRESS)bn, sleftv_bin);
7806                omFreeBin((ADDRESS)cn, sleftv_bin);
7807                a->CleanUp();
7808                b->CleanUp();
7809                c->CleanUp();
7810        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7811                return FALSE;
7812              }
7813            }
7814          }
7815        }
7816        i++;
7817      }
7818      an->CleanUp();
7819      bn->CleanUp();
7820      cn->CleanUp();
7821      omFreeBin((ADDRESS)an, sleftv_bin);
7822      omFreeBin((ADDRESS)bn, sleftv_bin);
7823      omFreeBin((ADDRESS)cn, sleftv_bin);
7824    }
7825    // error handling ---------------------------------------------------
7826    if (!errorreported)
7827    {
7828      const char *s=NULL;
7829      if ((at==0) && (a->Fullname()!=sNoName))
7830      {
7831        s=a->Fullname();
7832      }
7833      else if ((bt==0) && (b->Fullname()!=sNoName))
7834      {
7835        s=b->Fullname();
7836      }
7837      else if ((ct==0) && (c->Fullname()!=sNoName))
7838      {
7839        s=c->Fullname();
7840      }
7841      if (s!=NULL)
7842        Werror("`%s` is not defined",s);
7843      else
7844      {
7845        i=0;
7846        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7847        const char *s = iiTwoOps(op);
7848        Werror("%s(`%s`,`%s`,`%s`) failed"
7849                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
7850        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7851        {
7852          while (dArith3[i].cmd==op)
7853          {
7854            if(((at==dArith3[i].arg1)
7855            ||(bt==dArith3[i].arg2)
7856            ||(ct==dArith3[i].arg3))
7857            && (dArith3[i].res!=0))
7858            {
7859              Werror("expected %s(`%s`,`%s`,`%s`)"
7860                  ,s,Tok2Cmdname(dArith3[i].arg1)
7861                  ,Tok2Cmdname(dArith3[i].arg2)
7862                  ,Tok2Cmdname(dArith3[i].arg3));
7863            }
7864            i++;
7865          }
7866        }
7867      }
7868    }
7869    res->rtyp = UNKNOWN;
7870  }
7871  a->CleanUp();
7872  b->CleanUp();
7873  c->CleanUp();
7874        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7875  return TRUE;
7876}
7877/*==================== operations with many arg. ===============================*/
7878/* must be ordered: first operations for chars (infix ops),
7879 * then alphabetically */
7880
7881BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
7882{
7883  // cnt = 0: all
7884  // cnt = 1: only first one
7885  leftv next;
7886  BOOLEAN failed = TRUE;
7887  if(v==NULL) return failed;
7888  res->rtyp = LIST_CMD;
7889  if(cnt) v->next = NULL;
7890  next = v->next;             // saving next-pointer
7891  failed = jjLIST_PL(res, v);
7892  v->next = next;             // writeback next-pointer
7893  return failed;
7894}
7895
7896BOOLEAN iiExprArithM(leftv res, leftv a, int op)
7897{
7898  memset(res,0,sizeof(sleftv));
7899
7900  if (!errorreported)
7901  {
7902#ifdef SIQ
7903    if (siq>0)
7904    {
7905      //Print("siq:%d\n",siq);
7906      command d=(command)omAlloc0Bin(sip_command_bin);
7907      d->op=op;
7908      res->data=(char *)d;
7909      if (a!=NULL)
7910      {
7911        d->argc=a->listLength();
7912        // else : d->argc=0;
7913        memcpy(&d->arg1,a,sizeof(sleftv));
7914        switch(d->argc)
7915        {
7916          case 3:
7917            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
7918            a->next->next->Init();
7919            /* no break */
7920          case 2:
7921            memcpy(&d->arg2,a->next,sizeof(sleftv));
7922            a->next->Init();
7923            a->next->next=d->arg2.next;
7924            d->arg2.next=NULL;
7925            /* no break */
7926          case 1:
7927            a->Init();
7928            a->next=d->arg1.next;
7929            d->arg1.next=NULL;
7930        }
7931        if (d->argc>3) a->next=NULL;
7932        a->name=NULL;
7933        a->rtyp=0;
7934        a->data=NULL;
7935        a->e=NULL;
7936        a->attribute=NULL;
7937        a->CleanUp();
7938      }
7939      res->rtyp=COMMAND;
7940      return FALSE;
7941    }
7942#endif
7943    if ((a!=NULL) && (a->Typ()>MAX_TOK))
7944    {
7945      blackbox *bb=getBlackboxStuff(a->Typ());
7946      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
7947      else          return TRUE;
7948    }
7949    BOOLEAN failed=FALSE;
7950    int args=0;
7951    if (a!=NULL) args=a->listLength();
7952
7953    iiOp=op;
7954    int i=0;
7955    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
7956    while (dArithM[i].cmd==op)
7957    {
7958      if ((args==dArithM[i].number_of_args)
7959      || (dArithM[i].number_of_args==-1)
7960      || ((dArithM[i].number_of_args==-2)&&(args>0)))
7961      {
7962        res->rtyp=dArithM[i].res;
7963        if (currRing!=NULL)
7964        {
7965          #ifdef HAVE_PLURAL
7966          if (rIsPluralRing(currRing))
7967          {
7968            if ((dArithM[i].valid_for &PLURAL_MASK)==0 /*NO_PLURAL*/)
7969            {
7970              WerrorS(ii_not_for_plural);
7971              break;
7972            }
7973            else if ((dArithM[i].valid_for &PLURAL_MASK)==2 /*, COMM_PLURAL */)
7974            {
7975              Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(i));
7976            }
7977            /* else ALLOW_PLURAL */
7978          }
7979          #endif
7980          #ifdef HAVE_RINGS
7981          if (rField_is_Ring(currRing))
7982          {
7983            if ((dArithM[i].valid_for & RING_MASK)==0 /*NO_RING*/)
7984            {
7985              WerrorS(ii_not_for_ring);
7986              break;
7987            }
7988            /* else ALLOW_RING */
7989          }
7990          #endif
7991        }
7992        if (TEST_V_ALLWARN)
7993          Print("call %s(... (%d args))\n", Tok2Cmdname(iiOp),args);
7994        if (dArithM[i].p(res,a))
7995        {
7996          break;// leave loop, goto error handling
7997        }
7998        if (a!=NULL) a->CleanUp();
7999        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8000        return failed;
8001      }
8002      i++;
8003    }
8004    // error handling
8005    if (!errorreported)
8006    {
8007      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8008      {
8009        Werror("`%s` is not defined",a->Fullname());
8010      }
8011      else
8012      {
8013        const char *s = iiTwoOps(op);
8014        Werror("%s(...) failed",s);
8015      }
8016    }
8017    res->rtyp = UNKNOWN;
8018  }
8019  if (a!=NULL) a->CleanUp();
8020        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8021  return TRUE;
8022}
8023
8024/*=================== general utilities ============================*/
8025int IsCmd(const char *n, int & tok)
8026{
8027  int i;
8028  int an=1;
8029  int en=sArithBase.nLastIdentifier;
8030
8031  loop
8032  //for(an=0; an<sArithBase.nCmdUsed; )
8033  {
8034    if(an>=en-1)
8035    {
8036      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8037      {
8038        i=an;
8039        break;
8040      }
8041      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8042      {
8043        i=en;
8044        break;
8045      }
8046      else
8047      {
8048        // -- blackbox extensions:
8049        // return 0;
8050        return blackboxIsCmd(n,tok);
8051      }
8052    }
8053    i=(an+en)/2;
8054    if (*n < *(sArithBase.sCmds[i].name))
8055    {
8056      en=i-1;
8057    }
8058    else if (*n > *(sArithBase.sCmds[i].name))
8059    {
8060      an=i+1;
8061    }
8062    else
8063    {
8064      int v=strcmp(n,sArithBase.sCmds[i].name);
8065      if(v<0)
8066      {
8067        en=i-1;
8068      }
8069      else if(v>0)
8070      {
8071        an=i+1;
8072      }
8073      else /*v==0*/
8074      {
8075        break;
8076      }
8077    }
8078  }
8079  lastreserved=sArithBase.sCmds[i].name;
8080  tok=sArithBase.sCmds[i].tokval;
8081  if(sArithBase.sCmds[i].alias==2)
8082  {
8083    Warn("outdated identifier `%s` used - please change your code",
8084    sArithBase.sCmds[i].name);
8085    sArithBase.sCmds[i].alias=1;
8086  }
8087  if (currRingHdl==NULL)
8088  {
8089    #ifdef SIQ
8090    if (siq<=0)
8091    {
8092    #endif
8093      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8094      {
8095        WerrorS("no ring active");
8096        return 0;
8097      }
8098    #ifdef SIQ
8099    }
8100    #endif
8101  }
8102  if (!expected_parms)
8103  {
8104    switch (tok)
8105    {
8106      case IDEAL_CMD:
8107      case INT_CMD:
8108      case INTVEC_CMD:
8109      case MAP_CMD:
8110      case MATRIX_CMD:
8111      case MODUL_CMD:
8112      case POLY_CMD:
8113      case PROC_CMD:
8114      case RING_CMD:
8115      case STRING_CMD:
8116        cmdtok = tok;
8117        break;
8118    }
8119  }
8120  return sArithBase.sCmds[i].toktype;
8121}
8122static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8123{
8124  int a=0;
8125  int e=len;
8126  int p=len/2;
8127  do
8128  {
8129     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8130     if (op<dArithTab[p].cmd) e=p-1;
8131     else   a = p+1;
8132     p=a+(e-a)/2;
8133  }
8134  while ( a <= e);
8135
8136  assume(0);
8137  return 0;
8138}
8139
8140const char * Tok2Cmdname(int tok)
8141{
8142  int i = 0;
8143  if (tok <= 0)
8144  {
8145    return sArithBase.sCmds[0].name;
8146  }
8147  if (tok==ANY_TYPE) return "any_type";
8148  if (tok==COMMAND) return "command";
8149  if (tok==NONE) return "nothing";
8150  //if (tok==IFBREAK) return "if_break";
8151  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8152  //if (tok==ORDER_VECTOR) return "ordering";
8153  //if (tok==REF_VAR) return "ref";
8154  //if (tok==OBJECT) return "object";
8155  //if (tok==PRINT_EXPR) return "print_expr";
8156  if (tok==IDHDL) return "identifier";
8157  if (tok>MAX_TOK) return getBlackboxName(tok);
8158  for(i=0; i<sArithBase.nCmdUsed; i++)
8159    //while (sArithBase.sCmds[i].tokval!=0)
8160  {
8161    if ((sArithBase.sCmds[i].tokval == tok)&&
8162        (sArithBase.sCmds[i].alias==0))
8163    {
8164      return sArithBase.sCmds[i].name;
8165    }
8166  }
8167  return sArithBase.sCmds[0].name;
8168}
8169
8170
8171/*---------------------------------------------------------------------*/
8172/**
8173 * @brief compares to entry of cmdsname-list
8174
8175 @param[in] a
8176 @param[in] b
8177
8178 @return <ReturnValue>
8179**/
8180/*---------------------------------------------------------------------*/
8181static int _gentable_sort_cmds( const void *a, const void *b )
8182{
8183  cmdnames *pCmdL = (cmdnames*)a;
8184  cmdnames *pCmdR = (cmdnames*)b;
8185
8186  if(a==NULL || b==NULL)             return 0;
8187
8188  /* empty entries goes to the end of the list for later reuse */
8189  if(pCmdL->name==NULL) return 1;
8190  if(pCmdR->name==NULL) return -1;
8191
8192  /* $INVALID$ must come first */
8193  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8194  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8195
8196  /* tokval=-1 are reserved names at the end */
8197  if (pCmdL->tokval==-1)
8198  {
8199    if (pCmdR->tokval==-1)
8200       return strcmp(pCmdL->name, pCmdR->name);
8201    /* pCmdL->tokval==-1, pCmdL goes at the end */
8202    return 1;
8203  }
8204  /* pCmdR->tokval==-1, pCmdR goes at the end */
8205  if(pCmdR->tokval==-1) return -1;
8206
8207  return strcmp(pCmdL->name, pCmdR->name);
8208}
8209
8210/*---------------------------------------------------------------------*/
8211/**
8212 * @brief initialisation of arithmetic structured data
8213
8214 @retval 0 on success
8215
8216**/
8217/*---------------------------------------------------------------------*/
8218int iiInitArithmetic()
8219{
8220  int i;
8221  //printf("iiInitArithmetic()\n");
8222  memset(&sArithBase, 0, sizeof(sArithBase));
8223  iiInitCmdName();
8224  /* fix last-identifier */
8225#if 0
8226  /* we expect that gentable allready did every thing */
8227  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8228      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8229    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8230  }
8231#endif
8232  //Print("L=%d\n", sArithBase.nLastIdentifier);
8233
8234  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8235  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8236
8237  //iiArithAddCmd("Top", 0,-1,0);
8238
8239
8240  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8241  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8242  //         sArithBase.sCmds[i].name,
8243  //         sArithBase.sCmds[i].alias,
8244  //         sArithBase.sCmds[i].tokval,
8245  //         sArithBase.sCmds[i].toktype);
8246  //}
8247  //iiArithRemoveCmd("Top");
8248  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8249  //iiArithRemoveCmd("mygcd");
8250  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8251  return 0;
8252}
8253
8254/*---------------------------------------------------------------------*/
8255/**
8256 * @brief append newitem of size sizeofitem to the list named list.
8257
8258 @param[in,out] list
8259 @param[in,out] item_count
8260 @param[in] sizeofitem
8261 @param[in] newitem
8262
8263 @retval  0 success
8264 @retval -1 failure
8265**/
8266/*---------------------------------------------------------------------*/
8267int iiArithAddItem2list(
8268  void **list,
8269  long  *item_count,
8270  long sizeofitem,
8271  void *newitem
8272  )
8273{
8274  int count = *item_count;
8275
8276  //TRACE(0, "add_item_to_list(%p, %p, %ld, %p)\n", list, item_count,
8277  //       sizeofitem, newitem);
8278
8279  if(count==0)
8280  {
8281    *list = (void *)omAlloc(sizeofitem);
8282  }
8283  else
8284  {
8285    *list = (void *)omRealloc(*list, (count+1) * sizeofitem);
8286  }
8287  if((*list)==NULL) return -1;
8288
8289  //memset((*list)+count*sizeofitem, 0, sizeofitem);
8290  //memcpy((*list)+count*sizeofitem, newitem, sizeofitem);
8291
8292  /* erhoehe counter um 1 */
8293  (count)++;
8294  *item_count = count;
8295  return 0;
8296}
8297
8298int iiArithFindCmd(const char *szName)
8299{
8300  int an=0;
8301  int i = 0,v = 0;
8302  int en=sArithBase.nLastIdentifier;
8303
8304  loop
8305  //for(an=0; an<sArithBase.nCmdUsed; )
8306  {
8307    if(an>=en-1)
8308    {
8309      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8310      {
8311        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8312        return an;
8313      }
8314      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8315      {
8316        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8317        return en;
8318      }
8319      else
8320      {
8321        //Print("RET- 1\n");
8322        return -1;
8323      }
8324    }
8325    i=(an+en)/2;
8326    if (*szName < *(sArithBase.sCmds[i].name))
8327    {
8328      en=i-1;
8329    }
8330    else if (*szName > *(sArithBase.sCmds[i].name))
8331    {
8332      an=i+1;
8333    }
8334    else
8335    {
8336      v=strcmp(szName,sArithBase.sCmds[i].name);
8337      if(v<0)
8338      {
8339        en=i-1;
8340      }
8341      else if(v>0)
8342      {
8343        an=i+1;
8344      }
8345      else /*v==0*/
8346      {
8347        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8348        return i;
8349      }
8350    }
8351  }
8352  //if(i>=0 && i<sArithBase.nCmdUsed)
8353  //  return i;
8354  //Print("RET-2\n");
8355  return -2;
8356}
8357
8358char *iiArithGetCmd( int nPos )
8359{
8360  if(nPos<0) return NULL;
8361  if(nPos<sArithBase.nCmdUsed)
8362    return sArithBase.sCmds[nPos].name;
8363  return NULL;
8364}
8365
8366int iiArithRemoveCmd(const char *szName)
8367{
8368  int nIndex;
8369  if(szName==NULL) return -1;
8370
8371  nIndex = iiArithFindCmd(szName);
8372  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8373  {
8374    Print("'%s' not found (%d)\n", szName, nIndex);
8375    return -1;
8376  }
8377  omFree(sArithBase.sCmds[nIndex].name);
8378  sArithBase.sCmds[nIndex].name=NULL;
8379  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8380        (&_gentable_sort_cmds));
8381  sArithBase.nCmdUsed--;
8382
8383  /* fix last-identifier */
8384  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8385      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8386  {
8387    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8388  }
8389  //Print("L=%d\n", sArithBase.nLastIdentifier);
8390  return 0;
8391}
8392
8393int iiArithAddCmd(
8394  const char *szName,
8395  short nAlias,
8396  short nTokval,
8397  short nToktype,
8398  short nPos
8399  )
8400{
8401  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8402  //       nTokval, nToktype, nPos);
8403  if(nPos>=0)
8404  {
8405    // no checks: we rely on a correct generated code in iparith.inc
8406    assume(nPos < sArithBase.nCmdAllocated);
8407    assume(szName!=NULL);
8408    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8409    sArithBase.sCmds[nPos].alias   = nAlias;
8410    sArithBase.sCmds[nPos].tokval  = nTokval;
8411    sArithBase.sCmds[nPos].toktype = nToktype;
8412    sArithBase.nCmdUsed++;
8413    //if(nTokval>0) sArithBase.nLastIdentifier++;
8414  }
8415  else
8416  {
8417    if(szName==NULL) return -1;
8418    int nIndex = iiArithFindCmd(szName);
8419    if(nIndex>=0)
8420    {
8421      Print("'%s' already exists at %d\n", szName, nIndex);
8422      return -1;
8423    }
8424
8425    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8426    {
8427      /* needs to create new slots */
8428      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8429      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8430      if(sArithBase.sCmds==NULL) return -1;
8431      sArithBase.nCmdAllocated++;
8432    }
8433    /* still free slots available */
8434    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8435    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8436    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8437    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8438    sArithBase.nCmdUsed++;
8439
8440    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8441          (&_gentable_sort_cmds));
8442    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8443        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8444    {
8445      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8446    }
8447    //Print("L=%d\n", sArithBase.nLastIdentifier);
8448  }
8449  return 0;
8450}
Note: See TracBrowser for help on using the repository browser.