Context Navigation

source: git/Singular/extra.cc @ a563a0

spielwiese

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

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

Download in other formats: