Context Navigation

source: git/Singular/extra.cc @ f8936f

spielwiese

Last change on this file since f8936f was f8936f, checked in by Viktor Levandovskyy <levandov@…>, 16 years ago
*levandov: freegb function in extended system git-svn-id: file:///usr/local/Singular/svn/trunk@10577 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 82.2 KB

Line
1	/*****************************************
2	* Computer Algebra System SINGULAR *
3	*****************************************/
4	/* $Id: extra.cc,v 1.263 2008-02-15 17:12:09 levandov Exp $ */
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 "mod2.h"
17
18	#ifdef TIME_WITH_SYS_TIME
19	# include <time.h>
20	# ifdef HAVE_SYS_TIME_H
21	# include <sys/time.h>
22	# endif
23	#else
24	# ifdef HAVE_SYS_TIME_H
25	# include <sys/time.h>
26	# else
27	# include <time.h>
28	# endif
29	#endif
30	#ifdef HAVE_SYS_TIMES_H
31	#include <sys/times.h>
32	#endif
33
34	#include <unistd.h>
35
36	#include "tok.h"
37	#include "ipid.h"
38	#include "polys.h"
39	#include "lists.h"
40	#include "kutil.h"
41	#include "cntrlc.h"
42	#include "stairc.h"
43	#include "ipshell.h"
44	#include "modulop.h"
45	#include "febase.h"
46	#include "matpol.h"
47	#include "longalg.h"
48	#include "ideals.h"
49	#include "kstd1.h"
50	#include "syz.h"
51	#include "sdb.h"
52	#include "feOpt.h"
53	#include "distrib.h"
54	#include "prCopy.h"
55	#include "mpr_complex.h"
56
57	#ifdef HAVE_RINGS
58	#include "ringgb.h"
59	#endif
60
61	#ifdef HAVE_WALK
62	#include "walk.h"
63	#endif
64
65	#include "weight.h"
66	#include "fast_mult.h"
67	#include "digitech.h"
68
69	#ifdef HAVE_SPECTRUM
70	#include "spectrum.h"
71	#endif
72
73	#ifdef HAVE_BIFAC
74	#include <bifac.h>
75	#endif
76
77	#if defined(HPUX_10) \|\| defined(HPUX_9)
78	extern "C" int setenv(const char name, const char value, int overwrite);
79	#endif
80
81	#ifdef HAVE_PLURAL
82	#include "ring.h"
83	#include "gring.h"
84	#include "sca.h"
85	#include "ipconv.h"
86	#include "ratgring.h"
87	#endif
88
89	#ifdef ix86_Win /* only for the DLLTest */
90	/* #include "WinDllTest.h" */
91	#ifdef HAVE_DL
92	#include "mod_raw.h"
93	#endif
94	#endif
95
96	// for tests of t-rep-GB
97	#include "tgb.h"
98
99	// Define to enable many more system commands
100	#undef MAKE_DISTRIBUTION
101	#ifndef MAKE_DISTRIBUTION
102	#define HAVE_EXTENDED_SYSTEM 1
103	#endif
104
105	#ifdef HAVE_FACTORY
106	#define SI_DONT_HAVE_GLOBAL_VARS
107	#include "clapsing.h"
108	#include "clapconv.h"
109	#include "kstdfac.h"
110	#endif
111
112	#include "silink.h"
113	#include "walk.h"
114
115	#include "fast_maps.h"
116
117	#include "shiftgb.h"
118
119	#ifdef HAVE_EIGENVAL
120	#include "eigenval_ip.h"
121	#endif
122
123	#ifdef HAVE_GMS
124	#include "gms.h"
125	#endif
126
127	/*
128	* New function/system-calls that will be included as dynamic module
129	* should be inserted here.
130	* - without HAVE_DYNAMIC_LOADING: these functions comes as system("....");
131	* - with HAVE_DYNAMIC_LOADING: these functions are loaded as module.
132	*/
133	//#ifndef HAVE_DYNAMIC_LOADING
134
135	#ifdef HAVE_PCV
136	#include "pcv.h"
137	#endif
138
139	//#endif /* not HAVE_DYNAMIC_LOADING */
140
141	#ifdef ix86_Win
142	//#include <Python.h>
143	//#include <python_wrapper.h>
144	#endif
145
146
147	// see clapsing.cc for a description of the `FACTORY_*' options
148
149	#ifdef FACTORY_GCD_STAT
150	#include "gcd_stat.h"
151	#endif
152
153	#ifdef FACTORY_GCD_TIMING
154	#define TIMING
155	#include "timing.h"
156	TIMING_DEFINE_PRINTPROTO( contentTimer );
157	TIMING_DEFINE_PRINTPROTO( algContentTimer );
158	TIMING_DEFINE_PRINTPROTO( algLcmTimer );
159	#endif
160
161	void piShowProcList();
162	#ifndef MAKE_DISTRIBUTION
163	static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
164	#endif
165
166	extern BOOLEAN jjJanetBasis(leftv res, leftv v);
167
168	#ifdef ix86_Win /* PySingular initialized? */
169	static int PyInitialized = 0;
170	#endif
171
172	int singular_homog_flag=1;
173
174	//void emStart();
175	/*2
176	* the "system" command
177	*/
178	BOOLEAN jjSYSTEM(leftv res, leftv args)
179	{
180	if(args->Typ() == STRING_CMD)
181	{
182	const char sys_cmd=(char )(args->Data());
183	leftv h=args->next;
184	// ONLY documented system calls go here
185	// Undocumented system calls go down into #ifdef HAVE_EXTENDED_SYSTEM
186	/==================== nblocks ==================================/
187	if (strcmp(sys_cmd, "nblocks") == 0)
188	{
189	ring r;
190	if (h == NULL)
191	{
192	if (currRingHdl != NULL)
193	{
194	r = IDRING(currRingHdl);
195	}
196	else
197	{
198	WerrorS("no ring active");
199	return TRUE;
200	}
201	}
202	else
203	{
204	if (h->Typ() != RING_CMD)
205	{
206	WerrorS("ring expected");
207	return TRUE;
208	}
209	r = (ring) h->Data();
210	}
211	res->rtyp = INT_CMD;
212	res->data = (void*) (long)(rBlocks(r) - 1);
213	return FALSE;
214	}
215	/==================== version ==================================/
216	if(strcmp(sys_cmd,"version")==0)
217	{
218	res->rtyp=INT_CMD;
219	res->data=(void *)SINGULAR_VERSION;
220	return FALSE;
221	}
222	else
223	/==================== gen ==================================/
224	if(strcmp(sys_cmd,"gen")==0)
225	{
226	res->rtyp=INT_CMD;
227	res->data=(void *)(long)npGen;
228	return FALSE;
229	}
230	else
231	/==================== sh ==================================/
232	if(strcmp(sys_cmd,"sh")==0)
233	{
234	res->rtyp=INT_CMD;
235	if (h==NULL) res->data = (void *)(long) system("sh");
236	else if (h->Typ()==STRING_CMD)
237	res->data = (void)(long) system((char)(h->Data()));
238	else
239	WerrorS("string expected");
240	return FALSE;
241	}
242	else
243	/==================== uname ==================================/
244	if(strcmp(sys_cmd,"uname")==0)
245	{
246	res->rtyp=STRING_CMD;
247	res->data = omStrDup(S_UNAME);
248	return FALSE;
249	}
250	else
251	/==================== with ==================================/
252	if(strcmp(sys_cmd,"with")==0)
253	{
254	if (h==NULL)
255	{
256	res->rtyp=STRING_CMD;
257	res->data=(void *)omStrDup(versionString());
258	return FALSE;
259	}
260	else if (h->Typ()==STRING_CMD)
261	{
262	#define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
263	char s=(char )h->Data();
264	res->rtyp=INT_CMD;
265	#ifdef HAVE_DBM
266	TEST_FOR("DBM")
267	#endif
268	#ifdef HAVE_DLD
269	TEST_FOR("DLD")
270	#endif
271	#ifdef HAVE_FACTORY
272	TEST_FOR("factory")
273	#endif
274	#ifdef HAVE_LIBFAC_P
275	TEST_FOR("libfac")
276	#endif
277	#ifdef HAVE_MPSR
278	TEST_FOR("MP")
279	#endif
280	#ifdef HAVE_READLINE
281	TEST_FOR("readline")
282	#endif
283	#ifdef HAVE_TCL
284	TEST_FOR("tcl")
285	#endif
286	#ifdef TEST_MAC_ORDER
287	TEST_FOR("MAC_ORDER");
288	#endif
289	#ifdef HAVE_NS
290	TEST_FOR("Namespaces");
291	#endif
292	#ifdef HAVE_DYNAMIC_LOADING
293	TEST_FOR("DynamicLoading");
294	#endif
295	#ifdef HAVE_EIGENVAL
296	TEST_FOR("eigenval");
297	#endif
298	#ifdef HAVE_GMS
299	TEST_FOR("gms");
300	#endif
301	;
302	return FALSE;
303	#undef TEST_FOR
304	}
305	return TRUE;
306	}
307	else
308	/==================== browsers ==================================/
309	if (strcmp(sys_cmd,"browsers")==0)
310	{
311	res->rtyp = STRING_CMD;
312	char* b = StringSetS("");
313	feStringAppendBrowsers(0);
314	res->data = omStrDup(b);
315	return FALSE;
316	}
317	else
318	/==================== pid ==================================/
319	if (strcmp(sys_cmd,"pid")==0)
320	{
321	res->rtyp=INT_CMD;
322	res->data=(void *)(long) getpid();
323	return FALSE;
324	}
325	else
326	/==================== getenv ==================================/
327	if (strcmp(sys_cmd,"getenv")==0)
328	{
329	if ((h!=NULL) && (h->Typ()==STRING_CMD))
330	{
331	res->rtyp=STRING_CMD;
332	char r=getenv((char )h->Data());
333	if (r==NULL) r="";
334	res->data=(void *)omStrDup(r);
335	return FALSE;
336	}
337	else
338	{
339	WerrorS("string expected");
340	return TRUE;
341	}
342	}
343	else
344	/==================== setenv ==================================/
345	if (strcmp(sys_cmd,"setenv")==0)
346	{
347	#ifdef HAVE_SETENV
348	if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL &&
349	h->next != NULL && h->next->Typ() == STRING_CMD
350	&& h->next->Data() != NULL)
351	{
352	res->rtyp=STRING_CMD;
353	setenv((char )h->Data(), (char )h->next->Data(), 1);
354	res->data=(void )omStrDup((char )h->next->Data());
355	feReInitResources();
356	return FALSE;
357	}
358	else
359	{
360	WerrorS("two strings expected");
361	return TRUE;
362	}
363	#else
364	WerrorS("setenv not supported on this platform");
365	return TRUE;
366	#endif
367	}
368	else
369	/==================== Singular ==================================/
370	if (strcmp(sys_cmd, "Singular") == 0)
371	{
372	res->rtyp=STRING_CMD;
373	char *r=feResource("Singular");
374	if (r == NULL) r="";
375	res->data = (void*) omStrDup( r );
376	return FALSE;
377	}
378	else
379	if (strcmp(sys_cmd, "SingularLib") == 0)
380	{
381	res->rtyp=STRING_CMD;
382	char *r=feResource("SearchPath");
383	if (r == NULL) r="";
384	res->data = (void*) omStrDup( r );
385	return FALSE;
386	}
387	else
388	/==================== options ==================================/
389	if (strstr(sys_cmd, "--") == sys_cmd)
390	{
391	if (strcmp(sys_cmd, "--") == 0)
392	{
393	fePrintOptValues();
394	return FALSE;
395	}
396
397	feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
398	if (opt == FE_OPT_UNDEF)
399	{
400	Werror("Unknown option %s", sys_cmd);
401	Werror("Use 'system(\"--\");' for listing of available options");
402	return TRUE;
403	}
404
405	// for Untyped Options (help version),
406	// setting it just triggers action
407	if (feOptSpec[opt].type == feOptUntyped)
408	{
409	feSetOptValue(opt,0);
410	return FALSE;
411	}
412
413	if (h == NULL)
414	{
415	if (feOptSpec[opt].type == feOptString)
416	{
417	res->rtyp = STRING_CMD;
418	char r=(char)feOptSpec[opt].value;
419	if (r == NULL) r="";
420	res->data = omStrDup(r);
421	}
422	else
423	{
424	res->rtyp = INT_CMD;
425	res->data = feOptSpec[opt].value;
426	}
427	return FALSE;
428	}
429
430	if (h->Typ() != STRING_CMD &&
431	h->Typ() != INT_CMD)
432	{
433	Werror("Need string or int argument to set option value");
434	return TRUE;
435	}
436	char* errormsg;
437	if (h->Typ() == INT_CMD)
438	{
439	if (feOptSpec[opt].type == feOptString)
440	{
441	Werror("Need string argument to set value of option %s", sys_cmd);
442	return TRUE;
443	}
444	errormsg = feSetOptValue(opt, (int)((long) h->Data()));
445	if (errormsg != NULL)
446	Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
447	}
448	else
449	{
450	errormsg = feSetOptValue(opt, (char*) h->Data());
451	if (errormsg != NULL)
452	Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
453	}
454	if (errormsg != NULL) return TRUE;
455	return FALSE;
456	}
457	else
458	/==================== HC ==================================/
459	if (strcmp(sys_cmd,"HC")==0)
460	{
461	res->rtyp=INT_CMD;
462	res->data=(void *)(long) HCord;
463	return FALSE;
464	}
465	else
466	/==================== random ==================================/
467	if(strcmp(sys_cmd,"random")==0)
468	{
469	if ((h!=NULL) &&(h->Typ()==INT_CMD))
470	{
471	siRandomStart=(int)((long)h->Data());
472	#ifdef buildin_rand
473	siSeed=siRandomStart;
474	#else
475	srand((unsigned int)siRandomStart);
476	#endif
477	#ifdef HAVE_FACTORY
478	factoryseed(siRandomStart);
479	#endif
480	return FALSE;
481	}
482	else if (h != NULL)
483	{
484	WerrorS("int expected");
485	return TRUE;
486	}
487	res->rtyp=INT_CMD;
488	res->data=(void*)(long) siRandomStart;
489	return FALSE;
490	}
491	/==================== complexNearZero ======================/
492	if(strcmp(sys_cmd,"complexNearZero")==0)
493	{
494	if (h->Typ()==NUMBER_CMD )
495	{
496	if ( h->next!=NULL && h->next->Typ()==INT_CMD )
497	{
498	if ( !rField_is_long_C() )
499	{
500	Werror( "unsupported ground field!");
501	return TRUE;
502	}
503	else
504	{
505	res->rtyp=INT_CMD;
506	res->data=(void)complexNearZero((gmp_complex)h->Data(),
507	(int)((long)(h->next->Data())));
508	return FALSE;
509	}
510	}
511	else
512	{
513	Werror( "expected <int> as third parameter!");
514	return TRUE;
515	}
516	}
517	else
518	{
519	Werror( "expected <number> as second parameter!");
520	return TRUE;
521	}
522	}
523	/==================== getPrecDigits ======================/
524	if(strcmp(sys_cmd,"getPrecDigits")==0)
525	{
526	if ( !rField_is_long_C() && !rField_is_long_R() )
527	{
528	Werror( "unsupported ground field!");
529	return TRUE;
530	}
531	res->rtyp=INT_CMD;
532	res->data=(void*)getGMPFloatDigits();
533	return FALSE;
534	}
535	/==================== neworder =============================/
536	// should go below
537	#ifdef HAVE_LIBFAC_P
538	if(strcmp(sys_cmd,"neworder")==0)
539	{
540	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
541	{
542	res->rtyp=STRING_CMD;
543	res->data=(void *)singclap_neworder((ideal)h->Data());
544	return FALSE;
545	}
546	else
547	WerrorS("ideal expected");
548	}
549	else
550	#endif
551	//#ifndef HAVE_DYNAMIC_LOADING
552	/==================== pcv ==================================/
553	#ifdef HAVE_PCV
554	if(strcmp(sys_cmd,"pcvLAddL")==0)
555	{
556	return pcvLAddL(res,h);
557	}
558	else
559	if(strcmp(sys_cmd,"pcvPMulL")==0)
560	{
561	return pcvPMulL(res,h);
562	}
563	else
564	if(strcmp(sys_cmd,"pcvMinDeg")==0)
565	{
566	return pcvMinDeg(res,h);
567	}
568	else
569	if(strcmp(sys_cmd,"pcvP2CV")==0)
570	{
571	return pcvP2CV(res,h);
572	}
573	else
574	if(strcmp(sys_cmd,"pcvCV2P")==0)
575	{
576	return pcvCV2P(res,h);
577	}
578	else
579	if(strcmp(sys_cmd,"pcvDim")==0)
580	{
581	return pcvDim(res,h);
582	}
583	else
584	if(strcmp(sys_cmd,"pcvBasis")==0)
585	{
586	return pcvBasis(res,h);
587	}
588	else
589	#endif
590	/==================== eigenvalues ==================================/
591	#ifdef HAVE_EIGENVAL
592	if(strcmp(sys_cmd,"hessenberg")==0)
593	{
594	return evHessenberg(res,h);
595	}
596	else
597	if(strcmp(sys_cmd,"eigenvals")==0)
598	{
599	return evEigenvals(res,h);
600	}
601	else
602	#endif
603	/==================== Gauss-Manin system ==================================/
604	#ifdef HAVE_GMS
605	if(strcmp(sys_cmd,"gmsnf")==0)
606	{
607	return gmsNF(res,h);
608	}
609	else
610	#endif
611	//#endif /* HAVE_DYNAMIC_LOADING */
612	/==================== contributors =============================/
613	if(strcmp(sys_cmd,"contributors") == 0)
614	{
615	res->rtyp=STRING_CMD;
616	res->data=(void *)omStrDup(
617	"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");
618	return FALSE;
619	}
620	else
621	/==================== spectrum =============================/
622	#ifdef HAVE_SPECTRUM
623	if(strcmp(sys_cmd,"spectrum") == 0)
624	{
625	if (h->Typ()!=POLY_CMD)
626	{
627	WerrorS("poly expected");
628	return TRUE;
629	}
630	if (h->next==NULL)
631	return spectrumProc(res,h);
632	if (h->next->Typ()!=INT_CMD)
633	{
634	WerrorS("poly,int expected");
635	return TRUE;
636	}
637	if(((long)h->next->Data())==1L)
638	return spectrumfProc(res,h);
639	return spectrumProc(res,h);
640	}
641	else
642	/==================== semic =============================/
643	if(strcmp(sys_cmd,"semic") == 0)
644	{
645	if ((h->next!=NULL)
646	&& (h->Typ()==LIST_CMD)
647	&& (h->next->Typ()==LIST_CMD))
648	{
649	if (h->next->next==NULL)
650	return semicProc(res,h,h->next);
651	else if (h->next->next->Typ()==INT_CMD)
652	return semicProc3(res,h,h->next,h->next->next);
653	}
654	return TRUE;
655	}
656	else
657	/==================== spadd =============================/
658	if(strcmp(sys_cmd,"spadd") == 0)
659	{
660	if ((h->next!=NULL)
661	&& (h->Typ()==LIST_CMD)
662	&& (h->next->Typ()==LIST_CMD))
663	{
664	if (h->next->next==NULL)
665	return spaddProc(res,h,h->next);
666	}
667	return TRUE;
668	}
669	else
670	/==================== spmul =============================/
671	if(strcmp(sys_cmd,"spmul") == 0)
672	{
673	if ((h->next!=NULL)
674	&& (h->Typ()==LIST_CMD)
675	&& (h->next->Typ()==INT_CMD))
676	{
677	if (h->next->next==NULL)
678	return spmulProc(res,h,h->next);
679	}
680	return TRUE;
681	}
682	else
683	#endif
684	#ifdef HAVE_PLURAL
685	/==================== Approx_Step =================/
686	if (strcmp(sys_cmd, "astep") == 0)
687	{
688	ideal I;
689	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
690	{
691	I=(ideal)h->CopyD();
692	res->rtyp=IDEAL_CMD;
693	if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
694	else res->data=I;
695	setFlag(res,FLAG_STD);
696	}
697	else return TRUE;
698	return FALSE;
699	}
700	/==================== PrintMat =================/
701	if (strcmp(sys_cmd, "PrintMat") == 0)
702	{
703	int a;
704	int b;
705	ring r;
706	int metric;
707	if ((h!=NULL) && (h->Typ()==INT_CMD))
708	{
709	a=(int)((long)(h->Data()));
710	h=h->next;
711	}
712	else return TRUE;
713	if ((h!=NULL) && (h->Typ()==INT_CMD))
714	{
715	b=(int)((long)(h->Data()));
716	h=h->next;
717	}
718	else return TRUE;
719	if ((h!=NULL) && (h->Typ()==RING_CMD))
720	{
721	r=(ring)h->Data();
722	h=h->next;
723	}
724	else return TRUE;
725	if ((h!=NULL) && (h->Typ()==INT_CMD))
726	{
727	metric=(int)((long)(h->Data()));
728	}
729	res->rtyp=MATRIX_CMD;
730	if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
731	else res->data=NULL;
732	return FALSE;
733	}
734	/==================== twostd =================/
735	if (strcmp(sys_cmd, "twostd") == 0)
736	{
737	ideal I;
738	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
739	{
740	I=(ideal)h->CopyD();
741	res->rtyp=IDEAL_CMD;
742	if (rIsPluralRing(currRing)) res->data=twostd(I);
743	else res->data=I;
744	setFlag(res,FLAG_TWOSTD);
745	setFlag(res,FLAG_STD);
746	}
747	else return TRUE;
748	return FALSE;
749	}
750	/==================== lie bracket =================/
751	if (strcmp(sys_cmd, "bracket") == 0)
752	{
753	poly p;
754	poly q;
755	if ((h!=NULL) && (h->Typ()==POLY_CMD))
756	{
757	p=(poly)h->CopyD();
758	h=h->next;
759	}
760	else return TRUE;
761	if ((h!=NULL) && (h->Typ()==POLY_CMD))
762	{
763	q=(poly)h->Data();
764	}
765	else return TRUE;
766	res->rtyp=POLY_CMD;
767	if (rIsPluralRing(currRing)) res->data=nc_p_Bracket_qq(p,q);
768	else res->data=NULL;
769	return FALSE;
770	}
771	/==================== PLURAL =================/
772	#if 0
773	if (strcmp(sys_cmd, "PLURAL") == 0)
774	{
775	matrix C;
776	matrix D;
777	number nN;
778	poly pN;
779	int i,j;
780	sleftv tmp_v;
781	memset(&tmp_v,0,sizeof(tmp_v));
782
783	if (currRing->nc==NULL)
784	{
785	currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
786	currRing->nc->ref=1;
787	currRing->nc->basering=currRing;
788	}
789	else
790	{
791	WarnS("redefining algebra structure");
792	if (currRing->nc->ref>1) // in use by somebody else
793	currRing->nc->ref--;
794	else
795	ncKill(currRing); /* kill the previous nc data */
796	currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
797	currRing->nc->ref=1;
798	currRing->nc->basering=currRing;
799	}
800	currRing->nc->type=nc_general;
801	/* C is either a poly (coeff - an int or a number) or a matrix */
802	if (h==NULL) return TRUE;
803	leftv hh=h->next;
804	h->next=NULL;
805	switch(h->Typ())
806	{
807	case MATRIX_CMD: { C=(matrix)h->CopyD(); break; }
808
809	case INT_CMD: case NUMBER_CMD:
810	{
811	i=iiTestConvert(h->Typ(), POLY_CMD);
812	if (i==0)
813	{
814	Werror("cannot convert to poly");
815	return TRUE;
816	}
817	iiConvert(h->Typ(), POLY_CMD, i, h, &tmp_v);
818	pN=(poly)tmp_v.Data();
819	break;
820	}
821
822	case POLY_CMD: {pN=(poly)h->Data(); break;}
823
824	default: return TRUE;
825	}
826	if (h->Typ()==MATRIX_CMD)
827	{
828	currRing->nc->type=nc_undef; /* to analyze later ! */
829	// currRing->nc->IsSkewConstant=NULL;
830	}
831	else
832	{
833	nN=pGetCoeff(pN); // pN is not NULL anyway
834	if (nIsZero(nN))
835	{
836	Werror("zero coefficients are not allowed");
837	return TRUE;
838	}
839	if (nIsOne(nN)) currRing->nc->type=nc_lie;
840	else currRing->nc->type=nc_skew;
841	currRing->nc->IsSkewConstant=1;
842	/* create matrix C */
843	C=mpNew(currRing->N,currRing->N);
844	for(i=1;i<currRing->N;i++)
845	{
846	for(j=i+1;j<=currRing->N;j++)
847	{
848	MATELEM(C,i,j) = nc_p_CopyPut(pN,currRing);
849	// MATELEM(C,i,j)=pCopy(pN);
850	}
851	}
852	}
853	pN=NULL;
854	h=hh;
855	/* D is either a poly or a matrix */
856	if (h==NULL) { pN=NULL;} /* D is zero matrix */
857	else
858	{
859	switch(h->Typ())
860	{
861	case MATRIX_CMD: { D=(matrix)h->CopyD(); break;}
862
863	case INT_CMD: case NUMBER_CMD:
864	{
865	i=iiTestConvert(h->Typ(), POLY_CMD);
866	if (i==0)
867	{
868	Werror("cannot convert to poly");
869	return TRUE;
870	}
871	iiConvert(h->Typ(), POLY_CMD, i, h, &tmp_v);
872	pN=(poly)tmp_v.Data();
873	break;
874	}
875
876	case POLY_CMD: { pN=(poly)h->Data();break;}
877
878	default: return TRUE;
879	}
880	} /* end else h==NULL */
881	if (pN==NULL)
882	{
883	if (currRing->nc->type==nc_lie)
884	{
885	currRing->nc->type=nc_skew; /* even commutative! */
886	}
887	}
888	else
889	{
890	if (currRing->nc->type==nc_skew) currRing->nc->type=nc_general;
891	} /* end pN==NULL */
892	if (h==NULL)
893	{
894	WerrorS("expected `system(\"PLURAL\",<matrix>,<matrix>)`");
895	idDelete((ideal *)&(currRing->nc->C));
896	omFreeSize((ADDRESS)currRing->nc,sizeof(nc_struct));
897	currRing->nc=NULL;
898	return TRUE;
899	}
900	if (h->Typ()!=MATRIX_CMD)
901	{
902	D=mpNew(currRing->N,currRing->N);
903	/* create matrix D */
904	for(i=1;i<currRing->N;i++)
905	{
906	for(j=i+1;j<=currRing->N;j++)
907	{
908	MATELEM(D,i,j) = nc_p_CopyPut(pN,currRing);
909	// MATELEM(D,i,j)=pCopy(pN);
910	}
911	}
912	}
913	else currRing->nc->type=nc_undef;
914	tmp_v.CleanUp();
915	pN=NULL;
916	/* Now we proceed with C and D */
917	matrix COM;
918	currRing->nc->MT=(matrix )omAlloc0(currRing->N(currRing->N-1)/2*sizeof(matrix));
919	currRing->nc->MTsize=(int )omAlloc0(currRing->N(currRing->N-1)/2*sizeof(int));
920	currRing->nc->C=C;
921	currRing->nc->D=D;
922	COM=mpCopy(currRing->nc->C);
923	poly p;
924	short DefMTsize=7;
925	int tmpIsSkewConstant=1;
926	int IsNonComm=0;
927	pN=nc_p_CopyGet(MATELEM(currRing->nc->C,1,2),currRing);
928	// pN=MATELEM(currRing->nc->C,1,2);
929
930	for(i=1;i<currRing->N;i++)
931	{
932	for(j=i+1;j<=currRing->N;j++)
933	{
934	if (MATELEM(currRing->nc->C,i,j)==NULL)
935	{
936	Werror("Incorrect input : matrix of coefficients contains zeros in the upper triangle!");
937	return TRUE;
938	}
939	if (!nEqual(pGetCoeff(pN),pGetCoeff(MATELEM(currRing->nc->C,i,j)))) tmpIsSkewConstant=0;
940	if (MATELEM(currRing->nc->D,i,j)==NULL) /* quasicommutative case */
941	{
942	currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=1;
943	/* 1x1 mult.matrix */
944	currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(1,1);
945	}
946	else /* pure noncommutative case*/
947	{
948	IsNonComm=1;
949	MATELEM(COM,i,j)=NULL;
950	currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=DefMTsize; /* default sizes */
951	currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(DefMTsize,DefMTsize);
952	}
953	p=pOne();
954	pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
955	pSetExp(p,i,1);
956	pSetExp(p,j,1);
957	pSetm(p);
958	// p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
959	p=pAdd(p,nc_p_CopyGet(MATELEM(currRing->nc->D,i,j),currRing));
960	// MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=p;
961	MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=nc_p_CopyPut(p,currRing);
962	pDelete(&p);
963	p=NULL;
964	}
965	/* set MT[i,j,1,1] to c_i_jx_ix_j + D_i_j */
966	}
967	if (currRing->nc->type==nc_undef)
968	{
969	if (IsNonComm==1)
970	{
971	assume(pN!=NULL);
972	if ((tmpIsSkewConstant==1) && (nIsOne(pGetCoeff(pN)))) currRing->nc->type=nc_lie;
973	else currRing->nc->type=nc_general;
974	}
975	if (IsNonComm==0)
976	{
977	currRing->nc->type=nc_skew; /* could be also commutative */
978	currRing->nc->IsSkewConstant=tmpIsSkewConstant;
979	}
980	}
981	currRing->nc->COM=COM;
982	return FALSE;
983	}
984	else
985	#endif
986	/==================== opp ==================================/
987	if (strcmp(sys_cmd, "opp")==0)
988	{
989	if ((h!=NULL) && (h->Typ()==RING_CMD))
990	{
991	ring r=(ring)h->Data();
992	res->data=rOpposite(r);
993	res->rtyp=RING_CMD;
994	return FALSE;
995	}
996	else
997	{
998	WerrorS("`system(\"opp\",<ring>)` expected");
999	return TRUE;
1000	}
1001	}
1002	else
1003	/==================== env ==================================/
1004	if (strcmp(sys_cmd, "env")==0)
1005	{
1006	if ((h!=NULL) && (h->Typ()==RING_CMD))
1007	{
1008	ring r = (ring)h->Data();
1009	res->data = rEnvelope(r);
1010	res->rtyp = RING_CMD;
1011	return FALSE;
1012	}
1013	else
1014	{
1015	WerrorS("`system(\"env\",<ring>)` expected");
1016	return TRUE;
1017	}
1018	}
1019	else
1020	/==================== oppose ==================================/
1021	if (strcmp(sys_cmd, "oppose")==0)
1022	{
1023	ring Rop;
1024	if ((h!=NULL) && (h->Typ()==RING_CMD))
1025	{
1026	Rop = (ring)h->Data();
1027	h = h->next;
1028	}
1029	if ((h!=NULL))
1030	{
1031	idhdl w;
1032	if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1033	{
1034	poly p = (poly)IDDATA(w);
1035	res->data = pOppose(Rop,p);
1036	res->rtyp = POLY_CMD;
1037	return FALSE;
1038	}
1039	}
1040	else
1041	{
1042	WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1043	return TRUE;
1044	}
1045	}
1046	else
1047	#endif
1048	#ifdef HAVE_WALK
1049	/==================== walk stuff =================/
1050	#ifdef OWNW
1051	if (strcmp(sys_cmd, "walkNextWeight") == 0)
1052	{
1053	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1054	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1055	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1056	{
1057	Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1058	return TRUE;
1059	}
1060
1061	if (((intvec*) h->Data())->length() != currRing->N \|\|
1062	((intvec*) h->next->Data())->length() != currRing->N)
1063	{
1064	Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1065	currRing->N);
1066	return TRUE;
1067	}
1068	res->data = (void) walkNextWeight(((intvec) h->Data()),
1069	((intvec*) h->next->Data()),
1070	(ideal) h->next->next->Data());
1071	if (res->data == (void) 0 \|\| res->data == (void) 1)
1072	{
1073	res->rtyp = INT_CMD;
1074	}
1075	else
1076	{
1077	res->rtyp = INTVEC_CMD;
1078	}
1079	return FALSE;
1080	}
1081	else if (strcmp(sys_cmd, "walkInitials") == 0)
1082	{
1083	if (h == NULL \|\| h->Typ() != IDEAL_CMD)
1084	{
1085	WerrorS("system(\"walkInitials\", ideal) expected");
1086	return TRUE;
1087	}
1088
1089	res->data = (void*) walkInitials((ideal) h->Data());
1090	res->rtyp = IDEAL_CMD;
1091	return FALSE;
1092	}
1093	else
1094	#endif
1095	#ifdef WAIV
1096	if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1097	{
1098	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1099	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD)
1100	{
1101	WerrorS("system(\"walkAddIntVec\", intvec, intvec) expected");
1102	return TRUE;
1103	}
1104	intvec* arg1 = (intvec*) h->Data();
1105	intvec* arg2 = (intvec*) h->next->Data();
1106
1107
1108	res->data = (intvec*) walkAddIntVec(arg1, arg2);
1109	res->rtyp = INTVEC_CMD;
1110	return FALSE;
1111	}
1112	else
1113	#endif
1114	#ifdef MwaklNextWeight
1115	if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1116	{
1117	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1118	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1119	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1120	{
1121	Werror("system(\"MwalkNextWeight\", intvec, intvec, ideal) expected");
1122	return TRUE;
1123	}
1124
1125	if (((intvec*) h->Data())->length() != currRing->N \|\|
1126	((intvec*) h->next->Data())->length() != currRing->N)
1127	{
1128	Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1129	currRing->N);
1130	return TRUE;
1131	}
1132	intvec* arg1 = (intvec*) h->Data();
1133	intvec* arg2 = (intvec*) h->next->Data();
1134	ideal arg3 = (ideal) h->next->next->Data();
1135
1136	intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1137
1138	res->rtyp = INTVEC_CMD;
1139	res->data = result;
1140
1141	return FALSE;
1142	}
1143	else
1144	#endif //MWalkNextWeight
1145	if(strcmp(sys_cmd, "Mivdp") == 0)
1146	{
1147	if (h == NULL \|\| h->Typ() != INT_CMD)
1148	{
1149	Werror("system(\"Mivdp\", int) expected");
1150	return TRUE;
1151	}
1152	if ((int) ((long)(h->Data())) != currRing->N)
1153	{
1154	Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1155	currRing->N);
1156	return TRUE;
1157	}
1158	int arg1 = (int) ((long)(h->Data()));
1159
1160	intvec* result = (intvec*) Mivdp(arg1);
1161
1162	res->rtyp = INTVEC_CMD;
1163	res->data = result;
1164
1165	return FALSE;
1166	}
1167
1168	else if(strcmp(sys_cmd, "Mivlp") == 0)
1169	{
1170	if (h == NULL \|\| h->Typ() != INT_CMD)
1171	{
1172	Werror("system(\"Mivlp\", int) expected");
1173	return TRUE;
1174	}
1175	if ((int) ((long)(h->Data())) != currRing->N)
1176	{
1177	Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1178	currRing->N);
1179	return TRUE;
1180	}
1181	int arg1 = (int) ((long)(h->Data()));
1182
1183	intvec* result = (intvec*) Mivlp(arg1);
1184
1185	res->rtyp = INTVEC_CMD;
1186	res->data = result;
1187
1188	return FALSE;
1189	}
1190	else
1191	#ifdef MpDiv
1192	if(strcmp(sys_cmd, "MpDiv") == 0)
1193	{
1194	if(h==NULL \|\| h->Typ() != POLY_CMD \|\|
1195	h->next == NULL \|\| h->next->Typ() != POLY_CMD)
1196	{
1197	Werror("system(\"MpDiv\",poly, poly) expected");
1198	return TRUE;
1199	}
1200	poly arg1 = (poly) h->Data();
1201	poly arg2 = (poly) h->next->Data();
1202
1203	poly result = MpDiv(arg1, arg2);
1204
1205	res->rtyp = POLY_CMD;
1206	res->data = result;
1207	return FALSE;
1208	}
1209	else
1210	#endif
1211	#ifdef MpMult
1212	if(strcmp(sys_cmd, "MpMult") == 0)
1213	{
1214	if(h==NULL \|\| h->Typ() != POLY_CMD \|\|
1215	h->next == NULL \|\| h->next->Typ() != POLY_CMD)
1216	{
1217	Werror("system(\"MpMult\",poly, poly) expected");
1218	return TRUE;
1219	}
1220	poly arg1 = (poly) h->Data();
1221	poly arg2 = (poly) h->next->Data();
1222
1223	poly result = MpMult(arg1, arg2);
1224	res->rtyp = POLY_CMD;
1225	res->data = result;
1226	return FALSE;
1227	}
1228	else
1229	#endif
1230	if (strcmp(sys_cmd, "MivSame") == 0)
1231	{
1232	if(h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1233	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD )
1234	{
1235	Werror("system(\"MivSame\", intvec, intvec) expected");
1236	return TRUE;
1237	}
1238	/*
1239	if (((intvec*) h->Data())->length() != currRing->N \|\|
1240	((intvec*) h->next->Data())->length() != currRing->N)
1241	{
1242	Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1243	currRing->N);
1244	return TRUE;
1245	}
1246	*/
1247	intvec* arg1 = (intvec*) h->Data();
1248	intvec* arg2 = (intvec*) h->next->Data();
1249	/*
1250	poly result = (poly) MivSame(arg1, arg2);
1251
1252	res->rtyp = POLY_CMD;
1253	res->data = (poly) result;
1254	*/
1255	res->rtyp = INT_CMD;
1256	res->data = (void*)(long) MivSame(arg1, arg2);
1257	return FALSE;
1258	}
1259	else
1260	if (strcmp(sys_cmd, "M3ivSame") == 0)
1261	{
1262	if(h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1263	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1264	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD )
1265	{
1266	Werror("system(\"M3ivSame\", intvec, intvec, intvec) expected");
1267	return TRUE;
1268	}
1269	/*
1270	if (((intvec*) h->Data())->length() != currRing->N \|\|
1271	((intvec*) h->next->Data())->length() != currRing->N \|\|
1272	((intvec*) h->next->next->Data())->length() != currRing->N )
1273	{
1274	Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1275	currRing->N);
1276	return TRUE;
1277	}
1278	*/
1279	intvec* arg1 = (intvec*) h->Data();
1280	intvec* arg2 = (intvec*) h->next->Data();
1281	intvec* arg3 = (intvec*) h->next->next->Data();
1282	/*
1283	poly result = (poly) M3ivSame(arg1, arg2, arg3);
1284
1285	res->rtyp = POLY_CMD;
1286	res->data = (poly) result;
1287	*/
1288	res->rtyp = INT_CMD;
1289	res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1290	return FALSE;
1291	}
1292	else
1293	if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1294	{
1295	if(h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1296	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD)
1297	{
1298	Werror("system(\"MwalkInitialForm\", ideal, intvec) expected");
1299	return TRUE;
1300	}
1301	if(((intvec*) h->next->Data())->length() != currRing->N)
1302	{
1303	Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1304	currRing->N);
1305	return TRUE;
1306	}
1307	ideal id = (ideal) h->Data();
1308	intvec* int_w = (intvec*) h->next->Data();
1309	ideal result = (ideal) MwalkInitialForm(id, int_w);
1310
1311	res->rtyp = IDEAL_CMD;
1312	res->data = result;
1313	return FALSE;
1314	}
1315	else
1316	/************ Perturbation walk ********/
1317	if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1318	{
1319	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1320	{
1321	Werror("system(\"MivMatrixOrder\",intvec) expected");
1322	return TRUE;
1323	}
1324	intvec* arg1 = (intvec*) h->Data();
1325
1326	intvec* result = MivMatrixOrder(arg1);
1327
1328	res->rtyp = INTVEC_CMD;
1329	res->data = result;
1330	return FALSE;
1331	}
1332	else
1333	if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1334	{
1335	if(h==NULL \|\| h->Typ() != INT_CMD)
1336	{
1337	Werror("system(\"MivMatrixOrderdp\",intvec) expected");
1338	return TRUE;
1339	}
1340	int arg1 = (int) ((long)(h->Data()));
1341
1342	intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1343
1344	res->rtyp = INTVEC_CMD;
1345	res->data = result;
1346	return FALSE;
1347	}
1348	else
1349	if(strcmp(sys_cmd, "MPertVectors") == 0)
1350	{
1351
1352	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1353	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1354	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1355	{
1356	Werror("system(\"MPertVectors\",ideal, intvec, int) expected");
1357	return TRUE;
1358	}
1359
1360	ideal arg1 = (ideal) h->Data();
1361	intvec* arg2 = (intvec*) h->next->Data();
1362	int arg3 = (int) ((long)(h->next->next->Data()));
1363
1364	intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1365
1366	res->rtyp = INTVEC_CMD;
1367	res->data = result;
1368	return FALSE;
1369	}
1370	else
1371	if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1372	{
1373
1374	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1375	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1376	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1377	{
1378	Werror("system(\"MPertVectorslp\",ideal, intvec, int) expected");
1379	return TRUE;
1380	}
1381
1382	ideal arg1 = (ideal) h->Data();
1383	intvec* arg2 = (intvec*) h->next->Data();
1384	int arg3 = (int) ((long)(h->next->next->Data()));
1385
1386	intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1387
1388	res->rtyp = INTVEC_CMD;
1389	res->data = result;
1390	return FALSE;
1391	}
1392	/************ fractal walk ********/
1393	else
1394	if(strcmp(sys_cmd, "Mfpertvector") == 0)
1395	{
1396	if(h==NULL \|\| h->Typ() != IDEAL_CMD \|\|
1397	h->next==NULL \|\| h->next->Typ() != INTVEC_CMD )
1398	{
1399	Werror("system(\"Mfpertvector\", ideal,intvec) expected");
1400	return TRUE;
1401	}
1402	ideal arg1 = (ideal) h->Data();
1403	intvec* arg2 = (intvec*) h->next->Data();
1404	intvec* result = Mfpertvector(arg1, arg2);
1405
1406	res->rtyp = INTVEC_CMD;
1407	res->data = result;
1408	return FALSE;
1409	}
1410	else
1411	if(strcmp(sys_cmd, "MivUnit") == 0)
1412	{
1413	int arg1 = (int) ((long)(h->Data()));
1414
1415	intvec* result = (intvec*) MivUnit(arg1);
1416
1417	res->rtyp = INTVEC_CMD;
1418	res->data = result;
1419	return FALSE;
1420	}
1421	else
1422	if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1423	{
1424	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1425	{
1426	Werror("system(\"MivWeightOrderlp\",intvec) expected");
1427	return TRUE;
1428	}
1429	intvec* arg1 = (intvec*) h->Data();
1430	intvec* result = MivWeightOrderlp(arg1);
1431
1432	res->rtyp = INTVEC_CMD;
1433	res->data = result;
1434	return FALSE;
1435	}
1436	else
1437	if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1438	{
1439	if(h==NULL \|\| h->Typ() != INTVEC_CMD)
1440	{
1441	Werror("system(\"MivWeightOrderdp\",intvec) expected");
1442	return TRUE;
1443	}
1444	intvec* arg1 = (intvec*) h->Data();
1445	//int arg2 = (int) h->next->Data();
1446
1447	intvec* result = MivWeightOrderdp(arg1);
1448
1449	res->rtyp = INTVEC_CMD;
1450	res->data = result;
1451	return FALSE;
1452	}
1453	else
1454	if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1455	{
1456	if(h==NULL \|\| h->Typ() != INT_CMD)
1457	{
1458	Werror("system(\"MivMatrixOrderlp\",int) expected");
1459	return TRUE;
1460	}
1461	int arg1 = (int) ((long)(h->Data()));
1462
1463	intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1464
1465	res->rtyp = INTVEC_CMD;
1466	res->data = result;
1467	return FALSE;
1468	}
1469	else
1470	if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1471	{
1472	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1473	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1474	h->next->next == NULL \|\| h->next->next->Typ() != IDEAL_CMD)
1475	{
1476	Werror("system(\"MkInterRedNextWeight\", intvec, intvec, ideal) expected");
1477	return TRUE;
1478	}
1479
1480	if (((intvec*) h->Data())->length() != currRing->N \|\|
1481	((intvec*) h->next->Data())->length() != currRing->N)
1482	{
1483	Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1484	currRing->N);
1485	return TRUE;
1486	}
1487	intvec* arg1 = (intvec*) h->Data();
1488	intvec* arg2 = (intvec*) h->next->Data();
1489	ideal arg3 = (ideal) h->next->next->Data();
1490
1491	intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1492
1493	res->rtyp = INTVEC_CMD;
1494	res->data = result;
1495
1496	return FALSE;
1497	}
1498	else
1499	#ifdef MPertNextWeight
1500	if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1501	{
1502	if (h == NULL \|\| h->Typ() != INTVEC_CMD \|\|
1503	h->next == NULL \|\| h->next->Typ() != IDEAL_CMD \|\|
1504	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD)
1505	{
1506	Werror("system(\"MPertNextWeight\", intvec, ideal, int) expected");
1507	return TRUE;
1508	}
1509
1510	if (((intvec*) h->Data())->length() != currRing->N)
1511	{
1512	Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1513	currRing->N);
1514	return TRUE;
1515	}
1516	intvec* arg1 = (intvec*) h->Data();
1517	ideal arg2 = (ideal) h->next->Data();
1518	int arg3 = (int) h->next->next->Data();
1519
1520	intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1521
1522	res->rtyp = INTVEC_CMD;
1523	res->data = result;
1524
1525	return FALSE;
1526	}
1527	else
1528	#endif //MPertNextWeight
1529	#ifdef Mivperttarget
1530	if (strcmp(sys_cmd, "Mivperttarget") == 0)
1531	{
1532	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1533	h->next == NULL \|\| h->next->Typ() != INT_CMD )
1534	{
1535	Werror("system(\"Mivperttarget\", ideal, int) expected");
1536	return TRUE;
1537	}
1538
1539	ideal arg1 = (ideal) h->Data();
1540	int arg2 = (int) h->next->Data();
1541
1542	intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1543
1544	res->rtyp = INTVEC_CMD;
1545	res->data = result;
1546
1547	return FALSE;
1548	}
1549	else
1550	#endif //Mivperttarget
1551	if (strcmp(sys_cmd, "Mwalk") == 0)
1552	{
1553	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1554	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1555	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1556	{
1557	Werror("system(\"Mwalk\", ideal, intvec, intvec) expected");
1558	return TRUE;
1559	}
1560
1561	if (((intvec*) h->next->Data())->length() != currRing->N &&
1562	((intvec*) h->next->next->Data())->length() != currRing->N )
1563	{
1564	Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1565	currRing->N);
1566	return TRUE;
1567	}
1568	ideal arg1 = (ideal) h->Data();
1569	intvec* arg2 = (intvec*) h->next->Data();
1570	intvec* arg3 = (intvec*) h->next->next->Data();
1571
1572
1573	ideal result = (ideal) Mwalk(arg1, arg2, arg3);
1574
1575	res->rtyp = IDEAL_CMD;
1576	res->data = result;
1577
1578	return FALSE;
1579	}
1580	else
1581	#ifdef MPWALK_ORIG
1582	if (strcmp(sys_cmd, "Mpwalk") == 0)
1583	{
1584	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1585	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1586	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1587	h->next->next->next == NULL \|\|
1588	h->next->next->next->Typ() != INTVEC_CMD \|\|
1589	h->next->next->next->next == NULL \|\|
1590	h->next->next->next->next->Typ() != INTVEC_CMD)
1591	{
1592	Werror("system(\"Mpwalk\", ideal, int, int, intvec, intvec) expected");
1593	return TRUE;
1594	}
1595
1596	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1597	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1598	{
1599	Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",
1600	currRing->N);
1601	return TRUE;
1602	}
1603	ideal arg1 = (ideal) h->Data();
1604	int arg2 = (int) h->next->Data();
1605	int arg3 = (int) h->next->next->Data();
1606	intvec* arg4 = (intvec*) h->next->next->next->Data();
1607	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1608
1609
1610	ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5);
1611
1612	res->rtyp = IDEAL_CMD;
1613	res->data = result;
1614
1615	return FALSE;
1616	}
1617	else
1618	#endif
1619	if (strcmp(sys_cmd, "Mpwalk") == 0)
1620	{
1621	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1622	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1623	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1624	h->next->next->next == NULL \|\|
1625	h->next->next->next->Typ() != INTVEC_CMD \|\|
1626	h->next->next->next->next == NULL \|\|
1627	h->next->next->next->next->Typ() != INTVEC_CMD\|\|
1628	h->next->next->next->next->next == NULL \|\|
1629	h->next->next->next->next->next->Typ() != INT_CMD)
1630	{
1631	Werror("system(\"Mpwalk\", ideal, int, int, intvec, intvec, int) expected");
1632	return TRUE;
1633	}
1634
1635	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1636	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1637	{
1638	Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",
1639	currRing->N);
1640	return TRUE;
1641	}
1642	ideal arg1 = (ideal) h->Data();
1643	int arg2 = (int) ((long)(h->next->Data()));
1644	int arg3 = (int) ((long)(h->next->next->Data()));
1645	intvec* arg4 = (intvec*) h->next->next->next->Data();
1646	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1647	int arg6 = (int) ((long)(h->next->next->next->next->next->Data()));
1648
1649
1650	ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1651
1652	res->rtyp = IDEAL_CMD;
1653	res->data = result;
1654
1655	return FALSE;
1656	}
1657	else
1658	if (strcmp(sys_cmd, "MAltwalk1") == 0)
1659	{
1660	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1661	h->next == NULL \|\| h->next->Typ() != INT_CMD \|\|
1662	h->next->next == NULL \|\| h->next->next->Typ() != INT_CMD \|\|
1663	h->next->next->next == NULL \|\|
1664	h->next->next->next->Typ() != INTVEC_CMD \|\|
1665	h->next->next->next->next == NULL \|\|
1666	h->next->next->next->next->Typ() != INTVEC_CMD)
1667	{
1668	Werror("system(\"MAltwalk1\", ideal, int, int, intvec, intvec) expected");
1669	return TRUE;
1670	}
1671
1672	if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1673	((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1674	{
1675	Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
1676	currRing->N);
1677	return TRUE;
1678	}
1679	ideal arg1 = (ideal) h->Data();
1680	int arg2 = (int) ((long)(h->next->Data()));
1681	int arg3 = (int) ((long)(h->next->next->Data()));
1682	intvec* arg4 = (intvec*) h->next->next->next->Data();
1683	intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1684
1685
1686	ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
1687
1688	res->rtyp = IDEAL_CMD;
1689	res->data = result;
1690
1691	return FALSE;
1692	}
1693	#ifdef MFWALK_ALT
1694	else
1695	if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
1696	{
1697	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1698	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1699	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD \|\|
1700	h->next->next->next == NULL \|\| h->next->next->next->Typ() !=INT_CMD)
1701	{
1702	Werror("system(\"Mfwalk\", ideal, intvec, intvec,int) expected");
1703	return TRUE;
1704	}
1705
1706	if (((intvec*) h->next->Data())->length() != currRing->N &&
1707	((intvec*) h->next->next->Data())->length() != currRing->N )
1708	{
1709	Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
1710	currRing->N);
1711	return TRUE;
1712	}
1713	ideal arg1 = (ideal) h->Data();
1714	intvec* arg2 = (intvec*) h->next->Data();
1715	intvec* arg3 = (intvec*) h->next->next->Data();
1716	int arg4 = (int) h->next->next->next->Data();
1717
1718	ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
1719
1720	res->rtyp = IDEAL_CMD;
1721	res->data = result;
1722
1723	return FALSE;
1724	}
1725	#endif
1726	else
1727	if (strcmp(sys_cmd, "Mfwalk") == 0)
1728	{
1729	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1730	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1731	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1732	{
1733	Werror("system(\"Mfwalk\", ideal, intvec, intvec) expected");
1734	return TRUE;
1735	}
1736
1737	if (((intvec*) h->next->Data())->length() != currRing->N &&
1738	((intvec*) h->next->next->Data())->length() != currRing->N )
1739	{
1740	Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
1741	currRing->N);
1742	return TRUE;
1743	}
1744	ideal arg1 = (ideal) h->Data();
1745	intvec* arg2 = (intvec*) h->next->Data();
1746	intvec* arg3 = (intvec*) h->next->next->Data();
1747
1748	ideal result = (ideal) Mfwalk(arg1, arg2, arg3);
1749
1750	res->rtyp = IDEAL_CMD;
1751	res->data = result;
1752
1753	return FALSE;
1754	}
1755	else
1756
1757	#ifdef TRAN_Orig
1758	if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
1759	{
1760	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1761	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1762	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1763	{
1764	Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec) expected");
1765	return TRUE;
1766	}
1767
1768	if (((intvec*) h->next->Data())->length() != currRing->N &&
1769	((intvec*) h->next->next->Data())->length() != currRing->N )
1770	{
1771	Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
1772	currRing->N);
1773	return TRUE;
1774	}
1775	ideal arg1 = (ideal) h->Data();
1776	intvec* arg2 = (intvec*) h->next->Data();
1777	intvec* arg3 = (intvec*) h->next->next->Data();
1778
1779
1780	ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
1781
1782	res->rtyp = IDEAL_CMD;
1783	res->data = result;
1784
1785	return FALSE;
1786	}
1787	else
1788	#endif
1789	if (strcmp(sys_cmd, "MAltwalk2") == 0)
1790	{
1791	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1792	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1793	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD)
1794	{
1795	Werror("system(\"MAltwalk2\", ideal, intvec, intvec) expected");
1796	return TRUE;
1797	}
1798
1799	if (((intvec*) h->next->Data())->length() != currRing->N &&
1800	((intvec*) h->next->next->Data())->length() != currRing->N )
1801	{
1802	Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
1803	currRing->N);
1804	return TRUE;
1805	}
1806	ideal arg1 = (ideal) h->Data();
1807	intvec* arg2 = (intvec*) h->next->Data();
1808	intvec* arg3 = (intvec*) h->next->next->Data();
1809
1810
1811	ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
1812
1813	res->rtyp = IDEAL_CMD;
1814	res->data = result;
1815
1816	return FALSE;
1817	}
1818	else
1819	if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
1820	{
1821	if (h == NULL \|\| h->Typ() != IDEAL_CMD \|\|
1822	h->next == NULL \|\| h->next->Typ() != INTVEC_CMD \|\|
1823	h->next->next == NULL \|\| h->next->next->Typ() != INTVEC_CMD\|\|
1824	h->next->next->next == NULL \|\| h->next->next->next->Typ() != INT_CMD)
1825	{
1826	Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec, int) expected");
1827	return TRUE;
1828	}
1829
1830	if (((intvec*) h->next->Data())->length() != currRing->N &&
1831	((intvec*) h->next->next->Data())->length() != currRing->N )
1832	{
1833	Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
1834	currRing->N);
1835	return TRUE;
1836	}
1837	ideal arg1 = (ideal) h->Data();
1838	intvec* arg2 = (intvec*) h->next->Data();
1839	intvec* arg3 = (intvec*) h->next->next->Data();
1840	int arg4 = (int) ((long)(h->next->next->next->Data()));
1841
1842	ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
1843
1844	res->rtyp = IDEAL_CMD;
1845	res->data = result;
1846
1847	return FALSE;
1848	}
1849	else
1850	#endif
1851	/================= Extended system call ========================/
1852	{
1853	#ifndef MAKE_DISTRIBUTION
1854	return(jjEXTENDED_SYSTEM(res, args));
1855	#else
1856	Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1857	#endif
1858	}
1859	} /* typ==string */
1860	return TRUE;
1861	}
1862
1863
1864	#ifdef HAVE_EXTENDED_SYSTEM
1865	// You can put your own system calls here
1866	#include "../kernel/fglmcomb.cc"
1867	#include "fglm.h"
1868	#ifdef HAVE_NEWTON
1869	#include <hc_newton.h>
1870	#endif
1871	#include "mpsr.h"
1872	#include "mod_raw.h"
1873	#include "ratgring.h"
1874	#include "shiftgb.h"
1875
1876	static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
1877	{
1878	if(h->Typ() == STRING_CMD)
1879	{
1880	char sys_cmd=(char )(h->Data());
1881	h=h->next;
1882	/==================== locNF ======================================/
1883	if(strcmp(sys_cmd,"locNF")==0)
1884	{
1885	if (h != NULL && h->Typ() == VECTOR_CMD)
1886	{
1887	poly f=(poly)h->Data();
1888	h=h->next;
1889	if (h != NULL && h->Typ() == MODUL_CMD)
1890	{
1891	ideal m=(ideal)h->Data();
1892	assumeStdFlag(h);
1893	h=h->next;
1894	if (h != NULL && h->Typ() == INT_CMD)
1895	{
1896	int n=(int)((long)h->Data());
1897	h=h->next;
1898	if (h != NULL && h->Typ() == INTVEC_CMD)
1899	{
1900	intvec v=(intvec )h->Data();
1901
1902	/* == now the work starts == */
1903
1904	short * iv=iv2array(v);
1905	poly r=0;
1906	poly hp=ppJetW(f,n,iv);
1907	int s=MATCOLS(m);
1908	int j=0;
1909	matrix T=mpInitI(s,1,0);
1910
1911	while (hp != NULL)
1912	{
1913	if (pDivisibleBy(m->m[j],hp))
1914	{
1915	if (MATELEM(T,j+1,1)==0)
1916	{
1917	MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
1918	}
1919	else
1920	{
1921	pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
1922	}
1923	hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
1924	j=0;
1925	}
1926	else
1927	{
1928	if (j==s-1)
1929	{
1930	r=pAdd(r,pHead(hp));
1931	hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
1932	j=0;
1933	}
1934	else
1935	{
1936	j++;
1937	}
1938	}
1939	}
1940
1941	matrix Temp=mpTransp((matrix) idVec2Ideal(r));
1942	matrix R=mpNew(MATCOLS((matrix) idVec2Ideal(f)),1);
1943	for (int k=1;k<=MATROWS(Temp);k++)
1944	{
1945	MATELEM(R,k,1)=MATELEM(Temp,k,1);
1946	}
1947
1948	lists L=(lists)omAllocBin(slists_bin);
1949	L->Init(2);
1950	L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
1951	L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
1952	res->data=L;
1953	res->rtyp=LIST_CMD;
1954	// iv aufraeumen
1955	omFree(iv);
1956	}
1957	else
1958	{
1959	Warn ("4th argument: must be an intvec!");
1960	}
1961	}
1962	else
1963	{
1964	Warn("3rd argument must be an int!!");
1965	}
1966	}
1967	else
1968	{
1969	Warn("2nd argument must be a module!");
1970	}
1971	}
1972	else
1973	{
1974	Warn("1st argument must be a vector!");
1975	}
1976	return FALSE;
1977	}
1978	else
1979	/==================== interred ==================================/
1980	#if 0
1981	if(strcmp(sys_cmd,"interred")==0)
1982	{
1983	res->data=(char *)kIR((ideal)h->Data(),currQuotient);
1984	res->rtyp=h->Typ();
1985	return ((h->Typ()!=IDEAL_CMD) && (h->Typ()!=MODUL_CMD));
1986	}
1987	else
1988	#endif
1989	#ifdef RDEBUG
1990	/==================== poly debug ==================================/
1991	if(strcmp(sys_cmd,"p")==0)
1992	{
1993	pDebugPrint((poly)h->Data());
1994	return FALSE;
1995	}
1996	else
1997	/==================== ring debug ==================================/
1998	if(strcmp(sys_cmd,"r")==0)
1999	{
2000	rDebugPrint((ring)h->Data());
2001	return FALSE;
2002	}
2003	else
2004	#endif
2005	/==================== mtrack ==================================/
2006	if(strcmp(sys_cmd,"mtrack")==0)
2007	{
2008	#ifdef OM_TRACK
2009	om_Opts.MarkAsStatic = 1;
2010	FILE *fd = NULL;
2011	int max = 5;
2012	while (h != NULL)
2013	{
2014	omMarkAsStaticAddr(h);
2015	if (fd == NULL && h->Typ()==STRING_CMD)
2016	{
2017	fd = fopen((char*) h->Data(), "w");
2018	if (fd == NULL)
2019	Warn("Can not open %s for writing og mtrack. Using stdout");
2020	}
2021	if (h->Typ() == INT_CMD)
2022	{
2023	max = (int)(long)h->Data();
2024	}
2025	h = h->Next();
2026	}
2027	omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2028	if (fd != NULL) fclose(fd);
2029	om_Opts.MarkAsStatic = 0;
2030	return FALSE;
2031	#else
2032	WerrorS("mtrack not supported without OM_TRACK");
2033	return TRUE;
2034	#endif
2035	}
2036	/==================== mtrack_all ==================================/
2037	if(strcmp(sys_cmd,"mtrack_all")==0)
2038	{
2039	#ifdef OM_TRACK
2040	om_Opts.MarkAsStatic = 1;
2041	FILE *fd = NULL;
2042	if ((h!=NULL) &&(h->Typ()==STRING_CMD))
2043	{
2044	fd = fopen((char*) h->Data(), "w");
2045	if (fd == NULL)
2046	Warn("Can not open %s for writing og mtrack. Using stdout");
2047	omMarkAsStaticAddr(h);
2048	}
2049	// OB: TBC print to fd
2050	omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
2051	if (fd != NULL) fclose(fd);
2052	om_Opts.MarkAsStatic = 0;
2053	return FALSE;
2054	#else
2055	WerrorS("mtrack not supported without OM_TRACK");
2056	return TRUE;
2057	#endif
2058	}
2059	else
2060	/==================== backtrace ==================================/
2061	if(strcmp(sys_cmd,"backtrace")==0)
2062	{
2063	#ifndef OM_NDEBUG
2064	omPrintCurrentBackTrace(stdout);
2065	return FALSE;
2066	#else
2067	WerrorS("btrack not supported without OM_TRACK");
2068	return TRUE;
2069	#endif
2070	}
2071	else
2072	/==================== naIdeal ==================================/
2073	if(strcmp(sys_cmd,"naIdeal")==0)
2074	{
2075	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2076	{
2077	naSetIdeal((ideal)h->Data());
2078	return FALSE;
2079	}
2080	else
2081	WerrorS("ideal expected");
2082	}
2083	else
2084	/==================== isSqrFree =============================/
2085	#ifdef HAVE_FACTORY
2086	if(strcmp(sys_cmd,"isSqrFree")==0)
2087	{
2088	if ((h!=NULL) &&(h->Typ()==POLY_CMD))
2089	{
2090	res->rtyp=INT_CMD;
2091	res->data=(void *)(long) singclap_isSqrFree((poly)h->Data());
2092	return FALSE;
2093	}
2094	else
2095	WerrorS("poly expected");
2096	}
2097	else
2098	#endif
2099	/==================== pDivStat =============================/
2100	#if defined(PDEBUG) \|\| defined(PDIV_DEBUG)
2101	if(strcmp(sys_cmd,"pDivStat")==0)
2102	{
2103	extern void pPrintDivisbleByStat();
2104	pPrintDivisbleByStat();
2105	return FALSE;
2106	}
2107	else
2108	#endif
2109	/==================== alarm ==================================/
2110	#ifdef unix
2111	if(strcmp(sys_cmd,"alarm")==0)
2112	{
2113	if ((h!=NULL) &&(h->Typ()==INT_CMD))
2114	{
2115	// standard variant -> SIGALARM (standard: abort)
2116	//alarm((unsigned)h->next->Data());
2117	// process time (user +system): SIGVTALARM
2118	struct itimerval t,o;
2119	memset(&t,0,sizeof(t));
2120	t.it_value.tv_sec =(unsigned)((unsigned long)h->Data());
2121	setitimer(ITIMER_VIRTUAL,&t,&o);
2122	return FALSE;
2123	}
2124	else
2125	WerrorS("int expected");
2126	}
2127	else
2128	#endif
2129	/==================== red =============================/
2130	#if 0
2131	if(strcmp(sys_cmd,"red")==0)
2132	{
2133	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2134	{
2135	res->rtyp=IDEAL_CMD;
2136	res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2137	setFlag(res,FLAG_STD);
2138	return FALSE;
2139	}
2140	else
2141	WerrorS("ideal expected");
2142	}
2143	else
2144	#endif
2145	#ifdef HAVE_FACTORY
2146	/==================== fastcomb =============================/
2147	if(strcmp(sys_cmd,"fastcomb")==0)
2148	{
2149	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2150	{
2151	int i=0;
2152	if (h->next!=NULL)
2153	{
2154	if (h->next->Typ()!=POLY_CMD)
2155	{
2156	Warn("Wrong types for poly= comb(ideal,poly)");
2157	}
2158	}
2159	res->rtyp=POLY_CMD;
2160	res->data=(void *) fglmLinearCombination(
2161	(ideal)h->Data(),(poly)h->next->Data());
2162	return FALSE;
2163	}
2164	else
2165	WerrorS("ideal expected");
2166	}
2167	else
2168	/==================== comb =============================/
2169	if(strcmp(sys_cmd,"comb")==0)
2170	{
2171	if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2172	{
2173	int i=0;
2174	if (h->next!=NULL)
2175	{
2176	if (h->next->Typ()!=POLY_CMD)
2177	{
2178	Warn("Wrong types for poly= comb(ideal,poly)");
2179	}
2180	}
2181	res->rtyp=POLY_CMD;
2182	res->data=(void *)fglmNewLinearCombination(
2183	(ideal)h->Data(),(poly)h->next->Data());
2184	return FALSE;
2185	}
2186	else
2187	WerrorS("ideal expected");
2188	}
2189	else
2190	#endif
2191	#ifdef FACTORY_GCD_TEST
2192	/=======================gcd Testerei ================================/
2193	if ( ! strcmp( sys_cmd, "setgcd" ) ) {
2194	if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
2195	CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
2196	return FALSE;
2197	} else
2198	WerrorS("int expected");
2199	}
2200	else
2201	#endif
2202
2203	#ifdef FACTORY_GCD_TIMING
2204	if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
2205	TIMING_PRINT( contentTimer, "time used for content: " );
2206	TIMING_PRINT( algContentTimer, "time used for algContent: " );
2207	TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
2208	TIMING_RESET( contentTimer );
2209	TIMING_RESET( algContentTimer );
2210	TIMING_RESET( algLcmTimer );
2211	return FALSE;
2212	}
2213	else
2214	#endif
2215
2216	#ifdef FACTORY_GCD_STAT
2217	if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
2218	printGcdTotal();
2219	printContTotal();
2220	resetGcdTotal();
2221	resetContTotal();
2222	return FALSE;
2223	}
2224	else
2225	#endif
2226	#if !defined(HAVE_NS)
2227	/==================== lib ==================================/
2228	if(strcmp(sys_cmd,"LIB")==0)
2229	{
2230	idhdl hh=idroot->get((char*)h->Data(),0);
2231	if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
2232	{
2233	res->rtyp=STRING_CMD;
2234	char *r=iiGetLibName(IDPROC(hh));
2235	if (r==NULL) r="";
2236	res->data=omStrDup(r);
2237	return FALSE;
2238	}
2239	else
2240	Warn("`%s` not found",(char*)h->Data());
2241	}
2242	else
2243	#endif
2244	/==================== listall ===================================/
2245	if(strcmp(sys_cmd,"listall")==0)
2246	{
2247	int showproc=0;
2248	if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2249	#ifdef HAVE_NS
2250	listall(showproc);
2251	#else
2252	idhdl hh=IDROOT;
2253	while (hh!=NULL)
2254	{
2255	if (IDDATA(hh)==(void *)currRing) PrintS("(R)");
2256	else PrintS(" ");
2257	Print("::%s, typ %s level %d\n",
2258	IDID(hh),Tok2Cmdname(IDTYP(hh)),IDLEV(hh));
2259	hh=IDNEXT(hh);
2260	}
2261	hh=IDROOT;
2262	while (hh!=NULL)
2263	{
2264	if ((IDTYP(hh)==RING_CMD)
2265	\|\| (IDTYP(hh)==QRING_CMD)
2266	\|\| (IDTYP(hh)==PACKAGE_CMD))
2267	{
2268	idhdl h2=IDRING(hh)->idroot;
2269	while (h2!=NULL)
2270	{
2271	if (IDDATA(h2)==(void *)currRing) PrintS("(R)");
2272	else PrintS(" ");
2273	Print("%s::%s, typ %s level %d\n",
2274	IDID(hh),IDID(h2),Tok2Cmdname(IDTYP(h2)),IDLEV(h2));
2275	h2=IDNEXT(h2);
2276	}
2277	}
2278	hh=IDNEXT(hh);
2279	}
2280	#endif /* HAVE_NS */
2281	return FALSE;
2282	}
2283	else
2284	/==================== proclist =================================/
2285	if(strcmp(sys_cmd,"proclist")==0)
2286	{
2287	piShowProcList();
2288	return FALSE;
2289	}
2290	else
2291	/* ==================== newton ================================*/
2292	#ifdef HAVE_NEWTON
2293	if(strcmp(sys_cmd,"newton")==0)
2294	{
2295	if ((h->Typ()!=POLY_CMD)
2296	\|\| (h->next->Typ()!=INT_CMD)
2297	\|\| (h->next->next->Typ()!=INT_CMD))
2298	{
2299	WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2300	return TRUE;
2301	}
2302	poly p=(poly)(h->Data());
2303	int l=pLength(p);
2304	short points=(short )omAlloc(currRing->Nlsizeof(short));
2305	int i,j,k;
2306	k=0;
2307	poly pp=p;
2308	for (i=0;pp!=NULL;i++)
2309	{
2310	for(j=1;j<=currRing->N;j++)
2311	{
2312	points[k]=pGetExp(pp,j);
2313	k++;
2314	}
2315	pIter(pp);
2316	}
2317	hc_ERG r=hc_KOENIG(currRing->N, // dimension
2318	l, // number of points
2319	(short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2320	currRing->OrdSgn==-1,
2321	(int) (h->next->Data()), // 1: Milnor, 0: Newton
2322	(int) (h->next->next->Data()) // debug
2323	);
2324	//----<>---Output-----------------------
2325
2326
2327	// PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2328
2329
2330	lists L=(lists)omAllocBin(slists_bin);
2331	L->Init(6);
2332	L->m[0].rtyp=STRING_CMD; // newtonnumber;
2333	L->m[0].data=(void *)omStrDup(r.nZahl);
2334	L->m[1].rtyp=INT_CMD;
2335	L->m[1].data=(void *)r.achse; // flag for unoccupied axes
2336	L->m[2].rtyp=INT_CMD;
2337	L->m[2].data=(void *)r.deg; // #degenerations
2338	if ( r.deg != 0) // only if degenerations exist
2339	{
2340	L->m[3].rtyp=INT_CMD;
2341	L->m[3].data=(void *)r.anz_punkte; // #points
2342	//---<>--number of points------
2343	int anz = r.anz_punkte; // number of points
2344	int dim = (currRing->N); // dimension
2345	intvec* v = new intvec( anz*dim );
2346	for (i=0; i<anz*dim; i++) // copy points
2347	(*v)[i] = r.pu[i];
2348	L->m[4].rtyp=INTVEC_CMD;
2349	L->m[4].data=(void *)v;
2350	//---<>--degenerations---------
2351	int deg = r.deg; // number of points
2352	intvec* w = new intvec( r.speicher ); // necessary memeory
2353	i=0; // start copying
2354	do
2355	{
2356	(*w)[i] = r.deg_tab[i];
2357	i++;
2358	}
2359	while (r.deg_tab[i-1] != -2); // mark for end of list
2360	L->m[5].rtyp=INTVEC_CMD;
2361	L->m[5].data=(void *)w;
2362	}
2363	else
2364	{
2365	L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2366	L->m[4].rtyp=DEF_CMD;
2367	L->m[5].rtyp=DEF_CMD;
2368	}
2369
2370	res->data=(void *)L;
2371	res->rtyp=LIST_CMD;
2372	// free all pointer in r:
2373	delete[] r.nZahl;
2374	delete[] r.pu;
2375	delete[] r.deg_tab; // Ist das ein Problem??
2376
2377	omFreeSize((ADDRESS)points,currRing->Nlsizeof(short));
2378	return FALSE;
2379	}
2380	else
2381	#endif
2382	/==================== sdb_flags =================/
2383	#ifdef HAVE_SDB
2384	if (strcmp(sys_cmd, "sdb_flags") == 0)
2385	{
2386	if ((h!=NULL) && (h->Typ()==INT_CMD))
2387	{
2388	sdb_flags=(int)((long)h->Data());
2389	}
2390	else
2391	{
2392	WerrorS("system(\"sdb_flags\",`int`) expected");
2393	return TRUE;
2394	}
2395	return FALSE;
2396	}
2397	else
2398	/==================== sdb_edit =================/
2399	if (strcmp(sys_cmd, "sdb_edit") == 0)
2400	{
2401	if ((h!=NULL) && (h->Typ()==PROC_CMD))
2402	{
2403	procinfov p=(procinfov)h->Data();
2404	sdb_edit(p);
2405	}
2406	else
2407	{
2408	WerrorS("system(\"sdb_edit\",`proc`) expected");
2409	return TRUE;
2410	}
2411	return FALSE;
2412	}
2413	else
2414	#endif
2415	/==================== GF =================/
2416	#if 0
2417	if (strcmp(sys_cmd, "GF") == 0)
2418	{
2419	int c=rChar(currRing);
2420	setCharacteristic( c, 2);
2421	CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
2422	res->rtyp=POLY_CMD;
2423	res->data=convClapGFSingGF( F );
2424	return FALSE;
2425	}
2426	else
2427	#endif
2428	/==================== stdX =================/
2429	if (strcmp(sys_cmd, "std") == 0)
2430	{
2431	ideal i1;
2432	int i2;
2433	if ((h!=NULL) && (h->Typ()==MODUL_CMD))
2434	{
2435	i1=(ideal)h->CopyD();
2436	h=h->next;
2437	}
2438	else return TRUE;
2439	if ((h!=NULL) && (h->Typ()==INT_CMD))
2440	{
2441	i2=(int)((long)h->Data());
2442	}
2443	else return TRUE;
2444	res->rtyp=MODUL_CMD;
2445	res->data=idXXX(i1,i2);
2446	return FALSE;
2447	}
2448	else
2449	#ifdef ix86_Win
2450	#ifdef HAVE_DL
2451	/==================== DLL =================/
2452	/* testing the DLL functionality under Win32 */
2453	if (strcmp(sys_cmd, "DLL") == 0)
2454	{
2455	typedef void (*Void_Func)();
2456	typedef int (*Int_Func)(int);
2457	void *hh=dynl_open("WinDllTest.dll");
2458	if ((h!=NULL) && (h->Typ()==INT_CMD))
2459	{
2460	int (*f)(int);
2461	if (hh!=NULL)
2462	{
2463	int (*f)(int);
2464	f=(Int_Func)dynl_sym(hh,"PlusDll");
2465	int i=10;
2466	if (f!=NULL) printf("%d\n",f(i));
2467	else PrintS("cannot find PlusDll\n");
2468	}
2469	}
2470	else
2471	{
2472	void (*f)();
2473	f= (Void_Func)dynl_sym(hh,"TestDll");
2474	if (f!=NULL) f();
2475	else PrintS("cannot find TestDll\n");
2476	}
2477	return FALSE;
2478	}
2479	else
2480	#endif
2481	#endif
2482	/==================== eigenvalues ==================================/
2483	#ifdef HAVE_EIGENVAL
2484	if(strcmp(sys_cmd,"eigenvals")==0)
2485	{
2486	return evEigenvals(res,h);
2487	}
2488	else
2489	#endif
2490	/==================== Gauss-Manin system ==================================/
2491	#ifdef HAVE_GMS
2492	if(strcmp(sys_cmd,"gmsnf")==0)
2493	{
2494	return gmsNF(res,h);
2495	}
2496	else
2497	#endif
2498	/==================== facstd_debug ==================================/
2499	#if !defined(NDEBUG)
2500	if(strcmp(sys_cmd,"facstd")==0)
2501	{
2502	extern int strat_nr;
2503	extern int strat_fac_debug;
2504	strat_fac_debug=(int)(long)h->Data();
2505	strat_nr=0;
2506	return FALSE;
2507	}
2508	else
2509	#endif
2510	#ifdef HAVE_RING2TOM
2511	/==================== ring-GB ==================================/
2512	if (strcmp(sys_cmd, "findZeroPoly")==0)
2513	{
2514	ring r = currRing;
2515	poly f = (poly) h->Data();
2516	res->rtyp=POLY_CMD;
2517	res->data=(poly) kFindZeroPoly(f, r, r);
2518	return(FALSE);
2519	}
2520	else
2521	/==================== Creating zero polynomials =================/
2522	if (strcmp(sys_cmd, "createG0")==0)
2523	{
2524	/* long exp[50];
2525	int N = 0;
2526	while (h != NULL)
2527	{
2528	N += 1;
2529	exp[N] = (long) h->Data();
2530	// if (exp[i] % 2 != 0) exp[i] -= 1;
2531	h = h->next;
2532	}
2533	for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
2534
2535	poly t_p;
2536	res->rtyp=POLY_CMD;
2537	res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
2538	return(FALSE); */
2539
2540	res->rtyp = IDEAL_CMD;
2541	res->data = (ideal) createG0();
2542	return(FALSE);
2543	}
2544	else
2545	if (strcmp(sys_cmd, "redNF_ring")==0)
2546	{
2547	ring r = currRing;
2548	poly f = (poly) h->Data();
2549	h = h->next;
2550	ideal G = (ideal) h->Data();
2551	res->rtyp=POLY_CMD;
2552	res->data=(poly) ringRedNF(f, G, r);
2553	return(FALSE);
2554	}
2555	else
2556	#endif
2557	#ifdef HAVE_RINGS
2558	/==================== Testing groebner basis =================/
2559	if (strcmp(sys_cmd, "NF_ring")==0)
2560	{
2561	ring r = currRing;
2562	poly f = (poly) h->Data();
2563	h = h->next;
2564	ideal G = (ideal) h->Data();
2565	res->rtyp=POLY_CMD;
2566	res->data=(poly) ringNF(f, G, r);
2567	return(FALSE);
2568	}
2569	else
2570	if (strcmp(sys_cmd, "spoly")==0)
2571	{
2572	poly f = pCopy((poly) h->Data());
2573	h = h->next;
2574	poly g = pCopy((poly) h->Data());
2575
2576	res->rtyp=POLY_CMD;
2577	res->data=(poly) plain_spoly(f,g);
2578	return(FALSE);
2579	}
2580	else
2581	if (strcmp(sys_cmd, "testGB")==0)
2582	{
2583	ideal I = (ideal) h->Data();
2584	h = h->next;
2585	ideal GI = (ideal) h->Data();
2586	res->rtyp = INT_CMD;
2587	res->data = (void *) testGB(I, GI);
2588	return(FALSE);
2589	}
2590	else
2591	#endif
2592	#ifdef HAVE_PLURAL
2593	/==================== sca?AltVar ==================================/
2594	if ( (strcmp(sys_cmd, "AltVarStart") == 0) \|\| (strcmp(sys_cmd, "AltVarEnd") == 0) )
2595	{
2596	ring r = currRing;
2597
2598	if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
2599	{
2600	WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
2601	return TRUE;
2602	}
2603
2604	res->rtyp=INT_CMD;
2605
2606	if (rIsSCA(r))
2607	{
2608	if(strcmp(sys_cmd, "AltVarStart") == 0)
2609	res->data = (void*)scaFirstAltVar(r);
2610	else
2611	res->data = (void*)scaLastAltVar(r);
2612	return FALSE;
2613	}
2614
2615	WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
2616	return TRUE;
2617	}
2618	else
2619	#endif
2620	#ifdef HAVE_PLURAL
2621	#ifdef HAVE_RATGRING
2622	/==================== RatNF, noncomm rational coeffs =================/
2623	if (strcmp(sys_cmd, "intratNF") == 0)
2624	{
2625	poly p;
2626	poly *q;
2627	ideal I;
2628	int is, k, id;
2629	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2630	{
2631	p=(poly)h->CopyD();
2632	h=h->next;
2633	// Print("poly is done\n");
2634	}
2635	else return TRUE;
2636	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2637	{
2638	I=(ideal)h->CopyD();
2639	q = I->m;
2640	h=h->next;
2641	// Print("ideal is done\n");
2642	}
2643	else return TRUE;
2644	if ((h!=NULL) && (h->Typ()==INT_CMD))
2645	{
2646	is=(int)((long)(h->Data()));
2647	// res->rtyp=INT_CMD;
2648	// Print("int is done\n");
2649	// res->rtyp=IDEAL_CMD;
2650	if (rIsPluralRing(currRing))
2651	{
2652	id = IDELEMS(I);
2653	int pl=(int)omAlloc0(IDELEMS(I)*sizeof(int));
2654	for(k=0; k < id; k++)
2655	{
2656	pl[k] = pLength(I->m[k]);
2657	}
2658	Print("starting redRat\n");
2659	//res->data = (char *)
2660	redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
2661	res->data=p;
2662	res->rtyp=POLY_CMD;
2663	// res->data = ncGCD(p,q,currRing);
2664	}
2665	else
2666	{
2667	res->rtyp=POLY_CMD;
2668	res->data=p;
2669	}
2670	}
2671	else return TRUE;
2672	return FALSE;
2673	}
2674	else
2675	/==================== RatNF, noncomm rational coeffs =================/
2676	if (strcmp(sys_cmd, "ratNF") == 0)
2677	{
2678	poly p,q;
2679	int is;
2680	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2681	{
2682	p=(poly)h->CopyD();
2683	h=h->next;
2684	}
2685	else return TRUE;
2686	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2687	{
2688	q=(poly)h->CopyD();
2689	h=h->next;
2690	}
2691	else return TRUE;
2692	if ((h!=NULL) && (h->Typ()==INT_CMD))
2693	{
2694	is=(int)((long)(h->Data()));
2695	res->rtyp=POLY_CMD;
2696	// res->rtyp=IDEAL_CMD;
2697	if (rIsPluralRing(currRing))
2698	{
2699	res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
2700	// res->data = ncGCD(p,q,currRing);
2701	}
2702	else res->data=p;
2703	}
2704	else return TRUE;
2705	return FALSE;
2706	}
2707	else
2708	#endif // HAVE_RATGRING
2709	/==================== freeGB, twosided GB in free algebra =================/
2710	if (strcmp(sys_cmd, "freegb") == 0)
2711	{
2712	ideal I;
2713	int uptodeg, lVblock;
2714	if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2715	{
2716	I=(ideal)h->CopyD();
2717	h=h->next;
2718	}
2719	else return TRUE;
2720	if ((h!=NULL) && (h->Typ()==INT_CMD))
2721	{
2722	uptodeg=(int)((long)(h->Data()));
2723	h=h->next;
2724	}
2725	else return TRUE;
2726	if ((h!=NULL) && (h->Typ()==INT_CMD))
2727	{
2728	lVblock=(int)((long)(h->Data()));
2729	res->data = freegb(I,uptodeg,lVblock);
2730	res->rtyp = IDEAL_CMD;
2731	}
2732	else return TRUE;
2733	return FALSE;
2734	}
2735	else
2736	/==================== shift-test for freeGB =================/
2737	if (strcmp(sys_cmd, "stest") == 0)
2738	{
2739	poly p;
2740	int sh,uptodeg, lVblock;
2741	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2742	{
2743	p=(poly)h->CopyD();
2744	h=h->next;
2745	}
2746	else return TRUE;
2747	if ((h!=NULL) && (h->Typ()==INT_CMD))
2748	{
2749	sh=(int)((long)(h->Data()));
2750	h=h->next;
2751	}
2752	else return TRUE;
2753
2754	if ((h!=NULL) && (h->Typ()==INT_CMD))
2755	{
2756	uptodeg=(int)((long)(h->Data()));
2757	h=h->next;
2758	}
2759	else return TRUE;
2760	if ((h!=NULL) && (h->Typ()==INT_CMD))
2761	{
2762	lVblock=(int)((long)(h->Data()));
2763	res->data = pLPshift(p,sh,uptodeg,lVblock);
2764	res->rtyp = POLY_CMD;
2765	}
2766	else return TRUE;
2767	return FALSE;
2768	}
2769	else
2770	/==================== block-test for freeGB =================/
2771	if (strcmp(sys_cmd, "btest") == 0)
2772	{
2773	poly p;
2774	int lV;
2775	if ((h!=NULL) && (h->Typ()==POLY_CMD))
2776	{
2777	p=(poly)h->CopyD();
2778	h=h->next;
2779	}
2780	else return TRUE;
2781	if ((h!=NULL) && (h->Typ()==INT_CMD))
2782	{
2783	lV=(int)((long)(h->Data()));
2784	res->rtyp = INT_CMD;
2785	res->data = (void*)pLastVblock(p, lV);
2786	}
2787	else return TRUE;
2788	return FALSE;
2789	}
2790	else
2791	#endif
2792	/==================== t-rep-GB ==================================/
2793	if (strcmp(sys_cmd, "unifastmult")==0)
2794	{
2795	ring r = currRing;
2796	poly f = (poly)h->Data();
2797	h=h->next;
2798	poly g=(poly)h->Data();
2799	res->rtyp=POLY_CMD;
2800	res->data=unifastmult(f,g,currRing);
2801	return(FALSE);
2802	}
2803	else
2804	if (strcmp(sys_cmd, "multifastmult")==0)
2805	{
2806	ring r = currRing;
2807	poly f = (poly)h->Data();
2808	h=h->next;
2809	poly g=(poly)h->Data();
2810	res->rtyp=POLY_CMD;
2811	res->data=multifastmult(f,g,currRing);
2812	return(FALSE);
2813	}
2814	else
2815	if (strcmp(sys_cmd, "mults")==0)
2816	{
2817	res->rtyp=INT_CMD ;
2818	res->data=(void*)(long) Mults();
2819	return(FALSE);
2820	}
2821	else
2822	if (strcmp(sys_cmd, "fastpower")==0)
2823	{
2824	ring r = currRing;
2825	poly f = (poly)h->Data();
2826	h=h->next;
2827	int n=(int)((long)h->Data());
2828	res->rtyp=POLY_CMD ;
2829	res->data=(void*) pFastPower(f,n,r);
2830	return(FALSE);
2831	}
2832	else
2833	if (strcmp(sys_cmd, "normalpower")==0)
2834	{
2835	ring r = currRing;
2836	poly f = (poly)h->Data();
2837	h=h->next;
2838	int n=(int)((long)h->Data());
2839	res->rtyp=POLY_CMD ;
2840	res->data=(void*) pPower(pCopy(f),n);
2841	return(FALSE);
2842	}
2843	else
2844	if (strcmp(sys_cmd, "MCpower")==0)
2845	{
2846	ring r = currRing;
2847	poly f = (poly)h->Data();
2848	h=h->next;
2849	int n=(int)((long)h->Data());
2850	res->rtyp=POLY_CMD ;
2851	res->data=(void*) pFastPowerMC(f,n,r);
2852	return(FALSE);
2853	}
2854	else
2855	if (strcmp(sys_cmd, "bit_subst")==0)
2856	{
2857	ring r = currRing;
2858	poly outer = (poly)h->Data();
2859	h=h->next;
2860	poly inner=(poly)h->Data();
2861	res->rtyp=POLY_CMD ;
2862	res->data=(void*) uni_subst_bits(outer, inner,r);
2863	return(FALSE);
2864	}
2865	else
2866	/==================== bifac =================/
2867	#ifdef HAVE_BIFAC
2868	if (strcmp(sys_cmd, "bifac")==0)
2869	{
2870	if (h->Typ()!=POLY_CMD)
2871	{
2872	WerrorS("`system(\"bifac\",<poly>) expected");
2873	return TRUE;
2874	}
2875	if (!rField_is_Q())
2876	{
2877	WerrorS("coeff field must be Q");
2878	return TRUE;
2879	}
2880	BIFAC B;
2881	CFFList C;
2882	int sw_rat=isOn(SW_RATIONAL);
2883	On(SW_RATIONAL);
2884	CanonicalForm F( convSingPClapP((poly)(h->Data())));
2885	B.bifac(F, 1);
2886	CFFList L=B.getFactors();
2887	// construct the ring ==============================================
2888	int i;
2889	int lev=ExtensionLevel();
2890	char names=(char)omAlloc0(lev*sizeof(char_ptr));
2891	for(i=1;i<=lev; i++)
2892	{
2893	StringSetS("");
2894	names[i-1]=omStrDup(StringAppend("a(%d)",i));
2895	}
2896	ring alg_ring=rDefault(0,lev,names);
2897	ring new_ring=rCopy0(currRing); // all variable names, ordering etc.
2898	new_ring->P=lev;
2899	new_ring->parameter=names;
2900	new_ring->algring=alg_ring;
2901	new_ring->ch=1;
2902	rComplete(new_ring,TRUE);
2903	// set the mipo ===============================================
2904	ring save_currRing=currRing; idhdl save_currRingHdl=currRingHdl;
2905	rChangeCurrRing(alg_ring);
2906	ideal mipo_id=idInit(lev,1);
2907	for (i=lev; i>0;i--)
2908	{
2909	CanonicalForm Mipo=getMipo(Variable(-i),Variable(i));
2910	mipo_id->m[i-1]=convClapPSingP(Mipo);
2911	}
2912	idShow(mipo_id);
2913	alg_ring->qideal=mipo_id;
2914	rChangeCurrRing(new_ring);
2915	for (i=lev-1; i>=0;i--)
2916	{
2917	poly p=pOne();
2918	lnumber n=(lnumber)pGetCoeff(p);
2919	// no need to delete nac 1
2920	n->z=(napoly)mipo_id->m[i];
2921	mipo_id->m[i]=p;
2922	}
2923	new_ring->minideal=id_Copy(alg_ring->qideal,new_ring);
2924	// convert factors =============================================
2925	ideal fac_id=idInit(L.length(),1);
2926	CFFListIterator J=L;
2927	i=0;
2928	intvec *v = new intvec( L.length() );
2929	for ( ; J.hasItem(); J++,i++ )
2930	{
2931	fac_id->m[i]=convClapAPSingAP( J.getItem().factor() );
2932	(*v)[i]=J.getItem().exp();
2933	}
2934	idhdl hh=enterid("factors",0,LIST_CMD,&(currRing->idroot),FALSE);
2935	lists LL=(lists)omAllocBin( slists_bin);
2936	LL->Init(2);
2937	LL->m[0].rtyp=IDEAL_CMD;
2938	LL->m[0].data=(char *)fac_id;
2939	LL->m[1].rtyp=INTVEC_CMD;
2940	LL->m[1].data=(char *)v;
2941	IDDATA(hh)=(char *)LL;
2942
2943	rChangeCurrRing(save_currRing);
2944	currRingHdl=save_currRingHdl;
2945	if (!sw_rat) Off(SW_RATIONAL);
2946
2947	res->data=new_ring;
2948	res->rtyp=RING_CMD;
2949	return FALSE;
2950	}
2951	else
2952	#endif
2953	/==================== gcd-varianten =================/
2954	if (strcmp(sys_cmd, "gcd") == 0)
2955	{
2956	if (h==NULL)
2957	{
2958	Print("NTL_0:%d (use NTL for gcd of polynomials in char 0)\n",isOn(SW_USE_NTL_GCD_0));
2959	Print("NTL_p:%d (use NTL for gcd of polynomials in char p)\n",isOn(SW_USE_NTL_GCD_P));
2960	Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
2961	Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
2962	Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
2963	Print("SPARSEMOD:%d (use SPARSEMOD for gcd of polynomials in char 0)\n",isOn(SW_USE_SPARSEMOD));
2964	Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
2965	return FALSE;
2966	}
2967	else
2968	if ((h!=NULL) && (h->Typ()==STRING_CMD)
2969	&& (h->next!=NULL) && (h->next->Typ()==INT_CMD))
2970	{
2971	int d=(int)(long)h->next->Data();
2972	char s=(char )h->Data();
2973	if (strcmp(s,"NTL_0")==0) { if (d) On(SW_USE_NTL_GCD_0); else Off(SW_USE_NTL_GCD_0); } else
2974	if (strcmp(s,"NTL_p")==0) { if (d) On(SW_USE_NTL_GCD_P); else Off(SW_USE_NTL_GCD_P); } else
2975	if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
2976	if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
2977	if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
2978	if (strcmp(s,"SPARSEMOD")==0) { if (d) On(SW_USE_SPARSEMOD); else Off(SW_USE_SPARSEMOD); } else
2979	if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
2980	return TRUE;
2981	return FALSE;
2982	}
2983	else return TRUE;
2984	}
2985	else
2986	#if 0
2987	/==================== gcd-test =================/
2988	if (strcmp(sys_cmd, "GCD") == 0)
2989	{
2990	if ((h!=NULL) && (h->Typ()==POLY_CMD)
2991	&& (h->next!=NULL) && (h->next->Typ()==POLY_CMD))
2992	{
2993	poly f=(poly)h->Data();
2994	poly g=(poly)h->next->Data();
2995	res->rtyp=POLY_CMD;
2996	res->data=(char*)id_GCD(f,g,currRing);
2997	return FALSE;
2998	}
2999	else return TRUE;
3000	}
3001	else
3002	#endif
3003	#ifdef ix86_Win
3004	/==================== Python Singular =================/
3005	if (strcmp(sys_cmd, "python") == 0)
3006	{
3007	const char* c;
3008	if ((h!=NULL) && (h->Typ()==STRING_CMD))
3009	{
3010	c=(const char*)h->Data();
3011	if (!PyInitialized) {
3012	PyInitialized = 1;
3013	// Py_Initialize();
3014	// initPySingular();
3015	}
3016	// PyRun_SimpleString(c);
3017	return FALSE;
3018	}
3019	else return TRUE;
3020	}
3021	else
3022	/*==================== Python Singular =================
3023	if (strcmp(sys_cmd, "ipython") == 0)
3024	{
3025	const char* c;
3026	{
3027	if (!PyInitialized) {
3028	PyInitialized = 1;
3029	Py_Initialize();
3030	initPySingular();
3031	}
3032	PyRun_SimpleString(
3033	"try: \n\
3034	__IPYTHON__ \n\
3035	except NameError: \n\
3036	argv = [''] \n\
3037	banner = exit_msg = '' \n\
3038	else: \n\
3039	# Command-line options for IPython (a list like sys.argv) \n\
3040	argv = ['-pi1','In <\\#>:','-pi2',' .\\D.:','-po','Out<\\#>:'] \n\
3041	banner = '* Nested interpreter *' \n\
3042	exit_msg = '* Back in main IPython *' \n\
3043	\n\
3044	# First import the embeddable shell class \n\
3045	from IPython.Shell import IPShellEmbed \n\
3046	# Now create the IPython shell instance. Put ipshell() anywhere in your code \n\
3047	# where you want it to open. \n\
3048	ipshell = IPShellEmbed(argv,banner=banner,exit_msg=exit_msg) \n\
3049	ipshell()");
3050	return FALSE;
3051	}
3052	}
3053	else
3054	*/
3055
3056
3057	#endif
3058	/==================== Error =================/
3059	Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3060	}
3061	return TRUE;
3062	}
3063	#endif // HAVE_EXTENDED_SYSTEM
3064

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

Download in other formats: