Context Navigation

source: git/Singular/extra.cc @ fc5095

spielwiese

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

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

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

Download in other formats: