source: git/Singular/iparith.cc @ 1edbcdd

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