Context Navigation

source: git/Singular/extra.cc @ 73c6d21

spielwiese

Last change on this file since 73c6d21 was 73c6d21, checked in by Hans Schönemann <hannes@…>, 16 years ago
*hannes: HAVE_RATGRING git-svn-id: file:///usr/local/Singular/svn/trunk@10544 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 82.2 KB

Line
1	/*****************************************
2	* Computer Algebra System SINGULAR *
3	*****************************************/
4	/* $Id: extra.cc,v 1.262 2008-01-31 13:24:28 Singular Exp $ */
5	/*
6	* ABSTRACT: general interface to internals of Singular ("system" command)
7	*/
8
9	#define HAVE_WALK 1
10
11	#include <stdlib.h>
12	#include <stdio.h>
13	#include <string.h>
14	#include <ctype.h>
15	#include <signal.h>
16	#include "mod2.h"
17
18	#ifdef TIME_WITH_SYS_TIME
19	# include <time.h>
20	# ifdef HAVE_SYS_TIME_H
21	# include <sys/time.h>
22	# endif
23	#else
24	# ifdef HAVE_SYS_TIME_H
25	# include <sys/time.h>
26	# else
27	# include <time.h>
28	# endif
29	#endif
30	#ifdef HAVE_SYS_TIMES_H
31	#include <sys/times.h>
32	#endif
33
34	#include <unistd.h>
35
36	#include "tok.h"
37	#include "ipid.h"
38	#include "polys.h"
39	#include "lists.h"
40	#include "kutil.h"
41	#include "cntrlc.h"
42	#include "stairc.h"
43	#include "ipshell.h"
44	#include "modulop.h"
45	#include "febase.h"
46	#include "matpol.h"
47	#include "longalg.h"
48	#include "ideals.h"
49	#include "kstd1.h"
50	#include "syz.h"
51	#include "sdb.h"
52	#include "feOpt.h"
53	#include "distrib.h"
54	#include "prCopy.h"
55	#include "mpr_complex.h"
56
57	#ifdef HAVE_RINGS
58	#include "ringgb.h"
59	#endif
60
61	#ifdef HAVE_WALK
62	#include "walk.h"
63	#endif
64
65	#include "weight.h"
66	#include "fast_mult.h"
67	#include "digitech.h"
68
69	#ifdef HAVE_SPECTRUM
70	#include "spectrum.h"
71	#endif
72
73	#ifdef HAVE_BIFAC
74	#include <bifac.h>
75	#endif
76
77	#if defined(HPUX_10) \|\| defined(HPUX_9)
78	extern "C" int setenv(const char name, const char value, int overwrite);
79	#endif
80
81	#ifdef HAVE_PLURAL
82	#include "ring.h"
83	#include "gring.h"
84	#include "sca.h"
85	#include "ipconv.h"
86	#include "ratgring.h"
87	#endif
88
89	#ifdef ix86_Win /* only for the DLLTest */
90	/* #include "WinDllTest.h" */
91	#ifdef HAVE_DL
92	#include "mod_raw.h"
93	#endif
94	#endif
95
96	// for tests of t-rep-GB
97	#include "tgb.h"
98
99	// Define to enable many more system commands
100	#undef MAKE_DISTRIBUTION
101	#ifndef MAKE_DISTRIBUTION
102	#define HAVE_EXTENDED_SYSTEM 1
103	#endif
104
105	#ifdef HAVE_FACTORY
106	#define SI_DONT_HAVE_GLOBAL_VARS
107	#include "clapsing.h"
108	#include "clapconv.h"
109	#include "kstdfac.h"
110	#endif
111
112	#include "silink.h"
113	#include "walk.h"
114
115	#include "fast_maps.h"
116
117	#include "shiftgb.h"
118
119	#ifdef HAVE_EIGENVAL
120	#include "eigenval_ip.h"
121	#endif
122
123	#ifdef HAVE_GMS
124	#include "gms.h"
125	#endif
126
127	/*
128	* New function/system-calls that will be included as dynamic module
129	* should be inserted here.
130	* - without HAVE_DYNAMIC_LOADING: these functions comes as system("....");
131	* - with HAVE_DYNAMIC_LOADING: these functions are loaded as module.
132	*/
133	//#ifndef HAVE_DYNAMIC_LOADING
134
135	#ifdef HAVE_PCV
136	#include "pcv.h"
137	#endif
138
139	//#endif /* not HAVE_DYNAMIC_LOADING */
140
141	#ifdef ix86_Win
142	//#include <Python.h>
143	//#include <python_wrapper.h>
144	#endif
145
146
147	// see clapsing.cc for a description of the `FACTORY_*' options
148
149	#ifdef FACTORY_GCD_STAT
150	#include "gcd_stat.h"
151	#endif
152
153	#ifdef FACTORY_GCD_TIMING
154	#define TIMING
155	#include "timing.h"
156	TIMING_DEFINE_PRINTPROTO( contentTimer );
157	TIMING_DEFINE_PRINTPROTO( algContentTimer );
158	TIMING_DEFINE_PRINTPROTO( algLcmTimer );
159	#endif
160
161	void piShowProcList();
162	#ifndef MAKE_DISTRIBUTION
163	static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
164	#endif
165
166	extern BOOLEAN jjJanetBasis(leftv res, leftv v);
167
168	#ifdef ix86_Win /* PySingular initialized? */
169	static int PyInitialized = 0;
170	#endif
171
172	int singular_homog_flag=1;
173
174	//void emStart();
175	/*2
176	* the "system" command
177	*/
178	BOOLEAN jjSYSTEM(leftv res, leftv args)
179	{
180	if(args->Typ() == STRING_CMD)
181	{
182	const char sys_cmd=(char )(args->Data());
183	leftv h=args->next;
184	// ONLY documented system calls go here
185	// Undocumented system calls go down into #ifdef HAVE_EXTENDED_SYSTEM
186	/==================== nblocks ==================================/
187	if (strcmp(sys_cmd, "nblocks") == 0)
188	{
189	ring r;
190	if (h == NULL)
191	{
192	if (currRingHdl != NULL)
193	{
194	r = IDRING(currRingHdl);
195	}
196	else
197	{
198	WerrorS("no ring active");
199	return TRUE;
200	}
201	}
202	else
203	{
204	if (h->Typ() != RING_CMD)
205	{
206	WerrorS("ring expected");
207	return TRUE;
208	}
209	r = (ring) h->Data();
210	}
211	res->rtyp = INT_CMD;
212	res->data = (void*) (long)(rBlocks(r) - 1);
213	return FALSE;
214	}
215	/==================== version ==================================/
216	if(strcmp(sys_cmd,"version")==0)
217	{
218	res->rtyp=INT_CMD;
219	res->data=(void *)SINGULAR_VERSION;
220	return FALSE;
221	}
222	else
223	/==================== gen ==================================/
224	if(strcmp(sys_cmd,"gen")==0)
225	{
226	res->rtyp=INT_CMD;
227	res->data=(void *)(long)npGen;
228	return FALSE;
229	}
230	else
231	/==================== sh ==================================/
232	if(strcmp(sys_cmd,"sh")==0)
233	{
234	res->rtyp=INT_CMD;
235	if (h==NULL) res->data = (void *)(long) system("sh");
236	else if (h->Typ()==STRING_CMD)
237	res->data = (void)(long) system((char)(h->Data()));
238	else
239	WerrorS("string expected");
240	return FALSE;
241	}
242	else
243	/==================== uname ==================================/
244	if(strcmp(sys_cmd,"uname")==0)
245	{
246	res->rtyp=STRING_CMD;
247	res->data = omStrDup(S_UNAME);
248	return FALSE;
249	}
250	else
251	/==================== with ==================================/
252	if(strcmp(sys_cmd,"with")==0)
253	{
254	if (h==NULL)
255	{
256	res->rtyp=STRING_CMD;
257	res->data=(void *)omStrDup(versionString());
258	return FALSE;
259	}
260	else if (h->Typ()==STRING_CMD)
261	{
262	#define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
263	char s=(char )h->Data();
264	res->rtyp=INT_CMD;
265	#ifdef HAVE_DBM
266	TEST_FOR("DBM")
267	#endif
268	#ifdef HAVE_DLD
269	TEST_FOR("DLD")
270	#endif
271	#ifdef HAVE_FACTORY
272	TEST_FOR("factory")
273	#endif
274	#ifdef HAVE_LIBFAC_P
275	TEST_FOR("libfac")
276	#endif
277	#ifdef HAVE_MPSR
278	TEST_FOR("MP")
279	#endif
280	#ifdef HAVE_READLINE
281	TEST_FOR("readline")
282	#endif
283	#ifdef HAVE_TCL
284	TEST_FOR("tcl")
285	#endif
286	#ifdef TEST_MAC_ORDER
287	TEST_FOR("MAC_ORDER");
288	#endif
289	#ifdef HAVE_NS
290	TEST_FOR("Namespaces");
291	#endif
292	#ifdef HAVE_DYNAMIC_LOADING
293	TEST_FOR("DynamicLoading");
294	#endif
295	#ifdef HAVE_EIGENVAL
296	TEST_FOR("eigenval");
297	#endif
298	#ifdef HAVE_GMS
299	TEST_FOR("gms");
300	#endif
301	;
302	return FALSE;
303	#undef TEST_FOR
304	}
305	return TRUE;
306	}
307	else
308	/==================== browsers ==================================/
309	if (strcmp(sys_cmd,"browsers")==0)
310	{
311	res->rtyp = STRING_CMD;
312	char* b = StringSetS("");
313	feStringAppendBrowsers(0);
314	res->data = omStrDup(b);
315	return FALSE;
316	}
317	else
318	/==================== pid ==================================/
319	if (strcmp(sys_cmd,"pid")==0)
320	{
321	res->rtyp=INT_CMD;
322	res->data=(void *)(long) getpid();
323	return FALSE;
324	}
325	else
326	/==================== getenv ==================================/
327	if (strcmp(sys_cmd,"getenv")==0)
328	{
329	if ((h!=NULL) && (h->Typ()==STRING_CMD))
330	{
331	res->rtyp=STRING_CMD;
332	char r=getenv((char )h->Data());
333	if (r==NULL) r="";
334	res->data=(void *)omStrDup(r);
335	return FALSE;
336	}
337	else
338	{
339	WerrorS("string expected");
340	return TRUE;
341	}
342	}
343	else
344	/==================== setenv ==================================/
345	if (strcmp(sys_cmd,"setenv")==0)
346	{
347	#ifdef HAVE_SETENV
348	if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL &&
349	h->next != NULL && h->next->Typ() == STRING_CMD
350	&& h->next->Data() != NULL)
351	{
352	res->rtyp=STRING_CMD;
353	setenv((char )h->Data(), (char )h->next->Data(), 1);
354	res->data=(void )omStrDup((char )h->next->Data());
355	feReInitResources();
356	return FALSE;
357	}
358	else
359	{
360	WerrorS("two strings expected");
361	return TRUE;
362	}
363	#else
364	WerrorS("setenv not supported on this platform");
365	return TRUE;
366	#endif
367	}
368	else
369	/==================== Singular ==================================/
370	if (strcmp(sys_cmd, "Singular") == 0)
371	{
372	res->rtyp=STRING_CMD;
373	char *r=feResource("Singular");
374	if (r == NULL) r="";
375	res->data = (void*) omStrDup( r );
376	return FALSE;
377	}
378	else
379	if (strcmp(sys_cmd, "SingularLib") == 0)
380	{
381	res->rtyp=STRING_CMD;
382	char *r=feResource("SearchPath");
383	if (r == NULL) r="";
384	res->data = (void*) omStrDup( r );
385	return FALSE;
386	}
387	else
388	/==================== options ==================================/
389	if (strstr(sys_cmd, "--") == sys_cmd)
390	{
391	if (strcmp(sys_cmd, "--") == 0)
392	{
393	fePrintOptValues();
394	return FALSE;
395	}
396
397	feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
398	if (opt == FE_OPT_UNDEF)
399	{
400	Werror("Unknown option %s", sys_cmd);
401	Werror("Use 'system(\"--\");' for listing of available options");
402	return TRUE;
403	}
404
405	// for Untyped Options (help version),
406	// setting it just triggers action
407	if (feOptSpec[opt].type == feOptUntyped)
408	{
409	feSetOptValue(opt,0);
410	return FALSE;
411	}
412
413	if (h == NULL)
414	{
415	if (feOptSpec[opt].type == feOptString)
416	{
417	res->rtyp = STRING_CMD;
418	char r=(char)feOptSpec[opt].value;
419	if (r == NULL) r="";
420	res->data = omStrDup(r);
421	}
422	else
423	{
424	res->rtyp = INT_CMD;
425	res->data = feOptSpec[opt].value;
426	}
427	return FALSE;
428	}
429
430	if (h->Typ() != STRING_CMD &&
431	h->Typ() != INT_CMD)
432	{
433	Werror("Need string or int argument to set option value");
434	return TRUE;
435	}
436	char* errormsg;
437	if (h->Typ() == INT_CMD)
438	{
439	if (feOptSpec[opt].type == feOptString)
440	{
441	Werror("Need string argument to set value of option %s", sys_cmd);
442	return TRUE;
443	}
444	errormsg = feSetOptValue(opt, (int)((long) h->Data()));
445	if (errormsg != NULL)
446	Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
447	}
448	else
449	{
450	errormsg = feSetOptValue(opt, (char*) h->Data());
451	if (errormsg != NULL)
452	Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
453	}
454	if (errormsg != NULL) return TRUE;
455	return FALSE;
456	}
457	else
458	/==================== HC ==================================/
459	if (strcmp(sys_cmd,"HC")==0)
460	{
461	res->rtyp=INT_CMD;
462	res->data=(void *)(long) HCord;
463	return FALSE;
464	}
465	else
466	/==================== random ==================================/
467	if(strcmp(sys_cmd,"random")==0)
468	{
469	if ((h!=NULL) &&(h->Typ()==INT_CMD))
470	{
471	siRandomStart=(int)((long)h->Data());
472	#ifdef buildin_rand
473	siSeed=siRandomStart;
474	#else
475	srand((unsigned int)siRandomStart);
476	#endif
477	#ifdef HAVE_FACTORY
478	factoryseed(siRandomStart);
479	#endif
480	return FALSE;
481	}
482	else if (h != NULL)
483	{
484	WerrorS("int expected");
485	return TRUE;
486	}
487	res->rtyp=INT_CMD;
488	res->data=(void*)(long) siRandomStart;
489	return FALSE;
490	}
491	/==================== complexNearZero ======================/
492	if(strcmp(sys_cmd,"complexNearZero")==0)
493	{
494	if (h->Typ()==NUMBER_CMD )
495	{
496	if ( h->next!=NULL && h->next->Typ()==INT_CMD )
497	{
498	if ( !rField_is_long_C() )
499	{
500	Werror( "unsupported ground field!");
501	return TRUE;
502	}
503	else
504	{
505	res->rtyp=INT_CMD;
506	res->data=(void)complexNearZero((gmp_complex)h->Data(),
507	(int)((long)(h->next->Data())));
508	return FALSE;
509	}
510	}
511	else
512	{
513	Werror( "expected <int> as third parameter!");
514	return TRUE;
515	}
516	}
517	else
518	{
519	Werror( "expected <number> as second parameter!");
520	return TRUE;
521	}
522	}
523	/==================== getPrecDigits ======================/
524	if(strcmp(sys_cmd,"getPrecDigits")==0)
525	{
526	if ( !rField_is_long_C() && !rField_is_long_R() )
527	{
528	Werror( "unsupported ground field!");
529	return TRUE;
530	}
531	res->rtyp=INT_CMD;
532	res->data=(void*)getGMPFloatDigits();
533	return FALSE;
534	}
535	/==================== neworder =============================/
536	// should go below
537	#ifdef HAVE_LIBFAC_P
538	if(strcmp(sys_cmd,"neworder")==0)
539	{
540	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
541	{
542	res->rtyp=STRING_CMD;
543	res->data=(void *)singclap_neworder((ideal)h->Data());
544	return FALSE;
545	}
546	else
547	WerrorS("ideal expected");
548	}
549	else
550	#endif
551	//#ifndef HAVE_DYNAMIC_LOADING
552	/==================== pcv ==================================/
553	#ifdef HAVE_PCV
554	if(strcmp(sys_cmd,"pcvLAddL")==0)
555	{
556	return pcvLAddL(res,h);
557	}
558	else
559	if(strcmp(sys_cmd,"pcvPMulL")==0)
560	{
561	return pcvPMulL(res,h);
562	}
563	else
564	if(strcmp(sys_cmd,"pcvMinDeg")==0)
565	{
566	return pcvMinDeg(res,h);
567	}
568	else
569	if(strcmp(sys_cmd,"pcvP2CV")==0)
570	{
571	return pcvP2CV(res,h);
572	}
573	else
574	if(strcmp(sys_cmd,"pcvCV2P")==0)
575	{
576	return pcvCV2P(res,h);
577	}
578	else
579	if(strcmp(sys_cmd,"pcvDim")==0)
580	{
581	return pcvDim(res,h);
582	}
583	else
584	if(strcmp(sys_cmd,"pcvBasis")==0)
585	{
586	return pcvBasis(res,h);
587	}
588	else
589	#endif
590	/==================== eigenvalues ==================================/
591	#ifdef HAVE_EIGENVAL
592	if(strcmp(sys_cmd,"hessenberg")==0)
593	{
594	return evHessenberg(res,h);
595	}
596	else
597	if(strcmp(sys_cmd,"eigenvals")==0)
598	{
599	return evEigenvals(res,h);
600	}
601	else
602	#endif
603	/==================== Gauss-Manin system ==================================/
604	#ifdef HAVE_GMS
605	if(strcmp(sys_cmd,"gmsnf")==0)
606	{
607	return gmsNF(res,h);
608	}
609	else
610	#endif
611	//#endif /* HAVE_DYNAMIC_LOADING */
612	/==================== contributors =============================/
613	if(strcmp(sys_cmd,"contributors") == 0)
614	{
615	res->rtyp=STRING_CMD;
616	res->data=(void *)omStrDup(
617	"Olaf Bachmann, Michael Brickenstein, Hubert Grassmann, Kai Krueger, Victor Levandovskyy, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Mathias Schulze, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
618	return FALSE;
619	}
620	else
621	/==================== spectrum =============================/
622	#ifdef HAVE_SPECTRUM
623	if(strcmp(sys_cmd,"spectrum") == 0)
624	{
625	if (h->Typ()!=POLY_CMD)
626	{
627	WerrorS("poly expected");
628	return TRUE;
629	}
630	if (h->next==NULL)
631	return spectrumProc(res,h);
632	if (h->next->Typ()!=INT_CMD)
633	{
634	WerrorS("poly,int expected");
635	return TRUE;
636	}
637	if(((long)h->next->Data())==1L)
638	return spectrumfProc(res,h);
639	return spectrumProc(res,h);
640	}
641	else
642	/==================== semic =============================/
643	if(strcmp(sys_cmd,"semic") == 0)
644	{
645	if ((h->next!=NULL)
646	&& (h->Typ()==LIST_CMD)
647	&& (h->next->Typ()==LIST_CMD))
648	{
649	if (h->next->next==NULL)
650	return semicProc(res,h,h->next);
651	else if (h->next->next->Typ()==INT_CMD)
652	return semicProc3(res,h,h->next,h->next->next);
653	}
654	return TRUE;
655	}
656	else
657	/==================== spadd =============================/
658	if(strcmp(sys_cmd,"spadd") == 0)
659	{
660	if ((h->next!=NULL)
661	&& (h->Typ()==LIST_CMD)
662	&& (h->next->Typ()==LIST_CMD))
663	{
664	if (h->next->next==NULL)
665	return spaddProc(res,h,h->next);
666	}
667	return TRUE;
668	}
669	else
670	/==================== spmul =============================/
671	if(strcmp(sys_cmd,"spmul") == 0)
672	{
673	if ((h->next!=NULL)
674	&& (h->Typ()==LIST_CMD)
675	&& (h->next->Typ()==INT_CMD))
676	{
677	if (h->next->next==NULL)
678	return spmulProc(res,h,h->next);
679	}
680	return TRUE;
681	}
682	else
683	#endif
684	#ifdef HAVE_PLURAL
685	/==================== Approx_Step =================/
686	if (strcmp(sys_cmd, "astep") == 0)
687	{
688	ideal I;
689	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
690	{
691	I=(ideal)h->CopyD();
692	res->rtyp=IDEAL_CMD;
693	if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
694	else res->data=I;
695	setFlag(res,FLAG_STD);
696	}
697	else return TRUE;
698	return FALSE;
699	}
700	/==================== PrintMat =================/
701	if (strcmp(sys_cmd, "PrintMat") == 0)
702	{
703	int a;
704	int b;
705	ring r;
706	int metric;
707	if ((h!=NULL) && (h->Typ()==INT_CMD))
708	{
709	a=(int)((long)(h->Data()));
710	h=h->next;
711	}
712	else return TRUE;
713	if ((h!=NULL) && (h->Typ()==INT_CMD))
714	{
715	b=(int)((long)(h->Data()));
716	h=h->next;
717	}
718	else return TRUE;
719	if ((h!=NULL) && (h->Typ()==RING_CMD))
720	{
721	r=(ring)h->Data();
722	h=h->next;
723	}
724	else return TRUE;
725	if ((h!=NULL) && (h->Typ()==INT_CMD))
726	{
727	metric=(int)((long)(h->Data()));
728	}
729	res->rtyp=MATRIX_CMD;
730	if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
731	else res->data=NULL;
732	return FALSE;
733	}
734	/==================== twostd =================/
735	if (strcmp(sys_cmd, "twostd") == 0)
736	{
737	ideal I;
738	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
739	{
740	I=(ideal)h->CopyD();
741	res->rtyp=IDEAL_CMD;
742	if (rIsPluralRing(currRing)) res->data=twostd(I);
743	else res->data=I;
744	setFlag(res,FLAG_TWOSTD);
745	setFlag(res,FLAG_STD);
746	}
747	else return TRUE;
748	return FALSE;
749	}
750	/==================== lie bracket =================/
751	if (strcmp(sys_cmd, "bracket") == 0)
752	{
753	poly p;
754	poly q;
755	if ((h!=NULL) && (h->Typ()==POLY_CMD))
756	{
757	p=(poly)h->CopyD();
758	h=h->next;
759	}
760	else return TRUE;
761	if ((h!=NULL) && (h->Typ()==POLY_CMD))
762	{
763	q=(poly)h->Data();
764	}
765	else return TRUE;
766	res->rtyp=POLY_CMD;
767	if (rIsPluralRing(currRing)) res->data=nc_p_Bracket_qq(p,q);
768	else res->data=NULL;
769	return FALSE;
770	}
771	/==================== PLURAL =================/
772	#if 0
773	if (strcmp(sys_cmd, "PLURAL") == 0)
774	{
775	matrix C;
776	matrix D;
777	number nN;
778	poly pN;
779	int i,j;
780	sleftv tmp_v;
781	memset(&tmp_v,0,sizeof(tmp_v));
782
783	if (currRing->nc==NULL)
784	{
785	currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
786	currRing->nc->ref=1;
787	currRing->nc->basering=currRing;
788	}
789	else
790	{
791	WarnS("redefining algebra structure");
792	if (currRing->nc->ref>1) // in use by somebody else
793	currRing->nc->ref--;
794	else
795	ncKill(currRing); /* kill the previous nc data */
796	currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
797	currRing->nc->ref=1;
798	currRing->nc->basering=currRing;
799	}
800	currRing->nc->type=nc_general;
801	/* C is either a poly (coeff - an int or a number) or a matrix */
802	if (h==NULL) return TRUE;
803	leftv hh=h->next;
804	h->next=NULL;
805	switch(h->Typ())
806	{
807	case MATRIX_CMD: { C=(matrix)h->CopyD(); break; }
808
809	case INT_CMD: case NUMBER_CMD:
810	{
811	i=iiTestConvert(h->Typ(), POLY_CMD);
812	if (i==0)
813	{
814	Werror("cannot convert to poly");
815	return TRUE;
816	}
817	iiConvert(h->Typ(), POLY_CMD, i, h, &tmp_v);
818	pN=(poly)tmp_v.Data();
819	break;
820	}
821
822	case POLY_CMD: {pN=(poly)h->Data(); break;}
823
824	default: return TRUE;
825	}
826	if (h->Typ()==MATRIX_CMD)
827	{
828	currRing->nc->type=nc_undef; /* to analyze later ! */
829	// currRing->nc->IsSkewConstant=NULL;
830	}
831	else
832	{
833	nN=pGetCoeff(pN); // pN is not NULL anyway
834	if (nIsZero(nN))
835	{
836	Werror("zero coefficients are not allowed");
837	return TRUE;
838	}
839	if (nIsOne(nN)) currRing->nc->type=nc_lie;
840	else currRing->nc->type=nc_skew;
841	currRing->nc->IsSkewConstant=1;
842	/* create matrix C */
843	C=mpNew(currRing->N,currRing->N);
844	for(i=1;i<currRing->N;i++)
845	{
846	for(j=i+1;j<=currRing->N;j++)
847	{
848	MATELEM(C,i,j) = nc_p_CopyPut(pN,currRing);
849	// MATELEM(C,i,j)=pCopy(pN);
850	}
851	}
852	}
853	pN=NULL;
854	h=hh;
855	/* D is either a poly or a matrix */
856	if (h==NULL) { pN=NULL;} /* D is zero matrix */
857	else
858	{
859	switch(h->Typ())
860	{
861	case MATRIX_CMD: { D=(matrix)h->CopyD(); break;}
862
863	case INT_CMD: case NUMBER_CMD:
864	{
865	i=iiTestConvert(h->Typ(), POLY_CMD);
866	if (i==0)
867	{
868	Werror("cannot convert to poly");
869	return TRUE;
870	}
871	iiConvert(h->Typ(), POLY_CMD, i, h, &tmp_v);
872	pN=(poly)tmp_v.Data();
873	break;
874	}
875
876	case POLY_CMD: { pN=(poly)h->Data();break;}
877
878	default: return TRUE;
879	}
880	} /* end else h==NULL */
881	if (pN==NULL)
882	{
883	if (currRing->nc->type==nc_lie)
884	{
885	currRing->nc->type=nc_skew; /* even commutative! */
886	}
887	}
888	else
889	{
890	if (currRing->nc->type==nc_skew) currRing->nc->type=nc_general;
891	} /* end pN==NULL */
892	if (h==NULL)
893	{
894	WerrorS("expected `system(\"PLURAL\",<matrix>,<matrix>)`");
895	idDelete((ideal *)&(currRing->nc->C));
896	omFreeSize((ADDRESS)currRing->nc,sizeof(nc_struct));
897	currRing->nc=NULL;
898	return TRUE;
899	}
900	if (h->Typ()!=MATRIX_CMD)
901	{
902	D=mpNew(currRing->N,currRing->N);
903	/* create matrix D */
904	for(i=1;i<currRing->N;i++)
905	{
906	for(j=i+1;j<=currRing->N;j++)
907	{
908	MATELEM(D,i,j) = nc_p_CopyPut(pN,currRing);
909	// MATELEM(D,i,j)=pCopy(pN);
910	}
911	}
912	}
913	else currRing->nc->type=nc_undef;
914	tmp_v.CleanUp();
915	pN=NULL;
916	/* Now we proceed with C and D */
917	matrix COM;
918	currRing->nc->MT=(matrix )omAlloc0(currRing->N(currRing->N-1)/2*sizeof(matrix));
919	currRing->nc->MTsize=(int )omAlloc0(currRing->N(currRing->N-1)/2*sizeof(int));
920	currRing->nc->C=C;
921	currRing->nc->D=D;
922	COM=mpCopy(currRing->nc->C);
923	poly p;
924	short DefMTsize=7;
925	int tmpIsSkewConstant=1;
926	int IsNonComm=0;
927	pN=nc_p_CopyGet(MATELEM(currRing->nc->C,1,2),currRing);
928	// pN=MATELEM(currRing->nc->C,1,2);
929
930	for(i=1;i<currRing->N;i++)
931	{
932	for(j=i+1;j<=currRing->N;j++)
933	{
934	if (MATELEM(currRing->nc->C,i,j)==NULL)
935	{
936	Werror("Incorrect input : matrix of coefficients contains zeros in the upper triangle!");
937	return TRUE;
938	}
939	if (!nEqual(pGetCoeff(pN),pGetCoeff(MATELEM(currRing->nc->C,i,j)))) tmpIsSkewConstant=0;
940	if (MATELEM(currRing->nc->D,i,j)==NULL) /* quasicommutative case */
941	{
942	currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=1;
943	/* 1x1 mult.matrix */
944	currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(1,1);
945	}
946	else /* pure noncommutative case*/
947	{
948	IsNonComm=1;
949	MATELEM(COM,i,j)=NULL;
950	currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=DefMTsize; /* default sizes */
951	currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(DefMTsize,DefMTsize);
952	}
953	p=pOne();
954	pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
955	pSetExp(p,i,1);
956	pSetExp(p,j,1);
957	pSetm(p);
958	// p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
959	p=pAdd(p,nc_p_CopyGet(MATELEM(currRing->nc->D,i,j),currRing));
960	// MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=p;
961	MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=nc_p_CopyPut(p,currRing);
962	pDelete(&p);
963	p=NULL;
964	}
965	/* set MT[i,j,1,1] to c_i_jx_ix_j + D_i_j */
966	}
967	if (currRing->nc->type==nc_undef)
968	{
969	if (IsNonComm==1)
970	{
971	assume(pN!=NULL);
972	if ((tmpIsSkewConstant==1) && (nIsOne(pGetCoeff(pN)))) currRing->nc->type=nc_lie;
973	else currRing->nc->type=nc_general;
974	}
975	if (IsNonComm==0)
976	{
977	currRing->nc->type=nc_skew; /* could be also commutative */
978	currRing->nc->IsSkewConstant=tmpIsSkewConstant;
979	}
980	}
981	currRing->nc->COM=COM;
982	return FALSE;
983	}
984	else
985	#endif
986	/==================== opp ==================================/
987	if (strcmp(sys_cmd, "opp")==0)
988	{
989	if ((h!=NULL) && (h->Typ()==RING_CMD))
990	{
991	ring r=(ring)h->Data();
992	res->data=rOpposite(r);
993	res->rtyp=RING_CMD;
994	return FALSE;
995	}
996	else
997	{
998	WerrorS("`system(\"opp\",<ring>)` expected");
999	return TRUE;
1000	}
1001	}
1002	else
1003	/==================== env ==================================/
1004	if (strcmp(sys_cmd, "env")==0)
1005	{
1006	if ((h!=NULL) && (h->Typ()==RING_CMD))
1007	{
1008	ring r = (ring)h->Data();
1009	res->data = rEnvelope(r);
1010	res->rtyp = RING_CMD;
1011	return FALSE;
1012	}
1013	else
1014	{
1015	WerrorS("`system(\"env\",<ring>)` expected");
1016	return TRUE;
1017	}
1018	}
1019	else
1020	/==================== oppose ==================================/
1021	if (strcmp(sys_cmd, "oppose")==0)
1022	{
1023	ring Rop;
1024	if ((h!=NULL) && (h->Typ()==RING_CMD))
1025	{
1026	Rop = (ring)h->Data();
1027	h = h->next;
1028	}
1029	if ((h!=NULL))
1030	{
1031	idhdl w;
1032	if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1033	{
1034	poly p = (poly)IDDATA(w);
1035	res->data = pOppose(Rop,p);
1036	res->rtyp = POLY_CMD;
1037	return FALSE;
1038	}
1039	}
1040	else
1041	{
1042	WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1043	return TRUE;
1044	}
1045	}
1046	else
1047	#endif
1048	#ifdef HAVE_WALK
1049	/==================== walk stuff =================/
1050	#ifdef OWNW
1051	if (strcmp(sys_cmd, "walkNextWeight") == 0)
1052	{
1053	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1054	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1055	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1056	{
1057	Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1058	return TRUE;
1059	}
1060
1061	if (((intvec*) h->Data())->length() != currRing->N \|\|
1062	((intvec*) h->next->Data())->length() != currRing->N)
1063	{
1064	Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1065	currRing->N);
1066	return TRUE;
1067	}
1068	res->data = (void) walkNextWeight(((intvec) h->Data()),
1069	((intvec*) h->next->Data()),
1070	(ideal) h->next->next->Data());
1071	if (res->data == (void) 0 \|\| res->data == (void) 1)
1072	{
1073	res->rtyp = INT_CMD;
1074	}
1075	else
1076	{
1077	res->rtyp = INTVEC_CMD;
1078	}
1079	return FALSE;
1080	}
1081	else if (strcmp(sys_cmd, "walkInitials") == 0)
1082	{
1083	if (h == NULL \|\| h->Typ() != IDEAL_CMD)
1084	{
1085	WerrorS("system(\"walkInitials\", ideal) expected");
1086	return TRUE;
1087	}
1088
1089	res->data = (void*) walkInitials((ideal) h->Data());
1090	res->rtyp = IDEAL_CMD;
1091	return FALSE;
1092	}
1093	else
1094	#endif
1095	#ifdef WAIV
1096	if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1097	{
1098	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1099	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD)
1100	{
1101	WerrorS("system(\"walkAddIntVec\", intvec, intvec) expected");
1102	return TRUE;
1103	}
1104	intvec* arg1 = (intvec*) h->Data();
1105	intvec* arg2 = (intvec*) h->next->Data();
1106
1107
1108	res->data = (intvec*) walkAddIntVec(arg1, arg2);
1109	res->rtyp = INTVEC_CMD;
1110	return FALSE;
1111	}
1112	else
1113	#endif
1114	#ifdef MwaklNextWeight
1115	if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1116	{
1117	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1118	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1119	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1120	{
1121	Werror("system(\"MwalkNextWeight\", intvec, intvec, ideal) expected");
1122	return TRUE;
1123	}
1124
1125	if (((intvec*) h->Data())->length() != currRing->N \|\|
1126	((intvec*) h->next->Data())->length() != currRing->N)
1127	{
1128	Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1129	currRing->N);
1130	return TRUE;
1131	}
1132	intvec* arg1 = (intvec*) h->Data();
1133	intvec* arg2 = (intvec*) h->next->Data();
1134	ideal arg3 = (ideal) h->next->next->Data();
1135
1136	intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1137
1138	res->rtyp = INTVEC_CMD;
1139	res->data = result;
1140
1141	return FALSE;
1142	}
1143	else
1144	#endif //MWalkNextWeight
1145	if(strcmp(sys_cmd, "Mivdp") == 0)
1146	{
1147	if (h == NULL \|\| h->Typ() != INT_CMD)
1148	{
1149	Werror("system(\"Mivdp\", int) expected");
1150	return TRUE;
1151	}
1152	if ((int) ((long)(h->Data())) != currRing->N)
1153	{
1154	Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1155	currRing->N);
1156	return TRUE;
1157	}
1158	int arg1 = (int) ((long)(h->Data()));
1159
1160	intvec* result = (intvec*) Mivdp(arg1);
1161
1162	res->rtyp = INTVEC_CMD;
1163	res->data = result;
1164
1165	return FALSE;
1166	}
1167
1168	else if(strcmp(sys_cmd, "Mivlp") == 0)
1169	{
1170	if (h == NULL \|\| h->Typ() != INT_CMD)
1171	{
1172	Werror("system(\"Mivlp\", int) expected");
1173	return TRUE;
1174	}
1175	if ((int) ((long)(h->Data())) != currRing->N)
1176	{
1177	Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1178	currRing->N);
1179	return TRUE;
1180	}
1181	int arg1 = (int) ((long)(h->Data()));
1182
1183	intvec* result = (intvec*) Mivlp(arg1);
1184
1185	res->rtyp = INTVEC_CMD;
1186	res->data = result;
1187
1188	return FALSE;
1189	}
1190	else
1191	#ifdef MpDiv
1192	if(strcmp(sys_cmd, "MpDiv") == 0)
1193	{
1194	if(h==NULL \|\| h->Typ() != POLY_CMD \|\|
1195	h->next == NULL \|\| h->next->Typ() != POLY_CMD)
1196	{
1197	Werror("system(\"MpDiv\",poly, poly) expected");
1198	return TRUE;
1199	}
1200	poly arg1 = (poly) h->Data();
1201	poly arg2 = (poly) h->next->Data();
1202
1203	poly result = MpDiv(arg1, arg2);
1204
1205	res->rtyp = POLY_CMD;
1206	res->data = result;
1207	return FALSE;
1208	}
1209	else
1210	#endif
1211	#ifdef MpMult
1212	if(strcmp(sys_cmd, "MpMult") == 0)
1213	{
1214	if(h==NULL \|\| h->Typ() != POLY_CMD \|\|
1215	h->next == NULL \|\| h->next->Typ() != POLY_CMD)
1216	{
1217	Werror("system(\"MpMult\",poly, poly) expected");
1218	return TRUE;
1219	}
1220	poly arg1 = (poly) h->Data();
1221	poly arg2 = (poly) h->next->Data();
1222
1223	poly result = MpMult(arg1, arg2);
1224	res->rtyp = POLY_CMD;
1225	res->data = result;
1226	return FALSE;
1227	}
1228	else
1229	#endif
1230	if (strcmp(sys_cmd, "MivSame") == 0)
1231	{
1232	if(h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1233	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD )
1234	{
1235	Werror("system(\"MivSame\", intvec, intvec) expected");
1236	return TRUE;
1237	}
1238	/*
1239	if (((intvec*) h->Data())->length() != currRing->N \|\|
1240	((intvec*) h->next->Data())->length() != currRing->N)
1241	{
1242	Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1243	currRing->N);
1244	return TRUE;
1245	}
1246	*/
1247	intvec* arg1 = (intvec*) h->Data();
1248	intvec* arg2 = (intvec*) h->next->Data();
1249	/*
1250	poly result = (poly) MivSame(arg1, arg2);
1251
1252	res->rtyp = POLY_CMD;
1253	res->data = (poly) result;
1254	*/
1255	res->rtyp = INT_CMD;
1256	res->data = (void*)(long) MivSame(arg1, arg2);
1257	return FALSE;
1258	}
1259	else
1260	if (strcmp(sys_cmd, "M3ivSame") == 0)
1261	{
1262	if(h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1263	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1264	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD )
1265	{
1266	Werror("system(\"M3ivSame\", intvec, intvec, intvec) expected");
1267	return TRUE;
1268	}
1269	/*
1270	if (((intvec*) h->Data())->length() != currRing->N \|\|
1271	((intvec*) h->next->Data())->length() != currRing->N \|\|
1272	((intvec*) h->next->next->Data())->length() != currRing->N )
1273	{
1274	Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1275	currRing->N);
1276	return TRUE;
1277	}
1278	*/
1279	intvec* arg1 = (intvec*) h->Data();
1280	intvec* arg2 = (intvec*) h->next->Data();
1281	intvec* arg3 = (intvec*) h->next->next->Data();
1282	/*
1283	poly result = (poly) M3ivSame(arg1, arg2, arg3);
1284
1285	res->rtyp = POLY_CMD;
1286	res->data = (poly) result;
1287	*/
1288	res->rtyp = INT_CMD;
1289	res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1290	return FALSE;
1291	}
1292	else
1293	if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1294	{
1295	if(h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1296	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD)
1297	{
1298	Werror("system(\"MwalkInitialForm\", ideal, intvec) expected");
1299	return TRUE;
1300	}
1301	if(((intvec*) h->next->Data())->length() != currRing->N)
1302	{
1303	Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1304	currRing->N);
1305	return TRUE;
1306	}
1307	ideal id = (ideal) h->Data();
1308	intvec* int_w = (intvec*) h->next->Data();
1309	ideal result = (ideal) MwalkInitialForm(id, int_w);
1310
1311	res->rtyp = IDEAL_CMD;
1312	res->data = result;
1313	return FALSE;
1314	}
1315	else
1316	/************ Perturbation walk ********/
1317	if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1318	{
1319	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1320	{
1321	Werror("system(\"MivMatrixOrder\",intvec) expected");
1322	return TRUE;
1323	}
1324	intvec* arg1 = (intvec*) h->Data();
1325
1326	intvec* result = MivMatrixOrder(arg1);
1327
1328	res->rtyp = INTVEC_CMD;
1329	res->data = result;
1330	return FALSE;
1331	}
1332	else
1333	if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1334	{
1335	if(h==NULL \|\| h->Typ() != INT_CMD)
1336	{
1337	Werror("system(\"MivMatrixOrderdp\",intvec) expected");
1338	return TRUE;
1339	}
1340	int arg1 = (int) ((long)(h->Data()));
1341
1342	intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1343
1344	res->rtyp = INTVEC_CMD;
1345	res->data = result;
1346	return FALSE;
1347	}
1348	else
1349	if(strcmp(sys_cmd, "MPertVectors") == 0)
1350	{
1351
1352	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1353	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1354	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1355	{
1356	Werror("system(\"MPertVectors\",ideal, intvec, int) expected");
1357	return TRUE;
1358	}
1359
1360	ideal arg1 = (ideal) h->Data();
1361	intvec* arg2 = (intvec*) h->next->Data();
1362	int arg3 = (int) ((long)(h->next->next->Data()));
1363
1364	intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1365
1366	res->rtyp = INTVEC_CMD;
1367	res->data = result;
1368	return FALSE;
1369	}
1370	else
1371	if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1372	{
1373
1374	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1375	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1376	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1377	{
1378	Werror("system(\"MPertVectorslp\",ideal, intvec, int) expected");
1379	return TRUE;
1380	}
1381
1382	ideal arg1 = (ideal) h->Data();
1383	intvec* arg2 = (intvec*) h->next->Data();
1384	int arg3 = (int) ((long)(h->next->next->Data()));
1385
1386	intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1387
1388	res->rtyp = INTVEC_CMD;
1389	res->data = result;
1390	return FALSE;
1391	}
1392	/************ fractal walk ********/
1393	else
1394	if(strcmp(sys_cmd, "Mfpertvector") == 0)
1395	{
1396	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1397	h->next==NULL \|\| h->next->Typ() != INTVEC_CMD )
1398	{
1399	Werror("system(\"Mfpertvector\", ideal,intvec) expected");
1400	return TRUE;
1401	}
1402	ideal arg1 = (ideal) h->Data();
1403	intvec* arg2 = (intvec*) h->next->Data();
1404	intvec* result = Mfpertvector(arg1, arg2);
1405
1406	res->rtyp = INTVEC_CMD;
1407	res->data = result;
1408	return FALSE;
1409	}
1410	else
1411	if(strcmp(sys_cmd, "MivUnit") == 0)
1412	{
1413	int arg1 = (int) ((long)(h->Data()));
1414
1415	intvec* result = (intvec*) MivUnit(arg1);
1416
1417	res->rtyp = INTVEC_CMD;
1418	res->data = result;
1419	return FALSE;
1420	}
1421	else
1422	if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1423	{
1424	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1425	{
1426	Werror("system(\"MivWeightOrderlp\",intvec) expected");
1427	return TRUE;
1428	}
1429	intvec* arg1 = (intvec*) h->Data();
1430	intvec* result = MivWeightOrderlp(arg1);
1431
1432	res->rtyp = INTVEC_CMD;
1433	res->data = result;
1434	return FALSE;
1435	}
1436	else
1437	if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1438	{
1439	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1440	{
1441	Werror("system(\"MivWeightOrderdp\",intvec) expected");
1442	return TRUE;
1443	}
1444	intvec* arg1 = (intvec*) h->Data();
1445	//int arg2 = (int) h->next->Data();
1446
1447	intvec* result = MivWeightOrderdp(arg1);
1448
1449	res->rtyp = INTVEC_CMD;
1450	res->data = result;
1451	return FALSE;
1452	}
1453	else
1454	if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1455	{
1456	if(h==NULL \|\| h->Typ() != INT_CMD)
1457	{
1458	Werror("system(\"MivMatrixOrderlp\",int) expected");
1459	return TRUE;
1460	}
1461	int arg1 = (int) ((long)(h->Data()));
1462
1463	intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1464
1465	res->rtyp = INTVEC_CMD;
1466	res->data = result;
1467	return FALSE;
1468	}
1469	else
1470	if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1471	{
1472	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1473	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1474	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1475	{
1476	Werror("system(\"MkInterRedNextWeight\", intvec, intvec, ideal) expected");
1477	return TRUE;
1478	}
1479
1480	if (((intvec*) h->Data())->length() != currRing->N \|\|
1481	((intvec*) h->next->Data())->length() != currRing->N)
1482	{
1483	Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1484	currRing->N);
1485	return TRUE;
1486	}
1487	intvec* arg1 = (intvec*) h->Data();
1488	intvec* arg2 = (intvec*) h->next->Data();
1489	ideal arg3 = (ideal) h->next->next->Data();
1490
1491	intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1492
1493	res->rtyp = INTVEC_CMD;
1494	res->data = result;
1495
1496	return FALSE;
1497	}
1498	else
1499	#ifdef MPertNextWeight
1500	if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1501	{
1502	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1503	h->next == NULL \|\| h->next->Typ() != IDEAL_CMD \|\|
1504	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1505	{
1506	Werror("system(\"MPertNextWeight\", intvec, ideal, int) expected");
1507	return TRUE;
1508	}
1509
1510	if (((intvec*) h->Data())->length() != currRing->N)
1511	{
1512	Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1513	currRing->N);
1514	return TRUE;
1515	}
1516	intvec* arg1 = (intvec*) h->Data();
1517	ideal arg2 = (ideal) h->next->Data();
1518	int arg3 = (int) h->next->next->Data();
1519
1520	intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1521
1522	res->rtyp = INTVEC_CMD;
1523	res->data = result;
1524
1525	return FALSE;
1526	}
1527	else
1528	#endif //MPertNextWeight
1529	#ifdef Mivperttarget
1530	if (strcmp(sys_cmd, "Mivperttarget") == 0)
1531	{
1532	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1533	h->next == NULL \|\| h->next->Typ() != INT_CMD )
1534	{
1535	Werror("system(\"Mivperttarget\", ideal, int) expected");
1536	return TRUE;
1537	}
1538
1539	ideal arg1 = (ideal) h->Data();
1540	int arg2 = (int) h->next->Data();
1541
1542	intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1543
1544	res->rtyp = INTVEC_CMD;
1545	res->data = result;
1546
1547	return FALSE;
1548	}
1549	else
1550	#endif //Mivperttarget
1551	if (strcmp(sys_cmd, "Mwalk") == 0)
1552	{
1553	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1554	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1555	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1556	{
1557	Werror("system(\"Mwalk\", ideal, intvec, intvec) expected");
1558	return TRUE;
1559	}
1560
1561	if (((intvec*) h->next->Data())->length() != currRing->N &&
1562	((intvec*) h->next->next->Data())->length() != currRing->N )
1563	{
1564	Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1565	currRing->N);
1566	return TRUE;
1567	}
1568	ideal arg1 = (ideal) h->Data();
1569	intvec* arg2 = (intvec*) h->next->Data();
1570	intvec* arg3 = (intvec*) h->next->next->Data();
1571
1572
1573	ideal result = (ideal) Mwalk(arg1, arg2, arg3);
1574
1575	res->rtyp = IDEAL_CMD;
1576	res->data = result;
1577
1578	return FALSE;
1579	}
1580	else
1581	#ifdef MPWALK_ORIG
1582	if (strcmp(sys_cmd, "Mpwalk") == 0)
1583	{
1584	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1585	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1586	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1587	h->next->next->next == NULL \|\|
1588	h->next->next->next->Typ() != INTVEC_CMD \|\|
1589	h->next->next->next->next == NULL \|\|
1590	h->next->next->next->next->Typ() != INTVEC_CMD)
1591	{
1592	Werror("system(\"Mpwalk\", ideal, int, int, intvec, intvec) expected");
1593	return TRUE;
1594	}
1595
1596	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1597	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1598	{
1599	Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",
1600	currRing->N);
1601	return TRUE;
1602	}
1603	ideal arg1 = (ideal) h->Data();
1604	int arg2 = (int) h->next->Data();
1605	int arg3 = (int) h->next->next->Data();
1606	intvec* arg4 = (intvec*) h->next->next->next->Data();
1607	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1608
1609
1610	ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5);
1611
1612	res->rtyp = IDEAL_CMD;
1613	res->data = result;
1614
1615	return FALSE;
1616	}
1617	else
1618	#endif
1619	if (strcmp(sys_cmd, "Mpwalk") == 0)
1620	{
1621	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1622	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1623	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1624	h->next->next->next == NULL \|\|
1625	h->next->next->next->Typ() != INTVEC_CMD \|\|
1626	h->next->next->next->next == NULL \|\|
1627	h->next->next->next->next->Typ() != INTVEC_CMD\|\|
1628	h->next->next->next->next->next == NULL \|\|
1629	h->next->next->next->next->next->Typ() != INT_CMD)
1630	{
1631	Werror("system(\"Mpwalk\", ideal, int, int, intvec, intvec, int) expected");
1632	return TRUE;
1633	}
1634
1635	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1636	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1637	{
1638	Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",
1639	currRing->N);
1640	return TRUE;
1641	}
1642	ideal arg1 = (ideal) h->Data();
1643	int arg2 = (int) ((long)(h->next->Data()));
1644	int arg3 = (int) ((long)(h->next->next->Data()));
1645	intvec* arg4 = (intvec*) h->next->next->next->Data();
1646	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1647	int arg6 = (int) ((long)(h->next->next->next->next->next->Data()));
1648
1649
1650	ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1651
1652	res->rtyp = IDEAL_CMD;
1653	res->data = result;
1654
1655	return FALSE;
1656	}
1657	else
1658	if (strcmp(sys_cmd, "MAltwalk1") == 0)
1659	{
1660	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1661	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1662	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1663	h->next->next->next == NULL \|\|
1664	h->next->next->next->Typ() != INTVEC_CMD \|\|
1665	h->next->next->next->next == NULL \|\|
1666	h->next->next->next->next->Typ() != INTVEC_CMD)
1667	{
1668	Werror("system(\"MAltwalk1\", ideal, int, int, intvec, intvec) expected");
1669	return TRUE;
1670	}
1671
1672	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1673	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1674	{
1675	Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
1676	currRing->N);
1677	return TRUE;
1678	}
1679	ideal arg1 = (ideal) h->Data();
1680	int arg2 = (int) ((long)(h->next->Data()));
1681	int arg3 = (int) ((long)(h->next->next->Data()));
1682	intvec* arg4 = (intvec*) h->next->next->next->Data();
1683	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1684
1685
1686	ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
1687
1688	res->rtyp = IDEAL_CMD;
1689	res->data = result;
1690
1691	return FALSE;
1692	}
1693	#ifdef MFWALK_ALT
1694	else
1695	if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
1696	{
1697	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1698	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1699	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD \|\|
1700	h->next->next->next == NULL \|\| h->next->next->next->Typ() !=INT_CMD)
1701	{
1702	Werror("system(\"Mfwalk\", ideal, intvec, intvec,int) expected");
1703	return TRUE;
1704	}
1705
1706	if (((intvec*) h->next->Data())->length() != currRing->N &&
1707	((intvec*) h->next->next->Data())->length() != currRing->N )
1708	{
1709	Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
1710	currRing->N);
1711	return TRUE;
1712	}
1713	ideal arg1 = (ideal) h->Data();
1714	intvec* arg2 = (intvec*) h->next->Data();
1715	intvec* arg3 = (intvec*) h->next->next->Data();
1716	int arg4 = (int) h->next->next->next->Data();
1717
1718	ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
1719
1720	res->rtyp = IDEAL_CMD;
1721	res->data = result;
1722
1723	return FALSE;
1724	}
1725	#endif
1726	else
1727	if (strcmp(sys_cmd, "Mfwalk") == 0)
1728	{
1729	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1730	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1731	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1732	{
1733	Werror("system(\"Mfwalk\", ideal, intvec, intvec) expected");
1734	return TRUE;
1735	}
1736
1737	if (((intvec*) h->next->Data())->length() != currRing->N &&
1738	((intvec*) h->next->next->Data())->length() != currRing->N )
1739	{
1740	Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
1741	currRing->N);
1742	return TRUE;
1743	}
1744	ideal arg1 = (ideal) h->Data();
1745	intvec* arg2 = (intvec*) h->next->Data();
1746	intvec* arg3 = (intvec*) h->next->next->Data();
1747
1748	ideal result = (ideal) Mfwalk(arg1, arg2, arg3);
1749
1750	res->rtyp = IDEAL_CMD;
1751	res->data = result;
1752
1753	return FALSE;
1754	}
1755	else
1756
1757	#ifdef TRAN_Orig
1758	if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
1759	{
1760	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1761	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1762	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1763	{
1764	Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec) expected");
1765	return TRUE;
1766	}
1767
1768	if (((intvec*) h->next->Data())->length() != currRing->N &&
1769	((intvec*) h->next->next->Data())->length() != currRing->N )
1770	{
1771	Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
1772	currRing->N);
1773	return TRUE;
1774	}
1775	ideal arg1 = (ideal) h->Data();
1776	intvec* arg2 = (intvec*) h->next->Data();
1777	intvec* arg3 = (intvec*) h->next->next->Data();
1778
1779
1780	ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
1781
1782	res->rtyp = IDEAL_CMD;
1783	res->data = result;
1784
1785	return FALSE;
1786	}
1787	else
1788	#endif
1789	if (strcmp(sys_cmd, "MAltwalk2") == 0)
1790	{
1791	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1792	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1793	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1794	{
1795	Werror("system(\"MAltwalk2\", ideal, intvec, intvec) expected");
1796	return TRUE;
1797	}
1798
1799	if (((intvec*) h->next->Data())->length() != currRing->N &&
1800	((intvec*) h->next->next->Data())->length() != currRing->N )
1801	{
1802	Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
1803	currRing->N);
1804	return TRUE;
1805	}
1806	ideal arg1 = (ideal) h->Data();
1807	intvec* arg2 = (intvec*) h->next->Data();
1808	intvec* arg3 = (intvec*) h->next->next->Data();
1809
1810
1811	ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
1812
1813	res->rtyp = IDEAL_CMD;
1814	res->data = result;
1815
1816	return FALSE;
1817	}
1818	else
1819	if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
1820	{
1821	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1822	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1823	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD\|\|
1824	h->next->next->next == NULL \|\| h->next->next->next->Typ() != INT_CMD)
1825	{
1826	Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec, int) expected");
1827	return TRUE;
1828	}
1829
1830	if (((intvec*) h->next->Data())->length() != currRing->N &&
1831	((intvec*) h->next->next->Data())->length() != currRing->N )
1832	{
1833	Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
1834	currRing->N);
1835	return TRUE;
1836	}
1837	ideal arg1 = (ideal) h->Data();
1838	intvec* arg2 = (intvec*) h->next->Data();
1839	intvec* arg3 = (intvec*) h->next->next->Data();
1840	int arg4 = (int) ((long)(h->next->next->next->Data()));
1841
1842	ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
1843
1844	res->rtyp = IDEAL_CMD;
1845	res->data = result;
1846
1847	return FALSE;
1848	}
1849	else
1850	#endif
1851	/================= Extended system call ========================/
1852	{
1853	#ifndef MAKE_DISTRIBUTION
1854	return(jjEXTENDED_SYSTEM(res, args));
1855	#else
1856	Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1857	#endif
1858	}
1859	} /* typ==string */
1860	return TRUE;
1861	}
1862
1863
1864	#ifdef HAVE_EXTENDED_SYSTEM
1865	// You can put your own system calls here
1866	#include "../kernel/fglmcomb.cc"
1867	#include "fglm.h"
1868	#ifdef HAVE_NEWTON
1869	#include <hc_newton.h>
1870	#endif
1871	#include "mpsr.h"
1872	#include "mod_raw.h"
1873	#include "ratgring.h"
1874
1875	static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
1876	{
1877	if(h->Typ() == STRING_CMD)
1878	{
1879	char sys_cmd=(char )(h->Data());
1880	h=h->next;
1881	/==================== locNF ======================================/
1882	if(strcmp(sys_cmd,"locNF")==0)
1883	{
1884	if (h != NULL && h->Typ() == VECTOR_CMD)
1885	{
1886	poly f=(poly)h->Data();
1887	h=h->next;
1888	if (h != NULL && h->Typ() == MODUL_CMD)
1889	{
1890	ideal m=(ideal)h->Data();
1891	assumeStdFlag(h);
1892	h=h->next;
1893	if (h != NULL && h->Typ() == INT_CMD)
1894	{
1895	int n=(int)((long)h->Data());
1896	h=h->next;
1897	if (h != NULL && h->Typ() == INTVEC_CMD)
1898	{
1899	intvec v=(intvec )h->Data();
1900
1901	/* == now the work starts == */
1902
1903	short * iv=iv2array(v);
1904	poly r=0;
1905	poly hp=ppJetW(f,n,iv);
1906	int s=MATCOLS(m);
1907	int j=0;
1908	matrix T=mpInitI(s,1,0);
1909
1910	while (hp != NULL)
1911	{
1912	if (pDivisibleBy(m->m[j],hp))
1913	{
1914	if (MATELEM(T,j+1,1)==0)
1915	{
1916	MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
1917	}
1918	else
1919	{
1920	pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
1921	}
1922	hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
1923	j=0;
1924	}
1925	else
1926	{
1927	if (j==s-1)
1928	{
1929	r=pAdd(r,pHead(hp));
1930	hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
1931	j=0;
1932	}
1933	else
1934	{
1935	j++;
1936	}
1937	}
1938	}
1939
1940	matrix Temp=mpTransp((matrix) idVec2Ideal(r));
1941	matrix R=mpNew(MATCOLS((matrix) idVec2Ideal(f)),1);
1942	for (int k=1;k<=MATROWS(Temp);k++)
1943	{
1944	MATELEM(R,k,1)=MATELEM(Temp,k,1);
1945	}
1946
1947	lists L=(lists)omAllocBin(slists_bin);
1948	L->Init(2);
1949	L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
1950	L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
1951	res->data=L;
1952	res->rtyp=LIST_CMD;
1953	// iv aufraeumen
1954	omFree(iv);
1955	}
1956	else
1957	{
1958	Warn ("4th argument: must be an intvec!");
1959	}
1960	}
1961	else
1962	{
1963	Warn("3rd argument must be an int!!");
1964	}
1965	}
1966	else
1967	{
1968	Warn("2nd argument must be a module!");
1969	}
1970	}
1971	else
1972	{
1973	Warn("1st argument must be a vector!");
1974	}
1975	return FALSE;
1976	}
1977	else
1978	/==================== interred ==================================/
1979	#if 0
1980	if(strcmp(sys_cmd,"interred")==0)
1981	{
1982	res->data=(char *)kIR((ideal)h->Data(),currQuotient);
1983	res->rtyp=h->Typ();
1984	return ((h->Typ()!=IDEAL_CMD) && (h->Typ()!=MODUL_CMD));
1985	}
1986	else
1987	#endif
1988	#ifdef RDEBUG
1989	/==================== poly debug ==================================/
1990	if(strcmp(sys_cmd,"p")==0)
1991	{
1992	pDebugPrint((poly)h->Data());
1993	return FALSE;
1994	}
1995	else
1996	/==================== ring debug ==================================/
1997	if(strcmp(sys_cmd,"r")==0)
1998	{
1999	rDebugPrint((ring)h->Data());
2000	return FALSE;
2001	}
2002	else
2003	#endif
2004	/==================== mtrack ==================================/
2005	if(strcmp(sys_cmd,"mtrack")==0)
2006	{
2007	#ifdef OM_TRACK
2008	om_Opts.MarkAsStatic = 1;
2009	FILE *fd = NULL;
2010	int max = 5;
2011	while (h != NULL)
2012	{
2013	omMarkAsStaticAddr(h);
2014	if (fd == NULL && h->Typ()==STRING_CMD)
2015	{
2016	fd = fopen((char*) h->Data(), "w");
2017	if (fd == NULL)
2018	Warn("Can not open %s for writing og mtrack. Using stdout");
2019	}
2020	if (h->Typ() == INT_CMD)
2021	{
2022	max = (int)(long)h->Data();
2023	}
2024	h = h->Next();
2025	}
2026	omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2027	if (fd != NULL) fclose(fd);
2028	om_Opts.MarkAsStatic = 0;
2029	return FALSE;
2030	#else
2031	WerrorS("mtrack not supported without OM_TRACK");
2032	return TRUE;
2033	#endif
2034	}
2035	/==================== mtrack_all ==================================/
2036	if(strcmp(sys_cmd,"mtrack_all")==0)
2037	{
2038	#ifdef OM_TRACK
2039	om_Opts.MarkAsStatic = 1;
2040	FILE *fd = NULL;
2041	if ((h!=NULL) &&(h->Typ()==STRING_CMD))
2042	{
2043	fd = fopen((char*) h->Data(), "w");
2044	if (fd == NULL)
2045	Warn("Can not open %s for writing og mtrack. Using stdout");
2046	omMarkAsStaticAddr(h);
2047	}
2048	// OB: TBC print to fd
2049	omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
2050	if (fd != NULL) fclose(fd);
2051	om_Opts.MarkAsStatic = 0;
2052	return FALSE;
2053	#else
2054	WerrorS("mtrack not supported without OM_TRACK");
2055	return TRUE;
2056	#endif
2057	}
2058	else
2059	/==================== backtrace ==================================/
2060	if(strcmp(sys_cmd,"backtrace")==0)
2061	{
2062	#ifndef OM_NDEBUG
2063	omPrintCurrentBackTrace(stdout);
2064	return FALSE;
2065	#else
2066	WerrorS("btrack not supported without OM_TRACK");
2067	return TRUE;
2068	#endif
2069	}
2070	else
2071	/==================== naIdeal ==================================/
2072	if(strcmp(sys_cmd,"naIdeal")==0)
2073	{
2074	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2075	{
2076	naSetIdeal((ideal)h->Data());
2077	return FALSE;
2078	}
2079	else
2080	WerrorS("ideal expected");
2081	}
2082	else
2083	/==================== isSqrFree =============================/
2084	#ifdef HAVE_FACTORY
2085	if(strcmp(sys_cmd,"isSqrFree")==0)
2086	{
2087	if ((h!=NULL) &&(h->Typ()==POLY_CMD))
2088	{
2089	res->rtyp=INT_CMD;
2090	res->data=(void *)(long) singclap_isSqrFree((poly)h->Data());
2091	return FALSE;
2092	}
2093	else
2094	WerrorS("poly expected");
2095	}
2096	else
2097	#endif
2098	/==================== pDivStat =============================/
2099	#if defined(PDEBUG) \|\| defined(PDIV_DEBUG)
2100	if(strcmp(sys_cmd,"pDivStat")==0)
2101	{
2102	extern void pPrintDivisbleByStat();
2103	pPrintDivisbleByStat();
2104	return FALSE;
2105	}
2106	else
2107	#endif
2108	/==================== alarm ==================================/
2109	#ifdef unix
2110	if(strcmp(sys_cmd,"alarm")==0)
2111	{
2112	if ((h!=NULL) &&(h->Typ()==INT_CMD))
2113	{
2114	// standard variant -> SIGALARM (standard: abort)
2115	//alarm((unsigned)h->next->Data());
2116	// process time (user +system): SIGVTALARM
2117	struct itimerval t,o;
2118	memset(&t,0,sizeof(t));
2119	t.it_value.tv_sec =(unsigned)((unsigned long)h->Data());
2120	setitimer(ITIMER_VIRTUAL,&t,&o);
2121	return FALSE;
2122	}
2123	else
2124	WerrorS("int expected");
2125	}
2126	else
2127	#endif
2128	/==================== red =============================/
2129	#if 0
2130	if(strcmp(sys_cmd,"red")==0)
2131	{
2132	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2133	{
2134	res->rtyp=IDEAL_CMD;
2135	res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2136	setFlag(res,FLAG_STD);
2137	return FALSE;
2138	}
2139	else
2140	WerrorS("ideal expected");
2141	}
2142	else
2143	#endif
2144	#ifdef HAVE_FACTORY
2145	/==================== fastcomb =============================/
2146	if(strcmp(sys_cmd,"fastcomb")==0)
2147	{
2148	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2149	{
2150	int i=0;
2151	if (h->next!=NULL)
2152	{
2153	if (h->next->Typ()!=POLY_CMD)
2154	{
2155	Warn("Wrong types for poly= comb(ideal,poly)");
2156	}
2157	}
2158	res->rtyp=POLY_CMD;
2159	res->data=(void *) fglmLinearCombination(
2160	(ideal)h->Data(),(poly)h->next->Data());
2161	return FALSE;
2162	}
2163	else
2164	WerrorS("ideal expected");
2165	}
2166	else
2167	/==================== comb =============================/
2168	if(strcmp(sys_cmd,"comb")==0)
2169	{
2170	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2171	{
2172	int i=0;
2173	if (h->next!=NULL)
2174	{
2175	if (h->next->Typ()!=POLY_CMD)
2176	{
2177	Warn("Wrong types for poly= comb(ideal,poly)");
2178	}
2179	}
2180	res->rtyp=POLY_CMD;
2181	res->data=(void *)fglmNewLinearCombination(
2182	(ideal)h->Data(),(poly)h->next->Data());
2183	return FALSE;
2184	}
2185	else
2186	WerrorS("ideal expected");
2187	}
2188	else
2189	#endif
2190	#ifdef FACTORY_GCD_TEST
2191	/=======================gcd Testerei ================================/
2192	if ( ! strcmp( sys_cmd, "setgcd" ) ) {
2193	if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
2194	CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
2195	return FALSE;
2196	} else
2197	WerrorS("int expected");
2198	}
2199	else
2200	#endif
2201
2202	#ifdef FACTORY_GCD_TIMING
2203	if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
2204	TIMING_PRINT( contentTimer, "time used for content: " );
2205	TIMING_PRINT( algContentTimer, "time used for algContent: " );
2206	TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
2207	TIMING_RESET( contentTimer );
2208	TIMING_RESET( algContentTimer );
2209	TIMING_RESET( algLcmTimer );
2210	return FALSE;
2211	}
2212	else
2213	#endif
2214
2215	#ifdef FACTORY_GCD_STAT
2216	if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
2217	printGcdTotal();
2218	printContTotal();
2219	resetGcdTotal();
2220	resetContTotal();
2221	return FALSE;
2222	}
2223	else
2224	#endif
2225	#if !defined(HAVE_NS)
2226	/==================== lib ==================================/
2227	if(strcmp(sys_cmd,"LIB")==0)
2228	{
2229	idhdl hh=idroot->get((char*)h->Data(),0);
2230	if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
2231	{
2232	res->rtyp=STRING_CMD;
2233	char *r=iiGetLibName(IDPROC(hh));
2234	if (r==NULL) r="";
2235	res->data=omStrDup(r);
2236	return FALSE;
2237	}
2238	else
2239	Warn("`%s` not found",(char*)h->Data());
2240	}
2241	else
2242	#endif
2243	/==================== listall ===================================/
2244	if(strcmp(sys_cmd,"listall")==0)
2245	{
2246	int showproc=0;
2247	if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2248	#ifdef HAVE_NS
2249	listall(showproc);
2250	#else
2251	idhdl hh=IDROOT;
2252	while (hh!=NULL)
2253	{
2254	if (IDDATA(hh)==(void *)currRing) PrintS("(R)");
2255	else PrintS(" ");
2256	Print("::%s, typ %s level %d\n",
2257	IDID(hh),Tok2Cmdname(IDTYP(hh)),IDLEV(hh));
2258	hh=IDNEXT(hh);
2259	}
2260	hh=IDROOT;
2261	while (hh!=NULL)
2262	{
2263	if ((IDTYP(hh)==RING_CMD)
2264	\|\| (IDTYP(hh)==QRING_CMD)
2265	\|\| (IDTYP(hh)==PACKAGE_CMD))
2266	{
2267	idhdl h2=IDRING(hh)->idroot;
2268	while (h2!=NULL)
2269	{
2270	if (IDDATA(h2)==(void *)currRing) PrintS("(R)");
2271	else PrintS(" ");
2272	Print("%s::%s, typ %s level %d\n",
2273	IDID(hh),IDID(h2),Tok2Cmdname(IDTYP(h2)),IDLEV(h2));
2274	h2=IDNEXT(h2);
2275	}
2276	}
2277	hh=IDNEXT(hh);
2278	}
2279	#endif /* HAVE_NS */
2280	return FALSE;
2281	}
2282	else
2283	/==================== proclist =================================/
2284	if(strcmp(sys_cmd,"proclist")==0)
2285	{
2286	piShowProcList();
2287	return FALSE;
2288	}
2289	else
2290	/* ==================== newton ================================*/
2291	#ifdef HAVE_NEWTON
2292	if(strcmp(sys_cmd,"newton")==0)
2293	{
2294	if ((h->Typ()!=POLY_CMD)
2295	\|\| (h->next->Typ()!=INT_CMD)
2296	\|\| (h->next->next->Typ()!=INT_CMD))
2297	{
2298	WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2299	return TRUE;
2300	}
2301	poly p=(poly)(h->Data());
2302	int l=pLength(p);
2303	short points=(short )omAlloc(currRing->Nlsizeof(short));
2304	int i,j,k;
2305	k=0;
2306	poly pp=p;
2307	for (i=0;pp!=NULL;i++)
2308	{
2309	for(j=1;j<=currRing->N;j++)
2310	{
2311	points[k]=pGetExp(pp,j);
2312	k++;
2313	}
2314	pIter(pp);
2315	}
2316	hc_ERG r=hc_KOENIG(currRing->N, // dimension
2317	l, // number of points
2318	(short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2319	currRing->OrdSgn==-1,
2320	(int) (h->next->Data()), // 1: Milnor, 0: Newton
2321	(int) (h->next->next->Data()) // debug
2322	);
2323	//----<>---Output-----------------------
2324
2325
2326	// PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2327
2328
2329	lists L=(lists)omAllocBin(slists_bin);
2330	L->Init(6);
2331	L->m[0].rtyp=STRING_CMD; // newtonnumber;
2332	L->m[0].data=(void *)omStrDup(r.nZahl);
2333	L->m[1].rtyp=INT_CMD;
2334	L->m[1].data=(void *)r.achse; // flag for unoccupied axes
2335	L->m[2].rtyp=INT_CMD;
2336	L->m[2].data=(void *)r.deg; // #degenerations
2337	if ( r.deg != 0) // only if degenerations exist
2338	{
2339	L->m[3].rtyp=INT_CMD;
2340	L->m[3].data=(void *)r.anz_punkte; // #points
2341	//---<>--number of points------
2342	int anz = r.anz_punkte; // number of points
2343	int dim = (currRing->N); // dimension
2344	intvec* v = new intvec( anz*dim );
2345	for (i=0; i<anz*dim; i++) // copy points
2346	(*v)[i] = r.pu[i];
2347	L->m[4].rtyp=INTVEC_CMD;
2348	L->m[4].data=(void *)v;
2349	//---<>--degenerations---------
2350	int deg = r.deg; // number of points
2351	intvec* w = new intvec( r.speicher ); // necessary memeory
2352	i=0; // start copying
2353	do
2354	{
2355	(*w)[i] = r.deg_tab[i];
2356	i++;
2357	}
2358	while (r.deg_tab[i-1] != -2); // mark for end of list
2359	L->m[5].rtyp=INTVEC_CMD;
2360	L->m[5].data=(void *)w;
2361	}
2362	else
2363	{
2364	L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2365	L->m[4].rtyp=DEF_CMD;
2366	L->m[5].rtyp=DEF_CMD;
2367	}
2368
2369	res->data=(void *)L;
2370	res->rtyp=LIST_CMD;
2371	// free all pointer in r:
2372	delete[] r.nZahl;
2373	delete[] r.pu;
2374	delete[] r.deg_tab; // Ist das ein Problem??
2375
2376	omFreeSize((ADDRESS)points,currRing->Nlsizeof(short));
2377	return FALSE;
2378	}
2379	else
2380	#endif
2381	/==================== sdb_flags =================/
2382	#ifdef HAVE_SDB
2383	if (strcmp(sys_cmd, "sdb_flags") == 0)
2384	{
2385	if ((h!=NULL) && (h->Typ()==INT_CMD))
2386	{
2387	sdb_flags=(int)((long)h->Data());
2388	}
2389	else
2390	{
2391	WerrorS("system(\"sdb_flags\",`int`) expected");
2392	return TRUE;
2393	}
2394	return FALSE;
2395	}
2396	else
2397	/==================== sdb_edit =================/
2398	if (strcmp(sys_cmd, "sdb_edit") == 0)
2399	{
2400	if ((h!=NULL) && (h->Typ()==PROC_CMD))
2401	{
2402	procinfov p=(procinfov)h->Data();
2403	sdb_edit(p);
2404	}
2405	else
2406	{
2407	WerrorS("system(\"sdb_edit\",`proc`) expected");
2408	return TRUE;
2409	}
2410	return FALSE;
2411	}
2412	else
2413	#endif
2414	/==================== GF =================/
2415	#if 0
2416	if (strcmp(sys_cmd, "GF") == 0)
2417	{
2418	int c=rChar(currRing);
2419	setCharacteristic( c, 2);
2420	CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
2421	res->rtyp=POLY_CMD;
2422	res->data=convClapGFSingGF( F );
2423	return FALSE;
2424	}
2425	else
2426	#endif
2427	/==================== stdX =================/
2428	if (strcmp(sys_cmd, "std") == 0)
2429	{
2430	ideal i1;
2431	int i2;
2432	if ((h!=NULL) && (h->Typ()==MODUL_CMD))
2433	{
2434	i1=(ideal)h->CopyD();
2435	h=h->next;
2436	}
2437	else return TRUE;
2438	if ((h!=NULL) && (h->Typ()==INT_CMD))
2439	{
2440	i2=(int)((long)h->Data());
2441	}
2442	else return TRUE;
2443	res->rtyp=MODUL_CMD;
2444	res->data=idXXX(i1,i2);
2445	return FALSE;
2446	}
2447	else
2448	#ifdef ix86_Win
2449	#ifdef HAVE_DL
2450	/==================== DLL =================/
2451	/* testing the DLL functionality under Win32 */
2452	if (strcmp(sys_cmd, "DLL") == 0)
2453	{
2454	typedef void (*Void_Func)();
2455	typedef int (*Int_Func)(int);
2456	void *hh=dynl_open("WinDllTest.dll");
2457	if ((h!=NULL) && (h->Typ()==INT_CMD))
2458	{
2459	int (*f)(int);
2460	if (hh!=NULL)
2461	{
2462	int (*f)(int);
2463	f=(Int_Func)dynl_sym(hh,"PlusDll");
2464	int i=10;
2465	if (f!=NULL) printf("%d\n",f(i));
2466	else PrintS("cannot find PlusDll\n");
2467	}
2468	}
2469	else
2470	{
2471	void (*f)();
2472	f= (Void_Func)dynl_sym(hh,"TestDll");
2473	if (f!=NULL) f();
2474	else PrintS("cannot find TestDll\n");
2475	}
2476	return FALSE;
2477	}
2478	else
2479	#endif
2480	#endif
2481	/==================== eigenvalues ==================================/
2482	#ifdef HAVE_EIGENVAL
2483	if(strcmp(sys_cmd,"eigenvals")==0)
2484	{
2485	return evEigenvals(res,h);
2486	}
2487	else
2488	#endif
2489	/==================== Gauss-Manin system ==================================/
2490	#ifdef HAVE_GMS
2491	if(strcmp(sys_cmd,"gmsnf")==0)
2492	{
2493	return gmsNF(res,h);
2494	}
2495	else
2496	#endif
2497	/==================== facstd_debug ==================================/
2498	#if !defined(NDEBUG)
2499	if(strcmp(sys_cmd,"facstd")==0)
2500	{
2501	extern int strat_nr;
2502	extern int strat_fac_debug;
2503	strat_fac_debug=(int)(long)h->Data();
2504	strat_nr=0;
2505	return FALSE;
2506	}
2507	else
2508	#endif
2509	#ifdef HAVE_RING2TOM
2510	/==================== ring-GB ==================================/
2511	if (strcmp(sys_cmd, "findZeroPoly")==0)
2512	{
2513	ring r = currRing;
2514	poly f = (poly) h->Data();
2515	res->rtyp=POLY_CMD;
2516	res->data=(poly) kFindZeroPoly(f, r, r);
2517	return(FALSE);
2518	}
2519	else
2520	/==================== Creating zero polynomials =================/
2521	if (strcmp(sys_cmd, "createG0")==0)
2522	{
2523	/* long exp[50];
2524	int N = 0;
2525	while (h != NULL)
2526	{
2527	N += 1;
2528	exp[N] = (long) h->Data();
2529	// if (exp[i] % 2 != 0) exp[i] -= 1;
2530	h = h->next;
2531	}
2532	for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
2533
2534	poly t_p;
2535	res->rtyp=POLY_CMD;
2536	res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
2537	return(FALSE); */
2538
2539	res->rtyp = IDEAL_CMD;
2540	res->data = (ideal) createG0();
2541	return(FALSE);
2542	}
2543	else
2544	if (strcmp(sys_cmd, "redNF_ring")==0)
2545	{
2546	ring r = currRing;
2547	poly f = (poly) h->Data();
2548	h = h->next;
2549	ideal G = (ideal) h->Data();
2550	res->rtyp=POLY_CMD;
2551	res->data=(poly) ringRedNF(f, G, r);
2552	return(FALSE);
2553	}
2554	else
2555	#endif
2556	#ifdef HAVE_RINGS
2557	/==================== Testing groebner basis =================/
2558	if (strcmp(sys_cmd, "NF_ring")==0)
2559	{
2560	ring r = currRing;
2561	poly f = (poly) h->Data();
2562	h = h->next;
2563	ideal G = (ideal) h->Data();
2564	res->rtyp=POLY_CMD;
2565	res->data=(poly) ringNF(f, G, r);
2566	return(FALSE);
2567	}
2568	else
2569	if (strcmp(sys_cmd, "spoly")==0)
2570	{
2571	poly f = pCopy((poly) h->Data());
2572	h = h->next;
2573	poly g = pCopy((poly) h->Data());
2574
2575	res->rtyp=POLY_CMD;
2576	res->data=(poly) plain_spoly(f,g);
2577	return(FALSE);
2578	}
2579	else
2580	if (strcmp(sys_cmd, "testGB")==0)
2581	{
2582	ideal I = (ideal) h->Data();
2583	h = h->next;
2584	ideal GI = (ideal) h->Data();
2585	res->rtyp = INT_CMD;
2586	res->data = (void *) testGB(I, GI);
2587	return(FALSE);
2588	}
2589	else
2590	#endif
2591	#ifdef HAVE_PLURAL
2592	/==================== sca?AltVar ==================================/
2593	if ( (strcmp(sys_cmd, "AltVarStart") == 0) \|\| (strcmp(sys_cmd, "AltVarEnd") == 0) )
2594	{
2595	ring r = currRing;
2596
2597	if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
2598	{
2599	WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
2600	return TRUE;
2601	}
2602
2603	res->rtyp=INT_CMD;
2604
2605	if (rIsSCA(r))
2606	{
2607	if(strcmp(sys_cmd, "AltVarStart") == 0)
2608	res->data = (void*)scaFirstAltVar(r);
2609	else
2610	res->data = (void*)scaLastAltVar(r);
2611	return FALSE;
2612	}
2613
2614	WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
2615	return TRUE;
2616	}
2617	else
2618	#endif
2619	#ifdef HAVE_RATGRING
2620	/==================== RatNF, noncomm rational coeffs =================/
2621	if (strcmp(sys_cmd, "intratNF") == 0)
2622	{
2623	poly p;
2624	poly *q;
2625	ideal I;
2626	int is, k, id;
2627	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2628	{
2629	p=(poly)h->CopyD();
2630	h=h->next;
2631	// Print("poly is done\n");
2632	}
2633	else return TRUE;
2634	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2635	{
2636	I=(ideal)h->CopyD();
2637	q = I->m;
2638	h=h->next;
2639	// Print("ideal is done\n");
2640	}
2641	else return TRUE;
2642	if ((h!=NULL) && (h->Typ()==INT_CMD))
2643	{
2644	is=(int)((long)(h->Data()));
2645	// res->rtyp=INT_CMD;
2646	// Print("int is done\n");
2647	// res->rtyp=IDEAL_CMD;
2648	if (rIsPluralRing(currRing))
2649	{
2650	id = IDELEMS(I);
2651	int pl=(int)omAlloc0(IDELEMS(I)*sizeof(int));
2652	for(k=0; k < id; k++)
2653	{
2654	pl[k] = pLength(I->m[k]);
2655	}
2656	Print("starting redRat\n");
2657	//res->data = (char *)
2658	redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
2659	res->data=p;
2660	res->rtyp=POLY_CMD;
2661	// res->data = ncGCD(p,q,currRing);
2662	}
2663	else
2664	{
2665	res->rtyp=POLY_CMD;
2666	res->data=p;
2667	}
2668	}
2669	else return TRUE;
2670	return FALSE;
2671	}
2672	else
2673	/==================== RatNF, noncomm rational coeffs =================/
2674	if (strcmp(sys_cmd, "ratNF") == 0)
2675	{
2676	poly p,q;
2677	int is;
2678	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2679	{
2680	p=(poly)h->CopyD();
2681	h=h->next;
2682	}
2683	else return TRUE;
2684	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2685	{
2686	q=(poly)h->CopyD();
2687	h=h->next;
2688	}
2689	else return TRUE;
2690	if ((h!=NULL) && (h->Typ()==INT_CMD))
2691	{
2692	is=(int)((long)(h->Data()));
2693	res->rtyp=POLY_CMD;
2694	// res->rtyp=IDEAL_CMD;
2695	if (rIsPluralRing(currRing))
2696	{
2697	res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
2698	// res->data = ncGCD(p,q,currRing);
2699	}
2700	else res->data=p;
2701	}
2702	else return TRUE;
2703	return FALSE;
2704	}
2705	else
2706	#endif
2707	#ifdef HAVE_PLURAL
2708	/==================== freeGB, twosided GB in free algebra =================/
2709	if (strcmp(sys_cmd, "freegb") == 0)
2710	{
2711	ideal I;
2712	int uptodeg, lVblock;
2713	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2714	{
2715	I=(ideal)h->CopyD();
2716	h=h->next;
2717	}
2718	else return TRUE;
2719	if ((h!=NULL) && (h->Typ()==INT_CMD))
2720	{
2721	uptodeg=(int)((long)(h->Data()));
2722	h=h->next;
2723	}
2724	else return TRUE;
2725	if ((h!=NULL) && (h->Typ()==INT_CMD))
2726	{
2727	lVblock=(int)((long)(h->Data()));
2728	// res->data = freegb(I,uptodeg,lVblock);
2729	// res->rtyp = IDEAL_CMD;
2730	}
2731	else return TRUE;
2732	return FALSE;
2733	}
2734	else
2735	/==================== shift-test for freeGB =================/
2736	if (strcmp(sys_cmd, "stest") == 0)
2737	{
2738	poly p;
2739	int sh,uptodeg, lVblock;
2740	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2741	{
2742	p=(poly)h->CopyD();
2743	h=h->next;
2744	}
2745	else return TRUE;
2746	if ((h!=NULL) && (h->Typ()==INT_CMD))
2747	{
2748	sh=(int)((long)(h->Data()));
2749	h=h->next;
2750	}
2751	else return TRUE;
2752
2753	if ((h!=NULL) && (h->Typ()==INT_CMD))
2754	{
2755	uptodeg=(int)((long)(h->Data()));
2756	h=h->next;
2757	}
2758	else return TRUE;
2759	if ((h!=NULL) && (h->Typ()==INT_CMD))
2760	{
2761	lVblock=(int)((long)(h->Data()));
2762	res->data = pLPshift(p,sh,uptodeg,lVblock);
2763	res->rtyp = POLY_CMD;
2764	}
2765	else return TRUE;
2766	return FALSE;
2767	}
2768	else
2769	/==================== block-test for freeGB =================/
2770	if (strcmp(sys_cmd, "btest") == 0)
2771	{
2772	poly p;
2773	int lV;
2774	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2775	{
2776	p=(poly)h->CopyD();
2777	h=h->next;
2778	}
2779	else return TRUE;
2780	if ((h!=NULL) && (h->Typ()==INT_CMD))
2781	{
2782	lV=(int)((long)(h->Data()));
2783	res->rtyp = INT_CMD;
2784	res->data = (void*)pLastVblock(p, lV);
2785	}
2786	else return TRUE;
2787	return FALSE;
2788	}
2789	else
2790	#endif
2791	/==================== t-rep-GB ==================================/
2792	if (strcmp(sys_cmd, "unifastmult")==0)
2793	{
2794	ring r = currRing;
2795	poly f = (poly)h->Data();
2796	h=h->next;
2797	poly g=(poly)h->Data();
2798	res->rtyp=POLY_CMD;
2799	res->data=unifastmult(f,g,currRing);
2800	return(FALSE);
2801	}
2802	else
2803	if (strcmp(sys_cmd, "multifastmult")==0)
2804	{
2805	ring r = currRing;
2806	poly f = (poly)h->Data();
2807	h=h->next;
2808	poly g=(poly)h->Data();
2809	res->rtyp=POLY_CMD;
2810	res->data=multifastmult(f,g,currRing);
2811	return(FALSE);
2812	}
2813	else
2814	if (strcmp(sys_cmd, "mults")==0)
2815	{
2816	res->rtyp=INT_CMD ;
2817	res->data=(void*)(long) Mults();
2818	return(FALSE);
2819	}
2820	else
2821	if (strcmp(sys_cmd, "fastpower")==0)
2822	{
2823	ring r = currRing;
2824	poly f = (poly)h->Data();
2825	h=h->next;
2826	int n=(int)((long)h->Data());
2827	res->rtyp=POLY_CMD ;
2828	res->data=(void*) pFastPower(f,n,r);
2829	return(FALSE);
2830	}
2831	else
2832	if (strcmp(sys_cmd, "normalpower")==0)
2833	{
2834	ring r = currRing;
2835	poly f = (poly)h->Data();
2836	h=h->next;
2837	int n=(int)((long)h->Data());
2838	res->rtyp=POLY_CMD ;
2839	res->data=(void*) pPower(pCopy(f),n);
2840	return(FALSE);
2841	}
2842	else
2843	if (strcmp(sys_cmd, "MCpower")==0)
2844	{
2845	ring r = currRing;
2846	poly f = (poly)h->Data();
2847	h=h->next;
2848	int n=(int)((long)h->Data());
2849	res->rtyp=POLY_CMD ;
2850	res->data=(void*) pFastPowerMC(f,n,r);
2851	return(FALSE);
2852	}
2853	else
2854	if (strcmp(sys_cmd, "bit_subst")==0)
2855	{
2856	ring r = currRing;
2857	poly outer = (poly)h->Data();
2858	h=h->next;
2859	poly inner=(poly)h->Data();
2860	res->rtyp=POLY_CMD ;
2861	res->data=(void*) uni_subst_bits(outer, inner,r);
2862	return(FALSE);
2863	}
2864	else
2865	/==================== bifac =================/
2866	#ifdef HAVE_BIFAC
2867	if (strcmp(sys_cmd, "bifac")==0)
2868	{
2869	if (h->Typ()!=POLY_CMD)
2870	{
2871	WerrorS("`system(\"bifac\",<poly>) expected");
2872	return TRUE;
2873	}
2874	if (!rField_is_Q())
2875	{
2876	WerrorS("coeff field must be Q");
2877	return TRUE;
2878	}
2879	BIFAC B;
2880	CFFList C;
2881	int sw_rat=isOn(SW_RATIONAL);
2882	On(SW_RATIONAL);
2883	CanonicalForm F( convSingPClapP((poly)(h->Data())));
2884	B.bifac(F, 1);
2885	CFFList L=B.getFactors();
2886	// construct the ring ==============================================
2887	int i;
2888	int lev=ExtensionLevel();
2889	char names=(char)omAlloc0(lev*sizeof(char_ptr));
2890	for(i=1;i<=lev; i++)
2891	{
2892	StringSetS("");
2893	names[i-1]=omStrDup(StringAppend("a(%d)",i));
2894	}
2895	ring alg_ring=rDefault(0,lev,names);
2896	ring new_ring=rCopy0(currRing); // all variable names, ordering etc.
2897	new_ring->P=lev;
2898	new_ring->parameter=names;
2899	new_ring->algring=alg_ring;
2900	new_ring->ch=1;
2901	rComplete(new_ring,TRUE);
2902	// set the mipo ===============================================
2903	ring save_currRing=currRing; idhdl save_currRingHdl=currRingHdl;
2904	rChangeCurrRing(alg_ring);
2905	ideal mipo_id=idInit(lev,1);
2906	for (i=lev; i>0;i--)
2907	{
2908	CanonicalForm Mipo=getMipo(Variable(-i),Variable(i));
2909	mipo_id->m[i-1]=convClapPSingP(Mipo);
2910	}
2911	idShow(mipo_id);
2912	alg_ring->qideal=mipo_id;
2913	rChangeCurrRing(new_ring);
2914	for (i=lev-1; i>=0;i--)
2915	{
2916	poly p=pOne();
2917	lnumber n=(lnumber)pGetCoeff(p);
2918	// no need to delete nac 1
2919	n->z=(napoly)mipo_id->m[i];
2920	mipo_id->m[i]=p;
2921	}
2922	new_ring->minideal=id_Copy(alg_ring->qideal,new_ring);
2923	// convert factors =============================================
2924	ideal fac_id=idInit(L.length(),1);
2925	CFFListIterator J=L;
2926	i=0;
2927	intvec *v = new intvec( L.length() );
2928	for ( ; J.hasItem(); J++,i++ )
2929	{
2930	fac_id->m[i]=convClapAPSingAP( J.getItem().factor() );
2931	(*v)[i]=J.getItem().exp();
2932	}
2933	idhdl hh=enterid("factors",0,LIST_CMD,&(currRing->idroot),FALSE);
2934	lists LL=(lists)omAllocBin( slists_bin);
2935	LL->Init(2);
2936	LL->m[0].rtyp=IDEAL_CMD;
2937	LL->m[0].data=(char *)fac_id;
2938	LL->m[1].rtyp=INTVEC_CMD;
2939	LL->m[1].data=(char *)v;
2940	IDDATA(hh)=(char *)LL;
2941
2942	rChangeCurrRing(save_currRing);
2943	currRingHdl=save_currRingHdl;
2944	if (!sw_rat) Off(SW_RATIONAL);
2945
2946	res->data=new_ring;
2947	res->rtyp=RING_CMD;
2948	return FALSE;
2949	}
2950	else
2951	#endif
2952	/==================== gcd-varianten =================/
2953	if (strcmp(sys_cmd, "gcd") == 0)
2954	{
2955	if (h==NULL)
2956	{
2957	Print("NTL_0:%d (use NTL for gcd of polynomials in char 0)\n",isOn(SW_USE_NTL_GCD_0));
2958	Print("NTL_p:%d (use NTL for gcd of polynomials in char p)\n",isOn(SW_USE_NTL_GCD_P));
2959	Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
2960	Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
2961	Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
2962	Print("SPARSEMOD:%d (use SPARSEMOD for gcd of polynomials in char 0)\n",isOn(SW_USE_SPARSEMOD));
2963	Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
2964	return FALSE;
2965	}
2966	else
2967	if ((h!=NULL) && (h->Typ()==STRING_CMD)
2968	&& (h->next!=NULL) && (h->next->Typ()==INT_CMD))
2969	{
2970	int d=(int)(long)h->next->Data();
2971	char s=(char )h->Data();
2972	if (strcmp(s,"NTL_0")==0) { if (d) On(SW_USE_NTL_GCD_0); else Off(SW_USE_NTL_GCD_0); } else
2973	if (strcmp(s,"NTL_p")==0) { if (d) On(SW_USE_NTL_GCD_P); else Off(SW_USE_NTL_GCD_P); } else
2974	if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
2975	if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
2976	if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
2977	if (strcmp(s,"SPARSEMOD")==0) { if (d) On(SW_USE_SPARSEMOD); else Off(SW_USE_SPARSEMOD); } else
2978	if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
2979	return TRUE;
2980	return FALSE;
2981	}
2982	else return TRUE;
2983	}
2984	else
2985	#if 0
2986	/==================== gcd-test =================/
2987	if (strcmp(sys_cmd, "GCD") == 0)
2988	{
2989	if ((h!=NULL) && (h->Typ()==POLY_CMD)
2990	&& (h->next!=NULL) && (h->next->Typ()==POLY_CMD))
2991	{
2992	poly f=(poly)h->Data();
2993	poly g=(poly)h->next->Data();
2994	res->rtyp=POLY_CMD;
2995	res->data=(char*)id_GCD(f,g,currRing);
2996	return FALSE;
2997	}
2998	else return TRUE;
2999	}
3000	else
3001	#endif
3002	#ifdef ix86_Win
3003	/==================== Python Singular =================/
3004	if (strcmp(sys_cmd, "python") == 0)
3005	{
3006	const char* c;
3007	if ((h!=NULL) && (h->Typ()==STRING_CMD))
3008	{
3009	c=(const char*)h->Data();
3010	if (!PyInitialized) {
3011	PyInitialized = 1;
3012	// Py_Initialize();
3013	// initPySingular();
3014	}
3015	// PyRun_SimpleString(c);
3016	return FALSE;
3017	}
3018	else return TRUE;
3019	}
3020	else
3021	/*==================== Python Singular =================
3022	if (strcmp(sys_cmd, "ipython") == 0)
3023	{
3024	const char* c;
3025	{
3026	if (!PyInitialized) {
3027	PyInitialized = 1;
3028	Py_Initialize();
3029	initPySingular();
3030	}
3031	PyRun_SimpleString(
3032	"try: \n\
3033	__IPYTHON__ \n\
3034	except NameError: \n\
3035	argv = [''] \n\
3036	banner = exit_msg = '' \n\
3037	else: \n\
3038	# Command-line options for IPython (a list like sys.argv) \n\
3039	argv = ['-pi1','In <\\#>:','-pi2',' .\\D.:','-po','Out<\\#>:'] \n\
3040	banner = '* Nested interpreter *' \n\
3041	exit_msg = '* Back in main IPython *' \n\
3042	\n\
3043	# First import the embeddable shell class \n\
3044	from IPython.Shell import IPShellEmbed \n\
3045	# Now create the IPython shell instance. Put ipshell() anywhere in your code \n\
3046	# where you want it to open. \n\
3047	ipshell = IPShellEmbed(argv,banner=banner,exit_msg=exit_msg) \n\
3048	ipshell()");
3049	return FALSE;
3050	}
3051	}
3052	else
3053	*/
3054
3055
3056	#endif
3057	/==================== Error =================/
3058	Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3059	}
3060	return TRUE;
3061	}
3062	#endif // HAVE_EXTENDED_SYSTEM
3063

Note: See TracBrowser for help on using the repository browser.

Download in other formats: