source: git/Singular/extra.cc @ dabe365

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