source: git/Singular/extra.cc @ c342fc

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