Context Navigation

source: git/Singular/extra.cc @ 502966

spielwiese

Last change on this file since 502966 was 502966, checked in by Viktor Levandovskyy <levandov@…>, 16 years ago
*levandov: shiftgb related changes git-svn-id: file:///usr/local/Singular/svn/trunk@10147 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 81.7 KB

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

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

Download in other formats: