Context Navigation

source: git/Singular/extra.cc @ 237b3e4

spielwiese

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

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

Download in other formats: