source: git/Singular/extra.cc

spielwiese
Last change on this file was aa4e28, checked in by Hans Schoenemann <hannes@…>, 4 weeks ago
HAVE_RINGS is default (p1)
  • Property mode set to 100644
File size: 122.7 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/*
5* ABSTRACT: general interface to internals of Singular ("system" command)
6* jjSYSTEM: official commands, must be documented in the manual,
7*           #defines must be local to each command
8* jjEXTENDED_SYSTEM: tests, temporary comands etc.
9*/
10
11#define HAVE_WALK 1
12
13#include "kernel/mod2.h"
14#include "misc/sirandom.h"
15#include "resources/omFindExec.h"
16
17#ifdef HAVE_CCLUSTER
18#undef CC
19#include "ccluster/ccluster.h"
20#endif
21
22#include "factory/factory.h"
23
24#ifdef TIME_WITH_SYS_TIME
25# include <time.h>
26# ifdef HAVE_SYS_TIME_H
27#   include <sys/time.h>
28# endif
29#else
30# ifdef HAVE_SYS_TIME_H
31#   include <sys/time.h>
32# else
33#   include <time.h>
34# endif
35#endif
36#ifdef HAVE_SYS_TIMES_H
37#include <sys/times.h>
38#endif
39
40#include <unistd.h>
41
42#include "misc/options.h"
43
44// #include "coeffs/ffields.h"
45#include "coeffs/coeffs.h"
46#include "coeffs/mpr_complex.h"
47
48
49#include "resources/feResource.h"
50#include "polys/monomials/ring.h"
51#include "kernel/polys.h"
52
53#include "polys/monomials/maps.h"
54#include "polys/matpol.h"
55#include "polys/pCoeff.h"
56
57#include "polys/weight.h"
58
59#ifdef HAVE_SHIFTBBA
60#include "polys/shiftop.h"
61#endif
62
63#include "coeffs/bigintmat.h"
64#include "kernel/fast_mult.h"
65#include "kernel/digitech.h"
66#include "kernel/combinatorics/stairc.h"
67#include "kernel/ideals.h"
68#include "kernel/GBEngine/kstd1.h"
69#include "kernel/GBEngine/syz.h"
70#include "kernel/GBEngine/kutil.h"
71#include "kernel/GBEngine/kverify.h"
72
73#include "kernel/linear_algebra/linearAlgebra.h"
74
75#include "kernel/combinatorics/hutil.h"
76
77// for tests of t-rep-GB
78#include "kernel/GBEngine/tgb.h"
79
80#include "kernel/linear_algebra/minpoly.h"
81
82#include "numeric/mpr_base.h"
83
84#include "tok.h"
85#include "ipid.h"
86#include "lists.h"
87#include "cntrlc.h"
88#include "ipshell.h"
89#include "sdb.h"
90#include "feOpt.h"
91#include "fehelp.h"
92#include "misc/distrib.h"
93
94#include "misc_ip.h"
95
96#include "attrib.h"
97
98#include "links/silink.h"
99#include "links/ssiLink.h"
100#include "walk.h"
101#include "Singular/newstruct.h"
102#include "Singular/blackbox.h"
103#include "Singular/pyobject_setup.h"
104
105
106#include "kernel/GBEngine/ringgb.h"
107
108#ifdef HAVE_F5
109#include "kernel/GBEngine/f5gb.h"
110#endif
111
112#ifdef HAVE_WALK
113#include "walk.h"
114#endif
115
116#ifdef HAVE_SPECTRUM
117#include "kernel/spectrum/spectrum.h"
118#endif
119
120#ifdef HAVE_PLURAL
121#include "polys/nc/nc.h"
122#include "polys/nc/ncSAMult.h" // for CMultiplier etc classes
123#include "polys/nc/sca.h"
124#include "kernel/GBEngine/nc.h"
125#include "ipconv.h"
126#ifdef HAVE_RATGRING
127#include "kernel/GBEngine/ratgring.h"
128#endif
129#endif
130
131#ifdef __CYGWIN__ /* only for the DLLTest */
132/* #include "WinDllTest.h" */
133#ifdef HAVE_DL
134#include "polys/mod_raw.h"
135#endif
136#endif
137
138// Define to enable many more system commands
139//#undef MAKE_DISTRIBUTION
140#ifndef MAKE_DISTRIBUTION
141#define HAVE_EXTENDED_SYSTEM 1
142#endif
143
144#include "polys/flintconv.h"
145#include "polys/clapconv.h"
146#include "kernel/GBEngine/kstdfac.h"
147
148#include "polys/clapsing.h"
149
150#ifdef HAVE_EIGENVAL
151#include "eigenval_ip.h"
152#endif
153
154#ifdef HAVE_GMS
155#include "gms.h"
156#endif
157
158#ifdef HAVE_SIMPLEIPC
159#include "Singular/links/simpleipc.h"
160#endif
161
162#ifdef HAVE_PCV
163#include "pcv.h"
164#endif
165
166#ifndef MAKE_DISTRIBUTION
167static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
168#endif
169EXTERN_VAR BOOLEAN FE_OPT_NO_SHELL_FLAG;
170
171/* expects a SINGULAR square matrix with number entries
172   where currRing is expected to be over some field F_p;
173   returns a long** matrix with the "same", i.e.,
174   appropriately mapped entries;
175   leaves singularMatrix unmodified */
176unsigned long** singularMatrixToLongMatrix(matrix singularMatrix)
177{
178  int n = singularMatrix->rows();
179  assume(n == singularMatrix->cols());
180  unsigned long **longMatrix = 0;
181  longMatrix = new unsigned long *[n] ;
182  for (int i = 0 ; i < n; i++)
183    longMatrix[i] = new unsigned long [n];
184  number entry;
185  for (int r = 0; r < n; r++)
186    for (int c = 0; c < n; c++)
187    {
188      poly p=MATELEM(singularMatrix, r + 1, c + 1);
189      int entryAsInt;
190      if (p!=NULL)
191      {
192        entry = p_GetCoeff(p, currRing);
193        entryAsInt = n_Int(entry, currRing->cf);
194        if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
195      }
196      else
197        entryAsInt=0;
198      longMatrix[r][c] = (unsigned long)entryAsInt;
199    }
200  return longMatrix;
201}
202
203/* expects an array of unsigned longs with valid indices 0..degree;
204   returns the following poly, where x denotes the first ring variable
205   of currRing, and d = degree:
206      polyCoeffs[d] * x^d + polyCoeffs[d-1] * x^(d-1) + ... + polyCoeffs[0]
207   leaves polyCoeffs unmodified */
208poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
209{
210  poly result = NULL;
211  for (int i = 0; i <= degree; i++)
212  {
213    if ((int)polyCoeffs[i] != 0)
214    {
215      poly term = p_ISet((int)polyCoeffs[i], currRing);
216      if (i > 0)
217      {
218        p_SetExp(term, 1, i, currRing);
219        p_Setm(term, currRing);
220      }
221      result = p_Add_q(result, term, currRing);
222    }
223  }
224  return result;
225}
226
227/*2
228*  the "system" command
229*/
230BOOLEAN jjSYSTEM(leftv res, leftv args)
231{
232  if(args->Typ() == STRING_CMD)
233  {
234    const char *sys_cmd=(char *)(args->Data());
235    leftv h=args->next;
236// ONLY documented system calls go here
237// Undocumented system calls go down into jjEXTENDED_SYSTEM (#ifdef HAVE_EXTENDED_SYSTEM)
238/*==================== nblocks ==================================*/
239    if (strcmp(sys_cmd, "nblocks") == 0)
240    {
241      ring r;
242      if (h == NULL)
243      {
244        if (currRingHdl != NULL)
245        {
246          r = IDRING(currRingHdl);
247        }
248        else
249        {
250          WerrorS("no ring active");
251          return TRUE;
252        }
253      }
254      else
255      {
256        if (h->Typ() != RING_CMD)
257        {
258          WerrorS("ring expected");
259          return TRUE;
260        }
261        r = (ring) h->Data();
262      }
263      res->rtyp = INT_CMD;
264      res->data = (void*) (long)(rBlocks(r) - 1);
265      return FALSE;
266    }
267/*==================== version ==================================*/
268    if(strcmp(sys_cmd,"version")==0)
269    {
270      res->rtyp=INT_CMD;
271      res->data=(void *)SINGULAR_VERSION;
272      return FALSE;
273    }
274    else
275/*==================== alarm ==================================*/
276      if(strcmp(sys_cmd,"alarm")==0)
277      {
278        if ((h!=NULL) &&(h->Typ()==INT_CMD))
279        {
280          // standard variant -> SIGALARM (standard: abort)
281          //alarm((unsigned)h->next->Data());
282          // process time (user +system): SIGVTALARM
283          struct itimerval t,o;
284          memset(&t,0,sizeof(t));
285          t.it_value.tv_sec     =(unsigned)((unsigned long)h->Data());
286          setitimer(ITIMER_VIRTUAL,&t,&o);
287          return FALSE;
288        }
289        else
290          WerrorS("int expected");
291      }
292      else
293/*==================== content ==================================*/
294    if(strcmp(sys_cmd,"content")==0)
295    {
296      if ((h!=NULL) && ((h->Typ()==POLY_CMD)||(h->Typ()==VECTOR_CMD)))
297      {
298        int t=h->Typ();
299        poly p=(poly)h->CopyD();
300        if (p!=NULL)
301        {
302           if (!nCoeff_is_Ring(currRing->cf)) p_Cleardenom(p,currRing);
303          p_Content(p,currRing);
304        }
305        res->data=(void *)p;
306        res->rtyp=t;
307        return FALSE;
308      }
309      return TRUE;
310    }
311    else
312/*==================== cpu ==================================*/
313    if(strcmp(sys_cmd,"cpu")==0)
314    {
315      #if 0
316      long cpu=1;
317      #ifdef _SC_NPROCESSORS_ONLN
318      cpu=sysconf(_SC_NPROCESSORS_ONLN);
319      #elif defined(_SC_NPROCESSORS_CONF)
320      cpu=sysconf(_SC_NPROCESSORS_CONF);
321      #endif
322      res->data=(void *)cpu;
323      #else
324      res->data=(void *)feOptValue(FE_OPT_CPUS);
325      #endif
326      res->rtyp=INT_CMD;
327      return FALSE;
328    }
329    else
330/*==================== executable ==================================*/
331    if(strcmp(sys_cmd,"executable")==0)
332    {
333      if ((h!=NULL) && (h->Typ()==STRING_CMD))
334      {
335        char tbuf[MAXPATHLEN];
336        char *s=omFindExec((char*)h->Data(),tbuf);
337        if(s==NULL) s=(char*)"";
338        res->data=(void *)omStrDup(s);
339        res->rtyp=STRING_CMD;
340        return FALSE;
341      }
342      return TRUE;
343    }
344    else
345  /*==================== flatten =============================*/
346    if(strcmp(sys_cmd,"flatten")==0)
347    {
348      if ((h!=NULL) &&(h->Typ()==SMATRIX_CMD))
349      {
350        res->data=(char*)sm_Flatten((ideal)h->Data(),currRing);
351        res->rtyp=SMATRIX_CMD;
352        return FALSE;
353      }
354      else
355        WerrorS("smatrix expected");
356    }
357    else
358  /*==================== unflatten =============================*/
359    if(strcmp(sys_cmd,"unflatten")==0)
360    {
361      const short t1[]={2,SMATRIX_CMD,INT_CMD};
362      if (iiCheckTypes(h,t1,1))
363      {
364        res->data=(char*)sm_UnFlatten((ideal)h->Data(),(int)(long)h->next->Data(),currRing);
365        res->rtyp=SMATRIX_CMD;
366        return res->data==NULL;
367      }
368      else return TRUE;
369    }
370    else
371  /*==================== neworder =============================*/
372    if(strcmp(sys_cmd,"neworder")==0)
373    {
374      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
375      {
376        res->rtyp=STRING_CMD;
377        res->data=(void *)singclap_neworder((ideal)h->Data(), currRing);
378        return FALSE;
379      }
380      else
381        WerrorS("ideal expected");
382    }
383    else
384/*===== nc_hilb ===============================================*/
385   // Hilbert series of non-commutative monomial algebras
386    if(strcmp(sys_cmd,"nc_hilb") == 0)
387    {
388      ideal i; int lV;
389      bool ig = FALSE;
390      bool mgrad = FALSE;
391      bool autop = FALSE;
392      int trunDegHs=0;
393      if((h != NULL)&&(h->Typ() == IDEAL_CMD))
394        i = (ideal)h->Data();
395      else
396      {
397        WerrorS("nc_Hilb:ideal expected");
398        return TRUE;
399      }
400      h = h->next;
401      if((h != NULL)&&(h->Typ() == INT_CMD))
402        lV = (int)(long)h->Data();
403      else
404      {
405        WerrorS("nc_Hilb:int expected");
406        return TRUE;
407      }
408      h = h->next;
409      while(h != NULL)
410      {
411        if((int)(long)h->Data() == 1)
412          ig = TRUE;
413        else if((int)(long)h->Data() == 2)
414          mgrad = TRUE;
415        else if(h->Typ()==STRING_CMD)
416           autop = TRUE;
417        else if(h->Typ() == INT_CMD)
418          trunDegHs = (int)(long)h->Data();
419        h = h->next;
420      }
421      if(h != NULL)
422      {
423        WerrorS("nc_Hilb:int 1,2, total degree for the truncation, and a string                  for printing the details are expected");
424        return TRUE;
425      }
426
427      HilbertSeries_OrbitData(i, lV, ig, mgrad, autop, trunDegHs);
428      return(FALSE);
429    }
430    else
431/* ====== verify ============================*/
432    if(strcmp(sys_cmd,"verifyGB")==0)
433    {
434      if (rIsNCRing(currRing))
435      {
436        WerrorS("system(\"verifyGB\",<ideal>,..) expects a commutative ring");
437        return TRUE;
438      }
439      if (((h->Typ()!=IDEAL_CMD)&&(h->Typ()!=MODUL_CMD))
440      || (h->next!=NULL))
441      {
442        Werror("expected system(\"verifyGB\",<ideal/module>), found <%s>",Tok2Cmdname(h->Typ()));
443        return TRUE;
444      }
445      ideal F=(ideal)h->Data();
446      #ifdef HAVE_VSPACE
447      int cpus = (long) feOptValue(FE_OPT_CPUS);
448      if (cpus>1)
449        res->data=(char*)(long) kVerify2(F,currRing->qideal);
450      else
451      #endif
452        res->data=(char*)(long) kVerify1(F,currRing->qideal);
453      res->rtyp=INT_CMD;
454      return FALSE;
455    }
456    else
457/*===== rcolon ===============================================*/
458  if(strcmp(sys_cmd,"rcolon") == 0)
459  {
460    const short t1[]={3,IDEAL_CMD,POLY_CMD,INT_CMD};
461    if (iiCheckTypes(h,t1,1))
462    {
463      ideal i = (ideal)h->Data();
464      h = h->next;
465      poly w=(poly)h->Data();
466      h = h->next;
467      int lV = (int)(long)h->Data();
468      res->rtyp = IDEAL_CMD;
469      res->data = RightColonOperation(i, w, lV);
470      return(FALSE);
471    }
472    else
473      return TRUE;
474  }
475  else
476
477/*==================== sh ==================================*/
478    if(strcmp(sys_cmd,"sh")==0)
479    {
480      if (FE_OPT_NO_SHELL_FLAG)
481      {
482        WerrorS("shell execution is disallowed in restricted mode");
483        return TRUE;
484      }
485      res->rtyp=INT_CMD;
486      if (h==NULL) res->data = (void *)(long) system("sh");
487      else if (h->Typ()==STRING_CMD)
488        res->data = (void*)(long) system((char*)(h->Data()));
489      else
490        WerrorS("string expected");
491      return FALSE;
492    }
493    else
494/*========reduce procedure like the global one but with jet bounds=======*/
495    if(strcmp(sys_cmd,"reduce_bound")==0)
496    {
497      poly p=NULL;
498      ideal pid=NULL;
499      const short t1[]={3,POLY_CMD,IDEAL_CMD,INT_CMD};
500      const short t2[]={3,IDEAL_CMD,IDEAL_CMD,INT_CMD};
501      const short t3[]={3,VECTOR_CMD,MODUL_CMD,INT_CMD};
502      const short t4[]={3,MODUL_CMD,MODUL_CMD,INT_CMD};
503      if ((iiCheckTypes(h,t1,0))||((iiCheckTypes(h,t3,0))))
504      {
505        p = (poly)h->CopyD();
506      }
507      else if  ((iiCheckTypes(h,t2,0))||(iiCheckTypes(h,t4,1)))
508      {
509        pid = (ideal)h->CopyD();
510      }
511      else return TRUE;
512      //int htype;
513      res->rtyp= h->Typ(); /*htype*/
514      ideal q = (ideal)h->next->CopyD();
515      int bound = (int)(long)h->next->next->Data();
516      if (pid==NULL) /*(htype == POLY_CMD || htype == VECTOR_CMD)*/
517        res->data = (char *)kNFBound(q,currRing->qideal,p,bound);
518      else /*(htype == IDEAL_CMD || htype == MODUL_CMD)*/
519        res->data = (char *)kNFBound(q,currRing->qideal,pid,bound);
520      return FALSE;
521    }
522    else
523/*==================== uname ==================================*/
524    if(strcmp(sys_cmd,"uname")==0)
525    {
526      res->rtyp=STRING_CMD;
527      res->data = omStrDup(S_UNAME);
528      return FALSE;
529    }
530    else
531/*==================== with ==================================*/
532    if(strcmp(sys_cmd,"with")==0)
533    {
534      if (h==NULL)
535      {
536        res->rtyp=STRING_CMD;
537        res->data=(void *)versionString();
538        return FALSE;
539      }
540      else if (h->Typ()==STRING_CMD)
541      {
542        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
543        char *s=(char *)h->Data();
544        res->rtyp=INT_CMD;
545        #ifdef HAVE_DBM
546          TEST_FOR("DBM")
547        #endif
548        #ifdef HAVE_DLD
549          TEST_FOR("DLD")
550        #endif
551          //TEST_FOR("factory")
552          //TEST_FOR("libfac")
553        #ifdef HAVE_READLINE
554          TEST_FOR("readline")
555        #endif
556        #ifdef TEST_MAC_ORDER
557          TEST_FOR("MAC_ORDER")
558        #endif
559        // unconditional since 3-1-0-6
560          TEST_FOR("Namespaces")
561        #ifdef HAVE_DYNAMIC_LOADING
562          TEST_FOR("DynamicLoading")
563        #endif
564        #ifdef HAVE_EIGENVAL
565          TEST_FOR("eigenval")
566        #endif
567        #ifdef HAVE_GMS
568          TEST_FOR("gms")
569        #endif
570        #ifdef OM_NDEBUG
571          TEST_FOR("om_ndebug")
572        #endif
573        #ifdef SING_NDEBUG
574          TEST_FOR("ndebug")
575        #endif
576          {};
577          return FALSE;
578        #undef TEST_FOR
579      }
580      return TRUE;
581    }
582    else
583  /*==================== browsers ==================================*/
584    if (strcmp(sys_cmd,"browsers")==0)
585    {
586      res->rtyp = STRING_CMD;
587      StringSetS("");
588      feStringAppendBrowsers(0);
589      res->data = StringEndS();
590      return FALSE;
591    }
592    else
593  /*==================== pid ==================================*/
594    if (strcmp(sys_cmd,"pid")==0)
595    {
596      res->rtyp=INT_CMD;
597      res->data=(void *)(long) getpid();
598      return FALSE;
599    }
600    else
601  /*==================== getenv ==================================*/
602    if (strcmp(sys_cmd,"getenv")==0)
603    {
604      if ((h!=NULL) && (h->Typ()==STRING_CMD))
605      {
606        res->rtyp=STRING_CMD;
607        const char *r=getenv((char *)h->Data());
608        if (r==NULL) r="";
609        res->data=(void *)omStrDup(r);
610        return FALSE;
611      }
612      else
613      {
614        WerrorS("string expected");
615        return TRUE;
616      }
617    }
618    else
619  /*==================== setenv ==================================*/
620    if (strcmp(sys_cmd,"setenv")==0)
621    {
622  #ifdef HAVE_SETENV
623      const short t[]={2,STRING_CMD,STRING_CMD};
624      if (iiCheckTypes(h,t,1))
625      {
626        res->rtyp=STRING_CMD;
627        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
628        res->data=(void *)omStrDup((char *)h->next->Data());
629        feReInitResources();
630        return FALSE;
631      }
632      else
633      {
634        return TRUE;
635      }
636  #else
637      WerrorS("setenv not supported on this platform");
638      return TRUE;
639  #endif
640    }
641    else
642  /*==================== Singular ==================================*/
643    if (strcmp(sys_cmd, "Singular") == 0)
644    {
645      res->rtyp=STRING_CMD;
646      const char *r=feResource("Singular");
647      if (r == NULL) r="";
648      res->data = (void*) omStrDup( r );
649      return FALSE;
650    }
651    else
652    if (strcmp(sys_cmd, "SingularLib") == 0)
653    {
654      res->rtyp=STRING_CMD;
655      const char *r=feResource("SearchPath");
656      if (r == NULL) r="";
657      res->data = (void*) omStrDup( r );
658      return FALSE;
659    }
660    else
661    if (strcmp(sys_cmd, "SingularBin") == 0)
662    {
663      res->rtyp=STRING_CMD;
664      const char *r=feResource('r');
665      if (r == NULL) r="/usr/local";
666      int l=strlen(r);
667      /* where to find Singular's programs: */
668      #define SINGULAR_PROCS_DIR "/libexec/singular/MOD"
669      int ll=si_max((int)strlen(SINGULAR_PROCS_DIR),(int)strlen(LIBEXEC_DIR));
670      char *s=(char*)omAlloc(l+ll+2);
671      if ((strstr(r,".libs/..")==NULL)   /*not installed Singular (libtool)*/
672      &&(strstr(r,"Singular/..")==NULL)) /*not installed Singular (static)*/
673      {
674        strcpy(s,r);
675        strcat(s,SINGULAR_PROCS_DIR);
676        if (access(s,X_OK)==0)
677        {
678          strcat(s,"/");
679        }
680        else
681        {
682          /*second try: LIBEXEC_DIR*/
683          strcpy(s,LIBEXEC_DIR);
684          if (access(s,X_OK)==0)
685          {
686            strcat(s,"/");
687          }
688          else
689          {
690            s[0]='\0';
691          }
692        }
693      }
694      else
695      {
696        const char *r=feResource('b');
697        if (r == NULL)
698        {
699          s[0]='\0';
700        }
701        else
702        {
703          strcpy(s,r);
704          strcat(s,"/");
705        }
706      }
707      res->data = (void*)s;
708      return FALSE;
709    }
710    else
711  /*==================== options ==================================*/
712    if (strstr(sys_cmd, "--") == sys_cmd)
713    {
714      if (strcmp(sys_cmd, "--") == 0)
715      {
716        fePrintOptValues();
717        return FALSE;
718      }
719      feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
720      if (opt == FE_OPT_UNDEF)
721      {
722        Werror("Unknown option %s", sys_cmd);
723        WerrorS("Use 'system(\"--\");' for listing of available options");
724        return TRUE;
725      }
726      // for Untyped Options (help version),
727      // setting it just triggers action
728      if (feOptSpec[opt].type == feOptUntyped)
729      {
730        feSetOptValue(opt,0);
731        return FALSE;
732      }
733      if (h == NULL)
734      {
735        if (feOptSpec[opt].type == feOptString)
736        {
737          res->rtyp = STRING_CMD;
738          const char *r=(const char*)feOptSpec[opt].value;
739          if (r == NULL) r="";
740          res->data = omStrDup(r);
741        }
742        else
743        {
744          res->rtyp = INT_CMD;
745          res->data = feOptSpec[opt].value;
746        }
747        return FALSE;
748      }
749      if (h->Typ() != STRING_CMD &&
750          h->Typ() != INT_CMD)
751      {
752        WerrorS("Need string or int argument to set option value");
753        return TRUE;
754      }
755      const char* errormsg;
756      if (h->Typ() == INT_CMD)
757      {
758        if (feOptSpec[opt].type == feOptString)
759        {
760          Werror("Need string argument to set value of option %s", sys_cmd);
761          return TRUE;
762        }
763        errormsg = feSetOptValue(opt, (int)((long) h->Data()));
764        if (errormsg != NULL)
765          Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
766      }
767      else
768      {
769        errormsg = feSetOptValue(opt, (char*) h->Data());
770        if (errormsg != NULL)
771          Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
772      }
773      if (errormsg != NULL) return TRUE;
774      return FALSE;
775    }
776    else
777  /*==================== HC ==================================*/
778    if (strcmp(sys_cmd,"HC")==0)
779    {
780      res->rtyp=INT_CMD;
781      res->data=(void *)(long) HCord;
782      return FALSE;
783    }
784    else
785  /*==================== random ==================================*/
786    if(strcmp(sys_cmd,"random")==0)
787    {
788      const short t[]={1,INT_CMD};
789      if (h!=NULL)
790      {
791        if (iiCheckTypes(h,t,1))
792        {
793          siRandomStart=(int)((long)h->Data());
794          siSeed=siRandomStart;
795          factoryseed(siRandomStart);
796          return FALSE;
797        }
798        else
799        {
800          return TRUE;
801        }
802      }
803      res->rtyp=INT_CMD;
804      res->data=(void*)(long) siSeed;
805      return FALSE;
806    }
807    else
808  /*======================= demon_list =====================*/
809    if (strcmp(sys_cmd,"denom_list")==0)
810    {
811      res->rtyp=LIST_CMD;
812      extern lists get_denom_list();
813      res->data=(lists)get_denom_list();
814      return FALSE;
815    }
816    else
817    /*==================== complexNearZero ======================*/
818    if(strcmp(sys_cmd,"complexNearZero")==0)
819    {
820      const short t[]={2,NUMBER_CMD,INT_CMD};
821      if (iiCheckTypes(h,t,1))
822      {
823        if ( !rField_is_long_C(currRing) )
824        {
825          WerrorS( "unsupported ground field!");
826          return TRUE;
827        }
828        else
829        {
830          res->rtyp=INT_CMD;
831          res->data=(void*)complexNearZero((gmp_complex*)h->Data(),
832                             (int)((long)(h->next->Data())));
833          return FALSE;
834        }
835      }
836      else
837      {
838        return TRUE;
839      }
840    }
841    else
842  /*==================== getPrecDigits ======================*/
843    if(strcmp(sys_cmd,"getPrecDigits")==0)
844    {
845      if ( (currRing==NULL)
846      ||  (!rField_is_long_C(currRing) && !rField_is_long_R(currRing)))
847      {
848        WerrorS( "unsupported ground field!");
849        return TRUE;
850      }
851      res->rtyp=INT_CMD;
852      res->data=(void*)(long)gmp_output_digits;
853      //if (gmp_output_digits!=getGMPFloatDigits())
854      //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);}
855      return FALSE;
856    }
857    else
858  /*==================== lduDecomp ======================*/
859    if(strcmp(sys_cmd, "lduDecomp")==0)
860    {
861      const short t[]={1,MATRIX_CMD};
862      if (iiCheckTypes(h,t,1))
863      {
864        matrix aMat = (matrix)h->Data();
865        matrix pMat; matrix lMat; matrix dMat; matrix uMat;
866        poly l; poly u; poly prodLU;
867        lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU);
868        lists L = (lists)omAllocBin(slists_bin);
869        L->Init(7);
870        L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat;
871        L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat;
872        L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat;
873        L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat;
874        L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l;
875        L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u;
876        L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU;
877        res->rtyp = LIST_CMD;
878        res->data = (char *)L;
879        return FALSE;
880      }
881      else
882      {
883        return TRUE;
884      }
885    }
886    else
887  /*==================== lduSolve ======================*/
888    if(strcmp(sys_cmd, "lduSolve")==0)
889    {
890      /* for solving a linear equation system A * x = b, via the
891           given LDU-decomposition of the matrix A;
892           There is one valid parametrisation:
893           1) exactly eight arguments P, L, D, U, l, u, lTimesU, b;
894              P, L, D, and U realise the LDU-decomposition of A, that is,
895              P * A = L * D^(-1) * U, and P, L, D, and U satisfy the
896              properties decribed in method 'luSolveViaLDUDecomp' in
897              linearAlgebra.h; see there;
898              l, u, and lTimesU are as described in the same location;
899              b is the right-hand side vector of the linear equation system;
900           The method will return a list of either 1 entry or three entries:
901           1) [0] if there is no solution to the system;
902           2) [1, x, H] if there is at least one solution;
903              x is any solution of the given linear system,
904              H is the matrix with column vectors spanning the homogeneous
905              solution space.
906           The method produces an error if matrix and vector sizes do not
907           fit. */
908      const short t[]={7,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,POLY_CMD,POLY_CMD,MATRIX_CMD};
909      if (!iiCheckTypes(h,t,1))
910      {
911        return TRUE;
912      }
913      if (rField_is_Ring(currRing))
914      {
915        WerrorS("field required");
916        return TRUE;
917      }
918      matrix pMat  = (matrix)h->Data();
919      matrix lMat  = (matrix)h->next->Data();
920      matrix dMat  = (matrix)h->next->next->Data();
921      matrix uMat  = (matrix)h->next->next->next->Data();
922      poly l       = (poly)  h->next->next->next->next->Data();
923      poly u       = (poly)  h->next->next->next->next->next->Data();
924      poly lTimesU = (poly)  h->next->next->next->next->next->next->Data();
925      matrix bVec  = (matrix)h->next->next->next->next->next->next->next->Data();
926      matrix xVec; int solvable; matrix homogSolSpace;
927      if (pMat->rows() != pMat->cols())
928      {
929        Werror("first matrix (%d x %d) is not quadratic",
930                 pMat->rows(), pMat->cols());
931        return TRUE;
932      }
933      if (lMat->rows() != lMat->cols())
934      {
935        Werror("second matrix (%d x %d) is not quadratic",
936                 lMat->rows(), lMat->cols());
937        return TRUE;
938      }
939      if (dMat->rows() != dMat->cols())
940      {
941        Werror("third matrix (%d x %d) is not quadratic",
942                 dMat->rows(), dMat->cols());
943        return TRUE;
944      }
945      if (dMat->cols() != uMat->rows())
946      {
947        Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s",
948                 dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(),
949                 "do not t");
950        return TRUE;
951      }
952      if (uMat->rows() != bVec->rows())
953      {
954        Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit",
955                 uMat->rows(), uMat->cols(), bVec->rows());
956        return TRUE;
957      }
958      solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU,
959                                       bVec, xVec, homogSolSpace);
960
961      /* build the return structure; a list with either one or
962           three entries */
963      lists ll = (lists)omAllocBin(slists_bin);
964      if (solvable)
965      {
966        ll->Init(3);
967        ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
968        ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
969        ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
970      }
971      else
972      {
973        ll->Init(1);
974        ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
975      }
976      res->rtyp = LIST_CMD;
977      res->data=(char*)ll;
978      return FALSE;
979    }
980    else
981  /*==== countedref: reference and shared ====*/
982    if (strcmp(sys_cmd, "shared") == 0)
983    {
984      #ifndef SI_COUNTEDREF_AUTOLOAD
985      void countedref_shared_load();
986      countedref_shared_load();
987      #endif
988      res->rtyp = NONE;
989      return FALSE;
990    }
991    else if (strcmp(sys_cmd, "reference") == 0)
992    {
993      #ifndef SI_COUNTEDREF_AUTOLOAD
994      void countedref_reference_load();
995      countedref_reference_load();
996      #endif
997      res->rtyp = NONE;
998      return FALSE;
999    }
1000    else
1001/*==================== semaphore =================*/
1002#ifdef HAVE_SIMPLEIPC
1003    if (strcmp(sys_cmd,"semaphore")==0)
1004    {
1005      if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
1006      {
1007        int v=1;
1008        if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))
1009          v=(int)(long)h->next->next->Data();
1010        res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v);
1011        res->rtyp=INT_CMD;
1012        return FALSE;
1013      }
1014      else
1015      {
1016        WerrorS("Usage: system(\"semaphore\",<cmd>,int)");
1017        return TRUE;
1018      }
1019    }
1020    else
1021#endif
1022/*==================== reserved port =================*/
1023    if (strcmp(sys_cmd,"reserve")==0)
1024    {
1025      const short t[]={1,INT_CMD};
1026      if (iiCheckTypes(h,t,1))
1027      {
1028        res->rtyp=INT_CMD;
1029        int p=ssiReservePort((int)(long)h->Data());
1030        res->data=(void*)(long)p;
1031        return (p==0);
1032      }
1033      return TRUE;
1034    }
1035    else
1036/*==================== reserved link =================*/
1037    if (strcmp(sys_cmd,"reservedLink")==0)
1038    {
1039      res->rtyp=LINK_CMD;
1040      si_link p=ssiCommandLink();
1041      res->data=(void*)p;
1042      return (p==NULL);
1043    }
1044    else
1045/*==================== install newstruct =================*/
1046    if (strcmp(sys_cmd,"install")==0)
1047    {
1048      const short t[]={4,STRING_CMD,STRING_CMD,PROC_CMD,INT_CMD};
1049      if (iiCheckTypes(h,t,1))
1050      {
1051        return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),
1052                                (int)(long)h->next->next->next->Data(),
1053                                (procinfov)h->next->next->Data());
1054      }
1055      return TRUE;
1056    }
1057    else
1058/*==================== newstruct =================*/
1059    if (strcmp(sys_cmd,"newstruct")==0)
1060    {
1061      const short t[]={1,STRING_CMD};
1062      if (iiCheckTypes(h,t,1))
1063      {
1064        int id=0;
1065        char *n=(char*)h->Data();
1066        blackboxIsCmd(n,id);
1067        if (id>0)
1068        {
1069          blackbox *bb=getBlackboxStuff(id);
1070          if (BB_LIKE_LIST(bb))
1071          {
1072            newstruct_desc desc=(newstruct_desc)bb->data;
1073            newstructShow(desc);
1074            return FALSE;
1075          }
1076          else Werror("'%s' is not a newstruct",n);
1077        }
1078        else Werror("'%s' is not a blackbox object",n);
1079      }
1080      return TRUE;
1081    }
1082    else
1083/*==================== blackbox =================*/
1084    if (strcmp(sys_cmd,"blackbox")==0)
1085    {
1086      printBlackboxTypes();
1087      return FALSE;
1088    }
1089    else
1090  /*================= absBiFact ======================*/
1091    #if defined(HAVE_FLINT) || defined(HAVE_NTL)
1092    if (strcmp(sys_cmd, "absFact") == 0)
1093    {
1094      const short t[]={1,POLY_CMD};
1095      if (iiCheckTypes(h,t,1)
1096      && (currRing!=NULL)
1097      && (getCoeffType(currRing->cf)==n_transExt))
1098      {
1099        res->rtyp=LIST_CMD;
1100        intvec *v=NULL;
1101        ideal mipos= NULL;
1102        int n= 0;
1103        ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);
1104        if (f==NULL) return TRUE;
1105        ivTest(v);
1106        lists l=(lists)omAllocBin(slists_bin);
1107        l->Init(4);
1108        l->m[0].rtyp=IDEAL_CMD;
1109        l->m[0].data=(void *)f;
1110        l->m[1].rtyp=INTVEC_CMD;
1111        l->m[1].data=(void *)v;
1112        l->m[2].rtyp=IDEAL_CMD;
1113        l->m[2].data=(void*) mipos;
1114        l->m[3].rtyp=INT_CMD;
1115        l->m[3].data=(void*) (long) n;
1116        res->data=(void *)l;
1117        return FALSE;
1118      }
1119      else return TRUE;
1120    }
1121    else
1122    #endif
1123  /* =================== LLL via NTL ==============================*/
1124  #ifdef HAVE_NTL
1125    if (strcmp(sys_cmd, "LLL") == 0)
1126    {
1127      if (h!=NULL)
1128      {
1129        res->rtyp=h->Typ();
1130        if (h->Typ()==MATRIX_CMD)
1131        {
1132          res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
1133          return FALSE;
1134        }
1135        else if (h->Typ()==INTMAT_CMD)
1136        {
1137          res->data=(char *)singntl_LLL((intvec*)h->Data());
1138          return FALSE;
1139        }
1140        else return TRUE;
1141      }
1142      else return TRUE;
1143    }
1144    else
1145  #endif
1146  /* =================== LLL via Flint ==============================*/
1147  #ifdef HAVE_FLINT
1148  #if __FLINT_RELEASE >= 20500
1149    if (strcmp(sys_cmd, "LLL_Flint") == 0)
1150    {
1151      if (h!=NULL)
1152      {
1153        if(h->next == NULL)
1154        {
1155            res->rtyp=h->Typ();
1156            if (h->Typ()==BIGINTMAT_CMD)
1157            {
1158              res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1159              return FALSE;
1160            }
1161            else if (h->Typ()==INTMAT_CMD)
1162            {
1163              res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1164              return FALSE;
1165            }
1166            else return TRUE;
1167        }
1168        if(h->next->Typ()!= INT_CMD)
1169        {
1170            WerrorS("matrix,int or bigint,int expected");
1171            return TRUE;
1172        }
1173        if(h->next->Typ()== INT_CMD)
1174        {
1175            if(((int)((long)(h->next->Data())) != 0) && (int)((long)(h->next->Data()) != 1))
1176            {
1177                WerrorS("int is different from 0, 1");
1178                return TRUE;
1179            }
1180            res->rtyp=h->Typ();
1181            if((long)(h->next->Data()) == 0)
1182            {
1183                if (h->Typ()==BIGINTMAT_CMD)
1184                {
1185                  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1186                  return FALSE;
1187                }
1188                else if (h->Typ()==INTMAT_CMD)
1189                {
1190                  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1191                  return FALSE;
1192                }
1193                else return TRUE;
1194            }
1195            // This will give also the transformation matrix U s.t. res = U * m
1196            if((long)(h->next->Data()) == 1)
1197            {
1198                if (h->Typ()==BIGINTMAT_CMD)
1199                {
1200                  bigintmat* m = (bigintmat*)h->Data();
1201                  bigintmat* T = new bigintmat(m->rows(),m->rows(),m->basecoeffs());
1202                  for(int i = 1; i<=m->rows(); i++)
1203                  {
1204                    n_Delete(&(BIMATELEM(*T,i,i)),T->basecoeffs());
1205                    BIMATELEM(*T,i,i)=n_Init(1, T->basecoeffs());
1206                  }
1207                  m = singflint_LLL(m,T);
1208                  lists L = (lists)omAllocBin(slists_bin);
1209                  L->Init(2);
1210                  L->m[0].rtyp = BIGINTMAT_CMD;  L->m[0].data = (void*)m;
1211                  L->m[1].rtyp = BIGINTMAT_CMD;  L->m[1].data = (void*)T;
1212                  res->data=L;
1213                  res->rtyp=LIST_CMD;
1214                  return FALSE;
1215                }
1216                else if (h->Typ()==INTMAT_CMD)
1217                {
1218                  intvec* m = (intvec*)h->Data();
1219                  intvec* T = new intvec(m->rows(),m->rows(),(int)0);
1220                  for(int i = 1; i<=m->rows(); i++)
1221                    IMATELEM(*T,i,i)=1;
1222                  m = singflint_LLL(m,T);
1223                  lists L = (lists)omAllocBin(slists_bin);
1224                  L->Init(2);
1225                  L->m[0].rtyp = INTMAT_CMD;  L->m[0].data = (void*)m;
1226                  L->m[1].rtyp = INTMAT_CMD;  L->m[1].data = (void*)T;
1227                  res->data=L;
1228                  res->rtyp=LIST_CMD;
1229                  return FALSE;
1230                }
1231                else return TRUE;
1232            }
1233        }
1234
1235      }
1236      else return TRUE;
1237    }
1238    else
1239  #endif
1240  #endif
1241/* ====== rref ============================*/
1242  #if defined(HAVE_FLINT) || defined(HAVE_NTL)
1243  if(strcmp(sys_cmd,"rref")==0)
1244  {
1245    const short t1[]={1,MATRIX_CMD};
1246    const short t2[]={1,SMATRIX_CMD};
1247    if (iiCheckTypes(h,t1,0))
1248    {
1249      matrix M=(matrix)h->Data();
1250      #if defined(HAVE_FLINT)
1251      res->data=(void*)singflint_rref(M,currRing);
1252      #elif defined(HAVE_NTL)
1253      res->data=(void*)singntl_rref(M,currRing);
1254      #endif
1255      res->rtyp=MATRIX_CMD;
1256      return FALSE;
1257    }
1258    else if (iiCheckTypes(h,t2,1))
1259    {
1260      ideal M=(ideal)h->Data();
1261      #if defined(HAVE_FLINT)
1262      res->data=(void*)singflint_rref(M,currRing);
1263      #elif defined(HAVE_NTL)
1264      res->data=(void*)singntl_rref(M,currRing);
1265      #endif
1266      res->rtyp=SMATRIX_CMD;
1267      return FALSE;
1268    }
1269    else
1270    {
1271      WerrorS("expected system(\"rref\",<matrix>/<smatrix>)");
1272      return TRUE;
1273    }
1274  }
1275  else
1276  #endif
1277  /*==================== pcv ==================================*/
1278  #ifdef HAVE_PCV
1279    if(strcmp(sys_cmd,"pcvLAddL")==0)
1280    {
1281      return pcvLAddL(res,h);
1282    }
1283    else
1284    if(strcmp(sys_cmd,"pcvPMulL")==0)
1285    {
1286      return pcvPMulL(res,h);
1287    }
1288    else
1289    if(strcmp(sys_cmd,"pcvMinDeg")==0)
1290    {
1291      return pcvMinDeg(res,h);
1292    }
1293    else
1294    if(strcmp(sys_cmd,"pcvP2CV")==0)
1295    {
1296      return pcvP2CV(res,h);
1297    }
1298    else
1299    if(strcmp(sys_cmd,"pcvCV2P")==0)
1300    {
1301      return pcvCV2P(res,h);
1302    }
1303    else
1304    if(strcmp(sys_cmd,"pcvDim")==0)
1305    {
1306      return pcvDim(res,h);
1307    }
1308    else
1309    if(strcmp(sys_cmd,"pcvBasis")==0)
1310    {
1311      return pcvBasis(res,h);
1312    }
1313    else
1314  #endif
1315  /*==================== hessenberg/eigenvalues ==================================*/
1316  #ifdef HAVE_EIGENVAL
1317    if(strcmp(sys_cmd,"hessenberg")==0)
1318    {
1319      return evHessenberg(res,h);
1320    }
1321    else
1322  #endif
1323  /*==================== eigenvalues ==================================*/
1324  #ifdef HAVE_EIGENVAL
1325    if(strcmp(sys_cmd,"eigenvals")==0)
1326    {
1327      return evEigenvals(res,h);
1328    }
1329    else
1330  #endif
1331  /*==================== rowelim ==================================*/
1332  #ifdef HAVE_EIGENVAL
1333    if(strcmp(sys_cmd,"rowelim")==0)
1334    {
1335      return evRowElim(res,h);
1336    }
1337    else
1338  #endif
1339  /*==================== rowcolswap ==================================*/
1340  #ifdef HAVE_EIGENVAL
1341    if(strcmp(sys_cmd,"rowcolswap")==0)
1342    {
1343      return evSwap(res,h);
1344    }
1345    else
1346  #endif
1347  /*==================== Gauss-Manin system ==================================*/
1348  #ifdef HAVE_GMS
1349    if(strcmp(sys_cmd,"gmsnf")==0)
1350    {
1351      return gmsNF(res,h);
1352    }
1353    else
1354  #endif
1355  /*==================== contributors =============================*/
1356    if(strcmp(sys_cmd,"contributors") == 0)
1357    {
1358      res->rtyp=STRING_CMD;
1359      res->data=(void *)omStrDup(
1360         "Olaf Bachmann, Michael Brickenstein, Hubert Grassmann, Kai Krueger, Victor Levandovskyy, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Mathias Schulze, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
1361      return FALSE;
1362    }
1363    else
1364  /*==================== spectrum =============================*/
1365    #ifdef HAVE_SPECTRUM
1366    if(strcmp(sys_cmd,"spectrum") == 0)
1367    {
1368      if ((h==NULL) || (h->Typ()!=POLY_CMD))
1369      {
1370        WerrorS("poly expected");
1371        return TRUE;
1372      }
1373      if (h->next==NULL)
1374        return spectrumProc(res,h);
1375      if (h->next->Typ()!=INT_CMD)
1376      {
1377        WerrorS("poly,int expected");
1378        return TRUE;
1379      }
1380      if(((long)h->next->Data())==1L)
1381         return spectrumfProc(res,h);
1382      return spectrumProc(res,h);
1383    }
1384    else
1385  /*==================== semic =============================*/
1386    if(strcmp(sys_cmd,"semic") == 0)
1387    {
1388      if ((h->next!=NULL)
1389      && (h->Typ()==LIST_CMD)
1390      && (h->next->Typ()==LIST_CMD))
1391      {
1392        if (h->next->next==NULL)
1393          return semicProc(res,h,h->next);
1394        else if (h->next->next->Typ()==INT_CMD)
1395          return semicProc3(res,h,h->next,h->next->next);
1396      }
1397      return TRUE;
1398    }
1399    else
1400  /*==================== spadd =============================*/
1401    if(strcmp(sys_cmd,"spadd") == 0)
1402    {
1403      const short t[]={2,LIST_CMD,LIST_CMD};
1404      if (iiCheckTypes(h,t,1))
1405      {
1406        return spaddProc(res,h,h->next);
1407      }
1408      return TRUE;
1409    }
1410    else
1411  /*==================== spmul =============================*/
1412    if(strcmp(sys_cmd,"spmul") == 0)
1413    {
1414      const short t[]={2,LIST_CMD,INT_CMD};
1415      if (iiCheckTypes(h,t,1))
1416      {
1417        return spmulProc(res,h,h->next);
1418      }
1419      return TRUE;
1420    }
1421    else
1422  #endif
1423/*==================== tensorModuleMult ========================= */
1424  #define HAVE_SHEAFCOH_TRICKS 1
1425
1426  #ifdef HAVE_SHEAFCOH_TRICKS
1427    if(strcmp(sys_cmd,"tensorModuleMult")==0)
1428    {
1429      const short t[]={2,INT_CMD,MODUL_CMD};
1430  //      WarnS("tensorModuleMult!");
1431      if (iiCheckTypes(h,t,1))
1432      {
1433        int m = (int)( (long)h->Data() );
1434        ideal M = (ideal)h->next->Data();
1435        res->rtyp=MODUL_CMD;
1436        res->data=(void *)id_TensorModuleMult(m, M, currRing);
1437        return FALSE;
1438      }
1439      return TRUE;
1440    }
1441    else
1442  #endif
1443  /*==================== twostd  =================*/
1444  #ifdef HAVE_PLURAL
1445    if (strcmp(sys_cmd, "twostd") == 0)
1446    {
1447      ideal I;
1448      if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1449      {
1450        I=(ideal)h->CopyD();
1451        res->rtyp=IDEAL_CMD;
1452        if (rIsPluralRing(currRing)) res->data=twostd(I);
1453        else res->data=I;
1454        setFlag(res,FLAG_TWOSTD);
1455        setFlag(res,FLAG_STD);
1456      }
1457      else return TRUE;
1458      return FALSE;
1459    }
1460    else
1461  #endif
1462  /*==================== lie bracket =================*/
1463  #ifdef HAVE_PLURAL
1464    if (strcmp(sys_cmd, "bracket") == 0)
1465    {
1466      const short t[]={2,POLY_CMD,POLY_CMD};
1467      if (iiCheckTypes(h,t,1))
1468      {
1469        poly p=(poly)h->CopyD();
1470        h=h->next;
1471        poly q=(poly)h->Data();
1472        res->rtyp=POLY_CMD;
1473        if (rIsPluralRing(currRing))  res->data=nc_p_Bracket_qq(p,q, currRing);
1474        return FALSE;
1475      }
1476      return TRUE;
1477    }
1478    else
1479  #endif
1480  /*==================== env ==================================*/
1481  #ifdef HAVE_PLURAL
1482    if (strcmp(sys_cmd, "env")==0)
1483    {
1484      if ((h!=NULL) && (h->Typ()==RING_CMD))
1485      {
1486        ring r = (ring)h->Data();
1487        res->data = rEnvelope(r);
1488        res->rtyp = RING_CMD;
1489        return FALSE;
1490      }
1491      else
1492      {
1493        WerrorS("`system(\"env\",<ring>)` expected");
1494        return TRUE;
1495      }
1496    }
1497    else
1498  #endif
1499/* ============ opp ======================== */
1500  #ifdef HAVE_PLURAL
1501    if (strcmp(sys_cmd, "opp")==0)
1502    {
1503      if ((h!=NULL) && (h->Typ()==RING_CMD))
1504      {
1505        ring r=(ring)h->Data();
1506        res->data=rOpposite(r);
1507        res->rtyp=RING_CMD;
1508        return FALSE;
1509      }
1510      else
1511      {
1512        WerrorS("`system(\"opp\",<ring>)` expected");
1513        return TRUE;
1514      }
1515    }
1516    else
1517  #endif
1518  /*==================== oppose ==================================*/
1519  #ifdef HAVE_PLURAL
1520    if (strcmp(sys_cmd, "oppose")==0)
1521    {
1522      if ((h!=NULL) && (h->Typ()==RING_CMD)
1523      && (h->next!= NULL))
1524      {
1525        ring Rop = (ring)h->Data();
1526        h   = h->next;
1527        idhdl w;
1528        if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1529        {
1530          poly p = (poly)IDDATA(w);
1531          res->data = pOppose(Rop, p, currRing); // into CurrRing?
1532          res->rtyp = POLY_CMD;
1533          return FALSE;
1534        }
1535      }
1536      else
1537      {
1538        WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1539        return TRUE;
1540      }
1541    }
1542    else
1543  #endif
1544/*==================== sat =================*/
1545    if(strcmp(sys_cmd,"sat")==0)
1546    {
1547      ideal I= (ideal)h->Data();
1548      ideal J=(ideal)h->next->Data();
1549      int k;
1550      ideal S=idSaturate(I,J,k,h->Typ()==IDEAL_CMD);
1551      res->rtyp=h->Typ();
1552      res->data=(void*)S;
1553      setFlag(res,FLAG_STD);
1554      return FALSE;
1555    }
1556    else
1557  /*==================== walk stuff =================*/
1558  /*==================== walkNextWeight =================*/
1559  #ifdef HAVE_WALK
1560  #ifdef OWNW
1561    if (strcmp(sys_cmd, "walkNextWeight") == 0)
1562    {
1563      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1564      if (!iiCheckTypes(h,t,1)) return TRUE;
1565      if (((intvec*) h->Data())->length() != currRing->N ||
1566          ((intvec*) h->next->Data())->length() != currRing->N)
1567      {
1568        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1569               currRing->N);
1570        return TRUE;
1571      }
1572      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1573                                         ((intvec*) h->next->Data()),
1574                                         (ideal) h->next->next->Data());
1575      if (res->data == NULL || res->data == (void*) 1L)
1576      {
1577        res->rtyp = INT_CMD;
1578      }
1579      else
1580      {
1581        res->rtyp = INTVEC_CMD;
1582      }
1583      return FALSE;
1584    }
1585    else
1586  #endif
1587  #endif
1588  /*==================== walkNextWeight =================*/
1589  #ifdef HAVE_WALK
1590  #ifdef OWNW
1591    if (strcmp(sys_cmd, "walkInitials") == 0)
1592    {
1593      if (h == NULL || h->Typ() != IDEAL_CMD)
1594      {
1595        WerrorS("system(\"walkInitials\", ideal) expected");
1596        return TRUE;
1597      }
1598      res->data = (void*) walkInitials((ideal) h->Data());
1599      res->rtyp = IDEAL_CMD;
1600      return FALSE;
1601    }
1602    else
1603  #endif
1604  #endif
1605  /*==================== walkAddIntVec =================*/
1606  #ifdef HAVE_WALK
1607  #ifdef WAIV
1608    if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1609    {
1610      const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1611      if (!iiCheckTypes(h,t,1)) return TRUE;
1612      intvec* arg1 = (intvec*) h->Data();
1613      intvec* arg2 = (intvec*) h->next->Data();
1614      res->data = (intvec*) walkAddIntVec(arg1, arg2);
1615      res->rtyp = INTVEC_CMD;
1616      return FALSE;
1617    }
1618    else
1619  #endif
1620  #endif
1621  /*==================== MwalkNextWeight =================*/
1622  #ifdef HAVE_WALK
1623  #ifdef MwaklNextWeight
1624    if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1625    {
1626      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1627      if (!iiCheckTypes(h,t,1)) return TRUE;
1628      if (((intvec*) h->Data())->length() != currRing->N ||
1629        ((intvec*) h->next->Data())->length() != currRing->N)
1630      {
1631        Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1632               currRing->N);
1633        return TRUE;
1634      }
1635      intvec* arg1 = (intvec*) h->Data();
1636      intvec* arg2 = (intvec*) h->next->Data();
1637      ideal arg3   =   (ideal) h->next->next->Data();
1638      intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1639      res->rtyp = INTVEC_CMD;
1640      res->data =  result;
1641      return FALSE;
1642    }
1643    else
1644  #endif //MWalkNextWeight
1645  #endif
1646  /*==================== Mivdp =================*/
1647  #ifdef HAVE_WALK
1648    if(strcmp(sys_cmd, "Mivdp") == 0)
1649    {
1650      if (h == NULL || h->Typ() != INT_CMD)
1651      {
1652        WerrorS("system(\"Mivdp\", int) expected");
1653        return TRUE;
1654      }
1655      if ((int) ((long)(h->Data())) != currRing->N)
1656      {
1657        Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1658               currRing->N);
1659        return TRUE;
1660      }
1661      int arg1 = (int) ((long)(h->Data()));
1662      intvec* result = (intvec*) Mivdp(arg1);
1663      res->rtyp = INTVEC_CMD;
1664      res->data =  result;
1665      return FALSE;
1666    }
1667    else
1668  #endif
1669  /*==================== Mivlp =================*/
1670  #ifdef HAVE_WALK
1671    if(strcmp(sys_cmd, "Mivlp") == 0)
1672    {
1673      if (h == NULL || h->Typ() != INT_CMD)
1674      {
1675        WerrorS("system(\"Mivlp\", int) expected");
1676        return TRUE;
1677      }
1678      if ((int) ((long)(h->Data())) != currRing->N)
1679      {
1680        Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1681               currRing->N);
1682        return TRUE;
1683      }
1684      int arg1 = (int) ((long)(h->Data()));
1685      intvec* result = (intvec*) Mivlp(arg1);
1686      res->rtyp = INTVEC_CMD;
1687      res->data =  result;
1688      return FALSE;
1689    }
1690    else
1691  #endif
1692  /*==================== MpDiv =================*/
1693  #ifdef HAVE_WALK
1694  #ifdef MpDiv
1695    if(strcmp(sys_cmd, "MpDiv") == 0)
1696    {
1697      const short t[]={2,POLY_CMD,POLY_CMD};
1698      if (!iiCheckTypes(h,t,1)) return TRUE;
1699      poly arg1 = (poly) h->Data();
1700      poly arg2 = (poly) h->next->Data();
1701      poly result = MpDiv(arg1, arg2);
1702      res->rtyp = POLY_CMD;
1703      res->data = result;
1704      return FALSE;
1705    }
1706    else
1707  #endif
1708  #endif
1709  /*==================== MpMult =================*/
1710  #ifdef HAVE_WALK
1711  #ifdef MpMult
1712    if(strcmp(sys_cmd, "MpMult") == 0)
1713    {
1714      const short t[]={2,POLY_CMD,POLY_CMD};
1715      if (!iiCheckTypes(h,t,1)) return TRUE;
1716      poly arg1 = (poly) h->Data();
1717      poly arg2 = (poly) h->next->Data();
1718      poly result = MpMult(arg1, arg2);
1719      res->rtyp = POLY_CMD;
1720      res->data = result;
1721      return FALSE;
1722    }
1723    else
1724  #endif
1725  #endif
1726  /*==================== MivSame =================*/
1727  #ifdef HAVE_WALK
1728    if (strcmp(sys_cmd, "MivSame") == 0)
1729    {
1730      const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1731      if (!iiCheckTypes(h,t,1)) return TRUE;
1732      /*
1733      if (((intvec*) h->Data())->length() != currRing->N ||
1734      ((intvec*) h->next->Data())->length() != currRing->N)
1735      {
1736        Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1737               currRing->N);
1738        return TRUE;
1739      }
1740      */
1741      intvec* arg1 = (intvec*) h->Data();
1742      intvec* arg2 = (intvec*) h->next->Data();
1743      /*
1744      poly result = (poly) MivSame(arg1, arg2);
1745      res->rtyp = POLY_CMD;
1746      res->data =  (poly) result;
1747      */
1748      res->rtyp = INT_CMD;
1749      res->data = (void*)(long) MivSame(arg1, arg2);
1750      return FALSE;
1751    }
1752    else
1753  #endif
1754  /*==================== M3ivSame =================*/
1755  #ifdef HAVE_WALK
1756    if (strcmp(sys_cmd, "M3ivSame") == 0)
1757    {
1758      const short t[]={3,INTVEC_CMD,INTVEC_CMD,INTVEC_CMD};
1759      if (!iiCheckTypes(h,t,1)) return TRUE;
1760      /*
1761      if (((intvec*) h->Data())->length() != currRing->N ||
1762        ((intvec*) h->next->Data())->length() != currRing->N ||
1763        ((intvec*) h->next->next->Data())->length() != currRing->N )
1764      {
1765        Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1766              currRing->N);
1767        return TRUE;
1768      }
1769      */
1770      intvec* arg1 = (intvec*) h->Data();
1771      intvec* arg2 = (intvec*) h->next->Data();
1772      intvec* arg3 = (intvec*) h->next->next->Data();
1773      /*
1774      poly result = (poly) M3ivSame(arg1, arg2, arg3);
1775      res->rtyp = POLY_CMD;
1776      res->data =  (poly) result;
1777      */
1778      res->rtyp = INT_CMD;
1779      res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1780      return FALSE;
1781    }
1782    else
1783  #endif
1784  /*==================== MwalkInitialForm =================*/
1785  #ifdef HAVE_WALK
1786    if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1787    {
1788      const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1789      if (!iiCheckTypes(h,t,1)) return TRUE;
1790      if(((intvec*) h->next->Data())->length() != currRing->N)
1791      {
1792        Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1793               currRing->N);
1794        return TRUE;
1795      }
1796      ideal id      = (ideal) h->Data();
1797      intvec* int_w = (intvec*) h->next->Data();
1798      ideal result  = (ideal) MwalkInitialForm(id, int_w);
1799      res->rtyp = IDEAL_CMD;
1800      res->data = result;
1801      return FALSE;
1802    }
1803    else
1804  #endif
1805  /*==================== MivMatrixOrder =================*/
1806  #ifdef HAVE_WALK
1807    /************** Perturbation walk **********/
1808    if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1809    {
1810      if(h==NULL || h->Typ() != INTVEC_CMD)
1811      {
1812        WerrorS("system(\"MivMatrixOrder\",intvec) expected");
1813        return TRUE;
1814      }
1815      intvec* arg1 = (intvec*) h->Data();
1816      intvec* result = MivMatrixOrder(arg1);
1817      res->rtyp = INTVEC_CMD;
1818      res->data =  result;
1819      return FALSE;
1820    }
1821    else
1822  #endif
1823  /*==================== MivMatrixOrderdp =================*/
1824  #ifdef HAVE_WALK
1825    if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1826    {
1827      if(h==NULL || h->Typ() != INT_CMD)
1828      {
1829        WerrorS("system(\"MivMatrixOrderdp\",intvec) expected");
1830        return TRUE;
1831      }
1832      int arg1 = (int) ((long)(h->Data()));
1833      intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1834      res->rtyp = INTVEC_CMD;
1835      res->data =  result;
1836      return FALSE;
1837    }
1838    else
1839  #endif
1840  /*==================== MPertVectors =================*/
1841  #ifdef HAVE_WALK
1842    if(strcmp(sys_cmd, "MPertVectors") == 0)
1843    {
1844      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1845      if (!iiCheckTypes(h,t,1)) return TRUE;
1846      ideal arg1 = (ideal) h->Data();
1847      intvec* arg2 = (intvec*) h->next->Data();
1848      int arg3 = (int) ((long)(h->next->next->Data()));
1849      intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1850      res->rtyp = INTVEC_CMD;
1851      res->data =  result;
1852      return FALSE;
1853    }
1854    else
1855  #endif
1856  /*==================== MPertVectorslp =================*/
1857  #ifdef HAVE_WALK
1858    if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1859    {
1860      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1861      if (!iiCheckTypes(h,t,1)) return TRUE;
1862      ideal arg1 = (ideal) h->Data();
1863      intvec* arg2 = (intvec*) h->next->Data();
1864      int arg3 = (int) ((long)(h->next->next->Data()));
1865      intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1866      res->rtyp = INTVEC_CMD;
1867      res->data =  result;
1868      return FALSE;
1869    }
1870    else
1871  #endif
1872    /************** fractal walk **********/
1873  #ifdef HAVE_WALK
1874    if(strcmp(sys_cmd, "Mfpertvector") == 0)
1875    {
1876      const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1877      if (!iiCheckTypes(h,t,1)) return TRUE;
1878      ideal arg1 = (ideal) h->Data();
1879      intvec* arg2 = (intvec*) h->next->Data();
1880      intvec* result = Mfpertvector(arg1, arg2);
1881      res->rtyp = INTVEC_CMD;
1882      res->data =  result;
1883      return FALSE;
1884    }
1885    else
1886  #endif
1887  /*==================== MivUnit =================*/
1888  #ifdef HAVE_WALK
1889    if(strcmp(sys_cmd, "MivUnit") == 0)
1890    {
1891      const short t[]={1,INT_CMD};
1892      if (!iiCheckTypes(h,t,1)) return TRUE;
1893      int arg1 = (int) ((long)(h->Data()));
1894      intvec* result = (intvec*) MivUnit(arg1);
1895      res->rtyp = INTVEC_CMD;
1896      res->data =  result;
1897      return FALSE;
1898    }
1899    else
1900  #endif
1901  /*==================== MivWeightOrderlp =================*/
1902  #ifdef HAVE_WALK
1903    if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1904    {
1905      const short t[]={1,INTVEC_CMD};
1906      if (!iiCheckTypes(h,t,1)) return TRUE;
1907      intvec* arg1 = (intvec*) h->Data();
1908      intvec* result = MivWeightOrderlp(arg1);
1909      res->rtyp = INTVEC_CMD;
1910      res->data =  result;
1911      return FALSE;
1912    }
1913    else
1914  #endif
1915  /*==================== MivWeightOrderdp =================*/
1916  #ifdef HAVE_WALK
1917    if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1918    {
1919      if(h==NULL || h->Typ() != INTVEC_CMD)
1920      {
1921        WerrorS("system(\"MivWeightOrderdp\",intvec) expected");
1922        return TRUE;
1923      }
1924      intvec* arg1 = (intvec*) h->Data();
1925      //int arg2 = (int) h->next->Data();
1926      intvec* result = MivWeightOrderdp(arg1);
1927      res->rtyp = INTVEC_CMD;
1928      res->data =  result;
1929      return FALSE;
1930    }
1931    else
1932  #endif
1933  /*==================== MivMatrixOrderlp =================*/
1934  #ifdef HAVE_WALK
1935    if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1936    {
1937      if(h==NULL || h->Typ() != INT_CMD)
1938      {
1939        WerrorS("system(\"MivMatrixOrderlp\",int) expected");
1940        return TRUE;
1941      }
1942      int arg1 = (int) ((long)(h->Data()));
1943      intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1944      res->rtyp = INTVEC_CMD;
1945      res->data =  result;
1946      return FALSE;
1947    }
1948    else
1949  #endif
1950  /*==================== MkInterRedNextWeight =================*/
1951  #ifdef HAVE_WALK
1952    if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1953    {
1954      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1955      if (!iiCheckTypes(h,t,1)) return TRUE;
1956      if (((intvec*) h->Data())->length() != currRing->N ||
1957        ((intvec*) h->next->Data())->length() != currRing->N)
1958      {
1959        Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1960                 currRing->N);
1961        return TRUE;
1962      }
1963      intvec* arg1 = (intvec*) h->Data();
1964      intvec* arg2 = (intvec*) h->next->Data();
1965      ideal arg3   =   (ideal) h->next->next->Data();
1966      intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1967      res->rtyp = INTVEC_CMD;
1968      res->data =  result;
1969      return FALSE;
1970    }
1971    else
1972  #endif
1973  /*==================== MPertNextWeight =================*/
1974  #ifdef HAVE_WALK
1975  #ifdef MPertNextWeight
1976    if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1977    {
1978      const short t[]={3,INTVEC_CMD,IDEAL_CMD,INT_CMD};
1979      if (!iiCheckTypes(h,t,1)) return TRUE;
1980      if (((intvec*) h->Data())->length() != currRing->N)
1981      {
1982        Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1983                 currRing->N);
1984        return TRUE;
1985      }
1986      intvec* arg1 = (intvec*) h->Data();
1987      ideal arg2 = (ideal) h->next->Data();
1988      int arg3   =   (int) h->next->next->Data();
1989      intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1990      res->rtyp = INTVEC_CMD;
1991      res->data =  result;
1992      return FALSE;
1993    }
1994    else
1995  #endif //MPertNextWeight
1996  #endif
1997  /*==================== Mivperttarget =================*/
1998  #ifdef HAVE_WALK
1999  #ifdef Mivperttarget
2000    if (strcmp(sys_cmd, "Mivperttarget") == 0)
2001    {
2002      const short t[]={2,IDEAL_CMD,INT_CMD};
2003      if (!iiCheckTypes(h,t,1)) return TRUE;
2004      ideal arg1 = (ideal) h->Data();
2005      int arg2 = (int) h->next->Data();
2006      intvec* result = (intvec*) Mivperttarget(arg1, arg2);
2007      res->rtyp = INTVEC_CMD;
2008      res->data =  result;
2009      return FALSE;
2010    }
2011    else
2012  #endif //Mivperttarget
2013  #endif
2014  /*==================== Mwalk =================*/
2015  #ifdef HAVE_WALK
2016    if (strcmp(sys_cmd, "Mwalk") == 0)
2017    {
2018      const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD,INT_CMD,INT_CMD};
2019      if (!iiCheckTypes(h,t,1)) return TRUE;
2020      if (((intvec*) h->next->Data())->length() != currRing->N &&
2021        ((intvec*) h->next->next->Data())->length() != currRing->N )
2022      {
2023        Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
2024           currRing->N);
2025        return TRUE;
2026      }
2027      ideal arg1 = (ideal) h->CopyD();
2028      intvec* arg2 = (intvec*) h->next->Data();
2029      intvec* arg3 = (intvec*) h->next->next->Data();
2030      ring arg4 = (ring) h->next->next->next->Data();
2031      int arg5 = (int) (long) h->next->next->next->next->Data();
2032      int arg6 = (int) (long) h->next->next->next->next->next->Data();
2033      ideal result = (ideal) Mwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2034      res->rtyp = IDEAL_CMD;
2035      res->data =  result;
2036      return FALSE;
2037    }
2038    else
2039  #endif
2040  /*==================== Mpwalk =================*/
2041  #ifdef HAVE_WALK
2042  #ifdef MPWALK_ORIG
2043    if (strcmp(sys_cmd, "Mwalk") == 0)
2044    {
2045      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
2046      if (!iiCheckTypes(h,t,1)) return TRUE;
2047      if ((((intvec*) h->next->Data())->length() != currRing->N &&
2048          ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2049          (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2050          ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N)))
2051      {
2052        Werror("system(\"Mwalk\" ...) intvecs not of length %d or %d\n",
2053               currRing->N,(currRing->N)*(currRing->N));
2054        return TRUE;
2055      }
2056      ideal arg1 = (ideal) h->Data();
2057      intvec* arg2 = (intvec*) h->next->Data();
2058      intvec* arg3   =  (intvec*) h->next->next->Data();
2059      ring arg4 = (ring) h->next->next->next->Data();
2060      ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
2061      res->rtyp = IDEAL_CMD;
2062      res->data =  result;
2063      return FALSE;
2064    }
2065    else
2066  #else
2067    if (strcmp(sys_cmd, "Mpwalk") == 0)
2068    {
2069      const short t[]={8,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
2070      if (!iiCheckTypes(h,t,1)) return TRUE;
2071      if(((intvec*) h->next->next->next->Data())->length() != currRing->N &&
2072         ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
2073      {
2074        Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",currRing->N);
2075        return TRUE;
2076      }
2077      ideal arg1 = (ideal) h->Data();
2078      int arg2 = (int) (long) h->next->Data();
2079      int arg3 = (int) (long) h->next->next->Data();
2080      intvec* arg4 = (intvec*) h->next->next->next->Data();
2081      intvec* arg5 = (intvec*) h->next->next->next->next->Data();
2082      int arg6 = (int) (long) h->next->next->next->next->next->Data();
2083      int arg7 = (int) (long) h->next->next->next->next->next->next->Data();
2084      int arg8 = (int) (long) h->next->next->next->next->next->next->next->Data();
2085      ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
2086      res->rtyp = IDEAL_CMD;
2087      res->data =  result;
2088      return FALSE;
2089    }
2090    else
2091    #endif
2092  #endif
2093  /*==================== Mrwalk =================*/
2094  #ifdef HAVE_WALK
2095    if (strcmp(sys_cmd, "Mrwalk") == 0)
2096    {
2097      const short t[]={7,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
2098      if (!iiCheckTypes(h,t,1)) return TRUE;
2099      if(((intvec*) h->next->Data())->length() != currRing->N &&
2100         ((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2101         ((intvec*) h->next->next->Data())->length() != currRing->N &&
2102         ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) )
2103      {
2104        Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2105               currRing->N,(currRing->N)*(currRing->N));
2106        return TRUE;
2107      }
2108      ideal arg1 = (ideal) h->Data();
2109      intvec* arg2 = (intvec*) h->next->Data();
2110      intvec* arg3 =  (intvec*) h->next->next->Data();
2111      int arg4 = (int)(long) h->next->next->next->Data();
2112      int arg5 = (int)(long) h->next->next->next->next->Data();
2113      int arg6 = (int)(long) h->next->next->next->next->next->Data();
2114      int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2115      ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
2116      res->rtyp = IDEAL_CMD;
2117      res->data =  result;
2118      return FALSE;
2119    }
2120    else
2121  #endif
2122  /*==================== MAltwalk1 =================*/
2123  #ifdef HAVE_WALK
2124    if (strcmp(sys_cmd, "MAltwalk1") == 0)
2125    {
2126      const short t[]={5,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD};
2127      if (!iiCheckTypes(h,t,1)) return TRUE;
2128      if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
2129        ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
2130      {
2131        Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
2132                 currRing->N);
2133        return TRUE;
2134      }
2135      ideal arg1 = (ideal) h->Data();
2136      int arg2 = (int) ((long)(h->next->Data()));
2137      int arg3 = (int) ((long)(h->next->next->Data()));
2138      intvec* arg4 = (intvec*) h->next->next->next->Data();
2139      intvec* arg5   =  (intvec*) h->next->next->next->next->Data();
2140      ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
2141      res->rtyp = IDEAL_CMD;
2142      res->data =  result;
2143      return FALSE;
2144    }
2145    else
2146  #endif
2147  /*==================== MAltwalk1 =================*/
2148  #ifdef HAVE_WALK
2149  #ifdef MFWALK_ALT
2150    if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
2151    {
2152      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2153      if (!iiCheckTypes(h,t,1)) return TRUE;
2154      if (((intvec*) h->next->Data())->length() != currRing->N &&
2155        ((intvec*) h->next->next->Data())->length() != currRing->N )
2156      {
2157        Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2158              currRing->N);
2159        return TRUE;
2160      }
2161      ideal arg1 = (ideal) h->Data();
2162      intvec* arg2 = (intvec*) h->next->Data();
2163      intvec* arg3   =  (intvec*) h->next->next->Data();
2164      int arg4 = (int) h->next->next->next->Data();
2165      ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
2166      res->rtyp = IDEAL_CMD;
2167      res->data =  result;
2168      return FALSE;
2169    }
2170    else
2171  #endif
2172  #endif
2173  /*==================== Mfwalk =================*/
2174  #ifdef HAVE_WALK
2175    if (strcmp(sys_cmd, "Mfwalk") == 0)
2176    {
2177      const short t[]={5,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD};
2178      if (!iiCheckTypes(h,t,1)) return TRUE;
2179      if (((intvec*) h->next->Data())->length() != currRing->N &&
2180        ((intvec*) h->next->next->Data())->length() != currRing->N )
2181      {
2182        Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2183                 currRing->N);
2184        return TRUE;
2185      }
2186      ideal arg1 = (ideal) h->Data();
2187      intvec* arg2 = (intvec*) h->next->Data();
2188      intvec* arg3 = (intvec*) h->next->next->Data();
2189      int arg4 = (int)(long) h->next->next->next->Data();
2190      int arg5 = (int)(long) h->next->next->next->next->Data();
2191      ideal result = (ideal) Mfwalk(arg1, arg2, arg3, arg4, arg5);
2192      res->rtyp = IDEAL_CMD;
2193      res->data =  result;
2194      return FALSE;
2195    }
2196    else
2197  #endif
2198  /*==================== Mfrwalk =================*/
2199  #ifdef HAVE_WALK
2200    if (strcmp(sys_cmd, "Mfrwalk") == 0)
2201    {
2202      const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
2203      if (!iiCheckTypes(h,t,1)) return TRUE;
2204/*
2205      if (((intvec*) h->next->Data())->length() != currRing->N &&
2206          ((intvec*) h->next->next->Data())->length() != currRing->N)
2207      {
2208        Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
2209        return TRUE;
2210      }
2211*/
2212      if((((intvec*) h->next->Data())->length() != currRing->N &&
2213         ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2214         (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2215         ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2216      {
2217        Werror("system(\"Mfrwalk\" ...) intvecs not of length %d or %d\n",
2218               currRing->N,(currRing->N)*(currRing->N));
2219        return TRUE;
2220      }
2221
2222      ideal arg1 = (ideal) h->Data();
2223      intvec* arg2 = (intvec*) h->next->Data();
2224      intvec* arg3 = (intvec*) h->next->next->Data();
2225      int arg4 = (int)(long) h->next->next->next->Data();
2226      int arg5 = (int)(long) h->next->next->next->next->Data();
2227      int arg6 = (int)(long) h->next->next->next->next->next->Data();
2228      ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2229      res->rtyp = IDEAL_CMD;
2230      res->data =  result;
2231      return FALSE;
2232    }
2233    else
2234  /*==================== Mprwalk =================*/
2235    if (strcmp(sys_cmd, "Mprwalk") == 0)
2236    {
2237      const short t[]={9,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
2238      if (!iiCheckTypes(h,t,1)) return TRUE;
2239      if((((intvec*) h->next->Data())->length() != currRing->N &&
2240         ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2241         (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2242         ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2243      {
2244        Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2245               currRing->N,(currRing->N)*(currRing->N));
2246        return TRUE;
2247      }
2248      ideal arg1 = (ideal) h->Data();
2249      intvec* arg2 = (intvec*) h->next->Data();
2250      intvec* arg3 =  (intvec*) h->next->next->Data();
2251      int arg4 = (int)(long) h->next->next->next->Data();
2252      int arg5 = (int)(long) h->next->next->next->next->Data();
2253      int arg6 = (int)(long) h->next->next->next->next->next->Data();
2254      int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2255      int arg8 = (int)(long) h->next->next->next->next->next->next->next->Data();
2256      int arg9 = (int)(long) h->next->next->next->next->next->next->next->next->Data();
2257      ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
2258      res->rtyp = IDEAL_CMD;
2259      res->data =  result;
2260      return FALSE;
2261    }
2262    else
2263  #endif
2264  /*==================== TranMImprovwalk =================*/
2265  #ifdef HAVE_WALK
2266  #ifdef TRAN_Orig
2267    if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2268    {
2269      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2270      if (!iiCheckTypes(h,t,1)) return TRUE;
2271      if (((intvec*) h->next->Data())->length() != currRing->N &&
2272        ((intvec*) h->next->next->Data())->length() != currRing->N )
2273      {
2274        Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2275              currRing->N);
2276        return TRUE;
2277      }
2278      ideal arg1 = (ideal) h->Data();
2279      intvec* arg2 = (intvec*) h->next->Data();
2280      intvec* arg3   =  (intvec*) h->next->next->Data();
2281      ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
2282      res->rtyp = IDEAL_CMD;
2283      res->data =  result;
2284      return FALSE;
2285    }
2286    else
2287  #endif
2288  #endif
2289  /*==================== MAltwalk2 =================*/
2290  #ifdef HAVE_WALK
2291    if (strcmp(sys_cmd, "MAltwalk2") == 0)
2292    {
2293      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2294      if (!iiCheckTypes(h,t,1)) return TRUE;
2295      if (((intvec*) h->next->Data())->length() != currRing->N &&
2296        ((intvec*) h->next->next->Data())->length() != currRing->N )
2297      {
2298        Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
2299                 currRing->N);
2300        return TRUE;
2301      }
2302      ideal arg1 = (ideal) h->Data();
2303      intvec* arg2 = (intvec*) h->next->Data();
2304      intvec* arg3   =  (intvec*) h->next->next->Data();
2305      ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
2306      res->rtyp = IDEAL_CMD;
2307      res->data =  result;
2308      return FALSE;
2309    }
2310    else
2311  #endif
2312  /*==================== MAltwalk2 =================*/
2313  #ifdef HAVE_WALK
2314    if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2315    {
2316      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2317      if (!iiCheckTypes(h,t,1)) return TRUE;
2318      if (((intvec*) h->next->Data())->length() != currRing->N &&
2319        ((intvec*) h->next->next->Data())->length() != currRing->N )
2320      {
2321        Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2322                 currRing->N);
2323        return TRUE;
2324      }
2325      ideal arg1 = (ideal) h->Data();
2326      intvec* arg2 = (intvec*) h->next->Data();
2327      intvec* arg3   =  (intvec*) h->next->next->Data();
2328      int arg4   =  (int) ((long)(h->next->next->next->Data()));
2329      ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
2330      res->rtyp = IDEAL_CMD;
2331      res->data =  result;
2332      return FALSE;
2333    }
2334    else
2335  #endif
2336  /*==================== TranMrImprovwalk =================*/
2337  #if 0
2338  #ifdef HAVE_WALK
2339    if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
2340    {
2341      if (h == NULL || h->Typ() != IDEAL_CMD ||
2342        h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2343        h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2344        h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
2345        h->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD ||
2346        h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD)
2347      {
2348        WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
2349        return TRUE;
2350      }
2351      if (((intvec*) h->next->Data())->length() != currRing->N &&
2352        ((intvec*) h->next->next->Data())->length() != currRing->N )
2353      {
2354        Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
2355        return TRUE;
2356      }
2357      ideal arg1 = (ideal) h->Data();
2358      intvec* arg2 = (intvec*) h->next->Data();
2359      intvec* arg3 = (intvec*) h->next->next->Data();
2360      int arg4 = (int)(long) h->next->next->next->Data();
2361      int arg5 = (int)(long) h->next->next->next->next->Data();
2362      int arg6 = (int)(long) h->next->next->next->next->next->Data();
2363      ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2364      res->rtyp = IDEAL_CMD;
2365      res->data =  result;
2366      return FALSE;
2367    }
2368    else
2369  #endif
2370  #endif
2371  /*================= Extended system call ========================*/
2372    {
2373       #ifndef MAKE_DISTRIBUTION
2374       return(jjEXTENDED_SYSTEM(res, args));
2375       #else
2376       Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
2377       #endif
2378    }
2379  } /* typ==string */
2380  return TRUE;
2381}
2382
2383
2384#ifdef HAVE_EXTENDED_SYSTEM
2385  // You can put your own system calls here
2386#  include "kernel/fglm/fglm.h"
2387#  ifdef HAVE_NEWTON
2388#    include "hc_newton.h"
2389#  endif
2390
2391static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
2392{
2393    if(h->Typ() == STRING_CMD)
2394    {
2395      char *sys_cmd=(char *)(h->Data());
2396      h=h->next;
2397  /*==================== test syz strat =================*/
2398      if (strcmp(sys_cmd, "syz") == 0)
2399      {
2400         if ((h!=NULL) && (h->Typ()==STRING_CMD))
2401         {
2402           const char *s=(const char *)h->Data();
2403           if (strcmp(s,"posInT_EcartFDegpLength")==0)
2404             test_PosInT=posInT_EcartFDegpLength;
2405           else if (strcmp(s,"posInT_FDegpLength")==0)
2406             test_PosInT=posInT_FDegpLength;
2407           else if (strcmp(s,"posInT_pLength")==0)
2408             test_PosInT=posInT_pLength;
2409           else if (strcmp(s,"posInT0")==0)
2410             test_PosInT=posInT0;
2411           else if (strcmp(s,"posInT1")==0)
2412             test_PosInT=posInT1;
2413           else if (strcmp(s,"posInT2")==0)
2414             test_PosInT=posInT2;
2415           else if (strcmp(s,"posInT11")==0)
2416             test_PosInT=posInT11;
2417           else if (strcmp(s,"posInT110")==0)
2418             test_PosInT=posInT110;
2419           else if (strcmp(s,"posInT13")==0)
2420             test_PosInT=posInT13;
2421           else if (strcmp(s,"posInT15")==0)
2422             test_PosInT=posInT15;
2423           else if (strcmp(s,"posInT17")==0)
2424             test_PosInT=posInT17;
2425           else if (strcmp(s,"posInT17_c")==0)
2426             test_PosInT=posInT17_c;
2427           else if (strcmp(s,"posInT19")==0)
2428             test_PosInT=posInT19;
2429           else PrintS("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2430         }
2431         else
2432         {
2433           test_PosInT=NULL;
2434           test_PosInL=NULL;
2435         }
2436         si_opt_2|=Sy_bit(23);
2437         return FALSE;
2438      }
2439      else
2440  /*==================== locNF ======================================*/
2441      if(strcmp(sys_cmd,"locNF")==0)
2442      {
2443        const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2444        if (iiCheckTypes(h,t,1))
2445        {
2446          poly f=(poly)h->Data();
2447          h=h->next;
2448          ideal m=(ideal)h->Data();
2449          assumeStdFlag(h);
2450          h=h->next;
2451          int n=(int)((long)h->Data());
2452          h=h->next;
2453          intvec *v=(intvec *)h->Data();
2454
2455          /* == now the work starts == */
2456
2457          int * iv=iv2array(v, currRing);
2458          poly r=0;
2459          poly hp=ppJetW(f,n,iv);
2460          int s=MATCOLS(m);
2461          int j=0;
2462          matrix T=mp_InitI(s,1,0, currRing);
2463
2464          while (hp != NULL)
2465          {
2466            if (pDivisibleBy(m->m[j],hp))
2467            {
2468              if (MATELEM(T,j+1,1)==0)
2469              {
2470                MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2471              }
2472              else
2473              {
2474                pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2475              }
2476              hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2477              j=0;
2478            }
2479            else
2480            {
2481              if (j==s-1)
2482              {
2483                r=pAdd(r,pHead(hp));
2484                hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2485                j=0;
2486              }
2487              else
2488              {
2489                j++;
2490              }
2491            }
2492          }
2493
2494          matrix Temp=mp_Transp((matrix) id_Vec2Ideal(r, currRing), currRing);
2495          matrix R=mpNew(MATCOLS((matrix) id_Vec2Ideal(f, currRing)),1);
2496          for (int k=1;k<=MATROWS(Temp);k++)
2497          {
2498            MATELEM(R,k,1)=MATELEM(Temp,k,1);
2499          }
2500
2501          lists L=(lists)omAllocBin(slists_bin);
2502          L->Init(2);
2503          L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)R;
2504          L->m[1].rtyp=MATRIX_CMD;   L->m[1].data=(void *)T;
2505          res->data=L;
2506          res->rtyp=LIST_CMD;
2507          // iv aufraeumen
2508          omFree(iv);
2509          return FALSE;
2510        }
2511        else
2512          return TRUE;
2513      }
2514      else
2515  /*==================== poly debug ==================================*/
2516        if(strcmp(sys_cmd,"p")==0)
2517        {
2518#  ifdef RDEBUG
2519          p_DebugPrint((poly)h->Data(), currRing);
2520#  else
2521          WarnS("Sorry: not available for release build!");
2522#  endif
2523          return FALSE;
2524        }
2525        else
2526  /*==================== setsyzcomp ==================================*/
2527      if(strcmp(sys_cmd,"setsyzcomp")==0)
2528      {
2529        if ((h!=NULL) && (h->Typ()==INT_CMD))
2530        {
2531          int k = (int)(long)h->Data();
2532          if ( currRing->order[0] == ringorder_s )
2533          {
2534            rSetSyzComp(k, currRing);
2535          }
2536        }
2537      }
2538  /*==================== ring debug ==================================*/
2539        if(strcmp(sys_cmd,"r")==0)
2540        {
2541#  ifdef RDEBUG
2542          rDebugPrint((ring)h->Data());
2543#  else
2544          WarnS("Sorry: not available for release build!");
2545#  endif
2546          return FALSE;
2547        }
2548        else
2549  /*==================== changeRing ========================*/
2550        /* The following code changes the names of the variables in the
2551           current ring to "x1", "x2", ..., "xN", where N is the number
2552           of variables in the current ring.
2553           The purpose of this rewriting is to eliminate indexed variables,
2554           as they may cause problems when generating scripts for Magma,
2555           Maple, or Macaulay2. */
2556        if(strcmp(sys_cmd,"changeRing")==0)
2557        {
2558          int varN = currRing->N;
2559          char h[10];
2560          for (int i = 1; i <= varN; i++)
2561          {
2562            omFree(currRing->names[i - 1]);
2563            snprintf(h,10, "x%d", i);
2564            currRing->names[i - 1] = omStrDup(h);
2565          }
2566          rComplete(currRing);
2567          res->rtyp = INT_CMD;
2568          res->data = (void*)0L;
2569          return FALSE;
2570        }
2571        else
2572  /*==================== mtrack ==================================*/
2573      if(strcmp(sys_cmd,"mtrack")==0)
2574      {
2575  #ifdef OM_TRACK
2576        om_Opts.MarkAsStatic = 1;
2577        FILE *fd = NULL;
2578        int max = 5;
2579        while (h != NULL)
2580        {
2581          omMarkAsStaticAddr(h);
2582          if (fd == NULL && h->Typ()==STRING_CMD)
2583          {
2584            char *fn=(char*) h->Data();
2585            fd = fopen(fn, "w");
2586            if (fd == NULL)
2587              Warn("Can not open %s for writing og mtrack. Using stdout",fn);
2588          }
2589          else if (h->Typ() == INT_CMD)
2590          {
2591            max = (int)(long)h->Data();
2592          }
2593          h = h->Next();
2594        }
2595        omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2596        if (fd != NULL) fclose(fd);
2597        om_Opts.MarkAsStatic = 0;
2598        return FALSE;
2599  #else
2600        WerrorS("system(\"mtrack\",..) is not implemented in this version");
2601        return TRUE;
2602  #endif
2603      }
2604      else
2605  /*==================== backtrace ==================================*/
2606  #ifndef OM_NDEBUG
2607      if(strcmp(sys_cmd,"backtrace")==0)
2608      {
2609        omPrintCurrentBackTrace(stdout);
2610        return FALSE;
2611      }
2612      else
2613  #endif
2614
2615#if !defined(OM_NDEBUG)
2616  /*==================== omMemoryTest ==================================*/
2617      if (strcmp(sys_cmd,"omMemoryTest")==0)
2618      {
2619
2620#ifdef OM_STATS_H
2621        PrintS("\n[om_Info]: \n");
2622        omUpdateInfo();
2623#define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2624        OM_PRINT(MaxBytesSystem);
2625        OM_PRINT(CurrentBytesSystem);
2626        OM_PRINT(MaxBytesSbrk);
2627        OM_PRINT(CurrentBytesSbrk);
2628        OM_PRINT(MaxBytesMmap);
2629        OM_PRINT(CurrentBytesMmap);
2630        OM_PRINT(UsedBytes);
2631        OM_PRINT(AvailBytes);
2632        OM_PRINT(UsedBytesMalloc);
2633        OM_PRINT(AvailBytesMalloc);
2634        OM_PRINT(MaxBytesFromMalloc);
2635        OM_PRINT(CurrentBytesFromMalloc);
2636        OM_PRINT(MaxBytesFromValloc);
2637        OM_PRINT(CurrentBytesFromValloc);
2638        OM_PRINT(UsedBytesFromValloc);
2639        OM_PRINT(AvailBytesFromValloc);
2640        OM_PRINT(MaxPages);
2641        OM_PRINT(UsedPages);
2642        OM_PRINT(AvailPages);
2643        OM_PRINT(MaxRegionsAlloc);
2644        OM_PRINT(CurrentRegionsAlloc);
2645#undef OM_PRINT
2646#endif
2647
2648#ifdef OM_OPTS_H
2649        PrintS("\n[om_Opts]: \n");
2650#define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2651        OM_PRINT("d", MinTrack);
2652        OM_PRINT("d", MinCheck);
2653        OM_PRINT("d", MaxTrack);
2654        OM_PRINT("d", MaxCheck);
2655        OM_PRINT("d", Keep);
2656        OM_PRINT("d", HowToReportErrors);
2657        OM_PRINT("d", MarkAsStatic);
2658        OM_PRINT("u", PagesPerRegion);
2659        OM_PRINT("p", OutOfMemoryFunc);
2660        OM_PRINT("p", MemoryLowFunc);
2661        OM_PRINT("p", ErrorHook);
2662#undef OM_PRINT
2663#endif
2664
2665#ifdef OM_ERROR_H
2666        Print("\n\n[om_ErrorStatus]        : '%s' (%s)\n",
2667                omError2String(om_ErrorStatus),
2668                omError2Serror(om_ErrorStatus));
2669        Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2670                omError2String(om_InternalErrorStatus),
2671                omError2Serror(om_InternalErrorStatus));
2672
2673#endif
2674
2675//        omTestMemory(1);
2676//        omtTestErrors();
2677        return FALSE;
2678      }
2679      else
2680#endif
2681  /*==================== red =============================*/
2682  #if 0
2683      if(strcmp(sys_cmd,"red")==0)
2684      {
2685        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2686        {
2687          res->rtyp=IDEAL_CMD;
2688          res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2689          setFlag(res,FLAG_STD);
2690          return FALSE;
2691        }
2692        else
2693          WerrorS("ideal expected");
2694      }
2695      else
2696  #endif
2697  /*==================== fastcomb =============================*/
2698      if(strcmp(sys_cmd,"fastcomb")==0)
2699      {
2700        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2701        {
2702          if (h->next!=NULL)
2703          {
2704            if (h->next->Typ()!=POLY_CMD)
2705            {
2706              WarnS("Wrong types for poly= comb(ideal,poly)");
2707            }
2708          }
2709          res->rtyp=POLY_CMD;
2710          res->data=(void *) fglmLinearCombination(
2711                             (ideal)h->Data(),(poly)h->next->Data());
2712          return FALSE;
2713        }
2714        else
2715          WerrorS("ideal expected");
2716      }
2717      else
2718  /*==================== comb =============================*/
2719      if(strcmp(sys_cmd,"comb")==0)
2720      {
2721        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2722        {
2723          if (h->next!=NULL)
2724          {
2725            if (h->next->Typ()!=POLY_CMD)
2726            {
2727                WarnS("Wrong types for poly= comb(ideal,poly)");
2728            }
2729          }
2730          res->rtyp=POLY_CMD;
2731          res->data=(void *)fglmNewLinearCombination(
2732                              (ideal)h->Data(),(poly)h->next->Data());
2733          return FALSE;
2734        }
2735        else
2736          WerrorS("ideal expected");
2737      }
2738      else
2739  #if 0 /* debug only */
2740  /*==================== listall ===================================*/
2741      if(strcmp(sys_cmd,"listall")==0)
2742      {
2743        void listall(int showproc);
2744        int showproc=0;
2745        if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2746        listall(showproc);
2747        return FALSE;
2748      }
2749      else
2750  #endif
2751  #if 0 /* debug only */
2752  /*==================== proclist =================================*/
2753      if(strcmp(sys_cmd,"proclist")==0)
2754      {
2755        void piShowProcList();
2756        piShowProcList();
2757        return FALSE;
2758      }
2759      else
2760  #endif
2761  /* ==================== newton ================================*/
2762  #ifdef HAVE_NEWTON
2763      if(strcmp(sys_cmd,"newton")==0)
2764      {
2765        if ((h->Typ()!=POLY_CMD)
2766        || (h->next->Typ()!=INT_CMD)
2767        || (h->next->next->Typ()!=INT_CMD))
2768        {
2769          WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2770          return TRUE;
2771        }
2772        poly  p=(poly)(h->Data());
2773        int l=pLength(p);
2774        short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2775        int i,j,k;
2776        k=0;
2777        poly pp=p;
2778        for (i=0;pp!=NULL;i++)
2779        {
2780          for(j=1;j<=currRing->N;j++)
2781          {
2782            points[k]=pGetExp(pp,j);
2783            k++;
2784          }
2785          pIter(pp);
2786        }
2787        hc_ERG r=hc_KOENIG(currRing->N,      // dimension
2788                  l,      // number of points
2789                  (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
2790                  currRing->OrdSgn==-1,
2791                  (int) (h->next->Data()),      // 1: Milnor, 0: Newton
2792                  (int) (h->next->next->Data()) // debug
2793                 );
2794        //----<>---Output-----------------------
2795
2796
2797  //  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2798
2799
2800        lists L=(lists)omAllocBin(slists_bin);
2801        L->Init(6);
2802        L->m[0].rtyp=STRING_CMD;               // newtonnumber;
2803        L->m[0].data=(void *)omStrDup(r.nZahl);
2804        L->m[1].rtyp=INT_CMD;
2805        L->m[1].data=(void *)(long)r.achse;          // flag for unoccupied axes
2806        L->m[2].rtyp=INT_CMD;
2807        L->m[2].data=(void *)(long)r.deg;            // #degenerations
2808        if ( r.deg != 0)              // only if degenerations exist
2809        {
2810          L->m[3].rtyp=INT_CMD;
2811          L->m[3].data=(void *)(long)r.anz_punkte;     // #points
2812          //---<>--number of points------
2813          int anz = r.anz_punkte;    // number of points
2814          int dim = (currRing->N);     // dimension
2815          intvec* v = new intvec( anz*dim );
2816          for (i=0; i<anz*dim; i++)    // copy points
2817            (*v)[i] = r.pu[i];
2818          L->m[4].rtyp=INTVEC_CMD;
2819          L->m[4].data=(void *)v;
2820          //---<>--degenerations---------
2821          int deg = r.deg;    // number of points
2822          intvec* w = new intvec( r.speicher );  // necessary memory
2823          i=0;               // start copying
2824          do
2825          {
2826            (*w)[i] = r.deg_tab[i];
2827            i++;
2828          }
2829          while (r.deg_tab[i-1] != -2);   // mark for end of list
2830          L->m[5].rtyp=INTVEC_CMD;
2831          L->m[5].data=(void *)w;
2832        }
2833        else
2834        {
2835          L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2836          L->m[4].rtyp=DEF_CMD;
2837          L->m[5].rtyp=DEF_CMD;
2838        }
2839
2840        res->data=(void *)L;
2841        res->rtyp=LIST_CMD;
2842        // free all pointer in r:
2843        delete[] r.nZahl;
2844        delete[] r.pu;
2845        delete[] r.deg_tab;      // Ist das ein Problem??
2846
2847        omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2848        return FALSE;
2849      }
2850      else
2851  #endif
2852  /*==== connection to Sebastian Jambor's code ======*/
2853  /* This code connects Sebastian Jambor's code for
2854     computing the minimal polynomial of an (n x n) matrix
2855     with entries in F_p to SINGULAR. Two conversion methods
2856     are needed; see further up in this file:
2857        (1) conversion of a matrix with long entries to
2858            a SINGULAR matrix with number entries, where
2859            the numbers are coefficients in currRing;
2860        (2) conversion of an array of longs (encoding the
2861            coefficients of the minimal polynomial) to a
2862            SINGULAR poly living in currRing. */
2863      if (strcmp(sys_cmd, "minpoly") == 0)
2864      {
2865        if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2866        {
2867          Werror("expected exactly one argument: %s",
2868                 "a square matrix with number entries");
2869          return TRUE;
2870        }
2871        else
2872        {
2873          matrix m = (matrix)h->Data();
2874          int n = m->rows();
2875          unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2876          if (n != m->cols())
2877          {
2878            WerrorS("expected exactly one argument: "
2879                   "a square matrix with number entries");
2880            return TRUE;
2881          }
2882          unsigned long** ml = singularMatrixToLongMatrix(m);
2883          unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2884          poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2885          res->rtyp = POLY_CMD;
2886          res->data = (void *)theMinPoly;
2887          for (int i = 0; i < n; i++) delete[] ml[i];
2888          delete[] ml;
2889          delete[] polyCoeffs;
2890          return FALSE;
2891        }
2892      }
2893      else
2894  /*==================== sdb_flags =================*/
2895  #ifdef HAVE_SDB
2896      if (strcmp(sys_cmd, "sdb_flags") == 0)
2897      {
2898        if ((h!=NULL) && (h->Typ()==INT_CMD))
2899        {
2900          sdb_flags=(int)((long)h->Data());
2901        }
2902        else
2903        {
2904          WerrorS("system(\"sdb_flags\",`int`) expected");
2905          return TRUE;
2906        }
2907        return FALSE;
2908      }
2909      else
2910  #endif
2911  /*==================== sdb_edit =================*/
2912  #ifdef HAVE_SDB
2913      if (strcmp(sys_cmd, "sdb_edit") == 0)
2914      {
2915        if (FE_OPT_NO_SHELL_FLAG)
2916        {
2917          WerrorS("shell execution is disallowed in restricted mode");
2918          return TRUE;
2919        }
2920        if ((h!=NULL) && (h->Typ()==PROC_CMD))
2921        {
2922          procinfov p=(procinfov)h->Data();
2923          sdb_edit(p);
2924        }
2925        else
2926        {
2927          WerrorS("system(\"sdb_edit\",`proc`) expected");
2928          return TRUE;
2929        }
2930        return FALSE;
2931      }
2932      else
2933  #endif
2934  /*==================== GF =================*/
2935  #if 0 // for testing only
2936      if (strcmp(sys_cmd, "GF") == 0)
2937      {
2938        if ((h!=NULL) && (h->Typ()==POLY_CMD))
2939        {
2940          int c=rChar(currRing);
2941          setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2942          CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2943          res->rtyp=POLY_CMD;
2944          res->data=convFactoryGFSingGF( F, currRing );
2945          return FALSE;
2946        }
2947        else { WerrorS("wrong typ"); return TRUE;}
2948      }
2949      else
2950  #endif
2951  /*==================== SVD =================*/
2952  #ifdef HAVE_SVD
2953       if (strcmp(sys_cmd, "svd") == 0)
2954       {
2955            extern lists testsvd(matrix M);
2956              res->rtyp=LIST_CMD;
2957            res->data=(char*)(testsvd((matrix)h->Data()));
2958            return FALSE;
2959       }
2960       else
2961  #endif
2962  /*==================== redNF_ring =================*/
2963      if (strcmp(sys_cmd, "redNF_ring")==0)
2964      {
2965        ring r = currRing;
2966        poly f = (poly) h->Data();
2967        h = h->next;
2968        ideal G = (ideal) h->Data();
2969        res->rtyp=POLY_CMD;
2970        res->data=(poly) ringRedNF(f, G, r);
2971        return(FALSE);
2972      }
2973      else
2974  /*==================== Roune Hilb  =================*/
2975       if (strcmp(sys_cmd, "hilbroune") == 0)
2976       {
2977         if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2978         {
2979           slicehilb((ideal)h->Data());
2980         }
2981         else return TRUE;
2982         return FALSE;
2983       }
2984      else
2985  /*==================== F5 Implementation =================*/
2986  #ifdef HAVE_F5
2987      if (strcmp(sys_cmd, "f5")==0)
2988      {
2989        if (h->Typ()!=IDEAL_CMD)
2990        {
2991          WerrorS("ideal expected");
2992          return TRUE;
2993        }
2994
2995        ring r = currRing;
2996        ideal G = (ideal) h->Data();
2997        h = h->next;
2998        int opt;
2999        if(h != NULL) {
3000          opt = (int) (long) h->Data();
3001        }
3002        else {
3003          opt = 2;
3004        }
3005        h = h->next;
3006        int plus;
3007        if(h != NULL) {
3008          plus = (int) (long) h->Data();
3009        }
3010        else {
3011          plus = 0;
3012        }
3013        h = h->next;
3014        int termination;
3015        if(h != NULL) {
3016          termination = (int) (long) h->Data();
3017        }
3018        else {
3019          termination = 0;
3020        }
3021        res->rtyp=IDEAL_CMD;
3022        res->data=(ideal) F5main(G,r,opt,plus,termination);
3023        return FALSE;
3024      }
3025      else
3026  #endif
3027  /*==================== Testing groebner basis =================*/
3028      if (strcmp(sys_cmd, "NF_ring")==0)
3029      {
3030        ring r = currRing;
3031        poly f = (poly) h->Data();
3032        h = h->next;
3033        ideal G = (ideal) h->Data();
3034        res->rtyp=POLY_CMD;
3035        res->data=(poly) ringNF(f, G, r);
3036        return(FALSE);
3037      }
3038      else
3039      if (strcmp(sys_cmd, "spoly")==0)
3040      {
3041        poly f = pCopy((poly) h->Data());
3042        h = h->next;
3043        poly g = pCopy((poly) h->Data());
3044
3045        res->rtyp=POLY_CMD;
3046        res->data=(poly) plain_spoly(f,g);
3047        return(FALSE);
3048      }
3049      else
3050      if (strcmp(sys_cmd, "testGB")==0)
3051      {
3052        ideal I = (ideal) h->Data();
3053        h = h->next;
3054        ideal GI = (ideal) h->Data();
3055        res->rtyp = INT_CMD;
3056        res->data = (void *)(long) testGB(I, GI);
3057        return(FALSE);
3058      }
3059      else
3060    /*==================== sca:AltVar ==================================*/
3061  #ifdef HAVE_PLURAL
3062      if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
3063      {
3064        ring r = currRing;
3065
3066        if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3067        {
3068          WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3069          return TRUE;
3070        }
3071
3072        res->rtyp=INT_CMD;
3073
3074        if (rIsSCA(r))
3075        {
3076          if(strcmp(sys_cmd, "AltVarStart") == 0)
3077            res->data = (void*)(long)scaFirstAltVar(r);
3078          else
3079            res->data = (void*)(long)scaLastAltVar(r);
3080          return FALSE;
3081        }
3082
3083        WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3084        return TRUE;
3085      }
3086      else
3087  #endif
3088  /*==================== RatNF, noncomm rational coeffs =================*/
3089  #ifdef HAVE_RATGRING
3090      if (strcmp(sys_cmd, "intratNF") == 0)
3091      {
3092        poly p;
3093        poly *q;
3094        ideal I;
3095        int is, k, id;
3096        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3097        {
3098          p=(poly)h->CopyD();
3099          h=h->next;
3100          //        PrintS("poly is done\n");
3101        }
3102        else return TRUE;
3103        if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3104        {
3105          I=(ideal)h->CopyD();
3106          q = I->m;
3107          h=h->next;
3108          //        PrintS("ideal is done\n");
3109        }
3110        else return TRUE;
3111        if ((h!=NULL) && (h->Typ()==INT_CMD))
3112        {
3113          is=(int)((long)(h->Data()));
3114          //        res->rtyp=INT_CMD;
3115          //        PrintS("int is done\n");
3116          //        res->rtyp=IDEAL_CMD;
3117          if (rIsPluralRing(currRing))
3118          {
3119            id = IDELEMS(I);
3120                   int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3121            for(k=0; k < id; k++)
3122            {
3123              pl[k] = pLength(I->m[k]);
3124            }
3125            PrintS("starting redRat\n");
3126            //res->data = (char *)
3127            redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3128            res->data=p;
3129            res->rtyp=POLY_CMD;
3130            //        res->data = ncGCD(p,q,currRing);
3131          }
3132          else
3133          {
3134            res->rtyp=POLY_CMD;
3135            res->data=p;
3136          }
3137        }
3138        else return TRUE;
3139        return FALSE;
3140      }
3141      else
3142  /*==================== RatNF, noncomm rational coeffs =================*/
3143      if (strcmp(sys_cmd, "ratNF") == 0)
3144      {
3145        poly p,q;
3146        int is, htype;
3147        if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3148        {
3149          p=(poly)h->CopyD();
3150          h=h->next;
3151          htype = h->Typ();
3152        }
3153        else return TRUE;
3154        if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3155        {
3156          q=(poly)h->CopyD();
3157          h=h->next;
3158        }
3159        else return TRUE;
3160        if ((h!=NULL) && (h->Typ()==INT_CMD))
3161        {
3162          is=(int)((long)(h->Data()));
3163          res->rtyp=htype;
3164          //        res->rtyp=IDEAL_CMD;
3165          if (rIsPluralRing(currRing))
3166          {
3167            res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3168            //        res->data = ncGCD(p,q,currRing);
3169          }
3170          else res->data=p;
3171        }
3172        else return TRUE;
3173        return FALSE;
3174      }
3175      else
3176        /*==================== RatSpoly, noncomm rational coeffs =================*/
3177      if (strcmp(sys_cmd, "ratSpoly") == 0)
3178      {
3179        poly p,q;
3180        int is;
3181        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3182        {
3183          p=(poly)h->CopyD();
3184          h=h->next;
3185        }
3186        else return TRUE;
3187        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3188        {
3189          q=(poly)h->CopyD();
3190          h=h->next;
3191        }
3192        else return TRUE;
3193        if ((h!=NULL) && (h->Typ()==INT_CMD))
3194        {
3195          is=(int)((long)(h->Data()));
3196          res->rtyp=POLY_CMD;
3197          //        res->rtyp=IDEAL_CMD;
3198          if (rIsPluralRing(currRing))
3199          {
3200            res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3201            //        res->data = ncGCD(p,q,currRing);
3202          }
3203          else res->data=p;
3204        }
3205        else return TRUE;
3206        return FALSE;
3207      }
3208      else
3209  #endif // HAVE_RATGRING
3210  /*==================== Rat def =================*/
3211      if (strcmp(sys_cmd, "ratVar") == 0)
3212      {
3213        int start,end;
3214        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3215        {
3216          start=pIsPurePower((poly)h->Data());
3217          h=h->next;
3218        }
3219        else return TRUE;
3220        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3221        {
3222          end=pIsPurePower((poly)h->Data());
3223          h=h->next;
3224        }
3225        else return TRUE;
3226        currRing->real_var_start=start;
3227        currRing->real_var_end=end;
3228        return (start==0)||(end==0)||(start>end);
3229      }
3230      else
3231  /*==================== t-rep-GB ==================================*/
3232      if (strcmp(sys_cmd, "unifastmult")==0)
3233      {
3234        poly f = (poly)h->Data();
3235        h=h->next;
3236        poly g=(poly)h->Data();
3237        res->rtyp=POLY_CMD;
3238        res->data=unifastmult(f,g,currRing);
3239        return(FALSE);
3240      }
3241      else
3242      if (strcmp(sys_cmd, "multifastmult")==0)
3243      {
3244        poly f = (poly)h->Data();
3245        h=h->next;
3246        poly g=(poly)h->Data();
3247        res->rtyp=POLY_CMD;
3248        res->data=multifastmult(f,g,currRing);
3249        return(FALSE);
3250      }
3251      else
3252      if (strcmp(sys_cmd, "mults")==0)
3253      {
3254        res->rtyp=INT_CMD ;
3255        res->data=(void*)(long) Mults();
3256        return(FALSE);
3257      }
3258      else
3259      if (strcmp(sys_cmd, "fastpower")==0)
3260      {
3261        ring r = currRing;
3262        poly f = (poly)h->Data();
3263        h=h->next;
3264        int n=(int)((long)h->Data());
3265        res->rtyp=POLY_CMD ;
3266        res->data=(void*) pFastPower(f,n,r);
3267        return(FALSE);
3268      }
3269      else
3270      if (strcmp(sys_cmd, "normalpower")==0)
3271      {
3272        poly f = (poly)h->Data();
3273        h=h->next;
3274        int n=(int)((long)h->Data());
3275        res->rtyp=POLY_CMD ;
3276        res->data=(void*) pPower(pCopy(f),n);
3277        return(FALSE);
3278      }
3279      else
3280      if (strcmp(sys_cmd, "MCpower")==0)
3281      {
3282        ring r = currRing;
3283        poly f = (poly)h->Data();
3284        h=h->next;
3285        int n=(int)((long)h->Data());
3286        res->rtyp=POLY_CMD ;
3287        res->data=(void*) pFastPowerMC(f,n,r);
3288        return(FALSE);
3289      }
3290      else
3291      if (strcmp(sys_cmd, "bit_subst")==0)
3292      {
3293        ring r = currRing;
3294        poly outer = (poly)h->Data();
3295        h=h->next;
3296        poly inner=(poly)h->Data();
3297        res->rtyp=POLY_CMD ;
3298        res->data=(void*) uni_subst_bits(outer, inner,r);
3299        return(FALSE);
3300      }
3301      else
3302  /*==================== gcd-varianten =================*/
3303      if (strcmp(sys_cmd, "gcd") == 0)
3304      {
3305        if (h==NULL)
3306        {
3307        #if 0
3308          Print("FLINT_P:%d (use Flints gcd for polynomials in char p)\n",isOn(SW_USE_FL_GCD_P));
3309          Print("FLINT_0:%d (use Flints gcd for polynomials in char 0)\n",isOn(SW_USE_FL_GCD_0));
3310        #endif
3311          Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3312          Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3313          Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3314          #ifndef __CYGWIN__
3315          Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3316          #endif
3317          return FALSE;
3318        }
3319        else
3320        if ((h!=NULL) && (h->Typ()==STRING_CMD)
3321        && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3322        {
3323          int d=(int)(long)h->next->Data();
3324          char *s=(char *)h->Data();
3325        #if 0
3326          if (strcmp(s,"FLINT_P")==0) { if (d) On(SW_USE_FL_GCD_P); else Off(SW_USE_FL_GCD_P); } else
3327          if (strcmp(s,"FLINT_0")==0) { if (d) On(SW_USE_FL_GCD_0); else Off(SW_USE_FL_GCD_0); } else
3328        #endif
3329          if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3330          if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3331          if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3332          #ifndef __CYGWIN__
3333          if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3334          #endif
3335          return TRUE;
3336          return FALSE;
3337        }
3338        else return TRUE;
3339      }
3340      else
3341  /*==================== subring =================*/
3342      if (strcmp(sys_cmd, "subring") == 0)
3343      {
3344        if (h!=NULL)
3345        {
3346          extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3347          res->data=(char *)rSubring(currRing,h);
3348          res->rtyp=RING_CMD;
3349          return res->data==NULL;
3350        }
3351        else return TRUE;
3352      }
3353      else
3354  /*==================== HNF =================*/
3355  #ifdef HAVE_NTL
3356      if (strcmp(sys_cmd, "HNF") == 0)
3357      {
3358        if (h!=NULL)
3359        {
3360          res->rtyp=h->Typ();
3361          if (h->Typ()==MATRIX_CMD)
3362          {
3363            res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3364            return FALSE;
3365          }
3366          else if (h->Typ()==INTMAT_CMD)
3367          {
3368            res->data=(char *)singntl_HNF((intvec*)h->Data());
3369            return FALSE;
3370          }
3371          else if (h->Typ()==INTMAT_CMD)
3372          {
3373            res->data=(char *)singntl_HNF((intvec*)h->Data());
3374            return FALSE;
3375          }
3376          else
3377          {
3378            WerrorS("expected `system(\"HNF\",<matrix|intmat|bigintmat>)`");
3379            return TRUE;
3380          }
3381        }
3382        else return TRUE;
3383      }
3384      else
3385  /*================= probIrredTest ======================*/
3386      if (strcmp (sys_cmd, "probIrredTest") == 0)
3387      {
3388        if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3389        {
3390          CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3391          char *s=(char *)h->next->Data();
3392          double error= atof (s);
3393          int irred= probIrredTest (F, error);
3394          res->rtyp= INT_CMD;
3395          res->data= (void*)(long)irred;
3396          return FALSE;
3397        }
3398        else return TRUE;
3399      }
3400      else
3401  #endif
3402  /*==================== mpz_t loader ======================*/
3403    if(strcmp(sys_cmd, "GNUmpLoad")==0)
3404    {
3405      if ((h != NULL) && (h->Typ() == STRING_CMD))
3406      {
3407        char* filename = (char*)h->Data();
3408        FILE* f = fopen(filename, "r");
3409        if (f == NULL)
3410        {
3411          WerrorS( "invalid file name (in paths use '/')");
3412          return FALSE;
3413        }
3414        mpz_t m; mpz_init(m);
3415        mpz_inp_str(m, f, 10);
3416        fclose(f);
3417        number n = n_InitMPZ(m, coeffs_BIGINT);
3418        res->rtyp = BIGINT_CMD;
3419        res->data = (void*)n;
3420        return FALSE;
3421      }
3422      else
3423      {
3424        WerrorS( "expected valid file name as a string");
3425        return TRUE;
3426      }
3427    }
3428    else
3429  /*==================== intvec matching ======================*/
3430    /* Given two non-empty intvecs, the call
3431            'system("intvecMatchingSegments", ivec, jvec);'
3432         computes all occurences of jvec in ivec, i.e., it returns
3433         a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3434         If no such k exists (e.g. when ivec is shorter than jvec), an
3435         intvec with the single entry 0 is being returned. */
3436    if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3437    {
3438      if ((h       != NULL) && (h->Typ()       == INTVEC_CMD) &&
3439          (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3440          (h->next->next == NULL))
3441      {
3442        intvec* ivec = (intvec*)h->Data();
3443        intvec* jvec = (intvec*)h->next->Data();
3444        intvec* r = new intvec(1); (*r)[0] = 0;
3445        int validEntries = 0;
3446        for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3447        {
3448          if (memcmp(&(*ivec)[k], &(*jvec)[0],
3449                       sizeof(int) * jvec->rows()) == 0)
3450          {
3451            if (validEntries == 0)
3452              (*r)[0] = k + 1;
3453            else
3454            {
3455              r->resize(validEntries + 1);
3456              (*r)[validEntries] = k + 1;
3457            }
3458            validEntries++;
3459          }
3460        }
3461        res->rtyp = INTVEC_CMD;
3462        res->data = (void*)r;
3463        return FALSE;
3464      }
3465      else
3466      {
3467        WerrorS("expected two non-empty intvecs as arguments");
3468        return TRUE;
3469      }
3470    }
3471    else
3472  /* ================== intvecOverlap ======================= */
3473    /* Given two non-empty intvecs, the call
3474            'system("intvecOverlap", ivec, jvec);'
3475         computes the longest intvec kvec such that ivec ends with kvec
3476         and jvec starts with kvec. The length of this overlap is being
3477         returned. If there is no overlap at all, then 0 is being returned. */
3478    if(strcmp(sys_cmd, "intvecOverlap")==0)
3479    {
3480      if ((h       != NULL) && (h->Typ()       == INTVEC_CMD) &&
3481            (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3482            (h->next->next == NULL))
3483      {
3484        intvec* ivec = (intvec*)h->Data();
3485        intvec* jvec = (intvec*)h->next->Data();
3486        int ir = ivec->rows(); int jr = jvec->rows();
3487        int r = jr; if (ir < jr) r = ir;   /* r = min{ir, jr} */
3488        while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0],
3489                                     sizeof(int) * r) != 0))
3490          r--;
3491        res->rtyp = INT_CMD;
3492        res->data = (void*)(long)r;
3493        return FALSE;
3494      }
3495      else
3496      {
3497        WerrorS("expected two non-empty intvecs as arguments");
3498        return TRUE;
3499      }
3500    }
3501    else
3502  /*==================== Hensel's lemma ======================*/
3503    if(strcmp(sys_cmd, "henselfactors")==0)
3504    {
3505      if ((h != NULL) && (h->Typ() == INT_CMD) &&
3506        (h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3507        (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3508        (h->next->next->next != NULL) &&
3509        (h->next->next->next->Typ() == POLY_CMD) &&
3510        (h->next->next->next->next != NULL) &&
3511        (h->next->next->next->next->Typ() == POLY_CMD) &&
3512        (h->next->next->next->next->next != NULL) &&
3513        (h->next->next->next->next->next->Typ() == INT_CMD) &&
3514        (h->next->next->next->next->next->next == NULL))
3515      {
3516        int xIndex = (int)(long)h->Data();
3517        int yIndex = (int)(long)h->next->Data();
3518        poly hh    = (poly)h->next->next->Data();
3519        poly f0    = (poly)h->next->next->next->Data();
3520        poly g0    = (poly)h->next->next->next->next->Data();
3521        int d      = (int)(long)h->next->next->next->next->next->Data();
3522        poly f; poly g;
3523        henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3524        lists L = (lists)omAllocBin(slists_bin);
3525        L->Init(2);
3526        L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3527        L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3528        res->rtyp = LIST_CMD;
3529        res->data = (char *)L;
3530        return FALSE;
3531      }
3532      else
3533      {
3534        WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3535        return TRUE;
3536      }
3537    }
3538    else
3539  /*==================== Approx_Step  =================*/
3540  #ifdef HAVE_PLURAL
3541    if (strcmp(sys_cmd, "astep") == 0)
3542    {
3543      ideal I;
3544      if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3545      {
3546        I=(ideal)h->CopyD();
3547        res->rtyp=IDEAL_CMD;
3548        if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3549        else res->data=I;
3550        setFlag(res,FLAG_STD);
3551      }
3552      else return TRUE;
3553      return FALSE;
3554    }
3555    else
3556  #endif
3557  /*==================== PrintMat  =================*/
3558  #ifdef HAVE_PLURAL
3559    if (strcmp(sys_cmd, "PrintMat") == 0)
3560    {
3561      int a=0;
3562      int b=0;
3563      ring r=NULL;
3564      int metric=0;
3565      if (h!=NULL)
3566      {
3567        if (h->Typ()==INT_CMD)
3568        {
3569          a=(int)((long)(h->Data()));
3570          h=h->next;
3571        }
3572        else if (h->Typ()==INT_CMD)
3573        {
3574          b=(int)((long)(h->Data()));
3575          h=h->next;
3576        }
3577        else if (h->Typ()==RING_CMD)
3578        {
3579          r=(ring)h->Data();
3580          h=h->next;
3581        }
3582        else
3583          return TRUE;
3584      }
3585      else
3586        return TRUE;
3587      if ((h!=NULL) && (h->Typ()==INT_CMD))
3588      {
3589        metric=(int)((long)(h->Data()));
3590      }
3591      res->rtyp=MATRIX_CMD;
3592      if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3593      else res->data=NULL;
3594      return FALSE;
3595    }
3596    else
3597  #endif
3598/* ============ NCUseExtensions ======================== */
3599  #ifdef HAVE_PLURAL
3600    if(strcmp(sys_cmd,"NCUseExtensions")==0)
3601    {
3602      if ((h!=NULL) && (h->Typ()==INT_CMD))
3603        res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3604      else
3605        res->data=(void *)(long)getNCExtensions();
3606      res->rtyp=INT_CMD;
3607      return FALSE;
3608    }
3609    else
3610  #endif
3611/* ============ NCGetType ======================== */
3612  #ifdef HAVE_PLURAL
3613    if(strcmp(sys_cmd,"NCGetType")==0)
3614    {
3615      res->rtyp=INT_CMD;
3616      if( rIsPluralRing(currRing) )
3617        res->data=(void *)(long)ncRingType(currRing);
3618      else
3619        res->data=(void *)(-1L);
3620      return FALSE;
3621    }
3622    else
3623  #endif
3624/* ============ ForceSCA ======================== */
3625  #ifdef HAVE_PLURAL
3626    if(strcmp(sys_cmd,"ForceSCA")==0)
3627    {
3628      if( !rIsPluralRing(currRing) )
3629        return TRUE;
3630      int b, e;
3631      if ((h!=NULL) && (h->Typ()==INT_CMD))
3632      {
3633        b = (int)((long)(h->Data()));
3634        h=h->next;
3635      }
3636      else return TRUE;
3637      if ((h!=NULL) && (h->Typ()==INT_CMD))
3638      {
3639        e = (int)((long)(h->Data()));
3640      }
3641      else return TRUE;
3642      if( !sca_Force(currRing, b, e) )
3643        return TRUE;
3644      return FALSE;
3645    }
3646    else
3647  #endif
3648/* ============ ForceNewNCMultiplication ======================== */
3649  #ifdef HAVE_PLURAL
3650    if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3651    {
3652      if( !rIsPluralRing(currRing) )
3653        return TRUE;
3654      if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3655        return TRUE;
3656      return FALSE;
3657    }
3658    else
3659  #endif
3660/* ============ ForceNewOldNCMultiplication ======================== */
3661  #ifdef HAVE_PLURAL
3662    if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3663    {
3664      if( !rIsPluralRing(currRing) )
3665        return TRUE;
3666      if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3667        return TRUE;
3668      return FALSE;
3669    }
3670    else
3671  #endif
3672/*==================== test64 =================*/
3673  #if 0
3674    if(strcmp(sys_cmd,"test64")==0)
3675    {
3676      long l=8;int i;
3677      for(i=1;i<62;i++)
3678      {
3679        l=l<<1;
3680        number n=n_Init(l,coeffs_BIGINT);
3681        Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3682        CanonicalForm nn=n_convSingNFactoryN(n,TRUE,coeffs_BIGINT);
3683        n_Delete(&n,coeffs_BIGINT);
3684        n=n_convFactoryNSingN(nn,coeffs_BIGINT);
3685        PrintS(" F:");
3686        n_Print(n,coeffs_BIGINT);
3687        PrintLn();
3688        n_Delete(&n,coeffs_BIGINT);
3689      }
3690      Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3691      return FALSE;
3692    }
3693    else
3694   #endif
3695/*==================== n_SwitchChinRem =================*/
3696    if(strcmp(sys_cmd,"cache_chinrem")==0)
3697    {
3698      EXTERN_VAR int n_SwitchChinRem;
3699      Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3700      if ((h!=NULL)&&(h->Typ()==INT_CMD))
3701        n_SwitchChinRem=(int)(long)h->Data();
3702      return FALSE;
3703    }
3704    else
3705/*==================== LU for bigintmat =================*/
3706#ifdef SINGULAR_4_2
3707    if(strcmp(sys_cmd,"LU")==0)
3708    {
3709      if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3710      {
3711        // get the argument:
3712        bigintmat *b=(bigintmat *)h->Data();
3713        // just for tests: simply transpose
3714        bigintmat *bb=b->transpose();
3715        // return the result:
3716        res->rtyp=CMATRIX_CMD;
3717        res->data=(char*)bb;
3718        return FALSE;
3719      }
3720      else
3721      {
3722        WerrorS("system(\"LU\",<cmatrix>) expected");
3723        return TRUE;
3724      }
3725    }
3726    else
3727#endif
3728/*==================== sort =================*/
3729    if(strcmp(sys_cmd,"sort")==0)
3730    {
3731      extern BOOLEAN jjSORTLIST(leftv,leftv);
3732      if (h->Typ()==LIST_CMD)
3733        return jjSORTLIST(res,h);
3734      else
3735        return TRUE;
3736    }
3737    else
3738/*==================== uniq =================*/
3739    if(strcmp(sys_cmd,"uniq")==0)
3740    {
3741      extern BOOLEAN jjUNIQLIST(leftv, leftv);
3742      if (h->Typ()==LIST_CMD)
3743        return jjUNIQLIST(res,h);
3744      else
3745        return TRUE;
3746    }
3747    else
3748/*==================== GF(p,n) ==================================*/
3749    if(strcmp(sys_cmd,"GF")==0)
3750    {
3751      const short t[]={3,INT_CMD,INT_CMD,STRING_CMD};
3752      if (iiCheckTypes(h,t,1))
3753      {
3754        int p=(int)(long)h->Data();
3755        int n=(int)(long)h->next->Data();
3756        char *v=(char*)h->next->next->CopyD();
3757        GFInfo param;
3758        param.GFChar = p;
3759        param.GFDegree = n;
3760        param.GFPar_name = v;
3761        coeffs cf= nInitChar(n_GF, &param);
3762        res->rtyp=CRING_CMD;
3763        res->data=cf;
3764        return FALSE;
3765      }
3766      else
3767        return TRUE;
3768    }
3769    else
3770/*==================== power* ==================================*/
3771    #if 0
3772    if(strcmp(sys_cmd,"power1")==0)
3773    {
3774      res->rtyp=POLY_CMD;
3775      poly f=(poly)h->CopyD();
3776      poly g=pPower(f,2000);
3777      res->data=(void *)g;
3778      return FALSE;
3779    }
3780    else
3781    if(strcmp(sys_cmd,"power2")==0)
3782    {
3783      res->rtyp=POLY_CMD;
3784      poly f=(poly)h->Data();
3785      poly g=pOne();
3786      for(int i=0;i<2000;i++)
3787        g=pMult(g,pCopy(f));
3788      res->data=(void *)g;
3789      return FALSE;
3790    }
3791    if(strcmp(sys_cmd,"power3")==0)
3792    {
3793      res->rtyp=POLY_CMD;
3794      poly f=(poly)h->Data();
3795      poly p2=pMult(pCopy(f),pCopy(f));
3796      poly p4=pMult(pCopy(p2),pCopy(p2));
3797      poly p8=pMult(pCopy(p4),pCopy(p4));
3798      poly p16=pMult(pCopy(p8),pCopy(p8));
3799      poly p32=pMult(pCopy(p16),pCopy(p16));
3800      poly p64=pMult(pCopy(p32),pCopy(p32));
3801      poly p128=pMult(pCopy(p64),pCopy(p64));
3802      poly p256=pMult(pCopy(p128),pCopy(p128));
3803      poly p512=pMult(pCopy(p256),pCopy(p256));
3804      poly p1024=pMult(pCopy(p512),pCopy(p512));
3805      poly p1536=pMult(p1024,p512);
3806      poly p1792=pMult(p1536,p256);
3807      poly p1920=pMult(p1792,p128);
3808      poly p1984=pMult(p1920,p64);
3809      poly p2000=pMult(p1984,p16);
3810      res->data=(void *)p2000;
3811      pDelete(&p2);
3812      pDelete(&p4);
3813      pDelete(&p8);
3814      //pDelete(&p16);
3815      pDelete(&p32);
3816      //pDelete(&p64);
3817      //pDelete(&p128);
3818      //pDelete(&p256);
3819      //pDelete(&p512);
3820      //pDelete(&p1024);
3821      //pDelete(&p1536);
3822      //pDelete(&p1792);
3823      //pDelete(&p1920);
3824      //pDelete(&p1984);
3825      return FALSE;
3826    }
3827    else
3828    #endif
3829/* ccluster --------------------------------------------------------------*/
3830#ifdef HAVE_CCLUSTER
3831    if(strcmp(sys_cmd,"ccluster")==0)
3832    {
3833      if ((currRing!=NULL)
3834      && (rField_is_Q(currRing) || rField_is_R(currRing) || rField_is_long_R(currRing)))
3835      {
3836        const short t[]={5,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3837        const short t2[]={6,POLY_CMD,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3838
3839//         printf("test t : %d\n", h->Typ()==POLY_CMD);
3840//         printf("test t : %d\n", h->next->Typ()==POLY_CMD);
3841        int pol_with_complex_coeffs=0;
3842        if (h->next->Typ()==POLY_CMD)
3843            pol_with_complex_coeffs=1;
3844
3845        if ( (pol_with_complex_coeffs==0 && iiCheckTypes(h,t,1))
3846       ||(pol_with_complex_coeffs==1 && iiCheckTypes(h,t2,1)) )
3847        {
3848          // convert first arg. to fmpq_poly_t
3849          fmpq_poly_t fre, fim;
3850          convSingPFlintP(fre,(poly)h->Data(),currRing); h=h->next;
3851          if (pol_with_complex_coeffs==1)
3852          { // convert second arg. to fmpq_poly_t
3853            convSingPFlintP(fim,(poly)h->Data(),currRing); h=h->next;
3854          }
3855          // convert box-center(re,im), box-size, epsilon
3856          fmpq_t center_re,center_im,boxsize,eps;
3857          convSingNFlintN(center_re,(number)h->Data(),currRing->cf); h=h->next;
3858          convSingNFlintN(center_im,(number)h->Data(),currRing->cf); h=h->next;
3859          convSingNFlintN(boxsize,(number)h->Data(),currRing->cf); h=h->next;
3860          convSingNFlintN(eps,(number)h->Data(),currRing->cf); h=h->next;
3861          // alloc arrays
3862          int n=fmpq_poly_length(fre);
3863          fmpq_t* re_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3864          fmpq_t* im_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3865          int *mult      =(int*)   omAlloc(n*sizeof(int));
3866          for(int i=0; i<n;i++)
3867          { fmpq_init(re_part[i]); fmpq_init(im_part[i]); }
3868          // call cccluster, adjust n
3869          int verbosity =0; //nothing is printed
3870          int strategy = 23; //default strategy
3871          int nn=0;
3872          long nb_threads = (long) feOptValue(FE_OPT_CPUS);
3873          strategy = strategy+(nb_threads<<6);
3874//       printf("nb threads: %ld\n", nb_threads);
3875//       printf("strategy: %ld\n", strategy);
3876          if (pol_with_complex_coeffs==0)
3877            nn=ccluster_interface_poly_real(re_part,im_part,mult,fre,center_re,center_im,boxsize,eps,strategy,verbosity);
3878          else
3879            nn=ccluster_interface_poly_real_imag(re_part,im_part,mult,fre,fim,center_re,center_im,boxsize,eps,strategy,verbosity);
3880          // convert to list
3881          lists l=(lists)omAlloc0Bin(slists_bin);
3882          l->Init(nn);
3883          for(int i=0; i<nn;i++)
3884          {
3885            lists ll=(lists)omAlloc0Bin(slists_bin);
3886            l->m[i].rtyp=LIST_CMD;
3887            l->m[i].data=ll;
3888            ll->Init(3);
3889            ll->m[0].rtyp=NUMBER_CMD;
3890            ll->m[1].rtyp=NUMBER_CMD;
3891            ll->m[2].rtyp=INT_CMD;
3892            ll->m[0].data=convFlintNSingN(re_part[i],currRing->cf);
3893            ll->m[1].data=convFlintNSingN(im_part[i],currRing->cf);
3894            ll->m[2].data=(void *)(long)mult[i];
3895          }
3896          //clear re, im, mults, fre, fim
3897          for(int i=n-1;i>=0;i--) { fmpq_clear(re_part[i]); fmpq_clear(im_part[i]); }
3898          omFree(re_part);
3899          omFree(im_part);
3900          omFree(mult);
3901          fmpq_clear(center_re); fmpq_clear(center_im); fmpq_clear(boxsize); fmpq_clear(eps);
3902          fmpq_poly_clear(fre);
3903          if (pol_with_complex_coeffs==1) fmpq_poly_clear(fim);
3904          // result
3905          res->rtyp=LIST_CMD;
3906          res->data=l;
3907          return FALSE;
3908        }
3909      }
3910      return TRUE;
3911    }
3912    else
3913#endif
3914/* ====== maEvalAt ============================*/
3915    if(strcmp(sys_cmd,"evaluate")==0)
3916    {
3917      extern number maEvalAt(const poly p,const number* pt, const ring r);
3918      if (h->Typ()!=POLY_CMD)
3919      {
3920        WerrorS("expected system(\"evaluate\",<poly>,..)");
3921        return TRUE;
3922      }
3923      poly p=(poly)h->Data();
3924      number *pt=(number*)omAlloc(sizeof(number)*currRing->N);
3925      for(int i=0;i<currRing->N;i++)
3926      {
3927        h=h->next;
3928        if ((h==NULL)||(h->Typ()!=NUMBER_CMD))
3929        {
3930          WerrorS("system(\"evaluate\",<poly>,<number>..) - expect number");
3931          return TRUE;
3932        }
3933        pt[i]=(number)h->Data();
3934      }
3935      res->data=maEvalAt(p,pt,currRing);
3936      res->rtyp=NUMBER_CMD;
3937      return FALSE;
3938    }
3939    else
3940/* ====== DivRem ============================*/
3941    if(strcmp(sys_cmd,"DivRem")==0)
3942    {
3943      const short t1[]={2,POLY_CMD,POLY_CMD};
3944      if (iiCheckTypes(h,t1,1))
3945      {
3946        poly p=(poly)h->CopyD();
3947        poly q=(poly)h->next->CopyD();
3948        poly rest;
3949        res->data=p_DivRem(p,q,rest,currRing);
3950        res->rtyp=POLY_CMD;
3951        PrintS("rest:");pWrite(rest);
3952        return FALSE;
3953      }
3954      else
3955      {
3956        WerrorS("expected system(\"DivRem\",<poly>,<poly>)");
3957        return TRUE;
3958      }
3959    }
3960    else
3961/* ====== DivRemId ============================*/
3962    if(strcmp(sys_cmd,"DivRemIdU")==0)
3963    {
3964      const short t1[]={2,IDEAL_CMD,IDEAL_CMD};
3965      const short t2[]={2,MODUL_CMD,MODUL_CMD};
3966      if (iiCheckTypes(h,t1,0)
3967      || iiCheckTypes(h,t2,0))
3968      {
3969        ideal p=(ideal)h->CopyD();
3970        ideal q=(ideal)h->next->CopyD();
3971        ideal factors;
3972        ideal unit;
3973        ideal rest=idDivRem(p,q,factors,&unit,0);
3974        //matrix T = id_Module2Matrix(factors,currRing);
3975        //matrix U = id_Module2Matrix(unit,currRing);
3976        lists L=(lists)omAllocBin(slists_bin);
3977        L->Init(3);
3978        //L->m[0].rtyp=h->Typ();   L->m[0].data=(void *)rest;
3979        L->m[0].rtyp=MODUL_CMD;   L->m[0].data=(void *)rest;
3980        L->m[1].rtyp=MODUL_CMD;  L->m[1].data=(void *)factors;
3981        L->m[2].rtyp=MODUL_CMD;  L->m[2].data=(void *)unit;
3982        res->rtyp=LIST_CMD;
3983        res->data=L;
3984        return FALSE;
3985      }
3986      else
3987      {
3988        WerrorS("expected system(\"DivRemId\",<ideal>,<ideal>)");
3989        return TRUE;
3990      }
3991    }
3992    else
3993    if(strcmp(sys_cmd,"DivRemId")==0)
3994    {
3995      const short t1[]={2,IDEAL_CMD,IDEAL_CMD};
3996      const short t2[]={2,MODUL_CMD,MODUL_CMD};
3997      if (iiCheckTypes(h,t1,0)
3998      || iiCheckTypes(h,t2,0))
3999      {
4000        ideal p=(ideal)h->CopyD();
4001        ideal q=(ideal)h->next->CopyD();
4002        ideal rest;
4003        ideal quot=idDivRem(p,q,rest,NULL,0);
4004        matrix T = id_Module2Matrix(rest,currRing);
4005        lists L=(lists)omAllocBin(slists_bin);
4006        L->Init(2);
4007        L->m[0].rtyp=IDEAL_CMD;   L->m[0].data=(void *)quot;
4008        L->m[1].rtyp=MATRIX_CMD;  L->m[1].data=(void *)T;
4009        res->rtyp=LIST_CMD;
4010        res->data=L;
4011        return FALSE;
4012      }
4013      else
4014      {
4015        WerrorS("expected system(\"DivRemId\",<ideal>,<ideal>)");
4016        return TRUE;
4017      }
4018    }
4019    else
4020/* ====== CoeffTerm ============================*/
4021    if(strcmp(sys_cmd,"CoeffTerm")==0)
4022    {
4023      const short t1[]={2,POLY_CMD,POLY_CMD};
4024      const short t2[]={2,VECTOR_CMD,VECTOR_CMD};
4025      const short t3[]={2,IDEAL_CMD,POLY_CMD};
4026      const short t4[]={2,MODUL_CMD,VECTOR_CMD};
4027      const short t5[]={2,VECTOR_CMD,POLY_CMD};
4028      const short t6[]={2,MODUL_CMD,POLY_CMD};
4029      const short t7[]={2,VECTOR_CMD,IDEAL_CMD};
4030      const short t8[]={2,VECTOR_CMD,MODUL_CMD};
4031      if (iiCheckTypes(h,t1,0)
4032      || iiCheckTypes(h,t2,0))
4033      {
4034        poly p=(poly)h->Data();
4035        poly q=(poly)h->next->Data();
4036        res->data=p_CoeffTerm(p,q,currRing);
4037        res->rtyp=NUMBER_CMD;
4038        return FALSE;
4039      }
4040      else if (iiCheckTypes(h,t3,0)
4041      || iiCheckTypes(h,t4,0))
4042      {
4043        ideal p=(ideal)h->Data();
4044        poly q=(poly)h->next->Data();
4045        res->data=id_CoeffTerm(p,q,currRing);
4046        res->rtyp=h->Typ();
4047        return FALSE;
4048      }
4049      else if (iiCheckTypes(h,t5,0))
4050      {
4051        poly p=(poly)h->Data();
4052        poly q=(poly)h->next->Data();
4053        res->data=p_CoeffTermV(p,q,currRing);
4054        res->rtyp=VECTOR_CMD;
4055        return FALSE;
4056      }
4057      else if (iiCheckTypes(h,t6,0))
4058      {
4059        ideal p=(ideal)h->Data();
4060        poly q=(poly)h->next->Data();
4061        res->data=id_CoeffTermV(p,q,currRing);
4062        res->rtyp=MODUL_CMD;
4063        return FALSE;
4064      }
4065      else if (iiCheckTypes(h,t7,0)) /* vector,ideal*/
4066      {
4067        poly p=(poly)h->Data();
4068        ideal q=(ideal)h->next->Data();
4069        res->data=p_CoeffTermId(p,q,p_MaxComp(p,currRing),currRing);
4070        res->rtyp=VECTOR_CMD;
4071        return FALSE;
4072      }
4073      else if (iiCheckTypes(h,t8,0)) /* vector,module*/
4074      {
4075        poly p=(poly)h->Data();
4076        ideal q=(ideal)h->next->Data();
4077        res->data=p_CoeffTermMo(p,q,p_MaxComp(p,currRing),currRing);
4078        res->rtyp=VECTOR_CMD;
4079        return FALSE;
4080      }
4081      else
4082      {
4083        WerrorS("expected system(\"CoeffTerm\",<poly>/<vector>,<poly>/<vector>)"        "\n or                          <ideal>/<module>,<poly>/<vector>");
4084        return TRUE;
4085      }
4086    }
4087    else
4088/*==================== sat1 =================*/
4089    if(strcmp(sys_cmd,"sat1")==0)
4090    {
4091      ideal I= (ideal)h->Data();
4092      ideal J=(ideal)h->next->Data();
4093      res->rtyp=IDEAL_CMD;
4094      res->data=(void*)id_Sat_principal(I,J,currRing);
4095      return FALSE;
4096    }
4097    else
4098/*==================== mres_with_map =================*/
4099    if(strcmp(sys_cmd,"mres_with_map")==0)
4100    {
4101      ideal I= (ideal)h->Data();
4102      int l=(int)(long)h->next->Data();
4103      ideal trans;
4104      res->rtyp=RESOLUTION_CMD;
4105      res->data=(void*)syMres_with_map(I,l,NULL,trans);
4106      res->next=(leftv)omAlloc0Bin(sleftv_bin);
4107      res->next->data=(void*)trans;
4108      res->next->rtyp=MODUL_CMD;
4109      return FALSE;
4110    }
4111    else
4112/*==================== minres_with_map =================*/
4113    if(strcmp(sys_cmd,"minres_with_map")==0)
4114    {
4115      syStrategy r= syCopy((syStrategy)h->Data());
4116      ideal trans;
4117      res->rtyp=RESOLUTION_CMD;
4118      syMinimize_with_map(r,trans);
4119      res->data=(void*)r;
4120      res->next=(leftv)omAlloc0Bin(sleftv_bin);
4121      res->next->data=(void*)trans;
4122      res->next->rtyp=MODUL_CMD;
4123      return FALSE;
4124    }
4125    else
4126/*==================== sat =================*/
4127#if 0
4128    if(strcmp(sys_cmd,"sat_with_exp")==0)
4129    {
4130      ideal I= (ideal)h->Data();
4131      ideal J=(ideal)h->next->Data();
4132      int k;
4133      ideal S=idSaturate(I,J,k,h->Typ()==IDEAL_CMD);
4134      lists L = (lists)omAllocBin(slists_bin);
4135      L->Init(2);
4136      L->m[0].rtyp = h->Typ(); L->m[0].data=(void*)S; // ideal or module
4137      setFlag(&(L->m[0]),FLAG_STD);
4138      L->m[1].rtyp = INT_CMD; L->m[1].data=(void*)(long)k;
4139      res->rtyp=LIST_CMD;
4140      res->data=(void*)L;
4141      return FALSE;
4142    }
4143    else
4144#endif
4145/*==================== Error =================*/
4146      Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
4147  }
4148  return TRUE;
4149}
4150
4151#endif // HAVE_EXTENDED_SYSTEM
Note: See TracBrowser for help on using the repository browser.