Context Navigation

source: git/Singular/extra.cc @ d15996

spielwiese

Last change on this file since d15996 was d15996, checked in by Oliver Wienand <wienand@…>, 17 years ago
mind your own buisness g git-svn-id: file:///usr/local/Singular/svn/trunk@10035 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 79.9 KB

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

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

Download in other formats: