source: git/Singular/extra.cc @ 85bcd6

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