Context Navigation

source: git/Singular/extra.cc @ 9cb530

fieker-DuValspielwiese

Last change on this file since 9cb530 was 0e5a3e, checked in by Frank Seelisch <seelisch@…>, 14 years ago
removed files to re-establish SINGULAR as it was; files and new code will appear in new branches instead; git-svn-id: file:///usr/local/Singular/svn/trunk@12294 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 89.8 KB

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

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

Download in other formats: