Context Navigation

source: git/Singular/extra.cc @ b117e8

spielwiese

Last change on this file since b117e8 was b117e8, checked in by Hans Schoenemann <hannes@…>, 13 years ago
blackbox types git-svn-id: file:///usr/local/Singular/svn/trunk@13737 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 106.0 KB

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

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

Download in other formats: