Context Navigation

source: git/Singular/extra.cc @ 836138

spielwiese

Last change on this file since 836138 was 836138, checked in by Frank Seelisch <seelisch@…>, 14 years ago
system-command changeRing to make generation of Maple/Magma scripts simpler git-svn-id: file:///usr/local/Singular/svn/trunk@12488 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 94.4 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	res->rtyp=IDEAL_CMD;
2721	res->data=(ideal) F5main(G,r,opt);
2722	return FALSE;
2723	}
2724	else
2725	#endif
2726	/==================== F5C Implementation =================/
2727	#ifdef HAVE_F5C
2728	if (strcmp(sys_cmd, "f5c")==0)
2729	{
2730	if (h->Typ()!=IDEAL_CMD)
2731	{
2732	WerrorS("ideal expected");
2733	return TRUE;
2734	}
2735
2736	ring r = currRing;
2737	ideal G = (ideal) h->Data();
2738	res->rtyp=IDEAL_CMD;
2739	res->data=(ideal) f5cMain(G,r);
2740	return FALSE;
2741	}
2742	else
2743	#endif
2744	/==================== Testing groebner basis =================/
2745	#ifdef HAVE_RINGS
2746	if (strcmp(sys_cmd, "NF_ring")==0)
2747	{
2748	ring r = currRing;
2749	poly f = (poly) h->Data();
2750	h = h->next;
2751	ideal G = (ideal) h->Data();
2752	res->rtyp=POLY_CMD;
2753	res->data=(poly) ringNF(f, G, r);
2754	return(FALSE);
2755	}
2756	else
2757	if (strcmp(sys_cmd, "spoly")==0)
2758	{
2759	poly f = pCopy((poly) h->Data());
2760	h = h->next;
2761	poly g = pCopy((poly) h->Data());
2762
2763	res->rtyp=POLY_CMD;
2764	res->data=(poly) plain_spoly(f,g);
2765	return(FALSE);
2766	}
2767	else
2768	if (strcmp(sys_cmd, "testGB")==0)
2769	{
2770	ideal I = (ideal) h->Data();
2771	h = h->next;
2772	ideal GI = (ideal) h->Data();
2773	res->rtyp = INT_CMD;
2774	res->data = (void *) testGB(I, GI);
2775	return(FALSE);
2776	}
2777	else
2778	#endif
2779	/==================== sca?AltVar ==================================/
2780	#ifdef HAVE_PLURAL
2781	if ( (strcmp(sys_cmd, "AltVarStart") == 0) \|\| (strcmp(sys_cmd, "AltVarEnd") == 0) )
2782	{
2783	ring r = currRing;
2784
2785	if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
2786	{
2787	WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
2788	return TRUE;
2789	}
2790
2791	res->rtyp=INT_CMD;
2792
2793	if (rIsSCA(r))
2794	{
2795	if(strcmp(sys_cmd, "AltVarStart") == 0)
2796	res->data = (void*)scaFirstAltVar(r);
2797	else
2798	res->data = (void*)scaLastAltVar(r);
2799	return FALSE;
2800	}
2801
2802	WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
2803	return TRUE;
2804	}
2805	else
2806	#endif
2807	/==================== RatNF, noncomm rational coeffs =================/
2808	#ifdef HAVE_PLURAL
2809	#ifdef HAVE_RATGRING
2810	if (strcmp(sys_cmd, "intratNF") == 0)
2811	{
2812	poly p;
2813	poly *q;
2814	ideal I;
2815	int is, k, id;
2816	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2817	{
2818	p=(poly)h->CopyD();
2819	h=h->next;
2820	// Print("poly is done\n");
2821	}
2822	else return TRUE;
2823	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2824	{
2825	I=(ideal)h->CopyD();
2826	q = I->m;
2827	h=h->next;
2828	// Print("ideal is done\n");
2829	}
2830	else return TRUE;
2831	if ((h!=NULL) && (h->Typ()==INT_CMD))
2832	{
2833	is=(int)((long)(h->Data()));
2834	// res->rtyp=INT_CMD;
2835	// Print("int is done\n");
2836	// res->rtyp=IDEAL_CMD;
2837	if (rIsPluralRing(currRing))
2838	{
2839	id = IDELEMS(I);
2840	int pl=(int)omAlloc0(IDELEMS(I)*sizeof(int));
2841	for(k=0; k < id; k++)
2842	{
2843	pl[k] = pLength(I->m[k]);
2844	}
2845	Print("starting redRat\n");
2846	//res->data = (char *)
2847	redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
2848	res->data=p;
2849	res->rtyp=POLY_CMD;
2850	// res->data = ncGCD(p,q,currRing);
2851	}
2852	else
2853	{
2854	res->rtyp=POLY_CMD;
2855	res->data=p;
2856	}
2857	}
2858	else return TRUE;
2859	return FALSE;
2860	}
2861	else
2862	/==================== RatNF, noncomm rational coeffs =================/
2863	if (strcmp(sys_cmd, "ratNF") == 0)
2864	{
2865	poly p,q;
2866	int is, htype;
2867	if ((h!=NULL) && ( (h->Typ()==POLY_CMD) \|\| (h->Typ()==VECTOR_CMD) ) )
2868	{
2869	p=(poly)h->CopyD();
2870	h=h->next;
2871	htype = h->Typ();
2872	}
2873	else return TRUE;
2874	if ((h!=NULL) && ( (h->Typ()==POLY_CMD) \|\| (h->Typ()==VECTOR_CMD) ) )
2875	{
2876	q=(poly)h->CopyD();
2877	h=h->next;
2878	}
2879	else return TRUE;
2880	if ((h!=NULL) && (h->Typ()==INT_CMD))
2881	{
2882	is=(int)((long)(h->Data()));
2883	res->rtyp=htype;
2884	// res->rtyp=IDEAL_CMD;
2885	if (rIsPluralRing(currRing))
2886	{
2887	res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
2888	// res->data = ncGCD(p,q,currRing);
2889	}
2890	else res->data=p;
2891	}
2892	else return TRUE;
2893	return FALSE;
2894	}
2895	else
2896	/==================== RatSpoly, noncomm rational coeffs =================/
2897	if (strcmp(sys_cmd, "ratSpoly") == 0)
2898	{
2899	poly p,q;
2900	int is;
2901	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2902	{
2903	p=(poly)h->CopyD();
2904	h=h->next;
2905	}
2906	else return TRUE;
2907	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2908	{
2909	q=(poly)h->CopyD();
2910	h=h->next;
2911	}
2912	else return TRUE;
2913	if ((h!=NULL) && (h->Typ()==INT_CMD))
2914	{
2915	is=(int)((long)(h->Data()));
2916	res->rtyp=POLY_CMD;
2917	// res->rtyp=IDEAL_CMD;
2918	if (rIsPluralRing(currRing))
2919	{
2920	res->data = nc_rat_CreateSpoly(p,q,is,currRing);
2921	// res->data = ncGCD(p,q,currRing);
2922	}
2923	else res->data=p;
2924	}
2925	else return TRUE;
2926	return FALSE;
2927	}
2928	else
2929	#endif // HAVE_RATGRING
2930	/==================== Rat def =================/
2931	if (strcmp(sys_cmd, "ratVar") == 0)
2932	{
2933	int start,end;
2934	int is;
2935	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2936	{
2937	start=pIsPurePower((poly)h->Data());
2938	h=h->next;
2939	}
2940	else return TRUE;
2941	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2942	{
2943	end=pIsPurePower((poly)h->Data());
2944	h=h->next;
2945	}
2946	else return TRUE;
2947	currRing->real_var_start=start;
2948	currRing->real_var_end=end;
2949	return (start==0)\|\|(end==0)\|\|(start>end);
2950	}
2951	else
2952	/==================== shift-test for freeGB =================/
2953	#ifdef HAVE_SHIFTBBA
2954	if (strcmp(sys_cmd, "stest") == 0)
2955	{
2956	poly p;
2957	int sh,uptodeg, lVblock;
2958	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2959	{
2960	p=(poly)h->CopyD();
2961	h=h->next;
2962	}
2963	else return TRUE;
2964	if ((h!=NULL) && (h->Typ()==INT_CMD))
2965	{
2966	sh=(int)((long)(h->Data()));
2967	h=h->next;
2968	}
2969	else return TRUE;
2970
2971	if ((h!=NULL) && (h->Typ()==INT_CMD))
2972	{
2973	uptodeg=(int)((long)(h->Data()));
2974	h=h->next;
2975	}
2976	else return TRUE;
2977	if ((h!=NULL) && (h->Typ()==INT_CMD))
2978	{
2979	lVblock=(int)((long)(h->Data()));
2980	res->data = pLPshift(p,sh,uptodeg,lVblock);
2981	res->rtyp = POLY_CMD;
2982	}
2983	else return TRUE;
2984	return FALSE;
2985	}
2986	else
2987	#endif
2988	/==================== block-test for freeGB =================/
2989	#ifdef HAVE_SHIFTBBA
2990	if (strcmp(sys_cmd, "btest") == 0)
2991	{
2992	poly p;
2993	int lV;
2994	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2995	{
2996	p=(poly)h->CopyD();
2997	h=h->next;
2998	}
2999	else return TRUE;
3000	if ((h!=NULL) && (h->Typ()==INT_CMD))
3001	{
3002	lV=(int)((long)(h->Data()));
3003	res->rtyp = INT_CMD;
3004	res->data = (void*)pLastVblock(p, lV);
3005	}
3006	else return TRUE;
3007	return FALSE;
3008	}
3009	else
3010	/==================== shrink-test for freeGB =================/
3011	if (strcmp(sys_cmd, "shrinktest") == 0)
3012	{
3013	poly p;
3014	int lV;
3015	if ((h!=NULL) && (h->Typ()==POLY_CMD))
3016	{
3017	p=(poly)h->CopyD();
3018	h=h->next;
3019	}
3020	else return TRUE;
3021	if ((h!=NULL) && (h->Typ()==INT_CMD))
3022	{
3023	lV=(int)((long)(h->Data()));
3024	res->rtyp = POLY_CMD;
3025	// res->data = p_mShrink(p, lV, currRing);
3026	// kStrategy strat=new skStrategy;
3027	// strat->tailRing = currRing;
3028	res->data = p_Shrink(p, lV, currRing);
3029	}
3030	else return TRUE;
3031	return FALSE;
3032	}
3033	else
3034	#endif
3035	#endif
3036	/==================== t-rep-GB ==================================/
3037	if (strcmp(sys_cmd, "unifastmult")==0)
3038	{
3039	ring r = currRing;
3040	poly f = (poly)h->Data();
3041	h=h->next;
3042	poly g=(poly)h->Data();
3043	res->rtyp=POLY_CMD;
3044	res->data=unifastmult(f,g,currRing);
3045	return(FALSE);
3046	}
3047	else
3048	if (strcmp(sys_cmd, "multifastmult")==0)
3049	{
3050	ring r = currRing;
3051	poly f = (poly)h->Data();
3052	h=h->next;
3053	poly g=(poly)h->Data();
3054	res->rtyp=POLY_CMD;
3055	res->data=multifastmult(f,g,currRing);
3056	return(FALSE);
3057	}
3058	else
3059	if (strcmp(sys_cmd, "mults")==0)
3060	{
3061	res->rtyp=INT_CMD ;
3062	res->data=(void*)(long) Mults();
3063	return(FALSE);
3064	}
3065	else
3066	if (strcmp(sys_cmd, "fastpower")==0)
3067	{
3068	ring r = currRing;
3069	poly f = (poly)h->Data();
3070	h=h->next;
3071	int n=(int)((long)h->Data());
3072	res->rtyp=POLY_CMD ;
3073	res->data=(void*) pFastPower(f,n,r);
3074	return(FALSE);
3075	}
3076	else
3077	if (strcmp(sys_cmd, "normalpower")==0)
3078	{
3079	ring r = currRing;
3080	poly f = (poly)h->Data();
3081	h=h->next;
3082	int n=(int)((long)h->Data());
3083	res->rtyp=POLY_CMD ;
3084	res->data=(void*) pPower(pCopy(f),n);
3085	return(FALSE);
3086	}
3087	else
3088	if (strcmp(sys_cmd, "MCpower")==0)
3089	{
3090	ring r = currRing;
3091	poly f = (poly)h->Data();
3092	h=h->next;
3093	int n=(int)((long)h->Data());
3094	res->rtyp=POLY_CMD ;
3095	res->data=(void*) pFastPowerMC(f,n,r);
3096	return(FALSE);
3097	}
3098	else
3099	if (strcmp(sys_cmd, "bit_subst")==0)
3100	{
3101	ring r = currRing;
3102	poly outer = (poly)h->Data();
3103	h=h->next;
3104	poly inner=(poly)h->Data();
3105	res->rtyp=POLY_CMD ;
3106	res->data=(void*) uni_subst_bits(outer, inner,r);
3107	return(FALSE);
3108	}
3109	else
3110	/==================== bifac =================/
3111	#ifdef HAVE_BIFAC
3112	if (strcmp(sys_cmd, "bifac")==0)
3113	{
3114	if (h->Typ()!=POLY_CMD)
3115	{
3116	WerrorS("`system(\"bifac\",<poly>) expected");
3117	return TRUE;
3118	}
3119	if (!rField_is_Q())
3120	{
3121	WerrorS("coeff field must be Q");
3122	return TRUE;
3123	}
3124	BIFAC B;
3125	CFFList C;
3126	int sw_rat=isOn(SW_RATIONAL);
3127	On(SW_RATIONAL);
3128	CanonicalForm F( convSingPClapP((poly)(h->Data())));
3129	B.bifac(F, 1);
3130	CFFList L=B.getFactors();
3131	// construct the ring ==============================================
3132	int i;
3133	int lev=ExtensionLevel();
3134	char names=(char)omAlloc0(lev*sizeof(char_ptr));
3135	for(i=1;i<=lev; i++)
3136	{
3137	StringSetS("");
3138	names[i-1]=omStrDup(StringAppend("a(%d)",i));
3139	}
3140	ring alg_ring=rDefault(0,lev,names);
3141	ring new_ring=rCopy0(currRing); // all variable names, ordering etc.
3142	new_ring->P=lev;
3143	new_ring->parameter=names;
3144	new_ring->algring=alg_ring;
3145	new_ring->ch=1;
3146	rComplete(new_ring,TRUE);
3147	// set the mipo ===============================================
3148	ring save_currRing=currRing; idhdl save_currRingHdl=currRingHdl;
3149	rChangeCurrRing(alg_ring);
3150	ideal mipo_id=idInit(lev,1);
3151	for (i=lev; i>0;i--)
3152	{
3153	CanonicalForm Mipo=getMipo(Variable(-i),Variable(i));
3154	mipo_id->m[i-1]=convClapPSingP(Mipo);
3155	}
3156	idShow(mipo_id);
3157	alg_ring->qideal=mipo_id;
3158	rChangeCurrRing(new_ring);
3159	for (i=lev-1; i>=0;i--)
3160	{
3161	poly p=pOne();
3162	lnumber n=(lnumber)pGetCoeff(p);
3163	// no need to delete nac 1
3164	n->z=(napoly)mipo_id->m[i];
3165	mipo_id->m[i]=p;
3166	}
3167	new_ring->minideal=id_Copy(alg_ring->qideal,new_ring);
3168	// convert factors =============================================
3169	ideal fac_id=idInit(L.length(),1);
3170	CFFListIterator J=L;
3171	i=0;
3172	intvec *v = new intvec( L.length() );
3173	for ( ; J.hasItem(); J++,i++ )
3174	{
3175	fac_id->m[i]=convClapAPSingAP( J.getItem().factor() );
3176	(*v)[i]=J.getItem().exp();
3177	}
3178	idhdl hh=enterid("factors",0,LIST_CMD,&(currRing->idroot),FALSE);
3179	lists LL=(lists)omAllocBin( slists_bin);
3180	LL->Init(2);
3181	LL->m[0].rtyp=IDEAL_CMD;
3182	LL->m[0].data=(char *)fac_id;
3183	LL->m[1].rtyp=INTVEC_CMD;
3184	LL->m[1].data=(char *)v;
3185	IDDATA(hh)=(char *)LL;
3186
3187	rChangeCurrRing(save_currRing);
3188	currRingHdl=save_currRingHdl;
3189	if (!sw_rat) Off(SW_RATIONAL);
3190
3191	res->data=new_ring;
3192	res->rtyp=RING_CMD;
3193	return FALSE;
3194	}
3195	else
3196	#endif
3197	/==================== gcd-varianten =================/
3198	if (strcmp(sys_cmd, "gcd") == 0)
3199	{
3200	if (h==NULL)
3201	{
3202	Print("NTL_0:%d (use NTL for gcd of polynomials in char 0)\n",isOn(SW_USE_NTL_GCD_0));
3203	Print("NTL_p:%d (use NTL for gcd of polynomials in char p)\n",isOn(SW_USE_NTL_GCD_P));
3204	Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3205	Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3206	Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3207	Print("SPARSEMOD:%d (use SPARSEMOD for gcd of polynomials in char 0)\n",isOn(SW_USE_SPARSEMOD));
3208	Print("QGCD:%d (use QGCD for gcd of polynomials in alg. ext.)\n",isOn(SW_USE_QGCD));
3209	Print("FGCD:%d (use fieldGCD for gcd of polynomials in Z/p)\n",isOn(SW_USE_fieldGCD));
3210	Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3211	return FALSE;
3212	}
3213	else
3214	if ((h!=NULL) && (h->Typ()==STRING_CMD)
3215	&& (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3216	{
3217	int d=(int)(long)h->next->Data();
3218	char s=(char )h->Data();
3219	if (strcmp(s,"NTL_0")==0) { if (d) On(SW_USE_NTL_GCD_0); else Off(SW_USE_NTL_GCD_0); } else
3220	if (strcmp(s,"NTL_p")==0) { if (d) On(SW_USE_NTL_GCD_P); else Off(SW_USE_NTL_GCD_P); } else
3221	if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3222	if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3223	if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3224	if (strcmp(s,"SPARSEMOD")==0) { if (d) On(SW_USE_SPARSEMOD); else Off(SW_USE_SPARSEMOD); } else
3225	if (strcmp(s,"QGCD")==0) { if (d) On(SW_USE_QGCD); else Off(SW_USE_QGCD); } else
3226	if (strcmp(s,"FGCD")==0) { if (d) On(SW_USE_fieldGCD); else Off(SW_USE_fieldGCD); } else
3227	if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3228	return TRUE;
3229	return FALSE;
3230	}
3231	else return TRUE;
3232	}
3233	else
3234	#if 0
3235	/==================== gcd-test =================/
3236	if (strcmp(sys_cmd, "GCD") == 0)
3237	{
3238	if ((h!=NULL) && (h->Typ()==POLY_CMD)
3239	&& (h->next!=NULL) && (h->next->Typ()==POLY_CMD))
3240	{
3241	poly f=(poly)h->Data();
3242	poly g=(poly)h->next->Data();
3243	res->rtyp=POLY_CMD;
3244	res->data=(char*)id_GCD(f,g,currRing);
3245	return FALSE;
3246	}
3247	else return TRUE;
3248	}
3249	else
3250	#endif
3251	/==================== subring =================/
3252	if (strcmp(sys_cmd, "subring") == 0)
3253	{
3254	if (h!=NULL)
3255	{
3256	extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3257	res->data=(char *)rSubring(currRing,h);
3258	res->rtyp=RING_CMD;
3259	return res->data==NULL;
3260	}
3261	else return TRUE;
3262	}
3263	else
3264	#ifdef ix86_Win
3265	/==================== Python Singular =================/
3266	if (strcmp(sys_cmd, "python") == 0)
3267	{
3268	const char* c;
3269	if ((h!=NULL) && (h->Typ()==STRING_CMD))
3270	{
3271	c=(const char*)h->Data();
3272	if (!PyInitialized) {
3273	PyInitialized = 1;
3274	// Py_Initialize();
3275	// initPySingular();
3276	}
3277	// PyRun_SimpleString(c);
3278	return FALSE;
3279	}
3280	else return TRUE;
3281	}
3282	else
3283	/*==================== Python Singular =================
3284	if (strcmp(sys_cmd, "ipython") == 0)
3285	{
3286	const char* c;
3287	{
3288	if (!PyInitialized) {
3289	PyInitialized = 1;
3290	Py_Initialize();
3291	initPySingular();
3292	}
3293	PyRun_SimpleString(
3294	"try: \n\
3295	__IPYTHON__ \n\
3296	except NameError: \n\
3297	argv = [''] \n\
3298	banner = exit_msg = '' \n\
3299	else: \n\
3300	# Command-line options for IPython (a list like sys.argv) \n\
3301	argv = ['-pi1','In <\\#>:','-pi2',' .\\D.:','-po','Out<\\#>:'] \n\
3302	banner = '* Nested interpreter *' \n\
3303	exit_msg = '* Back in main IPython *' \n\
3304	\n\
3305	# First import the embeddable shell class \n\
3306	from IPython.Shell import IPShellEmbed \n\
3307	# Now create the IPython shell instance. Put ipshell() anywhere in your code \n\
3308	# where you want it to open. \n\
3309	ipshell = IPShellEmbed(argv,banner=banner,exit_msg=exit_msg) \n\
3310	ipshell()");
3311	return FALSE;
3312	}
3313	}
3314	else
3315	*/
3316
3317	#endif
3318
3319	// TODO: What about a dynamic module instead? Only Linux?
3320	#ifdef HAVE_SINGULAR_PLUS_PLUS
3321	if (strcmp(sys_cmd,"Singular++")==0)
3322	{
3323	// using namespace SINGULAR_NS;
3324	extern BOOLEAN Main(leftv res, leftv h); // FALSE = Ok, TRUE = Error!
3325	return Main(res, h);
3326	}
3327	else
3328	#endif // HAVE_SINGULAR_PLUS_PLUS
3329
3330	if (strcmp(sys_cmd,"FrankTest")==0)
3331	{
3332	PrintS("Hell Or Word!");
3333	return FALSE;
3334	};
3335
3336	#ifdef HAVE_GFAN
3337	/======== GFAN ==============/
3338	/*
3339	WILL HAVE TO CHANGE RETURN TYPE TO LIST_CMD
3340	*/
3341	if (strcmp(sys_cmd,"gfan")==0)
3342	{
3343	// if ((h==NULL) \|\| (h!=NULL && h->Typ()!=IDEAL_CMD))
3344	// {
3345	// Werror("system(\"gfan\"...) Ideal expected");
3346	// return TRUE; //Ooooops
3347	// }
3348	// else if(h->next==NULL)
3349	// {
3350	// Werror("gfan expects an integer parameter");
3351	// return TRUE;
3352	// }
3353	// else if(h->next!=NULL && h->next->Typ()!=INT_CMD)
3354	// {
3355	// Werror("1st parameter ist no integer");
3356	// return TRUE;
3357	// }
3358	/*
3359	heuristic:
3360	0 = keep all GrÃ¶bner bases in memory
3361	1 = write all GrÃ¶bner bases to disk and read whenever necessary
3362	2 = use a mixed heuristic, based on length of GrÃ¶bner bases
3363	*/
3364	if( h!=NULL && h->Typ()==IDEAL_CMD && h->next!=NULL && h->next->Typ()==INT_CMD)
3365	{
3366	int heuristic;
3367	heuristic=(int)(long)h->next->Data();
3368	ideal I=((ideal)h->Data());
3369	// res->rtyp=IDEAL_CMD;
3370	// res->data=(ideal) gfan(I,heuristic);
3371	res->rtyp=LIST_CMD;
3372	res->data=(lists) gfan(I,heuristic);
3373	return FALSE;
3374	}
3375	else
3376	{
3377	WerrorS("Usage: system(\"gfan\",I,int)");
3378	return TRUE;
3379	}
3380	//res->rtyp=LIST_CMD;
3381	//res->data= ???
3382
3383	// return FALSE; //Everything went fine
3384	}
3385	else
3386	#endif
3387	/==================== Error =================/
3388	Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3389	}
3390	return TRUE;
3391	}
3392
3393	#endif // HAVE_EXTENDED_SYSTEM
3394
3395

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

Download in other formats: