1 /*****************************************
2 * Computer Algebra System SINGULAR *
3 *****************************************/
4 /*
5 * ABSTRACT: general interface to internals of Singular ("system" command)
6 * jjSYSTEM: official commands, must be documented in the manual,
7 * #defines must be local to each command
8 * jjEXTENDED_SYSTEM: tests, temporary comands etc.
9 */
10
11 #define HAVE_WALK 1
12
13 #include "kernel/mod2.h"
14 #include "misc/sirandom.h"
15 #include "resources/omFindExec.h"
16
17 #ifdef HAVE_CCLUSTER
18 #include "ccluster/ccluster.h"
19 #endif
20
21 #include "factory/factory.h"
22
23 #ifdef TIME_WITH_SYS_TIME
24 # include <time.h>
25 # ifdef HAVE_SYS_TIME_H
26 # include <sys/time.h>
27 # endif
28 #else
29 # ifdef HAVE_SYS_TIME_H
30 # include <sys/time.h>
31 # else
32 # include <time.h>
33 # endif
34 #endif
35 #ifdef HAVE_SYS_TIMES_H
36 #include <sys/times.h>
37 #endif
38
39 #include <unistd.h>
40
41 #include "misc/options.h"
42
43 // #include "coeffs/ffields.h"
44 #include "coeffs/coeffs.h"
45 #include "coeffs/mpr_complex.h"
46
47
48 #include "resources/feResource.h"
49 #include "polys/monomials/ring.h"
50 #include "kernel/polys.h"
51
52 #include "polys/monomials/maps.h"
53 #include "polys/matpol.h"
54
55 #include "polys/weight.h"
56
57 #ifdef HAVE_SHIFTBBA
58 #include "polys/shiftop.h"
59 #endif
60
61 #include "coeffs/bigintmat.h"
62 #include "kernel/fast_mult.h"
63 #include "kernel/digitech.h"
64 #include "kernel/combinatorics/stairc.h"
65 #include "kernel/ideals.h"
66 #include "kernel/GBEngine/kstd1.h"
67 #include "kernel/GBEngine/syz.h"
68 #include "kernel/GBEngine/kutil.h"
69 #include "kernel/GBEngine/kverify.h"
70
71 #include "kernel/linear_algebra/linearAlgebra.h"
72
73 #include "kernel/combinatorics/hutil.h"
74
75 // for tests of t-rep-GB
76 #include "kernel/GBEngine/tgb.h"
77
78 #include "kernel/linear_algebra/minpoly.h"
79
80 #include "numeric/mpr_base.h"
81
82 #include "tok.h"
83 #include "ipid.h"
84 #include "lists.h"
85 #include "cntrlc.h"
86 #include "ipshell.h"
87 #include "sdb.h"
88 #include "feOpt.h"
89 #include "fehelp.h"
90 #include "distrib.h"
91
92 #include "misc_ip.h"
93
94 #include "attrib.h"
95
96 #include "links/silink.h"
97 #include "links/ssiLink.h"
98 #include "walk.h"
99 #include "Singular/newstruct.h"
100 #include "Singular/blackbox.h"
101 #include "Singular/pyobject_setup.h"
102
103
104 #ifdef HAVE_RINGS
105 #include "kernel/GBEngine/ringgb.h"
106 #endif
107
108 #ifdef HAVE_F5
109 #include "kernel/GBEngine/f5gb.h"
110 #endif
111
112 #ifdef HAVE_WALK
113 #include "walk.h"
114 #endif
115
116 #ifdef HAVE_SPECTRUM
117 #include "kernel/spectrum/spectrum.h"
118 #endif
119
120 #ifdef HAVE_PLURAL
121 #include "polys/nc/nc.h"
122 #include "polys/nc/ncSAMult.h" // for CMultiplier etc classes
123 #include "polys/nc/sca.h"
124 #include "kernel/GBEngine/nc.h"
125 #include "ipconv.h"
126 #ifdef HAVE_RATGRING
127 #include "kernel/GBEngine/ratgring.h"
128 #endif
129 #endif
130
131 #ifdef __CYGWIN__ /* only for the DLLTest */
132 /* #include "WinDllTest.h" */
133 #ifdef HAVE_DL
134 #include "polys/mod_raw.h"
135 #endif
136 #endif
137
138 // Define to enable many more system commands
139 //#undef MAKE_DISTRIBUTION
140 #ifndef MAKE_DISTRIBUTION
141 #define HAVE_EXTENDED_SYSTEM 1
142 #endif
143
144 #include "polys/flintconv.h"
145 #include "polys/clapconv.h"
146 #include "kernel/GBEngine/kstdfac.h"
147
148 #include "polys/clapsing.h"
149
150 #ifdef HAVE_EIGENVAL
151 #include "eigenval_ip.h"
152 #endif
153
154 #ifdef HAVE_GMS
155 #include "gms.h"
156 #endif
157
158 #ifdef HAVE_SIMPLEIPC
159 #include "Singular/links/simpleipc.h"
160 #endif
161
162 #ifdef HAVE_PCV
163 #include "pcv.h"
164 #endif
165
166 #ifndef MAKE_DISTRIBUTION
167 static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
168 #endif
169
170 /* expects a SINGULAR square matrix with number entries
171 where currRing is expected to be over some field F_p;
172 returns a long** matrix with the "same", i.e.,
173 appropriately mapped entries;
174 leaves singularMatrix unmodified */
singularMatrixToLongMatrix(matrix singularMatrix)175 unsigned long** singularMatrixToLongMatrix(matrix singularMatrix)
176 {
177 int n = singularMatrix->rows();
178 assume(n == singularMatrix->cols());
179 unsigned long **longMatrix = 0;
180 longMatrix = new unsigned long *[n] ;
181 for (int i = 0 ; i < n; i++)
182 longMatrix[i] = new unsigned long [n];
183 number entry;
184 for (int r = 0; r < n; r++)
185 for (int c = 0; c < n; c++)
186 {
187 poly p=MATELEM(singularMatrix, r + 1, c + 1);
188 int entryAsInt;
189 if (p!=NULL)
190 {
191 entry = p_GetCoeff(p, currRing);
192 entryAsInt = n_Int(entry, currRing->cf);
193 if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
194 }
195 else
196 entryAsInt=0;
197 longMatrix[r][c] = (unsigned long)entryAsInt;
198 }
199 return longMatrix;
200 }
201
202 /* expects an array of unsigned longs with valid indices 0..degree;
203 returns the following poly, where x denotes the first ring variable
204 of currRing, and d = degree:
205 polyCoeffs[d] * x^d + polyCoeffs[d-1] * x^(d-1) + ... + polyCoeffs[0]
206 leaves polyCoeffs unmodified */
longCoeffsToSingularPoly(unsigned long * polyCoeffs,const int degree)207 poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
208 {
209 poly result = NULL;
210 for (int i = 0; i <= degree; i++)
211 {
212 if ((int)polyCoeffs[i] != 0)
213 {
214 poly term = p_ISet((int)polyCoeffs[i], currRing);
215 if (i > 0)
216 {
217 p_SetExp(term, 1, i, currRing);
218 p_Setm(term, currRing);
219 }
220 result = p_Add_q(result, term, currRing);
221 }
222 }
223 return result;
224 }
225
226 //void emStart();
227 /*2
228 * the "system" command
229 */
jjSYSTEM(leftv res,leftv args)230 BOOLEAN jjSYSTEM(leftv res, leftv args)
231 {
232 if(args->Typ() == STRING_CMD)
233 {
234 const char *sys_cmd=(char *)(args->Data());
235 leftv h=args->next;
236 // ONLY documented system calls go here
237 // Undocumented system calls go down into jjEXTENDED_SYSTEM (#ifdef HAVE_EXTENDED_SYSTEM)
238 /*==================== nblocks ==================================*/
239 if (strcmp(sys_cmd, "nblocks") == 0)
240 {
241 ring r;
242 if (h == NULL)
243 {
244 if (currRingHdl != NULL)
245 {
246 r = IDRING(currRingHdl);
247 }
248 else
249 {
250 WerrorS("no ring active");
251 return TRUE;
252 }
253 }
254 else
255 {
256 if (h->Typ() != RING_CMD)
257 {
258 WerrorS("ring expected");
259 return TRUE;
260 }
261 r = (ring) h->Data();
262 }
263 res->rtyp = INT_CMD;
264 res->data = (void*) (long)(rBlocks(r) - 1);
265 return FALSE;
266 }
267 /*==================== version ==================================*/
268 if(strcmp(sys_cmd,"version")==0)
269 {
270 res->rtyp=INT_CMD;
271 res->data=(void *)SINGULAR_VERSION;
272 return FALSE;
273 }
274 else
275 /*==================== alarm ==================================*/
276 if(strcmp(sys_cmd,"alarm")==0)
277 {
278 if ((h!=NULL) &&(h->Typ()==INT_CMD))
279 {
280 // standard variant -> SIGALARM (standard: abort)
281 //alarm((unsigned)h->next->Data());
282 // process time (user +system): SIGVTALARM
283 struct itimerval t,o;
284 memset(&t,0,sizeof(t));
285 t.it_value.tv_sec =(unsigned)((unsigned long)h->Data());
286 setitimer(ITIMER_VIRTUAL,&t,&o);
287 return FALSE;
288 }
289 else
290 WerrorS("int expected");
291 }
292 else
293 /*==================== cpu ==================================*/
294 if(strcmp(sys_cmd,"cpu")==0)
295 {
296 long cpu=1; //feOptValue(FE_OPT_CPUS);
297 #ifdef _SC_NPROCESSORS_ONLN
298 cpu=sysconf(_SC_NPROCESSORS_ONLN);
299 #elif defined(_SC_NPROCESSORS_CONF)
300 cpu=sysconf(_SC_NPROCESSORS_CONF);
301 #endif
302 res->data=(void *)cpu;
303 res->rtyp=INT_CMD;
304 return FALSE;
305 }
306 else
307 /*==================== executable ==================================*/
308 if(strcmp(sys_cmd,"executable")==0)
309 {
310 if ((h!=NULL) && (h->Typ()==STRING_CMD))
311 {
312 char tbuf[MAXPATHLEN];
313 char *s=omFindExec((char*)h->Data(),tbuf);
314 if(s==NULL) s=(char*)"";
315 res->data=(void *)omStrDup(s);
316 res->rtyp=STRING_CMD;
317 return FALSE;
318 }
319 return TRUE;
320 }
321 else
322 /*==================== flatten =============================*/
323 if(strcmp(sys_cmd,"flatten")==0)
324 {
325 if ((h!=NULL) &&(h->Typ()==SMATRIX_CMD))
326 {
327 res->data=(char*)sm_Flatten((ideal)h->Data(),currRing);
328 res->rtyp=SMATRIX_CMD;
329 return FALSE;
330 }
331 else
332 WerrorS("smatrix expected");
333 }
334 else
335 /*==================== unflatten =============================*/
336 if(strcmp(sys_cmd,"unflatten")==0)
337 {
338 const short t1[]={2,SMATRIX_CMD,INT_CMD};
339 if (iiCheckTypes(h,t1,1))
340 {
341 res->data=(char*)sm_UnFlatten((ideal)h->Data(),(int)(long)h->next->Data(),currRing);
342 res->rtyp=SMATRIX_CMD;
343 return res->data==NULL;
344 }
345 else return TRUE;
346 }
347 else
348 /*==================== neworder =============================*/
349 if(strcmp(sys_cmd,"neworder")==0)
350 {
351 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
352 {
353 res->rtyp=STRING_CMD;
354 res->data=(void *)singclap_neworder((ideal)h->Data(), currRing);
355 return FALSE;
356 }
357 else
358 WerrorS("ideal expected");
359 }
360 else
361 /*===== nc_hilb ===============================================*/
362 // Hilbert series of non-commutative monomial algebras
363 if(strcmp(sys_cmd,"nc_hilb") == 0)
364 {
365 ideal i; int lV;
366 bool ig = FALSE;
367 bool mgrad = FALSE;
368 bool autop = FALSE;
369 int trunDegHs=0;
370 if((h != NULL)&&(h->Typ() == IDEAL_CMD))
371 i = (ideal)h->Data();
372 else
373 {
374 WerrorS("nc_Hilb:ideal expected");
375 return TRUE;
376 }
377 h = h->next;
378 if((h != NULL)&&(h->Typ() == INT_CMD))
379 lV = (int)(long)h->Data();
380 else
381 {
382 WerrorS("nc_Hilb:int expected");
383 return TRUE;
384 }
385 h = h->next;
386 while(h != NULL)
387 {
388 if((int)(long)h->Data() == 1)
389 ig = TRUE;
390 else if((int)(long)h->Data() == 2)
391 mgrad = TRUE;
392 else if(h->Typ()==STRING_CMD)
393 autop = TRUE;
394 else if(h->Typ() == INT_CMD)
395 trunDegHs = (int)(long)h->Data();
396 h = h->next;
397 }
398 if(h != NULL)
399 {
400 WerrorS("nc_Hilb:int 1,2, total degree for the truncation, and a string for printing the details are expected");
401 return TRUE;
402 }
403
404 HilbertSeries_OrbitData(i, lV, ig, mgrad, autop, trunDegHs);
405 return(FALSE);
406 }
407 else
408 /* ====== verify ============================*/
409 if(strcmp(sys_cmd,"verifyGB")==0)
410 {
411 if (rIsNCRing(currRing))
412 {
413 WerrorS("system(\"verifyGB\",<ideal>,..) expects a commutative ring");
414 return TRUE;
415 }
416 if (h->Typ()!=IDEAL_CMD)
417 {
418 WerrorS("expected system(\"verifyGB\",<ideal>,..)");
419 return TRUE;
420 }
421 ideal F=(ideal)h->Data();
422 #ifdef HAVE_VSPACE
423 int cpus = (long) feOptValue(FE_OPT_CPUS);
424 if (cpus>1)
425 res->data=(char*)(long) kVerify2(F,currRing->qideal);
426 else
427 #endif
428 res->data=(char*)(long) kVerify1(F,currRing->qideal);
429 res->rtyp=INT_CMD;
430 return FALSE;
431 }
432 else
433 /*===== rcolon ===============================================*/
434 if(strcmp(sys_cmd,"rcolon") == 0)
435 {
436 const short t1[]={3,IDEAL_CMD,POLY_CMD,INT_CMD};
437 if (iiCheckTypes(h,t1,1))
438 {
439 ideal i = (ideal)h->Data();
440 h = h->next;
441 poly w=(poly)h->Data();
442 h = h->next;
443 int lV = (int)(long)h->Data();
444 res->rtyp = IDEAL_CMD;
445 res->data = RightColonOperation(i, w, lV);
446 return(FALSE);
447 }
448 else
449 return TRUE;
450 }
451 else
452
453 /*==================== sh ==================================*/
454 if(strcmp(sys_cmd,"sh")==0)
455 {
456 if (feOptValue(FE_OPT_NO_SHELL))
457 {
458 WerrorS("shell execution is disallowed in restricted mode");
459 return TRUE;
460 }
461 res->rtyp=INT_CMD;
462 if (h==NULL) res->data = (void *)(long) system("sh");
463 else if (h->Typ()==STRING_CMD)
464 res->data = (void*)(long) system((char*)(h->Data()));
465 else
466 WerrorS("string expected");
467 return FALSE;
468 }
469 else
470 /*========reduce procedure like the global one but with jet bounds=======*/
471 if(strcmp(sys_cmd,"reduce_bound")==0)
472 {
473 poly p;
474 ideal pid=NULL;
475 const short t1[]={3,POLY_CMD,IDEAL_CMD,INT_CMD};
476 const short t2[]={3,IDEAL_CMD,IDEAL_CMD,INT_CMD};
477 const short t3[]={3,VECTOR_CMD,MODUL_CMD,INT_CMD};
478 const short t4[]={3,MODUL_CMD,MODUL_CMD,INT_CMD};
479 if ((iiCheckTypes(h,t1,0))||((iiCheckTypes(h,t3,0))))
480 {
481 p = (poly)h->CopyD();
482 }
483 else if ((iiCheckTypes(h,t2,0))||(iiCheckTypes(h,t4,1)))
484 {
485 pid = (ideal)h->CopyD();
486 }
487 else return TRUE;
488 //int htype;
489 res->rtyp= h->Typ(); /*htype*/
490 ideal q = (ideal)h->next->CopyD();
491 int bound = (int)(long)h->next->next->Data();
492 if (pid==NULL) /*(htype == POLY_CMD || htype == VECTOR_CMD)*/
493 res->data = (char *)kNFBound(q,currRing->qideal,p,bound);
494 else /*(htype == IDEAL_CMD || htype == MODUL_CMD)*/
495 res->data = (char *)kNFBound(q,currRing->qideal,pid,bound);
496 return FALSE;
497 }
498 else
499 /*==================== uname ==================================*/
500 if(strcmp(sys_cmd,"uname")==0)
501 {
502 res->rtyp=STRING_CMD;
503 res->data = omStrDup(S_UNAME);
504 return FALSE;
505 }
506 else
507 /*==================== with ==================================*/
508 if(strcmp(sys_cmd,"with")==0)
509 {
510 if (h==NULL)
511 {
512 res->rtyp=STRING_CMD;
513 res->data=(void *)versionString();
514 return FALSE;
515 }
516 else if (h->Typ()==STRING_CMD)
517 {
518 #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
519 char *s=(char *)h->Data();
520 res->rtyp=INT_CMD;
521 #ifdef HAVE_DBM
522 TEST_FOR("DBM")
523 #endif
524 #ifdef HAVE_DLD
525 TEST_FOR("DLD")
526 #endif
527 //TEST_FOR("factory")
528 //TEST_FOR("libfac")
529 #ifdef HAVE_READLINE
530 TEST_FOR("readline")
531 #endif
532 #ifdef TEST_MAC_ORDER
533 TEST_FOR("MAC_ORDER")
534 #endif
535 // unconditional since 3-1-0-6
536 TEST_FOR("Namespaces")
537 #ifdef HAVE_DYNAMIC_LOADING
538 TEST_FOR("DynamicLoading")
539 #endif
540 #ifdef HAVE_EIGENVAL
541 TEST_FOR("eigenval")
542 #endif
543 #ifdef HAVE_GMS
544 TEST_FOR("gms")
545 #endif
546 #ifdef OM_NDEBUG
547 TEST_FOR("om_ndebug")
548 #endif
549 #ifdef SING_NDEBUG
550 TEST_FOR("ndebug")
551 #endif
552 {};
553 return FALSE;
554 #undef TEST_FOR
555 }
556 return TRUE;
557 }
558 else
559 /*==================== browsers ==================================*/
560 if (strcmp(sys_cmd,"browsers")==0)
561 {
562 res->rtyp = STRING_CMD;
563 StringSetS("");
564 feStringAppendBrowsers(0);
565 res->data = StringEndS();
566 return FALSE;
567 }
568 else
569 /*==================== pid ==================================*/
570 if (strcmp(sys_cmd,"pid")==0)
571 {
572 res->rtyp=INT_CMD;
573 res->data=(void *)(long) getpid();
574 return FALSE;
575 }
576 else
577 /*==================== getenv ==================================*/
578 if (strcmp(sys_cmd,"getenv")==0)
579 {
580 if ((h!=NULL) && (h->Typ()==STRING_CMD))
581 {
582 res->rtyp=STRING_CMD;
583 const char *r=getenv((char *)h->Data());
584 if (r==NULL) r="";
585 res->data=(void *)omStrDup(r);
586 return FALSE;
587 }
588 else
589 {
590 WerrorS("string expected");
591 return TRUE;
592 }
593 }
594 else
595 /*==================== setenv ==================================*/
596 if (strcmp(sys_cmd,"setenv")==0)
597 {
598 #ifdef HAVE_SETENV
599 const short t[]={2,STRING_CMD,STRING_CMD};
600 if (iiCheckTypes(h,t,1))
601 {
602 res->rtyp=STRING_CMD;
603 setenv((char *)h->Data(), (char *)h->next->Data(), 1);
604 res->data=(void *)omStrDup((char *)h->next->Data());
605 feReInitResources();
606 return FALSE;
607 }
608 else
609 {
610 return TRUE;
611 }
612 #else
613 WerrorS("setenv not supported on this platform");
614 return TRUE;
615 #endif
616 }
617 else
618 /*==================== Singular ==================================*/
619 if (strcmp(sys_cmd, "Singular") == 0)
620 {
621 res->rtyp=STRING_CMD;
622 const char *r=feResource("Singular");
623 if (r == NULL) r="";
624 res->data = (void*) omStrDup( r );
625 return FALSE;
626 }
627 else
628 if (strcmp(sys_cmd, "SingularLib") == 0)
629 {
630 res->rtyp=STRING_CMD;
631 const char *r=feResource("SearchPath");
632 if (r == NULL) r="";
633 res->data = (void*) omStrDup( r );
634 return FALSE;
635 }
636 else
637 /*==================== options ==================================*/
638 if (strstr(sys_cmd, "--") == sys_cmd)
639 {
640 if (strcmp(sys_cmd, "--") == 0)
641 {
642 fePrintOptValues();
643 return FALSE;
644 }
645 feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
646 if (opt == FE_OPT_UNDEF)
647 {
648 Werror("Unknown option %s", sys_cmd);
649 WerrorS("Use 'system(\"--\");' for listing of available options");
650 return TRUE;
651 }
652 // for Untyped Options (help version),
653 // setting it just triggers action
654 if (feOptSpec[opt].type == feOptUntyped)
655 {
656 feSetOptValue(opt,0);
657 return FALSE;
658 }
659 if (h == NULL)
660 {
661 if (feOptSpec[opt].type == feOptString)
662 {
663 res->rtyp = STRING_CMD;
664 const char *r=(const char*)feOptSpec[opt].value;
665 if (r == NULL) r="";
666 res->data = omStrDup(r);
667 }
668 else
669 {
670 res->rtyp = INT_CMD;
671 res->data = feOptSpec[opt].value;
672 }
673 return FALSE;
674 }
675 if (h->Typ() != STRING_CMD &&
676 h->Typ() != INT_CMD)
677 {
678 WerrorS("Need string or int argument to set option value");
679 return TRUE;
680 }
681 const char* errormsg;
682 if (h->Typ() == INT_CMD)
683 {
684 if (feOptSpec[opt].type == feOptString)
685 {
686 Werror("Need string argument to set value of option %s", sys_cmd);
687 return TRUE;
688 }
689 errormsg = feSetOptValue(opt, (int)((long) h->Data()));
690 if (errormsg != NULL)
691 Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
692 }
693 else
694 {
695 errormsg = feSetOptValue(opt, (char*) h->Data());
696 if (errormsg != NULL)
697 Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
698 }
699 if (errormsg != NULL) return TRUE;
700 return FALSE;
701 }
702 else
703 /*==================== HC ==================================*/
704 if (strcmp(sys_cmd,"HC")==0)
705 {
706 res->rtyp=INT_CMD;
707 res->data=(void *)(long) HCord;
708 return FALSE;
709 }
710 else
711 /*==================== random ==================================*/
712 if(strcmp(sys_cmd,"random")==0)
713 {
714 const short t[]={1,INT_CMD};
715 if (h!=NULL)
716 {
717 if (iiCheckTypes(h,t,1))
718 {
719 siRandomStart=(int)((long)h->Data());
720 siSeed=siRandomStart;
721 factoryseed(siRandomStart);
722 return FALSE;
723 }
724 else
725 {
726 return TRUE;
727 }
728 }
729 res->rtyp=INT_CMD;
730 res->data=(void*)(long) siSeed;
731 return FALSE;
732 }
733 else
734 /*======================= demon_list =====================*/
735 if (strcmp(sys_cmd,"denom_list")==0)
736 {
737 res->rtyp=LIST_CMD;
738 extern lists get_denom_list();
739 res->data=(lists)get_denom_list();
740 return FALSE;
741 }
742 else
743 /*==================== complexNearZero ======================*/
744 if(strcmp(sys_cmd,"complexNearZero")==0)
745 {
746 const short t[]={2,NUMBER_CMD,INT_CMD};
747 if (iiCheckTypes(h,t,1))
748 {
749 if ( !rField_is_long_C(currRing) )
750 {
751 WerrorS( "unsupported ground field!");
752 return TRUE;
753 }
754 else
755 {
756 res->rtyp=INT_CMD;
757 res->data=(void*)complexNearZero((gmp_complex*)h->Data(),
758 (int)((long)(h->next->Data())));
759 return FALSE;
760 }
761 }
762 else
763 {
764 return TRUE;
765 }
766 }
767 else
768 /*==================== getPrecDigits ======================*/
769 if(strcmp(sys_cmd,"getPrecDigits")==0)
770 {
771 if ( (currRing==NULL)
772 || (!rField_is_long_C(currRing) && !rField_is_long_R(currRing)))
773 {
774 WerrorS( "unsupported ground field!");
775 return TRUE;
776 }
777 res->rtyp=INT_CMD;
778 res->data=(void*)(long)gmp_output_digits;
779 //if (gmp_output_digits!=getGMPFloatDigits())
780 //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);}
781 return FALSE;
782 }
783 else
784 /*==================== lduDecomp ======================*/
785 if(strcmp(sys_cmd, "lduDecomp")==0)
786 {
787 const short t[]={1,MATRIX_CMD};
788 if (iiCheckTypes(h,t,1))
789 {
790 matrix aMat = (matrix)h->Data();
791 matrix pMat; matrix lMat; matrix dMat; matrix uMat;
792 poly l; poly u; poly prodLU;
793 lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU);
794 lists L = (lists)omAllocBin(slists_bin);
795 L->Init(7);
796 L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat;
797 L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat;
798 L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat;
799 L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat;
800 L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l;
801 L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u;
802 L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU;
803 res->rtyp = LIST_CMD;
804 res->data = (char *)L;
805 return FALSE;
806 }
807 else
808 {
809 return TRUE;
810 }
811 }
812 else
813 /*==================== lduSolve ======================*/
814 if(strcmp(sys_cmd, "lduSolve")==0)
815 {
816 /* for solving a linear equation system A * x = b, via the
817 given LDU-decomposition of the matrix A;
818 There is one valid parametrisation:
819 1) exactly eight arguments P, L, D, U, l, u, lTimesU, b;
820 P, L, D, and U realise the LDU-decomposition of A, that is,
821 P * A = L * D^(-1) * U, and P, L, D, and U satisfy the
822 properties decribed in method 'luSolveViaLDUDecomp' in
823 linearAlgebra.h; see there;
824 l, u, and lTimesU are as described in the same location;
825 b is the right-hand side vector of the linear equation system;
826 The method will return a list of either 1 entry or three entries:
827 1) [0] if there is no solution to the system;
828 2) [1, x, H] if there is at least one solution;
829 x is any solution of the given linear system,
830 H is the matrix with column vectors spanning the homogeneous
831 solution space.
832 The method produces an error if matrix and vector sizes do not
833 fit. */
834 const short t[]={7,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,POLY_CMD,POLY_CMD,MATRIX_CMD};
835 if (!iiCheckTypes(h,t,1))
836 {
837 return TRUE;
838 }
839 if (rField_is_Ring(currRing))
840 {
841 WerrorS("field required");
842 return TRUE;
843 }
844 matrix pMat = (matrix)h->Data();
845 matrix lMat = (matrix)h->next->Data();
846 matrix dMat = (matrix)h->next->next->Data();
847 matrix uMat = (matrix)h->next->next->next->Data();
848 poly l = (poly) h->next->next->next->next->Data();
849 poly u = (poly) h->next->next->next->next->next->Data();
850 poly lTimesU = (poly) h->next->next->next->next->next->next->Data();
851 matrix bVec = (matrix)h->next->next->next->next->next->next->next->Data();
852 matrix xVec; int solvable; matrix homogSolSpace;
853 if (pMat->rows() != pMat->cols())
854 {
855 Werror("first matrix (%d x %d) is not quadratic",
856 pMat->rows(), pMat->cols());
857 return TRUE;
858 }
859 if (lMat->rows() != lMat->cols())
860 {
861 Werror("second matrix (%d x %d) is not quadratic",
862 lMat->rows(), lMat->cols());
863 return TRUE;
864 }
865 if (dMat->rows() != dMat->cols())
866 {
867 Werror("third matrix (%d x %d) is not quadratic",
868 dMat->rows(), dMat->cols());
869 return TRUE;
870 }
871 if (dMat->cols() != uMat->rows())
872 {
873 Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s",
874 dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(),
875 "do not t");
876 return TRUE;
877 }
878 if (uMat->rows() != bVec->rows())
879 {
880 Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit",
881 uMat->rows(), uMat->cols(), bVec->rows());
882 return TRUE;
883 }
884 solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU,
885 bVec, xVec, homogSolSpace);
886
887 /* build the return structure; a list with either one or
888 three entries */
889 lists ll = (lists)omAllocBin(slists_bin);
890 if (solvable)
891 {
892 ll->Init(3);
893 ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
894 ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
895 ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
896 }
897 else
898 {
899 ll->Init(1);
900 ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
901 }
902 res->rtyp = LIST_CMD;
903 res->data=(char*)ll;
904 return FALSE;
905 }
906 else
907 /*==== countedref: reference and shared ====*/
908 if (strcmp(sys_cmd, "shared") == 0)
909 {
910 #ifndef SI_COUNTEDREF_AUTOLOAD
911 void countedref_shared_load();
912 countedref_shared_load();
913 #endif
914 res->rtyp = NONE;
915 return FALSE;
916 }
917 else if (strcmp(sys_cmd, "reference") == 0)
918 {
919 #ifndef SI_COUNTEDREF_AUTOLOAD
920 void countedref_reference_load();
921 countedref_reference_load();
922 #endif
923 res->rtyp = NONE;
924 return FALSE;
925 }
926 else
927 /*==================== semaphore =================*/
928 #ifdef HAVE_SIMPLEIPC
929 if (strcmp(sys_cmd,"semaphore")==0)
930 {
931 if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
932 {
933 int v=1;
934 if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))
935 v=(int)(long)h->next->next->Data();
936 res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v);
937 res->rtyp=INT_CMD;
938 return FALSE;
939 }
940 else
941 {
942 WerrorS("Usage: system(\"semaphore\",<cmd>,int)");
943 return TRUE;
944 }
945 }
946 else
947 #endif
948 /*==================== reserved port =================*/
949 if (strcmp(sys_cmd,"reserve")==0)
950 {
951 int ssiReservePort(int clients);
952 const short t[]={1,INT_CMD};
953 if (iiCheckTypes(h,t,1))
954 {
955 res->rtyp=INT_CMD;
956 int p=ssiReservePort((int)(long)h->Data());
957 res->data=(void*)(long)p;
958 return (p==0);
959 }
960 return TRUE;
961 }
962 else
963 /*==================== reserved link =================*/
964 if (strcmp(sys_cmd,"reservedLink")==0)
965 {
966 res->rtyp=LINK_CMD;
967 si_link p=ssiCommandLink();
968 res->data=(void*)p;
969 return (p==NULL);
970 }
971 else
972 /*==================== install newstruct =================*/
973 if (strcmp(sys_cmd,"install")==0)
974 {
975 const short t[]={4,STRING_CMD,STRING_CMD,PROC_CMD,INT_CMD};
976 if (iiCheckTypes(h,t,1))
977 {
978 return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),
979 (int)(long)h->next->next->next->Data(),
980 (procinfov)h->next->next->Data());
981 }
982 return TRUE;
983 }
984 else
985 /*==================== newstruct =================*/
986 if (strcmp(sys_cmd,"newstruct")==0)
987 {
988 const short t[]={1,STRING_CMD};
989 if (iiCheckTypes(h,t,1))
990 {
991 int id=0;
992 char *n=(char*)h->Data();
993 blackboxIsCmd(n,id);
994 if (id>0)
995 {
996 blackbox *bb=getBlackboxStuff(id);
997 if (BB_LIKE_LIST(bb))
998 {
999 newstruct_desc desc=(newstruct_desc)bb->data;
1000 newstructShow(desc);
1001 return FALSE;
1002 }
1003 else Werror("'%s' is not a newstruct",n);
1004 }
1005 else Werror("'%s' is not a blackbox object",n);
1006 }
1007 return TRUE;
1008 }
1009 else
1010 /*==================== blackbox =================*/
1011 if (strcmp(sys_cmd,"blackbox")==0)
1012 {
1013 printBlackboxTypes();
1014 return FALSE;
1015 }
1016 else
1017 /*================= absBiFact ======================*/
1018 #if defined(HAVE_FLINT) || defined(HAVE_NTL)
1019 if (strcmp(sys_cmd, "absFact") == 0)
1020 {
1021 const short t[]={1,POLY_CMD};
1022 if (iiCheckTypes(h,t,1)
1023 && (currRing!=NULL)
1024 && (getCoeffType(currRing->cf)==n_transExt))
1025 {
1026 res->rtyp=LIST_CMD;
1027 intvec *v=NULL;
1028 ideal mipos= NULL;
1029 int n= 0;
1030 ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);
1031 if (f==NULL) return TRUE;
1032 ivTest(v);
1033 lists l=(lists)omAllocBin(slists_bin);
1034 l->Init(4);
1035 l->m[0].rtyp=IDEAL_CMD;
1036 l->m[0].data=(void *)f;
1037 l->m[1].rtyp=INTVEC_CMD;
1038 l->m[1].data=(void *)v;
1039 l->m[2].rtyp=IDEAL_CMD;
1040 l->m[2].data=(void*) mipos;
1041 l->m[3].rtyp=INT_CMD;
1042 l->m[3].data=(void*) (long) n;
1043 res->data=(void *)l;
1044 return FALSE;
1045 }
1046 else return TRUE;
1047 }
1048 else
1049 #endif
1050 /* =================== LLL via NTL ==============================*/
1051 #ifdef HAVE_NTL
1052 if (strcmp(sys_cmd, "LLL") == 0)
1053 {
1054 if (h!=NULL)
1055 {
1056 res->rtyp=h->Typ();
1057 if (h->Typ()==MATRIX_CMD)
1058 {
1059 res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
1060 return FALSE;
1061 }
1062 else if (h->Typ()==INTMAT_CMD)
1063 {
1064 res->data=(char *)singntl_LLL((intvec*)h->Data());
1065 return FALSE;
1066 }
1067 else return TRUE;
1068 }
1069 else return TRUE;
1070 }
1071 else
1072 #endif
1073 /* =================== LLL via Flint ==============================*/
1074 #ifdef HAVE_FLINT
1075 #if __FLINT_RELEASE >= 20500
1076 if (strcmp(sys_cmd, "LLL_Flint") == 0)
1077 {
1078 if (h!=NULL)
1079 {
1080 if(h->next == NULL)
1081 {
1082 res->rtyp=h->Typ();
1083 if (h->Typ()==BIGINTMAT_CMD)
1084 {
1085 res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1086 return FALSE;
1087 }
1088 else if (h->Typ()==INTMAT_CMD)
1089 {
1090 res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1091 return FALSE;
1092 }
1093 else return TRUE;
1094 }
1095 if(h->next->Typ()!= INT_CMD)
1096 {
1097 WerrorS("matrix,int or bigint,int expected");
1098 return TRUE;
1099 }
1100 if(h->next->Typ()== INT_CMD)
1101 {
1102 if(((int)((long)(h->next->Data())) != 0) && (int)((long)(h->next->Data()) != 1))
1103 {
1104 WerrorS("int is different from 0, 1");
1105 return TRUE;
1106 }
1107 res->rtyp=h->Typ();
1108 if((long)(h->next->Data()) == 0)
1109 {
1110 if (h->Typ()==BIGINTMAT_CMD)
1111 {
1112 res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1113 return FALSE;
1114 }
1115 else if (h->Typ()==INTMAT_CMD)
1116 {
1117 res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1118 return FALSE;
1119 }
1120 else return TRUE;
1121 }
1122 // This will give also the transformation matrix U s.t. res = U * m
1123 if((long)(h->next->Data()) == 1)
1124 {
1125 if (h->Typ()==BIGINTMAT_CMD)
1126 {
1127 bigintmat* m = (bigintmat*)h->Data();
1128 bigintmat* T = new bigintmat(m->rows(),m->rows(),m->basecoeffs());
1129 for(int i = 1; i<=m->rows(); i++)
1130 {
1131 n_Delete(&(BIMATELEM(*T,i,i)),T->basecoeffs());
1132 BIMATELEM(*T,i,i)=n_Init(1, T->basecoeffs());
1133 }
1134 m = singflint_LLL(m,T);
1135 lists L = (lists)omAllocBin(slists_bin);
1136 L->Init(2);
1137 L->m[0].rtyp = BIGINTMAT_CMD; L->m[0].data = (void*)m;
1138 L->m[1].rtyp = BIGINTMAT_CMD; L->m[1].data = (void*)T;
1139 res->data=L;
1140 res->rtyp=LIST_CMD;
1141 return FALSE;
1142 }
1143 else if (h->Typ()==INTMAT_CMD)
1144 {
1145 intvec* m = (intvec*)h->Data();
1146 intvec* T = new intvec(m->rows(),m->rows(),(int)0);
1147 for(int i = 1; i<=m->rows(); i++)
1148 IMATELEM(*T,i,i)=1;
1149 m = singflint_LLL(m,T);
1150 lists L = (lists)omAllocBin(slists_bin);
1151 L->Init(2);
1152 L->m[0].rtyp = INTMAT_CMD; L->m[0].data = (void*)m;
1153 L->m[1].rtyp = INTMAT_CMD; L->m[1].data = (void*)T;
1154 res->data=L;
1155 res->rtyp=LIST_CMD;
1156 return FALSE;
1157 }
1158 else return TRUE;
1159 }
1160 }
1161
1162 }
1163 else return TRUE;
1164 }
1165 else
1166 #endif
1167 #endif
1168 /*==================== pcv ==================================*/
1169 #ifdef HAVE_PCV
1170 if(strcmp(sys_cmd,"pcvLAddL")==0)
1171 {
1172 return pcvLAddL(res,h);
1173 }
1174 else
1175 if(strcmp(sys_cmd,"pcvPMulL")==0)
1176 {
1177 return pcvPMulL(res,h);
1178 }
1179 else
1180 if(strcmp(sys_cmd,"pcvMinDeg")==0)
1181 {
1182 return pcvMinDeg(res,h);
1183 }
1184 else
1185 if(strcmp(sys_cmd,"pcvP2CV")==0)
1186 {
1187 return pcvP2CV(res,h);
1188 }
1189 else
1190 if(strcmp(sys_cmd,"pcvCV2P")==0)
1191 {
1192 return pcvCV2P(res,h);
1193 }
1194 else
1195 if(strcmp(sys_cmd,"pcvDim")==0)
1196 {
1197 return pcvDim(res,h);
1198 }
1199 else
1200 if(strcmp(sys_cmd,"pcvBasis")==0)
1201 {
1202 return pcvBasis(res,h);
1203 }
1204 else
1205 #endif
1206 /*==================== hessenberg/eigenvalues ==================================*/
1207 #ifdef HAVE_EIGENVAL
1208 if(strcmp(sys_cmd,"hessenberg")==0)
1209 {
1210 return evHessenberg(res,h);
1211 }
1212 else
1213 #endif
1214 /*==================== eigenvalues ==================================*/
1215 #ifdef HAVE_EIGENVAL
1216 if(strcmp(sys_cmd,"eigenvals")==0)
1217 {
1218 return evEigenvals(res,h);
1219 }
1220 else
1221 #endif
1222 /*==================== rowelim ==================================*/
1223 #ifdef HAVE_EIGENVAL
1224 if(strcmp(sys_cmd,"rowelim")==0)
1225 {
1226 return evRowElim(res,h);
1227 }
1228 else
1229 #endif
1230 /*==================== rowcolswap ==================================*/
1231 #ifdef HAVE_EIGENVAL
1232 if(strcmp(sys_cmd,"rowcolswap")==0)
1233 {
1234 return evSwap(res,h);
1235 }
1236 else
1237 #endif
1238 /*==================== Gauss-Manin system ==================================*/
1239 #ifdef HAVE_GMS
1240 if(strcmp(sys_cmd,"gmsnf")==0)
1241 {
1242 return gmsNF(res,h);
1243 }
1244 else
1245 #endif
1246 /*==================== contributors =============================*/
1247 if(strcmp(sys_cmd,"contributors") == 0)
1248 {
1249 res->rtyp=STRING_CMD;
1250 res->data=(void *)omStrDup(
1251 "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");
1252 return FALSE;
1253 }
1254 else
1255 /*==================== spectrum =============================*/
1256 #ifdef HAVE_SPECTRUM
1257 if(strcmp(sys_cmd,"spectrum") == 0)
1258 {
1259 if ((h==NULL) || (h->Typ()!=POLY_CMD))
1260 {
1261 WerrorS("poly expected");
1262 return TRUE;
1263 }
1264 if (h->next==NULL)
1265 return spectrumProc(res,h);
1266 if (h->next->Typ()!=INT_CMD)
1267 {
1268 WerrorS("poly,int expected");
1269 return TRUE;
1270 }
1271 if(((long)h->next->Data())==1L)
1272 return spectrumfProc(res,h);
1273 return spectrumProc(res,h);
1274 }
1275 else
1276 /*==================== semic =============================*/
1277 if(strcmp(sys_cmd,"semic") == 0)
1278 {
1279 if ((h->next!=NULL)
1280 && (h->Typ()==LIST_CMD)
1281 && (h->next->Typ()==LIST_CMD))
1282 {
1283 if (h->next->next==NULL)
1284 return semicProc(res,h,h->next);
1285 else if (h->next->next->Typ()==INT_CMD)
1286 return semicProc3(res,h,h->next,h->next->next);
1287 }
1288 return TRUE;
1289 }
1290 else
1291 /*==================== spadd =============================*/
1292 if(strcmp(sys_cmd,"spadd") == 0)
1293 {
1294 const short t[]={2,LIST_CMD,LIST_CMD};
1295 if (iiCheckTypes(h,t,1))
1296 {
1297 return spaddProc(res,h,h->next);
1298 }
1299 return TRUE;
1300 }
1301 else
1302 /*==================== spmul =============================*/
1303 if(strcmp(sys_cmd,"spmul") == 0)
1304 {
1305 const short t[]={2,LIST_CMD,INT_CMD};
1306 if (iiCheckTypes(h,t,1))
1307 {
1308 return spmulProc(res,h,h->next);
1309 }
1310 return TRUE;
1311 }
1312 else
1313 #endif
1314 /*==================== tensorModuleMult ========================= */
1315 #define HAVE_SHEAFCOH_TRICKS 1
1316
1317 #ifdef HAVE_SHEAFCOH_TRICKS
1318 if(strcmp(sys_cmd,"tensorModuleMult")==0)
1319 {
1320 const short t[]={2,INT_CMD,MODUL_CMD};
1321 // WarnS("tensorModuleMult!");
1322 if (iiCheckTypes(h,t,1))
1323 {
1324 int m = (int)( (long)h->Data() );
1325 ideal M = (ideal)h->next->Data();
1326 res->rtyp=MODUL_CMD;
1327 res->data=(void *)id_TensorModuleMult(m, M, currRing);
1328 return FALSE;
1329 }
1330 return TRUE;
1331 }
1332 else
1333 #endif
1334 /*==================== twostd =================*/
1335 #ifdef HAVE_PLURAL
1336 if (strcmp(sys_cmd, "twostd") == 0)
1337 {
1338 ideal I;
1339 if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1340 {
1341 I=(ideal)h->CopyD();
1342 res->rtyp=IDEAL_CMD;
1343 if (rIsPluralRing(currRing)) res->data=twostd(I);
1344 else res->data=I;
1345 setFlag(res,FLAG_TWOSTD);
1346 setFlag(res,FLAG_STD);
1347 }
1348 else return TRUE;
1349 return FALSE;
1350 }
1351 else
1352 #endif
1353 /*==================== lie bracket =================*/
1354 #ifdef HAVE_PLURAL
1355 if (strcmp(sys_cmd, "bracket") == 0)
1356 {
1357 const short t[]={2,POLY_CMD,POLY_CMD};
1358 if (iiCheckTypes(h,t,1))
1359 {
1360 poly p=(poly)h->CopyD();
1361 h=h->next;
1362 poly q=(poly)h->Data();
1363 res->rtyp=POLY_CMD;
1364 if (rIsPluralRing(currRing)) res->data=nc_p_Bracket_qq(p,q, currRing);
1365 return FALSE;
1366 }
1367 return TRUE;
1368 }
1369 else
1370 #endif
1371 /*==================== env ==================================*/
1372 #ifdef HAVE_PLURAL
1373 if (strcmp(sys_cmd, "env")==0)
1374 {
1375 if ((h!=NULL) && (h->Typ()==RING_CMD))
1376 {
1377 ring r = (ring)h->Data();
1378 res->data = rEnvelope(r);
1379 res->rtyp = RING_CMD;
1380 return FALSE;
1381 }
1382 else
1383 {
1384 WerrorS("`system(\"env\",<ring>)` expected");
1385 return TRUE;
1386 }
1387 }
1388 else
1389 #endif
1390 /* ============ opp ======================== */
1391 #ifdef HAVE_PLURAL
1392 if (strcmp(sys_cmd, "opp")==0)
1393 {
1394 if ((h!=NULL) && (h->Typ()==RING_CMD))
1395 {
1396 ring r=(ring)h->Data();
1397 res->data=rOpposite(r);
1398 res->rtyp=RING_CMD;
1399 return FALSE;
1400 }
1401 else
1402 {
1403 WerrorS("`system(\"opp\",<ring>)` expected");
1404 return TRUE;
1405 }
1406 }
1407 else
1408 #endif
1409 /*==================== oppose ==================================*/
1410 #ifdef HAVE_PLURAL
1411 if (strcmp(sys_cmd, "oppose")==0)
1412 {
1413 if ((h!=NULL) && (h->Typ()==RING_CMD)
1414 && (h->next!= NULL))
1415 {
1416 ring Rop = (ring)h->Data();
1417 h = h->next;
1418 idhdl w;
1419 if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1420 {
1421 poly p = (poly)IDDATA(w);
1422 res->data = pOppose(Rop, p, currRing); // into CurrRing?
1423 res->rtyp = POLY_CMD;
1424 return FALSE;
1425 }
1426 }
1427 else
1428 {
1429 WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1430 return TRUE;
1431 }
1432 }
1433 else
1434 #endif
1435 /*==================== walk stuff =================*/
1436 /*==================== walkNextWeight =================*/
1437 #ifdef HAVE_WALK
1438 #ifdef OWNW
1439 if (strcmp(sys_cmd, "walkNextWeight") == 0)
1440 {
1441 const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1442 if (!iiCheckTypes(h,t,1)) return TRUE;
1443 if (((intvec*) h->Data())->length() != currRing->N ||
1444 ((intvec*) h->next->Data())->length() != currRing->N)
1445 {
1446 Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1447 currRing->N);
1448 return TRUE;
1449 }
1450 res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1451 ((intvec*) h->next->Data()),
1452 (ideal) h->next->next->Data());
1453 if (res->data == NULL || res->data == (void*) 1L)
1454 {
1455 res->rtyp = INT_CMD;
1456 }
1457 else
1458 {
1459 res->rtyp = INTVEC_CMD;
1460 }
1461 return FALSE;
1462 }
1463 else
1464 #endif
1465 #endif
1466 /*==================== walkNextWeight =================*/
1467 #ifdef HAVE_WALK
1468 #ifdef OWNW
1469 if (strcmp(sys_cmd, "walkInitials") == 0)
1470 {
1471 if (h == NULL || h->Typ() != IDEAL_CMD)
1472 {
1473 WerrorS("system(\"walkInitials\", ideal) expected");
1474 return TRUE;
1475 }
1476 res->data = (void*) walkInitials((ideal) h->Data());
1477 res->rtyp = IDEAL_CMD;
1478 return FALSE;
1479 }
1480 else
1481 #endif
1482 #endif
1483 /*==================== walkAddIntVec =================*/
1484 #ifdef HAVE_WALK
1485 #ifdef WAIV
1486 if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1487 {
1488 const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1489 if (!iiCheckTypes(h,t,1)) return TRUE;
1490 intvec* arg1 = (intvec*) h->Data();
1491 intvec* arg2 = (intvec*) h->next->Data();
1492 res->data = (intvec*) walkAddIntVec(arg1, arg2);
1493 res->rtyp = INTVEC_CMD;
1494 return FALSE;
1495 }
1496 else
1497 #endif
1498 #endif
1499 /*==================== MwalkNextWeight =================*/
1500 #ifdef HAVE_WALK
1501 #ifdef MwaklNextWeight
1502 if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1503 {
1504 const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1505 if (!iiCheckTypes(h,t,1)) return TRUE;
1506 if (((intvec*) h->Data())->length() != currRing->N ||
1507 ((intvec*) h->next->Data())->length() != currRing->N)
1508 {
1509 Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1510 currRing->N);
1511 return TRUE;
1512 }
1513 intvec* arg1 = (intvec*) h->Data();
1514 intvec* arg2 = (intvec*) h->next->Data();
1515 ideal arg3 = (ideal) h->next->next->Data();
1516 intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1517 res->rtyp = INTVEC_CMD;
1518 res->data = result;
1519 return FALSE;
1520 }
1521 else
1522 #endif //MWalkNextWeight
1523 #endif
1524 /*==================== Mivdp =================*/
1525 #ifdef HAVE_WALK
1526 if(strcmp(sys_cmd, "Mivdp") == 0)
1527 {
1528 if (h == NULL || h->Typ() != INT_CMD)
1529 {
1530 WerrorS("system(\"Mivdp\", int) expected");
1531 return TRUE;
1532 }
1533 if ((int) ((long)(h->Data())) != currRing->N)
1534 {
1535 Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1536 currRing->N);
1537 return TRUE;
1538 }
1539 int arg1 = (int) ((long)(h->Data()));
1540 intvec* result = (intvec*) Mivdp(arg1);
1541 res->rtyp = INTVEC_CMD;
1542 res->data = result;
1543 return FALSE;
1544 }
1545 else
1546 #endif
1547 /*==================== Mivlp =================*/
1548 #ifdef HAVE_WALK
1549 if(strcmp(sys_cmd, "Mivlp") == 0)
1550 {
1551 if (h == NULL || h->Typ() != INT_CMD)
1552 {
1553 WerrorS("system(\"Mivlp\", int) expected");
1554 return TRUE;
1555 }
1556 if ((int) ((long)(h->Data())) != currRing->N)
1557 {
1558 Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1559 currRing->N);
1560 return TRUE;
1561 }
1562 int arg1 = (int) ((long)(h->Data()));
1563 intvec* result = (intvec*) Mivlp(arg1);
1564 res->rtyp = INTVEC_CMD;
1565 res->data = result;
1566 return FALSE;
1567 }
1568 else
1569 #endif
1570 /*==================== MpDiv =================*/
1571 #ifdef HAVE_WALK
1572 #ifdef MpDiv
1573 if(strcmp(sys_cmd, "MpDiv") == 0)
1574 {
1575 const short t[]={2,POLY_CMD,POLY_CMD};
1576 if (!iiCheckTypes(h,t,1)) return TRUE;
1577 poly arg1 = (poly) h->Data();
1578 poly arg2 = (poly) h->next->Data();
1579 poly result = MpDiv(arg1, arg2);
1580 res->rtyp = POLY_CMD;
1581 res->data = result;
1582 return FALSE;
1583 }
1584 else
1585 #endif
1586 #endif
1587 /*==================== MpMult =================*/
1588 #ifdef HAVE_WALK
1589 #ifdef MpMult
1590 if(strcmp(sys_cmd, "MpMult") == 0)
1591 {
1592 const short t[]={2,POLY_CMD,POLY_CMD};
1593 if (!iiCheckTypes(h,t,1)) return TRUE;
1594 poly arg1 = (poly) h->Data();
1595 poly arg2 = (poly) h->next->Data();
1596 poly result = MpMult(arg1, arg2);
1597 res->rtyp = POLY_CMD;
1598 res->data = result;
1599 return FALSE;
1600 }
1601 else
1602 #endif
1603 #endif
1604 /*==================== MivSame =================*/
1605 #ifdef HAVE_WALK
1606 if (strcmp(sys_cmd, "MivSame") == 0)
1607 {
1608 const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1609 if (!iiCheckTypes(h,t,1)) return TRUE;
1610 /*
1611 if (((intvec*) h->Data())->length() != currRing->N ||
1612 ((intvec*) h->next->Data())->length() != currRing->N)
1613 {
1614 Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1615 currRing->N);
1616 return TRUE;
1617 }
1618 */
1619 intvec* arg1 = (intvec*) h->Data();
1620 intvec* arg2 = (intvec*) h->next->Data();
1621 /*
1622 poly result = (poly) MivSame(arg1, arg2);
1623 res->rtyp = POLY_CMD;
1624 res->data = (poly) result;
1625 */
1626 res->rtyp = INT_CMD;
1627 res->data = (void*)(long) MivSame(arg1, arg2);
1628 return FALSE;
1629 }
1630 else
1631 #endif
1632 /*==================== M3ivSame =================*/
1633 #ifdef HAVE_WALK
1634 if (strcmp(sys_cmd, "M3ivSame") == 0)
1635 {
1636 const short t[]={3,INTVEC_CMD,INTVEC_CMD,INTVEC_CMD};
1637 if (!iiCheckTypes(h,t,1)) return TRUE;
1638 /*
1639 if (((intvec*) h->Data())->length() != currRing->N ||
1640 ((intvec*) h->next->Data())->length() != currRing->N ||
1641 ((intvec*) h->next->next->Data())->length() != currRing->N )
1642 {
1643 Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1644 currRing->N);
1645 return TRUE;
1646 }
1647 */
1648 intvec* arg1 = (intvec*) h->Data();
1649 intvec* arg2 = (intvec*) h->next->Data();
1650 intvec* arg3 = (intvec*) h->next->next->Data();
1651 /*
1652 poly result = (poly) M3ivSame(arg1, arg2, arg3);
1653 res->rtyp = POLY_CMD;
1654 res->data = (poly) result;
1655 */
1656 res->rtyp = INT_CMD;
1657 res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1658 return FALSE;
1659 }
1660 else
1661 #endif
1662 /*==================== MwalkInitialForm =================*/
1663 #ifdef HAVE_WALK
1664 if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1665 {
1666 const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1667 if (!iiCheckTypes(h,t,1)) return TRUE;
1668 if(((intvec*) h->next->Data())->length() != currRing->N)
1669 {
1670 Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1671 currRing->N);
1672 return TRUE;
1673 }
1674 ideal id = (ideal) h->Data();
1675 intvec* int_w = (intvec*) h->next->Data();
1676 ideal result = (ideal) MwalkInitialForm(id, int_w);
1677 res->rtyp = IDEAL_CMD;
1678 res->data = result;
1679 return FALSE;
1680 }
1681 else
1682 #endif
1683 /*==================== MivMatrixOrder =================*/
1684 #ifdef HAVE_WALK
1685 /************** Perturbation walk **********/
1686 if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1687 {
1688 if(h==NULL || h->Typ() != INTVEC_CMD)
1689 {
1690 WerrorS("system(\"MivMatrixOrder\",intvec) expected");
1691 return TRUE;
1692 }
1693 intvec* arg1 = (intvec*) h->Data();
1694 intvec* result = MivMatrixOrder(arg1);
1695 res->rtyp = INTVEC_CMD;
1696 res->data = result;
1697 return FALSE;
1698 }
1699 else
1700 #endif
1701 /*==================== MivMatrixOrderdp =================*/
1702 #ifdef HAVE_WALK
1703 if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1704 {
1705 if(h==NULL || h->Typ() != INT_CMD)
1706 {
1707 WerrorS("system(\"MivMatrixOrderdp\",intvec) expected");
1708 return TRUE;
1709 }
1710 int arg1 = (int) ((long)(h->Data()));
1711 intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1712 res->rtyp = INTVEC_CMD;
1713 res->data = result;
1714 return FALSE;
1715 }
1716 else
1717 #endif
1718 /*==================== MPertVectors =================*/
1719 #ifdef HAVE_WALK
1720 if(strcmp(sys_cmd, "MPertVectors") == 0)
1721 {
1722 const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1723 if (!iiCheckTypes(h,t,1)) return TRUE;
1724 ideal arg1 = (ideal) h->Data();
1725 intvec* arg2 = (intvec*) h->next->Data();
1726 int arg3 = (int) ((long)(h->next->next->Data()));
1727 intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1728 res->rtyp = INTVEC_CMD;
1729 res->data = result;
1730 return FALSE;
1731 }
1732 else
1733 #endif
1734 /*==================== MPertVectorslp =================*/
1735 #ifdef HAVE_WALK
1736 if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1737 {
1738 const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1739 if (!iiCheckTypes(h,t,1)) return TRUE;
1740 ideal arg1 = (ideal) h->Data();
1741 intvec* arg2 = (intvec*) h->next->Data();
1742 int arg3 = (int) ((long)(h->next->next->Data()));
1743 intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1744 res->rtyp = INTVEC_CMD;
1745 res->data = result;
1746 return FALSE;
1747 }
1748 else
1749 #endif
1750 /************** fractal walk **********/
1751 #ifdef HAVE_WALK
1752 if(strcmp(sys_cmd, "Mfpertvector") == 0)
1753 {
1754 const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1755 if (!iiCheckTypes(h,t,1)) return TRUE;
1756 ideal arg1 = (ideal) h->Data();
1757 intvec* arg2 = (intvec*) h->next->Data();
1758 intvec* result = Mfpertvector(arg1, arg2);
1759 res->rtyp = INTVEC_CMD;
1760 res->data = result;
1761 return FALSE;
1762 }
1763 else
1764 #endif
1765 /*==================== MivUnit =================*/
1766 #ifdef HAVE_WALK
1767 if(strcmp(sys_cmd, "MivUnit") == 0)
1768 {
1769 const short t[]={1,INT_CMD};
1770 if (!iiCheckTypes(h,t,1)) return TRUE;
1771 int arg1 = (int) ((long)(h->Data()));
1772 intvec* result = (intvec*) MivUnit(arg1);
1773 res->rtyp = INTVEC_CMD;
1774 res->data = result;
1775 return FALSE;
1776 }
1777 else
1778 #endif
1779 /*==================== MivWeightOrderlp =================*/
1780 #ifdef HAVE_WALK
1781 if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1782 {
1783 const short t[]={1,INTVEC_CMD};
1784 if (!iiCheckTypes(h,t,1)) return TRUE;
1785 intvec* arg1 = (intvec*) h->Data();
1786 intvec* result = MivWeightOrderlp(arg1);
1787 res->rtyp = INTVEC_CMD;
1788 res->data = result;
1789 return FALSE;
1790 }
1791 else
1792 #endif
1793 /*==================== MivWeightOrderdp =================*/
1794 #ifdef HAVE_WALK
1795 if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1796 {
1797 if(h==NULL || h->Typ() != INTVEC_CMD)
1798 {
1799 WerrorS("system(\"MivWeightOrderdp\",intvec) expected");
1800 return TRUE;
1801 }
1802 intvec* arg1 = (intvec*) h->Data();
1803 //int arg2 = (int) h->next->Data();
1804 intvec* result = MivWeightOrderdp(arg1);
1805 res->rtyp = INTVEC_CMD;
1806 res->data = result;
1807 return FALSE;
1808 }
1809 else
1810 #endif
1811 /*==================== MivMatrixOrderlp =================*/
1812 #ifdef HAVE_WALK
1813 if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1814 {
1815 if(h==NULL || h->Typ() != INT_CMD)
1816 {
1817 WerrorS("system(\"MivMatrixOrderlp\",int) expected");
1818 return TRUE;
1819 }
1820 int arg1 = (int) ((long)(h->Data()));
1821 intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1822 res->rtyp = INTVEC_CMD;
1823 res->data = result;
1824 return FALSE;
1825 }
1826 else
1827 #endif
1828 /*==================== MkInterRedNextWeight =================*/
1829 #ifdef HAVE_WALK
1830 if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1831 {
1832 const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1833 if (!iiCheckTypes(h,t,1)) return TRUE;
1834 if (((intvec*) h->Data())->length() != currRing->N ||
1835 ((intvec*) h->next->Data())->length() != currRing->N)
1836 {
1837 Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1838 currRing->N);
1839 return TRUE;
1840 }
1841 intvec* arg1 = (intvec*) h->Data();
1842 intvec* arg2 = (intvec*) h->next->Data();
1843 ideal arg3 = (ideal) h->next->next->Data();
1844 intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1845 res->rtyp = INTVEC_CMD;
1846 res->data = result;
1847 return FALSE;
1848 }
1849 else
1850 #endif
1851 /*==================== MPertNextWeight =================*/
1852 #ifdef HAVE_WALK
1853 #ifdef MPertNextWeight
1854 if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1855 {
1856 const short t[]={3,INTVEC_CMD,IDEAL_CMD,INT_CMD};
1857 if (!iiCheckTypes(h,t,1)) return TRUE;
1858 if (((intvec*) h->Data())->length() != currRing->N)
1859 {
1860 Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1861 currRing->N);
1862 return TRUE;
1863 }
1864 intvec* arg1 = (intvec*) h->Data();
1865 ideal arg2 = (ideal) h->next->Data();
1866 int arg3 = (int) h->next->next->Data();
1867 intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1868 res->rtyp = INTVEC_CMD;
1869 res->data = result;
1870 return FALSE;
1871 }
1872 else
1873 #endif //MPertNextWeight
1874 #endif
1875 /*==================== Mivperttarget =================*/
1876 #ifdef HAVE_WALK
1877 #ifdef Mivperttarget
1878 if (strcmp(sys_cmd, "Mivperttarget") == 0)
1879 {
1880 const short t[]={2,IDEAL_CMD,INT_CMD};
1881 if (!iiCheckTypes(h,t,1)) return TRUE;
1882 ideal arg1 = (ideal) h->Data();
1883 int arg2 = (int) h->next->Data();
1884 intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1885 res->rtyp = INTVEC_CMD;
1886 res->data = result;
1887 return FALSE;
1888 }
1889 else
1890 #endif //Mivperttarget
1891 #endif
1892 /*==================== Mwalk =================*/
1893 #ifdef HAVE_WALK
1894 if (strcmp(sys_cmd, "Mwalk") == 0)
1895 {
1896 const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD,INT_CMD,INT_CMD};
1897 if (!iiCheckTypes(h,t,1)) return TRUE;
1898 if (((intvec*) h->next->Data())->length() != currRing->N &&
1899 ((intvec*) h->next->next->Data())->length() != currRing->N )
1900 {
1901 Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1902 currRing->N);
1903 return TRUE;
1904 }
1905 ideal arg1 = (ideal) h->CopyD();
1906 intvec* arg2 = (intvec*) h->next->Data();
1907 intvec* arg3 = (intvec*) h->next->next->Data();
1908 ring arg4 = (ring) h->next->next->next->Data();
1909 int arg5 = (int) (long) h->next->next->next->next->Data();
1910 int arg6 = (int) (long) h->next->next->next->next->next->Data();
1911 ideal result = (ideal) Mwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1912 res->rtyp = IDEAL_CMD;
1913 res->data = result;
1914 return FALSE;
1915 }
1916 else
1917 #endif
1918 /*==================== Mpwalk =================*/
1919 #ifdef HAVE_WALK
1920 #ifdef MPWALK_ORIG
1921 if (strcmp(sys_cmd, "Mwalk") == 0)
1922 {
1923 const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
1924 if (!iiCheckTypes(h,t,1)) return TRUE;
1925 if ((((intvec*) h->next->Data())->length() != currRing->N &&
1926 ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
1927 (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
1928 ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N)))
1929 {
1930 Werror("system(\"Mwalk\" ...) intvecs not of length %d or %d\n",
1931 currRing->N,(currRing->N)*(currRing->N));
1932 return TRUE;
1933 }
1934 ideal arg1 = (ideal) h->Data();
1935 intvec* arg2 = (intvec*) h->next->Data();
1936 intvec* arg3 = (intvec*) h->next->next->Data();
1937 ring arg4 = (ring) h->next->next->next->Data();
1938 ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
1939 res->rtyp = IDEAL_CMD;
1940 res->data = result;
1941 return FALSE;
1942 }
1943 else
1944 #else
1945 if (strcmp(sys_cmd, "Mpwalk") == 0)
1946 {
1947 const short t[]={8,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
1948 if (!iiCheckTypes(h,t,1)) return TRUE;
1949 if(((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1950 ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1951 {
1952 Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",currRing->N);
1953 return TRUE;
1954 }
1955 ideal arg1 = (ideal) h->Data();
1956 int arg2 = (int) (long) h->next->Data();
1957 int arg3 = (int) (long) h->next->next->Data();
1958 intvec* arg4 = (intvec*) h->next->next->next->Data();
1959 intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1960 int arg6 = (int) (long) h->next->next->next->next->next->Data();
1961 int arg7 = (int) (long) h->next->next->next->next->next->next->Data();
1962 int arg8 = (int) (long) h->next->next->next->next->next->next->next->Data();
1963 ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
1964 res->rtyp = IDEAL_CMD;
1965 res->data = result;
1966 return FALSE;
1967 }
1968 else
1969 #endif
1970 #endif
1971 /*==================== Mrwalk =================*/
1972 #ifdef HAVE_WALK
1973 if (strcmp(sys_cmd, "Mrwalk") == 0)
1974 {
1975 const short t[]={7,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
1976 if (!iiCheckTypes(h,t,1)) return TRUE;
1977 if(((intvec*) h->next->Data())->length() != currRing->N &&
1978 ((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
1979 ((intvec*) h->next->next->Data())->length() != currRing->N &&
1980 ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) )
1981 {
1982 Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
1983 currRing->N,(currRing->N)*(currRing->N));
1984 return TRUE;
1985 }
1986 ideal arg1 = (ideal) h->Data();
1987 intvec* arg2 = (intvec*) h->next->Data();
1988 intvec* arg3 = (intvec*) h->next->next->Data();
1989 int arg4 = (int)(long) h->next->next->next->Data();
1990 int arg5 = (int)(long) h->next->next->next->next->Data();
1991 int arg6 = (int)(long) h->next->next->next->next->next->Data();
1992 int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
1993 ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
1994 res->rtyp = IDEAL_CMD;
1995 res->data = result;
1996 return FALSE;
1997 }
1998 else
1999 #endif
2000 /*==================== MAltwalk1 =================*/
2001 #ifdef HAVE_WALK
2002 if (strcmp(sys_cmd, "MAltwalk1") == 0)
2003 {
2004 const short t[]={5,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD};
2005 if (!iiCheckTypes(h,t,1)) return TRUE;
2006 if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
2007 ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
2008 {
2009 Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
2010 currRing->N);
2011 return TRUE;
2012 }
2013 ideal arg1 = (ideal) h->Data();
2014 int arg2 = (int) ((long)(h->next->Data()));
2015 int arg3 = (int) ((long)(h->next->next->Data()));
2016 intvec* arg4 = (intvec*) h->next->next->next->Data();
2017 intvec* arg5 = (intvec*) h->next->next->next->next->Data();
2018 ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
2019 res->rtyp = IDEAL_CMD;
2020 res->data = result;
2021 return FALSE;
2022 }
2023 else
2024 #endif
2025 /*==================== MAltwalk1 =================*/
2026 #ifdef HAVE_WALK
2027 #ifdef MFWALK_ALT
2028 if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
2029 {
2030 const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2031 if (!iiCheckTypes(h,t,1)) return TRUE;
2032 if (((intvec*) h->next->Data())->length() != currRing->N &&
2033 ((intvec*) h->next->next->Data())->length() != currRing->N )
2034 {
2035 Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2036 currRing->N);
2037 return TRUE;
2038 }
2039 ideal arg1 = (ideal) h->Data();
2040 intvec* arg2 = (intvec*) h->next->Data();
2041 intvec* arg3 = (intvec*) h->next->next->Data();
2042 int arg4 = (int) h->next->next->next->Data();
2043 ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
2044 res->rtyp = IDEAL_CMD;
2045 res->data = result;
2046 return FALSE;
2047 }
2048 else
2049 #endif
2050 #endif
2051 /*==================== Mfwalk =================*/
2052 #ifdef HAVE_WALK
2053 if (strcmp(sys_cmd, "Mfwalk") == 0)
2054 {
2055 const short t[]={5,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD};
2056 if (!iiCheckTypes(h,t,1)) return TRUE;
2057 if (((intvec*) h->next->Data())->length() != currRing->N &&
2058 ((intvec*) h->next->next->Data())->length() != currRing->N )
2059 {
2060 Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2061 currRing->N);
2062 return TRUE;
2063 }
2064 ideal arg1 = (ideal) h->Data();
2065 intvec* arg2 = (intvec*) h->next->Data();
2066 intvec* arg3 = (intvec*) h->next->next->Data();
2067 int arg4 = (int)(long) h->next->next->next->Data();
2068 int arg5 = (int)(long) h->next->next->next->next->Data();
2069 ideal result = (ideal) Mfwalk(arg1, arg2, arg3, arg4, arg5);
2070 res->rtyp = IDEAL_CMD;
2071 res->data = result;
2072 return FALSE;
2073 }
2074 else
2075 #endif
2076 /*==================== Mfrwalk =================*/
2077 #ifdef HAVE_WALK
2078 if (strcmp(sys_cmd, "Mfrwalk") == 0)
2079 {
2080 const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
2081 if (!iiCheckTypes(h,t,1)) return TRUE;
2082 /*
2083 if (((intvec*) h->next->Data())->length() != currRing->N &&
2084 ((intvec*) h->next->next->Data())->length() != currRing->N)
2085 {
2086 Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
2087 return TRUE;
2088 }
2089 */
2090 if((((intvec*) h->next->Data())->length() != currRing->N &&
2091 ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2092 (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2093 ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2094 {
2095 Werror("system(\"Mfrwalk\" ...) intvecs not of length %d or %d\n",
2096 currRing->N,(currRing->N)*(currRing->N));
2097 return TRUE;
2098 }
2099
2100 ideal arg1 = (ideal) h->Data();
2101 intvec* arg2 = (intvec*) h->next->Data();
2102 intvec* arg3 = (intvec*) h->next->next->Data();
2103 int arg4 = (int)(long) h->next->next->next->Data();
2104 int arg5 = (int)(long) h->next->next->next->next->Data();
2105 int arg6 = (int)(long) h->next->next->next->next->next->Data();
2106 ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2107 res->rtyp = IDEAL_CMD;
2108 res->data = result;
2109 return FALSE;
2110 }
2111 else
2112 /*==================== Mprwalk =================*/
2113 if (strcmp(sys_cmd, "Mprwalk") == 0)
2114 {
2115 const short t[]={9,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
2116 if (!iiCheckTypes(h,t,1)) return TRUE;
2117 if((((intvec*) h->next->Data())->length() != currRing->N &&
2118 ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2119 (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2120 ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2121 {
2122 Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2123 currRing->N,(currRing->N)*(currRing->N));
2124 return TRUE;
2125 }
2126 ideal arg1 = (ideal) h->Data();
2127 intvec* arg2 = (intvec*) h->next->Data();
2128 intvec* arg3 = (intvec*) h->next->next->Data();
2129 int arg4 = (int)(long) h->next->next->next->Data();
2130 int arg5 = (int)(long) h->next->next->next->next->Data();
2131 int arg6 = (int)(long) h->next->next->next->next->next->Data();
2132 int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2133 int arg8 = (int)(long) h->next->next->next->next->next->next->next->Data();
2134 int arg9 = (int)(long) h->next->next->next->next->next->next->next->next->Data();
2135 ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
2136 res->rtyp = IDEAL_CMD;
2137 res->data = result;
2138 return FALSE;
2139 }
2140 else
2141 #endif
2142 /*==================== TranMImprovwalk =================*/
2143 #ifdef HAVE_WALK
2144 #ifdef TRAN_Orig
2145 if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2146 {
2147 const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2148 if (!iiCheckTypes(h,t,1)) return TRUE;
2149 if (((intvec*) h->next->Data())->length() != currRing->N &&
2150 ((intvec*) h->next->next->Data())->length() != currRing->N )
2151 {
2152 Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2153 currRing->N);
2154 return TRUE;
2155 }
2156 ideal arg1 = (ideal) h->Data();
2157 intvec* arg2 = (intvec*) h->next->Data();
2158 intvec* arg3 = (intvec*) h->next->next->Data();
2159 ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
2160 res->rtyp = IDEAL_CMD;
2161 res->data = result;
2162 return FALSE;
2163 }
2164 else
2165 #endif
2166 #endif
2167 /*==================== MAltwalk2 =================*/
2168 #ifdef HAVE_WALK
2169 if (strcmp(sys_cmd, "MAltwalk2") == 0)
2170 {
2171 const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2172 if (!iiCheckTypes(h,t,1)) return TRUE;
2173 if (((intvec*) h->next->Data())->length() != currRing->N &&
2174 ((intvec*) h->next->next->Data())->length() != currRing->N )
2175 {
2176 Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
2177 currRing->N);
2178 return TRUE;
2179 }
2180 ideal arg1 = (ideal) h->Data();
2181 intvec* arg2 = (intvec*) h->next->Data();
2182 intvec* arg3 = (intvec*) h->next->next->Data();
2183 ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
2184 res->rtyp = IDEAL_CMD;
2185 res->data = result;
2186 return FALSE;
2187 }
2188 else
2189 #endif
2190 /*==================== MAltwalk2 =================*/
2191 #ifdef HAVE_WALK
2192 if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2193 {
2194 const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2195 if (!iiCheckTypes(h,t,1)) return TRUE;
2196 if (((intvec*) h->next->Data())->length() != currRing->N &&
2197 ((intvec*) h->next->next->Data())->length() != currRing->N )
2198 {
2199 Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2200 currRing->N);
2201 return TRUE;
2202 }
2203 ideal arg1 = (ideal) h->Data();
2204 intvec* arg2 = (intvec*) h->next->Data();
2205 intvec* arg3 = (intvec*) h->next->next->Data();
2206 int arg4 = (int) ((long)(h->next->next->next->Data()));
2207 ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
2208 res->rtyp = IDEAL_CMD;
2209 res->data = result;
2210 return FALSE;
2211 }
2212 else
2213 #endif
2214 /*==================== TranMrImprovwalk =================*/
2215 #if 0
2216 #ifdef HAVE_WALK
2217 if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
2218 {
2219 if (h == NULL || h->Typ() != IDEAL_CMD ||
2220 h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2221 h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2222 h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
2223 h->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD ||
2224 h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD)
2225 {
2226 WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
2227 return TRUE;
2228 }
2229 if (((intvec*) h->next->Data())->length() != currRing->N &&
2230 ((intvec*) h->next->next->Data())->length() != currRing->N )
2231 {
2232 Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
2233 return TRUE;
2234 }
2235 ideal arg1 = (ideal) h->Data();
2236 intvec* arg2 = (intvec*) h->next->Data();
2237 intvec* arg3 = (intvec*) h->next->next->Data();
2238 int arg4 = (int)(long) h->next->next->next->Data();
2239 int arg5 = (int)(long) h->next->next->next->next->Data();
2240 int arg6 = (int)(long) h->next->next->next->next->next->Data();
2241 ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2242 res->rtyp = IDEAL_CMD;
2243 res->data = result;
2244 return FALSE;
2245 }
2246 else
2247 #endif
2248 #endif
2249 /*================= Extended system call ========================*/
2250 {
2251 #ifndef MAKE_DISTRIBUTION
2252 return(jjEXTENDED_SYSTEM(res, args));
2253 #else
2254 Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
2255 #endif
2256 }
2257 } /* typ==string */
2258 return TRUE;
2259 }
2260
2261
2262 #ifdef HAVE_EXTENDED_SYSTEM
2263 // You can put your own system calls here
2264 # include "kernel/fglm/fglm.h"
2265 # ifdef HAVE_NEWTON
2266 # include "hc_newton.h"
2267 # endif
2268
jjEXTENDED_SYSTEM(leftv res,leftv h)2269 static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
2270 {
2271 if(h->Typ() == STRING_CMD)
2272 {
2273 char *sys_cmd=(char *)(h->Data());
2274 h=h->next;
2275 /*==================== test syz strat =================*/
2276 if (strcmp(sys_cmd, "syz") == 0)
2277 {
2278 if ((h!=NULL) && (h->Typ()==STRING_CMD))
2279 {
2280 const char *s=(const char *)h->Data();
2281 if (strcmp(s,"posInT_EcartFDegpLength")==0)
2282 test_PosInT=posInT_EcartFDegpLength;
2283 else if (strcmp(s,"posInT_FDegpLength")==0)
2284 test_PosInT=posInT_FDegpLength;
2285 else if (strcmp(s,"posInT_pLength")==0)
2286 test_PosInT=posInT_pLength;
2287 else if (strcmp(s,"posInT0")==0)
2288 test_PosInT=posInT0;
2289 else if (strcmp(s,"posInT1")==0)
2290 test_PosInT=posInT1;
2291 else if (strcmp(s,"posInT2")==0)
2292 test_PosInT=posInT2;
2293 else if (strcmp(s,"posInT11")==0)
2294 test_PosInT=posInT11;
2295 else if (strcmp(s,"posInT110")==0)
2296 test_PosInT=posInT110;
2297 else if (strcmp(s,"posInT13")==0)
2298 test_PosInT=posInT13;
2299 else if (strcmp(s,"posInT15")==0)
2300 test_PosInT=posInT15;
2301 else if (strcmp(s,"posInT17")==0)
2302 test_PosInT=posInT17;
2303 else if (strcmp(s,"posInT17_c")==0)
2304 test_PosInT=posInT17_c;
2305 else if (strcmp(s,"posInT19")==0)
2306 test_PosInT=posInT19;
2307 else PrintS("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2308 }
2309 else
2310 {
2311 test_PosInT=NULL;
2312 test_PosInL=NULL;
2313 }
2314 si_opt_2|=Sy_bit(23);
2315 return FALSE;
2316 }
2317 else
2318 /*==================== locNF ======================================*/
2319 if(strcmp(sys_cmd,"locNF")==0)
2320 {
2321 const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2322 if (iiCheckTypes(h,t,1))
2323 {
2324 poly f=(poly)h->Data();
2325 h=h->next;
2326 ideal m=(ideal)h->Data();
2327 assumeStdFlag(h);
2328 h=h->next;
2329 int n=(int)((long)h->Data());
2330 h=h->next;
2331 intvec *v=(intvec *)h->Data();
2332
2333 /* == now the work starts == */
2334
2335 int * iv=iv2array(v, currRing);
2336 poly r=0;
2337 poly hp=ppJetW(f,n,iv);
2338 int s=MATCOLS(m);
2339 int j=0;
2340 matrix T=mp_InitI(s,1,0, currRing);
2341
2342 while (hp != NULL)
2343 {
2344 if (pDivisibleBy(m->m[j],hp))
2345 {
2346 if (MATELEM(T,j+1,1)==0)
2347 {
2348 MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2349 }
2350 else
2351 {
2352 pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2353 }
2354 hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2355 j=0;
2356 }
2357 else
2358 {
2359 if (j==s-1)
2360 {
2361 r=pAdd(r,pHead(hp));
2362 hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2363 j=0;
2364 }
2365 else
2366 {
2367 j++;
2368 }
2369 }
2370 }
2371
2372 matrix Temp=mp_Transp((matrix) id_Vec2Ideal(r, currRing), currRing);
2373 matrix R=mpNew(MATCOLS((matrix) id_Vec2Ideal(f, currRing)),1);
2374 for (int k=1;k<=MATROWS(Temp);k++)
2375 {
2376 MATELEM(R,k,1)=MATELEM(Temp,k,1);
2377 }
2378
2379 lists L=(lists)omAllocBin(slists_bin);
2380 L->Init(2);
2381 L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
2382 L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
2383 res->data=L;
2384 res->rtyp=LIST_CMD;
2385 // iv aufraeumen
2386 omFree(iv);
2387 return FALSE;
2388 }
2389 else
2390 return TRUE;
2391 }
2392 else
2393 /*==================== poly debug ==================================*/
2394 if(strcmp(sys_cmd,"p")==0)
2395 {
2396 # ifdef RDEBUG
2397 p_DebugPrint((poly)h->Data(), currRing);
2398 # else
2399 WarnS("Sorry: not available for release build!");
2400 # endif
2401 return FALSE;
2402 }
2403 else
2404 /*==================== setsyzcomp ==================================*/
2405 if(strcmp(sys_cmd,"setsyzcomp")==0)
2406 {
2407 if ((h!=NULL) && (h->Typ()==INT_CMD))
2408 {
2409 int k = (int)(long)h->Data();
2410 if ( currRing->order[0] == ringorder_s )
2411 {
2412 rSetSyzComp(k, currRing);
2413 }
2414 }
2415 }
2416 /*==================== ring debug ==================================*/
2417 if(strcmp(sys_cmd,"r")==0)
2418 {
2419 # ifdef RDEBUG
2420 rDebugPrint((ring)h->Data());
2421 # else
2422 WarnS("Sorry: not available for release build!");
2423 # endif
2424 return FALSE;
2425 }
2426 else
2427 /*==================== changeRing ========================*/
2428 /* The following code changes the names of the variables in the
2429 current ring to "x1", "x2", ..., "xN", where N is the number
2430 of variables in the current ring.
2431 The purpose of this rewriting is to eliminate indexed variables,
2432 as they may cause problems when generating scripts for Magma,
2433 Maple, or Macaulay2. */
2434 if(strcmp(sys_cmd,"changeRing")==0)
2435 {
2436 int varN = currRing->N;
2437 char h[10];
2438 for (int i = 1; i <= varN; i++)
2439 {
2440 omFree(currRing->names[i - 1]);
2441 sprintf(h, "x%d", i);
2442 currRing->names[i - 1] = omStrDup(h);
2443 }
2444 rComplete(currRing);
2445 res->rtyp = INT_CMD;
2446 res->data = (void*)0L;
2447 return FALSE;
2448 }
2449 else
2450 /*==================== mtrack ==================================*/
2451 if(strcmp(sys_cmd,"mtrack")==0)
2452 {
2453 #ifdef OM_TRACK
2454 om_Opts.MarkAsStatic = 1;
2455 FILE *fd = NULL;
2456 int max = 5;
2457 while (h != NULL)
2458 {
2459 omMarkAsStaticAddr(h);
2460 if (fd == NULL && h->Typ()==STRING_CMD)
2461 {
2462 char *fn=(char*) h->Data();
2463 fd = fopen(fn, "w");
2464 if (fd == NULL)
2465 Warn("Can not open %s for writing og mtrack. Using stdout",fn);
2466 }
2467 else if (h->Typ() == INT_CMD)
2468 {
2469 max = (int)(long)h->Data();
2470 }
2471 h = h->Next();
2472 }
2473 omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2474 if (fd != NULL) fclose(fd);
2475 om_Opts.MarkAsStatic = 0;
2476 return FALSE;
2477 #else
2478 WerrorS("system(\"mtrack\",..) is not implemented in this version");
2479 return TRUE;
2480 #endif
2481 }
2482 else
2483 /*==================== backtrace ==================================*/
2484 #ifndef OM_NDEBUG
2485 if(strcmp(sys_cmd,"backtrace")==0)
2486 {
2487 omPrintCurrentBackTrace(stdout);
2488 return FALSE;
2489 }
2490 else
2491 #endif
2492
2493 #if !defined(OM_NDEBUG)
2494 /*==================== omMemoryTest ==================================*/
2495 if (strcmp(sys_cmd,"omMemoryTest")==0)
2496 {
2497
2498 #ifdef OM_STATS_H
2499 PrintS("\n[om_Info]: \n");
2500 omUpdateInfo();
2501 #define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2502 OM_PRINT(MaxBytesSystem);
2503 OM_PRINT(CurrentBytesSystem);
2504 OM_PRINT(MaxBytesSbrk);
2505 OM_PRINT(CurrentBytesSbrk);
2506 OM_PRINT(MaxBytesMmap);
2507 OM_PRINT(CurrentBytesMmap);
2508 OM_PRINT(UsedBytes);
2509 OM_PRINT(AvailBytes);
2510 OM_PRINT(UsedBytesMalloc);
2511 OM_PRINT(AvailBytesMalloc);
2512 OM_PRINT(MaxBytesFromMalloc);
2513 OM_PRINT(CurrentBytesFromMalloc);
2514 OM_PRINT(MaxBytesFromValloc);
2515 OM_PRINT(CurrentBytesFromValloc);
2516 OM_PRINT(UsedBytesFromValloc);
2517 OM_PRINT(AvailBytesFromValloc);
2518 OM_PRINT(MaxPages);
2519 OM_PRINT(UsedPages);
2520 OM_PRINT(AvailPages);
2521 OM_PRINT(MaxRegionsAlloc);
2522 OM_PRINT(CurrentRegionsAlloc);
2523 #undef OM_PRINT
2524 #endif
2525
2526 #ifdef OM_OPTS_H
2527 PrintS("\n[om_Opts]: \n");
2528 #define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2529 OM_PRINT("d", MinTrack);
2530 OM_PRINT("d", MinCheck);
2531 OM_PRINT("d", MaxTrack);
2532 OM_PRINT("d", MaxCheck);
2533 OM_PRINT("d", Keep);
2534 OM_PRINT("d", HowToReportErrors);
2535 OM_PRINT("d", MarkAsStatic);
2536 OM_PRINT("u", PagesPerRegion);
2537 OM_PRINT("p", OutOfMemoryFunc);
2538 OM_PRINT("p", MemoryLowFunc);
2539 OM_PRINT("p", ErrorHook);
2540 #undef OM_PRINT
2541 #endif
2542
2543 #ifdef OM_ERROR_H
2544 Print("\n\n[om_ErrorStatus] : '%s' (%s)\n",
2545 omError2String(om_ErrorStatus),
2546 omError2Serror(om_ErrorStatus));
2547 Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2548 omError2String(om_InternalErrorStatus),
2549 omError2Serror(om_InternalErrorStatus));
2550
2551 #endif
2552
2553 // omTestMemory(1);
2554 // omtTestErrors();
2555 return FALSE;
2556 }
2557 else
2558 #endif
2559 /*==================== pDivStat =============================*/
2560 #if defined(PDEBUG) || defined(PDIV_DEBUG)
2561 if(strcmp(sys_cmd,"pDivStat")==0)
2562 {
2563 extern void pPrintDivisbleByStat();
2564 pPrintDivisbleByStat();
2565 return FALSE;
2566 }
2567 else
2568 #endif
2569 /*==================== red =============================*/
2570 #if 0
2571 if(strcmp(sys_cmd,"red")==0)
2572 {
2573 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2574 {
2575 res->rtyp=IDEAL_CMD;
2576 res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2577 setFlag(res,FLAG_STD);
2578 return FALSE;
2579 }
2580 else
2581 WerrorS("ideal expected");
2582 }
2583 else
2584 #endif
2585 /*==================== fastcomb =============================*/
2586 if(strcmp(sys_cmd,"fastcomb")==0)
2587 {
2588 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2589 {
2590 if (h->next!=NULL)
2591 {
2592 if (h->next->Typ()!=POLY_CMD)
2593 {
2594 WarnS("Wrong types for poly= comb(ideal,poly)");
2595 }
2596 }
2597 res->rtyp=POLY_CMD;
2598 res->data=(void *) fglmLinearCombination(
2599 (ideal)h->Data(),(poly)h->next->Data());
2600 return FALSE;
2601 }
2602 else
2603 WerrorS("ideal expected");
2604 }
2605 else
2606 /*==================== comb =============================*/
2607 if(strcmp(sys_cmd,"comb")==0)
2608 {
2609 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2610 {
2611 if (h->next!=NULL)
2612 {
2613 if (h->next->Typ()!=POLY_CMD)
2614 {
2615 WarnS("Wrong types for poly= comb(ideal,poly)");
2616 }
2617 }
2618 res->rtyp=POLY_CMD;
2619 res->data=(void *)fglmNewLinearCombination(
2620 (ideal)h->Data(),(poly)h->next->Data());
2621 return FALSE;
2622 }
2623 else
2624 WerrorS("ideal expected");
2625 }
2626 else
2627 #if 0 /* debug only */
2628 /*==================== listall ===================================*/
2629 if(strcmp(sys_cmd,"listall")==0)
2630 {
2631 void listall(int showproc);
2632 int showproc=0;
2633 if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2634 listall(showproc);
2635 return FALSE;
2636 }
2637 else
2638 #endif
2639 #if 0 /* debug only */
2640 /*==================== proclist =================================*/
2641 if(strcmp(sys_cmd,"proclist")==0)
2642 {
2643 void piShowProcList();
2644 piShowProcList();
2645 return FALSE;
2646 }
2647 else
2648 #endif
2649 /* ==================== newton ================================*/
2650 #ifdef HAVE_NEWTON
2651 if(strcmp(sys_cmd,"newton")==0)
2652 {
2653 if ((h->Typ()!=POLY_CMD)
2654 || (h->next->Typ()!=INT_CMD)
2655 || (h->next->next->Typ()!=INT_CMD))
2656 {
2657 WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2658 return TRUE;
2659 }
2660 poly p=(poly)(h->Data());
2661 int l=pLength(p);
2662 short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2663 int i,j,k;
2664 k=0;
2665 poly pp=p;
2666 for (i=0;pp!=NULL;i++)
2667 {
2668 for(j=1;j<=currRing->N;j++)
2669 {
2670 points[k]=pGetExp(pp,j);
2671 k++;
2672 }
2673 pIter(pp);
2674 }
2675 hc_ERG r=hc_KOENIG(currRing->N, // dimension
2676 l, // number of points
2677 (short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2678 currRing->OrdSgn==-1,
2679 (int) (h->next->Data()), // 1: Milnor, 0: Newton
2680 (int) (h->next->next->Data()) // debug
2681 );
2682 //----<>---Output-----------------------
2683
2684
2685 // PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2686
2687
2688 lists L=(lists)omAllocBin(slists_bin);
2689 L->Init(6);
2690 L->m[0].rtyp=STRING_CMD; // newtonnumber;
2691 L->m[0].data=(void *)omStrDup(r.nZahl);
2692 L->m[1].rtyp=INT_CMD;
2693 L->m[1].data=(void *)(long)r.achse; // flag for unoccupied axes
2694 L->m[2].rtyp=INT_CMD;
2695 L->m[2].data=(void *)(long)r.deg; // #degenerations
2696 if ( r.deg != 0) // only if degenerations exist
2697 {
2698 L->m[3].rtyp=INT_CMD;
2699 L->m[3].data=(void *)(long)r.anz_punkte; // #points
2700 //---<>--number of points------
2701 int anz = r.anz_punkte; // number of points
2702 int dim = (currRing->N); // dimension
2703 intvec* v = new intvec( anz*dim );
2704 for (i=0; i<anz*dim; i++) // copy points
2705 (*v)[i] = r.pu[i];
2706 L->m[4].rtyp=INTVEC_CMD;
2707 L->m[4].data=(void *)v;
2708 //---<>--degenerations---------
2709 int deg = r.deg; // number of points
2710 intvec* w = new intvec( r.speicher ); // necessary memory
2711 i=0; // start copying
2712 do
2713 {
2714 (*w)[i] = r.deg_tab[i];
2715 i++;
2716 }
2717 while (r.deg_tab[i-1] != -2); // mark for end of list
2718 L->m[5].rtyp=INTVEC_CMD;
2719 L->m[5].data=(void *)w;
2720 }
2721 else
2722 {
2723 L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2724 L->m[4].rtyp=DEF_CMD;
2725 L->m[5].rtyp=DEF_CMD;
2726 }
2727
2728 res->data=(void *)L;
2729 res->rtyp=LIST_CMD;
2730 // free all pointer in r:
2731 delete[] r.nZahl;
2732 delete[] r.pu;
2733 delete[] r.deg_tab; // Ist das ein Problem??
2734
2735 omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2736 return FALSE;
2737 }
2738 else
2739 #endif
2740 /*==== connection to Sebastian Jambor's code ======*/
2741 /* This code connects Sebastian Jambor's code for
2742 computing the minimal polynomial of an (n x n) matrix
2743 with entries in F_p to SINGULAR. Two conversion methods
2744 are needed; see further up in this file:
2745 (1) conversion of a matrix with long entries to
2746 a SINGULAR matrix with number entries, where
2747 the numbers are coefficients in currRing;
2748 (2) conversion of an array of longs (encoding the
2749 coefficients of the minimal polynomial) to a
2750 SINGULAR poly living in currRing. */
2751 if (strcmp(sys_cmd, "minpoly") == 0)
2752 {
2753 if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2754 {
2755 Werror("expected exactly one argument: %s",
2756 "a square matrix with number entries");
2757 return TRUE;
2758 }
2759 else
2760 {
2761 matrix m = (matrix)h->Data();
2762 int n = m->rows();
2763 unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2764 if (n != m->cols())
2765 {
2766 WerrorS("expected exactly one argument: "
2767 "a square matrix with number entries");
2768 return TRUE;
2769 }
2770 unsigned long** ml = singularMatrixToLongMatrix(m);
2771 unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2772 poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2773 res->rtyp = POLY_CMD;
2774 res->data = (void *)theMinPoly;
2775 for (int i = 0; i < n; i++) delete[] ml[i];
2776 delete[] ml;
2777 delete[] polyCoeffs;
2778 return FALSE;
2779 }
2780 }
2781 else
2782 /*==================== sdb_flags =================*/
2783 #ifdef HAVE_SDB
2784 if (strcmp(sys_cmd, "sdb_flags") == 0)
2785 {
2786 if ((h!=NULL) && (h->Typ()==INT_CMD))
2787 {
2788 sdb_flags=(int)((long)h->Data());
2789 }
2790 else
2791 {
2792 WerrorS("system(\"sdb_flags\",`int`) expected");
2793 return TRUE;
2794 }
2795 return FALSE;
2796 }
2797 else
2798 #endif
2799 /*==================== sdb_edit =================*/
2800 #ifdef HAVE_SDB
2801 if (strcmp(sys_cmd, "sdb_edit") == 0)
2802 {
2803 if ((h!=NULL) && (h->Typ()==PROC_CMD))
2804 {
2805 procinfov p=(procinfov)h->Data();
2806 sdb_edit(p);
2807 }
2808 else
2809 {
2810 WerrorS("system(\"sdb_edit\",`proc`) expected");
2811 return TRUE;
2812 }
2813 return FALSE;
2814 }
2815 else
2816 #endif
2817 /*==================== GF =================*/
2818 #if 0 // for testing only
2819 if (strcmp(sys_cmd, "GF") == 0)
2820 {
2821 if ((h!=NULL) && (h->Typ()==POLY_CMD))
2822 {
2823 int c=rChar(currRing);
2824 setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2825 CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2826 res->rtyp=POLY_CMD;
2827 res->data=convFactoryGFSingGF( F, currRing );
2828 return FALSE;
2829 }
2830 else { WerrorS("wrong typ"); return TRUE;}
2831 }
2832 else
2833 #endif
2834 /*==================== SVD =================*/
2835 #ifdef HAVE_SVD
2836 if (strcmp(sys_cmd, "svd") == 0)
2837 {
2838 extern lists testsvd(matrix M);
2839 res->rtyp=LIST_CMD;
2840 res->data=(char*)(testsvd((matrix)h->Data()));
2841 return FALSE;
2842 }
2843 else
2844 #endif
2845 /*==================== redNF_ring =================*/
2846 #ifdef HAVE_RINGS
2847 if (strcmp(sys_cmd, "redNF_ring")==0)
2848 {
2849 ring r = currRing;
2850 poly f = (poly) h->Data();
2851 h = h->next;
2852 ideal G = (ideal) h->Data();
2853 res->rtyp=POLY_CMD;
2854 res->data=(poly) ringRedNF(f, G, r);
2855 return(FALSE);
2856 }
2857 else
2858 #endif
2859 /*==================== Roune Hilb =================*/
2860 if (strcmp(sys_cmd, "hilbroune") == 0)
2861 {
2862 if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2863 {
2864 slicehilb((ideal)h->Data());
2865 }
2866 else return TRUE;
2867 return FALSE;
2868 }
2869 else
2870 /*==================== F5 Implementation =================*/
2871 #ifdef HAVE_F5
2872 if (strcmp(sys_cmd, "f5")==0)
2873 {
2874 if (h->Typ()!=IDEAL_CMD)
2875 {
2876 WerrorS("ideal expected");
2877 return TRUE;
2878 }
2879
2880 ring r = currRing;
2881 ideal G = (ideal) h->Data();
2882 h = h->next;
2883 int opt;
2884 if(h != NULL) {
2885 opt = (int) (long) h->Data();
2886 }
2887 else {
2888 opt = 2;
2889 }
2890 h = h->next;
2891 int plus;
2892 if(h != NULL) {
2893 plus = (int) (long) h->Data();
2894 }
2895 else {
2896 plus = 0;
2897 }
2898 h = h->next;
2899 int termination;
2900 if(h != NULL) {
2901 termination = (int) (long) h->Data();
2902 }
2903 else {
2904 termination = 0;
2905 }
2906 res->rtyp=IDEAL_CMD;
2907 res->data=(ideal) F5main(G,r,opt,plus,termination);
2908 return FALSE;
2909 }
2910 else
2911 #endif
2912 /*==================== Testing groebner basis =================*/
2913 #ifdef HAVE_RINGS
2914 if (strcmp(sys_cmd, "NF_ring")==0)
2915 {
2916 ring r = currRing;
2917 poly f = (poly) h->Data();
2918 h = h->next;
2919 ideal G = (ideal) h->Data();
2920 res->rtyp=POLY_CMD;
2921 res->data=(poly) ringNF(f, G, r);
2922 return(FALSE);
2923 }
2924 else
2925 if (strcmp(sys_cmd, "spoly")==0)
2926 {
2927 poly f = pCopy((poly) h->Data());
2928 h = h->next;
2929 poly g = pCopy((poly) h->Data());
2930
2931 res->rtyp=POLY_CMD;
2932 res->data=(poly) plain_spoly(f,g);
2933 return(FALSE);
2934 }
2935 else
2936 if (strcmp(sys_cmd, "testGB")==0)
2937 {
2938 ideal I = (ideal) h->Data();
2939 h = h->next;
2940 ideal GI = (ideal) h->Data();
2941 res->rtyp = INT_CMD;
2942 res->data = (void *)(long) testGB(I, GI);
2943 return(FALSE);
2944 }
2945 else
2946 #endif
2947 /*==================== sca:AltVar ==================================*/
2948 #ifdef HAVE_PLURAL
2949 if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
2950 {
2951 ring r = currRing;
2952
2953 if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
2954 {
2955 WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
2956 return TRUE;
2957 }
2958
2959 res->rtyp=INT_CMD;
2960
2961 if (rIsSCA(r))
2962 {
2963 if(strcmp(sys_cmd, "AltVarStart") == 0)
2964 res->data = (void*)(long)scaFirstAltVar(r);
2965 else
2966 res->data = (void*)(long)scaLastAltVar(r);
2967 return FALSE;
2968 }
2969
2970 WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
2971 return TRUE;
2972 }
2973 else
2974 #endif
2975 /*==================== RatNF, noncomm rational coeffs =================*/
2976 #ifdef HAVE_RATGRING
2977 if (strcmp(sys_cmd, "intratNF") == 0)
2978 {
2979 poly p;
2980 poly *q;
2981 ideal I;
2982 int is, k, id;
2983 if ((h!=NULL) && (h->Typ()==POLY_CMD))
2984 {
2985 p=(poly)h->CopyD();
2986 h=h->next;
2987 // PrintS("poly is done\n");
2988 }
2989 else return TRUE;
2990 if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2991 {
2992 I=(ideal)h->CopyD();
2993 q = I->m;
2994 h=h->next;
2995 // PrintS("ideal is done\n");
2996 }
2997 else return TRUE;
2998 if ((h!=NULL) && (h->Typ()==INT_CMD))
2999 {
3000 is=(int)((long)(h->Data()));
3001 // res->rtyp=INT_CMD;
3002 // PrintS("int is done\n");
3003 // res->rtyp=IDEAL_CMD;
3004 if (rIsPluralRing(currRing))
3005 {
3006 id = IDELEMS(I);
3007 int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3008 for(k=0; k < id; k++)
3009 {
3010 pl[k] = pLength(I->m[k]);
3011 }
3012 PrintS("starting redRat\n");
3013 //res->data = (char *)
3014 redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3015 res->data=p;
3016 res->rtyp=POLY_CMD;
3017 // res->data = ncGCD(p,q,currRing);
3018 }
3019 else
3020 {
3021 res->rtyp=POLY_CMD;
3022 res->data=p;
3023 }
3024 }
3025 else return TRUE;
3026 return FALSE;
3027 }
3028 else
3029 /*==================== RatNF, noncomm rational coeffs =================*/
3030 if (strcmp(sys_cmd, "ratNF") == 0)
3031 {
3032 poly p,q;
3033 int is, htype;
3034 if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3035 {
3036 p=(poly)h->CopyD();
3037 h=h->next;
3038 htype = h->Typ();
3039 }
3040 else return TRUE;
3041 if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3042 {
3043 q=(poly)h->CopyD();
3044 h=h->next;
3045 }
3046 else return TRUE;
3047 if ((h!=NULL) && (h->Typ()==INT_CMD))
3048 {
3049 is=(int)((long)(h->Data()));
3050 res->rtyp=htype;
3051 // res->rtyp=IDEAL_CMD;
3052 if (rIsPluralRing(currRing))
3053 {
3054 res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3055 // res->data = ncGCD(p,q,currRing);
3056 }
3057 else res->data=p;
3058 }
3059 else return TRUE;
3060 return FALSE;
3061 }
3062 else
3063 /*==================== RatSpoly, noncomm rational coeffs =================*/
3064 if (strcmp(sys_cmd, "ratSpoly") == 0)
3065 {
3066 poly p,q;
3067 int is;
3068 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3069 {
3070 p=(poly)h->CopyD();
3071 h=h->next;
3072 }
3073 else return TRUE;
3074 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3075 {
3076 q=(poly)h->CopyD();
3077 h=h->next;
3078 }
3079 else return TRUE;
3080 if ((h!=NULL) && (h->Typ()==INT_CMD))
3081 {
3082 is=(int)((long)(h->Data()));
3083 res->rtyp=POLY_CMD;
3084 // res->rtyp=IDEAL_CMD;
3085 if (rIsPluralRing(currRing))
3086 {
3087 res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3088 // res->data = ncGCD(p,q,currRing);
3089 }
3090 else res->data=p;
3091 }
3092 else return TRUE;
3093 return FALSE;
3094 }
3095 else
3096 #endif // HAVE_RATGRING
3097 /*==================== Rat def =================*/
3098 if (strcmp(sys_cmd, "ratVar") == 0)
3099 {
3100 int start,end;
3101 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3102 {
3103 start=pIsPurePower((poly)h->Data());
3104 h=h->next;
3105 }
3106 else return TRUE;
3107 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3108 {
3109 end=pIsPurePower((poly)h->Data());
3110 h=h->next;
3111 }
3112 else return TRUE;
3113 currRing->real_var_start=start;
3114 currRing->real_var_end=end;
3115 return (start==0)||(end==0)||(start>end);
3116 }
3117 else
3118 /*==================== t-rep-GB ==================================*/
3119 if (strcmp(sys_cmd, "unifastmult")==0)
3120 {
3121 poly f = (poly)h->Data();
3122 h=h->next;
3123 poly g=(poly)h->Data();
3124 res->rtyp=POLY_CMD;
3125 res->data=unifastmult(f,g,currRing);
3126 return(FALSE);
3127 }
3128 else
3129 if (strcmp(sys_cmd, "multifastmult")==0)
3130 {
3131 poly f = (poly)h->Data();
3132 h=h->next;
3133 poly g=(poly)h->Data();
3134 res->rtyp=POLY_CMD;
3135 res->data=multifastmult(f,g,currRing);
3136 return(FALSE);
3137 }
3138 else
3139 if (strcmp(sys_cmd, "mults")==0)
3140 {
3141 res->rtyp=INT_CMD ;
3142 res->data=(void*)(long) Mults();
3143 return(FALSE);
3144 }
3145 else
3146 if (strcmp(sys_cmd, "fastpower")==0)
3147 {
3148 ring r = currRing;
3149 poly f = (poly)h->Data();
3150 h=h->next;
3151 int n=(int)((long)h->Data());
3152 res->rtyp=POLY_CMD ;
3153 res->data=(void*) pFastPower(f,n,r);
3154 return(FALSE);
3155 }
3156 else
3157 if (strcmp(sys_cmd, "normalpower")==0)
3158 {
3159 poly f = (poly)h->Data();
3160 h=h->next;
3161 int n=(int)((long)h->Data());
3162 res->rtyp=POLY_CMD ;
3163 res->data=(void*) pPower(pCopy(f),n);
3164 return(FALSE);
3165 }
3166 else
3167 if (strcmp(sys_cmd, "MCpower")==0)
3168 {
3169 ring r = currRing;
3170 poly f = (poly)h->Data();
3171 h=h->next;
3172 int n=(int)((long)h->Data());
3173 res->rtyp=POLY_CMD ;
3174 res->data=(void*) pFastPowerMC(f,n,r);
3175 return(FALSE);
3176 }
3177 else
3178 if (strcmp(sys_cmd, "bit_subst")==0)
3179 {
3180 ring r = currRing;
3181 poly outer = (poly)h->Data();
3182 h=h->next;
3183 poly inner=(poly)h->Data();
3184 res->rtyp=POLY_CMD ;
3185 res->data=(void*) uni_subst_bits(outer, inner,r);
3186 return(FALSE);
3187 }
3188 else
3189 /*==================== gcd-varianten =================*/
3190 if (strcmp(sys_cmd, "gcd") == 0)
3191 {
3192 if (h==NULL)
3193 {
3194 #if 0
3195 Print("FLINT_P:%d (use Flints gcd for polynomials in char p)\n",isOn(SW_USE_FL_GCD_P));
3196 Print("FLINT_0:%d (use Flints gcd for polynomials in char 0)\n",isOn(SW_USE_FL_GCD_0));
3197 #endif
3198 Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3199 Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3200 Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3201 #ifndef __CYGWIN__
3202 Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3203 #endif
3204 return FALSE;
3205 }
3206 else
3207 if ((h!=NULL) && (h->Typ()==STRING_CMD)
3208 && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3209 {
3210 int d=(int)(long)h->next->Data();
3211 char *s=(char *)h->Data();
3212 #if 0
3213 if (strcmp(s,"FLINT_P")==0) { if (d) On(SW_USE_FL_GCD_P); else Off(SW_USE_FL_GCD_P); } else
3214 if (strcmp(s,"FLINT_0")==0) { if (d) On(SW_USE_FL_GCD_0); else Off(SW_USE_FL_GCD_0); } else
3215 #endif
3216 if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3217 if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3218 if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3219 #ifndef __CYGWIN__
3220 if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3221 #endif
3222 return TRUE;
3223 return FALSE;
3224 }
3225 else return TRUE;
3226 }
3227 else
3228 /*==================== subring =================*/
3229 if (strcmp(sys_cmd, "subring") == 0)
3230 {
3231 if (h!=NULL)
3232 {
3233 extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3234 res->data=(char *)rSubring(currRing,h);
3235 res->rtyp=RING_CMD;
3236 return res->data==NULL;
3237 }
3238 else return TRUE;
3239 }
3240 else
3241 /*==================== HNF =================*/
3242 #ifdef HAVE_NTL
3243 if (strcmp(sys_cmd, "HNF") == 0)
3244 {
3245 if (h!=NULL)
3246 {
3247 res->rtyp=h->Typ();
3248 if (h->Typ()==MATRIX_CMD)
3249 {
3250 res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3251 return FALSE;
3252 }
3253 else if (h->Typ()==INTMAT_CMD)
3254 {
3255 res->data=(char *)singntl_HNF((intvec*)h->Data());
3256 return FALSE;
3257 }
3258 else if (h->Typ()==INTMAT_CMD)
3259 {
3260 res->data=(char *)singntl_HNF((intvec*)h->Data());
3261 return FALSE;
3262 }
3263 else
3264 {
3265 WerrorS("expected `system(\"HNF\",<matrix|intmat|bigintmat>)`");
3266 return TRUE;
3267 }
3268 }
3269 else return TRUE;
3270 }
3271 else
3272 /*================= probIrredTest ======================*/
3273 if (strcmp (sys_cmd, "probIrredTest") == 0)
3274 {
3275 if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3276 {
3277 CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3278 char *s=(char *)h->next->Data();
3279 double error= atof (s);
3280 int irred= probIrredTest (F, error);
3281 res->rtyp= INT_CMD;
3282 res->data= (void*)(long)irred;
3283 return FALSE;
3284 }
3285 else return TRUE;
3286 }
3287 else
3288 #endif
3289 /*==================== mpz_t loader ======================*/
3290 if(strcmp(sys_cmd, "GNUmpLoad")==0)
3291 {
3292 if ((h != NULL) && (h->Typ() == STRING_CMD))
3293 {
3294 char* filename = (char*)h->Data();
3295 FILE* f = fopen(filename, "r");
3296 if (f == NULL)
3297 {
3298 WerrorS( "invalid file name (in paths use '/')");
3299 return FALSE;
3300 }
3301 mpz_t m; mpz_init(m);
3302 mpz_inp_str(m, f, 10);
3303 fclose(f);
3304 number n = n_InitMPZ(m, coeffs_BIGINT);
3305 res->rtyp = BIGINT_CMD;
3306 res->data = (void*)n;
3307 return FALSE;
3308 }
3309 else
3310 {
3311 WerrorS( "expected valid file name as a string");
3312 return TRUE;
3313 }
3314 }
3315 else
3316 /*==================== intvec matching ======================*/
3317 /* Given two non-empty intvecs, the call
3318 'system("intvecMatchingSegments", ivec, jvec);'
3319 computes all occurences of jvec in ivec, i.e., it returns
3320 a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3321 If no such k exists (e.g. when ivec is shorter than jvec), an
3322 intvec with the single entry 0 is being returned. */
3323 if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3324 {
3325 if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3326 (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3327 (h->next->next == NULL))
3328 {
3329 intvec* ivec = (intvec*)h->Data();
3330 intvec* jvec = (intvec*)h->next->Data();
3331 intvec* r = new intvec(1); (*r)[0] = 0;
3332 int validEntries = 0;
3333 for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3334 {
3335 if (memcmp(&(*ivec)[k], &(*jvec)[0],
3336 sizeof(int) * jvec->rows()) == 0)
3337 {
3338 if (validEntries == 0)
3339 (*r)[0] = k + 1;
3340 else
3341 {
3342 r->resize(validEntries + 1);
3343 (*r)[validEntries] = k + 1;
3344 }
3345 validEntries++;
3346 }
3347 }
3348 res->rtyp = INTVEC_CMD;
3349 res->data = (void*)r;
3350 return FALSE;
3351 }
3352 else
3353 {
3354 WerrorS("expected two non-empty intvecs as arguments");
3355 return TRUE;
3356 }
3357 }
3358 else
3359 /* ================== intvecOverlap ======================= */
3360 /* Given two non-empty intvecs, the call
3361 'system("intvecOverlap", ivec, jvec);'
3362 computes the longest intvec kvec such that ivec ends with kvec
3363 and jvec starts with kvec. The length of this overlap is being
3364 returned. If there is no overlap at all, then 0 is being returned. */
3365 if(strcmp(sys_cmd, "intvecOverlap")==0)
3366 {
3367 if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3368 (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3369 (h->next->next == NULL))
3370 {
3371 intvec* ivec = (intvec*)h->Data();
3372 intvec* jvec = (intvec*)h->next->Data();
3373 int ir = ivec->rows(); int jr = jvec->rows();
3374 int r = jr; if (ir < jr) r = ir; /* r = min{ir, jr} */
3375 while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0],
3376 sizeof(int) * r) != 0))
3377 r--;
3378 res->rtyp = INT_CMD;
3379 res->data = (void*)(long)r;
3380 return FALSE;
3381 }
3382 else
3383 {
3384 WerrorS("expected two non-empty intvecs as arguments");
3385 return TRUE;
3386 }
3387 }
3388 else
3389 /*==================== Hensel's lemma ======================*/
3390 if(strcmp(sys_cmd, "henselfactors")==0)
3391 {
3392 if ((h != NULL) && (h->Typ() == INT_CMD) &&
3393 (h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3394 (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3395 (h->next->next->next != NULL) &&
3396 (h->next->next->next->Typ() == POLY_CMD) &&
3397 (h->next->next->next->next != NULL) &&
3398 (h->next->next->next->next->Typ() == POLY_CMD) &&
3399 (h->next->next->next->next->next != NULL) &&
3400 (h->next->next->next->next->next->Typ() == INT_CMD) &&
3401 (h->next->next->next->next->next->next == NULL))
3402 {
3403 int xIndex = (int)(long)h->Data();
3404 int yIndex = (int)(long)h->next->Data();
3405 poly hh = (poly)h->next->next->Data();
3406 poly f0 = (poly)h->next->next->next->Data();
3407 poly g0 = (poly)h->next->next->next->next->Data();
3408 int d = (int)(long)h->next->next->next->next->next->Data();
3409 poly f; poly g;
3410 henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3411 lists L = (lists)omAllocBin(slists_bin);
3412 L->Init(2);
3413 L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3414 L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3415 res->rtyp = LIST_CMD;
3416 res->data = (char *)L;
3417 return FALSE;
3418 }
3419 else
3420 {
3421 WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3422 return TRUE;
3423 }
3424 }
3425 else
3426 /*==================== Approx_Step =================*/
3427 #ifdef HAVE_PLURAL
3428 if (strcmp(sys_cmd, "astep") == 0)
3429 {
3430 ideal I;
3431 if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3432 {
3433 I=(ideal)h->CopyD();
3434 res->rtyp=IDEAL_CMD;
3435 if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3436 else res->data=I;
3437 setFlag(res,FLAG_STD);
3438 }
3439 else return TRUE;
3440 return FALSE;
3441 }
3442 else
3443 #endif
3444 /*==================== PrintMat =================*/
3445 #ifdef HAVE_PLURAL
3446 if (strcmp(sys_cmd, "PrintMat") == 0)
3447 {
3448 int a;
3449 int b;
3450 ring r;
3451 int metric;
3452 if (h!=NULL)
3453 {
3454 if (h->Typ()==INT_CMD)
3455 {
3456 a=(int)((long)(h->Data()));
3457 h=h->next;
3458 }
3459 else if (h->Typ()==INT_CMD)
3460 {
3461 b=(int)((long)(h->Data()));
3462 h=h->next;
3463 }
3464 else if (h->Typ()==RING_CMD)
3465 {
3466 r=(ring)h->Data();
3467 h=h->next;
3468 }
3469 else
3470 return TRUE;
3471 }
3472 else
3473 return TRUE;
3474 if ((h!=NULL) && (h->Typ()==INT_CMD))
3475 {
3476 metric=(int)((long)(h->Data()));
3477 }
3478 res->rtyp=MATRIX_CMD;
3479 if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3480 else res->data=NULL;
3481 return FALSE;
3482 }
3483 else
3484 #endif
3485 /* ============ NCUseExtensions ======================== */
3486 #ifdef HAVE_PLURAL
3487 if(strcmp(sys_cmd,"NCUseExtensions")==0)
3488 {
3489 if ((h!=NULL) && (h->Typ()==INT_CMD))
3490 res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3491 else
3492 res->data=(void *)(long)getNCExtensions();
3493 res->rtyp=INT_CMD;
3494 return FALSE;
3495 }
3496 else
3497 #endif
3498 /* ============ NCGetType ======================== */
3499 #ifdef HAVE_PLURAL
3500 if(strcmp(sys_cmd,"NCGetType")==0)
3501 {
3502 res->rtyp=INT_CMD;
3503 if( rIsPluralRing(currRing) )
3504 res->data=(void *)(long)ncRingType(currRing);
3505 else
3506 res->data=(void *)(-1L);
3507 return FALSE;
3508 }
3509 else
3510 #endif
3511 /* ============ ForceSCA ======================== */
3512 #ifdef HAVE_PLURAL
3513 if(strcmp(sys_cmd,"ForceSCA")==0)
3514 {
3515 if( !rIsPluralRing(currRing) )
3516 return TRUE;
3517 int b, e;
3518 if ((h!=NULL) && (h->Typ()==INT_CMD))
3519 {
3520 b = (int)((long)(h->Data()));
3521 h=h->next;
3522 }
3523 else return TRUE;
3524 if ((h!=NULL) && (h->Typ()==INT_CMD))
3525 {
3526 e = (int)((long)(h->Data()));
3527 }
3528 else return TRUE;
3529 if( !sca_Force(currRing, b, e) )
3530 return TRUE;
3531 return FALSE;
3532 }
3533 else
3534 #endif
3535 /* ============ ForceNewNCMultiplication ======================== */
3536 #ifdef HAVE_PLURAL
3537 if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3538 {
3539 if( !rIsPluralRing(currRing) )
3540 return TRUE;
3541 if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3542 return TRUE;
3543 return FALSE;
3544 }
3545 else
3546 #endif
3547 /* ============ ForceNewOldNCMultiplication ======================== */
3548 #ifdef HAVE_PLURAL
3549 if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3550 {
3551 if( !rIsPluralRing(currRing) )
3552 return TRUE;
3553 if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3554 return TRUE;
3555 return FALSE;
3556 }
3557 else
3558 #endif
3559 /*==================== test64 =================*/
3560 #if 0
3561 if(strcmp(sys_cmd,"test64")==0)
3562 {
3563 long l=8;int i;
3564 for(i=1;i<62;i++)
3565 {
3566 l=l<<1;
3567 number n=n_Init(l,coeffs_BIGINT);
3568 Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3569 CanonicalForm nn=n_convSingNFactoryN(n,TRUE,coeffs_BIGINT);
3570 n_Delete(&n,coeffs_BIGINT);
3571 n=n_convFactoryNSingN(nn,coeffs_BIGINT);
3572 PrintS(" F:");
3573 n_Print(n,coeffs_BIGINT);
3574 PrintLn();
3575 n_Delete(&n,coeffs_BIGINT);
3576 }
3577 Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3578 return FALSE;
3579 }
3580 else
3581 #endif
3582 /*==================== n_SwitchChinRem =================*/
3583 if(strcmp(sys_cmd,"cache_chinrem")==0)
3584 {
3585 EXTERN_VAR int n_SwitchChinRem;
3586 Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3587 if ((h!=NULL)&&(h->Typ()==INT_CMD))
3588 n_SwitchChinRem=(int)(long)h->Data();
3589 return FALSE;
3590 }
3591 else
3592 /*==================== LU for bigintmat =================*/
3593 #ifdef SINGULAR_4_2
3594 if(strcmp(sys_cmd,"LU")==0)
3595 {
3596 if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3597 {
3598 // get the argument:
3599 bigintmat *b=(bigintmat *)h->Data();
3600 // just for tests: simply transpose
3601 bigintmat *bb=b->transpose();
3602 // return the result:
3603 res->rtyp=CMATRIX_CMD;
3604 res->data=(char*)bb;
3605 return FALSE;
3606 }
3607 else
3608 {
3609 WerrorS("system(\"LU\",<cmatrix>) expected");
3610 return TRUE;
3611 }
3612 }
3613 else
3614 #endif
3615 /*==================== sort =================*/
3616 if(strcmp(sys_cmd,"sort")==0)
3617 {
3618 extern BOOLEAN jjSORTLIST(leftv,leftv);
3619 if (h->Typ()==LIST_CMD)
3620 return jjSORTLIST(res,h);
3621 else
3622 return TRUE;
3623 }
3624 else
3625 /*==================== uniq =================*/
3626 if(strcmp(sys_cmd,"uniq")==0)
3627 {
3628 extern BOOLEAN jjUNIQLIST(leftv, leftv);
3629 if (h->Typ()==LIST_CMD)
3630 return jjUNIQLIST(res,h);
3631 else
3632 return TRUE;
3633 }
3634 else
3635 /*==================== GF(p,n) ==================================*/
3636 if(strcmp(sys_cmd,"GF")==0)
3637 {
3638 const short t[]={3,INT_CMD,INT_CMD,STRING_CMD};
3639 if (iiCheckTypes(h,t,1))
3640 {
3641 int p=(int)(long)h->Data();
3642 int n=(int)(long)h->next->Data();
3643 char *v=(char*)h->next->next->CopyD();
3644 GFInfo param;
3645 param.GFChar = p;
3646 param.GFDegree = n;
3647 param.GFPar_name = v;
3648 coeffs cf= nInitChar(n_GF, ¶m);
3649 res->rtyp=CRING_CMD;
3650 res->data=cf;
3651 return FALSE;
3652 }
3653 else
3654 return TRUE;
3655 }
3656 else
3657 /*==================== power* ==================================*/
3658 #if 0
3659 if(strcmp(sys_cmd,"power1")==0)
3660 {
3661 res->rtyp=POLY_CMD;
3662 poly f=(poly)h->CopyD();
3663 poly g=pPower(f,2000);
3664 res->data=(void *)g;
3665 return FALSE;
3666 }
3667 else
3668 if(strcmp(sys_cmd,"power2")==0)
3669 {
3670 res->rtyp=POLY_CMD;
3671 poly f=(poly)h->Data();
3672 poly g=pOne();
3673 for(int i=0;i<2000;i++)
3674 g=pMult(g,pCopy(f));
3675 res->data=(void *)g;
3676 return FALSE;
3677 }
3678 if(strcmp(sys_cmd,"power3")==0)
3679 {
3680 res->rtyp=POLY_CMD;
3681 poly f=(poly)h->Data();
3682 poly p2=pMult(pCopy(f),pCopy(f));
3683 poly p4=pMult(pCopy(p2),pCopy(p2));
3684 poly p8=pMult(pCopy(p4),pCopy(p4));
3685 poly p16=pMult(pCopy(p8),pCopy(p8));
3686 poly p32=pMult(pCopy(p16),pCopy(p16));
3687 poly p64=pMult(pCopy(p32),pCopy(p32));
3688 poly p128=pMult(pCopy(p64),pCopy(p64));
3689 poly p256=pMult(pCopy(p128),pCopy(p128));
3690 poly p512=pMult(pCopy(p256),pCopy(p256));
3691 poly p1024=pMult(pCopy(p512),pCopy(p512));
3692 poly p1536=pMult(p1024,p512);
3693 poly p1792=pMult(p1536,p256);
3694 poly p1920=pMult(p1792,p128);
3695 poly p1984=pMult(p1920,p64);
3696 poly p2000=pMult(p1984,p16);
3697 res->data=(void *)p2000;
3698 pDelete(&p2);
3699 pDelete(&p4);
3700 pDelete(&p8);
3701 //pDelete(&p16);
3702 pDelete(&p32);
3703 //pDelete(&p64);
3704 //pDelete(&p128);
3705 //pDelete(&p256);
3706 //pDelete(&p512);
3707 //pDelete(&p1024);
3708 //pDelete(&p1536);
3709 //pDelete(&p1792);
3710 //pDelete(&p1920);
3711 //pDelete(&p1984);
3712 return FALSE;
3713 }
3714 else
3715 #endif
3716 /* ccluster --------------------------------------------------------------*/
3717 #ifdef HAVE_CCLUSTER
3718 if(strcmp(sys_cmd,"ccluster")==0)
3719 {
3720 if ((currRing!=NULL)
3721 && (rField_is_Q(currRing) || rField_is_R(currRing) || rField_is_long_R(currRing)))
3722 {
3723 const short t[]={5,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3724 const short t2[]={6,POLY_CMD,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3725
3726 // printf("test t : %d\n", h->Typ()==POLY_CMD);
3727 // printf("test t : %d\n", h->next->Typ()==POLY_CMD);
3728 int pol_with_complex_coeffs=0;
3729 if (h->next->Typ()==POLY_CMD)
3730 pol_with_complex_coeffs=1;
3731
3732 if ( (pol_with_complex_coeffs==0 && iiCheckTypes(h,t,1))
3733 ||(pol_with_complex_coeffs==1 && iiCheckTypes(h,t2,1)) )
3734 {
3735 // convert first arg. to fmpq_poly_t
3736 fmpq_poly_t fre, fim;
3737 convSingPFlintP(fre,(poly)h->Data(),currRing); h=h->next;
3738 if (pol_with_complex_coeffs==1)
3739 { // convert second arg. to fmpq_poly_t
3740 convSingPFlintP(fim,(poly)h->Data(),currRing); h=h->next;
3741 }
3742 // convert box-center(re,im), box-size, epsilon
3743 fmpq_t center_re,center_im,boxsize,eps;
3744 convSingNFlintN(center_re,(number)h->Data(),currRing->cf); h=h->next;
3745 convSingNFlintN(center_im,(number)h->Data(),currRing->cf); h=h->next;
3746 convSingNFlintN(boxsize,(number)h->Data(),currRing->cf); h=h->next;
3747 convSingNFlintN(eps,(number)h->Data(),currRing->cf); h=h->next;
3748 // alloc arrays
3749 int n=fmpq_poly_length(fre);
3750 fmpq_t* re_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3751 fmpq_t* im_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3752 int *mult =(int*) omAlloc(n*sizeof(int));
3753 for(int i=0; i<n;i++)
3754 { fmpq_init(re_part[i]); fmpq_init(im_part[i]); }
3755 // call cccluster, adjust n
3756 int verbosity =0; //nothing is printed
3757 int strategy = 23; //default strategy
3758 int nn=0;
3759 long nb_threads = (long) feOptValue(FE_OPT_CPUS);
3760 strategy = strategy+(nb_threads<<6);
3761 // printf("nb threads: %ld\n", nb_threads);
3762 // printf("strategy: %ld\n", strategy);
3763 if (pol_with_complex_coeffs==0)
3764 nn=ccluster_interface_poly_real(re_part,im_part,mult,fre,center_re,center_im,boxsize,eps,strategy,verbosity);
3765 else
3766 nn=ccluster_interface_poly_real_imag(re_part,im_part,mult,fre,fim,center_re,center_im,boxsize,eps,strategy,verbosity);
3767 // convert to list
3768 lists l=(lists)omAlloc0Bin(slists_bin);
3769 l->Init(nn);
3770 for(int i=0; i<nn;i++)
3771 {
3772 lists ll=(lists)omAlloc0Bin(slists_bin);
3773 l->m[i].rtyp=LIST_CMD;
3774 l->m[i].data=ll;
3775 ll->Init(3);
3776 ll->m[0].rtyp=NUMBER_CMD;
3777 ll->m[1].rtyp=NUMBER_CMD;
3778 ll->m[2].rtyp=INT_CMD;
3779 ll->m[0].data=convFlintNSingN(re_part[i],currRing->cf);
3780 ll->m[1].data=convFlintNSingN(im_part[i],currRing->cf);
3781 ll->m[2].data=(void *)(long)mult[i];
3782 }
3783 //clear re, im, mults, fre, fim
3784 for(int i=n-1;i>=0;i--) { fmpq_clear(re_part[i]); fmpq_clear(im_part[i]); }
3785 omFree(re_part);
3786 omFree(im_part);
3787 omFree(mult);
3788 fmpq_clear(center_re); fmpq_clear(center_im); fmpq_clear(boxsize); fmpq_clear(eps);
3789 fmpq_poly_clear(fre);
3790 if (pol_with_complex_coeffs==1) fmpq_poly_clear(fim);
3791 // result
3792 res->rtyp=LIST_CMD;
3793 res->data=l;
3794 return FALSE;
3795 }
3796 }
3797 return TRUE;
3798 }
3799 else
3800 #endif
3801 /* ====== maEvalAt ============================*/
3802 if(strcmp(sys_cmd,"evaluate")==0)
3803 {
3804 extern number maEvalAt(const poly p,const number* pt, const ring r);
3805 if (h->Typ()!=POLY_CMD)
3806 {
3807 WerrorS("expected system(\"evaluate\",<poly>,..)");
3808 return TRUE;
3809 }
3810 poly p=(poly)h->Data();
3811 number *pt=(number*)omAlloc(sizeof(number)*currRing->N);
3812 for(int i=0;i<currRing->N;i++)
3813 {
3814 h=h->next;
3815 if ((h==NULL)||(h->Typ()!=NUMBER_CMD))
3816 {
3817 WerrorS("system(\"evaluate\",<poly>,<number>..) - expect number");
3818 return TRUE;
3819 }
3820 pt[i]=(number)h->Data();
3821 }
3822 res->data=maEvalAt(p,pt,currRing);
3823 res->rtyp=NUMBER_CMD;
3824 return FALSE;
3825 }
3826 else
3827 /*==================== Error =================*/
3828 Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3829 }
3830 return TRUE;
3831 }
3832
3833 #endif // HAVE_EXTENDED_SYSTEM
3834
3835
3836