source: git/Singular/extra.cc @ 90adba8

spielwiese
Last change on this file since 90adba8 was 90adba8, checked in by Martin Monerjan, 15 years ago
extra.cc: prepared for LIST_CMD gfan.cc: removed functions getGB and *getConeNormals. These are now methods of class gcone. Construction of rings works partially. When entering a ring with ordering lp the program hangs after rWrite(rootRing) line 347. Prepared for return type LIST_CMD git-svn-id: file:///usr/local/Singular/svn/trunk@11601 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 82.8 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: extra.cc,v 1.298 2009-03-30 14:07:21 monerjan 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 return TRUE;
752        if ((h!=NULL) && (h->Typ()==INT_CMD))
753        {
754          b=(int)((long)(h->Data()));
755          h=h->next;
756        }
757        else return TRUE;
758        if ((h!=NULL) && (h->Typ()==RING_CMD))
759        {
760          r=(ring)h->Data();
761          h=h->next;
762        }
763        else return TRUE;
764        if ((h!=NULL) && (h->Typ()==INT_CMD))
765        {
766          metric=(int)((long)(h->Data()));
767        }
768        res->rtyp=MATRIX_CMD;
769        if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
770        else res->data=NULL;
771        return FALSE;
772      }
773/*==================== twostd  =================*/
774      if (strcmp(sys_cmd, "twostd") == 0)
775      {
776        ideal I;
777        if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
778        {
779          I=(ideal)h->CopyD();
780          res->rtyp=IDEAL_CMD;
781          if (rIsPluralRing(currRing)) res->data=twostd(I);
782          else res->data=I;
783          setFlag(res,FLAG_TWOSTD);
784          setFlag(res,FLAG_STD);
785        }
786        else return TRUE;
787        return FALSE;
788      }
789/*==================== lie bracket =================*/
790    if (strcmp(sys_cmd, "bracket") == 0)
791    {
792      poly p;
793      poly q;
794      if ((h!=NULL) && (h->Typ()==POLY_CMD))
795      {
796        p=(poly)h->CopyD();
797        h=h->next;
798      }
799      else return TRUE;
800      if ((h!=NULL) && (h->Typ()==POLY_CMD))
801      {
802        q=(poly)h->Data();
803      }
804      else return TRUE;
805      res->rtyp=POLY_CMD;
806      if (rIsPluralRing(currRing))  res->data=nc_p_Bracket_qq(p,q);
807      else res->data=NULL;
808      return FALSE;
809    }
810    if(strcmp(sys_cmd,"NCUseExtensions")==0)
811    {
812      extern bool bUseExtensions;
813      res->rtyp=INT_CMD;
814      res->data=(void *)bUseExtensions;
815     
816      if ((h!=NULL) && (h->Typ()==INT_CMD))
817        bUseExtensions = (bool)((long)(h->Data()));
818     
819      return FALSE;
820    }
821
822   
823    if(strcmp(sys_cmd,"NCGetType")==0)
824    {
825      res->rtyp=INT_CMD;
826     
827      if( rIsPluralRing(currRing) )
828        res->data=(void *)ncRingType(currRing);
829      else
830        res->data=(void *)(-1);
831     
832      return FALSE;
833    }
834
835   
836    if(strcmp(sys_cmd,"ForceSCA")==0)
837    {
838      if( !rIsPluralRing(currRing) )
839        return TRUE;
840
841      int b, e;
842     
843      if ((h!=NULL) && (h->Typ()==INT_CMD))
844      {
845        b = (int)((long)(h->Data()));
846        h=h->next;
847      } 
848      else return TRUE;
849 
850      if ((h!=NULL) && (h->Typ()==INT_CMD))
851      {
852        e = (int)((long)(h->Data()));
853      } 
854      else return TRUE;
855
856
857      if( !sca_Force(currRing, b, e) )
858        return TRUE;
859
860      return FALSE;
861    }
862
863    if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
864    {
865      if( !rIsPluralRing(currRing) )
866        return TRUE;
867
868      if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
869        return TRUE;
870
871      return FALSE;
872    }
873
874    if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
875    {
876      if( !rIsPluralRing(currRing) )
877        return TRUE;
878
879      if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
880        return TRUE;
881
882      return FALSE;
883    }
884
885
886
887   
888    /*==================== PLURAL =================*/
889/*==================== opp ==================================*/
890    if (strcmp(sys_cmd, "opp")==0)
891    {
892      if ((h!=NULL) && (h->Typ()==RING_CMD))
893      {
894        ring r=(ring)h->Data();
895        res->data=rOpposite(r);
896        res->rtyp=RING_CMD;
897        return FALSE;
898      }
899      else
900      {
901        WerrorS("`system(\"opp\",<ring>)` expected");
902        return TRUE;
903      }
904    }
905    else
906/*==================== env ==================================*/
907    if (strcmp(sys_cmd, "env")==0)
908    {
909      if ((h!=NULL) && (h->Typ()==RING_CMD))
910      {
911        ring r = (ring)h->Data();
912        res->data = rEnvelope(r);
913        res->rtyp = RING_CMD;
914        return FALSE;
915      }
916      else
917      {
918        WerrorS("`system(\"env\",<ring>)` expected");
919        return TRUE;
920      }
921    }
922    else
923/*==================== oppose ==================================*/
924    if (strcmp(sys_cmd, "oppose")==0)
925    {
926      ring Rop;
927      if ((h!=NULL) && (h->Typ()==RING_CMD))
928      {
929        Rop = (ring)h->Data();
930        h   = h->next;
931      }
932      if ((h!=NULL))
933      {
934        idhdl w;
935        if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
936        {
937          poly p = (poly)IDDATA(w);
938          res->data = pOppose(Rop,p);
939          res->rtyp = POLY_CMD;
940          return FALSE;
941        }
942       }
943      else
944      {
945        WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
946        return TRUE;
947      }
948    }
949    else
950/*==================== freeGB, twosided GB in free algebra =================*/
951#ifdef HAVE_SHIFTBBA
952    if (strcmp(sys_cmd, "freegb") == 0)
953    {
954      ideal I;
955      int uptodeg, lVblock;
956      if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
957      {
958        I=(ideal)h->CopyD();
959        h=h->next;
960      }
961      else return TRUE;
962      if ((h!=NULL) && (h->Typ()==INT_CMD))
963      {
964        uptodeg=(int)((long)(h->Data()));
965        h=h->next;
966      }
967      else return TRUE;
968      if ((h!=NULL) && (h->Typ()==INT_CMD))
969      {
970        lVblock=(int)((long)(h->Data()));
971        res->data = freegb(I,uptodeg,lVblock);
972        if (res->data == NULL)
973        {
974          /* that is there were input errors */
975          res->data = I;
976        }
977        res->rtyp = IDEAL_CMD;
978      }
979      else return TRUE;
980      return FALSE;
981    }
982    else
983#endif /*SHIFTBBA*/
984#endif /*PLURAL*/
985#ifdef HAVE_WALK
986/*==================== walk stuff =================*/
987#ifdef OWNW
988    if (strcmp(sys_cmd, "walkNextWeight") == 0)
989    {
990      if (h == NULL || h->Typ() != INTVEC_CMD ||
991          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
992          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
993      {
994        Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
995        return TRUE;
996      }
997
998      if (((intvec*) h->Data())->length() != currRing->N ||
999          ((intvec*) h->next->Data())->length() != currRing->N)
1000      {
1001        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1002               currRing->N);
1003        return TRUE;
1004      }
1005      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1006                                         ((intvec*) h->next->Data()),
1007                                         (ideal) h->next->next->Data());
1008      if (res->data == (void*) 0 || res->data == (void*) 1)
1009      {
1010        res->rtyp = INT_CMD;
1011      }
1012      else
1013      {
1014        res->rtyp = INTVEC_CMD;
1015      }
1016      return FALSE;
1017    }
1018    else if (strcmp(sys_cmd, "walkInitials") == 0)
1019    {
1020      if (h == NULL || h->Typ() != IDEAL_CMD)
1021      {
1022        WerrorS("system(\"walkInitials\", ideal) expected");
1023        return TRUE;
1024      }
1025
1026      res->data = (void*) walkInitials((ideal) h->Data());
1027      res->rtyp = IDEAL_CMD;
1028      return FALSE;
1029    }
1030    else
1031#endif
1032#ifdef WAIV
1033    if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1034    {
1035      if (h == NULL || h->Typ() != INTVEC_CMD ||
1036          h->next == NULL || h->next->Typ() != INTVEC_CMD)
1037      {
1038        WerrorS("system(\"walkAddIntVec\", intvec, intvec) expected");
1039        return TRUE;
1040      }
1041      intvec* arg1 = (intvec*) h->Data();
1042      intvec* arg2 = (intvec*) h->next->Data();
1043
1044
1045      res->data = (intvec*) walkAddIntVec(arg1, arg2);
1046      res->rtyp = INTVEC_CMD;
1047      return FALSE;
1048    }
1049    else
1050#endif
1051#ifdef MwaklNextWeight
1052    if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1053    {
1054      if (h == NULL || h->Typ() != INTVEC_CMD ||
1055          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1056          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
1057      {
1058        Werror("system(\"MwalkNextWeight\", intvec, intvec, ideal) expected");
1059        return TRUE;
1060      }
1061
1062      if (((intvec*) h->Data())->length() != currRing->N ||
1063          ((intvec*) h->next->Data())->length() != currRing->N)
1064      {
1065        Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1066               currRing->N);
1067        return TRUE;
1068      }
1069      intvec* arg1 = (intvec*) h->Data();
1070      intvec* arg2 = (intvec*) h->next->Data();
1071      ideal arg3   =   (ideal) h->next->next->Data();
1072
1073      intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1074
1075      res->rtyp = INTVEC_CMD;
1076      res->data =  result;
1077
1078      return FALSE;
1079    }
1080    else
1081#endif //MWalkNextWeight
1082    if(strcmp(sys_cmd, "Mivdp") == 0)
1083    {
1084      if (h == NULL || h->Typ() != INT_CMD)
1085      {
1086        Werror("system(\"Mivdp\", int) expected");
1087        return TRUE;
1088      }
1089      if ((int) ((long)(h->Data())) != currRing->N)
1090      {
1091        Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1092               currRing->N);
1093        return TRUE;
1094      }
1095      int arg1 = (int) ((long)(h->Data()));
1096
1097      intvec* result = (intvec*) Mivdp(arg1);
1098
1099      res->rtyp = INTVEC_CMD;
1100      res->data =  result;
1101
1102      return FALSE;
1103    }
1104
1105    else if(strcmp(sys_cmd, "Mivlp") == 0)
1106    {
1107      if (h == NULL || h->Typ() != INT_CMD)
1108      {
1109        Werror("system(\"Mivlp\", int) expected");
1110        return TRUE;
1111      }
1112      if ((int) ((long)(h->Data())) != currRing->N)
1113      {
1114        Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1115               currRing->N);
1116        return TRUE;
1117      }
1118      int arg1 = (int) ((long)(h->Data()));
1119
1120      intvec* result = (intvec*) Mivlp(arg1);
1121
1122      res->rtyp = INTVEC_CMD;
1123      res->data =  result;
1124
1125      return FALSE;
1126    }
1127   else
1128#ifdef MpDiv
1129      if(strcmp(sys_cmd, "MpDiv") == 0)
1130      {
1131        if(h==NULL || h->Typ() != POLY_CMD ||
1132           h->next == NULL || h->next->Typ() != POLY_CMD)
1133        {
1134          Werror("system(\"MpDiv\",poly, poly) expected");
1135          return TRUE;
1136        }
1137        poly arg1 = (poly) h->Data();
1138        poly arg2 = (poly) h->next->Data();
1139
1140        poly result = MpDiv(arg1, arg2);
1141
1142        res->rtyp = POLY_CMD;
1143        res->data = result;
1144        return FALSE;
1145      }
1146    else
1147#endif
1148#ifdef MpMult
1149      if(strcmp(sys_cmd, "MpMult") == 0)
1150      {
1151        if(h==NULL || h->Typ() != POLY_CMD ||
1152           h->next == NULL || h->next->Typ() != POLY_CMD)
1153        {
1154          Werror("system(\"MpMult\",poly, poly) expected");
1155          return TRUE;
1156        }
1157        poly arg1 = (poly) h->Data();
1158        poly arg2 = (poly) h->next->Data();
1159
1160        poly result = MpMult(arg1, arg2);
1161        res->rtyp = POLY_CMD;
1162        res->data = result;
1163        return FALSE;
1164      }
1165  else
1166#endif
1167   if (strcmp(sys_cmd, "MivSame") == 0)
1168    {
1169      if(h == NULL || h->Typ() != INTVEC_CMD ||
1170         h->next == NULL || h->next->Typ() != INTVEC_CMD )
1171      {
1172        Werror("system(\"MivSame\", intvec, intvec) expected");
1173        return TRUE;
1174      }
1175      /*
1176      if (((intvec*) h->Data())->length() != currRing->N ||
1177          ((intvec*) h->next->Data())->length() != currRing->N)
1178      {
1179        Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1180               currRing->N);
1181        return TRUE;
1182      }
1183      */
1184      intvec* arg1 = (intvec*) h->Data();
1185      intvec* arg2 = (intvec*) h->next->Data();
1186      /*
1187      poly result = (poly) MivSame(arg1, arg2);
1188
1189      res->rtyp = POLY_CMD;
1190      res->data =  (poly) result;
1191      */
1192      res->rtyp = INT_CMD;
1193      res->data = (void*)(long) MivSame(arg1, arg2);
1194      return FALSE;
1195    }
1196  else
1197   if (strcmp(sys_cmd, "M3ivSame") == 0)
1198    {
1199      if(h == NULL || h->Typ() != INTVEC_CMD ||
1200         h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1201         h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD  )
1202      {
1203        Werror("system(\"M3ivSame\", intvec, intvec, intvec) expected");
1204        return TRUE;
1205      }
1206      /*
1207      if (((intvec*) h->Data())->length() != currRing->N ||
1208          ((intvec*) h->next->Data())->length() != currRing->N ||
1209          ((intvec*) h->next->next->Data())->length() != currRing->N )
1210      {
1211        Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1212               currRing->N);
1213        return TRUE;
1214      }
1215      */
1216      intvec* arg1 = (intvec*) h->Data();
1217      intvec* arg2 = (intvec*) h->next->Data();
1218      intvec* arg3 = (intvec*) h->next->next->Data();
1219      /*
1220      poly result = (poly) M3ivSame(arg1, arg2, arg3);
1221
1222      res->rtyp = POLY_CMD;
1223      res->data =  (poly) result;
1224      */
1225      res->rtyp = INT_CMD;
1226      res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1227      return FALSE;
1228    }
1229  else
1230      if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1231      {
1232        if(h == NULL || h->Typ() != IDEAL_CMD ||
1233           h->next == NULL || h->next->Typ() != INTVEC_CMD)
1234        {
1235          Werror("system(\"MwalkInitialForm\", ideal, intvec) expected");
1236          return TRUE;
1237        }
1238        if(((intvec*) h->next->Data())->length() != currRing->N)
1239        {
1240          Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1241                 currRing->N);
1242          return TRUE;
1243        }
1244        ideal id      = (ideal) h->Data();
1245        intvec* int_w = (intvec*) h->next->Data();
1246        ideal result  = (ideal) MwalkInitialForm(id, int_w);
1247
1248        res->rtyp = IDEAL_CMD;
1249        res->data = result;
1250        return FALSE;
1251      }
1252  else
1253    /************** Perturbation walk **********/
1254     if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1255      {
1256        if(h==NULL || h->Typ() != INTVEC_CMD)
1257        {
1258          Werror("system(\"MivMatrixOrder\",intvec) expected");
1259          return TRUE;
1260        }
1261        intvec* arg1 = (intvec*) h->Data();
1262
1263        intvec* result = MivMatrixOrder(arg1);
1264
1265        res->rtyp = INTVEC_CMD;
1266        res->data =  result;
1267        return FALSE;
1268      }
1269    else
1270     if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1271      {
1272        if(h==NULL || h->Typ() != INT_CMD)
1273        {
1274          Werror("system(\"MivMatrixOrderdp\",intvec) expected");
1275          return TRUE;
1276        }
1277        int arg1 = (int) ((long)(h->Data()));
1278
1279        intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1280
1281        res->rtyp = INTVEC_CMD;
1282        res->data =  result;
1283        return FALSE;
1284      }
1285    else
1286    if(strcmp(sys_cmd, "MPertVectors") == 0)
1287      {
1288
1289        if(h==NULL || h->Typ() != IDEAL_CMD ||
1290           h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1291           h->next->next == NULL || h->next->next->Typ() != INT_CMD)
1292        {
1293          Werror("system(\"MPertVectors\",ideal, intvec, int) expected");
1294          return TRUE;
1295        }
1296
1297        ideal arg1 = (ideal) h->Data();
1298        intvec* arg2 = (intvec*) h->next->Data();
1299        int arg3 = (int) ((long)(h->next->next->Data()));
1300
1301        intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1302
1303        res->rtyp = INTVEC_CMD;
1304        res->data =  result;
1305        return FALSE;
1306      }
1307    else
1308    if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1309      {
1310
1311        if(h==NULL || h->Typ() != IDEAL_CMD ||
1312           h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1313           h->next->next == NULL || h->next->next->Typ() != INT_CMD)
1314        {
1315          Werror("system(\"MPertVectorslp\",ideal, intvec, int) expected");
1316          return TRUE;
1317        }
1318
1319        ideal arg1 = (ideal) h->Data();
1320        intvec* arg2 = (intvec*) h->next->Data();
1321        int arg3 = (int) ((long)(h->next->next->Data()));
1322
1323        intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1324
1325        res->rtyp = INTVEC_CMD;
1326        res->data =  result;
1327        return FALSE;
1328      }
1329        /************** fractal walk **********/
1330    else
1331      if(strcmp(sys_cmd, "Mfpertvector") == 0)
1332      {
1333        if(h==NULL || h->Typ() != IDEAL_CMD ||
1334          h->next==NULL || h->next->Typ() != INTVEC_CMD  )
1335        {
1336          Werror("system(\"Mfpertvector\", ideal,intvec) expected");
1337          return TRUE;
1338        }
1339        ideal arg1 = (ideal) h->Data();
1340        intvec* arg2 = (intvec*) h->next->Data();
1341        intvec* result = Mfpertvector(arg1, arg2);
1342
1343        res->rtyp = INTVEC_CMD;
1344        res->data =  result;
1345        return FALSE;
1346      }
1347    else
1348     if(strcmp(sys_cmd, "MivUnit") == 0)
1349      {
1350        int arg1 = (int) ((long)(h->Data()));
1351
1352        intvec* result = (intvec*) MivUnit(arg1);
1353
1354        res->rtyp = INTVEC_CMD;
1355        res->data =  result;
1356        return FALSE;
1357      }
1358     else
1359       if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1360       {
1361        if(h==NULL || h->Typ() != INTVEC_CMD)
1362        {
1363          Werror("system(\"MivWeightOrderlp\",intvec) expected");
1364          return TRUE;
1365        }
1366        intvec* arg1 = (intvec*) h->Data();
1367        intvec* result = MivWeightOrderlp(arg1);
1368
1369        res->rtyp = INTVEC_CMD;
1370        res->data =  result;
1371        return FALSE;
1372      }
1373     else
1374    if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1375      {
1376        if(h==NULL || h->Typ() != INTVEC_CMD)
1377        {
1378          Werror("system(\"MivWeightOrderdp\",intvec) expected");
1379          return TRUE;
1380        }
1381        intvec* arg1 = (intvec*) h->Data();
1382        //int arg2 = (int) h->next->Data();
1383
1384        intvec* result = MivWeightOrderdp(arg1);
1385
1386        res->rtyp = INTVEC_CMD;
1387        res->data =  result;
1388        return FALSE;
1389      }
1390    else
1391     if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1392      {
1393        if(h==NULL || h->Typ() != INT_CMD)
1394        {
1395          Werror("system(\"MivMatrixOrderlp\",int) expected");
1396          return TRUE;
1397        }
1398        int arg1 = (int) ((long)(h->Data()));
1399
1400        intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1401
1402        res->rtyp = INTVEC_CMD;
1403        res->data =  result;
1404        return FALSE;
1405      }
1406    else
1407    if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1408    {
1409      if (h == NULL || h->Typ() != INTVEC_CMD ||
1410          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1411          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
1412      {
1413        Werror("system(\"MkInterRedNextWeight\", intvec, intvec, ideal) expected");
1414        return TRUE;
1415      }
1416
1417      if (((intvec*) h->Data())->length() != currRing->N ||
1418          ((intvec*) h->next->Data())->length() != currRing->N)
1419      {
1420        Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1421               currRing->N);
1422        return TRUE;
1423      }
1424      intvec* arg1 = (intvec*) h->Data();
1425      intvec* arg2 = (intvec*) h->next->Data();
1426      ideal arg3   =   (ideal) h->next->next->Data();
1427
1428      intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1429
1430      res->rtyp = INTVEC_CMD;
1431      res->data =  result;
1432
1433      return FALSE;
1434    }
1435    else
1436#ifdef MPertNextWeight
1437    if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1438    {
1439      if (h == NULL || h->Typ() != INTVEC_CMD ||
1440          h->next == NULL || h->next->Typ() != IDEAL_CMD ||
1441          h->next->next == NULL || h->next->next->Typ() != INT_CMD)
1442      {
1443        Werror("system(\"MPertNextWeight\", intvec, ideal, int) expected");
1444        return TRUE;
1445      }
1446
1447      if (((intvec*) h->Data())->length() != currRing->N)
1448      {
1449        Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1450               currRing->N);
1451        return TRUE;
1452      }
1453      intvec* arg1 = (intvec*) h->Data();
1454      ideal arg2 = (ideal) h->next->Data();
1455      int arg3   =   (int) h->next->next->Data();
1456
1457      intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1458
1459      res->rtyp = INTVEC_CMD;
1460      res->data =  result;
1461
1462      return FALSE;
1463    }
1464    else
1465#endif //MPertNextWeight
1466#ifdef Mivperttarget
1467  if (strcmp(sys_cmd, "Mivperttarget") == 0)
1468    {
1469      if (h == NULL || h->Typ() != IDEAL_CMD ||
1470          h->next == NULL || h->next->Typ() != INT_CMD )
1471      {
1472        Werror("system(\"Mivperttarget\", ideal, int) expected");
1473        return TRUE;
1474      }
1475
1476      ideal arg1 = (ideal) h->Data();
1477      int arg2 = (int) h->next->Data();
1478
1479      intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1480
1481      res->rtyp = INTVEC_CMD;
1482      res->data =  result;
1483
1484      return FALSE;
1485    }
1486    else
1487#endif //Mivperttarget
1488    if (strcmp(sys_cmd, "Mwalk") == 0)
1489    {
1490      if (h == NULL || h->Typ() != IDEAL_CMD ||
1491          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1492          h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD)
1493      {
1494        Werror("system(\"Mwalk\", ideal, intvec, intvec) expected");
1495        return TRUE;
1496      }
1497
1498      if (((intvec*) h->next->Data())->length() != currRing->N &&
1499          ((intvec*) h->next->next->Data())->length() != currRing->N )
1500      {
1501        Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1502               currRing->N);
1503        return TRUE;
1504      }
1505      ideal arg1 = (ideal) h->Data();
1506      intvec* arg2 = (intvec*) h->next->Data();
1507      intvec* arg3   =  (intvec*) h->next->next->Data();
1508
1509
1510      ideal result = (ideal) Mwalk(arg1, arg2, arg3);
1511
1512      res->rtyp = IDEAL_CMD;
1513      res->data =  result;
1514
1515      return FALSE;
1516    }
1517    else
1518#ifdef MPWALK_ORIG
1519    if (strcmp(sys_cmd, "Mpwalk") == 0)
1520    {
1521      if (h == NULL || h->Typ() != IDEAL_CMD ||
1522          h->next == NULL || h->next->Typ() != INT_CMD ||
1523          h->next->next == NULL || h->next->next->Typ() != INT_CMD ||
1524          h->next->next->next == NULL ||
1525            h->next->next->next->Typ() != INTVEC_CMD ||
1526          h->next->next->next->next == NULL ||
1527            h->next->next->next->next->Typ() != INTVEC_CMD)
1528      {
1529        Werror("system(\"Mpwalk\", ideal, int, int, intvec, intvec) expected");
1530        return TRUE;
1531      }
1532
1533      if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1534          ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1535      {
1536        Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",
1537               currRing->N);
1538        return TRUE;
1539      }
1540      ideal arg1 = (ideal) h->Data();
1541      int arg2 = (int) h->next->Data();
1542      int arg3 = (int) h->next->next->Data();
1543      intvec* arg4 = (intvec*) h->next->next->next->Data();
1544      intvec* arg5   =  (intvec*) h->next->next->next->next->Data();
1545
1546
1547      ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5);
1548
1549      res->rtyp = IDEAL_CMD;
1550      res->data =  result;
1551
1552      return FALSE;
1553    }
1554    else
1555#endif
1556    if (strcmp(sys_cmd, "Mpwalk") == 0)
1557    {
1558      if (h == NULL || h->Typ() != IDEAL_CMD ||
1559          h->next == NULL || h->next->Typ() != INT_CMD ||
1560          h->next->next == NULL || h->next->next->Typ() != INT_CMD ||
1561          h->next->next->next == NULL ||
1562            h->next->next->next->Typ() != INTVEC_CMD ||
1563          h->next->next->next->next == NULL ||
1564            h->next->next->next->next->Typ() != INTVEC_CMD||
1565          h->next->next->next->next->next == NULL ||
1566            h->next->next->next->next->next->Typ() != INT_CMD)
1567      {
1568        Werror("system(\"Mpwalk\", ideal, int, int, intvec, intvec, int) expected");
1569        return TRUE;
1570      }
1571
1572      if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1573          ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1574      {
1575        Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",
1576               currRing->N);
1577        return TRUE;
1578      }
1579      ideal arg1 = (ideal) h->Data();
1580      int arg2 = (int) ((long)(h->next->Data()));
1581      int arg3 = (int) ((long)(h->next->next->Data()));
1582      intvec* arg4 = (intvec*) h->next->next->next->Data();
1583      intvec* arg5   =  (intvec*) h->next->next->next->next->Data();
1584      int arg6   =  (int) ((long)(h->next->next->next->next->next->Data()));
1585
1586
1587      ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1588
1589      res->rtyp = IDEAL_CMD;
1590      res->data =  result;
1591
1592      return FALSE;
1593    }
1594    else
1595    if (strcmp(sys_cmd, "MAltwalk1") == 0)
1596    {
1597      if (h == NULL || h->Typ() != IDEAL_CMD ||
1598          h->next == NULL || h->next->Typ() != INT_CMD ||
1599          h->next->next == NULL || h->next->next->Typ() != INT_CMD ||
1600          h->next->next->next == NULL ||
1601            h->next->next->next->Typ() != INTVEC_CMD ||
1602          h->next->next->next->next == NULL ||
1603            h->next->next->next->next->Typ() != INTVEC_CMD)
1604      {
1605        Werror("system(\"MAltwalk1\", ideal, int, int, intvec, intvec) expected");
1606        return TRUE;
1607      }
1608
1609      if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1610          ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1611      {
1612        Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
1613               currRing->N);
1614        return TRUE;
1615      }
1616      ideal arg1 = (ideal) h->Data();
1617      int arg2 = (int) ((long)(h->next->Data()));
1618      int arg3 = (int) ((long)(h->next->next->Data()));
1619      intvec* arg4 = (intvec*) h->next->next->next->Data();
1620      intvec* arg5   =  (intvec*) h->next->next->next->next->Data();
1621
1622
1623      ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
1624
1625      res->rtyp = IDEAL_CMD;
1626      res->data =  result;
1627
1628      return FALSE;
1629    }
1630#ifdef MFWALK_ALT
1631    else
1632    if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
1633    {
1634      if (h == NULL || h->Typ() != IDEAL_CMD ||
1635          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1636          h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
1637          h->next->next->next == NULL || h->next->next->next->Typ() !=INT_CMD)
1638      {
1639        Werror("system(\"Mfwalk\", ideal, intvec, intvec,int) expected");
1640        return TRUE;
1641      }
1642
1643      if (((intvec*) h->next->Data())->length() != currRing->N &&
1644          ((intvec*) h->next->next->Data())->length() != currRing->N )
1645      {
1646        Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
1647               currRing->N);
1648        return TRUE;
1649      }
1650      ideal arg1 = (ideal) h->Data();
1651      intvec* arg2 = (intvec*) h->next->Data();
1652      intvec* arg3   =  (intvec*) h->next->next->Data();
1653      int arg4 = (int) h->next->next->next->Data();
1654
1655      ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
1656
1657      res->rtyp = IDEAL_CMD;
1658      res->data =  result;
1659
1660      return FALSE;
1661    }
1662#endif
1663    else
1664    if (strcmp(sys_cmd, "Mfwalk") == 0)
1665    {
1666      if (h == NULL || h->Typ() != IDEAL_CMD ||
1667          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1668          h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD)
1669      {
1670        Werror("system(\"Mfwalk\", ideal, intvec, intvec) expected");
1671        return TRUE;
1672      }
1673
1674      if (((intvec*) h->next->Data())->length() != currRing->N &&
1675          ((intvec*) h->next->next->Data())->length() != currRing->N )
1676      {
1677        Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
1678               currRing->N);
1679        return TRUE;
1680      }
1681      ideal arg1 = (ideal) h->Data();
1682      intvec* arg2 = (intvec*) h->next->Data();
1683      intvec* arg3   =  (intvec*) h->next->next->Data();
1684
1685      ideal result = (ideal) Mfwalk(arg1, arg2, arg3);
1686
1687      res->rtyp = IDEAL_CMD;
1688      res->data =  result;
1689
1690      return FALSE;
1691    }
1692    else
1693
1694#ifdef TRAN_Orig
1695    if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
1696    {
1697      if (h == NULL || h->Typ() != IDEAL_CMD ||
1698          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1699          h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD)
1700      {
1701        Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec) expected");
1702        return TRUE;
1703      }
1704
1705      if (((intvec*) h->next->Data())->length() != currRing->N &&
1706          ((intvec*) h->next->next->Data())->length() != currRing->N )
1707      {
1708        Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
1709               currRing->N);
1710        return TRUE;
1711      }
1712      ideal arg1 = (ideal) h->Data();
1713      intvec* arg2 = (intvec*) h->next->Data();
1714      intvec* arg3   =  (intvec*) h->next->next->Data();
1715
1716
1717      ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
1718
1719      res->rtyp = IDEAL_CMD;
1720      res->data =  result;
1721
1722      return FALSE;
1723    }
1724    else
1725#endif
1726    if (strcmp(sys_cmd, "MAltwalk2") == 0)
1727      {
1728      if (h == NULL || h->Typ() != IDEAL_CMD ||
1729          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1730          h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD)
1731      {
1732        Werror("system(\"MAltwalk2\", ideal, intvec, intvec) expected");
1733        return TRUE;
1734      }
1735
1736      if (((intvec*) h->next->Data())->length() != currRing->N &&
1737          ((intvec*) h->next->next->Data())->length() != currRing->N )
1738      {
1739        Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
1740               currRing->N);
1741        return TRUE;
1742      }
1743      ideal arg1 = (ideal) h->Data();
1744      intvec* arg2 = (intvec*) h->next->Data();
1745      intvec* arg3   =  (intvec*) h->next->next->Data();
1746
1747
1748      ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
1749
1750      res->rtyp = IDEAL_CMD;
1751      res->data =  result;
1752
1753      return FALSE;
1754    }
1755    else
1756    if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
1757    {
1758      if (h == NULL || h->Typ() != IDEAL_CMD ||
1759          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1760          h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD||
1761          h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD)
1762      {
1763        Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec, int) expected");
1764        return TRUE;
1765      }
1766
1767      if (((intvec*) h->next->Data())->length() != currRing->N &&
1768          ((intvec*) h->next->next->Data())->length() != currRing->N )
1769      {
1770        Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
1771               currRing->N);
1772        return TRUE;
1773      }
1774      ideal arg1 = (ideal) h->Data();
1775      intvec* arg2 = (intvec*) h->next->Data();
1776      intvec* arg3   =  (intvec*) h->next->next->Data();
1777      int arg4   =  (int) ((long)(h->next->next->next->Data()));
1778
1779      ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
1780
1781      res->rtyp = IDEAL_CMD;
1782      res->data =  result;
1783
1784      return FALSE;
1785    }
1786    else
1787#endif
1788/*================= Extended system call ========================*/
1789   {
1790     #ifndef MAKE_DISTRIBUTION
1791     return(jjEXTENDED_SYSTEM(res, args));
1792     #else
1793     Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1794     #endif
1795   }
1796  } /* typ==string */
1797  return TRUE;
1798}
1799
1800
1801#ifdef HAVE_EXTENDED_SYSTEM
1802// You can put your own system calls here
1803#include "../kernel/fglmcomb.cc"
1804#include "fglm.h"
1805#ifdef HAVE_NEWTON
1806#include <hc_newton.h>
1807#endif
1808#include "mpsr.h"
1809#include "mod_raw.h"
1810#include "ratgring.h"
1811#include "shiftgb.h"
1812
1813static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
1814{
1815  if(h->Typ() == STRING_CMD)
1816  {
1817    char *sys_cmd=(char *)(h->Data());
1818    h=h->next;
1819/*==================== locNF ======================================*/
1820    if(strcmp(sys_cmd,"locNF")==0)
1821    {
1822      if (h != NULL && h->Typ() == VECTOR_CMD)
1823      {
1824        poly f=(poly)h->Data();
1825        h=h->next;
1826        if (h != NULL && h->Typ() == MODUL_CMD)
1827        {
1828          ideal m=(ideal)h->Data();
1829          assumeStdFlag(h);
1830          h=h->next;
1831          if (h != NULL && h->Typ() == INT_CMD)
1832          {
1833            int n=(int)((long)h->Data());
1834            h=h->next;
1835            if (h != NULL && h->Typ() == INTVEC_CMD)
1836            {
1837              intvec *v=(intvec *)h->Data();
1838
1839              /* == now the work starts == */
1840
1841              short * iv=iv2array(v);
1842              poly r=0;
1843              poly hp=ppJetW(f,n,iv);
1844              int s=MATCOLS(m);
1845              int j=0;
1846              matrix T=mpInitI(s,1,0);
1847
1848              while (hp != NULL)
1849              {
1850                if (pDivisibleBy(m->m[j],hp))
1851                  {
1852                    if (MATELEM(T,j+1,1)==0)
1853                    {
1854                      MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
1855                    }
1856                    else
1857                    {
1858                      pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
1859                    }
1860                    hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
1861                    j=0;
1862                  }
1863                else
1864                {
1865                  if (j==s-1)
1866                  {
1867                    r=pAdd(r,pHead(hp));
1868                    hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
1869                    j=0;
1870                  }
1871                  else
1872                  {
1873                    j++;
1874                  }
1875                }
1876              }
1877
1878              matrix Temp=mpTransp((matrix) idVec2Ideal(r));
1879              matrix R=mpNew(MATCOLS((matrix) idVec2Ideal(f)),1);
1880              for (int k=1;k<=MATROWS(Temp);k++)
1881              {
1882                MATELEM(R,k,1)=MATELEM(Temp,k,1);
1883              }
1884
1885              lists L=(lists)omAllocBin(slists_bin);
1886              L->Init(2);
1887              L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)R;
1888              L->m[1].rtyp=MATRIX_CMD;   L->m[1].data=(void *)T;
1889              res->data=L;
1890              res->rtyp=LIST_CMD;
1891              // iv aufraeumen
1892              omFree(iv);
1893            }
1894            else
1895            {
1896              Warn ("4th argument: must be an intvec!");
1897            }
1898          }
1899          else
1900          {
1901            Warn("3rd argument must be an int!!");
1902          }
1903        }
1904        else
1905        {
1906          Warn("2nd argument must be a module!");
1907        }
1908      }
1909      else
1910      {
1911        Warn("1st argument must be a vector!");
1912      }
1913      return FALSE;
1914    }
1915    else
1916/*==================== interred ==================================*/
1917    #if 0
1918    if(strcmp(sys_cmd,"interred")==0)
1919    {
1920      res->data=(char *)kIR((ideal)h->Data(),currQuotient);
1921      res->rtyp=h->Typ();
1922      return ((h->Typ()!=IDEAL_CMD) && (h->Typ()!=MODUL_CMD));
1923    }
1924    else
1925    #endif
1926#ifdef RDEBUG
1927/*==================== poly debug ==================================*/
1928    if(strcmp(sys_cmd,"p")==0)
1929    {
1930      pDebugPrint((poly)h->Data());
1931      return FALSE;
1932    }
1933    else
1934/*==================== ring debug ==================================*/
1935    if(strcmp(sys_cmd,"r")==0)
1936    {
1937      rDebugPrint((ring)h->Data());
1938      return FALSE;
1939    }
1940    else
1941#endif
1942/*==================== mtrack ==================================*/
1943    if(strcmp(sys_cmd,"mtrack")==0)
1944    {
1945#ifdef OM_TRACK
1946      om_Opts.MarkAsStatic = 1;
1947      FILE *fd = NULL;
1948      int max = 5;
1949      while (h != NULL)
1950      {
1951        omMarkAsStaticAddr(h);
1952        if (fd == NULL && h->Typ()==STRING_CMD)
1953        {
1954          fd = fopen((char*) h->Data(), "w");
1955          if (fd == NULL)
1956            Warn("Can not open %s for writing og mtrack. Using stdout");
1957        }
1958        if (h->Typ() == INT_CMD)
1959        {
1960          max = (int)(long)h->Data();
1961        }
1962        h = h->Next();
1963      }
1964      omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
1965      if (fd != NULL) fclose(fd);
1966      om_Opts.MarkAsStatic = 0;
1967      return FALSE;
1968#else
1969     WerrorS("mtrack not supported without OM_TRACK");
1970     return TRUE;
1971#endif
1972    }
1973/*==================== mtrack_all ==================================*/
1974    if(strcmp(sys_cmd,"mtrack_all")==0)
1975    {
1976#ifdef OM_TRACK
1977      om_Opts.MarkAsStatic = 1;
1978      FILE *fd = NULL;
1979      if ((h!=NULL) &&(h->Typ()==STRING_CMD))
1980      {
1981        fd = fopen((char*) h->Data(), "w");
1982        if (fd == NULL)
1983          Warn("Can not open %s for writing og mtrack. Using stdout");
1984        omMarkAsStaticAddr(h);
1985      }
1986      // OB: TBC print to fd
1987      omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
1988      if (fd != NULL) fclose(fd);
1989      om_Opts.MarkAsStatic = 0;
1990      return FALSE;
1991#else
1992     WerrorS("mtrack not supported without OM_TRACK");
1993     return TRUE;
1994#endif
1995    }
1996    else
1997/*==================== backtrace ==================================*/
1998    if(strcmp(sys_cmd,"backtrace")==0)
1999    {
2000#ifndef OM_NDEBUG
2001      omPrintCurrentBackTrace(stdout);
2002      return FALSE;
2003#else
2004     WerrorS("btrack not supported without OM_TRACK");
2005     return TRUE;
2006#endif
2007    }
2008    else
2009/*==================== naIdeal ==================================*/
2010    if(strcmp(sys_cmd,"naIdeal")==0)
2011    {
2012      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2013      {
2014        naSetIdeal((ideal)h->Data());
2015        return FALSE;
2016      }
2017      else
2018         WerrorS("ideal expected");
2019    }
2020    else
2021/*==================== isSqrFree =============================*/
2022#ifdef HAVE_FACTORY
2023    if(strcmp(sys_cmd,"isSqrFree")==0)
2024    {
2025      if ((h!=NULL) &&(h->Typ()==POLY_CMD))
2026      {
2027        res->rtyp=INT_CMD;
2028        res->data=(void *)(long) singclap_isSqrFree((poly)h->Data());
2029        return FALSE;
2030      }
2031      else
2032        WerrorS("poly expected");
2033    }
2034    else
2035#endif
2036/*==================== pDivStat =============================*/
2037#if defined(PDEBUG) || defined(PDIV_DEBUG)
2038    if(strcmp(sys_cmd,"pDivStat")==0)
2039    {
2040      extern void pPrintDivisbleByStat();
2041      pPrintDivisbleByStat();
2042      return FALSE;
2043    }
2044    else
2045#endif
2046/*==================== alarm ==================================*/
2047#ifdef unix
2048    if(strcmp(sys_cmd,"alarm")==0)
2049    {
2050      if ((h!=NULL) &&(h->Typ()==INT_CMD))
2051      {
2052        // standard variant -> SIGALARM (standard: abort)
2053        //alarm((unsigned)h->next->Data());
2054        // process time (user +system): SIGVTALARM
2055        struct itimerval t,o;
2056        memset(&t,0,sizeof(t));
2057        t.it_value.tv_sec     =(unsigned)((unsigned long)h->Data());
2058        setitimer(ITIMER_VIRTUAL,&t,&o);
2059        return FALSE;
2060      }
2061      else
2062        WerrorS("int expected");
2063    }
2064    else
2065#endif
2066/*==================== red =============================*/
2067#if 0
2068    if(strcmp(sys_cmd,"red")==0)
2069    {
2070      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2071      {
2072        res->rtyp=IDEAL_CMD;
2073        res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2074        setFlag(res,FLAG_STD);
2075        return FALSE;
2076      }
2077      else
2078        WerrorS("ideal expected");
2079    }
2080    else
2081#endif
2082#ifdef HAVE_FACTORY
2083/*==================== fastcomb =============================*/
2084    if(strcmp(sys_cmd,"fastcomb")==0)
2085    {
2086      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2087      {
2088        int i=0;
2089        if (h->next!=NULL)
2090        {
2091          if (h->next->Typ()!=POLY_CMD)
2092          {
2093            Warn("Wrong types for poly= comb(ideal,poly)");
2094          }
2095        }
2096        res->rtyp=POLY_CMD;
2097        res->data=(void *) fglmLinearCombination(
2098                           (ideal)h->Data(),(poly)h->next->Data());
2099        return FALSE;
2100      }
2101      else
2102        WerrorS("ideal expected");
2103    }
2104    else
2105/*==================== comb =============================*/
2106    if(strcmp(sys_cmd,"comb")==0)
2107    {
2108      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2109      {
2110        int i=0;
2111        if (h->next!=NULL)
2112        {
2113          if (h->next->Typ()!=POLY_CMD)
2114          {
2115              Warn("Wrong types for poly= comb(ideal,poly)");
2116          }
2117        }
2118        res->rtyp=POLY_CMD;
2119        res->data=(void *)fglmNewLinearCombination(
2120                            (ideal)h->Data(),(poly)h->next->Data());
2121        return FALSE;
2122      }
2123      else
2124        WerrorS("ideal expected");
2125    }
2126    else
2127#endif
2128#ifdef FACTORY_GCD_TEST
2129/*=======================gcd Testerei ================================*/
2130    if ( ! strcmp( sys_cmd, "setgcd" ) ) {
2131        if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
2132            CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
2133            return FALSE;
2134        } else
2135            WerrorS("int expected");
2136    }
2137    else
2138#endif
2139
2140#ifdef FACTORY_GCD_TIMING
2141    if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
2142        TIMING_PRINT( contentTimer, "time used for content: " );
2143        TIMING_PRINT( algContentTimer, "time used for algContent: " );
2144        TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
2145        TIMING_RESET( contentTimer );
2146        TIMING_RESET( algContentTimer );
2147        TIMING_RESET( algLcmTimer );
2148        return FALSE;
2149    }
2150    else
2151#endif
2152
2153#ifdef FACTORY_GCD_STAT
2154    if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
2155        printGcdTotal();
2156        printContTotal();
2157        resetGcdTotal();
2158        resetContTotal();
2159        return FALSE;
2160    }
2161    else
2162#endif
2163#if !defined(HAVE_NS)
2164/*==================== lib ==================================*/
2165    if(strcmp(sys_cmd,"LIB")==0)
2166    {
2167      idhdl hh=idroot->get((char*)h->Data(),0);
2168      if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
2169      {
2170        res->rtyp=STRING_CMD;
2171        char *r=iiGetLibName(IDPROC(hh));
2172        if (r==NULL) r="";
2173        res->data=omStrDup(r);
2174        return FALSE;
2175      }
2176      else
2177        Warn("`%s` not found",(char*)h->Data());
2178    }
2179    else
2180#endif
2181/*==================== listall ===================================*/
2182    if(strcmp(sys_cmd,"listall")==0)
2183    {
2184      int showproc=0;
2185      if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2186#ifdef HAVE_NS
2187      listall(showproc);
2188#else
2189      idhdl hh=IDROOT;
2190      while (hh!=NULL)
2191      {
2192        if (IDDATA(hh)==(void *)currRing) PrintS("(R)");
2193        else PrintS("   ");
2194        Print("::%s, typ %s level %d\n",
2195               IDID(hh),Tok2Cmdname(IDTYP(hh)),IDLEV(hh));
2196        hh=IDNEXT(hh);
2197      }
2198      hh=IDROOT;
2199      while (hh!=NULL)
2200      {
2201        if ((IDTYP(hh)==RING_CMD)
2202        || (IDTYP(hh)==QRING_CMD)
2203        || (IDTYP(hh)==PACKAGE_CMD))
2204        {
2205          idhdl h2=IDRING(hh)->idroot;
2206          while (h2!=NULL)
2207          {
2208            if (IDDATA(h2)==(void *)currRing) PrintS("(R)");
2209            else PrintS("   ");
2210            Print("%s::%s, typ %s level %d\n",
2211            IDID(hh),IDID(h2),Tok2Cmdname(IDTYP(h2)),IDLEV(h2));
2212            h2=IDNEXT(h2);
2213          }
2214        }
2215        hh=IDNEXT(hh);
2216      }
2217#endif /* HAVE_NS */
2218      return FALSE;
2219    }
2220    else
2221/*==================== proclist =================================*/
2222    if(strcmp(sys_cmd,"proclist")==0)
2223    {
2224      piShowProcList();
2225      return FALSE;
2226    }
2227    else
2228/* ==================== newton ================================*/
2229#ifdef HAVE_NEWTON
2230    if(strcmp(sys_cmd,"newton")==0)
2231    {
2232      if ((h->Typ()!=POLY_CMD)
2233      || (h->next->Typ()!=INT_CMD)
2234      || (h->next->next->Typ()!=INT_CMD))
2235      {
2236        WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2237        return TRUE;
2238      }
2239      poly  p=(poly)(h->Data());
2240      int l=pLength(p);
2241      short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2242      int i,j,k;
2243      k=0;
2244      poly pp=p;
2245      for (i=0;pp!=NULL;i++)
2246      {
2247        for(j=1;j<=currRing->N;j++)
2248        {
2249          points[k]=pGetExp(pp,j);
2250          k++;
2251        }
2252        pIter(pp);
2253      }
2254      hc_ERG r=hc_KOENIG(currRing->N,      // dimension
2255                l,      // number of points
2256                (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
2257                currRing->OrdSgn==-1,
2258                (int) (h->next->Data()),      // 1: Milnor, 0: Newton
2259                (int) (h->next->next->Data()) // debug
2260               );
2261      //----<>---Output-----------------------
2262
2263
2264//  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2265
2266
2267      lists L=(lists)omAllocBin(slists_bin);
2268      L->Init(6);
2269      L->m[0].rtyp=STRING_CMD;               // newtonnumber;
2270      L->m[0].data=(void *)omStrDup(r.nZahl);
2271      L->m[1].rtyp=INT_CMD;
2272      L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
2273      L->m[2].rtyp=INT_CMD;
2274      L->m[2].data=(void *)r.deg;            // #degenerations
2275      if ( r.deg != 0)              // only if degenerations exist
2276      {
2277        L->m[3].rtyp=INT_CMD;
2278        L->m[3].data=(void *)r.anz_punkte;     // #points
2279        //---<>--number of points------
2280        int anz = r.anz_punkte;    // number of points
2281        int dim = (currRing->N);     // dimension
2282        intvec* v = new intvec( anz*dim );
2283        for (i=0; i<anz*dim; i++)    // copy points
2284          (*v)[i] = r.pu[i];
2285        L->m[4].rtyp=INTVEC_CMD;
2286        L->m[4].data=(void *)v;
2287        //---<>--degenerations---------
2288        int deg = r.deg;    // number of points
2289        intvec* w = new intvec( r.speicher );  // necessary memeory
2290        i=0;               // start copying
2291        do
2292        {
2293          (*w)[i] = r.deg_tab[i];
2294          i++;
2295        }
2296        while (r.deg_tab[i-1] != -2);   // mark for end of list
2297        L->m[5].rtyp=INTVEC_CMD;
2298        L->m[5].data=(void *)w;
2299      }
2300      else
2301      {
2302        L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2303        L->m[4].rtyp=DEF_CMD;
2304        L->m[5].rtyp=DEF_CMD;
2305      }
2306
2307      res->data=(void *)L;
2308      res->rtyp=LIST_CMD;
2309      // free all pointer in r:
2310      delete[] r.nZahl;
2311      delete[] r.pu;
2312      delete[] r.deg_tab;      // Ist das ein Problem??
2313
2314      omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2315      return FALSE;
2316    }
2317    else
2318#endif
2319/*==================== sdb_flags =================*/
2320#ifdef HAVE_SDB
2321    if (strcmp(sys_cmd, "sdb_flags") == 0)
2322    {
2323      if ((h!=NULL) && (h->Typ()==INT_CMD))
2324      {
2325        sdb_flags=(int)((long)h->Data());
2326      }
2327      else
2328      {
2329        WerrorS("system(\"sdb_flags\",`int`) expected");
2330        return TRUE;
2331      }
2332      return FALSE;
2333    }
2334    else
2335/*==================== sdb_edit =================*/
2336    if (strcmp(sys_cmd, "sdb_edit") == 0)
2337    {
2338      if ((h!=NULL) && (h->Typ()==PROC_CMD))
2339      {
2340        procinfov p=(procinfov)h->Data();
2341        sdb_edit(p);
2342      }
2343      else
2344      {
2345        WerrorS("system(\"sdb_edit\",`proc`) expected");
2346        return TRUE;
2347      }
2348      return FALSE;
2349    }
2350    else
2351#endif
2352/*==================== GF =================*/
2353#if 0 // for testing only
2354    if (strcmp(sys_cmd, "GF") == 0)
2355    {
2356      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2357      {
2358        int c=rChar(currRing);
2359        setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2360        CanonicalForm F( convSingGFFactoryGF( (poly)h->Data() ) );
2361        res->rtyp=POLY_CMD;
2362        res->data=convFactoryGFSingGF( F );
2363        return FALSE;
2364      }
2365      else { Werror("wrong typ"); return TRUE;}
2366    }
2367    else
2368#endif
2369/*==================== stdX =================*/
2370    if (strcmp(sys_cmd, "std") == 0)
2371    {
2372      ideal i1;
2373      int i2;
2374      if ((h!=NULL) && (h->Typ()==MODUL_CMD))
2375      {
2376        i1=(ideal)h->CopyD();
2377        h=h->next;
2378      }
2379      else return TRUE;
2380      if ((h!=NULL) && (h->Typ()==INT_CMD))
2381      {
2382        i2=(int)((long)h->Data());
2383      }
2384      else return TRUE;
2385      res->rtyp=MODUL_CMD;
2386      res->data=idXXX(i1,i2);
2387      return FALSE;
2388    }
2389    else
2390/*==================== SVD =================*/
2391#ifdef HAVE_SVD
2392     if (strcmp(sys_cmd, "svd") == 0)
2393     {
2394          extern lists testsvd(matrix M);
2395            res->rtyp=LIST_CMD;
2396          res->data=(char*)(testsvd((matrix)h->Data()));
2397          return FALSE;
2398     }
2399     else
2400#endif
2401#ifdef ix86_Win
2402#ifdef HAVE_DL
2403/*==================== DLL =================*/
2404/* testing the DLL functionality under Win32 */
2405      if (strcmp(sys_cmd, "DLL") == 0)
2406      {
2407        typedef void  (*Void_Func)();
2408        typedef int  (*Int_Func)(int);
2409        void *hh=dynl_open("WinDllTest.dll");
2410        if ((h!=NULL) && (h->Typ()==INT_CMD))
2411        {
2412          int (*f)(int);
2413          if (hh!=NULL)
2414          {
2415            int (*f)(int);
2416            f=(Int_Func)dynl_sym(hh,"PlusDll");
2417            int i=10;
2418            if (f!=NULL) printf("%d\n",f(i));
2419            else PrintS("cannot find PlusDll\n");
2420          }
2421        }
2422        else
2423        {
2424          void (*f)();
2425          f= (Void_Func)dynl_sym(hh,"TestDll");
2426          if (f!=NULL) f();
2427          else PrintS("cannot find TestDll\n");
2428        }
2429        return FALSE;
2430      }
2431      else
2432#endif
2433#endif
2434/*==================== eigenvalues ==================================*/
2435#ifdef HAVE_EIGENVAL
2436    if(strcmp(sys_cmd,"eigenvals")==0)
2437    {
2438      return evEigenvals(res,h);
2439    }
2440    else
2441#endif
2442/*==================== Gauss-Manin system ==================================*/
2443#ifdef HAVE_GMS
2444    if(strcmp(sys_cmd,"gmsnf")==0)
2445    {
2446      return gmsNF(res,h);
2447    }
2448    else
2449#endif
2450/*==================== facstd_debug ==================================*/
2451#if !defined(NDEBUG)
2452    if(strcmp(sys_cmd,"facstd")==0)
2453    {
2454      extern int strat_nr;
2455      extern int strat_fac_debug;
2456      strat_fac_debug=(int)(long)h->Data();
2457      strat_nr=0;
2458      return FALSE;
2459    }
2460    else
2461#endif
2462#ifdef HAVE_RING2TOM
2463/*==================== ring-GB ==================================*/
2464    if (strcmp(sys_cmd, "findZeroPoly")==0)
2465    {
2466      ring r = currRing;
2467      poly f = (poly) h->Data();
2468      res->rtyp=POLY_CMD;
2469      res->data=(poly) kFindZeroPoly(f, r, r);
2470      return(FALSE);
2471    }
2472    else
2473#ifdef HAVE_VANIDEAL
2474/*==================== Creating zero polynomials =================*/
2475    if (strcmp(sys_cmd, "createG0")==0)
2476    {
2477      /* long exp[50];
2478      int N = 0;
2479      while (h != NULL)
2480      {
2481        N += 1;
2482        exp[N] = (long) h->Data();
2483        // if (exp[i] % 2 != 0) exp[i] -= 1;
2484        h = h->next;
2485      }
2486      for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
2487
2488      poly t_p;
2489      res->rtyp=POLY_CMD;
2490      res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
2491      return(FALSE); */
2492
2493      res->rtyp = IDEAL_CMD;
2494      res->data = (ideal) createG0();
2495      return(FALSE);
2496    }
2497    else
2498#endif
2499    if (strcmp(sys_cmd, "redNF_ring")==0)
2500    {
2501      ring r = currRing;
2502      poly f = (poly) h->Data();
2503      h = h->next;
2504      ideal G = (ideal) h->Data();
2505      res->rtyp=POLY_CMD;
2506      res->data=(poly) ringRedNF(f, G, r);
2507      return(FALSE);
2508    }
2509    else
2510#endif
2511    if (strcmp(sys_cmd, "minor")==0)
2512    {
2513      ring r = currRing;
2514      matrix a = (matrix) h->Data();
2515      h = h->next;
2516      int ar = (int)(long) h->Data();
2517      h = h->next;
2518      int which = (int)(long) h->Data();
2519      h = h->next;
2520      ideal R = NULL;
2521      if (h != NULL)
2522      {
2523        R = (ideal) h->Data();
2524      }
2525      res->data=(poly) idMinor(a, ar, (unsigned long) which, R);
2526      if (res->data == (poly) 1)
2527      {
2528        res->rtyp=INT_CMD;
2529        res->data = 0;
2530      }
2531      else
2532      {
2533        res->rtyp=POLY_CMD;
2534      }
2535      return(FALSE);
2536    }
2537    else
2538#ifdef HAVE_F5
2539/*==================== F5 Implementation =================*/
2540    if (strcmp(sys_cmd, "f5")==0)
2541    {
2542      if (h->Typ()!=IDEAL_CMD)
2543      {
2544        WerrorS("ideal expected");
2545        return TRUE;
2546      } 
2547     
2548      ring r = currRing;
2549      ideal G = (ideal) h->Data();
2550      res->rtyp=IDEAL_CMD;
2551      res->data=(ideal) F5main(G,r);
2552      return TRUE;
2553    }
2554    else
2555#endif
2556#ifdef HAVE_RINGS
2557/*==================== Testing groebner basis =================*/
2558    if (strcmp(sys_cmd, "NF_ring")==0)
2559    {
2560      ring r = currRing;
2561      poly f = (poly) h->Data();
2562      h = h->next;
2563      ideal G = (ideal) h->Data();
2564      res->rtyp=POLY_CMD;
2565      res->data=(poly) ringNF(f, G, r);
2566      return(FALSE);
2567    }
2568    else
2569    if (strcmp(sys_cmd, "spoly")==0)
2570    {
2571      poly f = pCopy((poly) h->Data());
2572      h = h->next;
2573      poly g = pCopy((poly) h->Data());
2574
2575      res->rtyp=POLY_CMD;
2576      res->data=(poly) plain_spoly(f,g);
2577      return(FALSE);
2578    }
2579    else
2580    if (strcmp(sys_cmd, "testGB")==0)
2581    {
2582      ideal I = (ideal) h->Data();
2583      h = h->next;
2584      ideal GI = (ideal) h->Data();
2585      res->rtyp = INT_CMD;
2586      res->data = (void *) testGB(I, GI);
2587      return(FALSE);
2588    }
2589    else
2590#endif
2591#ifdef HAVE_PLURAL
2592/*==================== sca?AltVar ==================================*/
2593    if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
2594    {
2595      ring r = currRing;
2596
2597      if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
2598      {
2599        WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
2600        return TRUE;
2601      }
2602
2603      res->rtyp=INT_CMD;
2604
2605      if (rIsSCA(r))
2606      {
2607        if(strcmp(sys_cmd, "AltVarStart") == 0)
2608          res->data = (void*)scaFirstAltVar(r);
2609        else
2610          res->data = (void*)scaLastAltVar(r);
2611        return FALSE;
2612      }
2613
2614      WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
2615      return TRUE;
2616    }
2617    else
2618#endif
2619#ifdef HAVE_PLURAL
2620#ifdef HAVE_RATGRING
2621/*==================== RatNF, noncomm rational coeffs =================*/
2622    if (strcmp(sys_cmd, "intratNF") == 0)
2623    {
2624      poly p;
2625      poly *q;
2626      ideal I;
2627      int is, k, id;
2628      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2629      {
2630        p=(poly)h->CopyD();
2631        h=h->next;
2632        //      Print("poly is done\n");
2633      }
2634      else return TRUE;
2635      if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2636      {
2637        I=(ideal)h->CopyD();
2638        q = I->m;
2639        h=h->next;
2640        //      Print("ideal is done\n");
2641      }
2642      else return TRUE;
2643      if ((h!=NULL) && (h->Typ()==INT_CMD))
2644      {
2645        is=(int)((long)(h->Data()));
2646        //      res->rtyp=INT_CMD;
2647        //      Print("int is done\n");
2648        //      res->rtyp=IDEAL_CMD;
2649        if (rIsPluralRing(currRing))
2650        { 
2651          id = IDELEMS(I);
2652                 int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
2653          for(k=0; k < id; k++)
2654          {
2655            pl[k] = pLength(I->m[k]);
2656          }
2657          Print("starting redRat\n");
2658          //res->data = (char *)
2659          redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
2660          res->data=p;
2661          res->rtyp=POLY_CMD;
2662          //    res->data = ncGCD(p,q,currRing);       
2663        }
2664        else 
2665        {
2666          res->rtyp=POLY_CMD;
2667          res->data=p;
2668        }
2669      }
2670      else return TRUE;
2671      return FALSE;
2672    }
2673    else
2674/*==================== RatNF, noncomm rational coeffs =================*/
2675    if (strcmp(sys_cmd, "ratNF") == 0)
2676    {
2677      poly p,q;
2678      int is, htype;
2679      if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
2680      {
2681        p=(poly)h->CopyD();
2682        h=h->next;
2683        htype = h->Typ();
2684      }
2685      else return TRUE;
2686      if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
2687      {
2688        q=(poly)h->CopyD();
2689        h=h->next;
2690      }
2691      else return TRUE;
2692      if ((h!=NULL) && (h->Typ()==INT_CMD))
2693      {
2694        is=(int)((long)(h->Data()));
2695        res->rtyp=htype;
2696        //      res->rtyp=IDEAL_CMD;
2697        if (rIsPluralRing(currRing))
2698        { 
2699          res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
2700          //    res->data = ncGCD(p,q,currRing);       
2701        }
2702        else res->data=p;
2703      }
2704      else return TRUE;
2705      return FALSE;
2706    }
2707    else
2708/*==================== RatSpoly, noncomm rational coeffs =================*/
2709    if (strcmp(sys_cmd, "ratSpoly") == 0)
2710    {
2711      poly p,q;
2712      int is;
2713      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2714      {
2715        p=(poly)h->CopyD();
2716        h=h->next;
2717      }
2718      else return TRUE;
2719      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2720      {
2721        q=(poly)h->CopyD();
2722        h=h->next;
2723      }
2724      else return TRUE;
2725      if ((h!=NULL) && (h->Typ()==INT_CMD))
2726      {
2727        is=(int)((long)(h->Data()));
2728        res->rtyp=POLY_CMD;
2729        //      res->rtyp=IDEAL_CMD;
2730        if (rIsPluralRing(currRing))
2731        { 
2732          res->data = nc_rat_CreateSpoly(p,q,is,currRing);
2733          //    res->data = ncGCD(p,q,currRing);       
2734        }
2735        else res->data=p;
2736      }
2737      else return TRUE;
2738      return FALSE;
2739    }
2740    else
2741#endif // HAVE_RATGRING
2742/*==================== Rat def =================*/
2743    if (strcmp(sys_cmd, "ratVar") == 0)
2744    {
2745      int start,end;
2746      int is;
2747      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2748      {
2749        start=pIsPurePower((poly)h->Data());
2750        h=h->next;
2751      }
2752      else return TRUE;
2753      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2754      {
2755        end=pIsPurePower((poly)h->Data());
2756        h=h->next;
2757      }
2758      else return TRUE;
2759      currRing->real_var_start=start;
2760      currRing->real_var_end=end;
2761      return (start==0)||(end==0)||(start>end);
2762    }
2763    else
2764/*==================== shift-test for freeGB  =================*/
2765#ifdef HAVE_SHIFTBBA
2766    if (strcmp(sys_cmd, "stest") == 0)
2767    {
2768      poly p;
2769      int sh,uptodeg, lVblock;
2770      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2771      {
2772        p=(poly)h->CopyD();
2773        h=h->next;
2774      }
2775      else return TRUE;
2776      if ((h!=NULL) && (h->Typ()==INT_CMD))
2777      {
2778        sh=(int)((long)(h->Data()));
2779        h=h->next;
2780      }
2781      else return TRUE;
2782
2783      if ((h!=NULL) && (h->Typ()==INT_CMD))
2784      {
2785        uptodeg=(int)((long)(h->Data()));
2786        h=h->next;
2787      }
2788      else return TRUE;
2789      if ((h!=NULL) && (h->Typ()==INT_CMD))
2790      {
2791        lVblock=(int)((long)(h->Data()));
2792        res->data = pLPshift(p,sh,uptodeg,lVblock);
2793        res->rtyp = POLY_CMD;
2794      }
2795      else return TRUE;
2796      return FALSE;
2797    }
2798    else
2799#endif
2800/*==================== block-test for freeGB  =================*/
2801#ifdef HAVE_SHIFTBBA
2802    if (strcmp(sys_cmd, "btest") == 0)
2803    {
2804      poly p;
2805      int lV;
2806      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2807      {
2808        p=(poly)h->CopyD();
2809        h=h->next;
2810      }
2811      else return TRUE;
2812      if ((h!=NULL) && (h->Typ()==INT_CMD))
2813      {
2814        lV=(int)((long)(h->Data()));
2815        res->rtyp = INT_CMD;
2816        res->data = (void*)pLastVblock(p, lV);
2817      }
2818      else return TRUE;
2819      return FALSE;
2820    }
2821    else
2822/*==================== shrink-test for freeGB  =================*/
2823    if (strcmp(sys_cmd, "shrinktest") == 0)
2824    {
2825      poly p;
2826      int lV;
2827      if ((h!=NULL) && (h->Typ()==POLY_CMD))
2828      {
2829        p=(poly)h->CopyD();
2830        h=h->next;
2831      }
2832      else return TRUE;
2833      if ((h!=NULL) && (h->Typ()==INT_CMD))
2834      {
2835        lV=(int)((long)(h->Data()));
2836        res->rtyp = POLY_CMD;
2837        //      res->data = p_mShrink(p, lV, currRing);
2838        //      kStrategy strat=new skStrategy;
2839        //      strat->tailRing = currRing;
2840        res->data = p_Shrink(p, lV, currRing);
2841      }
2842      else return TRUE;
2843      return FALSE;
2844    }
2845    else
2846#endif
2847#endif
2848/*==================== t-rep-GB ==================================*/
2849    if (strcmp(sys_cmd, "unifastmult")==0)
2850    {
2851      ring r = currRing;
2852      poly f = (poly)h->Data();
2853      h=h->next;
2854      poly g=(poly)h->Data();
2855      res->rtyp=POLY_CMD;
2856      res->data=unifastmult(f,g,currRing);
2857      return(FALSE);
2858    }
2859    else
2860    if (strcmp(sys_cmd, "multifastmult")==0)
2861    {
2862      ring r = currRing;
2863      poly f = (poly)h->Data();
2864      h=h->next;
2865      poly g=(poly)h->Data();
2866      res->rtyp=POLY_CMD;
2867      res->data=multifastmult(f,g,currRing);
2868      return(FALSE);
2869    }
2870    else
2871    if (strcmp(sys_cmd, "mults")==0)
2872    {
2873      res->rtyp=INT_CMD ;
2874      res->data=(void*)(long) Mults();
2875      return(FALSE);
2876    }
2877    else
2878    if (strcmp(sys_cmd, "fastpower")==0)
2879    {
2880      ring r = currRing;
2881      poly f = (poly)h->Data();
2882      h=h->next;
2883      int n=(int)((long)h->Data());
2884      res->rtyp=POLY_CMD ;
2885      res->data=(void*) pFastPower(f,n,r);
2886      return(FALSE);
2887    }
2888    else
2889    if (strcmp(sys_cmd, "normalpower")==0)
2890    {
2891      ring r = currRing;
2892      poly f = (poly)h->Data();
2893      h=h->next;
2894      int n=(int)((long)h->Data());
2895      res->rtyp=POLY_CMD ;
2896      res->data=(void*) pPower(pCopy(f),n);
2897      return(FALSE);
2898    }
2899    else
2900    if (strcmp(sys_cmd, "MCpower")==0)
2901    {
2902      ring r = currRing;
2903      poly f = (poly)h->Data();
2904      h=h->next;
2905      int n=(int)((long)h->Data());
2906      res->rtyp=POLY_CMD ;
2907      res->data=(void*) pFastPowerMC(f,n,r);
2908      return(FALSE);
2909    }
2910    else
2911    if (strcmp(sys_cmd, "bit_subst")==0)
2912    {
2913      ring r = currRing;
2914      poly outer = (poly)h->Data();
2915      h=h->next;
2916      poly inner=(poly)h->Data();
2917      res->rtyp=POLY_CMD ;
2918      res->data=(void*) uni_subst_bits(outer, inner,r);
2919      return(FALSE);
2920    }
2921    else
2922/*==================== bifac =================*/
2923#ifdef HAVE_BIFAC
2924    if (strcmp(sys_cmd, "bifac")==0)
2925    {
2926      if (h->Typ()!=POLY_CMD)
2927      {
2928        WerrorS("`system(\"bifac\",<poly>) expected");
2929        return TRUE;
2930      }
2931      if (!rField_is_Q())
2932      {
2933        WerrorS("coeff field must be Q");
2934        return TRUE;
2935      }
2936      BIFAC B;
2937      CFFList C;
2938      int sw_rat=isOn(SW_RATIONAL);
2939      On(SW_RATIONAL);
2940      CanonicalForm F( convSingPClapP((poly)(h->Data())));
2941      B.bifac(F, 1);
2942      CFFList L=B.getFactors();
2943      // construct the ring ==============================================
2944      int i;
2945      int lev=ExtensionLevel();
2946      char **names=(char**)omAlloc0(lev*sizeof(char_ptr));
2947      for(i=1;i<=lev; i++)
2948      {
2949        StringSetS("");
2950        names[i-1]=omStrDup(StringAppend("a(%d)",i));
2951      }
2952      ring alg_ring=rDefault(0,lev,names);
2953      ring new_ring=rCopy0(currRing); // all variable names, ordering etc.
2954      new_ring->P=lev;
2955      new_ring->parameter=names;
2956      new_ring->algring=alg_ring;
2957      new_ring->ch=1;
2958      rComplete(new_ring,TRUE);
2959      // set the mipo ===============================================
2960      ring save_currRing=currRing; idhdl save_currRingHdl=currRingHdl;
2961      rChangeCurrRing(alg_ring);
2962      ideal mipo_id=idInit(lev,1);
2963      for (i=lev; i>0;i--)
2964      {
2965        CanonicalForm Mipo=getMipo(Variable(-i),Variable(i));
2966        mipo_id->m[i-1]=convClapPSingP(Mipo);
2967      }
2968      idShow(mipo_id);
2969      alg_ring->qideal=mipo_id;
2970      rChangeCurrRing(new_ring);
2971      for (i=lev-1; i>=0;i--)
2972      {
2973        poly p=pOne();
2974        lnumber n=(lnumber)pGetCoeff(p);
2975        // no need to delete nac 1
2976        n->z=(napoly)mipo_id->m[i];
2977        mipo_id->m[i]=p;
2978      }
2979      new_ring->minideal=id_Copy(alg_ring->qideal,new_ring);
2980      // convert factors =============================================
2981      ideal fac_id=idInit(L.length(),1);
2982      CFFListIterator J=L;
2983      i=0;
2984      intvec *v = new intvec( L.length() );
2985      for ( ; J.hasItem(); J++,i++ )
2986      {
2987        fac_id->m[i]=convClapAPSingAP( J.getItem().factor() );
2988        (*v)[i]=J.getItem().exp();
2989      }
2990      idhdl hh=enterid("factors",0,LIST_CMD,&(currRing->idroot),FALSE);
2991      lists LL=(lists)omAllocBin( slists_bin);
2992      LL->Init(2);
2993      LL->m[0].rtyp=IDEAL_CMD;
2994      LL->m[0].data=(char *)fac_id;
2995      LL->m[1].rtyp=INTVEC_CMD;
2996      LL->m[1].data=(char *)v;
2997      IDDATA(hh)=(char *)LL;
2998
2999      rChangeCurrRing(save_currRing);
3000      currRingHdl=save_currRingHdl;
3001      if (!sw_rat) Off(SW_RATIONAL);
3002
3003      res->data=new_ring;
3004      res->rtyp=RING_CMD;
3005      return FALSE;
3006    }
3007    else
3008#endif
3009/*==================== gcd-varianten =================*/
3010    if (strcmp(sys_cmd, "gcd") == 0)
3011    {
3012      if (h==NULL)
3013      {
3014        Print("NTL_0:%d (use NTL for gcd of polynomials in char 0)\n",isOn(SW_USE_NTL_GCD_0));
3015        Print("NTL_p:%d (use NTL for gcd of polynomials in char p)\n",isOn(SW_USE_NTL_GCD_P));
3016        Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3017        Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3018        Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3019        Print("SPARSEMOD:%d (use SPARSEMOD for gcd of polynomials in char 0)\n",isOn(SW_USE_SPARSEMOD));
3020        Print("QGCD:%d (use QGCD for gcd of polynomials in alg. ext.)\n",isOn(SW_USE_QGCD));
3021        Print("FGCD:%d (use fieldGCD for gcd of polynomials in Z/p)\n",isOn(SW_USE_fieldGCD));
3022        Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3023        return FALSE;
3024      }
3025      else
3026      if ((h!=NULL) && (h->Typ()==STRING_CMD)
3027      && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3028      {
3029        int d=(int)(long)h->next->Data();
3030        char *s=(char *)h->Data();
3031        if (strcmp(s,"NTL_0")==0) { if (d) On(SW_USE_NTL_GCD_0); else Off(SW_USE_NTL_GCD_0); } else
3032        if (strcmp(s,"NTL_p")==0) { if (d) On(SW_USE_NTL_GCD_P); else Off(SW_USE_NTL_GCD_P); } else
3033        if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3034        if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3035        if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3036        if (strcmp(s,"SPARSEMOD")==0) { if (d) On(SW_USE_SPARSEMOD); else Off(SW_USE_SPARSEMOD); } else
3037        if (strcmp(s,"QGCD")==0) { if (d) On(SW_USE_QGCD); else Off(SW_USE_QGCD); } else
3038        if (strcmp(s,"FGCD")==0) { if (d) On(SW_USE_fieldGCD); else Off(SW_USE_fieldGCD); } else
3039        if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3040        return TRUE;
3041        return FALSE;
3042      }
3043      else return TRUE;
3044    }
3045    else
3046#if 0
3047/*==================== gcd-test =================*/
3048    if (strcmp(sys_cmd, "GCD") == 0)
3049    {
3050      if ((h!=NULL) && (h->Typ()==POLY_CMD)
3051      && (h->next!=NULL) && (h->next->Typ()==POLY_CMD))
3052      {
3053        poly f=(poly)h->Data();
3054        poly g=(poly)h->next->Data();
3055        res->rtyp=POLY_CMD;
3056        res->data=(char*)id_GCD(f,g,currRing);
3057        return FALSE;
3058      }
3059      else return TRUE;
3060    }
3061    else
3062#endif
3063/*==================== subring =================*/
3064    if (strcmp(sys_cmd, "subring") == 0)
3065    {
3066      if (h!=NULL)
3067      {
3068        extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3069        res->data=(char *)rSubring(currRing,h);
3070        res->rtyp=RING_CMD;
3071        return res->data==NULL;
3072      }
3073      else return TRUE;
3074    }
3075    else
3076#ifdef ix86_Win
3077/*==================== Python Singular =================*/
3078    if (strcmp(sys_cmd, "python") == 0)
3079    {
3080      const char* c;
3081      if ((h!=NULL) && (h->Typ()==STRING_CMD))
3082      {
3083        c=(const char*)h->Data();
3084        if (!PyInitialized) {
3085          PyInitialized = 1;
3086//          Py_Initialize();
3087//          initPySingular();
3088        }
3089//      PyRun_SimpleString(c);
3090        return FALSE;
3091      }
3092      else return TRUE;
3093    }
3094    else
3095/*==================== Python Singular =================
3096    if (strcmp(sys_cmd, "ipython") == 0)
3097    {
3098      const char* c;
3099      {
3100        if (!PyInitialized) {
3101          PyInitialized = 1;
3102          Py_Initialize();
3103          initPySingular();
3104        }
3105  PyRun_SimpleString(
3106"try:                                                                                       \n\
3107    __IPYTHON__                                                                             \n\
3108except NameError:                                                                           \n\
3109    argv = ['']                                                                             \n\
3110    banner = exit_msg = ''                                                                  \n\
3111else:                                                                                       \n\
3112    # Command-line options for IPython (a list like sys.argv)                               \n\
3113    argv = ['-pi1','In <\\#>:','-pi2','   .\\D.:','-po','Out<\\#>:']                        \n\
3114    banner = '*** Nested interpreter ***'                                                   \n\
3115    exit_msg = '*** Back in main IPython ***'                                               \n\
3116                          \n\
3117# First import the embeddable shell class                                                   \n\
3118from IPython.Shell import IPShellEmbed                                                      \n\
3119# Now create the IPython shell instance. Put ipshell() anywhere in your code                \n\
3120# where you want it to open.                                                                \n\
3121ipshell = IPShellEmbed(argv,banner=banner,exit_msg=exit_msg)                                \n\
3122ipshell()");
3123        return FALSE;
3124      }
3125    }
3126    else
3127              */
3128
3129#endif
3130
3131#ifdef HAVE_GFAN
3132/*======== GFAN ==============*/
3133/*
3134WILL HAVE TO CHANGE RETURN TYPE TO LIST_CMD
3135*/
3136if (strcmp(sys_cmd,"gfan")==0)
3137{
3138        if ((h==NULL) || (h!=NULL && h->Typ()!=IDEAL_CMD))
3139        {
3140                Werror("system(\"gfan\"...) Ideal expected");
3141                return TRUE; //Ooooops
3142        }
3143ideal I=((ideal)h->Data());
3144res->rtyp=IDEAL_CMD;
3145res->data=(ideal) gfan(I);
3146//res->rtyp=LIST_CMD;
3147//res->data= ???
3148       
3149return FALSE; //Everything went fine   
3150}
3151else
3152#endif
3153
3154/*==================== Error =================*/
3155      Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3156  }
3157  return TRUE;
3158}
3159
3160#endif // HAVE_EXTENDED_SYSTEM
3161
3162
Note: See TracBrowser for help on using the repository browser.