source: git/Singular/extra.cc @ 9bc0b8

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