source: git/Singular/extra.cc @ df237c4

spielwiese
Last change on this file since df237c4 was df237c4, checked in by Hans Schönemann <hannes@…>, 21 years ago
*hannes: FLAG_TWOSTD git-svn-id: file:///usr/local/Singular/svn/trunk@6336 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 42.3 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: extra.cc,v 1.190 2002-11-21 13:36:21 Singular Exp $ */
5/*
6* ABSTRACT: general interface to internals of Singular ("system" command)
7*/
8
9#include <stdlib.h>
10#include <stdio.h>
11#include <string.h>
12#include <ctype.h>
13#include <signal.h>
14#include "mod2.h"
15
16#ifndef __MWERKS__
17#ifdef TIME_WITH_SYS_TIME
18# include <time.h>
19# ifdef HAVE_SYS_TIME_H
20#   include <sys/time.h>
21# endif
22#else
23# ifdef HAVE_SYS_TIME_H
24#   include <sys/time.h>
25# else
26#   include <time.h>
27# endif
28#endif
29#ifdef HAVE_SYS_TIMES_H
30#include <sys/times.h>
31#endif
32
33#endif
34#include <unistd.h>
35
36#include "tok.h"
37#include "ipid.h"
38#include "polys.h"
39#include "kutil.h"
40#include "cntrlc.h"
41#include "stairc.h"
42#include "ipshell.h"
43#include "algmap.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#include "walk.h"
58#include "weight.h"
59
60#ifdef HAVE_SPECTRUM
61#include "spectrum.h"
62#endif
63
64#ifdef HAVE_PLURAL
65#include "ring.h"
66#include "gring.h"
67#include "ipconv.h"
68#endif
69
70#ifdef ix86_Win /* only for the DLLTest */
71/* #include "WinDllTest.h" */
72#ifdef HAVE_DL
73#include "mod_raw.h"
74#endif
75#endif
76
77// for tests of t-rep-GB
78#include "tgb.cc"
79
80// Define to enable many more system commands
81#ifndef MAKE_DISTRIBUTION
82#define HAVE_EXTENDED_SYSTEM 1
83#endif
84
85#ifdef HAVE_FACTORY
86#define SI_DONT_HAVE_GLOBAL_VARS
87#include "clapsing.h"
88#include "clapconv.h"
89#include "kstdfac.h"
90#endif
91
92#include "silink.h"
93#include "walk.h"
94
95#include "fast_maps.h"
96
97#ifdef HAVE_EIGENVAL
98#include "eigenval.h"
99#endif
100
101#ifdef HAVE_GMS
102#include "gms.h"
103#endif
104
105/*
106 *   New function/system-calls that will be included as dynamic module
107 * should be inserted here.
108 * - without HAVE_DYNAMIC_LOADING: these functions comes as system("....");
109 * - with    HAVE_DYNAMIC_LOADING: these functions are loaded as module.
110 */
111#ifndef HAVE_DYNAMIC_LOADING
112
113#ifdef HAVE_PCV
114#include "pcv.h"
115#endif
116
117#endif /* not HAVE_DYNAMIC_LOADING */
118
119// see clapsing.cc for a description of the `FACTORY_*' options
120
121#ifdef FACTORY_GCD_STAT
122#include "gcd_stat.h"
123#endif
124
125#ifdef FACTORY_GCD_TIMING
126#define TIMING
127#include "timing.h"
128TIMING_DEFINE_PRINTPROTO( contentTimer );
129TIMING_DEFINE_PRINTPROTO( algContentTimer );
130TIMING_DEFINE_PRINTPROTO( algLcmTimer );
131#endif
132
133void piShowProcList();
134#ifndef MAKE_DISTRIBUTION
135static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
136#endif
137
138
139//void emStart();
140/*2
141*  the "system" command
142*/
143BOOLEAN jjSYSTEM(leftv res, leftv args)
144{
145  if(args->Typ() == STRING_CMD)
146  {
147    const char *sys_cmd=(char *)(args->Data());
148    leftv h=args->next;
149// ONLY documented system calls go here
150// Undocumented system calls go down into #ifdef HAVE_EXTENDED_SYSTEM
151/*==================== nblocks ==================================*/
152    if (strcmp(sys_cmd, "nblocks") == 0)
153    {
154      ring r;
155      if (h == NULL)
156      {
157        if (currRingHdl != NULL)
158        {
159          r = IDRING(currRingHdl);
160        }
161        else
162        {
163          WerrorS("no ring active");
164          return TRUE;
165        }
166      }
167      else
168      {
169        if (h->Typ() != RING_CMD)
170        {
171          WerrorS("ring expected");
172          return TRUE;
173        }
174        r = (ring) h->Data();
175      }
176      res->rtyp = INT_CMD;
177      res->data = (void*) (rBlocks(r) - 1);
178      return FALSE;
179    }
180/*==================== version ==================================*/
181    if(strcmp(sys_cmd,"version")==0)
182    {
183      res->rtyp=INT_CMD;
184      res->data=(void *)SINGULAR_VERSION;
185      return FALSE;
186    }
187    else
188/*==================== gen ==================================*/
189    if(strcmp(sys_cmd,"gen")==0)
190    {
191      res->rtyp=INT_CMD;
192      res->data=(void *)npGen;
193      return FALSE;
194    }
195    else
196/*==================== sh ==================================*/
197    if(strcmp(sys_cmd,"sh")==0)
198    {
199      res->rtyp=INT_CMD;
200      #ifndef __MWERKS__
201      if (h==NULL) res->data = (void *)system("sh");
202      else if (h->Typ()==STRING_CMD)
203        res->data = (void*) system((char*)(h->Data()));
204      else
205        WerrorS("string expected");
206      #else
207      res->data=(void *)0;
208      #endif
209      return FALSE;
210    }
211    else
212/*==================== uname ==================================*/
213    if(strcmp(sys_cmd,"uname")==0)
214    {
215      res->rtyp=STRING_CMD;
216      res->data = omStrDup(S_UNAME);
217      return FALSE;
218    }
219    else
220/*==================== with ==================================*/
221    if(strcmp(sys_cmd,"with")==0)
222    {
223      if (h==NULL)
224      {
225        res->rtyp=STRING_CMD;
226        res->data=(void *)omStrDup(versionString());
227        return FALSE;
228      }
229      else if (h->Typ()==STRING_CMD)
230      {
231        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
232        char *s=(char *)h->Data();
233        res->rtyp=INT_CMD;
234        #ifdef HAVE_DBM
235          TEST_FOR("DBM")
236        #endif
237        #ifdef HAVE_DLD
238          TEST_FOR("DLD")
239        #endif
240        #ifdef HAVE_FACTORY
241          TEST_FOR("factory")
242        #endif
243        #ifdef HAVE_LIBFAC_P
244          TEST_FOR("libfac")
245        #endif
246        #ifdef HAVE_MPSR
247          TEST_FOR("MP")
248        #endif
249        #ifdef HAVE_READLINE
250          TEST_FOR("readline")
251        #endif
252        #ifdef HAVE_TCL
253          TEST_FOR("tcl")
254        #endif
255        #ifdef TEST_MAC_ORDER
256          TEST_FOR("MAC_ORDER");
257        #endif
258        #ifdef HAVE_NS
259          TEST_FOR("Namespaces");
260        #endif
261        #ifdef HAVE_DYNAMIC_LOADING
262          TEST_FOR("DynamicLoading");
263        #endif
264        #ifdef HAVE_EIGENVAL
265          TEST_FOR("eigenval");
266        #endif
267        #ifdef HAVE_GMS
268          TEST_FOR("gms");
269        #endif
270          ;
271        return FALSE;
272        #undef TEST_FOR
273      }
274      return TRUE;
275    }
276    else
277/*==================== browsers ==================================*/
278    if (strcmp(sys_cmd,"browsers")==0)
279    {
280      res->rtyp = STRING_CMD;
281      char* b = StringSetS("");
282      feStringAppendBrowsers(0);
283      res->data = omStrDup(b);
284      return FALSE;
285    }
286    else
287/*==================== pid ==================================*/
288    if (strcmp(sys_cmd,"pid")==0)
289    {
290      res->rtyp=INT_CMD;
291    #ifndef MSDOS
292    #ifndef __MWERKS__
293      res->data=(void *)getpid();
294    #else
295      res->data=(void *)1;
296    #endif
297    #else
298      res->data=(void *)1;
299    #endif
300      return FALSE;
301    }
302    else
303/*==================== getenv ==================================*/
304    if (strcmp(sys_cmd,"getenv")==0)
305    {
306      if ((h!=NULL) && (h->Typ()==STRING_CMD))
307      {
308        res->rtyp=STRING_CMD;
309        char *r=getenv((char *)h->Data());
310        if (r==NULL) r="";
311        res->data=(void *)omStrDup(r);
312        return FALSE;
313      }
314      else
315      {
316        WerrorS("string expected");
317        return TRUE;
318      }
319    }
320    else
321/*==================== setenv ==================================*/
322    if (strcmp(sys_cmd,"setenv")==0)
323    {
324#ifdef HAVE_SETENV
325      if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL &&
326          h->next != NULL && h->next->Typ() == STRING_CMD
327          && h->next->Data() != NULL)
328      {
329        res->rtyp=STRING_CMD;
330        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
331        res->data=(void *)omStrDup((char *)h->next->Data());
332        feReInitResources();
333        return FALSE;
334      }
335      else
336      {
337        WerrorS("two strings expected");
338        return TRUE;
339      }
340#else
341      WerrorS("setenv not supported on this platform");
342      return TRUE;
343#endif
344    }
345    else
346/*==================== Singular ==================================*/
347    if (strcmp(sys_cmd, "Singular") == 0)
348    {
349      res->rtyp=STRING_CMD;
350      char *r=feResource("Singular");
351      if (r != NULL)
352        res->data = (void*) omStrDup( r );
353      else
354        res->data = (void*) omStrDup("");
355      return FALSE;
356    }
357    else
358/*==================== options ==================================*/
359    if (strstr(sys_cmd, "--") == sys_cmd)
360    {
361      if (strcmp(sys_cmd, "--") == 0)
362      {
363        fePrintOptValues();
364        return FALSE;
365      }
366
367      feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
368      if (opt == FE_OPT_UNDEF)
369      {
370        Werror("Unknown option %s", sys_cmd);
371        Werror("Use 'system(\"--\");' for listing of available options");
372        return TRUE;
373      }
374
375      // for Untyped Options (help version),
376      // setting it just triggers action
377      if (feOptSpec[opt].type == feOptUntyped)
378      {
379        feSetOptValue(opt,0);
380        return FALSE;
381      }
382
383      if (h == NULL)
384      {
385        if (feOptSpec[opt].type == feOptString)
386        {
387          res->rtyp = STRING_CMD;
388          if (feOptSpec[opt].value != NULL)
389            res->data = omStrDup((char*) feOptSpec[opt].value);
390          else
391            res->data = omStrDup("");
392        }
393        else
394        {
395          res->rtyp = INT_CMD;
396          res->data = feOptSpec[opt].value;
397        }
398        return FALSE;
399      }
400
401      if (h->Typ() != STRING_CMD &&
402          h->Typ() != INT_CMD)
403      {
404        Werror("Need string or int argument to set option value");
405        return TRUE;
406      }
407      char* errormsg;
408      if (h->Typ() == INT_CMD)
409      {
410        if (feOptSpec[opt].type == feOptString)
411        {
412          Werror("Need string argument to set value of option %s", sys_cmd);
413          return TRUE;
414        }
415        errormsg = feSetOptValue(opt, (int) h->Data());
416        if (errormsg != NULL)
417          Werror("Option '--%s=%d' %s", sys_cmd, (int) h->Data(), errormsg);
418      }
419      else
420      {
421        errormsg = feSetOptValue(opt, (char*) h->Data());
422        if (errormsg != NULL)
423          Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
424      }
425      if (errormsg != NULL) return TRUE;
426      return FALSE;
427    }
428    else
429/*==================== HC ==================================*/
430    if (strcmp(sys_cmd,"HC")==0)
431    {
432      res->rtyp=INT_CMD;
433      res->data=(void *)HCord;
434      return FALSE;
435    }
436    else
437/*==================== random ==================================*/
438    if(strcmp(sys_cmd,"random")==0)
439    {
440      if ((h!=NULL) &&(h->Typ()==INT_CMD))
441      {
442        siRandomStart=(int)h->Data();
443#ifdef buildin_rand
444        siSeed=siRandomStart;
445#else
446        srand((unsigned int)siRandomStart);
447#endif
448#ifdef HAVE_FACTORY
449        factoryseed(siRandomStart);
450#endif
451        return FALSE;
452      }
453      else if (h != NULL)
454      {
455        WerrorS("int expected");
456        return TRUE;
457      }
458      res->rtyp=INT_CMD;
459      res->data=(void*) siRandomStart;
460      return FALSE;
461    }
462/*==================== complexNearZero ======================*/
463    if(strcmp(sys_cmd,"complexNearZero")==0)
464    {
465      if (h->Typ()==NUMBER_CMD )
466      {
467        if ( h->next!=NULL && h->next->Typ()==INT_CMD )
468        {
469          if ( !rField_is_long_C() )
470            {
471              Werror( "unsupported ground field!");
472              return TRUE;
473            }
474          else
475            {
476              res->rtyp=INT_CMD;
477              res->data=(void*)complexNearZero((gmp_complex*)h->Data(),(int)h->next->Data());
478              return FALSE;
479            }
480        }
481        else
482        {
483          Werror( "expected <int> as third parameter!");
484          return TRUE;
485        }
486      }
487      else
488      {
489        Werror( "expected <number> as second parameter!");
490        return TRUE;
491      }
492    }
493/*==================== getPrecDigits ======================*/
494    if(strcmp(sys_cmd,"getPrecDigits")==0)
495    {
496      if ( !rField_is_long_C() && !rField_is_long_R() )
497      {
498        Werror( "unsupported ground field!");
499        return TRUE;
500      }
501      res->rtyp=INT_CMD;
502      res->data=(void*)getGMPFloatDigits();
503      return FALSE;
504    }
505/*==================== neworder =============================*/
506// should go below
507#ifdef HAVE_LIBFAC_P
508    if(strcmp(sys_cmd,"neworder")==0)
509    {
510      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
511      {
512        res->rtyp=STRING_CMD;
513        res->data=(void *)singclap_neworder((ideal)h->Data());
514        return FALSE;
515      }
516      else
517        WerrorS("ideal expected");
518    }
519    else
520#endif
521#ifndef HAVE_DYNAMIC_LOADING
522/*==================== pcv ==================================*/
523#ifdef HAVE_PCV
524    if(strcmp(sys_cmd,"pcvLAddL")==0)
525    {
526      return pcvLAddL(res,h);
527    }
528    else
529    if(strcmp(sys_cmd,"pcvPMulL")==0)
530    {
531      return pcvPMulL(res,h);
532    }
533    else
534    if(strcmp(sys_cmd,"pcvMinDeg")==0)
535    {
536      return pcvMinDeg(res,h);
537    }
538    else
539    if(strcmp(sys_cmd,"pcvP2CV")==0)
540    {
541      return pcvP2CV(res,h);
542    }
543    else
544    if(strcmp(sys_cmd,"pcvCV2P")==0)
545    {
546      return pcvCV2P(res,h);
547    }
548    else
549    if(strcmp(sys_cmd,"pcvDim")==0)
550    {
551      return pcvDim(res,h);
552    }
553    else
554    if(strcmp(sys_cmd,"pcvBasis")==0)
555    {
556      return pcvBasis(res,h);
557    }
558    else
559#endif
560/*==================== eigenvalues ==================================*/
561#ifdef HAVE_EIGENVAL
562    if(strcmp(sys_cmd,"hessenberg")==0)
563    {
564      return evHessenberg(res,h);
565    }
566    else
567    if(strcmp(sys_cmd,"eigenvals")==0)
568    {
569      return evEigenvals(res,h);
570    }
571    else
572#endif
573/*==================== Gauss-Manin system ==================================*/
574#ifdef HAVE_GMS
575    if(strcmp(sys_cmd,"gmsnf")==0)
576    {
577      return gmsNF(res,h);
578    }
579    else
580#endif
581#endif /* HAVE_DYNAMIC_LOADING */
582/*==================== contributors =============================*/
583   if(strcmp(sys_cmd,"contributors") == 0)
584   {
585     res->rtyp=STRING_CMD;
586     res->data=(void *)omStrDup(
587       "Olaf Bachmann, Hubert Grassmann, Kai Krueger, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Mathias Schulze, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
588     return FALSE;
589   }
590   else
591/*==================== spectrum =============================*/
592   #ifdef HAVE_SPECTRUM
593   if(strcmp(sys_cmd,"spectrum") == 0)
594   {
595     if (h->Typ()!=POLY_CMD)
596     {
597       WerrorS("poly expected");
598       return TRUE;
599     }
600     if (h->next==NULL)
601       return spectrumProc(res,h);
602     if (h->next->Typ()!=INT_CMD)
603     {
604       WerrorS("poly,int expected");
605       return TRUE;
606     }
607     if(((int)h->next->Data())==1)
608       return spectrumfProc(res,h);
609     return spectrumProc(res,h);
610   }
611   else
612/*==================== semic =============================*/
613   if(strcmp(sys_cmd,"semic") == 0)
614   {
615     if ((h->next!=NULL)
616     && (h->Typ()==LIST_CMD)
617     && (h->next->Typ()==LIST_CMD))
618     {
619       if (h->next->next==NULL)
620         return semicProc(res,h,h->next);
621       else if (h->next->next->Typ()==INT_CMD)
622         return semicProc3(res,h,h->next,h->next->next);
623     }
624     return TRUE;
625   }
626   else
627/*==================== spadd =============================*/
628   if(strcmp(sys_cmd,"spadd") == 0)
629   {
630     if ((h->next!=NULL)
631     && (h->Typ()==LIST_CMD)
632     && (h->next->Typ()==LIST_CMD))
633     {
634       if (h->next->next==NULL)
635         return spaddProc(res,h,h->next);
636     }
637     return TRUE;
638   }
639   else
640/*==================== spmul =============================*/
641   if(strcmp(sys_cmd,"spmul") == 0)
642   {
643     if ((h->next!=NULL)
644     && (h->Typ()==LIST_CMD)
645     && (h->next->Typ()==INT_CMD))
646     {
647       if (h->next->next==NULL)
648         return spmulProc(res,h,h->next);
649     }
650     return TRUE;
651   }
652   else
653   #endif
654/*================= Extended system call ========================*/
655   {
656     #ifndef MAKE_DISTRIBUTION
657     return(jjEXTENDED_SYSTEM(res, args));
658     #else
659     Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
660     #endif
661   }
662  } /* typ==string */
663  return TRUE;
664}
665
666
667#ifdef HAVE_EXTENDED_SYSTEM
668// You can put your own system calls here
669#include "fglmcomb.cc"
670#include "fglm.h"
671#ifdef HAVE_NEWTON
672#include <hc_newton.h>
673#endif
674#include "mpsr.h"
675#include "mod_raw.h"
676
677static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
678{
679  if(h->Typ() == STRING_CMD)
680  {
681    char *sys_cmd=(char *)(h->Data());
682    h=h->next;
683/*==================== locNF ======================================*/
684    if(strcmp(sys_cmd,"locNF")==0)
685    {
686      if (h != NULL && h->Typ() == VECTOR_CMD)
687      {
688        poly f=(poly)h->Data();
689        h=h->next;
690        if (h != NULL && h->Typ() == MODUL_CMD)
691        {
692          ideal m=(ideal)h->Data();
693          assumeStdFlag(h);
694          h=h->next;
695          if (h != NULL && h->Typ() == INT_CMD)
696          {
697            int n=(int)h->Data();
698            h=h->next;
699            if (h != NULL && h->Typ() == INTVEC_CMD)
700            {
701              intvec *v=(intvec *)h->Data();
702
703              /* == now the work starts == */
704
705              short * iv=iv2array(v);
706              poly r=0;
707              poly hp=ppJetW(f,n,iv);
708              int s=MATCOLS(m);
709              int j=0;
710              matrix T=mpInitI(s,1,0);
711
712              while (hp != NULL)
713              {
714                if (pDivisibleBy(m->m[j],hp))
715                  {
716                    if (MATELEM(T,j+1,1)==0)
717                    {
718                      MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
719                    }
720                    else
721                    {
722                      pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
723                    }
724                    hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
725                    j=0;
726                  }
727                else
728                {
729                  if (j==s-1)
730                  {
731                    r=pAdd(r,pHead(hp));
732                    hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
733                    j=0;
734                  }
735                  else
736                  {
737                    j++;
738                  }
739                }
740              }
741
742              matrix Temp=mpTransp((matrix) idVec2Ideal(r));
743              matrix R=mpNew(MATCOLS((matrix) idVec2Ideal(f)),1);
744              for (int k=1;k<=MATROWS(Temp);k++)
745              {
746                MATELEM(R,k,1)=MATELEM(Temp,k,1);
747              }
748
749              lists L=(lists)omAllocBin(slists_bin);
750              L->Init(2);
751              L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)R;
752              L->m[1].rtyp=MATRIX_CMD;   L->m[1].data=(void *)T;
753              res->data=L;
754              res->rtyp=LIST_CMD;
755              // iv aufraeumen
756              omFree(iv);
757            }
758            else
759            {
760              Warn ("4th argument: must be an intvec!");
761            }
762          }
763          else
764          {
765            Warn("3rd argument must be an int!!");
766          }
767        }
768        else
769        {
770          Warn("2nd argument must be a module!");
771        }
772      }
773      else
774      {
775        Warn("1st argument must be a vector!");
776      }
777      return FALSE;
778    }
779    else
780/*==================== interred ==================================*/
781    #if 0
782    if(strcmp(sys_cmd,"interred")==0)
783    {
784      res->data=(char *)kIR((ideal)h->Data(),currQuotient);
785      res->rtyp=h->Typ();
786      return ((h->Typ()!=IDEAL_CMD) && (h->Typ()!=MODUL_CMD));
787    }
788    else
789    #endif
790#ifdef RDEBUG
791/*==================== poly debug ==================================*/
792    if(strcmp(sys_cmd,"p")==0)
793    {
794      pDebugPrint((poly)h->Data());
795      return FALSE;
796    }
797    else
798/*==================== ring debug ==================================*/
799    if(strcmp(sys_cmd,"r")==0)
800    {
801      rDebugPrint((ring)h->Data());
802      return FALSE;
803    }
804    else
805#endif
806/*==================== mtrack ==================================*/
807    if(strcmp(sys_cmd,"mtrack")==0)
808    {
809#ifdef OM_TRACK
810      om_Opts.MarkAsStatic = 1;
811      FILE *fd = NULL;
812      int max = 5;
813      while (h != NULL)
814      {
815        omMarkAsStaticAddr(h);
816        if (fd == NULL && h->Typ()==STRING_CMD)
817        {
818          fd = fopen((char*) h->Data(), "w");
819          if (fd == NULL)
820            Warn("Can not open %s for writing og mtrack. Using stdout");
821        }
822        if (h->Typ() == INT_CMD)
823        {
824          max = (int) h->Data();
825        }
826        h = h->Next();
827      }
828      omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
829      if (fd != NULL) fclose(fd);
830      om_Opts.MarkAsStatic = 0;
831      return FALSE;
832#else
833     WerrorS("mtrack not supported without OM_TRACK");
834     return TRUE;
835#endif
836    }
837/*==================== mtrack_all ==================================*/
838    if(strcmp(sys_cmd,"mtrack_all")==0)
839    {
840#ifdef OM_TRACK
841      om_Opts.MarkAsStatic = 1;
842      FILE *fd = NULL;
843      if ((h!=NULL) &&(h->Typ()==STRING_CMD))
844      {
845        fd = fopen((char*) h->Data(), "w");
846        if (fd == NULL)
847          Warn("Can not open %s for writing og mtrack. Using stdout");
848        omMarkAsStaticAddr(h);
849      }
850      // OB: TBC print to fd
851      omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
852      if (fd != NULL) fclose(fd);
853      om_Opts.MarkAsStatic = 0;
854      return FALSE;
855#else
856     WerrorS("mtrack not supported without OM_TRACK");
857     return TRUE;
858#endif
859    }
860    else
861/*==================== backtrace ==================================*/
862    if(strcmp(sys_cmd,"backtrace")==0)
863    {
864#ifndef OM_NDEBUG
865      omPrintCurrentBackTrace(stdout);
866      return FALSE;
867#else
868     WerrorS("btrack not supported without OM_TRACK");
869     return TRUE;
870#endif
871    }
872    else
873/*==================== naIdeal ==================================*/
874    if(strcmp(sys_cmd,"naIdeal")==0)
875    {
876      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
877      {
878        naSetIdeal((ideal)h->Data());
879        return FALSE;
880      }
881      else
882         WerrorS("ideal expected");
883    }
884    else
885/*==================== isSqrFree =============================*/
886#ifdef HAVE_FACTORY
887    if(strcmp(sys_cmd,"isSqrFree")==0)
888    {
889      if ((h!=NULL) &&(h->Typ()==POLY_CMD))
890      {
891        res->rtyp=INT_CMD;
892        res->data=(void *)singclap_isSqrFree((poly)h->Data());
893        return FALSE;
894      }
895      else
896        WerrorS("poly expected");
897    }
898    else
899#endif
900/*==================== pDivStat =============================*/
901#if defined(PDEBUG) || defined(PDIV_DEBUG)
902    if(strcmp(sys_cmd,"pDivStat")==0)
903    {
904      extern void pPrintDivisbleByStat();
905      pPrintDivisbleByStat();
906      return FALSE;
907    }
908    else
909#endif
910/*==================== alarm ==================================*/
911#ifndef __MWERKS__
912#ifndef MSDOS
913#ifndef atarist
914#ifdef unix
915    if(strcmp(sys_cmd,"alarm")==0)
916    {
917      if ((h!=NULL) &&(h->Typ()==INT_CMD))
918      {
919        // standard variant -> SIGALARM (standard: abort)
920        //alarm((unsigned)h->next->Data());
921        // process time (user +system): SIGVTALARM
922        struct itimerval t,o;
923        memset(&t,0,sizeof(t));
924        t.it_value.tv_sec     =(unsigned)h->Data();
925        setitimer(ITIMER_VIRTUAL,&t,&o);
926        return FALSE;
927      }
928      else
929        WerrorS("int expected");
930    }
931    else
932#endif
933#endif
934#endif
935#endif
936/*==================== red =============================*/
937#if 0
938    if(strcmp(sys_cmd,"red")==0)
939    {
940      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
941      {
942        res->rtyp=IDEAL_CMD;
943        res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
944        setFlag(res,FLAG_STD);
945        return FALSE;
946      }
947      else
948        WerrorS("ideal expected");
949    }
950    else
951#endif
952/*==================== algfetch =====================*/
953    if (strcmp(sys_cmd,"algfetch")==0)
954    {
955      int k;
956      idhdl w;
957      ideal i0, i1;
958      ring r0=(ring)h->Data();
959      leftv v = h->next;
960      w = r0->idroot->get(v->Name(),myynest);
961      if (w!=NULL)
962      {
963        if (IDTYP(w)==IDEAL_CMD)
964        {
965          i0 = IDIDEAL(w);
966          i1 = idInit(IDELEMS(i0),i0->rank);
967          for (k=0; k<IDELEMS(i1); k++)
968          {
969            i1->m[k] = maAlgpolyFetch(r0, i0->m[k]);
970          }
971          res->rtyp = IDEAL_CMD;
972          res->data = (void*)i1;
973          return FALSE;
974        }
975        else if (IDTYP(w)==POLY_CMD)
976        {
977          res->rtyp = POLY_CMD;
978          res->data = (void*)maAlgpolyFetch(r0,IDPOLY(w));
979          return FALSE;
980        }
981        else
982          WerrorS("`system(\"algfetch\",<ideal>/<poly>)` expected");
983      }
984      else
985        Werror("`%s` not found in `%s`",v->Name(),h->Name());
986    }
987    else
988/*==================== algmap =======================*/
989    if (strcmp(sys_cmd,"algmap")==0)
990    {
991      int k;
992      idhdl w;
993      ideal i0, i1, i, j;
994      ring r0=(ring)h->Data();
995      leftv v = h->next;
996      w = r0->idroot->get(v->Name(),myynest);
997      i0 = IDIDEAL(w);
998      v = v->next;
999      i = (ideal)v->Data();
1000      v = v->next;
1001      j = (ideal)v->Data();
1002      i1 = idInit(IDELEMS(i0),i0->rank);
1003      for (k=0; k<IDELEMS(i1); k++)
1004      {
1005        i1->m[k] = maAlgpolyMap(r0, i0->m[k], i, j);
1006      }
1007      res->rtyp = IDEAL_CMD;
1008      res->data = (void*)i1;
1009      return FALSE;
1010    }
1011    else
1012#ifdef HAVE_FACTORY
1013/*==================== fastcomb =============================*/
1014    if(strcmp(sys_cmd,"fastcomb")==0)
1015    {
1016      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
1017      {
1018        int i=0;
1019        if (h->next!=NULL)
1020        {
1021          if (h->next->Typ()!=POLY_CMD)
1022          {
1023            Warn("Wrong types for poly= comb(ideal,poly)");
1024          }
1025        }
1026        res->rtyp=POLY_CMD;
1027        res->data=(void *) fglmLinearCombination(
1028                           (ideal)h->Data(),(poly)h->next->Data());
1029        return FALSE;
1030      }
1031      else
1032        WerrorS("ideal expected");
1033    }
1034    else
1035/*==================== comb =============================*/
1036    if(strcmp(sys_cmd,"comb")==0)
1037    {
1038      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
1039      {
1040        int i=0;
1041        if (h->next!=NULL)
1042        {
1043          if (h->next->Typ()!=POLY_CMD)
1044          {
1045              Warn("Wrong types for poly= comb(ideal,poly)");
1046          }
1047        }
1048        res->rtyp=POLY_CMD;
1049        res->data=(void *)fglmNewLinearCombination(
1050                            (ideal)h->Data(),(poly)h->next->Data());
1051        return FALSE;
1052      }
1053      else
1054        WerrorS("ideal expected");
1055    }
1056    else
1057#endif
1058#ifdef FACTORY_GCD_TEST
1059/*=======================gcd Testerei ================================*/
1060    if ( ! strcmp( sys_cmd, "setgcd" ) ) {
1061        if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
1062            CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
1063            return FALSE;
1064        } else
1065            WerrorS("int expected");
1066    }
1067    else
1068#endif
1069
1070#ifdef FACTORY_GCD_TIMING
1071    if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
1072        TIMING_PRINT( contentTimer, "time used for content: " );
1073        TIMING_PRINT( algContentTimer, "time used for algContent: " );
1074        TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
1075        TIMING_RESET( contentTimer );
1076        TIMING_RESET( algContentTimer );
1077        TIMING_RESET( algLcmTimer );
1078        return FALSE;
1079    }
1080    else
1081#endif
1082
1083#ifdef FACTORY_GCD_STAT
1084    if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
1085        printGcdTotal();
1086        printContTotal();
1087        resetGcdTotal();
1088        resetContTotal();
1089        return FALSE;
1090    }
1091    else
1092#endif
1093#if !defined(HAVE_NS)
1094/*==================== lib ==================================*/
1095    if(strcmp(sys_cmd,"LIB")==0)
1096    {
1097      idhdl hh=idroot->get((char*)h->Data(),0);
1098      if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
1099      {
1100        res->rtyp=STRING_CMD;
1101        char *r=iiGetLibName(IDPROC(hh));
1102        if (r==NULL) r="";
1103        res->data=omStrDup(r);
1104        return FALSE;
1105      }
1106      else
1107        Warn("`%s` not found",(char*)h->Data());
1108    }
1109    else
1110#endif
1111/*==================== listall ===================================*/
1112    if(strcmp(sys_cmd,"listall")==0)
1113    {
1114      int showproc=1;
1115      if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)h->Data();
1116#ifdef HAVE_NS
1117      listall(showproc);
1118#else
1119      idhdl hh=IDROOT;
1120      while (hh!=NULL)
1121      {
1122        if (IDDATA(hh)==(void *)currRing) PrintS("(R)");
1123        else PrintS("   ");
1124        Print("::%s, typ %s level %d\n",
1125               IDID(hh),Tok2Cmdname(IDTYP(hh)),IDLEV(hh));
1126        hh=IDNEXT(hh);
1127      }
1128      hh=IDROOT;
1129      while (hh!=NULL)
1130      {
1131        if ((IDTYP(hh)==RING_CMD)
1132        || (IDTYP(hh)==QRING_CMD)
1133        || (IDTYP(hh)==PACKAGE_CMD))
1134        {
1135          idhdl h2=IDRING(hh)->idroot;
1136          while (h2!=NULL)
1137          {
1138            if (IDDATA(h2)==(void *)currRing) PrintS("(R)");
1139            else PrintS("   ");
1140            Print("%s::%s, typ %s level %d\n",
1141            IDID(hh),IDID(h2),Tok2Cmdname(IDTYP(h2)),IDLEV(h2));
1142            h2=IDNEXT(h2);
1143          }
1144        }
1145        hh=IDNEXT(hh);
1146      }
1147#endif /* HAVE_NS */
1148      return FALSE;
1149    }
1150    else
1151/*==================== proclist =================================*/
1152    if(strcmp(sys_cmd,"proclist")==0)
1153    {
1154      piShowProcList();
1155      return FALSE;
1156    }
1157    else
1158/* ==================== newton ================================*/
1159#ifdef HAVE_NEWTON
1160    if(strcmp(sys_cmd,"newton")==0)
1161    {
1162      if ((h->Typ()!=POLY_CMD)
1163      || (h->next->Typ()!=INT_CMD)
1164      || (h->next->next->Typ()!=INT_CMD))
1165      {
1166        WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
1167        return TRUE;
1168      }
1169      poly  p=(poly)(h->Data());
1170      int l=pLength(p);
1171      short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
1172      int i,j,k;
1173      k=0;
1174      poly pp=p;
1175      for (i=0;pp!=NULL;i++)
1176      {
1177        for(j=1;j<=currRing->N;j++)
1178        {
1179          points[k]=pGetExp(pp,j);
1180          k++;
1181        }
1182        pIter(pp);
1183      }
1184      hc_ERG r=hc_KOENIG(currRing->N,      // dimension
1185                l,      // number of points
1186                (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
1187                currRing->OrdSgn==-1,
1188                (int) (h->next->Data()),      // 1: Milnor, 0: Newton
1189                (int) (h->next->next->Data()) // debug
1190               );
1191      //----<>---Output-----------------------
1192
1193
1194//  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
1195
1196
1197      lists L=(lists)omAllocBin(slists_bin);
1198      L->Init(6);
1199      L->m[0].rtyp=STRING_CMD;               // newtonnumber;
1200      L->m[0].data=(void *)omStrDup(r.nZahl);
1201      L->m[1].rtyp=INT_CMD;
1202      L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
1203      L->m[2].rtyp=INT_CMD;
1204      L->m[2].data=(void *)r.deg;            // #degenerations
1205      if ( r.deg != 0)              // only if degenerations exist
1206      {
1207        L->m[3].rtyp=INT_CMD;
1208        L->m[3].data=(void *)r.anz_punkte;     // #points
1209        //---<>--number of points------
1210        int anz = r.anz_punkte;    // number of points
1211        int dim = (currRing->N);     // dimension
1212        intvec* v = new intvec( anz*dim );
1213        for (i=0; i<anz*dim; i++)    // copy points
1214          (*v)[i] = r.pu[i];
1215        L->m[4].rtyp=INTVEC_CMD;
1216        L->m[4].data=(void *)v;
1217        //---<>--degenerations---------
1218        int deg = r.deg;    // number of points
1219        intvec* w = new intvec( r.speicher );  // necessary memeory
1220        i=0;               // start copying
1221        do
1222        {
1223          (*w)[i] = r.deg_tab[i];
1224          i++;
1225        }
1226        while (r.deg_tab[i-1] != -2);   // mark for end of list
1227        L->m[5].rtyp=INTVEC_CMD;
1228        L->m[5].data=(void *)w;
1229      }
1230      else
1231      {
1232        L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
1233        L->m[4].rtyp=DEF_CMD;
1234        L->m[5].rtyp=DEF_CMD;
1235      }
1236
1237      res->data=(void *)L;
1238      res->rtyp=LIST_CMD;
1239      // free all pointer in r:
1240      delete[] r.nZahl;
1241      delete[] r.pu;
1242      delete[] r.deg_tab;      // Ist das ein Problem??
1243
1244      omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
1245      return FALSE;
1246    }
1247    else
1248#endif
1249/*==================== sdb_flags =================*/
1250#ifdef HAVE_SDB
1251    if (strcmp(sys_cmd, "sdb_flags") == 0)
1252    {
1253      if ((h!=NULL) && (h->Typ()==INT_CMD))
1254      {
1255        sdb_flags=(int)h->Data();
1256      }
1257      else
1258      {
1259        WerrorS("system(\"sdb_flags\",`int`) expected");
1260        return TRUE;
1261      }
1262      return FALSE;
1263    }
1264    else
1265/*==================== sdb_edit =================*/
1266    if (strcmp(sys_cmd, "sdb_edit") == 0)
1267    {
1268      if ((h!=NULL) && (h->Typ()==PROC_CMD))
1269      {
1270        procinfov p=(procinfov)h->Data();
1271        sdb_edit(p);
1272      }
1273      else
1274      {
1275        WerrorS("system(\"sdb_edit\",`proc`) expected");
1276        return TRUE;
1277      }
1278      return FALSE;
1279    }
1280    else
1281#endif
1282/*==================== GF =================*/
1283#if 0
1284    if (strcmp(sys_cmd, "GF") == 0)
1285    {
1286      int c=rChar(currRing);
1287      setCharacteristic( c, 2);
1288      CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
1289      res->rtyp=POLY_CMD;
1290      res->data=convClapGFSingGF( F );
1291      return FALSE;
1292    }
1293    else
1294#endif
1295/*==================== stdX =================*/
1296    if (strcmp(sys_cmd, "std") == 0)
1297    {
1298      ideal i1;
1299      int i2;
1300      if ((h!=NULL) && (h->Typ()==MODUL_CMD))
1301      {
1302        i1=(ideal)h->CopyD();
1303        h=h->next;
1304      }
1305      else return TRUE;
1306      if ((h!=NULL) && (h->Typ()==INT_CMD))
1307      {
1308        i2=(int)h->Data();
1309      }
1310      else return TRUE;
1311      res->rtyp=MODUL_CMD;
1312      res->data=idXXX(i1,i2);
1313      return FALSE;
1314    }
1315    else
1316#ifdef HAVE_PLURAL
1317/*==================== twostd  =================*/
1318      if (strcmp(sys_cmd, "twostd") == 0)
1319      {
1320        ideal I;
1321        if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1322        {
1323          I=(ideal)h->CopyD();
1324          res->rtyp=IDEAL_CMD;
1325          if (rIsPluralRing(currRing)) res->data=twostd(I);
1326          else res->data=I; 
1327          setFlag(FLAG_TWOSTD);
1328        }
1329        else return TRUE;
1330        return FALSE;
1331      }
1332/*==================== lie bracket =================*/
1333    if (strcmp(sys_cmd, "bracket") == 0)
1334    {
1335      poly p;
1336      poly q;
1337      if ((h!=NULL) && (h->Typ()==POLY_CMD))
1338      {
1339        p=(poly)h->CopyD();
1340        h=h->next;
1341      }
1342      else return TRUE;
1343      if ((h!=NULL) && (h->Typ()==POLY_CMD))
1344      {
1345        q=(poly)h->Data();
1346      }
1347      else return TRUE;
1348      res->rtyp=POLY_CMD;
1349      if (rIsPluralRing(currRing))  res->data=nc_p_Bracket_qq(p,q);
1350      else res->data=NULL;     
1351      return FALSE;
1352    }
1353/*==================== PLURAL =================*/
1354    if (strcmp(sys_cmd, "PLURAL") == 0)
1355    {
1356      matrix C;
1357      matrix D;
1358      number nN;
1359      poly pN;
1360      int i,j;
1361      sleftv tmp_v;
1362      memset(&tmp_v,0,sizeof(tmp_v));
1363
1364      if (currRing->nc==NULL)
1365      {
1366        currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
1367      }
1368      else
1369      {
1370        WarnS("redefining algebra structure");
1371        /* kill the previous nc data */
1372      }
1373      currRing->nc->type=nc_general;
1374      /* C is either a poly (coeff - an int or a number) or a  matrix */
1375      if (h==NULL) return TRUE;
1376      leftv hh=h->next;
1377      h->next=NULL;
1378      switch(h->Typ())
1379      {
1380        case MATRIX_CMD: { C=(matrix)h->CopyD(); break; }
1381       
1382        case INT_CMD: case NUMBER_CMD:
1383        {
1384          i=iiTestConvert(h->Typ(), POLY_CMD);
1385          if (i==0) 
1386          { 
1387            Werror("cannot convert to poly");
1388            return TRUE;
1389          }
1390          iiConvert(h->Typ(), POLY_CMD, i, h, &tmp_v);
1391          pN=(poly)tmp_v.Data();
1392          break;
1393        }
1394       
1395        case POLY_CMD:  {pN=(poly)h->Data(); break;}
1396
1397        default: return TRUE;   
1398      }
1399      if (h->Typ()==MATRIX_CMD) 
1400      {
1401        currRing->nc->type=nc_undef; /* to analyze later ! */
1402      }
1403      else
1404      {
1405        nN=pGetCoeff(pN);
1406        if (nIsOne(nN)) currRing->nc->type=nc_lie; 
1407        else currRing->nc->type=nc_skew;
1408        /* create matrix C */
1409        C=mpNew(currRing->N,currRing->N);
1410        for(i=1;i<currRing->N;i++)
1411        {
1412          for(j=i+1;j<=currRing->N;j++)
1413          {
1414            MATELEM(C,i,j)=pCopy(pN);
1415          }
1416        }
1417      }
1418      pN=NULL;
1419      h=hh;
1420      /* D is either a poly or a matrix */
1421      if (h==NULL) { pN=NULL;}  /* D is zero matrix */ 
1422      else 
1423      {
1424        switch(h->Typ())
1425        {
1426          case MATRIX_CMD: { D=(matrix)h->CopyD(); break;}
1427       
1428          case INT_CMD: case NUMBER_CMD:
1429          {
1430            i=iiTestConvert(h->Typ(), POLY_CMD);
1431            if (i==0) 
1432            { 
1433              Werror("cannot convert to poly");
1434              return TRUE;
1435            }
1436            iiConvert(h->Typ(), POLY_CMD, i, h, &tmp_v);
1437            pN=(poly)tmp_v.Data();
1438            break;
1439          }
1440         
1441          case POLY_CMD:  { pN=(poly)h->Data();break;}
1442         
1443          default: return TRUE;
1444        }
1445      } /* end else h==NULL */
1446      if (pN==NULL) 
1447      {
1448        if (currRing->nc->type==nc_lie) currRing->nc->type=nc_skew; /* even commutative! */
1449        /* if (currRing->nc->type==nc_skew)  NOP */
1450      }
1451      else  { if (currRing->nc->type==nc_skew) currRing->nc->type=nc_general; }
1452      if (h->Typ()!=MATRIX_CMD)
1453      {
1454        D=mpNew(currRing->N,currRing->N);
1455        /* create matrix D */
1456        for(i=1;i<currRing->N;i++)
1457        {
1458          for(j=i+1;j<=currRing->N;j++)
1459          {
1460            MATELEM(D,i,j)=pCopy(pN);
1461          }
1462        }
1463      }
1464      else currRing->nc->type=nc_undef;
1465      tmp_v.CleanUp();
1466      pN=NULL;
1467      /* Now we proceed with C and D */
1468      matrix COM;     
1469      currRing->nc->MT=(matrix *)omAlloc0(currRing->N*(currRing->N-1)/2*sizeof(matrix));
1470      currRing->nc->MTsize=(int *)omAlloc0(currRing->N*(currRing->N-1)/2*sizeof(int));
1471      currRing->nc->C=C;
1472      currRing->nc->D=D;
1473      COM=mpCopy(currRing->nc->C);
1474      poly p;
1475      short DefMTsize=7;
1476      int IsSkewConstant=1;
1477      int IsNonComm=0;
1478      pN=MATELEM(currRing->nc->C,1,2);
1479      for(i=1;i<currRing->N;i++)
1480      {
1481        for(j=i+1;j<=currRing->N;j++)
1482        {
1483          if (MATELEM(currRing->nc->C,i,j)==NULL)
1484          {
1485            Werror("Incorrect input : matrix of coefficients contains zeros in the upper triangle!");
1486            return TRUE;
1487          }
1488          if (!nEqual(pGetCoeff(pN),pGetCoeff(MATELEM(currRing->nc->C,i,j)))) IsSkewConstant=0; 
1489          if (MATELEM(currRing->nc->D,i,j)==NULL) /* quasicommutative case */
1490          {
1491            currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=1; 
1492            /* 1x1 mult.matrix */
1493            currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(1,1);
1494          }
1495          else /* pure noncommutative case*/
1496          {
1497            IsNonComm=1;
1498            MATELEM(COM,i,j)=NULL;
1499            currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=DefMTsize; /* default sizes */
1500            currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(DefMTsize,DefMTsize);
1501          }
1502          p=pOne();
1503          pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
1504          pSetExp(p,i,1);
1505          pSetExp(p,j,1);
1506          pSetm(p);
1507          p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
1508          MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=p;
1509          p=NULL;
1510        }
1511        /* set MT[i,j,1,1] to c_i_j*x_i*x_j + D_i_j */
1512      }
1513      if (currRing->nc->type==nc_undef)
1514      {
1515        if (IsNonComm==1) 
1516        {
1517          assume(pN!=NULL);
1518          if ((IsSkewConstant==1) && (nIsOne(pGetCoeff(pN)))) currRing->nc->type=nc_lie;
1519          else currRing->nc->type=nc_general;
1520        }
1521        if (IsNonComm==0) currRing->nc->type=nc_skew; /* could be also commutative */
1522      }
1523      currRing->nc->COM=COM;
1524      return FALSE;
1525    }
1526    else
1527#endif
1528#ifdef HAVE_WALK
1529/*==================== walk stuff =================*/
1530    if (strcmp(sys_cmd, "walkNextWeight") == 0)
1531    {
1532      if (h == NULL || h->Typ() != INTVEC_CMD ||
1533          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1534          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
1535      {
1536        Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1537        return TRUE;
1538      }
1539
1540      if (((intvec*) h->Data())->length() != currRing->N ||
1541          ((intvec*) h->next->Data())->length() != currRing->N)
1542      {
1543        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1544               currRing->N);
1545        return TRUE;
1546      }
1547      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1548                                         ((intvec*) h->next->Data()),
1549                                         (ideal) h->next->next->Data());
1550      if (res->data == (void*) 0 || res->data == (void*) 1)
1551      {
1552        res->rtyp = INT_CMD;
1553      }
1554      else
1555      {
1556        res->rtyp = INTVEC_CMD;
1557      }
1558      return FALSE;
1559    }
1560    else if (strcmp(sys_cmd, "walkInitials") == 0)
1561    {
1562      if (h == NULL || h->Typ() != IDEAL_CMD)
1563      {
1564        WerrorS("system(\"walkInitials\", ideal) expected");
1565        return TRUE;
1566      }
1567
1568      res->data = (void*) walkInitials((ideal) h->Data());
1569      res->rtyp = IDEAL_CMD;
1570      return FALSE;
1571    }
1572    else
1573#endif
1574#ifdef ix86_Win
1575#ifdef HAVE_DL
1576/*==================== DLL =================*/
1577/* testing the DLL functionality under Win32 */
1578      if (strcmp(sys_cmd, "DLL") == 0)
1579      {
1580        typedef void  (*Void_Func)();
1581        typedef int  (*Int_Func)(int);
1582        void *hh=dynl_open("WinDllTest.dll");
1583        if ((h!=NULL) && (h->Typ()==INT_CMD))
1584        {
1585          int (*f)(int);
1586          if (hh!=NULL)
1587          {
1588            int (*f)(int);
1589            f=(Int_Func)dynl_sym(hh,"PlusDll");
1590            int i=10;
1591            if (f!=NULL) printf("%d\n",f(i));
1592            else PrintS("cannot find PlusDll\n");
1593          }
1594        }
1595        else
1596        {
1597          void (*f)();
1598          f= (Void_Func)dynl_sym(hh,"TestDll");
1599          if (f!=NULL) f();
1600          else PrintS("cannot find TestDll\n");
1601        }
1602        return FALSE;
1603      }
1604      else
1605#endif
1606#endif
1607/*==================== eigenvalues ==================================*/
1608#ifdef HAVE_EIGENVAL
1609    if(strcmp(sys_cmd,"eigenvals")==0)
1610    {
1611      return evEigenvals(res,h);
1612    }
1613    else
1614#endif
1615/*==================== Gauss-Manin system ==================================*/
1616#ifdef HAVE_GMS
1617    if(strcmp(sys_cmd,"gmsnf")==0)
1618    {
1619      return gmsNF(res,h);
1620    }
1621    else
1622#endif
1623/*==================== t-rep-GB ==================================*/
1624    if (strcmp(sys_cmd, "trepgb")==0)
1625    {
1626      ring r = currRing;
1627      ideal i = (ideal)h->Data();
1628      res->data=t_rep_gb(r,i);
1629      res->rtyp=IDEAL_CMD;
1630      return(FALSE);
1631    }
1632    else
1633/*==================== Error =================*/
1634      Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1635  }
1636  return TRUE;
1637}
1638#endif // HAVE_EXTENDED_SYSTEM
Note: See TracBrowser for help on using the repository browser.