Context Navigation

source: git/Singular/extra.cc @ 598f45b

spielwiese

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

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

Download in other formats: