Context Navigation

source: git/Singular/extra.cc @ b4a284

spielwiese

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

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

Download in other formats: