source: git/Singular/extra.cc @ 3105b0

fieker-DuValspielwiese
Last change on this file since 3105b0 was 3105b0, checked in by Hans Schönemann <hannes@…>, 25 years ago
*hannes: more sdb modi git-svn-id: file:///usr/local/Singular/svn/trunk@3526 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 25.4 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: extra.cc,v 1.103 1999-08-20 16:06:49 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
52// Define to enable many more system commands
53#ifndef MAKE_DISTRIBUTION
54#define HAVE_EXTENDED_SYSTEM
55#endif
56
57#ifdef STDTRACE
58//#include "comm.h"
59#endif
60
61#ifdef HAVE_FACTORY
62#define SI_DONT_HAVE_GLOBAL_VARS
63#include "clapsing.h"
64#include "clapconv.h"
65#include "kstdfac.h"
66#endif
67
68#include "silink.h"
69#ifdef HAVE_MPSR
70#include "mpsr.h"
71#include "MPT_GP.h"
72#endif
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/*==================== sh ==================================*/
162    if(strcmp(sys_cmd,"sh")==0)
163    {
164      res->rtyp=INT_CMD;
165      #ifndef __MWERKS__
166      if (h==NULL) res->data = (void *)system("sh");
167      else if (h->Typ()==STRING_CMD)
168        res->data = (void*) system((char*)(h->Data()));
169      else
170        WerrorS("string expected");
171      #else
172      res->data=(void *)0;
173      #endif
174      return FALSE;
175    }
176    else
177/*==================== with ==================================*/
178    if(strcmp(sys_cmd,"with")==0)
179    {
180      if (h==NULL)
181      {
182        res->rtyp=STRING_CMD;
183        res->data=(void *)mstrdup(versionString());
184        return FALSE;
185      }
186      else if (h->Typ()==STRING_CMD)
187      {
188        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
189        char *s=(char *)h->Data();
190        res->rtyp=INT_CMD;
191        #ifdef DRING
192          TEST_FOR("DRING")
193        #endif
194        #ifdef HAVE_DBM
195          TEST_FOR("DBM")
196        #endif
197        #ifdef HAVE_DLD
198          TEST_FOR("DLD")
199        #endif
200        #ifdef HAVE_FACTORY
201          TEST_FOR("factory")
202        #endif
203        #ifdef HAVE_LIBFAC_P
204          TEST_FOR("libfac")
205        #endif
206        #ifdef HAVE_MPSR
207          TEST_FOR("MP")
208        #endif
209        #ifdef HAVE_READLINE
210          TEST_FOR("readline")
211        #endif
212        #ifdef HAVE_TCL
213          TEST_FOR("tcl")
214        #endif
215        #ifdef SRING
216          TEST_FOR("SRING")
217        #endif
218        #ifdef TEST_MAC_ORDER
219          TEST_FOR("MAC_ORDER");
220        #endif
221        #ifdef HAVE_NAMESPACES
222          TEST_FOR("Namespaces");
223        #endif
224        #ifdef HAVE_DYNAMIC_LOADING
225          TEST_FOR("DynamicLoading");
226        #endif
227          ;
228        return FALSE;
229        #undef TEST_FOR
230      }
231      return TRUE;
232    }
233    else
234/*==================== browsers ==================================*/
235    if (strcmp(sys_cmd,"browsers")==0)
236    {
237      res->rtyp = STRING_CMD;
238      char* b = StringSetS("");
239      feStringAppendBrowsers(1);
240      res->data = mstrdup(b);
241      return FALSE;
242    }
243    else
244/*==================== pid ==================================*/
245    if (strcmp(sys_cmd,"pid")==0)
246    {
247      res->rtyp=INT_CMD;
248    #ifndef MSDOS
249    #ifndef __MWERKS__
250      res->data=(void *)getpid();
251    #else
252      res->data=(void *)1;
253    #endif
254    #else
255      res->data=(void *)1;
256    #endif
257      return FALSE;
258    }
259    else
260/*==================== getenv ==================================*/
261    if (strcmp(sys_cmd,"getenv")==0)
262    {
263      if ((h!=NULL) && (h->Typ()==STRING_CMD))
264      {
265        res->rtyp=STRING_CMD;
266        char *r=getenv((char *)h->Data());
267        if (r==NULL) r="";
268        res->data=(void *)mstrdup(r);
269        return FALSE;
270      }
271      else
272      {
273        WerrorS("string expected");
274        return TRUE;
275      }
276    }
277    else
278/*==================== setenv ==================================*/
279    if (strcmp(sys_cmd,"setenv")==0)
280    {
281#ifdef HAVE_SETENV
282      if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL &&
283          h->next != NULL && h->next->Typ() == STRING_CMD
284          && h->next->Data() != NULL)
285      {
286        res->rtyp=STRING_CMD;
287        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
288        res->data=(void *)mstrdup((char *)h->next->Data());
289        feReInitResources();
290        return FALSE;
291      }
292      else
293      {
294        WerrorS("two strings expected");
295        return TRUE;
296      }
297#else
298      WerrorS("setenv not supported on this platform");
299      return TRUE;
300#endif
301    }
302    else
303/*==================== Singular ==================================*/
304    if (strcmp(sys_cmd, "Singular") == 0)
305    {
306      res->rtyp=STRING_CMD;
307      char *r=feResource("Singular");
308      if (r != NULL)
309        res->data = (void*) mstrdup( r );
310      else
311        res->data = (void*) mstrdup("");
312      return FALSE;
313    }
314    else
315/*==================== options ==================================*/
316    if (strstr(sys_cmd, "--") == sys_cmd)
317    {
318      BOOLEAN mainGetSingOptionValue(const char* name, char** result);
319      char* val;
320
321      if (h != NULL)
322      {
323        if (strcmp(sys_cmd, "--browser") == 0)
324        {
325          if (h->Typ() == STRING_CMD)
326          {
327            if (strcmp(feHelpBrowser((char*) h->Data(), 1),
328                       (char*) h->Data()) != 0)
329            {
330              Werror("Can not set HelpBrowser to '%s'", (char*) h->Data());
331              return TRUE;
332            }
333          }
334          else
335          {
336            Werror("Need string to set HelpBrowser");
337            return TRUE;
338          }
339        }
340        else
341        {
342          Werror("Can not set value of option %s", sys_cmd);
343          return TRUE;
344        }
345      }
346
347      if (mainGetSingOptionValue(&(sys_cmd)[2], &val))
348      {
349        if ((unsigned int) val > 1)
350        {
351          res->rtyp=STRING_CMD;
352          if (strcmp(sys_cmd, "--browser") == 0 &&
353              (val == NULL || *val == '\0'))
354            res->data = (void*) mstrdup(feHelpBrowser());
355          else
356            res->data = (void*) mstrdup( val );
357        }
358        else
359        {
360          res->rtyp=INT_CMD;
361          res->data=(void *)val;
362        }
363        return FALSE;
364      }
365      else
366      {
367        Werror("Unknown option %s\n", sys_cmd);
368        return TRUE;
369      }
370    }
371    else
372/*==================== HC ==================================*/
373    if (strcmp(sys_cmd,"HC")==0)
374    {
375      res->rtyp=INT_CMD;
376      res->data=(void *)HCord;
377      return FALSE;
378    }
379    else
380/*==================== random ==================================*/
381    if(strcmp(sys_cmd,"random")==0)
382    {
383      if ((h!=NULL) &&(h->Typ()==INT_CMD))
384      {
385        siRandomStart=(int)h->Data();
386#ifdef buildin_rand
387        siSeed=siRandomStart;
388#else
389        srand((unsigned int)siRandomStart);
390#endif
391        return FALSE;
392      }
393      else if (h != NULL)
394      {
395        WerrorS("int expected");
396        return TRUE;
397      }
398      res->rtyp=INT_CMD;
399      res->data=(void*) siRandomStart;
400      return FALSE;
401    }
402/*==================== neworder =============================*/
403// should go below
404#ifdef HAVE_LIBFAC_P
405    if(strcmp(sys_cmd,"neworder")==0)
406    {
407      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
408      {
409        res->rtyp=STRING_CMD;
410        res->data=(void *)singclap_neworder((ideal)h->Data());
411        return FALSE;
412      }
413      else
414        WerrorS("ideal expected");
415    }
416    else
417#endif
418/*==================== contributors =============================*/
419   if(strcmp(sys_cmd,"contributors") == 0)
420   {
421     res->rtyp=STRING_CMD;
422     res->data=(void *)mstrdup(
423       "Olaf Bachmann, Hubert Grassmann, Kai Krueger, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Thomas Siebert, Ruediger Stobbe, Tim Wichmann");
424     return FALSE;
425   }
426   else
427   {
428/*================= Extended system call ========================*/
429#ifdef HAVE_EXTENDED_SYSTEM
430     return(jjEXTENDED_SYSTEM(res, args));
431#else
432     Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
433#endif
434   }
435  } /* typ==string */
436  return TRUE;
437}
438
439
440
441#ifdef HAVE_EXTENDED_SYSTEM
442// You can put your own system calls here
443#include "fglmcomb.cc"
444#include "fglm.h"
445#ifdef HAVE_NEWTON
446#include <hc_newton.h>
447#endif
448#include "mpsr.h"
449
450#include "mpr_complex.h"
451
452static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
453{
454  if(h->Typ() == STRING_CMD)
455  {
456    char *sys_cmd=(char *)(h->Data());
457    h=h->next;
458/*==================== pcv ==================================*/
459#ifndef HAVE_DYNAMIC_LOADING
460#ifdef HAVE_PCV
461    if(strcmp(sys_cmd,"pcvLAddL")==0)
462    {
463      return pcvLAddL(res,h);
464    }
465    else
466    if(strcmp(sys_cmd,"pcvPMulL")==0)
467    {
468      return pcvPMulL(res,h);
469    }
470    else
471    if(strcmp(sys_cmd,"pcvMinDeg")==0)
472    {
473      return pcvMinDeg(res,h);
474    }
475    else
476    if(strcmp(sys_cmd,"pcvP2CV")==0)
477    {
478      return pcvP2CV(res,h);
479    }
480    else
481    if(strcmp(sys_cmd,"pcvCV2P")==0)
482    {
483      return pcvCV2P(res,h);
484    }
485    else
486    if(strcmp(sys_cmd,"pcvDim")==0)
487    {
488      return pcvDim(res,h);
489    }
490    else
491    if(strcmp(sys_cmd,"pcvBasis")==0)
492    {
493      return pcvBasis(res,h);
494    }
495    else
496#endif
497#endif /* HAVE_DYNAMIC_LOADING */
498/*==================== naIdeal ==================================*/
499    if(strcmp(sys_cmd,"naIdeal")==0)
500    {
501      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
502      {
503        naSetIdeal((ideal)h->Data());
504        return FALSE;
505      }
506      else
507         WerrorS("ideal expected");
508    }
509    else
510/*==================== isSqrFree =============================*/
511#ifdef HAVE_FACTORY
512    if(strcmp(sys_cmd,"isSqrFree")==0)
513    {
514      if ((h!=NULL) &&(h->Typ()==POLY_CMD))
515      {
516        res->rtyp=INT_CMD;
517        res->data=(void *)singclap_isSqrFree((poly)h->Data());
518        return FALSE;
519      }
520      else
521        WerrorS("poly expected");
522    }
523    else
524#endif
525/*==================== alarm ==================================*/
526#ifndef __MWERKS__
527#ifndef MSDOS
528#ifndef atarist
529#ifdef unix
530    if(strcmp(sys_cmd,"alarm")==0)
531    {
532      if ((h!=NULL) &&(h->Typ()==INT_CMD))
533      {
534        // standard variant -> SIGALARM (standard: abort)
535        //alarm((unsigned)h->next->Data());
536        // process time (user +system): SIGVTALARM
537        struct itimerval t,o;
538        memset(&t,0,sizeof(t));
539        t.it_value.tv_sec     =(unsigned)h->Data();
540        setitimer(ITIMER_VIRTUAL,&t,&o);
541        return FALSE;
542      }
543      else
544        WerrorS("int expected");
545    }
546    else
547#endif
548#endif
549#endif
550#endif
551/*==================== red =============================*/
552#if 0
553    if(strcmp(sys_cmd,"red")==0)
554    {
555      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
556      {
557        res->rtyp=IDEAL_CMD;
558        res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
559        setFlag(res,FLAG_STD);
560        return FALSE;
561      }
562      else
563        WerrorS("ideal expected");
564    }
565    else
566#endif
567/*==================== algfetch =====================*/
568    if (strcmp(sys_cmd,"algfetch")==0)
569    {
570      int k;
571      idhdl w;
572      ideal i0, i1;
573      ring r0=(ring)h->Data();
574      leftv v = h->next;
575      w = r0->idroot->get(v->Name(),myynest);
576      if (w!=NULL)
577      {
578        if (IDTYP(w)==IDEAL_CMD)
579        {
580          i0 = IDIDEAL(w);
581          i1 = idInit(IDELEMS(i0),i0->rank);
582          for (k=0; k<IDELEMS(i1); k++)
583          {
584            i1->m[k] = maAlgpolyFetch(r0, i0->m[k]);
585          }
586          res->rtyp = IDEAL_CMD;
587          res->data = (void*)i1;
588          return FALSE;
589        }
590        else if (IDTYP(w)==POLY_CMD)
591        {
592          res->rtyp = POLY_CMD;
593          res->data = (void*)maAlgpolyFetch(r0,IDPOLY(w));
594          return FALSE;
595        }
596        else
597          WerrorS("`system(\"algfetch\",<ideal>/<poly>)` expected");
598      }
599      else
600        Werror("`%s` not found in `%s`",v->Name(),h->Name());
601    }
602    else
603/*==================== algmap =======================*/
604    if (strcmp(sys_cmd,"algmap")==0)
605    {
606      int k;
607      idhdl w;
608      ideal i0, i1, i, j;
609      ring r0=(ring)h->Data();
610      leftv v = h->next;
611      w = r0->idroot->get(v->Name(),myynest);
612      i0 = IDIDEAL(w);
613      v = v->next;
614      i = (ideal)v->Data();
615      v = v->next;
616      j = (ideal)v->Data();
617      i1 = idInit(IDELEMS(i0),i0->rank);
618      for (k=0; k<IDELEMS(i1); k++)
619      {
620        i1->m[k] = maAlgpolyMap(r0, i0->m[k], i, j);
621      }
622      res->rtyp = IDEAL_CMD;
623      res->data = (void*)i1;
624      return FALSE;
625    }
626    else
627    /*==================== trace =============================*/
628#ifdef STDTRACE
629    /* Parameter : Ideal, Liste mit Links. */
630    if(strcmp(sys_cmd,"stdtrace")==0)
631    {
632      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
633      {
634        leftv root  = NULL,
635              ptr   = NULL,
636              lv    = NULL;
637        lists l     = NULL;
638        ideal I     = (ideal)(h->Data());
639        lists links = (lists)(h->next->Data());
640        tHomog hom  = testHomog;
641        int rw      = (int)(h->next->next->Data());
642
643        if(I==NULL)
644          PrintS("I==NULL\n");
645        for(int i=0; i <= links->nr ; i++)
646        {
647          lv = (leftv)Alloc0(sizeof(sleftv));
648          lv->Copy(&(links->m[i]));
649          if(root==NULL)
650          root=lv;
651          if(ptr==NULL)
652          {
653            ptr=lv;
654            ptr->next=NULL;
655          }
656          else
657          {
658            ptr->next=lv;
659            ptr=lv;
660          }
661        }
662        ptr->next=NULL;
663        l=TraceStd(root,rw,I,currQuotient,testHomog,NULL);
664        idSkipZeroes(((ideal)l->m[0].Data()));
665        res->rtyp=LIST_CMD;
666        res->data=(void *) l;
667        res->next=NULL;
668        root->CleanUp();
669        Free(root,sizeof(sleftv));
670        return FALSE;
671      }
672      else
673         WerrorS("ideal expected");
674    }
675    else
676#endif
677#ifdef HAVE_FACTORY
678/*==================== fastcomb =============================*/
679    if(strcmp(sys_cmd,"fastcomb")==0)
680    {
681      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
682      {
683        int i=0;
684        if (h->next!=NULL)
685        {
686          if (h->next->Typ()!=POLY_CMD)
687          {
688            Warn("Wrong types for poly= comb(ideal,poly)");
689          }
690        }
691        res->rtyp=POLY_CMD;
692        res->data=(void *) fglmLinearCombination(
693                           (ideal)h->Data(),(poly)h->next->Data());
694        return FALSE;
695      }
696      else
697        WerrorS("ideal expected");
698    }
699    else
700/*==================== comb =============================*/
701    if(strcmp(sys_cmd,"comb")==0)
702    {
703      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
704      {
705        int i=0;
706        if (h->next!=NULL)
707        {
708          if (h->next->Typ()!=POLY_CMD)
709          {
710              Warn("Wrong types for poly= comb(ideal,poly)");
711          }
712        }
713        res->rtyp=POLY_CMD;
714        res->data=(void *)fglmNewLinearCombination(
715                            (ideal)h->Data(),(poly)h->next->Data());
716        return FALSE;
717      }
718      else
719        WerrorS("ideal expected");
720    }
721    else
722#endif
723#ifdef FACTORY_GCD_TEST
724/*=======================gcd Testerei ================================*/
725    if ( ! strcmp( sys_cmd, "setgcd" ) ) {
726        if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
727            CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
728            return FALSE;
729        } else
730            WerrorS("int expected");
731    }
732    else
733#endif
734
735#ifdef FACTORY_GCD_TIMING
736    if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
737        TIMING_PRINT( contentTimer, "time used for content: " );
738        TIMING_PRINT( algContentTimer, "time used for algContent: " );
739        TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
740        TIMING_RESET( contentTimer );
741        TIMING_RESET( algContentTimer );
742        TIMING_RESET( algLcmTimer );
743        return FALSE;
744    }
745    else
746#endif
747
748#ifdef FACTORY_GCD_STAT
749    if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
750        printGcdTotal();
751        printContTotal();
752        resetGcdTotal();
753        resetContTotal();
754        return FALSE;
755    }
756    else
757#endif
758/*==================== lib ==================================*/
759    if(strcmp(sys_cmd,"LIB")==0)
760    {
761#ifdef HAVE_NAMESPACES
762      idhdl hh=namespaceroot->get((char*)h->Data(),0);
763#else /* HAVE_NAMESPACES */
764      idhdl hh=idroot->get((char*)h->Data(),0);
765#endif /* HAVE_NAMESPACES */
766      if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
767      {
768        res->rtyp=STRING_CMD;
769        char *r=iiGetLibName(IDPROC(hh));
770        if (r==NULL) r="";
771        res->data=mstrdup(r);
772        return FALSE;
773      }
774      else
775        Warn("`%s` not found",(char*)h->Data());
776    }
777    else
778#ifdef HAVE_NAMESPACES
779/*==================== nspush ===================================*/
780    if(strcmp(sys_cmd,"nspush")==0)
781    {
782      if (h->Typ()==PACKAGE_CMD)
783      {
784        idhdl hh=(idhdl)h->data;
785        namespaceroot = namespaceroot->push(IDPACKAGE(hh), IDID(hh));
786        return FALSE;
787      }
788      else
789        Warn("argument 2 is not a package");
790    }
791    else
792/*==================== nspop ====================================*/
793    if(strcmp(sys_cmd,"nspop")==0)
794    {
795      namespaceroot->pop();
796      return FALSE;
797    }
798    else
799#endif /* HAVE_NAMESPACES */
800/*==================== nsstack ===================================*/
801    if(strcmp(sys_cmd,"nsstack")==0)
802    {
803      namehdl nshdl = namespaceroot;
804      for( ; nshdl->isroot != TRUE; nshdl = nshdl->next) {
805        Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
806      }
807      Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
808      return FALSE;
809    }
810    else
811/*==================== proclist =================================*/
812    if(strcmp(sys_cmd,"proclist")==0)
813    {
814      piShowProcList();
815      return FALSE;
816    }
817    else
818/* ==================== newton ================================*/
819#ifdef HAVE_NEWTON
820    if(strcmp(sys_cmd,"newton")==0)
821    {
822      if ((h->Typ()!=POLY_CMD)
823      || (h->next->Typ()!=INT_CMD)
824      || (h->next->next->Typ()!=INT_CMD))
825      {
826        WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
827        return TRUE;
828      }
829      poly  p=(poly)(h->Data());
830      int l=pLength(p);
831      short *points=(short *)Alloc(currRing->N*l*sizeof(short));
832      int i,j,k;
833      k=0;
834      poly pp=p;
835      for (i=0;pp!=NULL;i++)
836      {
837        for(j=1;j<=currRing->N;j++)
838        {
839          points[k]=pGetExp(pp,j);
840          k++;
841        }
842        pIter(pp);
843      }
844      hc_ERG r=hc_KOENIG(currRing->N,      // dimension
845                l,      // number of points
846                (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
847                currRing->OrdSgn==-1,
848                (int) (h->next->Data()),      // 1: Milnor, 0: Newton
849                (int) (h->next->next->Data()) // debug
850               );
851      //----<>---Output-----------------------
852
853
854//  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
855
856
857      lists L=(lists)Alloc(sizeof(slists));
858      L->Init(6);
859      L->m[0].rtyp=STRING_CMD;               // newtonnumber;
860      L->m[0].data=(void *)mstrdup(r.nZahl);
861      L->m[1].rtyp=INT_CMD;
862      L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
863      L->m[2].rtyp=INT_CMD;
864      L->m[2].data=(void *)r.deg;            // #degenerations
865      if ( r.deg != 0)              // only if degenerations exist
866      {
867        L->m[3].rtyp=INT_CMD;
868        L->m[3].data=(void *)r.anz_punkte;     // #points
869        //---<>--number of points------
870        int anz = r.anz_punkte;    // number of points
871        int dim = (currRing->N);     // dimension
872        intvec* v = new intvec( anz*dim );
873        for (i=0; i<anz*dim; i++)    // copy points
874          (*v)[i] = r.pu[i];
875        L->m[4].rtyp=INTVEC_CMD;
876        L->m[4].data=(void *)v;
877        //---<>--degenerations---------
878        int deg = r.deg;    // number of points
879        intvec* w = new intvec( r.speicher );  // necessary memeory
880        i=0;               // start copying
881        do
882        {
883          (*w)[i] = r.deg_tab[i];
884          i++;
885        }
886        while (r.deg_tab[i-1] != -2);   // mark for end of list
887        L->m[5].rtyp=INTVEC_CMD;
888        L->m[5].data=(void *)w;
889      }
890      else
891      {
892        L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
893        L->m[4].rtyp=DEF_CMD;
894        L->m[5].rtyp=DEF_CMD;
895      }
896
897      res->data=(void *)L;
898      res->rtyp=LIST_CMD;
899      // free all pointer in r:
900      delete[] r.nZahl;
901      delete[] r.pu;
902      delete[] r.deg_tab;      // Ist das ein Problem??
903
904      Free((ADDRESS)points,currRing->N*l*sizeof(short));
905      return FALSE;
906    }
907    else
908#endif
909/*==================== gp =================*/
910#ifdef HAVE_MPSR
911     if (strcmp(sys_cmd, "gp") == 0)
912    {
913      if (h->Typ() != LINK_CMD)
914      {
915        WerrorS("No Link arg");
916        return FALSE;
917      }
918      si_link l = (si_link) h->Data();
919      if (strcmp(l->m->type, "MPfile") != 0)
920      {
921        WerrorS("No MPfile link");
922        return TRUE;
923      }
924      if( ! SI_LINK_R_OPEN_P(l)) // open r ?
925      {
926        if (slOpen(l, SI_LINK_READ)) return TRUE;
927      }
928
929      MP_Link_pt link = (MP_Link_pt) l->data;
930      if (MP_InitMsg(link) != MP_Success)
931      {
932        WerrorS("Can not Init");
933      }
934      MPT_Tree_pt tree = NULL;
935      if (MPT_GetTree(link, &tree) != MPT_Success)
936      {
937        WerrorS("Can not get tree");
938        return TRUE;
939      }
940      MPT_GP_pt gp_tree = MPT_GetGP(tree);
941      if (gp_tree == NULL || ! gp_tree->IsOk(gp_tree))
942      {
943        WerrorS("gp error");
944        return TRUE;
945      }
946      delete gp_tree;
947      MPT_DeleteTree(tree);
948      return FALSE;
949    }
950    else
951#endif
952/*==================== sdb-debugger =================*/
953    if (strcmp(sys_cmd, "breakpoint") == 0)
954    {
955      if (h==NULL)
956      {
957       sdb_show_bp();
958       return FALSE;
959      }
960      else if (h->Typ()==PROC_CMD)
961      {
962        int lineno=0;
963        if ((h->next!=NULL) && (h->next->Typ()==INT_CMD))
964        {
965          lineno=(int)h->next->Data();
966        }
967        return sdb_set_breakpoint(h->Name(),lineno);
968      }
969      else
970      {
971        WerrorS("system(\"breakpoint\",`proc`[,`int`]) expected");
972        return TRUE;
973      }
974    }
975    else
976/*==================== sdb_flags =================*/
977    if (strcmp(sys_cmd, "sdb_flags") == 0)
978    {
979      if ((h!=NULL) && (h->Typ()==INT_CMD))
980      {
981        sdb_flags=(int)h->Data();
982      }
983      else
984      {
985        WerrorS("system(\"sdb_flags\",`int`) expected");
986        return TRUE;
987      }
988      return FALSE;
989    }
990    else
991/*==================== sdb_edit =================*/
992    if (strcmp(sys_cmd, "sdb_edit") == 0)
993    {
994      if ((h!=NULL) && (h->Typ()==PROC_CMD))
995      {
996        procinfov p=(procinfov)h->Data();
997        sdb_edit(p);
998      }
999      else
1000      {
1001        WerrorS("system(\"sdb_edit\",`proc`) expected");
1002        return TRUE;
1003      }
1004      return FALSE;
1005    }
1006    else
1007/*==================== print all option values =================*/
1008#ifndef NDEBUG
1009    if (strcmp(sys_cmd, "options") == 0)
1010    {
1011      void mainOptionValues();
1012      mainOptionValues();
1013      return FALSE;
1014    }
1015    else
1016#endif
1017/*==================== GF =================*/
1018#if 0
1019    if (strcmp(sys_cmd, "GF") == 0)
1020    {
1021      int c=rChar(currRing);
1022      setCharacteristic( c, 2);
1023      CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
1024      res->rtyp=POLY_CMD;
1025      res->data=convClapGFSingGF( F );
1026      return FALSE;
1027    }
1028    else
1029#endif
1030/*============================================================*/
1031      Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1032  }
1033  return TRUE;
1034}
1035#endif // HAVE_EXTENDED_SYSTEM
Note: See TracBrowser for help on using the repository browser.