source: git/Singular/extra.cc @ 57fad3a

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