source: git/Singular/extra.cc @ dc0898

spielwiese
Last change on this file since dc0898 was dc0898, checked in by Olaf Bachmann <obachman@…>, 24 years ago
* solved system problem under HPUX git-svn-id: file:///usr/local/Singular/svn/trunk@4502 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 29.2 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: extra.cc,v 1.136 2000-08-02 13:40:30 obachman 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#ifdef HAVE_SPECTRUM
58#include "spectrum.h"
59#endif
60
61
62// Define to enable many more system commands
63#ifndef MAKE_DISTRIBUTION
64#define HAVE_EXTENDED_SYSTEM
65#endif
66
67#ifdef HAVE_FACTORY
68#define SI_DONT_HAVE_GLOBAL_VARS
69#include "clapsing.h"
70#include "clapconv.h"
71#include "kstdfac.h"
72#endif
73
74#include "silink.h"
75#ifdef HAVE_MPSR
76#include "mpsr.h"
77#include "MPT_GP.h"
78#endif
79#include "walk.h"
80
81/*
82 *   New function/system-calls that will be included as dynamic module
83 * should be inserted here.
84 * - without HAVE_DYNAMIC_LOADING: these functions comes as system("....");
85 * - with    HAVE_DYNAMIC_LOADING: these functions are loaded as module.
86 */
87#ifndef HAVE_DYNAMIC_LOADING
88#ifdef HAVE_PCV
89#include "pcv.h"
90#endif
91#endif /* not HAVE_DYNAMIC_LOADING */
92
93// see clapsing.cc for a description of the `FACTORY_*' options
94
95#ifdef FACTORY_GCD_STAT
96#include "gcd_stat.h"
97#endif
98
99#ifdef FACTORY_GCD_TIMING
100#define TIMING
101#include "timing.h"
102TIMING_DEFINE_PRINTPROTO( contentTimer );
103TIMING_DEFINE_PRINTPROTO( algContentTimer );
104TIMING_DEFINE_PRINTPROTO( algLcmTimer );
105#endif
106
107void piShowProcList();
108#ifndef MAKE_DISTRIBUTION
109static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
110#endif
111
112
113//void emStart();
114/*2
115*  the "system" command
116*/
117BOOLEAN jjSYSTEM(leftv res, leftv args)
118{
119  if(args->Typ() == STRING_CMD)
120  {
121    const char *sys_cmd=(char *)(args->Data());
122    leftv h=args->next;
123// ONLY documented system calls go here
124// Undocumented system calls go down into #ifdef HAVE_EXTENDED_SYSTEM
125/*==================== nblocks ==================================*/
126    if (strcmp(sys_cmd, "nblocks") == 0)
127    {
128      ring r;
129      if (h == NULL)
130      {
131        if (currRingHdl != NULL)
132        {
133          r = IDRING(currRingHdl);
134        }
135        else
136        {
137          WerrorS("no ring active");
138          return TRUE;
139        }
140      }
141      else
142      {
143        if (h->Typ() != RING_CMD)
144        {
145          WerrorS("ring expected");
146          return TRUE;
147        }
148        r = (ring) h->Data();
149      }
150      res->rtyp = INT_CMD;
151      res->data = (void*) (rBlocks(r) - 1);
152      return FALSE;
153    }
154/*==================== version ==================================*/
155    if(strcmp(sys_cmd,"version")==0)
156    {
157      res->rtyp=INT_CMD;
158      res->data=(void *)SINGULAR_VERSION;
159      return FALSE;
160    }
161    else
162/*==================== gen ==================================*/
163    if(strcmp(sys_cmd,"gen")==0)
164    {
165      res->rtyp=INT_CMD;
166      res->data=(void *)npGen;
167      return FALSE;
168    }
169    else
170/*==================== sh ==================================*/
171    if(strcmp(sys_cmd,"sh")==0)
172    {
173      res->rtyp=INT_CMD;
174      #ifndef __MWERKS__
175      if (h==NULL) res->data = (void *)system("sh");
176      else if (h->Typ()==STRING_CMD)
177        res->data = (void*) system((char*)(h->Data()));
178      else
179        WerrorS("string expected");
180      #else
181      res->data=(void *)0;
182      #endif
183      return FALSE;
184    }
185    else
186/*==================== uname ==================================*/
187    if(strcmp(sys_cmd,"uname")==0)
188    {
189      res->rtyp=STRING_CMD;
190      res->data = mstrdup(S_UNAME);
191      return FALSE;
192    }
193    else
194/*==================== with ==================================*/
195    if(strcmp(sys_cmd,"with")==0)
196    {
197      if (h==NULL)
198      {
199        res->rtyp=STRING_CMD;
200        res->data=(void *)mstrdup(versionString());
201        return FALSE;
202      }
203      else if (h->Typ()==STRING_CMD)
204      {
205        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
206        char *s=(char *)h->Data();
207        res->rtyp=INT_CMD;
208        #ifdef HAVE_DBM
209          TEST_FOR("DBM")
210        #endif
211        #ifdef HAVE_DLD
212          TEST_FOR("DLD")
213        #endif
214        #ifdef HAVE_FACTORY
215          TEST_FOR("factory")
216        #endif
217        #ifdef HAVE_LIBFAC_P
218          TEST_FOR("libfac")
219        #endif
220        #ifdef HAVE_MPSR
221          TEST_FOR("MP")
222        #endif
223        #ifdef HAVE_READLINE
224          TEST_FOR("readline")
225        #endif
226        #ifdef HAVE_TCL
227          TEST_FOR("tcl")
228        #endif
229        #ifdef TEST_MAC_ORDER
230          TEST_FOR("MAC_ORDER");
231        #endif
232        #ifdef HAVE_NAMESPACES
233          TEST_FOR("Namespaces");
234        #endif
235        #ifdef HAVE_DYNAMIC_LOADING
236          TEST_FOR("DynamicLoading");
237        #endif
238          ;
239        return FALSE;
240        #undef TEST_FOR
241      }
242      return TRUE;
243    }
244    else
245/*==================== browsers ==================================*/
246    if (strcmp(sys_cmd,"browsers")==0)
247    {
248      res->rtyp = STRING_CMD;
249      char* b = StringSetS("");
250      feStringAppendBrowsers(0);
251      res->data = mstrdup(b);
252      return FALSE;
253    }
254    else
255/*==================== pid ==================================*/
256    if (strcmp(sys_cmd,"pid")==0)
257    {
258      res->rtyp=INT_CMD;
259    #ifndef MSDOS
260    #ifndef __MWERKS__
261      res->data=(void *)getpid();
262    #else
263      res->data=(void *)1;
264    #endif
265    #else
266      res->data=(void *)1;
267    #endif
268      return FALSE;
269    }
270    else
271/*==================== getenv ==================================*/
272    if (strcmp(sys_cmd,"getenv")==0)
273    {
274      if ((h!=NULL) && (h->Typ()==STRING_CMD))
275      {
276        res->rtyp=STRING_CMD;
277        char *r=getenv((char *)h->Data());
278        if (r==NULL) r="";
279        res->data=(void *)mstrdup(r);
280        return FALSE;
281      }
282      else
283      {
284        WerrorS("string expected");
285        return TRUE;
286      }
287    }
288    else
289/*==================== setenv ==================================*/
290    if (strcmp(sys_cmd,"setenv")==0)
291    {
292#ifdef HAVE_SETENV
293      if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL &&
294          h->next != NULL && h->next->Typ() == STRING_CMD
295          && h->next->Data() != NULL)
296      {
297        res->rtyp=STRING_CMD;
298        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
299        res->data=(void *)mstrdup((char *)h->next->Data());
300        feReInitResources();
301        return FALSE;
302      }
303      else
304      {
305        WerrorS("two strings expected");
306        return TRUE;
307      }
308#else
309      WerrorS("setenv not supported on this platform");
310      return TRUE;
311#endif
312    }
313    else
314/*==================== Singular ==================================*/
315    if (strcmp(sys_cmd, "Singular") == 0)
316    {
317      res->rtyp=STRING_CMD;
318      char *r=feResource("Singular");
319      if (r != NULL)
320        res->data = (void*) mstrdup( r );
321      else
322        res->data = (void*) mstrdup("");
323      return FALSE;
324    }
325    else
326/*==================== options ==================================*/
327    if (strstr(sys_cmd, "--") == sys_cmd)
328    {
329      if (strcmp(sys_cmd, "--") == 0)
330      {
331        fePrintOptValues();
332        return FALSE;
333      }
334
335      feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
336      if (opt == FE_OPT_UNDEF)
337      {
338        Werror("Unknown option %s", sys_cmd);
339        Werror("Use 'system(\"--\");' for listing of available options");
340        return TRUE;
341      }
342
343      // for Untyped Options (help version),
344      // setting it just triggers action
345      if (feOptSpec[opt].type == feOptUntyped)
346      {
347        feSetOptValue(opt,NULL);
348        return FALSE;
349      }
350
351      if (h == NULL)
352      {
353        if (feOptSpec[opt].type == feOptString)
354        {
355          res->rtyp = STRING_CMD;
356          if (feOptSpec[opt].value != NULL)
357            res->data = mstrdup((char*) feOptSpec[opt].value);
358          else
359            res->data = mstrdup("");
360        }
361        else
362        {
363          res->rtyp = INT_CMD;
364          res->data = feOptSpec[opt].value;
365        }
366        return FALSE;
367      }
368
369      if (h->Typ() != STRING_CMD &&
370          h->Typ() != INT_CMD)
371      {
372        Werror("Need string or int argument to set option value");
373        return TRUE;
374      }
375      char* errormsg;
376      if (h->Typ() == INT_CMD)
377      {
378        if (feOptSpec[opt].type == feOptString)
379        {
380          Werror("Need string argument to set value of option %s", sys_cmd);
381          return TRUE;
382        }
383        errormsg = feSetOptValue(opt, (int) h->Data());
384        if (errormsg != NULL)
385          Werror("Option '--%s=%d' %s", sys_cmd, (int) h->Data(), errormsg);
386      }
387      else
388      {
389        errormsg = feSetOptValue(opt, (char*) h->Data());
390        if (errormsg != NULL)
391          Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
392      }
393      if (errormsg != NULL) return TRUE;
394      return FALSE;
395    }
396    else
397/*==================== HC ==================================*/
398    if (strcmp(sys_cmd,"HC")==0)
399    {
400      res->rtyp=INT_CMD;
401      res->data=(void *)HCord;
402      return FALSE;
403    }
404    else
405/*==================== random ==================================*/
406    if(strcmp(sys_cmd,"random")==0)
407    {
408      if ((h!=NULL) &&(h->Typ()==INT_CMD))
409      {
410        siRandomStart=(int)h->Data();
411#ifdef buildin_rand
412        siSeed=siRandomStart;
413#else
414        srand((unsigned int)siRandomStart);
415#endif
416        return FALSE;
417      }
418      else if (h != NULL)
419      {
420        WerrorS("int expected");
421        return TRUE;
422      }
423      res->rtyp=INT_CMD;
424      res->data=(void*) siRandomStart;
425      return FALSE;
426    }
427/*==================== complexNearZero ======================*/
428    if(strcmp(sys_cmd,"complexNearZero")==0)
429    {
430      if (h->Typ()==NUMBER_CMD )
431      {
432        if ( h->next!=NULL && h->next->Typ()==INT_CMD )
433        {
434          if ( !rField_is_long_C() )
435            {
436              Werror( "unsupported ground field!");
437              return TRUE;
438            }
439          else
440            {
441              res->rtyp=INT_CMD;
442              res->data=(void*)complexNearZero((gmp_complex*)h->Data(),(int)h->next->Data());
443              return FALSE;
444            }
445        }
446        else
447        {
448          Werror( "expected <int> as third parameter!");
449          return TRUE;
450        }
451      }
452      else
453      {
454        Werror( "expected <number> as second parameter!");
455        return TRUE;
456      }
457    }
458/*==================== getPrecDigits ======================*/
459    if(strcmp(sys_cmd,"getPrecDigits")==0)
460    {
461      if ( !rField_is_long_C() && !rField_is_long_R() )
462      {
463        Werror( "unsupported ground field!");
464        return TRUE;
465      }
466      res->rtyp=INT_CMD;
467      res->data=(void*)getGMPFloatDigits();
468      return FALSE;
469    }
470/*==================== neworder =============================*/
471// should go below
472#ifdef HAVE_LIBFAC_P
473    if(strcmp(sys_cmd,"neworder")==0)
474    {
475      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
476      {
477        res->rtyp=STRING_CMD;
478        res->data=(void *)singclap_neworder((ideal)h->Data());
479        return FALSE;
480      }
481      else
482        WerrorS("ideal expected");
483    }
484    else
485#endif
486/*==================== pcv ==================================*/
487#ifndef HAVE_DYNAMIC_LOADING
488#ifdef HAVE_PCV
489    if(strcmp(sys_cmd,"pcvLAddL")==0)
490    {
491      return pcvLAddL(res,h);
492    }
493    else
494    if(strcmp(sys_cmd,"pcvPMulL")==0)
495    {
496      return pcvPMulL(res,h);
497    }
498    else
499    if(strcmp(sys_cmd,"pcvMinDeg")==0)
500    {
501      return pcvMinDeg(res,h);
502    }
503    else
504    if(strcmp(sys_cmd,"pcvP2CV")==0)
505    {
506      return pcvP2CV(res,h);
507    }
508    else
509    if(strcmp(sys_cmd,"pcvCV2P")==0)
510    {
511      return pcvCV2P(res,h);
512    }
513    else
514    if(strcmp(sys_cmd,"pcvDim")==0)
515    {
516      return pcvDim(res,h);
517    }
518    else
519    if(strcmp(sys_cmd,"pcvBasis")==0)
520    {
521      return pcvBasis(res,h);
522    }
523    else
524#endif
525#endif /* HAVE_DYNAMIC_LOADING */
526/*==================== contributors =============================*/
527   if(strcmp(sys_cmd,"contributors") == 0)
528   {
529     res->rtyp=STRING_CMD;
530     res->data=(void *)mstrdup(
531       "Olaf Bachmann, Hubert Grassmann, Kai Krueger, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
532     return FALSE;
533   }
534   else
535/*==================== spectrum =============================*/
536   #ifdef HAVE_SPECTRUM
537   if(strcmp(sys_cmd,"spectrum") == 0)
538   {
539     if (h->Typ()!=POLY_CMD)
540     {
541       WerrorS("poly expected");
542       return TRUE;
543     }
544     if (h->next==NULL)
545       return spectrumProc(res,h);
546     if (h->next->Typ()!=INT_CMD)
547     {
548       WerrorS("poly,int expected");
549       return TRUE;
550     }
551     if(((int)h->next->Data())==1)
552       return spectrumfProc(res,h);
553     return spectrumProc(res,h);
554   }
555   else
556/*==================== semic =============================*/
557   if(strcmp(sys_cmd,"semic") == 0)
558   {
559     if ((h->next!=NULL)
560     && (h->Typ()==LIST_CMD)
561     && (h->next->Typ()==LIST_CMD))
562     {
563       if (h->next->next==NULL)
564         return semicProc(res,h,h->next);
565       else if (h->next->next->Typ()==INT_CMD)
566         return semicProc3(res,h,h->next,h->next->next);
567     }
568     return TRUE;
569   }
570   else
571/*==================== spadd =============================*/
572   if(strcmp(sys_cmd,"spadd") == 0)
573   {
574     if ((h->next!=NULL)
575     && (h->Typ()==LIST_CMD)
576     && (h->next->Typ()==LIST_CMD))
577     {
578       if (h->next->next==NULL)
579         return spaddProc(res,h,h->next);
580     }
581     return TRUE;
582   }
583   else
584/*==================== spmul =============================*/
585   if(strcmp(sys_cmd,"spmul") == 0)
586   {
587     if ((h->next!=NULL)
588     && (h->Typ()==LIST_CMD)
589     && (h->next->Typ()==INT_CMD))
590     {
591       if (h->next->next==NULL)
592         return spmulProc(res,h,h->next);
593     }
594     return TRUE;
595   }
596   else
597   #endif
598/*================= Extended system call ========================*/
599   {
600     #ifndef MAKE_DISTRIBUTION
601     return(jjEXTENDED_SYSTEM(res, args));
602     #else
603     Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
604     #endif
605   }
606  } /* typ==string */
607  return TRUE;
608}
609
610
611
612#ifdef HAVE_EXTENDED_SYSTEM
613// You can put your own system calls here
614#include "fglmcomb.cc"
615#include "fglm.h"
616#ifdef HAVE_NEWTON
617#include <hc_newton.h>
618#endif
619#include "mpsr.h"
620
621static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
622{
623  if(h->Typ() == STRING_CMD)
624  {
625    char *sys_cmd=(char *)(h->Data());
626    h=h->next;
627/*==================== poly debug ==================================*/
628    if(strcmp(sys_cmd,"p")==0)
629    {
630      pDebugPrint((poly)h->Data());
631      return FALSE;
632    }
633    else
634/*==================== ring debug ==================================*/
635    if(strcmp(sys_cmd,"r")==0)
636    {
637      rDebugPrint((ring)h->Data());
638      return FALSE;
639    }
640    else
641/*==================== mtrack ==================================*/
642    if(strcmp(sys_cmd,"mtrack")==0)
643    {
644#ifdef MLIST
645      FILE *fd = NULL;
646      if ((h!=NULL) &&(h->Typ()==STRING_CMD))
647      {
648        fd = fopen((char*) h->Data(), "w");
649        if (fd == NULL)
650          Warn("Can not open %s for writing og mtrack. Using stdout");
651      }
652      mmTestList((fd == NULL ? stdout: fd), 0);
653      if (fd != NULL) fclose(fd);
654      return FALSE;
655#else
656     WerrorS("mtrack not supported without MLIST");
657     return TRUE;
658#endif
659    }
660    else
661/*==================== naIdeal ==================================*/
662    if(strcmp(sys_cmd,"naIdeal")==0)
663    {
664      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
665      {
666        naSetIdeal((ideal)h->Data());
667        return FALSE;
668      }
669      else
670         WerrorS("ideal expected");
671    }
672    else
673/*==================== isSqrFree =============================*/
674#ifdef HAVE_FACTORY
675    if(strcmp(sys_cmd,"isSqrFree")==0)
676    {
677      if ((h!=NULL) &&(h->Typ()==POLY_CMD))
678      {
679        res->rtyp=INT_CMD;
680        res->data=(void *)singclap_isSqrFree((poly)h->Data());
681        return FALSE;
682      }
683      else
684        WerrorS("poly expected");
685    }
686    else
687#endif
688/*==================== pDivStat =============================*/
689    if(strcmp(sys_cmd,"pDivStat")==0)
690    {
691#ifdef PDIV_DEBUG
692      extern void pPrintDivisbleByStat();
693      pPrintDivisbleByStat();
694#endif
695      return FALSE;
696    }
697    else
698/*==================== alarm ==================================*/
699#ifndef __MWERKS__
700#ifndef MSDOS
701#ifndef atarist
702#ifdef unix
703    if(strcmp(sys_cmd,"alarm")==0)
704    {
705      if ((h!=NULL) &&(h->Typ()==INT_CMD))
706      {
707        // standard variant -> SIGALARM (standard: abort)
708        //alarm((unsigned)h->next->Data());
709        // process time (user +system): SIGVTALARM
710        struct itimerval t,o;
711        memset(&t,0,sizeof(t));
712        t.it_value.tv_sec     =(unsigned)h->Data();
713        setitimer(ITIMER_VIRTUAL,&t,&o);
714        return FALSE;
715      }
716      else
717        WerrorS("int expected");
718    }
719    else
720#endif
721#endif
722#endif
723#endif
724/*==================== red =============================*/
725#if 0
726    if(strcmp(sys_cmd,"red")==0)
727    {
728      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
729      {
730        res->rtyp=IDEAL_CMD;
731        res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
732        setFlag(res,FLAG_STD);
733        return FALSE;
734      }
735      else
736        WerrorS("ideal expected");
737    }
738    else
739#endif
740/*==================== algfetch =====================*/
741    if (strcmp(sys_cmd,"algfetch")==0)
742    {
743      int k;
744      idhdl w;
745      ideal i0, i1;
746      ring r0=(ring)h->Data();
747      leftv v = h->next;
748      w = r0->idroot->get(v->Name(),myynest);
749      if (w!=NULL)
750      {
751        if (IDTYP(w)==IDEAL_CMD)
752        {
753          i0 = IDIDEAL(w);
754          i1 = idInit(IDELEMS(i0),i0->rank);
755          for (k=0; k<IDELEMS(i1); k++)
756          {
757            i1->m[k] = maAlgpolyFetch(r0, i0->m[k]);
758          }
759          res->rtyp = IDEAL_CMD;
760          res->data = (void*)i1;
761          return FALSE;
762        }
763        else if (IDTYP(w)==POLY_CMD)
764        {
765          res->rtyp = POLY_CMD;
766          res->data = (void*)maAlgpolyFetch(r0,IDPOLY(w));
767          return FALSE;
768        }
769        else
770          WerrorS("`system(\"algfetch\",<ideal>/<poly>)` expected");
771      }
772      else
773        Werror("`%s` not found in `%s`",v->Name(),h->Name());
774    }
775    else
776/*==================== algmap =======================*/
777    if (strcmp(sys_cmd,"algmap")==0)
778    {
779      int k;
780      idhdl w;
781      ideal i0, i1, i, j;
782      ring r0=(ring)h->Data();
783      leftv v = h->next;
784      w = r0->idroot->get(v->Name(),myynest);
785      i0 = IDIDEAL(w);
786      v = v->next;
787      i = (ideal)v->Data();
788      v = v->next;
789      j = (ideal)v->Data();
790      i1 = idInit(IDELEMS(i0),i0->rank);
791      for (k=0; k<IDELEMS(i1); k++)
792      {
793        i1->m[k] = maAlgpolyMap(r0, i0->m[k], i, j);
794      }
795      res->rtyp = IDEAL_CMD;
796      res->data = (void*)i1;
797      return FALSE;
798    }
799    else
800#ifdef HAVE_FACTORY
801/*==================== fastcomb =============================*/
802    if(strcmp(sys_cmd,"fastcomb")==0)
803    {
804      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
805      {
806        int i=0;
807        if (h->next!=NULL)
808        {
809          if (h->next->Typ()!=POLY_CMD)
810          {
811            Warn("Wrong types for poly= comb(ideal,poly)");
812          }
813        }
814        res->rtyp=POLY_CMD;
815        res->data=(void *) fglmLinearCombination(
816                           (ideal)h->Data(),(poly)h->next->Data());
817        return FALSE;
818      }
819      else
820        WerrorS("ideal expected");
821    }
822    else
823/*==================== comb =============================*/
824    if(strcmp(sys_cmd,"comb")==0)
825    {
826      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
827      {
828        int i=0;
829        if (h->next!=NULL)
830        {
831          if (h->next->Typ()!=POLY_CMD)
832          {
833              Warn("Wrong types for poly= comb(ideal,poly)");
834          }
835        }
836        res->rtyp=POLY_CMD;
837        res->data=(void *)fglmNewLinearCombination(
838                            (ideal)h->Data(),(poly)h->next->Data());
839        return FALSE;
840      }
841      else
842        WerrorS("ideal expected");
843    }
844    else
845#endif
846#ifdef FACTORY_GCD_TEST
847/*=======================gcd Testerei ================================*/
848    if ( ! strcmp( sys_cmd, "setgcd" ) ) {
849        if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
850            CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
851            return FALSE;
852        } else
853            WerrorS("int expected");
854    }
855    else
856#endif
857
858#ifdef FACTORY_GCD_TIMING
859    if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
860        TIMING_PRINT( contentTimer, "time used for content: " );
861        TIMING_PRINT( algContentTimer, "time used for algContent: " );
862        TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
863        TIMING_RESET( contentTimer );
864        TIMING_RESET( algContentTimer );
865        TIMING_RESET( algLcmTimer );
866        return FALSE;
867    }
868    else
869#endif
870
871#ifdef FACTORY_GCD_STAT
872    if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
873        printGcdTotal();
874        printContTotal();
875        resetGcdTotal();
876        resetContTotal();
877        return FALSE;
878    }
879    else
880#endif
881/*==================== lib ==================================*/
882    if(strcmp(sys_cmd,"LIB")==0)
883    {
884#ifdef HAVE_NAMESPACES
885      idhdl hh=namespaceroot->get((char*)h->Data(),0);
886#else /* HAVE_NAMESPACES */
887      idhdl hh=idroot->get((char*)h->Data(),0);
888#endif /* HAVE_NAMESPACES */
889      if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
890      {
891        res->rtyp=STRING_CMD;
892        char *r=iiGetLibName(IDPROC(hh));
893        if (r==NULL) r="";
894        res->data=mstrdup(r);
895        return FALSE;
896      }
897      else
898        Warn("`%s` not found",(char*)h->Data());
899    }
900    else
901#ifdef HAVE_NAMESPACES
902/*==================== nspush ===================================*/
903    if(strcmp(sys_cmd,"nspush")==0)
904    {
905      if (h->Typ()==PACKAGE_CMD)
906      {
907        idhdl hh=(idhdl)h->data;
908        namespaceroot = namespaceroot->push(IDPACKAGE(hh), IDID(hh));
909        return FALSE;
910      }
911      else
912        Warn("argument 2 is not a package");
913    }
914    else
915/*==================== nspop ====================================*/
916    if(strcmp(sys_cmd,"nspop")==0)
917    {
918      namespaceroot->pop();
919      return FALSE;
920    }
921    else
922#endif /* HAVE_NAMESPACES */
923/*==================== nsstack ===================================*/
924    if(strcmp(sys_cmd,"nsstack")==0)
925    {
926      namehdl nshdl = namespaceroot;
927      for( ; nshdl->isroot != TRUE; nshdl = nshdl->next) {
928        Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
929      }
930      Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
931      return FALSE;
932    }
933    else
934/*==================== proclist =================================*/
935    if(strcmp(sys_cmd,"proclist")==0)
936    {
937      piShowProcList();
938      return FALSE;
939    }
940    else
941/* ==================== newton ================================*/
942#ifdef HAVE_NEWTON
943    if(strcmp(sys_cmd,"newton")==0)
944    {
945      if ((h->Typ()!=POLY_CMD)
946      || (h->next->Typ()!=INT_CMD)
947      || (h->next->next->Typ()!=INT_CMD))
948      {
949        WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
950        return TRUE;
951      }
952      poly  p=(poly)(h->Data());
953      int l=pLength(p);
954      short *points=(short *)Alloc(currRing->N*l*sizeof(short));
955      int i,j,k;
956      k=0;
957      poly pp=p;
958      for (i=0;pp!=NULL;i++)
959      {
960        for(j=1;j<=currRing->N;j++)
961        {
962          points[k]=pGetExp(pp,j);
963          k++;
964        }
965        pIter(pp);
966      }
967      hc_ERG r=hc_KOENIG(currRing->N,      // dimension
968                l,      // number of points
969                (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
970                currRing->OrdSgn==-1,
971                (int) (h->next->Data()),      // 1: Milnor, 0: Newton
972                (int) (h->next->next->Data()) // debug
973               );
974      //----<>---Output-----------------------
975
976
977//  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
978
979
980      lists L=(lists)AllocSizeOf(slists);
981      L->Init(6);
982      L->m[0].rtyp=STRING_CMD;               // newtonnumber;
983      L->m[0].data=(void *)mstrdup(r.nZahl);
984      L->m[1].rtyp=INT_CMD;
985      L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
986      L->m[2].rtyp=INT_CMD;
987      L->m[2].data=(void *)r.deg;            // #degenerations
988      if ( r.deg != 0)              // only if degenerations exist
989      {
990        L->m[3].rtyp=INT_CMD;
991        L->m[3].data=(void *)r.anz_punkte;     // #points
992        //---<>--number of points------
993        int anz = r.anz_punkte;    // number of points
994        int dim = (currRing->N);     // dimension
995        intvec* v = NewIntvec1( anz*dim );
996        for (i=0; i<anz*dim; i++)    // copy points
997          (*v)[i] = r.pu[i];
998        L->m[4].rtyp=INTVEC_CMD;
999        L->m[4].data=(void *)v;
1000        //---<>--degenerations---------
1001        int deg = r.deg;    // number of points
1002        intvec* w = NewIntvec1( r.speicher );  // necessary memeory
1003        i=0;               // start copying
1004        do
1005        {
1006          (*w)[i] = r.deg_tab[i];
1007          i++;
1008        }
1009        while (r.deg_tab[i-1] != -2);   // mark for end of list
1010        L->m[5].rtyp=INTVEC_CMD;
1011        L->m[5].data=(void *)w;
1012      }
1013      else
1014      {
1015        L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
1016        L->m[4].rtyp=DEF_CMD;
1017        L->m[5].rtyp=DEF_CMD;
1018      }
1019
1020      res->data=(void *)L;
1021      res->rtyp=LIST_CMD;
1022      // free all pointer in r:
1023      delete[] r.nZahl;
1024      delete[] r.pu;
1025      delete[] r.deg_tab;      // Ist das ein Problem??
1026
1027      Free((ADDRESS)points,currRing->N*l*sizeof(short));
1028      return FALSE;
1029    }
1030    else
1031#endif
1032/*==================== gp =================*/
1033#ifdef HAVE_MPSR
1034    if (strcmp(sys_cmd, "gp") == 0)
1035    {
1036      if (h->Typ() != LINK_CMD)
1037      {
1038        WerrorS("No Link arg");
1039        return FALSE;
1040      }
1041      si_link l = (si_link) h->Data();
1042      if (strcmp(l->m->type, "MPfile") != 0)
1043      {
1044        WerrorS("No MPfile link");
1045        return TRUE;
1046      }
1047      if( ! SI_LINK_R_OPEN_P(l)) // open r ?
1048      {
1049        if (slOpen(l, SI_LINK_READ)) return TRUE;
1050      }
1051
1052      MP_Link_pt link = (MP_Link_pt) l->data;
1053      if (MP_InitMsg(link) != MP_Success)
1054      {
1055        WerrorS("Can not Init");
1056      }
1057      MPT_Tree_pt tree = NULL;
1058      if (MPT_GetTree(link, &tree) != MPT_Success)
1059      {
1060        WerrorS("Can not get tree");
1061        return TRUE;
1062      }
1063      MPT_GP_pt gp_tree = MPT_GetGP(tree);
1064      if (gp_tree == NULL || ! gp_tree->IsOk(gp_tree))
1065      {
1066        WerrorS("gp error");
1067        return TRUE;
1068      }
1069      delete gp_tree;
1070      MPT_DeleteTree(tree);
1071      return FALSE;
1072    }
1073    else
1074#endif
1075/*==================== sdb_flags =================*/
1076    if (strcmp(sys_cmd, "sdb_flags") == 0)
1077    {
1078      if ((h!=NULL) && (h->Typ()==INT_CMD))
1079      {
1080        sdb_flags=(int)h->Data();
1081      }
1082      else
1083      {
1084        WerrorS("system(\"sdb_flags\",`int`) expected");
1085        return TRUE;
1086      }
1087      return FALSE;
1088    }
1089    else
1090/*==================== sdb_edit =================*/
1091    if (strcmp(sys_cmd, "sdb_edit") == 0)
1092    {
1093      if ((h!=NULL) && (h->Typ()==PROC_CMD))
1094      {
1095        procinfov p=(procinfov)h->Data();
1096        sdb_edit(p);
1097      }
1098      else
1099      {
1100        WerrorS("system(\"sdb_edit\",`proc`) expected");
1101        return TRUE;
1102      }
1103      return FALSE;
1104    }
1105    else
1106/*==================== GF =================*/
1107#if 0
1108    if (strcmp(sys_cmd, "GF") == 0)
1109    {
1110      int c=rChar(currRing);
1111      setCharacteristic( c, 2);
1112      CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
1113      res->rtyp=POLY_CMD;
1114      res->data=convClapGFSingGF( F );
1115      return FALSE;
1116    }
1117    else
1118#endif
1119#ifdef HAVE_WALK
1120/*==================== walk stuff =================*/
1121    if (strcmp(sys_cmd, "walkNextWeight") == 0)
1122    {
1123      if (h == NULL || h->Typ() != INTVEC_CMD ||
1124          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1125          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
1126      {
1127        Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1128        return TRUE;
1129      }
1130
1131      if (((intvec*) h->Data())->length() != currRing->N ||
1132          ((intvec*) h->next->Data())->length() != currRing->N)
1133      {
1134        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1135               currRing->N);
1136        return TRUE;
1137      }
1138      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1139                                         ((intvec*) h->next->Data()),
1140                                         (ideal) h->next->next->Data());
1141      if (res->data == (void*) 0 || res->data == (void*) 1)
1142      {
1143        res->rtyp = INT_CMD;
1144      }
1145      else
1146      {
1147        res->rtyp = INTVEC_CMD;
1148      }
1149      return FALSE;
1150    }
1151    else if (strcmp(sys_cmd, "walkInitials") == 0)
1152    {
1153      if (h == NULL || h->Typ() != IDEAL_CMD)
1154      {
1155        WerrorS("system(\"walkInitials\", ideal) expected");
1156        return TRUE;
1157      }
1158
1159      res->data = (void*) walkInitials((ideal) h->Data());
1160      res->rtyp = IDEAL_CMD;
1161      return FALSE;
1162    }
1163    else
1164#endif
1165/*==================== Error =================*/
1166      Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1167  }
1168  return TRUE;
1169}
1170#endif // HAVE_EXTENDED_SYSTEM
Note: See TracBrowser for help on using the repository browser.