Context Navigation

source: git/Singular/extra.cc @ 7447d8

spielwiese

Last change on this file since 7447d8 was 7447d8, checked in by Hans Schönemann <hannes@…>, 19 years ago
*hannes: gcc 4 and 64bit git-svn-id: file:///usr/local/Singular/svn/trunk@8463 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 70.6 KB

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

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

Download in other formats: