source: git/Singular/extra.cc @ 82dbf50

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