source: git/Singular/extra.cc @ a5f15a

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