source: git/Singular/extra.cc @ b8ad3a

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