source: git/Singular/extra.cc @ 44ca2f

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