source: git/Singular/extra.cc @ 02a069e

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