Context Navigation

source: git/Singular/extra.cc @ 645a19

spielwiese

Last change on this file since 645a19 was 645a19, checked in by Motsak Oleksandr <motsak@…>, 14 years ago
*motsak: deep kernel implementation of induced Schreyer ordering + helpers git-svn-id: file:///usr/local/Singular/svn/trunk@11991 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 89.1 KB

Line
1	/*****************************************
2	* Computer Algebra System SINGULAR *
3	*****************************************/
4	/* $Id: extra.cc,v 1.308 2009-07-20 12:01:13 motsak 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
723	WerrorS("system(\"tensorModuleMult\", int, module) expected");
724	return TRUE;
725	} else
726	#endif
727
728
729	#if 0
730	/// Returns old SyzCompLimit, can set new limit
731	if(strcmp(sys_cmd,"SetSyzComp")==0)
732	{
733	res->rtyp = INT_CMD;
734	res->data = (void *)rGetCurrSyzLimit(currRing);
735	if ((h!=NULL) && (h->Typ()==INT_CMD))
736	{
737	const int iSyzComp = (int)((long)(h->Data()));
738	assume( iSyzComp > 0 );
739	rSetSyzComp( iSyzComp );
740	}
741
742	return FALSE;
743	}
744	/// Endowe the current ring with additional (leading) Syz-component ordering
745	if(strcmp(sys_cmd,"MakeSyzCompOrdering")==0)
746	{
747	extern ring rAssure_SyzComp(const ring r, BOOLEAN complete);
748
749	// res->data = rCurrRingAssure_SyzComp(); // changes current ring! :(
750	res->data = (void *)rAssure_SyzComp(currRing, TRUE);
751	res->rtyp = RING_CMD; // return new ring!
752
753	return FALSE;
754	}
755	#endif
756
757	/// Same for Induced Schreyer ordering (ordering on components is defined by sign!)
758	if(strcmp(sys_cmd,"MakeInducedSchreyerOrdering")==0)
759	{
760	extern ring rAssure_InducedSchreyerOrdering(const ring r, BOOLEAN complete, int sign);
761	int sign = 1;
762	if ((h!=NULL) && (h->Typ()==INT_CMD))
763	{
764	sign = (int)((long)(h->Data()));
765	assume( sign == 1 \|\| sign == -1 );
766	}
767	res->data = (void *)rAssure_InducedSchreyerOrdering(currRing, TRUE, sign);
768	res->rtyp = RING_CMD; // return new ring!
769	return FALSE;
770	}
771
772	/// Returns old SyzCompLimit, can set new limit
773	if(strcmp(sys_cmd,"SetISReferrence")==0)
774	{
775	extern void rSetISReference(const ideal F, const int l, const int p, const intvec * componentWeights, const ring r);
776
777	if ((h!=NULL) && ( (h->Typ()==IDEAL_CMD) \|\| (h->Typ()==MODUL_CMD)))
778	{
779	intvec * componentWeights = (intvec *)atGet(h,"isHomog",INTVEC_CMD); // No copy?!
780	const ideal F = (ideal)h->Data(); ; // No copy!
781	h=h->next;
782
783	int l = 0; // Starting syz-comp (1st: i+1)
784
785	if ((h!=NULL) && (h->Typ()==INT_CMD))
786	{
787	l = (int)((long)(h->Data())); h=h->next;
788	}
789
790	int p = 0; // which IS-block? p^th!
791
792	if ((h!=NULL) && (h->Typ()==INT_CMD))
793	{
794	p = (int)((long)(h->Data())); h=h->next;
795	}
796
797	// F & componentWeights belong to that ordering block of currRing now:
798	rSetISReference(F, l, p, componentWeights, currRing); // F and componentWeights will be copied!
799	}
800	else
801	{
802	WerrorS("`system(\"SetISReferrence\",<ideal/module>, [int, int])` expected");
803	return TRUE;
804	}
805	return FALSE;
806	}
807
808
809
810	////////////////////////////////////////////////////////////////////////
811	/// Additional interface functions to non-commutative subsystem (PLURAL)
812	///
813
814
815	#ifdef HAVE_PLURAL
816	/==================== Approx_Step =================/
817	if (strcmp(sys_cmd, "astep") == 0)
818	{
819	ideal I;
820	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
821	{
822	I=(ideal)h->CopyD();
823	res->rtyp=IDEAL_CMD;
824	if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
825	else res->data=I;
826	setFlag(res,FLAG_STD);
827	}
828	else return TRUE;
829	return FALSE;
830	}
831	/==================== PrintMat =================/
832	if (strcmp(sys_cmd, "PrintMat") == 0)
833	{
834	int a;
835	int b;
836	ring r;
837	int metric;
838	if ((h!=NULL) && (h->Typ()==INT_CMD))
839	{
840	a=(int)((long)(h->Data()));
841	h=h->next;
842	}
843	else if ((h!=NULL) && (h->Typ()==INT_CMD))
844	{
845	b=(int)((long)(h->Data()));
846	h=h->next;
847	}
848	else if ((h!=NULL) && (h->Typ()==RING_CMD))
849	{
850	r=(ring)h->Data();
851	h=h->next;
852	}
853	else
854	return TRUE;
855	if ((h!=NULL) && (h->Typ()==INT_CMD))
856	{
857	metric=(int)((long)(h->Data()));
858	}
859	res->rtyp=MATRIX_CMD;
860	if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
861	else res->data=NULL;
862	return FALSE;
863	}
864	/==================== twostd =================/
865	if (strcmp(sys_cmd, "twostd") == 0)
866	{
867	ideal I;
868	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
869	{
870	I=(ideal)h->CopyD();
871	res->rtyp=IDEAL_CMD;
872	if (rIsPluralRing(currRing)) res->data=twostd(I);
873	else res->data=I;
874	setFlag(res,FLAG_TWOSTD);
875	setFlag(res,FLAG_STD);
876	}
877	else return TRUE;
878	return FALSE;
879	}
880	/==================== lie bracket =================/
881	if (strcmp(sys_cmd, "bracket") == 0)
882	{
883	poly p;
884	poly q;
885	if ((h!=NULL) && (h->Typ()==POLY_CMD))
886	{
887	p=(poly)h->CopyD();
888	h=h->next;
889	}
890	else return TRUE;
891	if ((h!=NULL) && (h->Typ()==POLY_CMD))
892	{
893	q=(poly)h->Data();
894	}
895	else return TRUE;
896	res->rtyp=POLY_CMD;
897	if (rIsPluralRing(currRing)) res->data=nc_p_Bracket_qq(p,q);
898	else res->data=NULL;
899	return FALSE;
900	}
901	if(strcmp(sys_cmd,"NCUseExtensions")==0)
902	{
903
904	if ((h!=NULL) && (h->Typ()==INT_CMD))
905	res->data=(void *)setNCExtensions( (int)((long)(h->Data())) );
906	else
907	res->data=(void *)getNCExtensions();
908
909	res->rtyp=INT_CMD;
910	return FALSE;
911	}
912
913
914	if(strcmp(sys_cmd,"NCGetType")==0)
915	{
916	res->rtyp=INT_CMD;
917
918	if( rIsPluralRing(currRing) )
919	res->data=(void *)ncRingType(currRing);
920	else
921	res->data=(void *)(-1);
922
923	return FALSE;
924	}
925
926
927	if(strcmp(sys_cmd,"ForceSCA")==0)
928	{
929	if( !rIsPluralRing(currRing) )
930	return TRUE;
931
932	int b, e;
933
934	if ((h!=NULL) && (h->Typ()==INT_CMD))
935	{
936	b = (int)((long)(h->Data()));
937	h=h->next;
938	}
939	else return TRUE;
940
941	if ((h!=NULL) && (h->Typ()==INT_CMD))
942	{
943	e = (int)((long)(h->Data()));
944	}
945	else return TRUE;
946
947
948	if( !sca_Force(currRing, b, e) )
949	return TRUE;
950
951	return FALSE;
952	}
953
954	if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
955	{
956	if( !rIsPluralRing(currRing) )
957	return TRUE;
958
959	if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
960	return TRUE;
961
962	return FALSE;
963	}
964
965	if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
966	{
967	if( !rIsPluralRing(currRing) )
968	return TRUE;
969
970	if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
971	return TRUE;
972
973	return FALSE;
974	}
975
976
977
978
979	/==================== PLURAL =================/
980	/==================== opp ==================================/
981	if (strcmp(sys_cmd, "opp")==0)
982	{
983	if ((h!=NULL) && (h->Typ()==RING_CMD))
984	{
985	ring r=(ring)h->Data();
986	res->data=rOpposite(r);
987	res->rtyp=RING_CMD;
988	return FALSE;
989	}
990	else
991	{
992	WerrorS("`system(\"opp\",<ring>)` expected");
993	return TRUE;
994	}
995	}
996	else
997	/==================== env ==================================/
998	if (strcmp(sys_cmd, "env")==0)
999	{
1000	if ((h!=NULL) && (h->Typ()==RING_CMD))
1001	{
1002	ring r = (ring)h->Data();
1003	res->data = rEnvelope(r);
1004	res->rtyp = RING_CMD;
1005	return FALSE;
1006	}
1007	else
1008	{
1009	WerrorS("`system(\"env\",<ring>)` expected");
1010	return TRUE;
1011	}
1012	}
1013	else
1014	/==================== oppose ==================================/
1015	if (strcmp(sys_cmd, "oppose")==0)
1016	{
1017	if ((h!=NULL) && (h->Typ()==RING_CMD)
1018	&& (h->next!= NULL))
1019	{
1020	ring Rop = (ring)h->Data();
1021	h = h->next;
1022	idhdl w;
1023	if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1024	{
1025	poly p = (poly)IDDATA(w);
1026	res->data = pOppose(Rop,p);
1027	res->rtyp = POLY_CMD;
1028	return FALSE;
1029	}
1030	}
1031	else
1032	{
1033	WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1034	return TRUE;
1035	}
1036	}
1037	else
1038	/==================== freeGB, twosided GB in free algebra =================/
1039	#ifdef HAVE_SHIFTBBA
1040	if (strcmp(sys_cmd, "freegb") == 0)
1041	{
1042	ideal I;
1043	int uptodeg, lVblock;
1044	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1045	{
1046	I=(ideal)h->CopyD();
1047	h=h->next;
1048	}
1049	else return TRUE;
1050	if ((h!=NULL) && (h->Typ()==INT_CMD))
1051	{
1052	uptodeg=(int)((long)(h->Data()));
1053	h=h->next;
1054	}
1055	else return TRUE;
1056	if ((h!=NULL) && (h->Typ()==INT_CMD))
1057	{
1058	lVblock=(int)((long)(h->Data()));
1059	res->data = freegb(I,uptodeg,lVblock);
1060	if (res->data == NULL)
1061	{
1062	/* that is there were input errors */
1063	res->data = I;
1064	}
1065	res->rtyp = IDEAL_CMD;
1066	}
1067	else return TRUE;
1068	return FALSE;
1069	}
1070	else
1071	#endif /SHIFTBBA/
1072	#endif /PLURAL/
1073	/==================== walk stuff =================/
1074	#ifdef HAVE_WALK
1075	#ifdef OWNW
1076	if (strcmp(sys_cmd, "walkNextWeight") == 0)
1077	{
1078	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1079	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1080	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1081	{
1082	Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1083	return TRUE;
1084	}
1085
1086	if (((intvec*) h->Data())->length() != currRing->N \|\|
1087	((intvec*) h->next->Data())->length() != currRing->N)
1088	{
1089	Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1090	currRing->N);
1091	return TRUE;
1092	}
1093	res->data = (void) walkNextWeight(((intvec) h->Data()),
1094	((intvec*) h->next->Data()),
1095	(ideal) h->next->next->Data());
1096	if (res->data == (void) 0 \|\| res->data == (void) 1)
1097	{
1098	res->rtyp = INT_CMD;
1099	}
1100	else
1101	{
1102	res->rtyp = INTVEC_CMD;
1103	}
1104	return FALSE;
1105	}
1106	else if (strcmp(sys_cmd, "walkInitials") == 0)
1107	{
1108	if (h == NULL \|\| h->Typ() != IDEAL_CMD)
1109	{
1110	WerrorS("system(\"walkInitials\", ideal) expected");
1111	return TRUE;
1112	}
1113
1114	res->data = (void*) walkInitials((ideal) h->Data());
1115	res->rtyp = IDEAL_CMD;
1116	return FALSE;
1117	}
1118	else
1119	#endif
1120	#ifdef WAIV
1121	if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1122	{
1123	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1124	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD)
1125	{
1126	WerrorS("system(\"walkAddIntVec\", intvec, intvec) expected");
1127	return TRUE;
1128	}
1129	intvec* arg1 = (intvec*) h->Data();
1130	intvec* arg2 = (intvec*) h->next->Data();
1131
1132
1133	res->data = (intvec*) walkAddIntVec(arg1, arg2);
1134	res->rtyp = INTVEC_CMD;
1135	return FALSE;
1136	}
1137	else
1138	#endif
1139	#ifdef MwaklNextWeight
1140	if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1141	{
1142	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1143	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1144	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1145	{
1146	Werror("system(\"MwalkNextWeight\", intvec, intvec, ideal) expected");
1147	return TRUE;
1148	}
1149
1150	if (((intvec*) h->Data())->length() != currRing->N \|\|
1151	((intvec*) h->next->Data())->length() != currRing->N)
1152	{
1153	Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1154	currRing->N);
1155	return TRUE;
1156	}
1157	intvec* arg1 = (intvec*) h->Data();
1158	intvec* arg2 = (intvec*) h->next->Data();
1159	ideal arg3 = (ideal) h->next->next->Data();
1160
1161	intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1162
1163	res->rtyp = INTVEC_CMD;
1164	res->data = result;
1165
1166	return FALSE;
1167	}
1168	else
1169	#endif //MWalkNextWeight
1170	if(strcmp(sys_cmd, "Mivdp") == 0)
1171	{
1172	if (h == NULL \|\| h->Typ() != INT_CMD)
1173	{
1174	Werror("system(\"Mivdp\", int) expected");
1175	return TRUE;
1176	}
1177	if ((int) ((long)(h->Data())) != currRing->N)
1178	{
1179	Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1180	currRing->N);
1181	return TRUE;
1182	}
1183	int arg1 = (int) ((long)(h->Data()));
1184
1185	intvec* result = (intvec*) Mivdp(arg1);
1186
1187	res->rtyp = INTVEC_CMD;
1188	res->data = result;
1189
1190	return FALSE;
1191	}
1192
1193	else if(strcmp(sys_cmd, "Mivlp") == 0)
1194	{
1195	if (h == NULL \|\| h->Typ() != INT_CMD)
1196	{
1197	Werror("system(\"Mivlp\", int) expected");
1198	return TRUE;
1199	}
1200	if ((int) ((long)(h->Data())) != currRing->N)
1201	{
1202	Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1203	currRing->N);
1204	return TRUE;
1205	}
1206	int arg1 = (int) ((long)(h->Data()));
1207
1208	intvec* result = (intvec*) Mivlp(arg1);
1209
1210	res->rtyp = INTVEC_CMD;
1211	res->data = result;
1212
1213	return FALSE;
1214	}
1215	else
1216	#ifdef MpDiv
1217	if(strcmp(sys_cmd, "MpDiv") == 0)
1218	{
1219	if(h==NULL \|\| h->Typ() != POLY_CMD \|\|
1220	h->next == NULL \|\| h->next->Typ() != POLY_CMD)
1221	{
1222	Werror("system(\"MpDiv\",poly, poly) expected");
1223	return TRUE;
1224	}
1225	poly arg1 = (poly) h->Data();
1226	poly arg2 = (poly) h->next->Data();
1227
1228	poly result = MpDiv(arg1, arg2);
1229
1230	res->rtyp = POLY_CMD;
1231	res->data = result;
1232	return FALSE;
1233	}
1234	else
1235	#endif
1236	#ifdef MpMult
1237	if(strcmp(sys_cmd, "MpMult") == 0)
1238	{
1239	if(h==NULL \|\| h->Typ() != POLY_CMD \|\|
1240	h->next == NULL \|\| h->next->Typ() != POLY_CMD)
1241	{
1242	Werror("system(\"MpMult\",poly, poly) expected");
1243	return TRUE;
1244	}
1245	poly arg1 = (poly) h->Data();
1246	poly arg2 = (poly) h->next->Data();
1247
1248	poly result = MpMult(arg1, arg2);
1249	res->rtyp = POLY_CMD;
1250	res->data = result;
1251	return FALSE;
1252	}
1253	else
1254	#endif
1255	if (strcmp(sys_cmd, "MivSame") == 0)
1256	{
1257	if(h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1258	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD )
1259	{
1260	Werror("system(\"MivSame\", intvec, intvec) expected");
1261	return TRUE;
1262	}
1263	/*
1264	if (((intvec*) h->Data())->length() != currRing->N \|\|
1265	((intvec*) h->next->Data())->length() != currRing->N)
1266	{
1267	Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1268	currRing->N);
1269	return TRUE;
1270	}
1271	*/
1272	intvec* arg1 = (intvec*) h->Data();
1273	intvec* arg2 = (intvec*) h->next->Data();
1274	/*
1275	poly result = (poly) MivSame(arg1, arg2);
1276
1277	res->rtyp = POLY_CMD;
1278	res->data = (poly) result;
1279	*/
1280	res->rtyp = INT_CMD;
1281	res->data = (void*)(long) MivSame(arg1, arg2);
1282	return FALSE;
1283	}
1284	else
1285	if (strcmp(sys_cmd, "M3ivSame") == 0)
1286	{
1287	if(h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1288	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1289	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD )
1290	{
1291	Werror("system(\"M3ivSame\", intvec, intvec, intvec) expected");
1292	return TRUE;
1293	}
1294	/*
1295	if (((intvec*) h->Data())->length() != currRing->N \|\|
1296	((intvec*) h->next->Data())->length() != currRing->N \|\|
1297	((intvec*) h->next->next->Data())->length() != currRing->N )
1298	{
1299	Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1300	currRing->N);
1301	return TRUE;
1302	}
1303	*/
1304	intvec* arg1 = (intvec*) h->Data();
1305	intvec* arg2 = (intvec*) h->next->Data();
1306	intvec* arg3 = (intvec*) h->next->next->Data();
1307	/*
1308	poly result = (poly) M3ivSame(arg1, arg2, arg3);
1309
1310	res->rtyp = POLY_CMD;
1311	res->data = (poly) result;
1312	*/
1313	res->rtyp = INT_CMD;
1314	res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1315	return FALSE;
1316	}
1317	else
1318	if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1319	{
1320	if(h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1321	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD)
1322	{
1323	Werror("system(\"MwalkInitialForm\", ideal, intvec) expected");
1324	return TRUE;
1325	}
1326	if(((intvec*) h->next->Data())->length() != currRing->N)
1327	{
1328	Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1329	currRing->N);
1330	return TRUE;
1331	}
1332	ideal id = (ideal) h->Data();
1333	intvec* int_w = (intvec*) h->next->Data();
1334	ideal result = (ideal) MwalkInitialForm(id, int_w);
1335
1336	res->rtyp = IDEAL_CMD;
1337	res->data = result;
1338	return FALSE;
1339	}
1340	else
1341	/************ Perturbation walk ********/
1342	if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1343	{
1344	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1345	{
1346	Werror("system(\"MivMatrixOrder\",intvec) expected");
1347	return TRUE;
1348	}
1349	intvec* arg1 = (intvec*) h->Data();
1350
1351	intvec* result = MivMatrixOrder(arg1);
1352
1353	res->rtyp = INTVEC_CMD;
1354	res->data = result;
1355	return FALSE;
1356	}
1357	else
1358	if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1359	{
1360	if(h==NULL \|\| h->Typ() != INT_CMD)
1361	{
1362	Werror("system(\"MivMatrixOrderdp\",intvec) expected");
1363	return TRUE;
1364	}
1365	int arg1 = (int) ((long)(h->Data()));
1366
1367	intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1368
1369	res->rtyp = INTVEC_CMD;
1370	res->data = result;
1371	return FALSE;
1372	}
1373	else
1374	if(strcmp(sys_cmd, "MPertVectors") == 0)
1375	{
1376
1377	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1378	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1379	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1380	{
1381	Werror("system(\"MPertVectors\",ideal, intvec, int) expected");
1382	return TRUE;
1383	}
1384
1385	ideal arg1 = (ideal) h->Data();
1386	intvec* arg2 = (intvec*) h->next->Data();
1387	int arg3 = (int) ((long)(h->next->next->Data()));
1388
1389	intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1390
1391	res->rtyp = INTVEC_CMD;
1392	res->data = result;
1393	return FALSE;
1394	}
1395	else
1396	if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1397	{
1398
1399	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1400	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1401	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1402	{
1403	Werror("system(\"MPertVectorslp\",ideal, intvec, int) expected");
1404	return TRUE;
1405	}
1406
1407	ideal arg1 = (ideal) h->Data();
1408	intvec* arg2 = (intvec*) h->next->Data();
1409	int arg3 = (int) ((long)(h->next->next->Data()));
1410
1411	intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1412
1413	res->rtyp = INTVEC_CMD;
1414	res->data = result;
1415	return FALSE;
1416	}
1417	/************ fractal walk ********/
1418	else
1419	if(strcmp(sys_cmd, "Mfpertvector") == 0)
1420	{
1421	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1422	h->next==NULL \|\| h->next->Typ() != INTVEC_CMD )
1423	{
1424	Werror("system(\"Mfpertvector\", ideal,intvec) expected");
1425	return TRUE;
1426	}
1427	ideal arg1 = (ideal) h->Data();
1428	intvec* arg2 = (intvec*) h->next->Data();
1429	intvec* result = Mfpertvector(arg1, arg2);
1430
1431	res->rtyp = INTVEC_CMD;
1432	res->data = result;
1433	return FALSE;
1434	}
1435	else
1436	if(strcmp(sys_cmd, "MivUnit") == 0)
1437	{
1438	int arg1 = (int) ((long)(h->Data()));
1439
1440	intvec* result = (intvec*) MivUnit(arg1);
1441
1442	res->rtyp = INTVEC_CMD;
1443	res->data = result;
1444	return FALSE;
1445	}
1446	else
1447	if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1448	{
1449	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1450	{
1451	Werror("system(\"MivWeightOrderlp\",intvec) expected");
1452	return TRUE;
1453	}
1454	intvec* arg1 = (intvec*) h->Data();
1455	intvec* result = MivWeightOrderlp(arg1);
1456
1457	res->rtyp = INTVEC_CMD;
1458	res->data = result;
1459	return FALSE;
1460	}
1461	else
1462	if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1463	{
1464	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1465	{
1466	Werror("system(\"MivWeightOrderdp\",intvec) expected");
1467	return TRUE;
1468	}
1469	intvec* arg1 = (intvec*) h->Data();
1470	//int arg2 = (int) h->next->Data();
1471
1472	intvec* result = MivWeightOrderdp(arg1);
1473
1474	res->rtyp = INTVEC_CMD;
1475	res->data = result;
1476	return FALSE;
1477	}
1478	else
1479	if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1480	{
1481	if(h==NULL \|\| h->Typ() != INT_CMD)
1482	{
1483	Werror("system(\"MivMatrixOrderlp\",int) expected");
1484	return TRUE;
1485	}
1486	int arg1 = (int) ((long)(h->Data()));
1487
1488	intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1489
1490	res->rtyp = INTVEC_CMD;
1491	res->data = result;
1492	return FALSE;
1493	}
1494	else
1495	if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1496	{
1497	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1498	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1499	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1500	{
1501	Werror("system(\"MkInterRedNextWeight\", intvec, intvec, ideal) expected");
1502	return TRUE;
1503	}
1504
1505	if (((intvec*) h->Data())->length() != currRing->N \|\|
1506	((intvec*) h->next->Data())->length() != currRing->N)
1507	{
1508	Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1509	currRing->N);
1510	return TRUE;
1511	}
1512	intvec* arg1 = (intvec*) h->Data();
1513	intvec* arg2 = (intvec*) h->next->Data();
1514	ideal arg3 = (ideal) h->next->next->Data();
1515
1516	intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1517
1518	res->rtyp = INTVEC_CMD;
1519	res->data = result;
1520
1521	return FALSE;
1522	}
1523	else
1524	#ifdef MPertNextWeight
1525	if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1526	{
1527	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1528	h->next == NULL \|\| h->next->Typ() != IDEAL_CMD \|\|
1529	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1530	{
1531	Werror("system(\"MPertNextWeight\", intvec, ideal, int) expected");
1532	return TRUE;
1533	}
1534
1535	if (((intvec*) h->Data())->length() != currRing->N)
1536	{
1537	Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1538	currRing->N);
1539	return TRUE;
1540	}
1541	intvec* arg1 = (intvec*) h->Data();
1542	ideal arg2 = (ideal) h->next->Data();
1543	int arg3 = (int) h->next->next->Data();
1544
1545	intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1546
1547	res->rtyp = INTVEC_CMD;
1548	res->data = result;
1549
1550	return FALSE;
1551	}
1552	else
1553	#endif //MPertNextWeight
1554	#ifdef Mivperttarget
1555	if (strcmp(sys_cmd, "Mivperttarget") == 0)
1556	{
1557	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1558	h->next == NULL \|\| h->next->Typ() != INT_CMD )
1559	{
1560	Werror("system(\"Mivperttarget\", ideal, int) expected");
1561	return TRUE;
1562	}
1563
1564	ideal arg1 = (ideal) h->Data();
1565	int arg2 = (int) h->next->Data();
1566
1567	intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1568
1569	res->rtyp = INTVEC_CMD;
1570	res->data = result;
1571
1572	return FALSE;
1573	}
1574	else
1575	#endif //Mivperttarget
1576	if (strcmp(sys_cmd, "Mwalk") == 0)
1577	{
1578	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1579	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1580	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1581	{
1582	Werror("system(\"Mwalk\", ideal, intvec, intvec) expected");
1583	return TRUE;
1584	}
1585
1586	if (((intvec*) h->next->Data())->length() != currRing->N &&
1587	((intvec*) h->next->next->Data())->length() != currRing->N )
1588	{
1589	Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1590	currRing->N);
1591	return TRUE;
1592	}
1593	ideal arg1 = (ideal) h->Data();
1594	intvec* arg2 = (intvec*) h->next->Data();
1595	intvec* arg3 = (intvec*) h->next->next->Data();
1596
1597
1598	ideal result = (ideal) Mwalk(arg1, arg2, arg3);
1599
1600	res->rtyp = IDEAL_CMD;
1601	res->data = result;
1602
1603	return FALSE;
1604	}
1605	else
1606	#ifdef MPWALK_ORIG
1607	if (strcmp(sys_cmd, "Mpwalk") == 0)
1608	{
1609	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1610	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1611	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1612	h->next->next->next == NULL \|\|
1613	h->next->next->next->Typ() != INTVEC_CMD \|\|
1614	h->next->next->next->next == NULL \|\|
1615	h->next->next->next->next->Typ() != INTVEC_CMD)
1616	{
1617	Werror("system(\"Mpwalk\", ideal, int, int, intvec, intvec) expected");
1618	return TRUE;
1619	}
1620
1621	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1622	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1623	{
1624	Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",
1625	currRing->N);
1626	return TRUE;
1627	}
1628	ideal arg1 = (ideal) h->Data();
1629	int arg2 = (int) h->next->Data();
1630	int arg3 = (int) h->next->next->Data();
1631	intvec* arg4 = (intvec*) h->next->next->next->Data();
1632	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1633
1634
1635	ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5);
1636
1637	res->rtyp = IDEAL_CMD;
1638	res->data = result;
1639
1640	return FALSE;
1641	}
1642	else
1643	#endif
1644	if (strcmp(sys_cmd, "Mpwalk") == 0)
1645	{
1646	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1647	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1648	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1649	h->next->next->next == NULL \|\|
1650	h->next->next->next->Typ() != INTVEC_CMD \|\|
1651	h->next->next->next->next == NULL \|\|
1652	h->next->next->next->next->Typ() != INTVEC_CMD\|\|
1653	h->next->next->next->next->next == NULL \|\|
1654	h->next->next->next->next->next->Typ() != INT_CMD)
1655	{
1656	Werror("system(\"Mpwalk\", ideal, int, int, intvec, intvec, int) expected");
1657	return TRUE;
1658	}
1659
1660	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1661	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1662	{
1663	Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",
1664	currRing->N);
1665	return TRUE;
1666	}
1667	ideal arg1 = (ideal) h->Data();
1668	int arg2 = (int) ((long)(h->next->Data()));
1669	int arg3 = (int) ((long)(h->next->next->Data()));
1670	intvec* arg4 = (intvec*) h->next->next->next->Data();
1671	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1672	int arg6 = (int) ((long)(h->next->next->next->next->next->Data()));
1673
1674
1675	ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1676
1677	res->rtyp = IDEAL_CMD;
1678	res->data = result;
1679
1680	return FALSE;
1681	}
1682	else
1683	if (strcmp(sys_cmd, "MAltwalk1") == 0)
1684	{
1685	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1686	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1687	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1688	h->next->next->next == NULL \|\|
1689	h->next->next->next->Typ() != INTVEC_CMD \|\|
1690	h->next->next->next->next == NULL \|\|
1691	h->next->next->next->next->Typ() != INTVEC_CMD)
1692	{
1693	Werror("system(\"MAltwalk1\", ideal, int, int, intvec, intvec) expected");
1694	return TRUE;
1695	}
1696
1697	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1698	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1699	{
1700	Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
1701	currRing->N);
1702	return TRUE;
1703	}
1704	ideal arg1 = (ideal) h->Data();
1705	int arg2 = (int) ((long)(h->next->Data()));
1706	int arg3 = (int) ((long)(h->next->next->Data()));
1707	intvec* arg4 = (intvec*) h->next->next->next->Data();
1708	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1709
1710
1711	ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
1712
1713	res->rtyp = IDEAL_CMD;
1714	res->data = result;
1715
1716	return FALSE;
1717	}
1718	#ifdef MFWALK_ALT
1719	else
1720	if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
1721	{
1722	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1723	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1724	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD \|\|
1725	h->next->next->next == NULL \|\| h->next->next->next->Typ() !=INT_CMD)
1726	{
1727	Werror("system(\"Mfwalk\", ideal, intvec, intvec,int) expected");
1728	return TRUE;
1729	}
1730
1731	if (((intvec*) h->next->Data())->length() != currRing->N &&
1732	((intvec*) h->next->next->Data())->length() != currRing->N )
1733	{
1734	Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
1735	currRing->N);
1736	return TRUE;
1737	}
1738	ideal arg1 = (ideal) h->Data();
1739	intvec* arg2 = (intvec*) h->next->Data();
1740	intvec* arg3 = (intvec*) h->next->next->Data();
1741	int arg4 = (int) h->next->next->next->Data();
1742
1743	ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
1744
1745	res->rtyp = IDEAL_CMD;
1746	res->data = result;
1747
1748	return FALSE;
1749	}
1750	#endif
1751	else
1752	if (strcmp(sys_cmd, "Mfwalk") == 0)
1753	{
1754	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1755	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1756	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1757	{
1758	Werror("system(\"Mfwalk\", ideal, intvec, intvec) expected");
1759	return TRUE;
1760	}
1761
1762	if (((intvec*) h->next->Data())->length() != currRing->N &&
1763	((intvec*) h->next->next->Data())->length() != currRing->N )
1764	{
1765	Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
1766	currRing->N);
1767	return TRUE;
1768	}
1769	ideal arg1 = (ideal) h->Data();
1770	intvec* arg2 = (intvec*) h->next->Data();
1771	intvec* arg3 = (intvec*) h->next->next->Data();
1772
1773	ideal result = (ideal) Mfwalk(arg1, arg2, arg3);
1774
1775	res->rtyp = IDEAL_CMD;
1776	res->data = result;
1777
1778	return FALSE;
1779	}
1780	else
1781
1782	#ifdef TRAN_Orig
1783	if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
1784	{
1785	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1786	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1787	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1788	{
1789	Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec) expected");
1790	return TRUE;
1791	}
1792
1793	if (((intvec*) h->next->Data())->length() != currRing->N &&
1794	((intvec*) h->next->next->Data())->length() != currRing->N )
1795	{
1796	Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
1797	currRing->N);
1798	return TRUE;
1799	}
1800	ideal arg1 = (ideal) h->Data();
1801	intvec* arg2 = (intvec*) h->next->Data();
1802	intvec* arg3 = (intvec*) h->next->next->Data();
1803
1804
1805	ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
1806
1807	res->rtyp = IDEAL_CMD;
1808	res->data = result;
1809
1810	return FALSE;
1811	}
1812	else
1813	#endif
1814	if (strcmp(sys_cmd, "MAltwalk2") == 0)
1815	{
1816	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1817	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1818	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1819	{
1820	Werror("system(\"MAltwalk2\", ideal, intvec, intvec) expected");
1821	return TRUE;
1822	}
1823
1824	if (((intvec*) h->next->Data())->length() != currRing->N &&
1825	((intvec*) h->next->next->Data())->length() != currRing->N )
1826	{
1827	Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
1828	currRing->N);
1829	return TRUE;
1830	}
1831	ideal arg1 = (ideal) h->Data();
1832	intvec* arg2 = (intvec*) h->next->Data();
1833	intvec* arg3 = (intvec*) h->next->next->Data();
1834
1835
1836	ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
1837
1838	res->rtyp = IDEAL_CMD;
1839	res->data = result;
1840
1841	return FALSE;
1842	}
1843	else
1844	if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
1845	{
1846	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1847	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1848	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD\|\|
1849	h->next->next->next == NULL \|\| h->next->next->next->Typ() != INT_CMD)
1850	{
1851	Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec, int) expected");
1852	return TRUE;
1853	}
1854
1855	if (((intvec*) h->next->Data())->length() != currRing->N &&
1856	((intvec*) h->next->next->Data())->length() != currRing->N )
1857	{
1858	Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
1859	currRing->N);
1860	return TRUE;
1861	}
1862	ideal arg1 = (ideal) h->Data();
1863	intvec* arg2 = (intvec*) h->next->Data();
1864	intvec* arg3 = (intvec*) h->next->next->Data();
1865	int arg4 = (int) ((long)(h->next->next->next->Data()));
1866
1867	ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
1868
1869	res->rtyp = IDEAL_CMD;
1870	res->data = result;
1871
1872	return FALSE;
1873	}
1874	else
1875	#endif
1876	/================= Extended system call ========================/
1877	{
1878	#ifndef MAKE_DISTRIBUTION
1879	return(jjEXTENDED_SYSTEM(res, args));
1880	#else
1881	Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1882	#endif
1883	}
1884	} /* typ==string */
1885	return TRUE;
1886	}
1887
1888
1889	#ifdef HAVE_EXTENDED_SYSTEM
1890	// You can put your own system calls here
1891	#include "../kernel/fglmcomb.cc"
1892	#include "fglm.h"
1893	#ifdef HAVE_NEWTON
1894	#include <hc_newton.h>
1895	#endif
1896	#include "mpsr.h"
1897	#include "mod_raw.h"
1898	#include "ratgring.h"
1899	#include "shiftgb.h"
1900
1901	static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
1902	{
1903	if(h->Typ() == STRING_CMD)
1904	{
1905	char sys_cmd=(char )(h->Data());
1906	h=h->next;
1907	/==================== test syz strat =================/
1908	if (strcmp(sys_cmd, "syz") == 0)
1909	{
1910	int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p);
1911	int posInT_FDegpLength(const TSet set,const int length,LObject &p);
1912	int posInT_pLength(const TSet set,const int length,LObject &p);
1913	int posInT0(const TSet set,const int length,LObject &p);
1914	int posInT1(const TSet set,const int length,LObject &p);
1915	int posInT2(const TSet set,const int length,LObject &p);
1916	int posInT11(const TSet set,const int length,LObject &p);
1917	int posInT110(const TSet set,const int length,LObject &p);
1918	int posInT13(const TSet set,const int length,LObject &p);
1919	int posInT15(const TSet set,const int length,LObject &p);
1920	int posInT17(const TSet set,const int length,LObject &p);
1921	int posInT17_c(const TSet set,const int length,LObject &p);
1922	int posInT19(const TSet set,const int length,LObject &p);
1923	if ((h!=NULL) && (h->Typ()==STRING_CMD))
1924	{
1925	const char s=(const char )h->Data();
1926	if (strcmp(s,"posInT_EcartFDegpLength")==0)
1927	test_PosInT=posInT_EcartFDegpLength;
1928	else if (strcmp(s,"posInT_FDegpLength")==0)
1929	test_PosInT=posInT_FDegpLength;
1930	else if (strcmp(s,"posInT_pLength")==0)
1931	test_PosInT=posInT_pLength;
1932	else if (strcmp(s,"posInT0")==0)
1933	test_PosInT=posInT0;
1934	else if (strcmp(s,"posInT1")==0)
1935	test_PosInT=posInT1;
1936	else if (strcmp(s,"posInT2")==0)
1937	test_PosInT=posInT2;
1938	else if (strcmp(s,"posInT11")==0)
1939	test_PosInT=posInT11;
1940	else if (strcmp(s,"posInT110")==0)
1941	test_PosInT=posInT110;
1942	else if (strcmp(s,"posInT13")==0)
1943	test_PosInT=posInT13;
1944	else if (strcmp(s,"posInT15")==0)
1945	test_PosInT=posInT15;
1946	else if (strcmp(s,"posInT17")==0)
1947	test_PosInT=posInT17;
1948	else if (strcmp(s,"posInT17_c")==0)
1949	test_PosInT=posInT17_c;
1950	else if (strcmp(s,"posInT19")==0)
1951	test_PosInT=posInT19;
1952	else Print("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
1953	}
1954	else
1955	{
1956	test_PosInT=NULL;
1957	test_PosInL=NULL;
1958	}
1959	verbose\|=Sy_bit(23);
1960	return FALSE;
1961	}
1962	else
1963	/==================== locNF ======================================/
1964	if(strcmp(sys_cmd,"locNF")==0)
1965	{
1966	if (h != NULL && h->Typ() == VECTOR_CMD)
1967	{
1968	poly f=(poly)h->Data();
1969	h=h->next;
1970	if (h != NULL && h->Typ() == MODUL_CMD)
1971	{
1972	ideal m=(ideal)h->Data();
1973	assumeStdFlag(h);
1974	h=h->next;
1975	if (h != NULL && h->Typ() == INT_CMD)
1976	{
1977	int n=(int)((long)h->Data());
1978	h=h->next;
1979	if (h != NULL && h->Typ() == INTVEC_CMD)
1980	{
1981	intvec v=(intvec )h->Data();
1982
1983	/* == now the work starts == */
1984
1985	short * iv=iv2array(v);
1986	poly r=0;
1987	poly hp=ppJetW(f,n,iv);
1988	int s=MATCOLS(m);
1989	int j=0;
1990	matrix T=mpInitI(s,1,0);
1991
1992	while (hp != NULL)
1993	{
1994	if (pDivisibleBy(m->m[j],hp))
1995	{
1996	if (MATELEM(T,j+1,1)==0)
1997	{
1998	MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
1999	}
2000	else
2001	{
2002	pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2003	}
2004	hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2005	j=0;
2006	}
2007	else
2008	{
2009	if (j==s-1)
2010	{
2011	r=pAdd(r,pHead(hp));
2012	hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2013	j=0;
2014	}
2015	else
2016	{
2017	j++;
2018	}
2019	}
2020	}
2021
2022	matrix Temp=mpTransp((matrix) idVec2Ideal(r));
2023	matrix R=mpNew(MATCOLS((matrix) idVec2Ideal(f)),1);
2024	for (int k=1;k<=MATROWS(Temp);k++)
2025	{
2026	MATELEM(R,k,1)=MATELEM(Temp,k,1);
2027	}
2028
2029	lists L=(lists)omAllocBin(slists_bin);
2030	L->Init(2);
2031	L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
2032	L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
2033	res->data=L;
2034	res->rtyp=LIST_CMD;
2035	// iv aufraeumen
2036	omFree(iv);
2037	}
2038	else
2039	{
2040	Warn ("4th argument: must be an intvec!");
2041	}
2042	}
2043	else
2044	{
2045	Warn("3rd argument must be an int!!");
2046	}
2047	}
2048	else
2049	{
2050	Warn("2nd argument must be a module!");
2051	}
2052	}
2053	else
2054	{
2055	Warn("1st argument must be a vector!");
2056	}
2057	return FALSE;
2058	}
2059	else
2060	/==================== poly debug ==================================/
2061	if(strcmp(sys_cmd,"p")==0)
2062	{
2063	#ifdef RDEBUG
2064	pDebugPrint((poly)h->Data());
2065	#endif
2066	return FALSE;
2067	}
2068	else
2069	/==================== ring debug ==================================/
2070	if(strcmp(sys_cmd,"r")==0)
2071	{
2072	#ifdef RDEBUG
2073	rDebugPrint((ring)h->Data());
2074	#endif
2075	return FALSE;
2076	}
2077	/==================== generic debug ==================================/
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	} else
2106	/==================== mtrack ==================================/
2107	if(strcmp(sys_cmd,"mtrack")==0)
2108	{
2109	#ifdef OM_TRACK
2110	om_Opts.MarkAsStatic = 1;
2111	FILE *fd = NULL;
2112	int max = 5;
2113	while (h != NULL)
2114	{
2115	omMarkAsStaticAddr(h);
2116	if (fd == NULL && h->Typ()==STRING_CMD)
2117	{
2118	fd = fopen((char*) h->Data(), "w");
2119	if (fd == NULL)
2120	Warn("Can not open %s for writing og mtrack. Using stdout");
2121	}
2122	if (h->Typ() == INT_CMD)
2123	{
2124	max = (int)(long)h->Data();
2125	}
2126	h = h->Next();
2127	}
2128	omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2129	if (fd != NULL) fclose(fd);
2130	om_Opts.MarkAsStatic = 0;
2131	return FALSE;
2132	#else
2133	WerrorS("mtrack not supported without OM_TRACK");
2134	return TRUE;
2135	#endif
2136	}
2137	/==================== mtrack_all ==================================/
2138	if(strcmp(sys_cmd,"mtrack_all")==0)
2139	{
2140	#ifdef OM_TRACK
2141	om_Opts.MarkAsStatic = 1;
2142	FILE *fd = NULL;
2143	if ((h!=NULL) &&(h->Typ()==STRING_CMD))
2144	{
2145	fd = fopen((char*) h->Data(), "w");
2146	if (fd == NULL)
2147	Warn("Can not open %s for writing og mtrack. Using stdout");
2148	omMarkAsStaticAddr(h);
2149	}
2150	// OB: TBC print to fd
2151	omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
2152	if (fd != NULL) fclose(fd);
2153	om_Opts.MarkAsStatic = 0;
2154	return FALSE;
2155	#else
2156	WerrorS("mtrack not supported without OM_TRACK");
2157	return TRUE;
2158	#endif
2159	}
2160	else
2161	/==================== backtrace ==================================/
2162	if(strcmp(sys_cmd,"backtrace")==0)
2163	{
2164	#ifndef OM_NDEBUG
2165	omPrintCurrentBackTrace(stdout);
2166	return FALSE;
2167	#else
2168	WerrorS("btrack not supported without OM_TRACK");
2169	return TRUE;
2170	#endif
2171	}
2172	else
2173	/==================== naIdeal ==================================/
2174	if(strcmp(sys_cmd,"naIdeal")==0)
2175	{
2176	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2177	{
2178	naSetIdeal((ideal)h->Data());
2179	return FALSE;
2180	}
2181	else
2182	WerrorS("ideal expected");
2183	}
2184	else
2185	/==================== isSqrFree =============================/
2186	#ifdef HAVE_FACTORY
2187	if(strcmp(sys_cmd,"isSqrFree")==0)
2188	{
2189	if ((h!=NULL) &&(h->Typ()==POLY_CMD))
2190	{
2191	res->rtyp=INT_CMD;
2192	res->data=(void *)(long) singclap_isSqrFree((poly)h->Data());
2193	return FALSE;
2194	}
2195	else
2196	WerrorS("poly expected");
2197	}
2198	else
2199	#endif
2200	/==================== pDivStat =============================/
2201	#if defined(PDEBUG) \|\| defined(PDIV_DEBUG)
2202	if(strcmp(sys_cmd,"pDivStat")==0)
2203	{
2204	extern void pPrintDivisbleByStat();
2205	pPrintDivisbleByStat();
2206	return FALSE;
2207	}
2208	else
2209	#endif
2210	/==================== alarm ==================================/
2211	#ifdef unix
2212	if(strcmp(sys_cmd,"alarm")==0)
2213	{
2214	if ((h!=NULL) &&(h->Typ()==INT_CMD))
2215	{
2216	// standard variant -> SIGALARM (standard: abort)
2217	//alarm((unsigned)h->next->Data());
2218	// process time (user +system): SIGVTALARM
2219	struct itimerval t,o;
2220	memset(&t,0,sizeof(t));
2221	t.it_value.tv_sec =(unsigned)((unsigned long)h->Data());
2222	setitimer(ITIMER_VIRTUAL,&t,&o);
2223	return FALSE;
2224	}
2225	else
2226	WerrorS("int expected");
2227	}
2228	else
2229	#endif
2230	/==================== red =============================/
2231	#if 0
2232	if(strcmp(sys_cmd,"red")==0)
2233	{
2234	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2235	{
2236	res->rtyp=IDEAL_CMD;
2237	res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2238	setFlag(res,FLAG_STD);
2239	return FALSE;
2240	}
2241	else
2242	WerrorS("ideal expected");
2243	}
2244	else
2245	#endif
2246	#ifdef HAVE_FACTORY
2247	/==================== fastcomb =============================/
2248	if(strcmp(sys_cmd,"fastcomb")==0)
2249	{
2250	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2251	{
2252	int i=0;
2253	if (h->next!=NULL)
2254	{
2255	if (h->next->Typ()!=POLY_CMD)
2256	{
2257	Warn("Wrong types for poly= comb(ideal,poly)");
2258	}
2259	}
2260	res->rtyp=POLY_CMD;
2261	res->data=(void *) fglmLinearCombination(
2262	(ideal)h->Data(),(poly)h->next->Data());
2263	return FALSE;
2264	}
2265	else
2266	WerrorS("ideal expected");
2267	}
2268	else
2269	/==================== comb =============================/
2270	if(strcmp(sys_cmd,"comb")==0)
2271	{
2272	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2273	{
2274	int i=0;
2275	if (h->next!=NULL)
2276	{
2277	if (h->next->Typ()!=POLY_CMD)
2278	{
2279	Warn("Wrong types for poly= comb(ideal,poly)");
2280	}
2281	}
2282	res->rtyp=POLY_CMD;
2283	res->data=(void *)fglmNewLinearCombination(
2284	(ideal)h->Data(),(poly)h->next->Data());
2285	return FALSE;
2286	}
2287	else
2288	WerrorS("ideal expected");
2289	}
2290	else
2291	#endif
2292	#ifdef FACTORY_GCD_TEST
2293	/=======================gcd Testerei ================================/
2294	if ( ! strcmp( sys_cmd, "setgcd" ) ) {
2295	if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
2296	CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
2297	return FALSE;
2298	} else
2299	WerrorS("int expected");
2300	}
2301	else
2302	#endif
2303
2304	#ifdef FACTORY_GCD_TIMING
2305	if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
2306	TIMING_PRINT( contentTimer, "time used for content: " );
2307	TIMING_PRINT( algContentTimer, "time used for algContent: " );
2308	TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
2309	TIMING_RESET( contentTimer );
2310	TIMING_RESET( algContentTimer );
2311	TIMING_RESET( algLcmTimer );
2312	return FALSE;
2313	}
2314	else
2315	#endif
2316
2317	#ifdef FACTORY_GCD_STAT
2318	if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
2319	printGcdTotal();
2320	printContTotal();
2321	resetGcdTotal();
2322	resetContTotal();
2323	return FALSE;
2324	}
2325	else
2326	#endif
2327	#if !defined(HAVE_NS)
2328	/==================== lib ==================================/
2329	if(strcmp(sys_cmd,"LIB")==0)
2330	{
2331	idhdl hh=idroot->get((char*)h->Data(),0);
2332	if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
2333	{
2334	res->rtyp=STRING_CMD;
2335	char *r=iiGetLibName(IDPROC(hh));
2336	if (r==NULL) r="";
2337	res->data=omStrDup(r);
2338	return FALSE;
2339	}
2340	else
2341	Warn("`%s` not found",(char*)h->Data());
2342	}
2343	else
2344	#endif
2345	/==================== listall ===================================/
2346	if(strcmp(sys_cmd,"listall")==0)
2347	{
2348	int showproc=0;
2349	if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2350	#ifdef HAVE_NS
2351	listall(showproc);
2352	#else
2353	idhdl hh=IDROOT;
2354	while (hh!=NULL)
2355	{
2356	if (IDDATA(hh)==(void *)currRing) PrintS("(R)");
2357	else PrintS(" ");
2358	Print("::%s, typ %s level %d\n",
2359	IDID(hh),Tok2Cmdname(IDTYP(hh)),IDLEV(hh));
2360	hh=IDNEXT(hh);
2361	}
2362	hh=IDROOT;
2363	while (hh!=NULL)
2364	{
2365	if ((IDTYP(hh)==RING_CMD)
2366	\|\| (IDTYP(hh)==QRING_CMD)
2367	\|\| (IDTYP(hh)==PACKAGE_CMD))
2368	{
2369	idhdl h2=IDRING(hh)->idroot;
2370	while (h2!=NULL)
2371	{
2372	if (IDDATA(h2)==(void *)currRing) PrintS("(R)");
2373	else PrintS(" ");
2374	Print("%s::%s, typ %s level %d\n",
2375	IDID(hh),IDID(h2),Tok2Cmdname(IDTYP(h2)),IDLEV(h2));
2376	h2=IDNEXT(h2);
2377	}
2378	}
2379	hh=IDNEXT(hh);
2380	}
2381	#endif /* HAVE_NS */
2382	return FALSE;
2383	}
2384	else
2385	/==================== proclist =================================/
2386	if(strcmp(sys_cmd,"proclist")==0)
2387	{
2388	piShowProcList();
2389	return FALSE;
2390	}
2391	else
2392	/* ==================== newton ================================*/
2393	#ifdef HAVE_NEWTON
2394	if(strcmp(sys_cmd,"newton")==0)
2395	{
2396	if ((h->Typ()!=POLY_CMD)
2397	\|\| (h->next->Typ()!=INT_CMD)
2398	\|\| (h->next->next->Typ()!=INT_CMD))
2399	{
2400	WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2401	return TRUE;
2402	}
2403	poly p=(poly)(h->Data());
2404	int l=pLength(p);
2405	short points=(short )omAlloc(currRing->Nlsizeof(short));
2406	int i,j,k;
2407	k=0;
2408	poly pp=p;
2409	for (i=0;pp!=NULL;i++)
2410	{
2411	for(j=1;j<=currRing->N;j++)
2412	{
2413	points[k]=pGetExp(pp,j);
2414	k++;
2415	}
2416	pIter(pp);
2417	}
2418	hc_ERG r=hc_KOENIG(currRing->N, // dimension
2419	l, // number of points
2420	(short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2421	currRing->OrdSgn==-1,
2422	(int) (h->next->Data()), // 1: Milnor, 0: Newton
2423	(int) (h->next->next->Data()) // debug
2424	);
2425	//----<>---Output-----------------------
2426
2427
2428	// PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2429
2430
2431	lists L=(lists)omAllocBin(slists_bin);
2432	L->Init(6);
2433	L->m[0].rtyp=STRING_CMD; // newtonnumber;
2434	L->m[0].data=(void *)omStrDup(r.nZahl);
2435	L->m[1].rtyp=INT_CMD;
2436	L->m[1].data=(void *)r.achse; // flag for unoccupied axes
2437	L->m[2].rtyp=INT_CMD;
2438	L->m[2].data=(void *)r.deg; // #degenerations
2439	if ( r.deg != 0) // only if degenerations exist
2440	{
2441	L->m[3].rtyp=INT_CMD;
2442	L->m[3].data=(void *)r.anz_punkte; // #points
2443	//---<>--number of points------
2444	int anz = r.anz_punkte; // number of points
2445	int dim = (currRing->N); // dimension
2446	intvec* v = new intvec( anz*dim );
2447	for (i=0; i<anz*dim; i++) // copy points
2448	(*v)[i] = r.pu[i];
2449	L->m[4].rtyp=INTVEC_CMD;
2450	L->m[4].data=(void *)v;
2451	//---<>--degenerations---------
2452	int deg = r.deg; // number of points
2453	intvec* w = new intvec( r.speicher ); // necessary memeory
2454	i=0; // start copying
2455	do
2456	{
2457	(*w)[i] = r.deg_tab[i];
2458	i++;
2459	}
2460	while (r.deg_tab[i-1] != -2); // mark for end of list
2461	L->m[5].rtyp=INTVEC_CMD;
2462	L->m[5].data=(void *)w;
2463	}
2464	else
2465	{
2466	L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2467	L->m[4].rtyp=DEF_CMD;
2468	L->m[5].rtyp=DEF_CMD;
2469	}
2470
2471	res->data=(void *)L;
2472	res->rtyp=LIST_CMD;
2473	// free all pointer in r:
2474	delete[] r.nZahl;
2475	delete[] r.pu;
2476	delete[] r.deg_tab; // Ist das ein Problem??
2477
2478	omFreeSize((ADDRESS)points,currRing->Nlsizeof(short));
2479	return FALSE;
2480	}
2481	else
2482	#endif
2483	/==================== sdb_flags =================/
2484	#ifdef HAVE_SDB
2485	if (strcmp(sys_cmd, "sdb_flags") == 0)
2486	{
2487	if ((h!=NULL) && (h->Typ()==INT_CMD))
2488	{
2489	sdb_flags=(int)((long)h->Data());
2490	}
2491	else
2492	{
2493	WerrorS("system(\"sdb_flags\",`int`) expected");
2494	return TRUE;
2495	}
2496	return FALSE;
2497	}
2498	else
2499	/==================== sdb_edit =================/
2500	if (strcmp(sys_cmd, "sdb_edit") == 0)
2501	{
2502	if ((h!=NULL) && (h->Typ()==PROC_CMD))
2503	{
2504	procinfov p=(procinfov)h->Data();
2505	sdb_edit(p);
2506	}
2507	else
2508	{
2509	WerrorS("system(\"sdb_edit\",`proc`) expected");
2510	return TRUE;
2511	}
2512	return FALSE;
2513	}
2514	else
2515	#endif
2516	/==================== GF =================/
2517	#if 0 // for testing only
2518	if (strcmp(sys_cmd, "GF") == 0)
2519	{
2520	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2521	{
2522	int c=rChar(currRing);
2523	setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2524	CanonicalForm F( convSingGFFactoryGF( (poly)h->Data() ) );
2525	res->rtyp=POLY_CMD;
2526	res->data=convFactoryGFSingGF( F );
2527	return FALSE;
2528	}
2529	else { Werror("wrong typ"); return TRUE;}
2530	}
2531	else
2532	#endif
2533	/==================== stdX =================/
2534	if (strcmp(sys_cmd, "std") == 0)
2535	{
2536	ideal i1;
2537	int i2;
2538	if ((h!=NULL) && (h->Typ()==MODUL_CMD))
2539	{
2540	i1=(ideal)h->CopyD();
2541	h=h->next;
2542	}
2543	else return TRUE;
2544	if ((h!=NULL) && (h->Typ()==INT_CMD))
2545	{
2546	i2=(int)((long)h->Data());
2547	}
2548	else return TRUE;
2549	res->rtyp=MODUL_CMD;
2550	res->data=idXXX(i1,i2);
2551	return FALSE;
2552	}
2553	else
2554	/==================== SVD =================/
2555	#ifdef HAVE_SVD
2556	if (strcmp(sys_cmd, "svd") == 0)
2557	{
2558	extern lists testsvd(matrix M);
2559	res->rtyp=LIST_CMD;
2560	res->data=(char*)(testsvd((matrix)h->Data()));
2561	return FALSE;
2562	}
2563	else
2564	#endif
2565	#ifdef ix86_Win
2566	#ifdef HAVE_DL
2567	/==================== DLL =================/
2568	/* testing the DLL functionality under Win32 */
2569	if (strcmp(sys_cmd, "DLL") == 0)
2570	{
2571	typedef void (*Void_Func)();
2572	typedef int (*Int_Func)(int);
2573	void *hh=dynl_open("WinDllTest.dll");
2574	if ((h!=NULL) && (h->Typ()==INT_CMD))
2575	{
2576	int (*f)(int);
2577	if (hh!=NULL)
2578	{
2579	int (*f)(int);
2580	f=(Int_Func)dynl_sym(hh,"PlusDll");
2581	int i=10;
2582	if (f!=NULL) printf("%d\n",f(i));
2583	else PrintS("cannot find PlusDll\n");
2584	}
2585	}
2586	else
2587	{
2588	void (*f)();
2589	f= (Void_Func)dynl_sym(hh,"TestDll");
2590	if (f!=NULL) f();
2591	else PrintS("cannot find TestDll\n");
2592	}
2593	return FALSE;
2594	}
2595	else
2596	#endif
2597	#endif
2598	/==================== eigenvalues ==================================/
2599	#ifdef HAVE_EIGENVAL
2600	if(strcmp(sys_cmd,"eigenvals")==0)
2601	{
2602	return evEigenvals(res,h);
2603	}
2604	else
2605	#endif
2606	/==================== Gauss-Manin system ==================================/
2607	#ifdef HAVE_GMS
2608	if(strcmp(sys_cmd,"gmsnf")==0)
2609	{
2610	return gmsNF(res,h);
2611	}
2612	else
2613	#endif
2614	/==================== facstd_debug ==================================/
2615	#if !defined(NDEBUG)
2616	if(strcmp(sys_cmd,"facstd")==0)
2617	{
2618	extern int strat_nr;
2619	extern int strat_fac_debug;
2620	strat_fac_debug=(int)(long)h->Data();
2621	strat_nr=0;
2622	return FALSE;
2623	}
2624	else
2625	#endif
2626	#ifdef HAVE_RING2TOM
2627	/==================== ring-GB ==================================/
2628	if (strcmp(sys_cmd, "findZeroPoly")==0)
2629	{
2630	ring r = currRing;
2631	poly f = (poly) h->Data();
2632	res->rtyp=POLY_CMD;
2633	res->data=(poly) kFindZeroPoly(f, r, r);
2634	return(FALSE);
2635	}
2636	else
2637	#ifdef HAVE_VANIDEAL
2638	/==================== Creating zero polynomials =================/
2639	if (strcmp(sys_cmd, "createG0")==0)
2640	{
2641	/* long exp[50];
2642	int N = 0;
2643	while (h != NULL)
2644	{
2645	N += 1;
2646	exp[N] = (long) h->Data();
2647	// if (exp[i] % 2 != 0) exp[i] -= 1;
2648	h = h->next;
2649	}
2650	for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
2651
2652	poly t_p;
2653	res->rtyp=POLY_CMD;
2654	res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
2655	return(FALSE); */
2656
2657	res->rtyp = IDEAL_CMD;
2658	res->data = (ideal) createG0();
2659	return(FALSE);
2660	}
2661	else
2662	#endif
2663	if (strcmp(sys_cmd, "redNF_ring")==0)
2664	{
2665	ring r = currRing;
2666	poly f = (poly) h->Data();
2667	h = h->next;
2668	ideal G = (ideal) h->Data();
2669	res->rtyp=POLY_CMD;
2670	res->data=(poly) ringRedNF(f, G, r);
2671	return(FALSE);
2672	}
2673	else
2674	#endif
2675	if (strcmp(sys_cmd, "minor")==0)
2676	{
2677	ring r = currRing;
2678	matrix a = (matrix) h->Data();
2679	h = h->next;
2680	int ar = (int)(long) h->Data();
2681	h = h->next;
2682	int which = (int)(long) h->Data();
2683	h = h->next;
2684	ideal R = NULL;
2685	if (h != NULL)
2686	{
2687	R = (ideal) h->Data();
2688	}
2689	res->data=(poly) idMinor(a, ar, (unsigned long) which, R);
2690	if (res->data == (poly) 1)
2691	{
2692	res->rtyp=INT_CMD;
2693	res->data = 0;
2694	}
2695	else
2696	{
2697	res->rtyp=POLY_CMD;
2698	}
2699	return(FALSE);
2700	}
2701	else
2702	#ifdef HAVE_F5
2703	/==================== F5 Implementation =================/
2704	if (strcmp(sys_cmd, "f5")==0)
2705	{
2706	if (h->Typ()!=IDEAL_CMD)
2707	{
2708	WerrorS("ideal expected");
2709	return TRUE;
2710	}
2711
2712	ring r = currRing;
2713	ideal G = (ideal) h->Data();
2714	h = h->next;
2715	int opt;
2716	if(h != NULL) {
2717	opt = (int) (long) h->Data();
2718	}
2719	else {
2720	opt = 2;
2721	}
2722	res->rtyp=IDEAL_CMD;
2723	res->data=(ideal) F5main(G,r,opt);
2724	return FALSE;
2725	}
2726	else
2727	#endif
2728	#ifdef HAVE_F5C
2729	/==================== F5C Implementation =================/
2730	if (strcmp(sys_cmd, "f5c")==0)
2731	{
2732	if (h->Typ()!=IDEAL_CMD)
2733	{
2734	WerrorS("ideal expected");
2735	return TRUE;
2736	}
2737
2738	ring r = currRing;
2739	ideal G = (ideal) h->Data();
2740	res->rtyp=IDEAL_CMD;
2741	res->data=(ideal) f5cMain(G,r);
2742	return FALSE;
2743	}
2744	else
2745	#endif
2746	#ifdef HAVE_RINGS
2747	/==================== Testing groebner basis =================/
2748	if (strcmp(sys_cmd, "NF_ring")==0)
2749	{
2750	ring r = currRing;
2751	poly f = (poly) h->Data();
2752	h = h->next;
2753	ideal G = (ideal) h->Data();
2754	res->rtyp=POLY_CMD;
2755	res->data=(poly) ringNF(f, G, r);
2756	return(FALSE);
2757	}
2758	else
2759	if (strcmp(sys_cmd, "spoly")==0)
2760	{
2761	poly f = pCopy((poly) h->Data());
2762	h = h->next;
2763	poly g = pCopy((poly) h->Data());
2764
2765	res->rtyp=POLY_CMD;
2766	res->data=(poly) plain_spoly(f,g);
2767	return(FALSE);
2768	}
2769	else
2770	if (strcmp(sys_cmd, "testGB")==0)
2771	{
2772	ideal I = (ideal) h->Data();
2773	h = h->next;
2774	ideal GI = (ideal) h->Data();
2775	res->rtyp = INT_CMD;
2776	res->data = (void *) testGB(I, GI);
2777	return(FALSE);
2778	}
2779	else
2780	#endif
2781	#ifdef HAVE_PLURAL
2782	/==================== sca?AltVar ==================================/
2783	if ( (strcmp(sys_cmd, "AltVarStart") == 0) \|\| (strcmp(sys_cmd, "AltVarEnd") == 0) )
2784	{
2785	ring r = currRing;
2786
2787	if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
2788	{
2789	WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
2790	return TRUE;
2791	}
2792
2793	res->rtyp=INT_CMD;
2794
2795	if (rIsSCA(r))
2796	{
2797	if(strcmp(sys_cmd, "AltVarStart") == 0)
2798	res->data = (void*)scaFirstAltVar(r);
2799	else
2800	res->data = (void*)scaLastAltVar(r);
2801	return FALSE;
2802	}
2803
2804	WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
2805	return TRUE;
2806	}
2807	else
2808	#endif
2809	#ifdef HAVE_PLURAL
2810	#ifdef HAVE_RATGRING
2811	/==================== RatNF, noncomm rational coeffs =================/
2812	if (strcmp(sys_cmd, "intratNF") == 0)
2813	{
2814	poly p;
2815	poly *q;
2816	ideal I;
2817	int is, k, id;
2818	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2819	{
2820	p=(poly)h->CopyD();
2821	h=h->next;
2822	// Print("poly is done\n");
2823	}
2824	else return TRUE;
2825	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2826	{
2827	I=(ideal)h->CopyD();
2828	q = I->m;
2829	h=h->next;
2830	// Print("ideal is done\n");
2831	}
2832	else return TRUE;
2833	if ((h!=NULL) && (h->Typ()==INT_CMD))
2834	{
2835	is=(int)((long)(h->Data()));
2836	// res->rtyp=INT_CMD;
2837	// Print("int is done\n");
2838	// res->rtyp=IDEAL_CMD;
2839	if (rIsPluralRing(currRing))
2840	{
2841	id = IDELEMS(I);
2842	int pl=(int)omAlloc0(IDELEMS(I)*sizeof(int));
2843	for(k=0; k < id; k++)
2844	{
2845	pl[k] = pLength(I->m[k]);
2846	}
2847	Print("starting redRat\n");
2848	//res->data = (char *)
2849	redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
2850	res->data=p;
2851	res->rtyp=POLY_CMD;
2852	// res->data = ncGCD(p,q,currRing);
2853	}
2854	else
2855	{
2856	res->rtyp=POLY_CMD;
2857	res->data=p;
2858	}
2859	}
2860	else return TRUE;
2861	return FALSE;
2862	}
2863	else
2864	/==================== RatNF, noncomm rational coeffs =================/
2865	if (strcmp(sys_cmd, "ratNF") == 0)
2866	{
2867	poly p,q;
2868	int is, htype;
2869	if ((h!=NULL) && ( (h->Typ()==POLY_CMD) \|\| (h->Typ()==VECTOR_CMD) ) )
2870	{
2871	p=(poly)h->CopyD();
2872	h=h->next;
2873	htype = h->Typ();
2874	}
2875	else return TRUE;
2876	if ((h!=NULL) && ( (h->Typ()==POLY_CMD) \|\| (h->Typ()==VECTOR_CMD) ) )
2877	{
2878	q=(poly)h->CopyD();
2879	h=h->next;
2880	}
2881	else return TRUE;
2882	if ((h!=NULL) && (h->Typ()==INT_CMD))
2883	{
2884	is=(int)((long)(h->Data()));
2885	res->rtyp=htype;
2886	// res->rtyp=IDEAL_CMD;
2887	if (rIsPluralRing(currRing))
2888	{
2889	res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
2890	// res->data = ncGCD(p,q,currRing);
2891	}
2892	else res->data=p;
2893	}
2894	else return TRUE;
2895	return FALSE;
2896	}
2897	else
2898	/==================== RatSpoly, noncomm rational coeffs =================/
2899	if (strcmp(sys_cmd, "ratSpoly") == 0)
2900	{
2901	poly p,q;
2902	int is;
2903	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2904	{
2905	p=(poly)h->CopyD();
2906	h=h->next;
2907	}
2908	else return TRUE;
2909	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2910	{
2911	q=(poly)h->CopyD();
2912	h=h->next;
2913	}
2914	else return TRUE;
2915	if ((h!=NULL) && (h->Typ()==INT_CMD))
2916	{
2917	is=(int)((long)(h->Data()));
2918	res->rtyp=POLY_CMD;
2919	// res->rtyp=IDEAL_CMD;
2920	if (rIsPluralRing(currRing))
2921	{
2922	res->data = nc_rat_CreateSpoly(p,q,is,currRing);
2923	// res->data = ncGCD(p,q,currRing);
2924	}
2925	else res->data=p;
2926	}
2927	else return TRUE;
2928	return FALSE;
2929	}
2930	else
2931	#endif // HAVE_RATGRING
2932	/==================== Rat def =================/
2933	if (strcmp(sys_cmd, "ratVar") == 0)
2934	{
2935	int start,end;
2936	int is;
2937	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2938	{
2939	start=pIsPurePower((poly)h->Data());
2940	h=h->next;
2941	}
2942	else return TRUE;
2943	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2944	{
2945	end=pIsPurePower((poly)h->Data());
2946	h=h->next;
2947	}
2948	else return TRUE;
2949	currRing->real_var_start=start;
2950	currRing->real_var_end=end;
2951	return (start==0)\|\|(end==0)\|\|(start>end);
2952	}
2953	else
2954	/==================== shift-test for freeGB =================/
2955	#ifdef HAVE_SHIFTBBA
2956	if (strcmp(sys_cmd, "stest") == 0)
2957	{
2958	poly p;
2959	int sh,uptodeg, lVblock;
2960	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2961	{
2962	p=(poly)h->CopyD();
2963	h=h->next;
2964	}
2965	else return TRUE;
2966	if ((h!=NULL) && (h->Typ()==INT_CMD))
2967	{
2968	sh=(int)((long)(h->Data()));
2969	h=h->next;
2970	}
2971	else return TRUE;
2972
2973	if ((h!=NULL) && (h->Typ()==INT_CMD))
2974	{
2975	uptodeg=(int)((long)(h->Data()));
2976	h=h->next;
2977	}
2978	else return TRUE;
2979	if ((h!=NULL) && (h->Typ()==INT_CMD))
2980	{
2981	lVblock=(int)((long)(h->Data()));
2982	res->data = pLPshift(p,sh,uptodeg,lVblock);
2983	res->rtyp = POLY_CMD;
2984	}
2985	else return TRUE;
2986	return FALSE;
2987	}
2988	else
2989	#endif
2990	/==================== block-test for freeGB =================/
2991	#ifdef HAVE_SHIFTBBA
2992	if (strcmp(sys_cmd, "btest") == 0)
2993	{
2994	poly p;
2995	int lV;
2996	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2997	{
2998	p=(poly)h->CopyD();
2999	h=h->next;
3000	}
3001	else return TRUE;
3002	if ((h!=NULL) && (h->Typ()==INT_CMD))
3003	{
3004	lV=(int)((long)(h->Data()));
3005	res->rtyp = INT_CMD;
3006	res->data = (void*)pLastVblock(p, lV);
3007	}
3008	else return TRUE;
3009	return FALSE;
3010	}
3011	else
3012	/==================== shrink-test for freeGB =================/
3013	if (strcmp(sys_cmd, "shrinktest") == 0)
3014	{
3015	poly p;
3016	int lV;
3017	if ((h!=NULL) && (h->Typ()==POLY_CMD))
3018	{
3019	p=(poly)h->CopyD();
3020	h=h->next;
3021	}
3022	else return TRUE;
3023	if ((h!=NULL) && (h->Typ()==INT_CMD))
3024	{
3025	lV=(int)((long)(h->Data()));
3026	res->rtyp = POLY_CMD;
3027	// res->data = p_mShrink(p, lV, currRing);
3028	// kStrategy strat=new skStrategy;
3029	// strat->tailRing = currRing;
3030	res->data = p_Shrink(p, lV, currRing);
3031	}
3032	else return TRUE;
3033	return FALSE;
3034	}
3035	else
3036	#endif
3037	#endif
3038	/==================== t-rep-GB ==================================/
3039	if (strcmp(sys_cmd, "unifastmult")==0)
3040	{
3041	ring r = currRing;
3042	poly f = (poly)h->Data();
3043	h=h->next;
3044	poly g=(poly)h->Data();
3045	res->rtyp=POLY_CMD;
3046	res->data=unifastmult(f,g,currRing);
3047	return(FALSE);
3048	}
3049	else
3050	if (strcmp(sys_cmd, "multifastmult")==0)
3051	{
3052	ring r = currRing;
3053	poly f = (poly)h->Data();
3054	h=h->next;
3055	poly g=(poly)h->Data();
3056	res->rtyp=POLY_CMD;
3057	res->data=multifastmult(f,g,currRing);
3058	return(FALSE);
3059	}
3060	else
3061	if (strcmp(sys_cmd, "mults")==0)
3062	{
3063	res->rtyp=INT_CMD ;
3064	res->data=(void*)(long) Mults();
3065	return(FALSE);
3066	}
3067	else
3068	if (strcmp(sys_cmd, "fastpower")==0)
3069	{
3070	ring r = currRing;
3071	poly f = (poly)h->Data();
3072	h=h->next;
3073	int n=(int)((long)h->Data());
3074	res->rtyp=POLY_CMD ;
3075	res->data=(void*) pFastPower(f,n,r);
3076	return(FALSE);
3077	}
3078	else
3079	if (strcmp(sys_cmd, "normalpower")==0)
3080	{
3081	ring r = currRing;
3082	poly f = (poly)h->Data();
3083	h=h->next;
3084	int n=(int)((long)h->Data());
3085	res->rtyp=POLY_CMD ;
3086	res->data=(void*) pPower(pCopy(f),n);
3087	return(FALSE);
3088	}
3089	else
3090	if (strcmp(sys_cmd, "MCpower")==0)
3091	{
3092	ring r = currRing;
3093	poly f = (poly)h->Data();
3094	h=h->next;
3095	int n=(int)((long)h->Data());
3096	res->rtyp=POLY_CMD ;
3097	res->data=(void*) pFastPowerMC(f,n,r);
3098	return(FALSE);
3099	}
3100	else
3101	if (strcmp(sys_cmd, "bit_subst")==0)
3102	{
3103	ring r = currRing;
3104	poly outer = (poly)h->Data();
3105	h=h->next;
3106	poly inner=(poly)h->Data();
3107	res->rtyp=POLY_CMD ;
3108	res->data=(void*) uni_subst_bits(outer, inner,r);
3109	return(FALSE);
3110	}
3111	else
3112	/==================== bifac =================/
3113	#ifdef HAVE_BIFAC
3114	if (strcmp(sys_cmd, "bifac")==0)
3115	{
3116	if (h->Typ()!=POLY_CMD)
3117	{
3118	WerrorS("`system(\"bifac\",<poly>) expected");
3119	return TRUE;
3120	}
3121	if (!rField_is_Q())
3122	{
3123	WerrorS("coeff field must be Q");
3124	return TRUE;
3125	}
3126	BIFAC B;
3127	CFFList C;
3128	int sw_rat=isOn(SW_RATIONAL);
3129	On(SW_RATIONAL);
3130	CanonicalForm F( convSingPClapP((poly)(h->Data())));
3131	B.bifac(F, 1);
3132	CFFList L=B.getFactors();
3133	// construct the ring ==============================================
3134	int i;
3135	int lev=ExtensionLevel();
3136	char names=(char)omAlloc0(lev*sizeof(char_ptr));
3137	for(i=1;i<=lev; i++)
3138	{
3139	StringSetS("");
3140	names[i-1]=omStrDup(StringAppend("a(%d)",i));
3141	}
3142	ring alg_ring=rDefault(0,lev,names);
3143	ring new_ring=rCopy0(currRing); // all variable names, ordering etc.
3144	new_ring->P=lev;
3145	new_ring->parameter=names;
3146	new_ring->algring=alg_ring;
3147	new_ring->ch=1;
3148	rComplete(new_ring,TRUE);
3149	// set the mipo ===============================================
3150	ring save_currRing=currRing; idhdl save_currRingHdl=currRingHdl;
3151	rChangeCurrRing(alg_ring);
3152	ideal mipo_id=idInit(lev,1);
3153	for (i=lev; i>0;i--)
3154	{
3155	CanonicalForm Mipo=getMipo(Variable(-i),Variable(i));
3156	mipo_id->m[i-1]=convClapPSingP(Mipo);
3157	}
3158	idShow(mipo_id);
3159	alg_ring->qideal=mipo_id;
3160	rChangeCurrRing(new_ring);
3161	for (i=lev-1; i>=0;i--)
3162	{
3163	poly p=pOne();
3164	lnumber n=(lnumber)pGetCoeff(p);
3165	// no need to delete nac 1
3166	n->z=(napoly)mipo_id->m[i];
3167	mipo_id->m[i]=p;
3168	}
3169	new_ring->minideal=id_Copy(alg_ring->qideal,new_ring);
3170	// convert factors =============================================
3171	ideal fac_id=idInit(L.length(),1);
3172	CFFListIterator J=L;
3173	i=0;
3174	intvec *v = new intvec( L.length() );
3175	for ( ; J.hasItem(); J++,i++ )
3176	{
3177	fac_id->m[i]=convClapAPSingAP( J.getItem().factor() );
3178	(*v)[i]=J.getItem().exp();
3179	}
3180	idhdl hh=enterid("factors",0,LIST_CMD,&(currRing->idroot),FALSE);
3181	lists LL=(lists)omAllocBin( slists_bin);
3182	LL->Init(2);
3183	LL->m[0].rtyp=IDEAL_CMD;
3184	LL->m[0].data=(char *)fac_id;
3185	LL->m[1].rtyp=INTVEC_CMD;
3186	LL->m[1].data=(char *)v;
3187	IDDATA(hh)=(char *)LL;
3188
3189	rChangeCurrRing(save_currRing);
3190	currRingHdl=save_currRingHdl;
3191	if (!sw_rat) Off(SW_RATIONAL);
3192
3193	res->data=new_ring;
3194	res->rtyp=RING_CMD;
3195	return FALSE;
3196	}
3197	else
3198	#endif
3199	/==================== gcd-varianten =================/
3200	if (strcmp(sys_cmd, "gcd") == 0)
3201	{
3202	if (h==NULL)
3203	{
3204	Print("NTL_0:%d (use NTL for gcd of polynomials in char 0)\n",isOn(SW_USE_NTL_GCD_0));
3205	Print("NTL_p:%d (use NTL for gcd of polynomials in char p)\n",isOn(SW_USE_NTL_GCD_P));
3206	Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3207	Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3208	Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3209	Print("SPARSEMOD:%d (use SPARSEMOD for gcd of polynomials in char 0)\n",isOn(SW_USE_SPARSEMOD));
3210	Print("QGCD:%d (use QGCD for gcd of polynomials in alg. ext.)\n",isOn(SW_USE_QGCD));
3211	Print("FGCD:%d (use fieldGCD for gcd of polynomials in Z/p)\n",isOn(SW_USE_fieldGCD));
3212	Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3213	return FALSE;
3214	}
3215	else
3216	if ((h!=NULL) && (h->Typ()==STRING_CMD)
3217	&& (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3218	{
3219	int d=(int)(long)h->next->Data();
3220	char s=(char )h->Data();
3221	if (strcmp(s,"NTL_0")==0) { if (d) On(SW_USE_NTL_GCD_0); else Off(SW_USE_NTL_GCD_0); } else
3222	if (strcmp(s,"NTL_p")==0) { if (d) On(SW_USE_NTL_GCD_P); else Off(SW_USE_NTL_GCD_P); } else
3223	if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3224	if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3225	if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3226	if (strcmp(s,"SPARSEMOD")==0) { if (d) On(SW_USE_SPARSEMOD); else Off(SW_USE_SPARSEMOD); } else
3227	if (strcmp(s,"QGCD")==0) { if (d) On(SW_USE_QGCD); else Off(SW_USE_QGCD); } else
3228	if (strcmp(s,"FGCD")==0) { if (d) On(SW_USE_fieldGCD); else Off(SW_USE_fieldGCD); } else
3229	if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3230	return TRUE;
3231	return FALSE;
3232	}
3233	else return TRUE;
3234	}
3235	else
3236	#if 0
3237	/==================== gcd-test =================/
3238	if (strcmp(sys_cmd, "GCD") == 0)
3239	{
3240	if ((h!=NULL) && (h->Typ()==POLY_CMD)
3241	&& (h->next!=NULL) && (h->next->Typ()==POLY_CMD))
3242	{
3243	poly f=(poly)h->Data();
3244	poly g=(poly)h->next->Data();
3245	res->rtyp=POLY_CMD;
3246	res->data=(char*)id_GCD(f,g,currRing);
3247	return FALSE;
3248	}
3249	else return TRUE;
3250	}
3251	else
3252	#endif
3253	/==================== subring =================/
3254	if (strcmp(sys_cmd, "subring") == 0)
3255	{
3256	if (h!=NULL)
3257	{
3258	extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3259	res->data=(char *)rSubring(currRing,h);
3260	res->rtyp=RING_CMD;
3261	return res->data==NULL;
3262	}
3263	else return TRUE;
3264	}
3265	else
3266	#ifdef ix86_Win
3267	/==================== Python Singular =================/
3268	if (strcmp(sys_cmd, "python") == 0)
3269	{
3270	const char* c;
3271	if ((h!=NULL) && (h->Typ()==STRING_CMD))
3272	{
3273	c=(const char*)h->Data();
3274	if (!PyInitialized) {
3275	PyInitialized = 1;
3276	// Py_Initialize();
3277	// initPySingular();
3278	}
3279	// PyRun_SimpleString(c);
3280	return FALSE;
3281	}
3282	else return TRUE;
3283	}
3284	else
3285	/*==================== Python Singular =================
3286	if (strcmp(sys_cmd, "ipython") == 0)
3287	{
3288	const char* c;
3289	{
3290	if (!PyInitialized) {
3291	PyInitialized = 1;
3292	Py_Initialize();
3293	initPySingular();
3294	}
3295	PyRun_SimpleString(
3296	"try: \n\
3297	__IPYTHON__ \n\
3298	except NameError: \n\
3299	argv = [''] \n\
3300	banner = exit_msg = '' \n\
3301	else: \n\
3302	# Command-line options for IPython (a list like sys.argv) \n\
3303	argv = ['-pi1','In <\\#>:','-pi2',' .\\D.:','-po','Out<\\#>:'] \n\
3304	banner = '* Nested interpreter *' \n\
3305	exit_msg = '* Back in main IPython *' \n\
3306	\n\
3307	# First import the embeddable shell class \n\
3308	from IPython.Shell import IPShellEmbed \n\
3309	# Now create the IPython shell instance. Put ipshell() anywhere in your code \n\
3310	# where you want it to open. \n\
3311	ipshell = IPShellEmbed(argv,banner=banner,exit_msg=exit_msg) \n\
3312	ipshell()");
3313	return FALSE;
3314	}
3315	}
3316	else
3317	*/
3318
3319	#endif
3320
3321	// TODO: What about a dynamic module instead? Only Linux?
3322	#ifdef HAVE_SINGULAR_PLUS_PLUS
3323	if (strcmp(sys_cmd,"Singular++")==0)
3324	{
3325	// using namespace SINGULAR_NS;
3326	extern BOOLEAN Main(leftv res, leftv h); // FALSE = Ok, TRUE = Error!
3327	return Main(res, h);
3328	};
3329	#endif // HAVE_SINGULAR_PLUS_PLUS
3330
3331
3332	#ifdef HAVE_GFAN
3333	/======== GFAN ==============/
3334	/*
3335	WILL HAVE TO CHANGE RETURN TYPE TO LIST_CMD
3336	*/
3337	if (strcmp(sys_cmd,"gfan")==0)
3338	{
3339	if ((h==NULL) \|\| (h!=NULL && h->Typ()!=IDEAL_CMD))
3340	{
3341	Werror("system(\"gfan\"...) Ideal expected");
3342	return TRUE; //Ooooops
3343	}
3344	ideal I=((ideal)h->Data());
3345	res->rtyp=IDEAL_CMD;
3346	res->data=(ideal) gfan(I);
3347	//res->rtyp=LIST_CMD;
3348	//res->data= ???
3349
3350	return FALSE; //Everything went fine
3351	}
3352	else
3353	#endif
3354	/==================== Error =================/
3355	Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3356	}
3357	return TRUE;
3358	}
3359
3360	#endif // HAVE_EXTENDED_SYSTEM
3361
3362

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

Download in other formats: