Context Navigation

source: git/Singular/extra.cc @ 67283e

spielwiese

Last change on this file since 67283e was 67283e, checked in by Hans Schönemann <hannes@…>, 14 years ago
*hannes: code clean, format git-svn-id: file:///usr/local/Singular/svn/trunk@12000 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 90.1 KB

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

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

Download in other formats: