source: git/Singular/extra.cc @ 6b4ff12

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