Context Navigation

source: git/Singular/extra.cc @ 0aad7c

spielwiese

Last change on this file since 0aad7c was 0aad7c, checked in by Martin Monerjan, 14 years ago
gfan->grfan git-svn-id: file:///usr/local/Singular/svn/trunk@12719 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 90.8 KB

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

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

Download in other formats: