source: git/Singular/extra.cc @ 0e002d

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