Context Navigation

source: git/Singular/extra.cc @ 667ba1

spielwiese

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

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

Download in other formats: