Context Navigation

source: git/Singular/extra.cc @ 4e8195

spielwiese

Last change on this file since 4e8195 was fea915, checked in by Hans Schönemann <hannes@…>, 19 years ago
*hannes: bifac stuff git-svn-id: file:///usr/local/Singular/svn/trunk@8406 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 70.5 KB

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

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

Download in other formats: