Context Navigation

source: git/Singular/extra.cc @ 31a04de

spielwiese

Last change on this file since 31a04de was 31a04de, checked in by Hans Schoenemann <hannes@…>, 13 years ago
debug bb stuff removed git-svn-id: file:///usr/local/Singular/svn/trunk@13913 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 114.2 KB

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

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

Download in other formats: