source: git/Singular/extra.cc @ 4b72f6

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