Context Navigation

source: git/Singular/extra.cc @ b84add

spielwiese

Last change on this file since b84add was b84add, checked in by Hans Schoenemann <hannes@…>, 5 years ago
ccluster by Remy Imbach
Property mode set to `100644`
File size: 114.0 KB

Line
1	/*****************************************
2	* Computer Algebra System SINGULAR *
3	*****************************************/
4	/*
5	* ABSTRACT: general interface to internals of Singular ("system" command)
6	* jjSYSTEM: official commands, must be documented in the manual,
7	* #defines must be local to each command
8	* jjEXTENDED_SYSTEM: tests, temporary comands etc.
9	*/
10
11	#define HAVE_WALK 1
12
13	#include "kernel/mod2.h"
14	#include "misc/sirandom.h"
15	#include "resources/omFindExec.h"
16
17	#ifdef HAVE_CCLUSTER
18	#include "ccluster/ccluster.h"
19	#endif
20
21	#include "factory/factory.h"
22
23	#ifdef TIME_WITH_SYS_TIME
24	# include <time.h>
25	# ifdef HAVE_SYS_TIME_H
26	# include <sys/time.h>
27	# endif
28	#else
29	# ifdef HAVE_SYS_TIME_H
30	# include <sys/time.h>
31	# else
32	# include <time.h>
33	# endif
34	#endif
35	#ifdef HAVE_SYS_TIMES_H
36	#include <sys/times.h>
37	#endif
38
39	#include <unistd.h>
40
41	#include "misc/options.h"
42
43	// #include "coeffs/ffields.h"
44	#include "coeffs/coeffs.h"
45	#include "coeffs/mpr_complex.h"
46	#include "coeffs/AE.h"
47	// #include "coeffs/OPAE.h"
48	#include "coeffs/AEp.h"
49	// #include "coeffs/OPAEp.h"
50	#include "coeffs/AEQ.h"
51	// #include "coeffs/OPAEQ.h"
52
53
54	#include "resources/feResource.h"
55	#include "polys/monomials/ring.h"
56	#include "kernel/polys.h"
57
58	#include "polys/monomials/maps.h"
59	#include "polys/matpol.h"
60
61	#include "polys/weight.h"
62
63	#ifdef HAVE_SHIFTBBA
64	#include "polys/shiftop.h"
65	#endif
66
67	#include "coeffs/bigintmat.h"
68	#include "kernel/fast_mult.h"
69	#include "kernel/digitech.h"
70	#include "kernel/combinatorics/stairc.h"
71	#include "kernel/ideals.h"
72	#include "kernel/GBEngine/kstd1.h"
73	#include "kernel/GBEngine/syz.h"
74	#include "kernel/GBEngine/kutil.h"
75
76	#include "kernel/linear_algebra/linearAlgebra.h"
77
78	#include "kernel/combinatorics/hutil.h"
79
80	// for tests of t-rep-GB
81	#include "kernel/GBEngine/tgb.h"
82
83	#include "kernel/linear_algebra/minpoly.h"
84
85	#include "numeric/mpr_base.h"
86
87	#include "tok.h"
88	#include "ipid.h"
89	#include "lists.h"
90	#include "cntrlc.h"
91	#include "ipshell.h"
92	#include "sdb.h"
93	#include "feOpt.h"
94	#include "fehelp.h"
95	#include "distrib.h"
96
97	#include "misc_ip.h"
98
99	#include "attrib.h"
100
101	#include "links/silink.h"
102	#include "links/ssiLink.h"
103	#include "walk.h"
104	#include "Singular/newstruct.h"
105	#include "Singular/blackbox.h"
106	#include "Singular/pyobject_setup.h"
107
108
109	#ifdef HAVE_RINGS
110	#include "kernel/GBEngine/ringgb.h"
111	#endif
112
113	#ifdef HAVE_F5
114	#include "kernel/GBEngine/f5gb.h"
115	#endif
116
117	#ifdef HAVE_WALK
118	#include "walk.h"
119	#endif
120
121	#ifdef HAVE_SPECTRUM
122	#include "kernel/spectrum/spectrum.h"
123	#endif
124
125	#ifdef HAVE_PLURAL
126	#include "polys/nc/nc.h"
127	#include "polys/nc/ncSAMult.h" // for CMultiplier etc classes
128	#include "polys/nc/sca.h"
129	#include "kernel/GBEngine/nc.h"
130	#include "ipconv.h"
131	#ifdef HAVE_RATGRING
132	#include "kernel/GBEngine/ratgring.h"
133	#endif
134	#endif
135
136	#ifdef __CYGWIN__ /* only for the DLLTest */
137	/* #include "WinDllTest.h" */
138	#ifdef HAVE_DL
139	#include "polys/mod_raw.h"
140	#endif
141	#endif
142
143	// Define to enable many more system commands
144	//#undef MAKE_DISTRIBUTION
145	#ifndef MAKE_DISTRIBUTION
146	#define HAVE_EXTENDED_SYSTEM 1
147	#endif
148
149	#include "polys/flintconv.h"
150	#include "polys/clapconv.h"
151	#include "kernel/GBEngine/kstdfac.h"
152
153	#include "polys/clapsing.h"
154
155	#ifdef HAVE_EIGENVAL
156	#include "eigenval_ip.h"
157	#endif
158
159	#ifdef HAVE_GMS
160	#include "gms.h"
161	#endif
162
163	#ifdef HAVE_SIMPLEIPC
164	#include "Singular/links/simpleipc.h"
165	#endif
166
167	#ifdef HAVE_PCV
168	#include "pcv.h"
169	#endif
170
171	#ifndef MAKE_DISTRIBUTION
172	static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
173	#endif
174
175	/* expects a SINGULAR square matrix with number entries
176	where currRing is expected to be over some field F_p;
177	returns a long** matrix with the "same", i.e.,
178	appropriately mapped entries;
179	leaves singularMatrix unmodified */
180	unsigned long** singularMatrixToLongMatrix(matrix singularMatrix)
181	{
182	int n = singularMatrix->rows();
183	assume(n == singularMatrix->cols());
184	unsigned long **longMatrix = 0;
185	longMatrix = new unsigned long *[n] ;
186	for (int i = 0 ; i < n; i++)
187	longMatrix[i] = new unsigned long [n];
188	number entry;
189	for (int r = 0; r < n; r++)
190	for (int c = 0; c < n; c++)
191	{
192	poly p=MATELEM(singularMatrix, r + 1, c + 1);
193	int entryAsInt;
194	if (p!=NULL)
195	{
196	entry = p_GetCoeff(p, currRing);
197	entryAsInt = n_Int(entry, currRing->cf);
198	if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
199	}
200	else
201	entryAsInt=0;
202	longMatrix[r][c] = (unsigned long)entryAsInt;
203	}
204	return longMatrix;
205	}
206
207	/* expects an array of unsigned longs with valid indices 0..degree;
208	returns the following poly, where x denotes the first ring variable
209	of currRing, and d = degree:
210	polyCoeffs[d] * x^d + polyCoeffs[d-1] * x^(d-1) + ... + polyCoeffs[0]
211	leaves polyCoeffs unmodified */
212	poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
213	{
214	poly result = NULL;
215	for (int i = 0; i <= degree; i++)
216	{
217	if ((int)polyCoeffs[i] != 0)
218	{
219	poly term = p_ISet((int)polyCoeffs[i], currRing);
220	if (i > 0)
221	{
222	p_SetExp(term, 1, i, currRing);
223	p_Setm(term, currRing);
224	}
225	result = p_Add_q(result, term, currRing);
226	}
227	}
228	return result;
229	}
230
231	//void emStart();
232	/*2
233	* the "system" command
234	*/
235	BOOLEAN jjSYSTEM(leftv res, leftv args)
236	{
237	if(args->Typ() == STRING_CMD)
238	{
239	const char sys_cmd=(char )(args->Data());
240	leftv h=args->next;
241	// ONLY documented system calls go here
242	// Undocumented system calls go down into jjEXTENDED_SYSTEM (#ifdef HAVE_EXTENDED_SYSTEM)
243	/==================== nblocks ==================================/
244	if (strcmp(sys_cmd, "nblocks") == 0)
245	{
246	ring r;
247	if (h == NULL)
248	{
249	if (currRingHdl != NULL)
250	{
251	r = IDRING(currRingHdl);
252	}
253	else
254	{
255	WerrorS("no ring active");
256	return TRUE;
257	}
258	}
259	else
260	{
261	if (h->Typ() != RING_CMD)
262	{
263	WerrorS("ring expected");
264	return TRUE;
265	}
266	r = (ring) h->Data();
267	}
268	res->rtyp = INT_CMD;
269	res->data = (void*) (long)(rBlocks(r) - 1);
270	return FALSE;
271	}
272	/==================== version ==================================/
273	if(strcmp(sys_cmd,"version")==0)
274	{
275	res->rtyp=INT_CMD;
276	res->data=(void *)SINGULAR_VERSION;
277	return FALSE;
278	}
279	else
280	/==================== alarm ==================================/
281	if(strcmp(sys_cmd,"alarm")==0)
282	{
283	if ((h!=NULL) &&(h->Typ()==INT_CMD))
284	{
285	// standard variant -> SIGALARM (standard: abort)
286	//alarm((unsigned)h->next->Data());
287	// process time (user +system): SIGVTALARM
288	struct itimerval t,o;
289	memset(&t,0,sizeof(t));
290	t.it_value.tv_sec =(unsigned)((unsigned long)h->Data());
291	setitimer(ITIMER_VIRTUAL,&t,&o);
292	return FALSE;
293	}
294	else
295	WerrorS("int expected");
296	}
297	else
298	/==================== cpu ==================================/
299	if(strcmp(sys_cmd,"cpu")==0)
300	{
301	long cpu=1; //feOptValue(FE_OPT_CPUS);
302	#ifdef _SC_NPROCESSORS_ONLN
303	cpu=sysconf(_SC_NPROCESSORS_ONLN);
304	#elif defined(_SC_NPROCESSORS_CONF)
305	cpu=sysconf(_SC_NPROCESSORS_CONF);
306	#endif
307	res->data=(void *)cpu;
308	res->rtyp=INT_CMD;
309	return FALSE;
310	}
311	else
312	/==================== executable ==================================/
313	if(strcmp(sys_cmd,"executable")==0)
314	{
315	if ((h!=NULL) && (h->Typ()==STRING_CMD))
316	{
317	char tbuf[MAXPATHLEN];
318	char s=omFindExec((char)h->Data(),tbuf);
319	if(s==NULL) s=(char*)"";
320	res->data=(void *)omStrDup(s);
321	res->rtyp=STRING_CMD;
322	return FALSE;
323	}
324	return TRUE;
325	}
326	else
327	/==================== flatten =============================/
328	if(strcmp(sys_cmd,"flatten")==0)
329	{
330	if ((h!=NULL) &&(h->Typ()==SMATRIX_CMD))
331	{
332	res->data=(char*)sm_Flatten((ideal)h->Data(),currRing);
333	res->rtyp=SMATRIX_CMD;
334	return FALSE;
335	}
336	else
337	WerrorS("smatrix expected");
338	}
339	else
340	/==================== unflatten =============================/
341	if(strcmp(sys_cmd,"unflatten")==0)
342	{
343	const short t1[]={2,SMATRIX_CMD,INT_CMD};
344	if (iiCheckTypes(h,t1,1))
345	{
346	res->data=(char*)sm_UnFlatten((ideal)h->Data(),(int)(long)h->next->Data(),currRing);
347	res->rtyp=SMATRIX_CMD;
348	return res->data==NULL;
349	}
350	else return TRUE;
351	}
352	else
353	/==================== neworder =============================/
354	if(strcmp(sys_cmd,"neworder")==0)
355	{
356	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
357	{
358	res->rtyp=STRING_CMD;
359	res->data=(void *)singclap_neworder((ideal)h->Data(), currRing);
360	return FALSE;
361	}
362	else
363	WerrorS("ideal expected");
364	}
365	else
366	/===== nc_hilb ===============================================/
367	// Hilbert series of non-commutative monomial algebras
368	if(strcmp(sys_cmd,"nc_hilb") == 0)
369	{
370	ideal i; int lV;
371	bool ig = FALSE;
372	bool mgrad = FALSE;
373	bool autop = FALSE;
374	int trunDegHs=0;
375	if((h != NULL)&&(h->Typ() == IDEAL_CMD))
376	i = (ideal)h->Data();
377	else
378	{
379	WerrorS("nc_Hilb:ideal expected");
380	return TRUE;
381	}
382	h = h->next;
383	if((h != NULL)&&(h->Typ() == INT_CMD))
384	lV = (int)(long)h->Data();
385	else
386	{
387	WerrorS("nc_Hilb:int expected");
388	return TRUE;
389	}
390	h = h->next;
391	while(h != NULL)
392	{
393	if((int)(long)h->Data() == 1)
394	ig = TRUE;
395	else if((int)(long)h->Data() == 2)
396	mgrad = TRUE;
397	else if(h->Typ()==STRING_CMD)
398	autop = TRUE;
399	else if(h->Typ() == INT_CMD)
400	trunDegHs = (int)(long)h->Data();
401	h = h->next;
402	}
403	if(h != NULL)
404	{
405	WerrorS("nc_Hilb:int 1,2, total degree for the truncation, and a string for printing the details are expected");
406	return TRUE;
407	}
408
409	HilbertSeries_OrbitData(i, lV, ig, mgrad, autop, trunDegHs);
410	return(FALSE);
411	}
412	else
413	/===== rcolon ===============================================/
414	if(strcmp(sys_cmd,"rcolon") == 0)
415	{
416	const short t1[]={3,IDEAL_CMD,POLY_CMD,INT_CMD};
417	if (iiCheckTypes(h,t1,1))
418	{
419	ideal i = (ideal)h->Data();
420	h = h->next;
421	poly w=(poly)h->Data();
422	h = h->next;
423	int lV = (int)(long)h->Data();
424	res->rtyp = IDEAL_CMD;
425	res->data = RightColonOperation(i, w, lV);
426	return(FALSE);
427	}
428	else
429	return TRUE;
430	}
431	else
432
433	/==================== sh ==================================/
434	if(strcmp(sys_cmd,"sh")==0)
435	{
436	if (feOptValue(FE_OPT_NO_SHELL))
437	{
438	WerrorS("shell execution is disallowed in restricted mode");
439	return TRUE;
440	}
441	res->rtyp=INT_CMD;
442	if (h==NULL) res->data = (void *)(long) system("sh");
443	else if (h->Typ()==STRING_CMD)
444	res->data = (void)(long) system((char)(h->Data()));
445	else
446	WerrorS("string expected");
447	return FALSE;
448	}
449	else
450	/========reduce procedure like the global one but with jet bounds=======/
451	if(strcmp(sys_cmd,"reduce_bound")==0)
452	{
453	poly p;
454	ideal pid=NULL;
455	const short t1[]={3,POLY_CMD,IDEAL_CMD,INT_CMD};
456	const short t2[]={3,IDEAL_CMD,IDEAL_CMD,INT_CMD};
457	const short t3[]={3,VECTOR_CMD,MODUL_CMD,INT_CMD};
458	const short t4[]={3,MODUL_CMD,MODUL_CMD,INT_CMD};
459	if ((iiCheckTypes(h,t1,0))\|\|((iiCheckTypes(h,t3,0))))
460	{
461	p = (poly)h->CopyD();
462	}
463	else if ((iiCheckTypes(h,t2,0))\|\|(iiCheckTypes(h,t4,1)))
464	{
465	pid = (ideal)h->CopyD();
466	}
467	else return TRUE;
468	//int htype;
469	res->rtyp= h->Typ(); /htype/
470	ideal q = (ideal)h->next->CopyD();
471	int bound = (int)(long)h->next->next->Data();
472	if (pid==NULL) /(htype == POLY_CMD \|\| htype == VECTOR_CMD)/
473	res->data = (char *)kNFBound(q,currRing->qideal,p,bound);
474	else /(htype == IDEAL_CMD \|\| htype == MODUL_CMD)/
475	res->data = (char *)kNFBound(q,currRing->qideal,pid,bound);
476	return FALSE;
477	}
478	else
479	/==================== uname ==================================/
480	if(strcmp(sys_cmd,"uname")==0)
481	{
482	res->rtyp=STRING_CMD;
483	res->data = omStrDup(S_UNAME);
484	return FALSE;
485	}
486	else
487	/==================== with ==================================/
488	if(strcmp(sys_cmd,"with")==0)
489	{
490	if (h==NULL)
491	{
492	res->rtyp=STRING_CMD;
493	res->data=(void *)versionString();
494	return FALSE;
495	}
496	else if (h->Typ()==STRING_CMD)
497	{
498	#define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
499	char s=(char )h->Data();
500	res->rtyp=INT_CMD;
501	#ifdef HAVE_DBM
502	TEST_FOR("DBM")
503	#endif
504	#ifdef HAVE_DLD
505	TEST_FOR("DLD")
506	#endif
507	//TEST_FOR("factory")
508	//TEST_FOR("libfac")
509	#ifdef HAVE_READLINE
510	TEST_FOR("readline")
511	#endif
512	#ifdef TEST_MAC_ORDER
513	TEST_FOR("MAC_ORDER")
514	#endif
515	// unconditional since 3-1-0-6
516	TEST_FOR("Namespaces")
517	#ifdef HAVE_DYNAMIC_LOADING
518	TEST_FOR("DynamicLoading")
519	#endif
520	#ifdef HAVE_EIGENVAL
521	TEST_FOR("eigenval")
522	#endif
523	#ifdef HAVE_GMS
524	TEST_FOR("gms")
525	#endif
526	#ifdef OM_NDEBUG
527	TEST_FOR("om_ndebug")
528	#endif
529	#ifdef SING_NDEBUG
530	TEST_FOR("ndebug")
531	#endif
532	{};
533	return FALSE;
534	#undef TEST_FOR
535	}
536	return TRUE;
537	}
538	else
539	/==================== browsers ==================================/
540	if (strcmp(sys_cmd,"browsers")==0)
541	{
542	res->rtyp = STRING_CMD;
543	StringSetS("");
544	feStringAppendBrowsers(0);
545	res->data = StringEndS();
546	return FALSE;
547	}
548	else
549	/==================== pid ==================================/
550	if (strcmp(sys_cmd,"pid")==0)
551	{
552	res->rtyp=INT_CMD;
553	res->data=(void *)(long) getpid();
554	return FALSE;
555	}
556	else
557	/==================== getenv ==================================/
558	if (strcmp(sys_cmd,"getenv")==0)
559	{
560	if ((h!=NULL) && (h->Typ()==STRING_CMD))
561	{
562	res->rtyp=STRING_CMD;
563	const char r=getenv((char )h->Data());
564	if (r==NULL) r="";
565	res->data=(void *)omStrDup(r);
566	return FALSE;
567	}
568	else
569	{
570	WerrorS("string expected");
571	return TRUE;
572	}
573	}
574	else
575	/==================== setenv ==================================/
576	if (strcmp(sys_cmd,"setenv")==0)
577	{
578	#ifdef HAVE_SETENV
579	const short t[]={2,STRING_CMD,STRING_CMD};
580	if (iiCheckTypes(h,t,1))
581	{
582	res->rtyp=STRING_CMD;
583	setenv((char )h->Data(), (char )h->next->Data(), 1);
584	res->data=(void )omStrDup((char )h->next->Data());
585	feReInitResources();
586	return FALSE;
587	}
588	else
589	{
590	return TRUE;
591	}
592	#else
593	WerrorS("setenv not supported on this platform");
594	return TRUE;
595	#endif
596	}
597	else
598	/==================== Singular ==================================/
599	if (strcmp(sys_cmd, "Singular") == 0)
600	{
601	res->rtyp=STRING_CMD;
602	const char *r=feResource("Singular");
603	if (r == NULL) r="";
604	res->data = (void*) omStrDup( r );
605	return FALSE;
606	}
607	else
608	if (strcmp(sys_cmd, "SingularLib") == 0)
609	{
610	res->rtyp=STRING_CMD;
611	const char *r=feResource("SearchPath");
612	if (r == NULL) r="";
613	res->data = (void*) omStrDup( r );
614	return FALSE;
615	}
616	else
617	/==================== options ==================================/
618	if (strstr(sys_cmd, "--") == sys_cmd)
619	{
620	if (strcmp(sys_cmd, "--") == 0)
621	{
622	fePrintOptValues();
623	return FALSE;
624	}
625	feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
626	if (opt == FE_OPT_UNDEF)
627	{
628	Werror("Unknown option %s", sys_cmd);
629	WerrorS("Use 'system(\"--\");' for listing of available options");
630	return TRUE;
631	}
632	// for Untyped Options (help version),
633	// setting it just triggers action
634	if (feOptSpec[opt].type == feOptUntyped)
635	{
636	feSetOptValue(opt,0);
637	return FALSE;
638	}
639	if (h == NULL)
640	{
641	if (feOptSpec[opt].type == feOptString)
642	{
643	res->rtyp = STRING_CMD;
644	const char r=(const char)feOptSpec[opt].value;
645	if (r == NULL) r="";
646	res->data = omStrDup(r);
647	}
648	else
649	{
650	res->rtyp = INT_CMD;
651	res->data = feOptSpec[opt].value;
652	}
653	return FALSE;
654	}
655	if (h->Typ() != STRING_CMD &&
656	h->Typ() != INT_CMD)
657	{
658	WerrorS("Need string or int argument to set option value");
659	return TRUE;
660	}
661	const char* errormsg;
662	if (h->Typ() == INT_CMD)
663	{
664	if (feOptSpec[opt].type == feOptString)
665	{
666	Werror("Need string argument to set value of option %s", sys_cmd);
667	return TRUE;
668	}
669	errormsg = feSetOptValue(opt, (int)((long) h->Data()));
670	if (errormsg != NULL)
671	Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
672	}
673	else
674	{
675	errormsg = feSetOptValue(opt, (char*) h->Data());
676	if (errormsg != NULL)
677	Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
678	}
679	if (errormsg != NULL) return TRUE;
680	return FALSE;
681	}
682	else
683	/==================== HC ==================================/
684	if (strcmp(sys_cmd,"HC")==0)
685	{
686	res->rtyp=INT_CMD;
687	res->data=(void *)(long) HCord;
688	return FALSE;
689	}
690	else
691	/==================== random ==================================/
692	if(strcmp(sys_cmd,"random")==0)
693	{
694	const short t[]={1,INT_CMD};
695	if (h!=NULL)
696	{
697	if (iiCheckTypes(h,t,1))
698	{
699	siRandomStart=(int)((long)h->Data());
700	siSeed=siRandomStart;
701	factoryseed(siRandomStart);
702	return FALSE;
703	}
704	else
705	{
706	return TRUE;
707	}
708	}
709	res->rtyp=INT_CMD;
710	res->data=(void*)(long) siSeed;
711	return FALSE;
712	}
713	else
714	/======================= demon_list =====================/
715	if (strcmp(sys_cmd,"denom_list")==0)
716	{
717	res->rtyp=LIST_CMD;
718	extern lists get_denom_list();
719	res->data=(lists)get_denom_list();
720	return FALSE;
721	}
722	else
723	/==================== complexNearZero ======================/
724	if(strcmp(sys_cmd,"complexNearZero")==0)
725	{
726	const short t[]={2,NUMBER_CMD,INT_CMD};
727	if (iiCheckTypes(h,t,1))
728	{
729	if ( !rField_is_long_C(currRing) )
730	{
731	WerrorS( "unsupported ground field!");
732	return TRUE;
733	}
734	else
735	{
736	res->rtyp=INT_CMD;
737	res->data=(void)complexNearZero((gmp_complex)h->Data(),
738	(int)((long)(h->next->Data())));
739	return FALSE;
740	}
741	}
742	else
743	{
744	return TRUE;
745	}
746	}
747	else
748	/==================== getPrecDigits ======================/
749	if(strcmp(sys_cmd,"getPrecDigits")==0)
750	{
751	if ( (currRing==NULL)
752	\|\| (!rField_is_long_C(currRing) && !rField_is_long_R(currRing)))
753	{
754	WerrorS( "unsupported ground field!");
755	return TRUE;
756	}
757	res->rtyp=INT_CMD;
758	res->data=(void*)(long)gmp_output_digits;
759	//if (gmp_output_digits!=getGMPFloatDigits())
760	//{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);}
761	return FALSE;
762	}
763	else
764	/==================== lduDecomp ======================/
765	if(strcmp(sys_cmd, "lduDecomp")==0)
766	{
767	const short t[]={1,MATRIX_CMD};
768	if (iiCheckTypes(h,t,1))
769	{
770	matrix aMat = (matrix)h->Data();
771	matrix pMat; matrix lMat; matrix dMat; matrix uMat;
772	poly l; poly u; poly prodLU;
773	lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU);
774	lists L = (lists)omAllocBin(slists_bin);
775	L->Init(7);
776	L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat;
777	L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat;
778	L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat;
779	L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat;
780	L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l;
781	L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u;
782	L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU;
783	res->rtyp = LIST_CMD;
784	res->data = (char *)L;
785	return FALSE;
786	}
787	else
788	{
789	return TRUE;
790	}
791	}
792	else
793	/==================== lduSolve ======================/
794	if(strcmp(sys_cmd, "lduSolve")==0)
795	{
796	/* for solving a linear equation system A * x = b, via the
797	given LDU-decomposition of the matrix A;
798	There is one valid parametrisation:
799	1) exactly eight arguments P, L, D, U, l, u, lTimesU, b;
800	P, L, D, and U realise the LDU-decomposition of A, that is,
801	P * A = L * D^(-1) * U, and P, L, D, and U satisfy the
802	properties decribed in method 'luSolveViaLDUDecomp' in
803	linearAlgebra.h; see there;
804	l, u, and lTimesU are as described in the same location;
805	b is the right-hand side vector of the linear equation system;
806	The method will return a list of either 1 entry or three entries:
807	1) [0] if there is no solution to the system;
808	2) [1, x, H] if there is at least one solution;
809	x is any solution of the given linear system,
810	H is the matrix with column vectors spanning the homogeneous
811	solution space.
812	The method produces an error if matrix and vector sizes do not
813	fit. */
814	const short t[]={7,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,POLY_CMD,POLY_CMD,MATRIX_CMD};
815	if (!iiCheckTypes(h,t,1))
816	{
817	return TRUE;
818	}
819	if (rField_is_Ring(currRing))
820	{
821	WerrorS("field required");
822	return TRUE;
823	}
824	matrix pMat = (matrix)h->Data();
825	matrix lMat = (matrix)h->next->Data();
826	matrix dMat = (matrix)h->next->next->Data();
827	matrix uMat = (matrix)h->next->next->next->Data();
828	poly l = (poly) h->next->next->next->next->Data();
829	poly u = (poly) h->next->next->next->next->next->Data();
830	poly lTimesU = (poly) h->next->next->next->next->next->next->Data();
831	matrix bVec = (matrix)h->next->next->next->next->next->next->next->Data();
832	matrix xVec; int solvable; matrix homogSolSpace;
833	if (pMat->rows() != pMat->cols())
834	{
835	Werror("first matrix (%d x %d) is not quadratic",
836	pMat->rows(), pMat->cols());
837	return TRUE;
838	}
839	if (lMat->rows() != lMat->cols())
840	{
841	Werror("second matrix (%d x %d) is not quadratic",
842	lMat->rows(), lMat->cols());
843	return TRUE;
844	}
845	if (dMat->rows() != dMat->cols())
846	{
847	Werror("third matrix (%d x %d) is not quadratic",
848	dMat->rows(), dMat->cols());
849	return TRUE;
850	}
851	if (dMat->cols() != uMat->rows())
852	{
853	Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s",
854	dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(),
855	"do not t");
856	return TRUE;
857	}
858	if (uMat->rows() != bVec->rows())
859	{
860	Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit",
861	uMat->rows(), uMat->cols(), bVec->rows());
862	return TRUE;
863	}
864	solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU,
865	bVec, xVec, homogSolSpace);
866
867	/* build the return structure; a list with either one or
868	three entries */
869	lists ll = (lists)omAllocBin(slists_bin);
870	if (solvable)
871	{
872	ll->Init(3);
873	ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
874	ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
875	ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
876	}
877	else
878	{
879	ll->Init(1);
880	ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
881	}
882	res->rtyp = LIST_CMD;
883	res->data=(char*)ll;
884	return FALSE;
885	}
886	else
887	/==== countedref: reference and shared ====/
888	if (strcmp(sys_cmd, "shared") == 0)
889	{
890	#ifndef SI_COUNTEDREF_AUTOLOAD
891	void countedref_shared_load();
892	countedref_shared_load();
893	#endif
894	res->rtyp = NONE;
895	return FALSE;
896	}
897	else if (strcmp(sys_cmd, "reference") == 0)
898	{
899	#ifndef SI_COUNTEDREF_AUTOLOAD
900	void countedref_reference_load();
901	countedref_reference_load();
902	#endif
903	res->rtyp = NONE;
904	return FALSE;
905	}
906	else
907	/==================== semaphore =================/
908	#ifdef HAVE_SIMPLEIPC
909	if (strcmp(sys_cmd,"semaphore")==0)
910	{
911	if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
912	{
913	int v=1;
914	if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))
915	v=(int)(long)h->next->next->Data();
916	res->data=(char )(long)simpleipc_cmd((char )h->Data(),(int)(long)h->next->Data(),v);
917	res->rtyp=INT_CMD;
918	return FALSE;
919	}
920	else
921	{
922	WerrorS("Usage: system(\"semaphore\",<cmd>,int)");
923	return TRUE;
924	}
925	}
926	else
927	#endif
928	/==================== reserved port =================/
929	if (strcmp(sys_cmd,"reserve")==0)
930	{
931	int ssiReservePort(int clients);
932	const short t[]={1,INT_CMD};
933	if (iiCheckTypes(h,t,1))
934	{
935	res->rtyp=INT_CMD;
936	int p=ssiReservePort((int)(long)h->Data());
937	res->data=(void*)(long)p;
938	return (p==0);
939	}
940	return TRUE;
941	}
942	else
943	/==================== reserved link =================/
944	if (strcmp(sys_cmd,"reservedLink")==0)
945	{
946	res->rtyp=LINK_CMD;
947	si_link p=ssiCommandLink();
948	res->data=(void*)p;
949	return (p==NULL);
950	}
951	else
952	/==================== install newstruct =================/
953	if (strcmp(sys_cmd,"install")==0)
954	{
955	const short t[]={4,STRING_CMD,STRING_CMD,PROC_CMD,INT_CMD};
956	if (iiCheckTypes(h,t,1))
957	{
958	return newstruct_set_proc((char)h->Data(),(char)h->next->Data(),
959	(int)(long)h->next->next->next->Data(),
960	(procinfov)h->next->next->Data());
961	}
962	return TRUE;
963	}
964	else
965	/==================== newstruct =================/
966	if (strcmp(sys_cmd,"newstruct")==0)
967	{
968	const short t[]={1,STRING_CMD};
969	if (iiCheckTypes(h,t,1))
970	{
971	int id=0;
972	char n=(char)h->Data();
973	blackboxIsCmd(n,id);
974	if (id>0)
975	{
976	blackbox *bb=getBlackboxStuff(id);
977	if (BB_LIKE_LIST(bb))
978	{
979	newstruct_desc desc=(newstruct_desc)bb->data;
980	newstructShow(desc);
981	return FALSE;
982	}
983	else Werror("'%s' is not a newstruct",n);
984	}
985	else Werror("'%s' is not a blackbox object",n);
986	}
987	return TRUE;
988	}
989	else
990	/==================== blackbox =================/
991	if (strcmp(sys_cmd,"blackbox")==0)
992	{
993	printBlackboxTypes();
994	return FALSE;
995	}
996	else
997	/================= absBiFact ======================/
998	#ifdef HAVE_NTL
999	if (strcmp(sys_cmd, "absFact") == 0)
1000	{
1001	const short t[]={1,POLY_CMD};
1002	if (iiCheckTypes(h,t,1)
1003	&& (currRing!=NULL)
1004	&& (getCoeffType(currRing->cf)==n_transExt))
1005	{
1006	res->rtyp=LIST_CMD;
1007	intvec *v=NULL;
1008	ideal mipos= NULL;
1009	int n= 0;
1010	ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);
1011	if (f==NULL) return TRUE;
1012	ivTest(v);
1013	lists l=(lists)omAllocBin(slists_bin);
1014	l->Init(4);
1015	l->m[0].rtyp=IDEAL_CMD;
1016	l->m[0].data=(void *)f;
1017	l->m[1].rtyp=INTVEC_CMD;
1018	l->m[1].data=(void *)v;
1019	l->m[2].rtyp=IDEAL_CMD;
1020	l->m[2].data=(void*) mipos;
1021	l->m[3].rtyp=INT_CMD;
1022	l->m[3].data=(void*) (long) n;
1023	res->data=(void *)l;
1024	return FALSE;
1025	}
1026	else return TRUE;
1027	}
1028	else
1029	#endif
1030	/* =================== LLL via NTL ==============================*/
1031	#ifdef HAVE_NTL
1032	if (strcmp(sys_cmd, "LLL") == 0)
1033	{
1034	if (h!=NULL)
1035	{
1036	res->rtyp=h->Typ();
1037	if (h->Typ()==MATRIX_CMD)
1038	{
1039	res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
1040	return FALSE;
1041	}
1042	else if (h->Typ()==INTMAT_CMD)
1043	{
1044	res->data=(char )singntl_LLL((intvec)h->Data());
1045	return FALSE;
1046	}
1047	else return TRUE;
1048	}
1049	else return TRUE;
1050	}
1051	else
1052	#endif
1053	/* =================== LLL via Flint ==============================*/
1054	#ifdef HAVE_FLINT
1055	#if __FLINT_RELEASE >= 20500
1056	if (strcmp(sys_cmd, "LLL_Flint") == 0)
1057	{
1058	if (h!=NULL)
1059	{
1060	if(h->next == NULL)
1061	{
1062	res->rtyp=h->Typ();
1063	if (h->Typ()==BIGINTMAT_CMD)
1064	{
1065	res->data=(char )singflint_LLL((bigintmat)h->Data(), NULL);
1066	return FALSE;
1067	}
1068	else if (h->Typ()==INTMAT_CMD)
1069	{
1070	res->data=(char )singflint_LLL((intvec)h->Data(), NULL);
1071	return FALSE;
1072	}
1073	else return TRUE;
1074	}
1075	if(h->next->Typ()!= INT_CMD)
1076	{
1077	WerrorS("matrix,int or bigint,int expected");
1078	return TRUE;
1079	}
1080	if(h->next->Typ()== INT_CMD)
1081	{
1082	if(((int)((long)(h->next->Data())) != 0) && (int)((long)(h->next->Data()) != 1))
1083	{
1084	WerrorS("int is different from 0, 1");
1085	return TRUE;
1086	}
1087	res->rtyp=h->Typ();
1088	if((long)(h->next->Data()) == 0)
1089	{
1090	if (h->Typ()==BIGINTMAT_CMD)
1091	{
1092	res->data=(char )singflint_LLL((bigintmat)h->Data(), NULL);
1093	return FALSE;
1094	}
1095	else if (h->Typ()==INTMAT_CMD)
1096	{
1097	res->data=(char )singflint_LLL((intvec)h->Data(), NULL);
1098	return FALSE;
1099	}
1100	else return TRUE;
1101	}
1102	// This will give also the transformation matrix U s.t. res = U * m
1103	if((long)(h->next->Data()) == 1)
1104	{
1105	if (h->Typ()==BIGINTMAT_CMD)
1106	{
1107	bigintmat* m = (bigintmat*)h->Data();
1108	bigintmat* T = new bigintmat(m->rows(),m->rows(),m->basecoeffs());
1109	for(int i = 1; i<=m->rows(); i++)
1110	{
1111	n_Delete(&(BIMATELEM(*T,i,i)),T->basecoeffs());
1112	BIMATELEM(*T,i,i)=n_Init(1, T->basecoeffs());
1113	}
1114	m = singflint_LLL(m,T);
1115	lists L = (lists)omAllocBin(slists_bin);
1116	L->Init(2);
1117	L->m[0].rtyp = BIGINTMAT_CMD; L->m[0].data = (void*)m;
1118	L->m[1].rtyp = BIGINTMAT_CMD; L->m[1].data = (void*)T;
1119	res->data=L;
1120	res->rtyp=LIST_CMD;
1121	return FALSE;
1122	}
1123	else if (h->Typ()==INTMAT_CMD)
1124	{
1125	intvec* m = (intvec*)h->Data();
1126	intvec* T = new intvec(m->rows(),m->rows(),(int)0);
1127	for(int i = 1; i<=m->rows(); i++)
1128	IMATELEM(*T,i,i)=1;
1129	m = singflint_LLL(m,T);
1130	lists L = (lists)omAllocBin(slists_bin);
1131	L->Init(2);
1132	L->m[0].rtyp = INTMAT_CMD; L->m[0].data = (void*)m;
1133	L->m[1].rtyp = INTMAT_CMD; L->m[1].data = (void*)T;
1134	res->data=L;
1135	res->rtyp=LIST_CMD;
1136	return FALSE;
1137	}
1138	else return TRUE;
1139	}
1140	}
1141
1142	}
1143	else return TRUE;
1144	}
1145	else
1146	#endif
1147	#endif
1148	/==================== pcv ==================================/
1149	#ifdef HAVE_PCV
1150	if(strcmp(sys_cmd,"pcvLAddL")==0)
1151	{
1152	return pcvLAddL(res,h);
1153	}
1154	else
1155	if(strcmp(sys_cmd,"pcvPMulL")==0)
1156	{
1157	return pcvPMulL(res,h);
1158	}
1159	else
1160	if(strcmp(sys_cmd,"pcvMinDeg")==0)
1161	{
1162	return pcvMinDeg(res,h);
1163	}
1164	else
1165	if(strcmp(sys_cmd,"pcvP2CV")==0)
1166	{
1167	return pcvP2CV(res,h);
1168	}
1169	else
1170	if(strcmp(sys_cmd,"pcvCV2P")==0)
1171	{
1172	return pcvCV2P(res,h);
1173	}
1174	else
1175	if(strcmp(sys_cmd,"pcvDim")==0)
1176	{
1177	return pcvDim(res,h);
1178	}
1179	else
1180	if(strcmp(sys_cmd,"pcvBasis")==0)
1181	{
1182	return pcvBasis(res,h);
1183	}
1184	else
1185	#endif
1186	/==================== hessenberg/eigenvalues ==================================/
1187	#ifdef HAVE_EIGENVAL
1188	if(strcmp(sys_cmd,"hessenberg")==0)
1189	{
1190	return evHessenberg(res,h);
1191	}
1192	else
1193	#endif
1194	/==================== eigenvalues ==================================/
1195	#ifdef HAVE_EIGENVAL
1196	if(strcmp(sys_cmd,"eigenvals")==0)
1197	{
1198	return evEigenvals(res,h);
1199	}
1200	else
1201	#endif
1202	/==================== rowelim ==================================/
1203	#ifdef HAVE_EIGENVAL
1204	if(strcmp(sys_cmd,"rowelim")==0)
1205	{
1206	return evRowElim(res,h);
1207	}
1208	else
1209	#endif
1210	/==================== rowcolswap ==================================/
1211	#ifdef HAVE_EIGENVAL
1212	if(strcmp(sys_cmd,"rowcolswap")==0)
1213	{
1214	return evSwap(res,h);
1215	}
1216	else
1217	#endif
1218	/==================== Gauss-Manin system ==================================/
1219	#ifdef HAVE_GMS
1220	if(strcmp(sys_cmd,"gmsnf")==0)
1221	{
1222	return gmsNF(res,h);
1223	}
1224	else
1225	#endif
1226	/==================== contributors =============================/
1227	if(strcmp(sys_cmd,"contributors") == 0)
1228	{
1229	res->rtyp=STRING_CMD;
1230	res->data=(void *)omStrDup(
1231	"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");
1232	return FALSE;
1233	}
1234	else
1235	/==================== spectrum =============================/
1236	#ifdef HAVE_SPECTRUM
1237	if(strcmp(sys_cmd,"spectrum") == 0)
1238	{
1239	if ((h==NULL) \|\| (h->Typ()!=POLY_CMD))
1240	{
1241	WerrorS("poly expected");
1242	return TRUE;
1243	}
1244	if (h->next==NULL)
1245	return spectrumProc(res,h);
1246	if (h->next->Typ()!=INT_CMD)
1247	{
1248	WerrorS("poly,int expected");
1249	return TRUE;
1250	}
1251	if(((long)h->next->Data())==1L)
1252	return spectrumfProc(res,h);
1253	return spectrumProc(res,h);
1254	}
1255	else
1256	/==================== semic =============================/
1257	if(strcmp(sys_cmd,"semic") == 0)
1258	{
1259	if ((h->next!=NULL)
1260	&& (h->Typ()==LIST_CMD)
1261	&& (h->next->Typ()==LIST_CMD))
1262	{
1263	if (h->next->next==NULL)
1264	return semicProc(res,h,h->next);
1265	else if (h->next->next->Typ()==INT_CMD)
1266	return semicProc3(res,h,h->next,h->next->next);
1267	}
1268	return TRUE;
1269	}
1270	else
1271	/==================== spadd =============================/
1272	if(strcmp(sys_cmd,"spadd") == 0)
1273	{
1274	const short t[]={2,LIST_CMD,LIST_CMD};
1275	if (iiCheckTypes(h,t,1))
1276	{
1277	return spaddProc(res,h,h->next);
1278	}
1279	return TRUE;
1280	}
1281	else
1282	/==================== spmul =============================/
1283	if(strcmp(sys_cmd,"spmul") == 0)
1284	{
1285	const short t[]={2,LIST_CMD,INT_CMD};
1286	if (iiCheckTypes(h,t,1))
1287	{
1288	return spmulProc(res,h,h->next);
1289	}
1290	return TRUE;
1291	}
1292	else
1293	#endif
1294	/==================== tensorModuleMult ========================= /
1295	#define HAVE_SHEAFCOH_TRICKS 1
1296
1297	#ifdef HAVE_SHEAFCOH_TRICKS
1298	if(strcmp(sys_cmd,"tensorModuleMult")==0)
1299	{
1300	const short t[]={2,INT_CMD,MODUL_CMD};
1301	// WarnS("tensorModuleMult!");
1302	if (iiCheckTypes(h,t,1))
1303	{
1304	int m = (int)( (long)h->Data() );
1305	ideal M = (ideal)h->next->Data();
1306	res->rtyp=MODUL_CMD;
1307	res->data=(void *)id_TensorModuleMult(m, M, currRing);
1308	return FALSE;
1309	}
1310	return TRUE;
1311	}
1312	else
1313	#endif
1314	/==================== twostd =================/
1315	#ifdef HAVE_PLURAL
1316	if (strcmp(sys_cmd, "twostd") == 0)
1317	{
1318	ideal I;
1319	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1320	{
1321	I=(ideal)h->CopyD();
1322	res->rtyp=IDEAL_CMD;
1323	if (rIsPluralRing(currRing)) res->data=twostd(I);
1324	else res->data=I;
1325	setFlag(res,FLAG_TWOSTD);
1326	setFlag(res,FLAG_STD);
1327	}
1328	else return TRUE;
1329	return FALSE;
1330	}
1331	else
1332	#endif
1333	/==================== lie bracket =================/
1334	#ifdef HAVE_PLURAL
1335	if (strcmp(sys_cmd, "bracket") == 0)
1336	{
1337	const short t[]={2,POLY_CMD,POLY_CMD};
1338	if (iiCheckTypes(h,t,1))
1339	{
1340	poly p=(poly)h->CopyD();
1341	h=h->next;
1342	poly q=(poly)h->Data();
1343	res->rtyp=POLY_CMD;
1344	if (rIsPluralRing(currRing)) res->data=nc_p_Bracket_qq(p,q, currRing);
1345	return FALSE;
1346	}
1347	return TRUE;
1348	}
1349	else
1350	#endif
1351	/==================== env ==================================/
1352	#ifdef HAVE_PLURAL
1353	if (strcmp(sys_cmd, "env")==0)
1354	{
1355	if ((h!=NULL) && (h->Typ()==RING_CMD))
1356	{
1357	ring r = (ring)h->Data();
1358	res->data = rEnvelope(r);
1359	res->rtyp = RING_CMD;
1360	return FALSE;
1361	}
1362	else
1363	{
1364	WerrorS("`system(\"env\",<ring>)` expected");
1365	return TRUE;
1366	}
1367	}
1368	else
1369	#endif
1370	/* ============ opp ======================== */
1371	#ifdef HAVE_PLURAL
1372	if (strcmp(sys_cmd, "opp")==0)
1373	{
1374	if ((h!=NULL) && (h->Typ()==RING_CMD))
1375	{
1376	ring r=(ring)h->Data();
1377	res->data=rOpposite(r);
1378	res->rtyp=RING_CMD;
1379	return FALSE;
1380	}
1381	else
1382	{
1383	WerrorS("`system(\"opp\",<ring>)` expected");
1384	return TRUE;
1385	}
1386	}
1387	else
1388	#endif
1389	/==================== oppose ==================================/
1390	#ifdef HAVE_PLURAL
1391	if (strcmp(sys_cmd, "oppose")==0)
1392	{
1393	if ((h!=NULL) && (h->Typ()==RING_CMD)
1394	&& (h->next!= NULL))
1395	{
1396	ring Rop = (ring)h->Data();
1397	h = h->next;
1398	idhdl w;
1399	if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1400	{
1401	poly p = (poly)IDDATA(w);
1402	res->data = pOppose(Rop, p, currRing); // into CurrRing?
1403	res->rtyp = POLY_CMD;
1404	return FALSE;
1405	}
1406	}
1407	else
1408	{
1409	WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1410	return TRUE;
1411	}
1412	}
1413	else
1414	#endif
1415	/==================== walk stuff =================/
1416	/==================== walkNextWeight =================/
1417	#ifdef HAVE_WALK
1418	#ifdef OWNW
1419	if (strcmp(sys_cmd, "walkNextWeight") == 0)
1420	{
1421	const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1422	if (!iiCheckTypes(h,t,1)) return TRUE;
1423	if (((intvec*) h->Data())->length() != currRing->N \|\|
1424	((intvec*) h->next->Data())->length() != currRing->N)
1425	{
1426	Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1427	currRing->N);
1428	return TRUE;
1429	}
1430	res->data = (void) walkNextWeight(((intvec) h->Data()),
1431	((intvec*) h->next->Data()),
1432	(ideal) h->next->next->Data());
1433	if (res->data == NULL \|\| res->data == (void*) 1L)
1434	{
1435	res->rtyp = INT_CMD;
1436	}
1437	else
1438	{
1439	res->rtyp = INTVEC_CMD;
1440	}
1441	return FALSE;
1442	}
1443	else
1444	#endif
1445	#endif
1446	/==================== walkNextWeight =================/
1447	#ifdef HAVE_WALK
1448	#ifdef OWNW
1449	if (strcmp(sys_cmd, "walkInitials") == 0)
1450	{
1451	if (h == NULL \|\| h->Typ() != IDEAL_CMD)
1452	{
1453	WerrorS("system(\"walkInitials\", ideal) expected");
1454	return TRUE;
1455	}
1456	res->data = (void*) walkInitials((ideal) h->Data());
1457	res->rtyp = IDEAL_CMD;
1458	return FALSE;
1459	}
1460	else
1461	#endif
1462	#endif
1463	/==================== walkAddIntVec =================/
1464	#ifdef HAVE_WALK
1465	#ifdef WAIV
1466	if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1467	{
1468	const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1469	if (!iiCheckTypes(h,t,1)) return TRUE;
1470	intvec* arg1 = (intvec*) h->Data();
1471	intvec* arg2 = (intvec*) h->next->Data();
1472	res->data = (intvec*) walkAddIntVec(arg1, arg2);
1473	res->rtyp = INTVEC_CMD;
1474	return FALSE;
1475	}
1476	else
1477	#endif
1478	#endif
1479	/==================== MwalkNextWeight =================/
1480	#ifdef HAVE_WALK
1481	#ifdef MwaklNextWeight
1482	if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1483	{
1484	const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1485	if (!iiCheckTypes(h,t,1)) return TRUE;
1486	if (((intvec*) h->Data())->length() != currRing->N \|\|
1487	((intvec*) h->next->Data())->length() != currRing->N)
1488	{
1489	Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1490	currRing->N);
1491	return TRUE;
1492	}
1493	intvec* arg1 = (intvec*) h->Data();
1494	intvec* arg2 = (intvec*) h->next->Data();
1495	ideal arg3 = (ideal) h->next->next->Data();
1496	intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1497	res->rtyp = INTVEC_CMD;
1498	res->data = result;
1499	return FALSE;
1500	}
1501	else
1502	#endif //MWalkNextWeight
1503	#endif
1504	/==================== Mivdp =================/
1505	#ifdef HAVE_WALK
1506	if(strcmp(sys_cmd, "Mivdp") == 0)
1507	{
1508	if (h == NULL \|\| h->Typ() != INT_CMD)
1509	{
1510	WerrorS("system(\"Mivdp\", int) expected");
1511	return TRUE;
1512	}
1513	if ((int) ((long)(h->Data())) != currRing->N)
1514	{
1515	Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1516	currRing->N);
1517	return TRUE;
1518	}
1519	int arg1 = (int) ((long)(h->Data()));
1520	intvec* result = (intvec*) Mivdp(arg1);
1521	res->rtyp = INTVEC_CMD;
1522	res->data = result;
1523	return FALSE;
1524	}
1525	else
1526	#endif
1527	/==================== Mivlp =================/
1528	#ifdef HAVE_WALK
1529	if(strcmp(sys_cmd, "Mivlp") == 0)
1530	{
1531	if (h == NULL \|\| h->Typ() != INT_CMD)
1532	{
1533	WerrorS("system(\"Mivlp\", int) expected");
1534	return TRUE;
1535	}
1536	if ((int) ((long)(h->Data())) != currRing->N)
1537	{
1538	Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1539	currRing->N);
1540	return TRUE;
1541	}
1542	int arg1 = (int) ((long)(h->Data()));
1543	intvec* result = (intvec*) Mivlp(arg1);
1544	res->rtyp = INTVEC_CMD;
1545	res->data = result;
1546	return FALSE;
1547	}
1548	else
1549	#endif
1550	/==================== MpDiv =================/
1551	#ifdef HAVE_WALK
1552	#ifdef MpDiv
1553	if(strcmp(sys_cmd, "MpDiv") == 0)
1554	{
1555	const short t[]={2,POLY_CMD,POLY_CMD};
1556	if (!iiCheckTypes(h,t,1)) return TRUE;
1557	poly arg1 = (poly) h->Data();
1558	poly arg2 = (poly) h->next->Data();
1559	poly result = MpDiv(arg1, arg2);
1560	res->rtyp = POLY_CMD;
1561	res->data = result;
1562	return FALSE;
1563	}
1564	else
1565	#endif
1566	#endif
1567	/==================== MpMult =================/
1568	#ifdef HAVE_WALK
1569	#ifdef MpMult
1570	if(strcmp(sys_cmd, "MpMult") == 0)
1571	{
1572	const short t[]={2,POLY_CMD,POLY_CMD};
1573	if (!iiCheckTypes(h,t,1)) return TRUE;
1574	poly arg1 = (poly) h->Data();
1575	poly arg2 = (poly) h->next->Data();
1576	poly result = MpMult(arg1, arg2);
1577	res->rtyp = POLY_CMD;
1578	res->data = result;
1579	return FALSE;
1580	}
1581	else
1582	#endif
1583	#endif
1584	/==================== MivSame =================/
1585	#ifdef HAVE_WALK
1586	if (strcmp(sys_cmd, "MivSame") == 0)
1587	{
1588	const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1589	if (!iiCheckTypes(h,t,1)) return TRUE;
1590	/*
1591	if (((intvec*) h->Data())->length() != currRing->N \|\|
1592	((intvec*) h->next->Data())->length() != currRing->N)
1593	{
1594	Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1595	currRing->N);
1596	return TRUE;
1597	}
1598	*/
1599	intvec* arg1 = (intvec*) h->Data();
1600	intvec* arg2 = (intvec*) h->next->Data();
1601	/*
1602	poly result = (poly) MivSame(arg1, arg2);
1603	res->rtyp = POLY_CMD;
1604	res->data = (poly) result;
1605	*/
1606	res->rtyp = INT_CMD;
1607	res->data = (void*)(long) MivSame(arg1, arg2);
1608	return FALSE;
1609	}
1610	else
1611	#endif
1612	/==================== M3ivSame =================/
1613	#ifdef HAVE_WALK
1614	if (strcmp(sys_cmd, "M3ivSame") == 0)
1615	{
1616	const short t[]={3,INTVEC_CMD,INTVEC_CMD,INTVEC_CMD};
1617	if (!iiCheckTypes(h,t,1)) return TRUE;
1618	/*
1619	if (((intvec*) h->Data())->length() != currRing->N \|\|
1620	((intvec*) h->next->Data())->length() != currRing->N \|\|
1621	((intvec*) h->next->next->Data())->length() != currRing->N )
1622	{
1623	Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1624	currRing->N);
1625	return TRUE;
1626	}
1627	*/
1628	intvec* arg1 = (intvec*) h->Data();
1629	intvec* arg2 = (intvec*) h->next->Data();
1630	intvec* arg3 = (intvec*) h->next->next->Data();
1631	/*
1632	poly result = (poly) M3ivSame(arg1, arg2, arg3);
1633	res->rtyp = POLY_CMD;
1634	res->data = (poly) result;
1635	*/
1636	res->rtyp = INT_CMD;
1637	res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1638	return FALSE;
1639	}
1640	else
1641	#endif
1642	/==================== MwalkInitialForm =================/
1643	#ifdef HAVE_WALK
1644	if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1645	{
1646	const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1647	if (!iiCheckTypes(h,t,1)) return TRUE;
1648	if(((intvec*) h->next->Data())->length() != currRing->N)
1649	{
1650	Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1651	currRing->N);
1652	return TRUE;
1653	}
1654	ideal id = (ideal) h->Data();
1655	intvec* int_w = (intvec*) h->next->Data();
1656	ideal result = (ideal) MwalkInitialForm(id, int_w);
1657	res->rtyp = IDEAL_CMD;
1658	res->data = result;
1659	return FALSE;
1660	}
1661	else
1662	#endif
1663	/==================== MivMatrixOrder =================/
1664	#ifdef HAVE_WALK
1665	/************ Perturbation walk ********/
1666	if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1667	{
1668	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1669	{
1670	WerrorS("system(\"MivMatrixOrder\",intvec) expected");
1671	return TRUE;
1672	}
1673	intvec* arg1 = (intvec*) h->Data();
1674	intvec* result = MivMatrixOrder(arg1);
1675	res->rtyp = INTVEC_CMD;
1676	res->data = result;
1677	return FALSE;
1678	}
1679	else
1680	#endif
1681	/==================== MivMatrixOrderdp =================/
1682	#ifdef HAVE_WALK
1683	if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1684	{
1685	if(h==NULL \|\| h->Typ() != INT_CMD)
1686	{
1687	WerrorS("system(\"MivMatrixOrderdp\",intvec) expected");
1688	return TRUE;
1689	}
1690	int arg1 = (int) ((long)(h->Data()));
1691	intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1692	res->rtyp = INTVEC_CMD;
1693	res->data = result;
1694	return FALSE;
1695	}
1696	else
1697	#endif
1698	/==================== MPertVectors =================/
1699	#ifdef HAVE_WALK
1700	if(strcmp(sys_cmd, "MPertVectors") == 0)
1701	{
1702	const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1703	if (!iiCheckTypes(h,t,1)) return TRUE;
1704	ideal arg1 = (ideal) h->Data();
1705	intvec* arg2 = (intvec*) h->next->Data();
1706	int arg3 = (int) ((long)(h->next->next->Data()));
1707	intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1708	res->rtyp = INTVEC_CMD;
1709	res->data = result;
1710	return FALSE;
1711	}
1712	else
1713	#endif
1714	/==================== MPertVectorslp =================/
1715	#ifdef HAVE_WALK
1716	if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1717	{
1718	const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1719	if (!iiCheckTypes(h,t,1)) return TRUE;
1720	ideal arg1 = (ideal) h->Data();
1721	intvec* arg2 = (intvec*) h->next->Data();
1722	int arg3 = (int) ((long)(h->next->next->Data()));
1723	intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1724	res->rtyp = INTVEC_CMD;
1725	res->data = result;
1726	return FALSE;
1727	}
1728	else
1729	#endif
1730	/************ fractal walk ********/
1731	#ifdef HAVE_WALK
1732	if(strcmp(sys_cmd, "Mfpertvector") == 0)
1733	{
1734	const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1735	if (!iiCheckTypes(h,t,1)) return TRUE;
1736	ideal arg1 = (ideal) h->Data();
1737	intvec* arg2 = (intvec*) h->next->Data();
1738	intvec* result = Mfpertvector(arg1, arg2);
1739	res->rtyp = INTVEC_CMD;
1740	res->data = result;
1741	return FALSE;
1742	}
1743	else
1744	#endif
1745	/==================== MivUnit =================/
1746	#ifdef HAVE_WALK
1747	if(strcmp(sys_cmd, "MivUnit") == 0)
1748	{
1749	const short t[]={1,INT_CMD};
1750	if (!iiCheckTypes(h,t,1)) return TRUE;
1751	int arg1 = (int) ((long)(h->Data()));
1752	intvec* result = (intvec*) MivUnit(arg1);
1753	res->rtyp = INTVEC_CMD;
1754	res->data = result;
1755	return FALSE;
1756	}
1757	else
1758	#endif
1759	/==================== MivWeightOrderlp =================/
1760	#ifdef HAVE_WALK
1761	if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1762	{
1763	const short t[]={1,INTVEC_CMD};
1764	if (!iiCheckTypes(h,t,1)) return TRUE;
1765	intvec* arg1 = (intvec*) h->Data();
1766	intvec* result = MivWeightOrderlp(arg1);
1767	res->rtyp = INTVEC_CMD;
1768	res->data = result;
1769	return FALSE;
1770	}
1771	else
1772	#endif
1773	/==================== MivWeightOrderdp =================/
1774	#ifdef HAVE_WALK
1775	if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1776	{
1777	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1778	{
1779	WerrorS("system(\"MivWeightOrderdp\",intvec) expected");
1780	return TRUE;
1781	}
1782	intvec* arg1 = (intvec*) h->Data();
1783	//int arg2 = (int) h->next->Data();
1784	intvec* result = MivWeightOrderdp(arg1);
1785	res->rtyp = INTVEC_CMD;
1786	res->data = result;
1787	return FALSE;
1788	}
1789	else
1790	#endif
1791	/==================== MivMatrixOrderlp =================/
1792	#ifdef HAVE_WALK
1793	if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1794	{
1795	if(h==NULL \|\| h->Typ() != INT_CMD)
1796	{
1797	WerrorS("system(\"MivMatrixOrderlp\",int) expected");
1798	return TRUE;
1799	}
1800	int arg1 = (int) ((long)(h->Data()));
1801	intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1802	res->rtyp = INTVEC_CMD;
1803	res->data = result;
1804	return FALSE;
1805	}
1806	else
1807	#endif
1808	/==================== MkInterRedNextWeight =================/
1809	#ifdef HAVE_WALK
1810	if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1811	{
1812	const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1813	if (!iiCheckTypes(h,t,1)) return TRUE;
1814	if (((intvec*) h->Data())->length() != currRing->N \|\|
1815	((intvec*) h->next->Data())->length() != currRing->N)
1816	{
1817	Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1818	currRing->N);
1819	return TRUE;
1820	}
1821	intvec* arg1 = (intvec*) h->Data();
1822	intvec* arg2 = (intvec*) h->next->Data();
1823	ideal arg3 = (ideal) h->next->next->Data();
1824	intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1825	res->rtyp = INTVEC_CMD;
1826	res->data = result;
1827	return FALSE;
1828	}
1829	else
1830	#endif
1831	/==================== MPertNextWeight =================/
1832	#ifdef HAVE_WALK
1833	#ifdef MPertNextWeight
1834	if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1835	{
1836	const short t[]={3,INTVEC_CMD,IDEAL_CMD,INT_CMD};
1837	if (!iiCheckTypes(h,t,1)) return TRUE;
1838	if (((intvec*) h->Data())->length() != currRing->N)
1839	{
1840	Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1841	currRing->N);
1842	return TRUE;
1843	}
1844	intvec* arg1 = (intvec*) h->Data();
1845	ideal arg2 = (ideal) h->next->Data();
1846	int arg3 = (int) h->next->next->Data();
1847	intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1848	res->rtyp = INTVEC_CMD;
1849	res->data = result;
1850	return FALSE;
1851	}
1852	else
1853	#endif //MPertNextWeight
1854	#endif
1855	/==================== Mivperttarget =================/
1856	#ifdef HAVE_WALK
1857	#ifdef Mivperttarget
1858	if (strcmp(sys_cmd, "Mivperttarget") == 0)
1859	{
1860	const short t[]={2,IDEAL_CMD,INT_CMD};
1861	if (!iiCheckTypes(h,t,1)) return TRUE;
1862	ideal arg1 = (ideal) h->Data();
1863	int arg2 = (int) h->next->Data();
1864	intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1865	res->rtyp = INTVEC_CMD;
1866	res->data = result;
1867	return FALSE;
1868	}
1869	else
1870	#endif //Mivperttarget
1871	#endif
1872	/==================== Mwalk =================/
1873	#ifdef HAVE_WALK
1874	if (strcmp(sys_cmd, "Mwalk") == 0)
1875	{
1876	const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD,INT_CMD,INT_CMD};
1877	if (!iiCheckTypes(h,t,1)) return TRUE;
1878	if (((intvec*) h->next->Data())->length() != currRing->N &&
1879	((intvec*) h->next->next->Data())->length() != currRing->N )
1880	{
1881	Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1882	currRing->N);
1883	return TRUE;
1884	}
1885	ideal arg1 = (ideal) h->CopyD();
1886	intvec* arg2 = (intvec*) h->next->Data();
1887	intvec* arg3 = (intvec*) h->next->next->Data();
1888	ring arg4 = (ring) h->next->next->next->Data();
1889	int arg5 = (int) (long) h->next->next->next->next->Data();
1890	int arg6 = (int) (long) h->next->next->next->next->next->Data();
1891	ideal result = (ideal) Mwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1892	res->rtyp = IDEAL_CMD;
1893	res->data = result;
1894	return FALSE;
1895	}
1896	else
1897	#endif
1898	/==================== Mpwalk =================/
1899	#ifdef HAVE_WALK
1900	#ifdef MPWALK_ORIG
1901	if (strcmp(sys_cmd, "Mwalk") == 0)
1902	{
1903	const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
1904	if (!iiCheckTypes(h,t,1)) return TRUE;
1905	if ((((intvec*) h->next->Data())->length() != currRing->N &&
1906	((intvec*) h->next->next->Data())->length() != currRing->N ) &&
1907	(((intvec) h->next->Data())->length() != (currRing->N)(currRing->N) &&
1908	((intvec) h->next->next->Data())->length() != (currRing->N)(currRing->N)))
1909	{
1910	Werror("system(\"Mwalk\" ...) intvecs not of length %d or %d\n",
1911	currRing->N,(currRing->N)*(currRing->N));
1912	return TRUE;
1913	}
1914	ideal arg1 = (ideal) h->Data();
1915	intvec* arg2 = (intvec*) h->next->Data();
1916	intvec* arg3 = (intvec*) h->next->next->Data();
1917	ring arg4 = (ring) h->next->next->next->Data();
1918	ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
1919	res->rtyp = IDEAL_CMD;
1920	res->data = result;
1921	return FALSE;
1922	}
1923	else
1924	#else
1925	if (strcmp(sys_cmd, "Mpwalk") == 0)
1926	{
1927	const short t[]={8,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
1928	if (!iiCheckTypes(h,t,1)) return TRUE;
1929	if(((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1930	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1931	{
1932	Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",currRing->N);
1933	return TRUE;
1934	}
1935	ideal arg1 = (ideal) h->Data();
1936	int arg2 = (int) (long) h->next->Data();
1937	int arg3 = (int) (long) h->next->next->Data();
1938	intvec* arg4 = (intvec*) h->next->next->next->Data();
1939	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1940	int arg6 = (int) (long) h->next->next->next->next->next->Data();
1941	int arg7 = (int) (long) h->next->next->next->next->next->next->Data();
1942	int arg8 = (int) (long) h->next->next->next->next->next->next->next->Data();
1943	ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
1944	res->rtyp = IDEAL_CMD;
1945	res->data = result;
1946	return FALSE;
1947	}
1948	else
1949	#endif
1950	#endif
1951	/==================== Mrwalk =================/
1952	#ifdef HAVE_WALK
1953	if (strcmp(sys_cmd, "Mrwalk") == 0)
1954	{
1955	const short t[]={7,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
1956	if (!iiCheckTypes(h,t,1)) return TRUE;
1957	if(((intvec*) h->next->Data())->length() != currRing->N &&
1958	((intvec) h->next->Data())->length() != (currRing->N)(currRing->N) &&
1959	((intvec*) h->next->next->Data())->length() != currRing->N &&
1960	((intvec) h->next->next->Data())->length() != (currRing->N)(currRing->N) )
1961	{
1962	Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
1963	currRing->N,(currRing->N)*(currRing->N));
1964	return TRUE;
1965	}
1966	ideal arg1 = (ideal) h->Data();
1967	intvec* arg2 = (intvec*) h->next->Data();
1968	intvec* arg3 = (intvec*) h->next->next->Data();
1969	int arg4 = (int)(long) h->next->next->next->Data();
1970	int arg5 = (int)(long) h->next->next->next->next->Data();
1971	int arg6 = (int)(long) h->next->next->next->next->next->Data();
1972	int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
1973	ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
1974	res->rtyp = IDEAL_CMD;
1975	res->data = result;
1976	return FALSE;
1977	}
1978	else
1979	#endif
1980	/==================== MAltwalk1 =================/
1981	#ifdef HAVE_WALK
1982	if (strcmp(sys_cmd, "MAltwalk1") == 0)
1983	{
1984	const short t[]={5,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD};
1985	if (!iiCheckTypes(h,t,1)) return TRUE;
1986	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1987	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1988	{
1989	Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
1990	currRing->N);
1991	return TRUE;
1992	}
1993	ideal arg1 = (ideal) h->Data();
1994	int arg2 = (int) ((long)(h->next->Data()));
1995	int arg3 = (int) ((long)(h->next->next->Data()));
1996	intvec* arg4 = (intvec*) h->next->next->next->Data();
1997	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1998	ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
1999	res->rtyp = IDEAL_CMD;
2000	res->data = result;
2001	return FALSE;
2002	}
2003	else
2004	#endif
2005	/==================== MAltwalk1 =================/
2006	#ifdef HAVE_WALK
2007	#ifdef MFWALK_ALT
2008	if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
2009	{
2010	const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2011	if (!iiCheckTypes(h,t,1)) return TRUE;
2012	if (((intvec*) h->next->Data())->length() != currRing->N &&
2013	((intvec*) h->next->next->Data())->length() != currRing->N )
2014	{
2015	Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2016	currRing->N);
2017	return TRUE;
2018	}
2019	ideal arg1 = (ideal) h->Data();
2020	intvec* arg2 = (intvec*) h->next->Data();
2021	intvec* arg3 = (intvec*) h->next->next->Data();
2022	int arg4 = (int) h->next->next->next->Data();
2023	ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
2024	res->rtyp = IDEAL_CMD;
2025	res->data = result;
2026	return FALSE;
2027	}
2028	else
2029	#endif
2030	#endif
2031	/==================== Mfwalk =================/
2032	#ifdef HAVE_WALK
2033	if (strcmp(sys_cmd, "Mfwalk") == 0)
2034	{
2035	const short t[]={5,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD};
2036	if (!iiCheckTypes(h,t,1)) return TRUE;
2037	if (((intvec*) h->next->Data())->length() != currRing->N &&
2038	((intvec*) h->next->next->Data())->length() != currRing->N )
2039	{
2040	Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2041	currRing->N);
2042	return TRUE;
2043	}
2044	ideal arg1 = (ideal) h->Data();
2045	intvec* arg2 = (intvec*) h->next->Data();
2046	intvec* arg3 = (intvec*) h->next->next->Data();
2047	int arg4 = (int)(long) h->next->next->next->Data();
2048	int arg5 = (int)(long) h->next->next->next->next->Data();
2049	ideal result = (ideal) Mfwalk(arg1, arg2, arg3, arg4, arg5);
2050	res->rtyp = IDEAL_CMD;
2051	res->data = result;
2052	return FALSE;
2053	}
2054	else
2055	#endif
2056	/==================== Mfrwalk =================/
2057	#ifdef HAVE_WALK
2058	if (strcmp(sys_cmd, "Mfrwalk") == 0)
2059	{
2060	const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
2061	if (!iiCheckTypes(h,t,1)) return TRUE;
2062	/*
2063	if (((intvec*) h->next->Data())->length() != currRing->N &&
2064	((intvec*) h->next->next->Data())->length() != currRing->N)
2065	{
2066	Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
2067	return TRUE;
2068	}
2069	*/
2070	if((((intvec*) h->next->Data())->length() != currRing->N &&
2071	((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2072	(((intvec) h->next->Data())->length() != (currRing->N)(currRing->N) &&
2073	((intvec) h->next->next->Data())->length() != (currRing->N)(currRing->N) ))
2074	{
2075	Werror("system(\"Mfrwalk\" ...) intvecs not of length %d or %d\n",
2076	currRing->N,(currRing->N)*(currRing->N));
2077	return TRUE;
2078	}
2079
2080	ideal arg1 = (ideal) h->Data();
2081	intvec* arg2 = (intvec*) h->next->Data();
2082	intvec* arg3 = (intvec*) h->next->next->Data();
2083	int arg4 = (int)(long) h->next->next->next->Data();
2084	int arg5 = (int)(long) h->next->next->next->next->Data();
2085	int arg6 = (int)(long) h->next->next->next->next->next->Data();
2086	ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2087	res->rtyp = IDEAL_CMD;
2088	res->data = result;
2089	return FALSE;
2090	}
2091	else
2092	/==================== Mprwalk =================/
2093	if (strcmp(sys_cmd, "Mprwalk") == 0)
2094	{
2095	const short t[]={9,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
2096	if (!iiCheckTypes(h,t,1)) return TRUE;
2097	if((((intvec*) h->next->Data())->length() != currRing->N &&
2098	((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2099	(((intvec) h->next->Data())->length() != (currRing->N)(currRing->N) &&
2100	((intvec) h->next->next->Data())->length() != (currRing->N)(currRing->N) ))
2101	{
2102	Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2103	currRing->N,(currRing->N)*(currRing->N));
2104	return TRUE;
2105	}
2106	ideal arg1 = (ideal) h->Data();
2107	intvec* arg2 = (intvec*) h->next->Data();
2108	intvec* arg3 = (intvec*) h->next->next->Data();
2109	int arg4 = (int)(long) h->next->next->next->Data();
2110	int arg5 = (int)(long) h->next->next->next->next->Data();
2111	int arg6 = (int)(long) h->next->next->next->next->next->Data();
2112	int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2113	int arg8 = (int)(long) h->next->next->next->next->next->next->next->Data();
2114	int arg9 = (int)(long) h->next->next->next->next->next->next->next->next->Data();
2115	ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
2116	res->rtyp = IDEAL_CMD;
2117	res->data = result;
2118	return FALSE;
2119	}
2120	else
2121	#endif
2122	/==================== TranMImprovwalk =================/
2123	#ifdef HAVE_WALK
2124	#ifdef TRAN_Orig
2125	if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2126	{
2127	const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2128	if (!iiCheckTypes(h,t,1)) return TRUE;
2129	if (((intvec*) h->next->Data())->length() != currRing->N &&
2130	((intvec*) h->next->next->Data())->length() != currRing->N )
2131	{
2132	Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2133	currRing->N);
2134	return TRUE;
2135	}
2136	ideal arg1 = (ideal) h->Data();
2137	intvec* arg2 = (intvec*) h->next->Data();
2138	intvec* arg3 = (intvec*) h->next->next->Data();
2139	ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
2140	res->rtyp = IDEAL_CMD;
2141	res->data = result;
2142	return FALSE;
2143	}
2144	else
2145	#endif
2146	#endif
2147	/==================== MAltwalk2 =================/
2148	#ifdef HAVE_WALK
2149	if (strcmp(sys_cmd, "MAltwalk2") == 0)
2150	{
2151	const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2152	if (!iiCheckTypes(h,t,1)) return TRUE;
2153	if (((intvec*) h->next->Data())->length() != currRing->N &&
2154	((intvec*) h->next->next->Data())->length() != currRing->N )
2155	{
2156	Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
2157	currRing->N);
2158	return TRUE;
2159	}
2160	ideal arg1 = (ideal) h->Data();
2161	intvec* arg2 = (intvec*) h->next->Data();
2162	intvec* arg3 = (intvec*) h->next->next->Data();
2163	ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
2164	res->rtyp = IDEAL_CMD;
2165	res->data = result;
2166	return FALSE;
2167	}
2168	else
2169	#endif
2170	/==================== MAltwalk2 =================/
2171	#ifdef HAVE_WALK
2172	if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2173	{
2174	const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2175	if (!iiCheckTypes(h,t,1)) return TRUE;
2176	if (((intvec*) h->next->Data())->length() != currRing->N &&
2177	((intvec*) h->next->next->Data())->length() != currRing->N )
2178	{
2179	Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2180	currRing->N);
2181	return TRUE;
2182	}
2183	ideal arg1 = (ideal) h->Data();
2184	intvec* arg2 = (intvec*) h->next->Data();
2185	intvec* arg3 = (intvec*) h->next->next->Data();
2186	int arg4 = (int) ((long)(h->next->next->next->Data()));
2187	ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
2188	res->rtyp = IDEAL_CMD;
2189	res->data = result;
2190	return FALSE;
2191	}
2192	else
2193	#endif
2194	/==================== TranMrImprovwalk =================/
2195	#if 0
2196	#ifdef HAVE_WALK
2197	if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
2198	{
2199	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
2200	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
2201	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD \|\|
2202	h->next->next->next == NULL \|\| h->next->next->next->Typ() != INT_CMD \|\|
2203	h->next->next->next == NULL \|\| h->next->next->next->next->Typ() != INT_CMD \|\|
2204	h->next->next->next == NULL \|\| h->next->next->next->next->next->Typ() != INT_CMD)
2205	{
2206	WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
2207	return TRUE;
2208	}
2209	if (((intvec*) h->next->Data())->length() != currRing->N &&
2210	((intvec*) h->next->next->Data())->length() != currRing->N )
2211	{
2212	Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
2213	return TRUE;
2214	}
2215	ideal arg1 = (ideal) h->Data();
2216	intvec* arg2 = (intvec*) h->next->Data();
2217	intvec* arg3 = (intvec*) h->next->next->Data();
2218	int arg4 = (int)(long) h->next->next->next->Data();
2219	int arg5 = (int)(long) h->next->next->next->next->Data();
2220	int arg6 = (int)(long) h->next->next->next->next->next->Data();
2221	ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2222	res->rtyp = IDEAL_CMD;
2223	res->data = result;
2224	return FALSE;
2225	}
2226	else
2227	#endif
2228	#endif
2229	/================= Extended system call ========================/
2230	{
2231	#ifndef MAKE_DISTRIBUTION
2232	return(jjEXTENDED_SYSTEM(res, args));
2233	#else
2234	Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
2235	#endif
2236	}
2237	} /* typ==string */
2238	return TRUE;
2239	}
2240
2241
2242	#ifdef HAVE_EXTENDED_SYSTEM
2243	// You can put your own system calls here
2244	# include "kernel/fglm/fglm.h"
2245	# ifdef HAVE_NEWTON
2246	# include "hc_newton.h"
2247	# endif
2248	# include "polys/mod_raw.h"
2249	# include "polys/monomials/ring.h"
2250	# include "kernel/GBEngine/shiftgb.h"
2251	# include "kernel/GBEngine/kutil.h"
2252
2253	static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
2254	{
2255	if(h->Typ() == STRING_CMD)
2256	{
2257	char sys_cmd=(char )(h->Data());
2258	h=h->next;
2259	/==================== test syz strat =================/
2260	if (strcmp(sys_cmd, "syz") == 0)
2261	{
2262	if ((h!=NULL) && (h->Typ()==STRING_CMD))
2263	{
2264	const char s=(const char )h->Data();
2265	if (strcmp(s,"posInT_EcartFDegpLength")==0)
2266	test_PosInT=posInT_EcartFDegpLength;
2267	else if (strcmp(s,"posInT_FDegpLength")==0)
2268	test_PosInT=posInT_FDegpLength;
2269	else if (strcmp(s,"posInT_pLength")==0)
2270	test_PosInT=posInT_pLength;
2271	else if (strcmp(s,"posInT0")==0)
2272	test_PosInT=posInT0;
2273	else if (strcmp(s,"posInT1")==0)
2274	test_PosInT=posInT1;
2275	else if (strcmp(s,"posInT2")==0)
2276	test_PosInT=posInT2;
2277	else if (strcmp(s,"posInT11")==0)
2278	test_PosInT=posInT11;
2279	else if (strcmp(s,"posInT110")==0)
2280	test_PosInT=posInT110;
2281	else if (strcmp(s,"posInT13")==0)
2282	test_PosInT=posInT13;
2283	else if (strcmp(s,"posInT15")==0)
2284	test_PosInT=posInT15;
2285	else if (strcmp(s,"posInT17")==0)
2286	test_PosInT=posInT17;
2287	else if (strcmp(s,"posInT17_c")==0)
2288	test_PosInT=posInT17_c;
2289	else if (strcmp(s,"posInT19")==0)
2290	test_PosInT=posInT19;
2291	else PrintS("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2292	}
2293	else
2294	{
2295	test_PosInT=NULL;
2296	test_PosInL=NULL;
2297	}
2298	si_opt_2\|=Sy_bit(23);
2299	return FALSE;
2300	}
2301	else
2302	/==================== locNF ======================================/
2303	if(strcmp(sys_cmd,"locNF")==0)
2304	{
2305	const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2306	if (iiCheckTypes(h,t,1))
2307	{
2308	poly f=(poly)h->Data();
2309	h=h->next;
2310	ideal m=(ideal)h->Data();
2311	assumeStdFlag(h);
2312	h=h->next;
2313	int n=(int)((long)h->Data());
2314	h=h->next;
2315	intvec v=(intvec )h->Data();
2316
2317	/* == now the work starts == */
2318
2319	short * iv=iv2array(v, currRing);
2320	poly r=0;
2321	poly hp=ppJetW(f,n,iv);
2322	int s=MATCOLS(m);
2323	int j=0;
2324	matrix T=mp_InitI(s,1,0, currRing);
2325
2326	while (hp != NULL)
2327	{
2328	if (pDivisibleBy(m->m[j],hp))
2329	{
2330	if (MATELEM(T,j+1,1)==0)
2331	{
2332	MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2333	}
2334	else
2335	{
2336	pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2337	}
2338	hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2339	j=0;
2340	}
2341	else
2342	{
2343	if (j==s-1)
2344	{
2345	r=pAdd(r,pHead(hp));
2346	hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2347	j=0;
2348	}
2349	else
2350	{
2351	j++;
2352	}
2353	}
2354	}
2355
2356	matrix Temp=mp_Transp((matrix) id_Vec2Ideal(r, currRing), currRing);
2357	matrix R=mpNew(MATCOLS((matrix) id_Vec2Ideal(f, currRing)),1);
2358	for (int k=1;k<=MATROWS(Temp);k++)
2359	{
2360	MATELEM(R,k,1)=MATELEM(Temp,k,1);
2361	}
2362
2363	lists L=(lists)omAllocBin(slists_bin);
2364	L->Init(2);
2365	L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
2366	L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
2367	res->data=L;
2368	res->rtyp=LIST_CMD;
2369	// iv aufraeumen
2370	omFree(iv);
2371	return FALSE;
2372	}
2373	else
2374	return TRUE;
2375	}
2376	else
2377	/==================== poly debug ==================================/
2378	if(strcmp(sys_cmd,"p")==0)
2379	{
2380	# ifdef RDEBUG
2381	p_DebugPrint((poly)h->Data(), currRing);
2382	# else
2383	WarnS("Sorry: not available for release build!");
2384	# endif
2385	return FALSE;
2386	}
2387	else
2388	/==================== setsyzcomp ==================================/
2389	if(strcmp(sys_cmd,"setsyzcomp")==0)
2390	{
2391	if ((h!=NULL) && (h->Typ()==INT_CMD))
2392	{
2393	int k = (int)(long)h->Data();
2394	if ( currRing->order[0] == ringorder_s )
2395	{
2396	rSetSyzComp(k, currRing);
2397	}
2398	}
2399	}
2400	/==================== ring debug ==================================/
2401	if(strcmp(sys_cmd,"r")==0)
2402	{
2403	# ifdef RDEBUG
2404	rDebugPrint((ring)h->Data());
2405	# else
2406	WarnS("Sorry: not available for release build!");
2407	# endif
2408	return FALSE;
2409	}
2410	else
2411	/==================== changeRing ========================/
2412	/* The following code changes the names of the variables in the
2413	current ring to "x1", "x2", ..., "xN", where N is the number
2414	of variables in the current ring.
2415	The purpose of this rewriting is to eliminate indexed variables,
2416	as they may cause problems when generating scripts for Magma,
2417	Maple, or Macaulay2. */
2418	if(strcmp(sys_cmd,"changeRing")==0)
2419	{
2420	int varN = currRing->N;
2421	char h[10];
2422	for (int i = 1; i <= varN; i++)
2423	{
2424	omFree(currRing->names[i - 1]);
2425	sprintf(h, "x%d", i);
2426	currRing->names[i - 1] = omStrDup(h);
2427	}
2428	rComplete(currRing);
2429	res->rtyp = INT_CMD;
2430	res->data = (void*)0L;
2431	return FALSE;
2432	}
2433	else
2434	/==================== mtrack ==================================/
2435	if(strcmp(sys_cmd,"mtrack")==0)
2436	{
2437	#ifdef OM_TRACK
2438	om_Opts.MarkAsStatic = 1;
2439	FILE *fd = NULL;
2440	int max = 5;
2441	while (h != NULL)
2442	{
2443	omMarkAsStaticAddr(h);
2444	if (fd == NULL && h->Typ()==STRING_CMD)
2445	{
2446	char fn=(char) h->Data();
2447	fd = fopen(fn, "w");
2448	if (fd == NULL)
2449	Warn("Can not open %s for writing og mtrack. Using stdout",fn);
2450	}
2451	else if (h->Typ() == INT_CMD)
2452	{
2453	max = (int)(long)h->Data();
2454	}
2455	h = h->Next();
2456	}
2457	omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2458	if (fd != NULL) fclose(fd);
2459	om_Opts.MarkAsStatic = 0;
2460	return FALSE;
2461	#else
2462	WerrorS("system(\"mtrack\",..) is not implemented in this version");
2463	return TRUE;
2464	#endif
2465	}
2466	else
2467	/==================== backtrace ==================================/
2468	#ifndef OM_NDEBUG
2469	if(strcmp(sys_cmd,"backtrace")==0)
2470	{
2471	omPrintCurrentBackTrace(stdout);
2472	return FALSE;
2473	}
2474	else
2475	#endif
2476
2477	#if !defined(OM_NDEBUG)
2478	/==================== omMemoryTest ==================================/
2479	if (strcmp(sys_cmd,"omMemoryTest")==0)
2480	{
2481
2482	#ifdef OM_STATS_H
2483	PrintS("\n[om_Info]: \n");
2484	omUpdateInfo();
2485	#define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2486	OM_PRINT(MaxBytesSystem);
2487	OM_PRINT(CurrentBytesSystem);
2488	OM_PRINT(MaxBytesSbrk);
2489	OM_PRINT(CurrentBytesSbrk);
2490	OM_PRINT(MaxBytesMmap);
2491	OM_PRINT(CurrentBytesMmap);
2492	OM_PRINT(UsedBytes);
2493	OM_PRINT(AvailBytes);
2494	OM_PRINT(UsedBytesMalloc);
2495	OM_PRINT(AvailBytesMalloc);
2496	OM_PRINT(MaxBytesFromMalloc);
2497	OM_PRINT(CurrentBytesFromMalloc);
2498	OM_PRINT(MaxBytesFromValloc);
2499	OM_PRINT(CurrentBytesFromValloc);
2500	OM_PRINT(UsedBytesFromValloc);
2501	OM_PRINT(AvailBytesFromValloc);
2502	OM_PRINT(MaxPages);
2503	OM_PRINT(UsedPages);
2504	OM_PRINT(AvailPages);
2505	OM_PRINT(MaxRegionsAlloc);
2506	OM_PRINT(CurrentRegionsAlloc);
2507	#undef OM_PRINT
2508	#endif
2509
2510	#ifdef OM_OPTS_H
2511	PrintS("\n[om_Opts]: \n");
2512	#define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2513	OM_PRINT("d", MinTrack);
2514	OM_PRINT("d", MinCheck);
2515	OM_PRINT("d", MaxTrack);
2516	OM_PRINT("d", MaxCheck);
2517	OM_PRINT("d", Keep);
2518	OM_PRINT("d", HowToReportErrors);
2519	OM_PRINT("d", MarkAsStatic);
2520	OM_PRINT("u", PagesPerRegion);
2521	OM_PRINT("p", OutOfMemoryFunc);
2522	OM_PRINT("p", MemoryLowFunc);
2523	OM_PRINT("p", ErrorHook);
2524	#undef OM_PRINT
2525	#endif
2526
2527	#ifdef OM_ERROR_H
2528	Print("\n\n[om_ErrorStatus] : '%s' (%s)\n",
2529	omError2String(om_ErrorStatus),
2530	omError2Serror(om_ErrorStatus));
2531	Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2532	omError2String(om_InternalErrorStatus),
2533	omError2Serror(om_InternalErrorStatus));
2534
2535	#endif
2536
2537	// omTestMemory(1);
2538	// omtTestErrors();
2539	return FALSE;
2540	}
2541	else
2542	#endif
2543	/==================== pDivStat =============================/
2544	#if defined(PDEBUG) \|\| defined(PDIV_DEBUG)
2545	if(strcmp(sys_cmd,"pDivStat")==0)
2546	{
2547	extern void pPrintDivisbleByStat();
2548	pPrintDivisbleByStat();
2549	return FALSE;
2550	}
2551	else
2552	#endif
2553	/==================== red =============================/
2554	#if 0
2555	if(strcmp(sys_cmd,"red")==0)
2556	{
2557	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2558	{
2559	res->rtyp=IDEAL_CMD;
2560	res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2561	setFlag(res,FLAG_STD);
2562	return FALSE;
2563	}
2564	else
2565	WerrorS("ideal expected");
2566	}
2567	else
2568	#endif
2569	/==================== fastcomb =============================/
2570	if(strcmp(sys_cmd,"fastcomb")==0)
2571	{
2572	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2573	{
2574	if (h->next!=NULL)
2575	{
2576	if (h->next->Typ()!=POLY_CMD)
2577	{
2578	WarnS("Wrong types for poly= comb(ideal,poly)");
2579	}
2580	}
2581	res->rtyp=POLY_CMD;
2582	res->data=(void *) fglmLinearCombination(
2583	(ideal)h->Data(),(poly)h->next->Data());
2584	return FALSE;
2585	}
2586	else
2587	WerrorS("ideal expected");
2588	}
2589	else
2590	/==================== comb =============================/
2591	if(strcmp(sys_cmd,"comb")==0)
2592	{
2593	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2594	{
2595	if (h->next!=NULL)
2596	{
2597	if (h->next->Typ()!=POLY_CMD)
2598	{
2599	WarnS("Wrong types for poly= comb(ideal,poly)");
2600	}
2601	}
2602	res->rtyp=POLY_CMD;
2603	res->data=(void *)fglmNewLinearCombination(
2604	(ideal)h->Data(),(poly)h->next->Data());
2605	return FALSE;
2606	}
2607	else
2608	WerrorS("ideal expected");
2609	}
2610	else
2611	#if 0 /* debug only */
2612	/==================== listall ===================================/
2613	if(strcmp(sys_cmd,"listall")==0)
2614	{
2615	void listall(int showproc);
2616	int showproc=0;
2617	if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2618	listall(showproc);
2619	return FALSE;
2620	}
2621	else
2622	#endif
2623	#if 0 /* debug only */
2624	/==================== proclist =================================/
2625	if(strcmp(sys_cmd,"proclist")==0)
2626	{
2627	void piShowProcList();
2628	piShowProcList();
2629	return FALSE;
2630	}
2631	else
2632	#endif
2633	/* ==================== newton ================================*/
2634	#ifdef HAVE_NEWTON
2635	if(strcmp(sys_cmd,"newton")==0)
2636	{
2637	if ((h->Typ()!=POLY_CMD)
2638	\|\| (h->next->Typ()!=INT_CMD)
2639	\|\| (h->next->next->Typ()!=INT_CMD))
2640	{
2641	WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2642	return TRUE;
2643	}
2644	poly p=(poly)(h->Data());
2645	int l=pLength(p);
2646	short points=(short )omAlloc(currRing->Nlsizeof(short));
2647	int i,j,k;
2648	k=0;
2649	poly pp=p;
2650	for (i=0;pp!=NULL;i++)
2651	{
2652	for(j=1;j<=currRing->N;j++)
2653	{
2654	points[k]=pGetExp(pp,j);
2655	k++;
2656	}
2657	pIter(pp);
2658	}
2659	hc_ERG r=hc_KOENIG(currRing->N, // dimension
2660	l, // number of points
2661	(short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2662	currRing->OrdSgn==-1,
2663	(int) (h->next->Data()), // 1: Milnor, 0: Newton
2664	(int) (h->next->next->Data()) // debug
2665	);
2666	//----<>---Output-----------------------
2667
2668
2669	// PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2670
2671
2672	lists L=(lists)omAllocBin(slists_bin);
2673	L->Init(6);
2674	L->m[0].rtyp=STRING_CMD; // newtonnumber;
2675	L->m[0].data=(void *)omStrDup(r.nZahl);
2676	L->m[1].rtyp=INT_CMD;
2677	L->m[1].data=(void *)(long)r.achse; // flag for unoccupied axes
2678	L->m[2].rtyp=INT_CMD;
2679	L->m[2].data=(void *)(long)r.deg; // #degenerations
2680	if ( r.deg != 0) // only if degenerations exist
2681	{
2682	L->m[3].rtyp=INT_CMD;
2683	L->m[3].data=(void *)(long)r.anz_punkte; // #points
2684	//---<>--number of points------
2685	int anz = r.anz_punkte; // number of points
2686	int dim = (currRing->N); // dimension
2687	intvec* v = new intvec( anz*dim );
2688	for (i=0; i<anz*dim; i++) // copy points
2689	(*v)[i] = r.pu[i];
2690	L->m[4].rtyp=INTVEC_CMD;
2691	L->m[4].data=(void *)v;
2692	//---<>--degenerations---------
2693	int deg = r.deg; // number of points
2694	intvec* w = new intvec( r.speicher ); // necessary memory
2695	i=0; // start copying
2696	do
2697	{
2698	(*w)[i] = r.deg_tab[i];
2699	i++;
2700	}
2701	while (r.deg_tab[i-1] != -2); // mark for end of list
2702	L->m[5].rtyp=INTVEC_CMD;
2703	L->m[5].data=(void *)w;
2704	}
2705	else
2706	{
2707	L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2708	L->m[4].rtyp=DEF_CMD;
2709	L->m[5].rtyp=DEF_CMD;
2710	}
2711
2712	res->data=(void *)L;
2713	res->rtyp=LIST_CMD;
2714	// free all pointer in r:
2715	delete[] r.nZahl;
2716	delete[] r.pu;
2717	delete[] r.deg_tab; // Ist das ein Problem??
2718
2719	omFreeSize((ADDRESS)points,currRing->Nlsizeof(short));
2720	return FALSE;
2721	}
2722	else
2723	#endif
2724	/==== connection to Sebastian Jambor's code ======/
2725	/* This code connects Sebastian Jambor's code for
2726	computing the minimal polynomial of an (n x n) matrix
2727	with entries in F_p to SINGULAR. Two conversion methods
2728	are needed; see further up in this file:
2729	(1) conversion of a matrix with long entries to
2730	a SINGULAR matrix with number entries, where
2731	the numbers are coefficients in currRing;
2732	(2) conversion of an array of longs (encoding the
2733	coefficients of the minimal polynomial) to a
2734	SINGULAR poly living in currRing. */
2735	if (strcmp(sys_cmd, "minpoly") == 0)
2736	{
2737	if ((h == NULL) \|\| (h->Typ() != MATRIX_CMD) \|\| h->next != NULL)
2738	{
2739	Werror("expected exactly one argument: %s",
2740	"a square matrix with number entries");
2741	return TRUE;
2742	}
2743	else
2744	{
2745	matrix m = (matrix)h->Data();
2746	int n = m->rows();
2747	unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2748	if (n != m->cols())
2749	{
2750	WerrorS("expected exactly one argument: "
2751	"a square matrix with number entries");
2752	return TRUE;
2753	}
2754	unsigned long** ml = singularMatrixToLongMatrix(m);
2755	unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2756	poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2757	res->rtyp = POLY_CMD;
2758	res->data = (void *)theMinPoly;
2759	for (int i = 0; i < n; i++) delete[] ml[i];
2760	delete[] ml;
2761	delete[] polyCoeffs;
2762	return FALSE;
2763	}
2764	}
2765	else
2766	/==================== sdb_flags =================/
2767	#ifdef HAVE_SDB
2768	if (strcmp(sys_cmd, "sdb_flags") == 0)
2769	{
2770	if ((h!=NULL) && (h->Typ()==INT_CMD))
2771	{
2772	sdb_flags=(int)((long)h->Data());
2773	}
2774	else
2775	{
2776	WerrorS("system(\"sdb_flags\",`int`) expected");
2777	return TRUE;
2778	}
2779	return FALSE;
2780	}
2781	else
2782	#endif
2783	/==================== sdb_edit =================/
2784	#ifdef HAVE_SDB
2785	if (strcmp(sys_cmd, "sdb_edit") == 0)
2786	{
2787	if ((h!=NULL) && (h->Typ()==PROC_CMD))
2788	{
2789	procinfov p=(procinfov)h->Data();
2790	sdb_edit(p);
2791	}
2792	else
2793	{
2794	WerrorS("system(\"sdb_edit\",`proc`) expected");
2795	return TRUE;
2796	}
2797	return FALSE;
2798	}
2799	else
2800	#endif
2801	/==================== GF =================/
2802	#if 0 // for testing only
2803	if (strcmp(sys_cmd, "GF") == 0)
2804	{
2805	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2806	{
2807	int c=rChar(currRing);
2808	setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2809	CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2810	res->rtyp=POLY_CMD;
2811	res->data=convFactoryGFSingGF( F, currRing );
2812	return FALSE;
2813	}
2814	else { WerrorS("wrong typ"); return TRUE;}
2815	}
2816	else
2817	#endif
2818	/==================== SVD =================/
2819	#ifdef HAVE_SVD
2820	if (strcmp(sys_cmd, "svd") == 0)
2821	{
2822	extern lists testsvd(matrix M);
2823	res->rtyp=LIST_CMD;
2824	res->data=(char*)(testsvd((matrix)h->Data()));
2825	return FALSE;
2826	}
2827	else
2828	#endif
2829
2830
2831	/==================== DLL =================/
2832	#ifdef __CYGWIN__
2833	#ifdef HAVE_DL
2834	/* testing the DLL functionality under Win32 */
2835	if (strcmp(sys_cmd, "DLL") == 0)
2836	{
2837	typedef void (*Void_Func)();
2838	typedef int (*Int_Func)(int);
2839	void *hh=dynl_open("WinDllTest.dll");
2840	if ((h!=NULL) && (h->Typ()==INT_CMD))
2841	{
2842	int (*f)(int);
2843	if (hh!=NULL)
2844	{
2845	int (*f)(int);
2846	f=(Int_Func)dynl_sym(hh,"PlusDll");
2847	int i=10;
2848	if (f!=NULL) printf("%d\n",f(i));
2849	else PrintS("cannot find PlusDll\n");
2850	}
2851	}
2852	else
2853	{
2854	void (*f)();
2855	f= (Void_Func)dynl_sym(hh,"TestDll");
2856	if (f!=NULL) f();
2857	else PrintS("cannot find TestDll\n");
2858	}
2859	return FALSE;
2860	}
2861	else
2862	#endif
2863	#endif
2864	#ifdef HAVE_RING2TOM
2865	/==================== ring-GB ==================================/
2866	if (strcmp(sys_cmd, "findZeroPoly")==0)
2867	{
2868	ring r = currRing;
2869	poly f = (poly) h->Data();
2870	res->rtyp=POLY_CMD;
2871	res->data=(poly) kFindZeroPoly(f, r, r);
2872	return(FALSE);
2873	}
2874	else
2875	/==================== Creating zero polynomials =================/
2876	#ifdef HAVE_VANIDEAL
2877	if (strcmp(sys_cmd, "createG0")==0)
2878	{
2879	/* long exp[50];
2880	int N = 0;
2881	while (h != NULL)
2882	{
2883	N += 1;
2884	exp[N] = (long) h->Data();
2885	// if (exp[i] % 2 != 0) exp[i] -= 1;
2886	h = h->next;
2887	}
2888	for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
2889
2890	poly t_p;
2891	res->rtyp=POLY_CMD;
2892	res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
2893	return(FALSE); */
2894
2895	res->rtyp = IDEAL_CMD;
2896	res->data = (ideal) createG0();
2897	return(FALSE);
2898	}
2899	else
2900	#endif
2901	/==================== redNF_ring =================/
2902	if (strcmp(sys_cmd, "redNF_ring")==0)
2903	{
2904	ring r = currRing;
2905	poly f = (poly) h->Data();
2906	h = h->next;
2907	ideal G = (ideal) h->Data();
2908	res->rtyp=POLY_CMD;
2909	res->data=(poly) ringRedNF(f, G, r);
2910	return(FALSE);
2911	}
2912	else
2913	#endif
2914	/==================== Roune Hilb =================/
2915	if (strcmp(sys_cmd, "hilbroune") == 0)
2916	{
2917	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2918	{
2919	slicehilb((ideal)h->Data());
2920	}
2921	else return TRUE;
2922	return FALSE;
2923	}
2924	else
2925	/==================== F5 Implementation =================/
2926	#ifdef HAVE_F5
2927	if (strcmp(sys_cmd, "f5")==0)
2928	{
2929	if (h->Typ()!=IDEAL_CMD)
2930	{
2931	WerrorS("ideal expected");
2932	return TRUE;
2933	}
2934
2935	ring r = currRing;
2936	ideal G = (ideal) h->Data();
2937	h = h->next;
2938	int opt;
2939	if(h != NULL) {
2940	opt = (int) (long) h->Data();
2941	}
2942	else {
2943	opt = 2;
2944	}
2945	h = h->next;
2946	int plus;
2947	if(h != NULL) {
2948	plus = (int) (long) h->Data();
2949	}
2950	else {
2951	plus = 0;
2952	}
2953	h = h->next;
2954	int termination;
2955	if(h != NULL) {
2956	termination = (int) (long) h->Data();
2957	}
2958	else {
2959	termination = 0;
2960	}
2961	res->rtyp=IDEAL_CMD;
2962	res->data=(ideal) F5main(G,r,opt,plus,termination);
2963	return FALSE;
2964	}
2965	else
2966	#endif
2967	/==================== Testing groebner basis =================/
2968	#ifdef HAVE_RINGS
2969	if (strcmp(sys_cmd, "NF_ring")==0)
2970	{
2971	ring r = currRing;
2972	poly f = (poly) h->Data();
2973	h = h->next;
2974	ideal G = (ideal) h->Data();
2975	res->rtyp=POLY_CMD;
2976	res->data=(poly) ringNF(f, G, r);
2977	return(FALSE);
2978	}
2979	else
2980	if (strcmp(sys_cmd, "spoly")==0)
2981	{
2982	poly f = pCopy((poly) h->Data());
2983	h = h->next;
2984	poly g = pCopy((poly) h->Data());
2985
2986	res->rtyp=POLY_CMD;
2987	res->data=(poly) plain_spoly(f,g);
2988	return(FALSE);
2989	}
2990	else
2991	if (strcmp(sys_cmd, "testGB")==0)
2992	{
2993	ideal I = (ideal) h->Data();
2994	h = h->next;
2995	ideal GI = (ideal) h->Data();
2996	res->rtyp = INT_CMD;
2997	res->data = (void *)(long) testGB(I, GI);
2998	return(FALSE);
2999	}
3000	else
3001	#endif
3002	/==================== sca:AltVar ==================================/
3003	#ifdef HAVE_PLURAL
3004	if ( (strcmp(sys_cmd, "AltVarStart") == 0) \|\| (strcmp(sys_cmd, "AltVarEnd") == 0) )
3005	{
3006	ring r = currRing;
3007
3008	if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3009	{
3010	WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3011	return TRUE;
3012	}
3013
3014	res->rtyp=INT_CMD;
3015
3016	if (rIsSCA(r))
3017	{
3018	if(strcmp(sys_cmd, "AltVarStart") == 0)
3019	res->data = (void*)(long)scaFirstAltVar(r);
3020	else
3021	res->data = (void*)(long)scaLastAltVar(r);
3022	return FALSE;
3023	}
3024
3025	WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3026	return TRUE;
3027	}
3028	else
3029	#endif
3030	/==================== RatNF, noncomm rational coeffs =================/
3031	#ifdef HAVE_RATGRING
3032	if (strcmp(sys_cmd, "intratNF") == 0)
3033	{
3034	poly p;
3035	poly *q;
3036	ideal I;
3037	int is, k, id;
3038	if ((h!=NULL) && (h->Typ()==POLY_CMD))
3039	{
3040	p=(poly)h->CopyD();
3041	h=h->next;
3042	// PrintS("poly is done\n");
3043	}
3044	else return TRUE;
3045	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3046	{
3047	I=(ideal)h->CopyD();
3048	q = I->m;
3049	h=h->next;
3050	// PrintS("ideal is done\n");
3051	}
3052	else return TRUE;
3053	if ((h!=NULL) && (h->Typ()==INT_CMD))
3054	{
3055	is=(int)((long)(h->Data()));
3056	// res->rtyp=INT_CMD;
3057	// PrintS("int is done\n");
3058	// res->rtyp=IDEAL_CMD;
3059	if (rIsPluralRing(currRing))
3060	{
3061	id = IDELEMS(I);
3062	int pl=(int)omAlloc0(IDELEMS(I)*sizeof(int));
3063	for(k=0; k < id; k++)
3064	{
3065	pl[k] = pLength(I->m[k]);
3066	}
3067	PrintS("starting redRat\n");
3068	//res->data = (char *)
3069	redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3070	res->data=p;
3071	res->rtyp=POLY_CMD;
3072	// res->data = ncGCD(p,q,currRing);
3073	}
3074	else
3075	{
3076	res->rtyp=POLY_CMD;
3077	res->data=p;
3078	}
3079	}
3080	else return TRUE;
3081	return FALSE;
3082	}
3083	else
3084	/==================== RatNF, noncomm rational coeffs =================/
3085	if (strcmp(sys_cmd, "ratNF") == 0)
3086	{
3087	poly p,q;
3088	int is, htype;
3089	if ((h!=NULL) && ( (h->Typ()==POLY_CMD) \|\| (h->Typ()==VECTOR_CMD) ) )
3090	{
3091	p=(poly)h->CopyD();
3092	h=h->next;
3093	htype = h->Typ();
3094	}
3095	else return TRUE;
3096	if ((h!=NULL) && ( (h->Typ()==POLY_CMD) \|\| (h->Typ()==VECTOR_CMD) ) )
3097	{
3098	q=(poly)h->CopyD();
3099	h=h->next;
3100	}
3101	else return TRUE;
3102	if ((h!=NULL) && (h->Typ()==INT_CMD))
3103	{
3104	is=(int)((long)(h->Data()));
3105	res->rtyp=htype;
3106	// res->rtyp=IDEAL_CMD;
3107	if (rIsPluralRing(currRing))
3108	{
3109	res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3110	// res->data = ncGCD(p,q,currRing);
3111	}
3112	else res->data=p;
3113	}
3114	else return TRUE;
3115	return FALSE;
3116	}
3117	else
3118	/==================== RatSpoly, noncomm rational coeffs =================/
3119	if (strcmp(sys_cmd, "ratSpoly") == 0)
3120	{
3121	poly p,q;
3122	int is;
3123	if ((h!=NULL) && (h->Typ()==POLY_CMD))
3124	{
3125	p=(poly)h->CopyD();
3126	h=h->next;
3127	}
3128	else return TRUE;
3129	if ((h!=NULL) && (h->Typ()==POLY_CMD))
3130	{
3131	q=(poly)h->CopyD();
3132	h=h->next;
3133	}
3134	else return TRUE;
3135	if ((h!=NULL) && (h->Typ()==INT_CMD))
3136	{
3137	is=(int)((long)(h->Data()));
3138	res->rtyp=POLY_CMD;
3139	// res->rtyp=IDEAL_CMD;
3140	if (rIsPluralRing(currRing))
3141	{
3142	res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3143	// res->data = ncGCD(p,q,currRing);
3144	}
3145	else res->data=p;
3146	}
3147	else return TRUE;
3148	return FALSE;
3149	}
3150	else
3151	#endif // HAVE_RATGRING
3152	/==================== Rat def =================/
3153	if (strcmp(sys_cmd, "ratVar") == 0)
3154	{
3155	int start,end;
3156	if ((h!=NULL) && (h->Typ()==POLY_CMD))
3157	{
3158	start=pIsPurePower((poly)h->Data());
3159	h=h->next;
3160	}
3161	else return TRUE;
3162	if ((h!=NULL) && (h->Typ()==POLY_CMD))
3163	{
3164	end=pIsPurePower((poly)h->Data());
3165	h=h->next;
3166	}
3167	else return TRUE;
3168	currRing->real_var_start=start;
3169	currRing->real_var_end=end;
3170	return (start==0)\|\|(end==0)\|\|(start>end);
3171	}
3172	else
3173	/==================== t-rep-GB ==================================/
3174	if (strcmp(sys_cmd, "unifastmult")==0)
3175	{
3176	poly f = (poly)h->Data();
3177	h=h->next;
3178	poly g=(poly)h->Data();
3179	res->rtyp=POLY_CMD;
3180	res->data=unifastmult(f,g,currRing);
3181	return(FALSE);
3182	}
3183	else
3184	if (strcmp(sys_cmd, "multifastmult")==0)
3185	{
3186	poly f = (poly)h->Data();
3187	h=h->next;
3188	poly g=(poly)h->Data();
3189	res->rtyp=POLY_CMD;
3190	res->data=multifastmult(f,g,currRing);
3191	return(FALSE);
3192	}
3193	else
3194	if (strcmp(sys_cmd, "mults")==0)
3195	{
3196	res->rtyp=INT_CMD ;
3197	res->data=(void*)(long) Mults();
3198	return(FALSE);
3199	}
3200	else
3201	if (strcmp(sys_cmd, "fastpower")==0)
3202	{
3203	ring r = currRing;
3204	poly f = (poly)h->Data();
3205	h=h->next;
3206	int n=(int)((long)h->Data());
3207	res->rtyp=POLY_CMD ;
3208	res->data=(void*) pFastPower(f,n,r);
3209	return(FALSE);
3210	}
3211	else
3212	if (strcmp(sys_cmd, "normalpower")==0)
3213	{
3214	poly f = (poly)h->Data();
3215	h=h->next;
3216	int n=(int)((long)h->Data());
3217	res->rtyp=POLY_CMD ;
3218	res->data=(void*) pPower(pCopy(f),n);
3219	return(FALSE);
3220	}
3221	else
3222	if (strcmp(sys_cmd, "MCpower")==0)
3223	{
3224	ring r = currRing;
3225	poly f = (poly)h->Data();
3226	h=h->next;
3227	int n=(int)((long)h->Data());
3228	res->rtyp=POLY_CMD ;
3229	res->data=(void*) pFastPowerMC(f,n,r);
3230	return(FALSE);
3231	}
3232	else
3233	if (strcmp(sys_cmd, "bit_subst")==0)
3234	{
3235	ring r = currRing;
3236	poly outer = (poly)h->Data();
3237	h=h->next;
3238	poly inner=(poly)h->Data();
3239	res->rtyp=POLY_CMD ;
3240	res->data=(void*) uni_subst_bits(outer, inner,r);
3241	return(FALSE);
3242	}
3243	else
3244	/==================== gcd-varianten =================/
3245	if (strcmp(sys_cmd, "gcd") == 0)
3246	{
3247	if (h==NULL)
3248	{
3249	Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3250	Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3251	Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3252	Print("QGCD:%d (use QGCD for gcd of polynomials in alg. ext.)\n",isOn(SW_USE_QGCD));
3253	Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3254	return FALSE;
3255	}
3256	else
3257	if ((h!=NULL) && (h->Typ()==STRING_CMD)
3258	&& (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3259	{
3260	int d=(int)(long)h->next->Data();
3261	char s=(char )h->Data();
3262	#ifdef HAVE_PLURAL
3263	if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3264	if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3265	if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3266	if (strcmp(s,"QGCD")==0) { if (d) On(SW_USE_QGCD); else Off(SW_USE_QGCD); } else
3267	#endif
3268	if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3269	return TRUE;
3270	return FALSE;
3271	}
3272	else return TRUE;
3273	}
3274	else
3275	/==================== subring =================/
3276	if (strcmp(sys_cmd, "subring") == 0)
3277	{
3278	if (h!=NULL)
3279	{
3280	extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3281	res->data=(char *)rSubring(currRing,h);
3282	res->rtyp=RING_CMD;
3283	return res->data==NULL;
3284	}
3285	else return TRUE;
3286	}
3287	else
3288	/==================== HNF =================/
3289	#ifdef HAVE_NTL
3290	if (strcmp(sys_cmd, "HNF") == 0)
3291	{
3292	if (h!=NULL)
3293	{
3294	res->rtyp=h->Typ();
3295	if (h->Typ()==MATRIX_CMD)
3296	{
3297	res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3298	return FALSE;
3299	}
3300	else if (h->Typ()==INTMAT_CMD)
3301	{
3302	res->data=(char )singntl_HNF((intvec)h->Data());
3303	return FALSE;
3304	}
3305	else if (h->Typ()==INTMAT_CMD)
3306	{
3307	res->data=(char )singntl_HNF((intvec)h->Data());
3308	return FALSE;
3309	}
3310	else
3311	{
3312	WerrorS("expected `system(\"HNF\",<matrix\|intmat\|bigintmat>)`");
3313	return TRUE;
3314	}
3315	}
3316	else return TRUE;
3317	}
3318	else
3319	/================= probIrredTest ======================/
3320	if (strcmp (sys_cmd, "probIrredTest") == 0)
3321	{
3322	if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3323	{
3324	CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3325	char s=(char )h->next->Data();
3326	double error= atof (s);
3327	int irred= probIrredTest (F, error);
3328	res->rtyp= INT_CMD;
3329	res->data= (void*)(long)irred;
3330	return FALSE;
3331	}
3332	else return TRUE;
3333	}
3334	else
3335	#endif
3336	/==================== mpz_t loader ======================/
3337	if(strcmp(sys_cmd, "GNUmpLoad")==0)
3338	{
3339	if ((h != NULL) && (h->Typ() == STRING_CMD))
3340	{
3341	char* filename = (char*)h->Data();
3342	FILE* f = fopen(filename, "r");
3343	if (f == NULL)
3344	{
3345	WerrorS( "invalid file name (in paths use '/')");
3346	return FALSE;
3347	}
3348	mpz_t m; mpz_init(m);
3349	mpz_inp_str(m, f, 10);
3350	fclose(f);
3351	number n = n_InitMPZ(m, coeffs_BIGINT);
3352	res->rtyp = BIGINT_CMD;
3353	res->data = (void*)n;
3354	return FALSE;
3355	}
3356	else
3357	{
3358	WerrorS( "expected valid file name as a string");
3359	return TRUE;
3360	}
3361	}
3362	else
3363	/==================== intvec matching ======================/
3364	/* Given two non-empty intvecs, the call
3365	'system("intvecMatchingSegments", ivec, jvec);'
3366	computes all occurences of jvec in ivec, i.e., it returns
3367	a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3368	If no such k exists (e.g. when ivec is shorter than jvec), an
3369	intvec with the single entry 0 is being returned. */
3370	if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3371	{
3372	if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3373	(h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3374	(h->next->next == NULL))
3375	{
3376	intvec* ivec = (intvec*)h->Data();
3377	intvec* jvec = (intvec*)h->next->Data();
3378	intvec* r = new intvec(1); (*r)[0] = 0;
3379	int validEntries = 0;
3380	for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3381	{
3382	if (memcmp(&(ivec)[k], &(jvec)[0],
3383	sizeof(int) * jvec->rows()) == 0)
3384	{
3385	if (validEntries == 0)
3386	(*r)[0] = k + 1;
3387	else
3388	{
3389	r->resize(validEntries + 1);
3390	(*r)[validEntries] = k + 1;
3391	}
3392	validEntries++;
3393	}
3394	}
3395	res->rtyp = INTVEC_CMD;
3396	res->data = (void*)r;
3397	return FALSE;
3398	}
3399	else
3400	{
3401	WerrorS("expected two non-empty intvecs as arguments");
3402	return TRUE;
3403	}
3404	}
3405	else
3406	/* ================== intvecOverlap ======================= */
3407	/* Given two non-empty intvecs, the call
3408	'system("intvecOverlap", ivec, jvec);'
3409	computes the longest intvec kvec such that ivec ends with kvec
3410	and jvec starts with kvec. The length of this overlap is being
3411	returned. If there is no overlap at all, then 0 is being returned. */
3412	if(strcmp(sys_cmd, "intvecOverlap")==0)
3413	{
3414	if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3415	(h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3416	(h->next->next == NULL))
3417	{
3418	intvec* ivec = (intvec*)h->Data();
3419	intvec* jvec = (intvec*)h->next->Data();
3420	int ir = ivec->rows(); int jr = jvec->rows();
3421	int r = jr; if (ir < jr) r = ir; /* r = min{ir, jr} */
3422	while ((r >= 1) && (memcmp(&(ivec)[ir - r], &(jvec)[0],
3423	sizeof(int) * r) != 0))
3424	r--;
3425	res->rtyp = INT_CMD;
3426	res->data = (void*)(long)r;
3427	return FALSE;
3428	}
3429	else
3430	{
3431	WerrorS("expected two non-empty intvecs as arguments");
3432	return TRUE;
3433	}
3434	}
3435	else
3436	/==================== Hensel's lemma ======================/
3437	if(strcmp(sys_cmd, "henselfactors")==0)
3438	{
3439	if ((h != NULL) && (h->Typ() == INT_CMD) &&
3440	(h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3441	(h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3442	(h->next->next->next != NULL) &&
3443	(h->next->next->next->Typ() == POLY_CMD) &&
3444	(h->next->next->next->next != NULL) &&
3445	(h->next->next->next->next->Typ() == POLY_CMD) &&
3446	(h->next->next->next->next->next != NULL) &&
3447	(h->next->next->next->next->next->Typ() == INT_CMD) &&
3448	(h->next->next->next->next->next->next == NULL))
3449	{
3450	int xIndex = (int)(long)h->Data();
3451	int yIndex = (int)(long)h->next->Data();
3452	poly hh = (poly)h->next->next->Data();
3453	poly f0 = (poly)h->next->next->next->Data();
3454	poly g0 = (poly)h->next->next->next->next->Data();
3455	int d = (int)(long)h->next->next->next->next->next->Data();
3456	poly f; poly g;
3457	henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3458	lists L = (lists)omAllocBin(slists_bin);
3459	L->Init(2);
3460	L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3461	L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3462	res->rtyp = LIST_CMD;
3463	res->data = (char *)L;
3464	return FALSE;
3465	}
3466	else
3467	{
3468	WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3469	return TRUE;
3470	}
3471	}
3472	else
3473	/==================== Approx_Step =================/
3474	#ifdef HAVE_PLURAL
3475	if (strcmp(sys_cmd, "astep") == 0)
3476	{
3477	ideal I;
3478	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3479	{
3480	I=(ideal)h->CopyD();
3481	res->rtyp=IDEAL_CMD;
3482	if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3483	else res->data=I;
3484	setFlag(res,FLAG_STD);
3485	}
3486	else return TRUE;
3487	return FALSE;
3488	}
3489	else
3490	#endif
3491	/==================== PrintMat =================/
3492	#ifdef HAVE_PLURAL
3493	if (strcmp(sys_cmd, "PrintMat") == 0)
3494	{
3495	int a;
3496	int b;
3497	ring r;
3498	int metric;
3499	if (h!=NULL)
3500	{
3501	if (h->Typ()==INT_CMD)
3502	{
3503	a=(int)((long)(h->Data()));
3504	h=h->next;
3505	}
3506	else if (h->Typ()==INT_CMD)
3507	{
3508	b=(int)((long)(h->Data()));
3509	h=h->next;
3510	}
3511	else if (h->Typ()==RING_CMD)
3512	{
3513	r=(ring)h->Data();
3514	h=h->next;
3515	}
3516	else
3517	return TRUE;
3518	}
3519	else
3520	return TRUE;
3521	if ((h!=NULL) && (h->Typ()==INT_CMD))
3522	{
3523	metric=(int)((long)(h->Data()));
3524	}
3525	res->rtyp=MATRIX_CMD;
3526	if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3527	else res->data=NULL;
3528	return FALSE;
3529	}
3530	else
3531	#endif
3532	/* ============ NCUseExtensions ======================== */
3533	#ifdef HAVE_PLURAL
3534	if(strcmp(sys_cmd,"NCUseExtensions")==0)
3535	{
3536	if ((h!=NULL) && (h->Typ()==INT_CMD))
3537	res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3538	else
3539	res->data=(void *)(long)getNCExtensions();
3540	res->rtyp=INT_CMD;
3541	return FALSE;
3542	}
3543	else
3544	#endif
3545	/* ============ NCGetType ======================== */
3546	#ifdef HAVE_PLURAL
3547	if(strcmp(sys_cmd,"NCGetType")==0)
3548	{
3549	res->rtyp=INT_CMD;
3550	if( rIsPluralRing(currRing) )
3551	res->data=(void *)(long)ncRingType(currRing);
3552	else
3553	res->data=(void *)(-1L);
3554	return FALSE;
3555	}
3556	else
3557	#endif
3558	/* ============ ForceSCA ======================== */
3559	#ifdef HAVE_PLURAL
3560	if(strcmp(sys_cmd,"ForceSCA")==0)
3561	{
3562	if( !rIsPluralRing(currRing) )
3563	return TRUE;
3564	int b, e;
3565	if ((h!=NULL) && (h->Typ()==INT_CMD))
3566	{
3567	b = (int)((long)(h->Data()));
3568	h=h->next;
3569	}
3570	else return TRUE;
3571	if ((h!=NULL) && (h->Typ()==INT_CMD))
3572	{
3573	e = (int)((long)(h->Data()));
3574	}
3575	else return TRUE;
3576	if( !sca_Force(currRing, b, e) )
3577	return TRUE;
3578	return FALSE;
3579	}
3580	else
3581	#endif
3582	/* ============ ForceNewNCMultiplication ======================== */
3583	#ifdef HAVE_PLURAL
3584	if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3585	{
3586	if( !rIsPluralRing(currRing) )
3587	return TRUE;
3588	if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3589	return TRUE;
3590	return FALSE;
3591	}
3592	else
3593	#endif
3594	/* ============ ForceNewOldNCMultiplication ======================== */
3595	#ifdef HAVE_PLURAL
3596	if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3597	{
3598	if( !rIsPluralRing(currRing) )
3599	return TRUE;
3600	if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3601	return TRUE;
3602	return FALSE;
3603	}
3604	else
3605	#endif
3606	/==================== test64 =================/
3607	#if 0
3608	if(strcmp(sys_cmd,"test64")==0)
3609	{
3610	long l=8;int i;
3611	for(i=1;i<62;i++)
3612	{
3613	l=l<<1;
3614	number n=n_Init(l,coeffs_BIGINT);
3615	Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3616	CanonicalForm nn=n_convSingNFactoryN(n,TRUE,coeffs_BIGINT);
3617	n_Delete(&n,coeffs_BIGINT);
3618	n=n_convFactoryNSingN(nn,coeffs_BIGINT);
3619	PrintS(" F:");
3620	n_Print(n,coeffs_BIGINT);
3621	PrintLn();
3622	n_Delete(&n,coeffs_BIGINT);
3623	}
3624	Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3625	return FALSE;
3626	}
3627	else
3628	#endif
3629	/==================== n_SwitchChinRem =================/
3630	if(strcmp(sys_cmd,"cache_chinrem")==0)
3631	{
3632	EXTERN_VAR int n_SwitchChinRem;
3633	Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3634	if ((h!=NULL)&&(h->Typ()==INT_CMD))
3635	n_SwitchChinRem=(int)(long)h->Data();
3636	return FALSE;
3637	}
3638	else
3639	/==================== LU for bigintmat =================/
3640	#ifdef SINGULAR_4_2
3641	if(strcmp(sys_cmd,"LU")==0)
3642	{
3643	if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3644	{
3645	// get the argument:
3646	bigintmat b=(bigintmat )h->Data();
3647	// just for tests: simply transpose
3648	bigintmat *bb=b->transpose();
3649	// return the result:
3650	res->rtyp=CMATRIX_CMD;
3651	res->data=(char*)bb;
3652	return FALSE;
3653	}
3654	else
3655	{
3656	WerrorS("system(\"LU\",<cmatrix>) expected");
3657	return TRUE;
3658	}
3659	}
3660	else
3661	#endif
3662	/==================== sort =================/
3663	if(strcmp(sys_cmd,"sort")==0)
3664	{
3665	extern BOOLEAN jjSORTLIST(leftv,leftv);
3666	if (h->Typ()==LIST_CMD)
3667	return jjSORTLIST(res,h);
3668	else
3669	return TRUE;
3670	}
3671	else
3672	/==================== uniq =================/
3673	if(strcmp(sys_cmd,"uniq")==0)
3674	{
3675	extern BOOLEAN jjUNIQLIST(leftv, leftv);
3676	if (h->Typ()==LIST_CMD)
3677	return jjUNIQLIST(res,h);
3678	else
3679	return TRUE;
3680	}
3681	else
3682	/==================== GF(p,n) ==================================/
3683	if(strcmp(sys_cmd,"GF")==0)
3684	{
3685	const short t[]={3,INT_CMD,INT_CMD,STRING_CMD};
3686	if (iiCheckTypes(h,t,1))
3687	{
3688	int p=(int)(long)h->Data();
3689	int n=(int)(long)h->next->Data();
3690	char v=(char)h->next->next->CopyD();
3691	GFInfo param;
3692	param.GFChar = p;
3693	param.GFDegree = n;
3694	param.GFPar_name = v;
3695	coeffs cf= nInitChar(n_GF, &param);
3696	res->rtyp=CRING_CMD;
3697	res->data=cf;
3698	return FALSE;
3699	}
3700	else
3701	return TRUE;
3702	}
3703	else
3704	/==================== power ==================================*/
3705	#if 0
3706	if(strcmp(sys_cmd,"power1")==0)
3707	{
3708	res->rtyp=POLY_CMD;
3709	poly f=(poly)h->CopyD();
3710	poly g=pPower(f,2000);
3711	res->data=(void *)g;
3712	return FALSE;
3713	}
3714	else
3715	if(strcmp(sys_cmd,"power2")==0)
3716	{
3717	res->rtyp=POLY_CMD;
3718	poly f=(poly)h->Data();
3719	poly g=pOne();
3720	for(int i=0;i<2000;i++)
3721	g=pMult(g,pCopy(f));
3722	res->data=(void *)g;
3723	return FALSE;
3724	}
3725	if(strcmp(sys_cmd,"power3")==0)
3726	{
3727	res->rtyp=POLY_CMD;
3728	poly f=(poly)h->Data();
3729	poly p2=pMult(pCopy(f),pCopy(f));
3730	poly p4=pMult(pCopy(p2),pCopy(p2));
3731	poly p8=pMult(pCopy(p4),pCopy(p4));
3732	poly p16=pMult(pCopy(p8),pCopy(p8));
3733	poly p32=pMult(pCopy(p16),pCopy(p16));
3734	poly p64=pMult(pCopy(p32),pCopy(p32));
3735	poly p128=pMult(pCopy(p64),pCopy(p64));
3736	poly p256=pMult(pCopy(p128),pCopy(p128));
3737	poly p512=pMult(pCopy(p256),pCopy(p256));
3738	poly p1024=pMult(pCopy(p512),pCopy(p512));
3739	poly p1536=pMult(p1024,p512);
3740	poly p1792=pMult(p1536,p256);
3741	poly p1920=pMult(p1792,p128);
3742	poly p1984=pMult(p1920,p64);
3743	poly p2000=pMult(p1984,p16);
3744	res->data=(void *)p2000;
3745	pDelete(&p2);
3746	pDelete(&p4);
3747	pDelete(&p8);
3748	//pDelete(&p16);
3749	pDelete(&p32);
3750	//pDelete(&p64);
3751	//pDelete(&p128);
3752	//pDelete(&p256);
3753	//pDelete(&p512);
3754	//pDelete(&p1024);
3755	//pDelete(&p1536);
3756	//pDelete(&p1792);
3757	//pDelete(&p1920);
3758	//pDelete(&p1984);
3759	return FALSE;
3760	}
3761	else
3762	#endif
3763	/* ccluster --------------------------------------------------------------*/
3764	#ifdef HAVE_CCLUSTER
3765	if(strcmp(sys_cmd,"ccluster")==0)
3766	{
3767	if ((currRing!=NULL) && rField_is_Q(currRing))
3768	{
3769	const short t[]={5,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3770	const short t2[]={6,POLY_CMD,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3771
3772	// printf("test t : %d\n", h->Typ()==POLY_CMD);
3773	// printf("test t : %d\n", h->next->Typ()==POLY_CMD);
3774	int pol_with_complex_coeffs=0;
3775	if (h->next->Typ()==POLY_CMD)
3776	pol_with_complex_coeffs=1;
3777
3778	if ( (pol_with_complex_coeffs==0 && iiCheckTypes(h,t,1))
3779	\|\|(pol_with_complex_coeffs==1 && iiCheckTypes(h,t2,1)) )
3780	{
3781	// convert first arg. to fmpq_poly_t
3782	fmpq_poly_t fre, fim;
3783	convSingPFlintP(fre,(poly)h->Data(),currRing); h=h->next;
3784	if (pol_with_complex_coeffs==1) { // convert second arg. to fmpq_poly_t
3785	convSingPFlintP(fim,(poly)h->Data(),currRing); h=h->next;
3786	}
3787	// convert box-center(re,im), box-size, epsilon
3788	fmpq_t center_re,center_im,boxsize,eps;
3789	convSingNFlintN(center_re,(number)h->Data(),currRing->cf); h=h->next;
3790	convSingNFlintN(center_im,(number)h->Data(),currRing->cf); h=h->next;
3791	convSingNFlintN(boxsize,(number)h->Data(),currRing->cf); h=h->next;
3792	convSingNFlintN(eps,(number)h->Data(),currRing->cf); h=h->next;
3793	// alloc arrays
3794	int n=fmpq_poly_length(fre);
3795	fmpq_t* re_part=(fmpq_t)omAlloc(nsizeof(fmpq_t));
3796	fmpq_t* im_part=(fmpq_t)omAlloc(nsizeof(fmpq_t));
3797	int mult =(int) omAlloc(n*sizeof(int));
3798	for(int i=0; i<n;i++)
3799	{ fmpq_init(re_part[i]); fmpq_init(im_part[i]); }
3800	// call cccluster, adjust n
3801	int verbosity =0; //nothing is printed
3802	int strategy = 23; //default strategy
3803	int nn=0;
3804	long nb_threads = (long) feOptValue(FE_OPT_CPUS);
3805	strategy = strategy+(nb_threads<<6);
3806	// printf("nb threads: %ld\n", nb_threads);
3807	// printf("strategy: %ld\n", strategy);
3808	if (pol_with_complex_coeffs==0)
3809	nn=ccluster_interface_poly_real(re_part,im_part,mult,fre,center_re,center_im,boxsize,eps,strategy,verbosity);
3810	else
3811	nn=ccluster_interface_poly_real_imag(re_part,im_part,mult,fre,fim,center_re,center_im,boxsize,eps,strategy,verbosity);
3812	// convert to list
3813	lists l=(lists)omAlloc0Bin(slists_bin);
3814	l->Init(nn);
3815	for(int i=0; i<nn;i++)
3816	{
3817	lists ll=(lists)omAlloc0Bin(slists_bin);
3818	l->m[i].rtyp=LIST_CMD;
3819	l->m[i].data=ll;
3820	ll->Init(3);
3821	ll->m[0].rtyp=NUMBER_CMD;
3822	ll->m[1].rtyp=NUMBER_CMD;
3823	ll->m[2].rtyp=INT_CMD;
3824	ll->m[0].data=convFlintNSingN(re_part[i],currRing->cf);
3825	ll->m[1].data=convFlintNSingN(im_part[i],currRing->cf);
3826	ll->m[2].data=(void *)(long)mult[i];
3827	}
3828	//clear re, im, mults, fre, fim
3829	for(int i=n-1;i>=0;i--) { fmpq_clear(re_part[i]); fmpq_clear(im_part[i]); }
3830	omFree(re_part);
3831	omFree(im_part);
3832	omFree(mult);
3833	fmpq_clear(center_re); fmpq_clear(center_im); fmpq_clear(boxsize); fmpq_clear(eps);
3834	fmpq_poly_clear(fre);
3835	if (pol_with_complex_coeffs==1) fmpq_poly_clear(fim);
3836	// result
3837	res->rtyp=LIST_CMD;
3838	res->data=l;
3839	return FALSE;
3840	}
3841	}
3842	return TRUE;
3843	}
3844	else
3845	#endif
3846	/==================== Error =================/
3847	Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3848	}
3849	return TRUE;
3850	}
3851
3852	#endif // HAVE_EXTENDED_SYSTEM
3853
3854

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

Download in other formats: