Context Navigation

source: git/Singular/extra.cc @ 40b31de

spielwiese

Last change on this file since 40b31de was 40b31de, checked in by Viktor Levandovskyy <levandov@…>, 15 years ago
*levandov: rational Groebner bases updated git-svn-id: file:///usr/local/Singular/svn/trunk@11425 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 82.0 KB

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

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

Download in other formats: