Changeset 0db91e in git for Singular/extra.cc
- Timestamp:
- Oct 4, 2014, 4:32:39 PM (10 years ago)
- Branches:
- (u'fieker-DuVal', '117eb8c30fc9e991c4decca4832b1d19036c4c65')(u'spielwiese', '38dfc5131670d387a89455159ed1e071997eec94')
- Children:
- feb8e6b55c7f02e79c4e3bb3221f82a9a718c3b0
- Parents:
- fc5cd7a315afd36382127c7f65c59c4543b58d96
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Singular/extra.cc
rfc5cd7 r0db91e 8 8 #define HAVE_WALK 1 9 9 10 11 12 13 10 #include <kernel/mod2.h> 14 11 #include <misc/auxiliary.h> … … 16 13 17 14 #include <factory/factory.h> 18 19 15 20 16 #include <stdlib.h> … … 120 116 #endif 121 117 122 123 118 #ifdef HAVE_SPECTRUM 124 119 #include <kernel/spectrum/spectrum.h> … … 145 140 146 141 // Define to enable many more system commands 147 #undef MAKE_DISTRIBUTION142 //#undef MAKE_DISTRIBUTION 148 143 #ifndef MAKE_DISTRIBUTION 149 144 #define HAVE_EXTENDED_SYSTEM 1 … … 314 309 else 315 310 316 317 318 319 311 /*==================== gen ==================================*/ 320 312 // // This seems to be obsolette...?! … … 330 322 if(strcmp(sys_cmd,"sh")==0) 331 323 { 332 if (feOptValue(FE_OPT_NO_SHELL)) { 333 WerrorS("shell execution is disallowed in restricted mode"); 334 return TRUE; 335 } 324 if (feOptValue(FE_OPT_NO_SHELL)) 325 { 326 WerrorS("shell execution is disallowed in restricted mode"); 327 return TRUE; 328 } 336 329 res->rtyp=INT_CMD; 337 330 if (h==NULL) res->data = (void *)(long) system("sh"); … … 420 413 else if (h->Typ()==STRING_CMD) 421 414 { 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 415 #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else 416 char *s=(char *)h->Data(); 417 res->rtyp=INT_CMD; 418 #ifdef HAVE_DBM 419 TEST_FOR("DBM") 420 #endif 421 #ifdef HAVE_DLD 422 TEST_FOR("DLD") 423 #endif 424 //TEST_FOR("factory") 425 //TEST_FOR("libfac") 426 #ifdef HAVE_READLINE 427 TEST_FOR("readline") 428 #endif 429 #ifdef TEST_MAC_ORDER 430 TEST_FOR("MAC_ORDER") 431 #endif 432 // unconditional since 3-1-0-6 433 TEST_FOR("Namespaces") 434 #ifdef HAVE_DYNAMIC_LOADING 435 TEST_FOR("DynamicLoading") 436 #endif 437 #ifdef HAVE_EIGENVAL 438 TEST_FOR("eigenval") 439 #endif 440 #ifdef HAVE_GMS 441 TEST_FOR("gms") 442 #endif 443 #ifdef OM_NDEBUG 444 TEST_FOR("om_ndebug") 445 #endif 446 #ifdef SING_NDEBUG 447 TEST_FOR("ndebug") 448 #endif 449 {}; 457 450 return FALSE; 458 #undef TEST_FOR 459 } 451 #undef TEST_FOR 452 } 453 return TRUE; 454 } 455 else 456 /*==================== browsers ==================================*/ 457 if (strcmp(sys_cmd,"browsers")==0) 458 { 459 res->rtyp = STRING_CMD; 460 StringSetS(""); 461 feStringAppendBrowsers(0); 462 res->data = StringEndS(); 463 return FALSE; 464 } 465 else 466 /*==================== pid ==================================*/ 467 if (strcmp(sys_cmd,"pid")==0) 468 { 469 res->rtyp=INT_CMD; 470 res->data=(void *)(long) getpid(); 471 return FALSE; 472 } 473 else 474 /*==================== getenv ==================================*/ 475 if (strcmp(sys_cmd,"getenv")==0) 476 { 477 if ((h!=NULL) && (h->Typ()==STRING_CMD)) 478 { 479 res->rtyp=STRING_CMD; 480 const char *r=getenv((char *)h->Data()); 481 if (r==NULL) r=""; 482 res->data=(void *)omStrDup(r); 483 return FALSE; 484 } 485 else 486 { 487 WerrorS("string expected"); 460 488 return TRUE; 461 489 } 462 else 463 /*==================== browsers ==================================*/ 464 if (strcmp(sys_cmd,"browsers")==0) 465 { 466 res->rtyp = STRING_CMD; 467 StringSetS(""); 468 feStringAppendBrowsers(0); 469 res->data = StringEndS(); 470 return FALSE; 471 } 472 else 473 /*==================== pid ==================================*/ 474 if (strcmp(sys_cmd,"pid")==0) 475 { 476 res->rtyp=INT_CMD; 477 res->data=(void *)(long) getpid(); 478 return FALSE; 479 } 480 else 481 /*==================== getenv ==================================*/ 482 if (strcmp(sys_cmd,"getenv")==0) 483 { 484 if ((h!=NULL) && (h->Typ()==STRING_CMD)) 485 { 486 res->rtyp=STRING_CMD; 487 const char *r=getenv((char *)h->Data()); 488 if (r==NULL) r=""; 489 res->data=(void *)omStrDup(r); 490 } 491 else 492 /*==================== setenv ==================================*/ 493 if (strcmp(sys_cmd,"setenv")==0) 494 { 495 #ifdef HAVE_SETENV 496 if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL && 497 h->next != NULL && h->next->Typ() == STRING_CMD 498 && h->next->Data() != NULL) 499 { 500 res->rtyp=STRING_CMD; 501 setenv((char *)h->Data(), (char *)h->next->Data(), 1); 502 res->data=(void *)omStrDup((char *)h->next->Data()); 503 feReInitResources(); 504 return FALSE; 505 } 506 else 507 { 508 WerrorS("two strings expected"); 509 return TRUE; 510 } 511 #else 512 WerrorS("setenv not supported on this platform"); 513 return TRUE; 514 #endif 515 } 516 else 517 /*==================== Singular ==================================*/ 518 if (strcmp(sys_cmd, "Singular") == 0) 519 { 520 res->rtyp=STRING_CMD; 521 const char *r=feResource("Singular"); 522 if (r == NULL) r=""; 523 res->data = (void*) omStrDup( r ); 524 return FALSE; 525 } 526 else 527 if (strcmp(sys_cmd, "SingularLib") == 0) 528 { 529 res->rtyp=STRING_CMD; 530 const char *r=feResource("SearchPath"); 531 if (r == NULL) r=""; 532 res->data = (void*) omStrDup( r ); 533 return FALSE; 534 } 535 else 536 /*==================== options ==================================*/ 537 if (strstr(sys_cmd, "--") == sys_cmd) 538 { 539 if (strcmp(sys_cmd, "--") == 0) 540 { 541 fePrintOptValues(); 542 return FALSE; 543 } 544 feOptIndex opt = feGetOptIndex(&sys_cmd[2]); 545 if (opt == FE_OPT_UNDEF) 546 { 547 Werror("Unknown option %s", sys_cmd); 548 WerrorS("Use 'system(\"--\");' for listing of available options"); 549 return TRUE; 550 } 551 // for Untyped Options (help version), 552 // setting it just triggers action 553 if (feOptSpec[opt].type == feOptUntyped) 554 { 555 feSetOptValue(opt,0); 556 return FALSE; 557 } 558 if (h == NULL) 559 { 560 if (feOptSpec[opt].type == feOptString) 561 { 562 res->rtyp = STRING_CMD; 563 const char *r=(const char*)feOptSpec[opt].value; 564 if (r == NULL) r=""; 565 res->data = omStrDup(r); 566 } 567 else 568 { 569 res->rtyp = INT_CMD; 570 res->data = feOptSpec[opt].value; 571 } 572 return FALSE; 573 } 574 if (h->Typ() != STRING_CMD && 575 h->Typ() != INT_CMD) 576 { 577 WerrorS("Need string or int argument to set option value"); 578 return TRUE; 579 } 580 const char* errormsg; 581 if (h->Typ() == INT_CMD) 582 { 583 if (feOptSpec[opt].type == feOptString) 584 { 585 Werror("Need string argument to set value of option %s", sys_cmd); 586 return TRUE; 587 } 588 errormsg = feSetOptValue(opt, (int)((long) h->Data())); 589 if (errormsg != NULL) 590 Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg); 591 } 592 else 593 { 594 errormsg = feSetOptValue(opt, (char*) h->Data()); 595 if (errormsg != NULL) 596 Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg); 597 } 598 if (errormsg != NULL) return TRUE; 599 return FALSE; 600 } 601 else 602 /*==================== HC ==================================*/ 603 if (strcmp(sys_cmd,"HC")==0) 604 { 605 res->rtyp=INT_CMD; 606 res->data=(void *)(long) HCord; 607 return FALSE; 608 } 609 else 610 /*==================== random ==================================*/ 611 if(strcmp(sys_cmd,"random")==0) 612 { 613 if ((h!=NULL) &&(h->Typ()==INT_CMD)) 614 { 615 siRandomStart=(int)((long)h->Data()); 616 siSeed=siRandomStart; 617 factoryseed(siRandomStart); 618 return FALSE; 619 } 620 else if (h != NULL) 621 { 622 WerrorS("int expected"); 623 return TRUE; 624 } 625 res->rtyp=INT_CMD; 626 res->data=(void*)(long) siRandomStart; 627 return FALSE; 628 } 629 else 630 /*==================== complexNearZero ======================*/ 631 if(strcmp(sys_cmd,"complexNearZero")==0) 632 { 633 if (h->Typ()==NUMBER_CMD ) 634 { 635 if ( h->next!=NULL && h->next->Typ()==INT_CMD ) 636 { 637 if ( !rField_is_long_C(currRing) ) 638 { 639 WerrorS( "unsupported ground field!"); 640 return TRUE; 641 } 642 else 643 { 644 res->rtyp=INT_CMD; 645 res->data=(void*)complexNearZero((gmp_complex*)h->Data(), 646 (int)((long)(h->next->Data()))); 647 return FALSE; 648 } 649 } 650 else 651 { 652 WerrorS( "expected <int> as third parameter!"); 653 return TRUE; 654 } 655 } 656 else 657 { 658 WerrorS( "expected <number> as second parameter!"); 659 return TRUE; 660 } 661 } 662 else 663 /*==================== getPrecDigits ======================*/ 664 if(strcmp(sys_cmd,"getPrecDigits")==0) 665 { 666 if ( !rField_is_long_C(currRing) && !rField_is_long_R(currRing) ) 667 { 668 WerrorS( "unsupported ground field!"); 669 return TRUE; 670 } 671 res->rtyp=INT_CMD; 672 res->data=(void*)(long)gmp_output_digits; 673 //if (gmp_output_digits!=getGMPFloatDigits()) 674 //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);} 675 return FALSE; 676 } 677 else 678 /*==================== mpz_t loader ======================*/ 679 if(strcmp(sys_cmd, "GNUmpLoad")==0) 680 { 681 if ((h != NULL) && (h->Typ() == STRING_CMD)) 682 { 683 char* filename = (char*)h->Data(); 684 FILE* f = fopen(filename, "r"); 685 if (f == NULL) 686 { 687 WerrorS( "invalid file name (in paths use '/')"); 490 688 return FALSE; 491 689 } 492 else 493 { 494 WerrorS("string expected"); 495 return TRUE; 496 } 497 } 498 else 499 /*==================== setenv ==================================*/ 500 if (strcmp(sys_cmd,"setenv")==0) 501 { 502 #ifdef HAVE_SETENV 503 if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL && 504 h->next != NULL && h->next->Typ() == STRING_CMD 505 && h->next->Data() != NULL) 506 { 507 res->rtyp=STRING_CMD; 508 setenv((char *)h->Data(), (char *)h->next->Data(), 1); 509 res->data=(void *)omStrDup((char *)h->next->Data()); 510 feReInitResources(); 511 return FALSE; 512 } 513 else 514 { 515 WerrorS("two strings expected"); 516 return TRUE; 517 } 518 #else 519 WerrorS("setenv not supported on this platform"); 690 mpz_t m; mpz_init(m); 691 mpz_inp_str(m, f, 10); 692 fclose(f); 693 number n = n_InitMPZ(m, coeffs_BIGINT); 694 res->rtyp = BIGINT_CMD; 695 res->data = (void*)n; 696 return FALSE; 697 } 698 else 699 { 700 WerrorS( "expected valid file name as a string"); 520 701 return TRUE; 521 #endif 522 } 523 else 524 /*==================== Singular ==================================*/ 525 if (strcmp(sys_cmd, "Singular") == 0) 526 { 527 res->rtyp=STRING_CMD; 528 const char *r=feResource("Singular"); 529 if (r == NULL) r=""; 530 res->data = (void*) omStrDup( r ); 531 return FALSE; 532 } 533 else 534 if (strcmp(sys_cmd, "SingularLib") == 0) 535 { 536 res->rtyp=STRING_CMD; 537 const char *r=feResource("SearchPath"); 538 if (r == NULL) r=""; 539 res->data = (void*) omStrDup( r ); 540 return FALSE; 541 } 542 else 543 /*==================== options ==================================*/ 544 if (strstr(sys_cmd, "--") == sys_cmd) 545 { 546 if (strcmp(sys_cmd, "--") == 0) 547 { 548 fePrintOptValues(); 549 return FALSE; 550 } 551 552 feOptIndex opt = feGetOptIndex(&sys_cmd[2]); 553 if (opt == FE_OPT_UNDEF) 554 { 555 Werror("Unknown option %s", sys_cmd); 556 Werror("Use 'system(\"--\");' for listing of available options"); 557 return TRUE; 558 } 559 560 // for Untyped Options (help version), 561 // setting it just triggers action 562 if (feOptSpec[opt].type == feOptUntyped) 563 { 564 feSetOptValue(opt,0); 565 return FALSE; 566 } 567 568 if (h == NULL) 569 { 570 if (feOptSpec[opt].type == feOptString) 571 { 572 res->rtyp = STRING_CMD; 573 const char *r=(const char*)feOptSpec[opt].value; 574 if (r == NULL) r=""; 575 res->data = omStrDup(r); 576 } 577 else 578 { 579 res->rtyp = INT_CMD; 580 res->data = feOptSpec[opt].value; 581 } 582 return FALSE; 583 } 584 585 if (h->Typ() != STRING_CMD && 586 h->Typ() != INT_CMD) 587 { 588 Werror("Need string or int argument to set option value"); 589 return TRUE; 590 } 591 const char* errormsg; 592 if (h->Typ() == INT_CMD) 593 { 594 if (feOptSpec[opt].type == feOptString) 595 { 596 Werror("Need string argument to set value of option %s", sys_cmd); 597 return TRUE; 598 } 599 errormsg = feSetOptValue(opt, (int)((long) h->Data())); 600 if (errormsg != NULL) 601 Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg); 602 } 603 else 604 { 605 errormsg = feSetOptValue(opt, (char*) h->Data()); 606 if (errormsg != NULL) 607 Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg); 608 } 609 if (errormsg != NULL) return TRUE; 610 return FALSE; 611 } 612 else 613 /*==================== HC ==================================*/ 614 if (strcmp(sys_cmd,"HC")==0) 615 { 616 res->rtyp=INT_CMD; 617 res->data=(void *)(long) HCord; 618 return FALSE; 619 } 620 else 621 /*==================== random ==================================*/ 622 if(strcmp(sys_cmd,"random")==0) 623 { 624 if ((h!=NULL) &&(h->Typ()==INT_CMD)) 625 { 626 siRandomStart=(int)((long)h->Data()); 627 siSeed=siRandomStart; 628 factoryseed(siRandomStart); 629 return FALSE; 630 } 631 else if (h != NULL) 632 { 633 WerrorS("int expected"); 634 return TRUE; 635 } 636 res->rtyp=INT_CMD; 637 res->data=(void*)(long) siRandomStart; 638 return FALSE; 639 } 640 /*==================== complexNearZero ======================*/ 641 if(strcmp(sys_cmd,"complexNearZero")==0) 642 { 643 if (h->Typ()==NUMBER_CMD ) 644 { 645 if ( h->next!=NULL && h->next->Typ()==INT_CMD ) 646 { 647 if ( !rField_is_long_C(currRing) ) 648 { 649 Werror( "unsupported ground field!"); 650 return TRUE; 651 } 652 else 653 { 654 res->rtyp=INT_CMD; 655 res->data=(void*)complexNearZero((gmp_complex*)h->Data(), 656 (int)((long)(h->next->Data()))); 657 return FALSE; 658 } 659 } 660 else 661 { 662 Werror( "expected <int> as third parameter!"); 663 return TRUE; 664 } 665 } 666 else 667 { 668 Werror( "expected <number> as second parameter!"); 669 return TRUE; 670 } 671 } 672 /*==================== getPrecDigits ======================*/ 673 if(strcmp(sys_cmd,"getPrecDigits")==0) 674 { 675 if ( !rField_is_long_C(currRing) && !rField_is_long_R(currRing) ) 676 { 677 Werror( "unsupported ground field!"); 678 return TRUE; 679 } 680 res->rtyp=INT_CMD; 681 res->data=(void*)(long)gmp_output_digits; 682 //if (gmp_output_digits!=getGMPFloatDigits()) 683 //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);} 684 return FALSE; 685 } 686 /*==================== mpz_t loader ======================*/ 687 if(strcmp(sys_cmd, "GNUmpLoad")==0) 688 { 689 if ((h != NULL) && (h->Typ() == STRING_CMD)) 690 { 691 char* filename = (char*)h->Data(); 692 FILE* f = fopen(filename, "r"); 693 if (f == NULL) 694 { 695 Werror( "invalid file name (in paths use '/')"); 696 return FALSE; 697 } 698 mpz_t m; mpz_init(m); 699 mpz_inp_str(m, f, 10); 700 fclose(f); 701 number n = n_InitMPZ(m, coeffs_BIGINT); 702 res->rtyp = BIGINT_CMD; 703 res->data = (void*)n; 704 return FALSE; 705 } 706 else 707 { 708 Werror( "expected valid file name as a string"); 709 return TRUE; 710 } 711 } 702 } 703 } 704 else 712 705 /*==================== intvec matching ======================*/ 713 706 /* Given two non-empty intvecs, the call 714 707 'system("intvecMatchingSegments", ivec, jvec);' 715 708 computes all occurences of jvec in ivec, i.e., it returns … … 717 710 If no such k exists (e.g. when ivec is shorter than jvec), an 718 711 intvec with the single entry 0 is being returned. */ 719 720 721 722 723 724 725 726 727 728 729 730 731 712 if(strcmp(sys_cmd, "intvecMatchingSegments")==0) 713 { 714 if ((h != NULL) && (h->Typ() == INTVEC_CMD) && 715 (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) && 716 (h->next->next == NULL)) 717 { 718 intvec* ivec = (intvec*)h->Data(); 719 intvec* jvec = (intvec*)h->next->Data(); 720 intvec* r = new intvec(1); (*r)[0] = 0; 721 int validEntries = 0; 722 for (int k = 0; k <= ivec->rows() - jvec->rows(); k++) 723 { 724 if (memcmp(&(*ivec)[k], &(*jvec)[0], 732 725 sizeof(int) * jvec->rows()) == 0) 726 { 727 if (validEntries == 0) 728 (*r)[0] = k + 1; 729 else 733 730 { 734 if (validEntries == 0) 735 (*r)[0] = k + 1; 736 else 737 { 738 r->resize(validEntries + 1); 739 (*r)[validEntries] = k + 1; 740 } 741 validEntries++; 731 r->resize(validEntries + 1); 732 (*r)[validEntries] = k + 1; 742 733 } 743 } 744 res->rtyp = INTVEC_CMD; 745 res->data = (void*)r; 746 return FALSE; 747 } 748 else 749 { 750 Werror("expected two non-empty intvecs as arguments"); 751 return TRUE; 752 } 753 } 754 /* Given two non-empty intvecs, the call 734 validEntries++; 735 } 736 } 737 res->rtyp = INTVEC_CMD; 738 res->data = (void*)r; 739 return FALSE; 740 } 741 else 742 { 743 WerrorS("expected two non-empty intvecs as arguments"); 744 return TRUE; 745 } 746 } 747 else 748 /* ================== intvecOverlap ======================= */ 749 /* Given two non-empty intvecs, the call 755 750 'system("intvecOverlap", ivec, jvec);' 756 751 computes the longest intvec kvec such that ivec ends with kvec 757 752 and jvec starts with kvec. The length of this overlap is being 758 753 returned. If there is no overlap at all, then 0 is being returned. */ 759 760 761 754 if(strcmp(sys_cmd, "intvecOverlap")==0) 755 { 756 if ((h != NULL) && (h->Typ() == INTVEC_CMD) && 762 757 (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) && 763 758 (h->next->next == NULL)) 764 765 766 767 768 769 759 { 760 intvec* ivec = (intvec*)h->Data(); 761 intvec* jvec = (intvec*)h->next->Data(); 762 int ir = ivec->rows(); int jr = jvec->rows(); 763 int r = jr; if (ir < jr) r = ir; /* r = min{ir, jr} */ 764 while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0], 770 765 sizeof(int) * r) != 0)) 771 r--; 772 res->rtyp = INT_CMD; 773 res->data = (void*)(long)r; 774 return FALSE; 775 } 776 else 777 { 778 Werror("expected two non-empty intvecs as arguments"); 779 return TRUE; 780 } 781 } 766 r--; 767 res->rtyp = INT_CMD; 768 res->data = (void*)(long)r; 769 return FALSE; 770 } 771 else 772 { 773 WerrorS("expected two non-empty intvecs as arguments"); 774 return TRUE; 775 } 776 } 777 else 782 778 /*==================== Hensel's lemma ======================*/ 783 if(strcmp(sys_cmd, "henselfactors")==0) 784 { 785 if ((h != NULL) && (h->Typ() == INT_CMD) && 786 (h->next != NULL) && (h->next->Typ() == INT_CMD) && 787 (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) && 788 (h->next->next->next != NULL) && 789 (h->next->next->next->Typ() == POLY_CMD) && 790 (h->next->next->next->next != NULL) && 791 (h->next->next->next->next->Typ() == POLY_CMD) && 792 (h->next->next->next->next->next != NULL) && 793 (h->next->next->next->next->next->Typ() == INT_CMD) && 794 (h->next->next->next->next->next->next == NULL)) 795 { 796 int xIndex = (int)(long)h->Data(); 797 int yIndex = (int)(long)h->next->Data(); 798 poly hh = (poly)h->next->next->Data(); 799 poly f0 = (poly)h->next->next->next->Data(); 800 poly g0 = (poly)h->next->next->next->next->Data(); 801 int d = (int)(long)h->next->next->next->next->next->Data(); 802 poly f; poly g; 803 henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g); 804 lists L = (lists)omAllocBin(slists_bin); 805 L->Init(2); 806 L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f; 807 L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g; 808 res->rtyp = LIST_CMD; 809 res->data = (char *)L; 810 return FALSE; 811 } 812 else 813 { 814 Werror( "expected argument list (int, int, poly, poly, poly, int)"); 815 return TRUE; 816 } 817 } 779 if(strcmp(sys_cmd, "henselfactors")==0) 780 { 781 if ((h != NULL) && (h->Typ() == INT_CMD) && 782 (h->next != NULL) && (h->next->Typ() == INT_CMD) && 783 (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) && 784 (h->next->next->next != NULL) && 785 (h->next->next->next->Typ() == POLY_CMD) && 786 (h->next->next->next->next != NULL) && 787 (h->next->next->next->next->Typ() == POLY_CMD) && 788 (h->next->next->next->next->next != NULL) && 789 (h->next->next->next->next->next->Typ() == INT_CMD) && 790 (h->next->next->next->next->next->next == NULL)) 791 { 792 int xIndex = (int)(long)h->Data(); 793 int yIndex = (int)(long)h->next->Data(); 794 poly hh = (poly)h->next->next->Data(); 795 poly f0 = (poly)h->next->next->next->Data(); 796 poly g0 = (poly)h->next->next->next->next->Data(); 797 int d = (int)(long)h->next->next->next->next->next->Data(); 798 poly f; poly g; 799 henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g); 800 lists L = (lists)omAllocBin(slists_bin); 801 L->Init(2); 802 L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f; 803 L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g; 804 res->rtyp = LIST_CMD; 805 res->data = (char *)L; 806 return FALSE; 807 } 808 else 809 { 810 WerrorS( "expected argument list (int, int, poly, poly, poly, int)"); 811 return TRUE; 812 } 813 } 814 else 818 815 /*==================== lduDecomp ======================*/ 819 if(strcmp(sys_cmd, "lduDecomp")==0) 820 { 821 if ((h != NULL) && (h->Typ() == MATRIX_CMD) && (h->next == NULL)) 822 { 823 matrix aMat = (matrix)h->Data(); 824 matrix pMat; matrix lMat; matrix dMat; matrix uMat; 825 poly l; poly u; poly prodLU; 826 lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU); 827 lists L = (lists)omAllocBin(slists_bin); 828 L->Init(7); 829 L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat; 830 L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat; 831 L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat; 832 L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat; 833 L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l; 834 L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u; 835 L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU; 836 res->rtyp = LIST_CMD; 837 res->data = (char *)L; 838 return FALSE; 839 } 840 else 841 { 842 Werror( "expected argument list (int, int, poly, poly, poly, int)"); 843 return TRUE; 844 } 845 } 816 if(strcmp(sys_cmd, "lduDecomp")==0) 817 { 818 if ((h != NULL) && (h->Typ() == MATRIX_CMD) && (h->next == NULL)) 819 { 820 matrix aMat = (matrix)h->Data(); 821 matrix pMat; matrix lMat; matrix dMat; matrix uMat; 822 poly l; poly u; poly prodLU; 823 lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU); 824 lists L = (lists)omAllocBin(slists_bin); 825 L->Init(7); 826 L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat; 827 L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat; 828 L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat; 829 L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat; 830 L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l; 831 L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u; 832 L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU; 833 res->rtyp = LIST_CMD; 834 res->data = (char *)L; 835 return FALSE; 836 } 837 else 838 { 839 WerrorS( "expected argument list (int, int, poly, poly, poly, int)"); 840 return TRUE; 841 } 842 } 843 else 846 844 /*==================== lduSolve ======================*/ 847 848 849 845 if(strcmp(sys_cmd, "lduSolve")==0) 846 { 847 /* for solving a linear equation system A * x = b, via the 850 848 given LDU-decomposition of the matrix A; 851 849 There is one valid parametrisation: … … 865 863 The method produces an error if matrix and vector sizes do not 866 864 fit. */ 867 if ((h == NULL) || (h->Typ() != MATRIX_CMD) || 868 (h->next == NULL) || (h->next->Typ() != MATRIX_CMD) || 869 (h->next->next == NULL) || (h->next->next->Typ() != MATRIX_CMD) || 870 (h->next->next->next == NULL) || 871 (h->next->next->next->Typ() != MATRIX_CMD) || 872 (h->next->next->next->next == NULL) || 873 (h->next->next->next->next->Typ() != POLY_CMD) || 874 (h->next->next->next->next->next == NULL) || 875 (h->next->next->next->next->next->Typ() != POLY_CMD) || 876 (h->next->next->next->next->next->next == NULL) || 877 (h->next->next->next->next->next->next->Typ() != POLY_CMD) || 878 (h->next->next->next->next->next->next->next == NULL) || 879 (h->next->next->next->next->next->next->next->Typ() 880 != MATRIX_CMD) || 881 (h->next->next->next->next->next->next->next->next != NULL)) 882 { 883 Werror("expected input (matrix, matrix, matrix, matrix, %s", 865 if ((h == NULL) || (h->Typ() != MATRIX_CMD) || 866 (h->next == NULL) || (h->next->Typ() != MATRIX_CMD) || 867 (h->next->next == NULL) || (h->next->next->Typ() != MATRIX_CMD) || 868 (h->next->next->next == NULL) || 869 (h->next->next->next->Typ() != MATRIX_CMD) || 870 (h->next->next->next->next == NULL) || 871 (h->next->next->next->next->Typ() != POLY_CMD) || 872 (h->next->next->next->next->next == NULL) || 873 (h->next->next->next->next->next->Typ() != POLY_CMD) || 874 (h->next->next->next->next->next->next == NULL) || 875 (h->next->next->next->next->next->next->Typ() != POLY_CMD) || 876 (h->next->next->next->next->next->next->next == NULL) || 877 (h->next->next->next->next->next->next->next->Typ() != MATRIX_CMD) || 878 (h->next->next->next->next->next->next->next->next != NULL)) 879 { 880 WerrorS("expected input (matrix, matrix, matrix, matrix, " 884 881 "poly, poly, poly, matrix)"); 885 return TRUE; 886 } 887 matrix pMat = (matrix)h->Data(); 888 matrix lMat = (matrix)h->next->Data(); 889 matrix dMat = (matrix)h->next->next->Data(); 890 matrix uMat = (matrix)h->next->next->next->Data(); 891 poly l = (poly) h->next->next->next->next->Data(); 892 poly u = (poly) h->next->next->next->next->next->Data(); 893 poly lTimesU = (poly) h->next->next->next->next->next->next 894 ->Data(); 895 matrix bVec = (matrix)h->next->next->next->next->next->next 896 ->next->Data(); 897 matrix xVec; int solvable; matrix homogSolSpace; 898 if (pMat->rows() != pMat->cols()) 899 { 900 Werror("first matrix (%d x %d) is not quadratic", 882 return TRUE; 883 } 884 matrix pMat = (matrix)h->Data(); 885 matrix lMat = (matrix)h->next->Data(); 886 matrix dMat = (matrix)h->next->next->Data(); 887 matrix uMat = (matrix)h->next->next->next->Data(); 888 poly l = (poly) h->next->next->next->next->Data(); 889 poly u = (poly) h->next->next->next->next->next->Data(); 890 poly lTimesU = (poly) h->next->next->next->next->next->next->Data(); 891 matrix bVec = (matrix)h->next->next->next->next->next->next->next->Data(); 892 matrix xVec; int solvable; matrix homogSolSpace; 893 if (pMat->rows() != pMat->cols()) 894 { 895 Werror("first matrix (%d x %d) is not quadratic", 901 896 pMat->rows(), pMat->cols()); 902 903 904 905 906 897 return TRUE; 898 } 899 if (lMat->rows() != lMat->cols()) 900 { 901 Werror("second matrix (%d x %d) is not quadratic", 907 902 lMat->rows(), lMat->cols()); 908 909 910 911 912 903 return TRUE; 904 } 905 if (dMat->rows() != dMat->cols()) 906 { 907 Werror("third matrix (%d x %d) is not quadratic", 913 908 dMat->rows(), dMat->cols()); 914 915 916 917 918 909 return TRUE; 910 } 911 if (dMat->cols() != uMat->rows()) 912 { 913 Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s", 919 914 dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(), 920 915 "do not t"); 921 922 923 924 925 916 return TRUE; 917 } 918 if (uMat->rows() != bVec->rows()) 919 { 920 Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit", 926 921 uMat->rows(), uMat->cols(), bVec->rows()); 927 928 929 922 return TRUE; 923 } 924 solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU, 930 925 bVec, xVec, homogSolSpace); 931 926 932 927 /* build the return structure; a list with either one or 933 928 three entries */ 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 929 lists ll = (lists)omAllocBin(slists_bin); 930 if (solvable) 931 { 932 ll->Init(3); 933 ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable; 934 ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec; 935 ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace; 936 } 937 else 938 { 939 ll->Init(1); 940 ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable; 941 } 942 res->rtyp = LIST_CMD; 943 res->data=(char*)ll; 944 return FALSE; 945 } 946 else 952 947 /*==================== neworder =============================*/ 953 948 // should go below 954 if(strcmp(sys_cmd,"neworder")==0) 955 { 956 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD)) 957 { 958 res->rtyp=STRING_CMD; 959 res->data=(void *)singclap_neworder((ideal)h->Data(), currRing); 949 if(strcmp(sys_cmd,"neworder")==0) 950 { 951 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD)) 952 { 953 res->rtyp=STRING_CMD; 954 res->data=(void *)singclap_neworder((ideal)h->Data(), currRing); 955 return FALSE; 956 } 957 else 958 WerrorS("ideal expected"); 959 } 960 else 961 /*==== countedref: reference and shared ====*/ 962 if (strcmp(sys_cmd, "shared") == 0) 963 { 964 #ifndef SI_COUNTEDREF_AUTOLOAD 965 void countedref_shared_load(); 966 countedref_shared_load(); 967 #endif 968 res->rtyp = NONE; 969 return FALSE; 970 } 971 else if (strcmp(sys_cmd, "reference") == 0) 972 { 973 #ifndef SI_COUNTEDREF_AUTOLOAD 974 void countedref_reference_load(); 975 countedref_reference_load(); 976 #endif 977 res->rtyp = NONE; 978 return FALSE; 979 } 980 else 981 /*==================== semaphore =================*/ 982 #ifdef HAVE_SIMPLEIPC 983 if (strcmp(sys_cmd,"semaphore")==0) 984 { 985 if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD)) 986 { 987 int v=1; 988 if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD)) 989 v=(int)(long)h->next->next->Data(); 990 res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v); 991 res->rtyp=INT_CMD; 992 return FALSE; 993 } 994 else 995 { 996 WerrorS("Usage: system(\"semaphore\",<cmd>,int)"); 997 return TRUE; 998 } 999 } 1000 else 1001 #endif 1002 /*==================== reserved port =================*/ 1003 if (strcmp(sys_cmd,"reserve")==0) 1004 { 1005 int ssiReservePort(int clients); 1006 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1007 { 1008 res->rtyp=INT_CMD; 1009 int p=ssiReservePort((int)(long)h->Data()); 1010 res->data=(void*)(long)p; 1011 return (p==0); 1012 } 1013 else 1014 { 1015 WerrorS("system(\"reserve\",<int>)"); 1016 } 1017 return TRUE; 1018 } 1019 else 1020 /*==================== reserved link =================*/ 1021 if (strcmp(sys_cmd,"reservedLink")==0) 1022 { 1023 extern si_link ssiCommandLink(); 1024 res->rtyp=LINK_CMD; 1025 si_link p=ssiCommandLink(); 1026 res->data=(void*)p; 1027 return (p==NULL); 1028 } 1029 else 1030 /*==================== install newstruct =================*/ 1031 if (strcmp(sys_cmd,"install")==0) 1032 { 1033 if ((h!=NULL) && (h->Typ()==STRING_CMD) 1034 && (h->next!=NULL) && (h->next->Typ()==STRING_CMD) 1035 && (h->next->next!=NULL) && (h->next->next->Typ()==PROC_CMD) 1036 && (h->next->next->next!=NULL) && (h->next->next->next->Typ()==INT_CMD)) 1037 { 1038 return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(), 1039 (int)(long)h->next->next->next->Data(), 1040 (procinfov)h->next->next->Data()); 1041 } 1042 return TRUE; 1043 } 1044 else 1045 /*==================== newstruct =================*/ 1046 if (strcmp(sys_cmd,"newstruct")==0) 1047 { 1048 if ((h!=NULL) && (h->Typ()==STRING_CMD)) 1049 { 1050 int id=0; 1051 blackboxIsCmd((char*)h->Data(),id); 1052 if (id>0) 1053 { 1054 blackbox *bb=getBlackboxStuff(id); 1055 if (BB_LIKE_LIST(bb)) 1056 { 1057 newstruct_desc desc=(newstruct_desc)bb->data; 1058 newstructShow(desc); 1059 return FALSE; 1060 } 1061 } 1062 } 1063 return TRUE; 1064 } 1065 else 1066 /*==================== blackbox =================*/ 1067 if (strcmp(sys_cmd,"blackbox")==0) 1068 { 1069 printBlackboxTypes(); 1070 return FALSE; 1071 } 1072 else 1073 /*================= absBiFact ======================*/ 1074 if (strcmp(sys_cmd, "absFact") == 0) 1075 { 1076 if (h!=NULL) 1077 { 1078 res->rtyp=LIST_CMD; 1079 if (h->Typ()==POLY_CMD) 1080 { 1081 intvec *v=NULL; 1082 ideal mipos= NULL; 1083 int n= 0; 1084 ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing); 1085 if (f==NULL) return TRUE; 1086 ivTest(v); 1087 lists l=(lists)omAllocBin(slists_bin); 1088 l->Init(4); 1089 l->m[0].rtyp=IDEAL_CMD; 1090 l->m[0].data=(void *)f; 1091 l->m[1].rtyp=INTVEC_CMD; 1092 l->m[1].data=(void *)v; 1093 l->m[2].rtyp=IDEAL_CMD; 1094 l->m[2].data=(void*) mipos; 1095 l->m[3].rtyp=INT_CMD; 1096 l->m[3].data=(void*) (long) n; 1097 res->data=(void *)l; 960 1098 return FALSE; 961 1099 } 962 else 963 WerrorS("ideal expected"); 964 } 965 else 1100 else return TRUE; 1101 } 1102 else return TRUE; 1103 } 1104 else 1105 /* =================== LLL via NTL ==============================*/ 1106 #ifdef HAVE_NTL 1107 if (strcmp(sys_cmd, "LLL") == 0) 1108 { 1109 if (h!=NULL) 1110 { 1111 res->rtyp=h->Typ(); 1112 if (h->Typ()==MATRIX_CMD) 1113 { 1114 res->data=(char *)singntl_LLL((matrix)h->Data(), currRing); 1115 return FALSE; 1116 } 1117 else if (h->Typ()==INTMAT_CMD) 1118 { 1119 res->data=(char *)singntl_LLL((intvec*)h->Data(), currRing); 1120 return FALSE; 1121 } 1122 else return TRUE; 1123 } 1124 else return TRUE; 1125 } 1126 else 1127 #endif 1128 /*==================== shift-test for freeGB =================*/ 1129 #ifdef HAVE_SHIFTBBA 1130 if (strcmp(sys_cmd, "stest") == 0) 1131 { 1132 poly p; 1133 int sh,uptodeg, lVblock; 1134 if ((h!=NULL) && (h->Typ()==POLY_CMD)) 1135 { 1136 p=(poly)h->CopyD(); 1137 h=h->next; 1138 } 1139 else return TRUE; 1140 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1141 { 1142 sh=(int)((long)(h->Data())); 1143 h=h->next; 1144 } 1145 else return TRUE; 1146 1147 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1148 { 1149 uptodeg=(int)((long)(h->Data())); 1150 h=h->next; 1151 } 1152 else return TRUE; 1153 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1154 { 1155 lVblock=(int)((long)(h->Data())); 1156 res->data = pLPshift(p,sh,uptodeg,lVblock); 1157 res->rtyp = POLY_CMD; 1158 } 1159 else return TRUE; 1160 return FALSE; 1161 } 1162 else 1163 #endif 1164 /*==================== block-test for freeGB =================*/ 1165 #ifdef HAVE_SHIFTBBA 1166 if (strcmp(sys_cmd, "btest") == 0) 1167 { 1168 poly p; 1169 int lV; 1170 if ((h!=NULL) && (h->Typ()==POLY_CMD)) 1171 { 1172 p=(poly)h->CopyD(); 1173 h=h->next; 1174 } 1175 else return TRUE; 1176 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1177 { 1178 lV=(int)((long)(h->Data())); 1179 res->rtyp = INT_CMD; 1180 res->data = (void*)(long)pLastVblock(p, lV); 1181 } 1182 else return TRUE; 1183 return FALSE; 1184 } 1185 else 1186 #endif 1187 /*==================== shrink-test for freeGB =================*/ 1188 #ifdef HAVE_SHIFTBBA 1189 if (strcmp(sys_cmd, "shrinktest") == 0) 1190 { 1191 poly p; 1192 int lV; 1193 if ((h!=NULL) && (h->Typ()==POLY_CMD)) 1194 { 1195 p=(poly)h->CopyD(); 1196 h=h->next; 1197 } 1198 else return TRUE; 1199 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1200 { 1201 lV=(int)((long)(h->Data())); 1202 res->rtyp = POLY_CMD; 1203 // res->data = p_mShrink(p, lV, currRing); 1204 // kStrategy strat=new skStrategy; 1205 // strat->tailRing = currRing; 1206 res->data = p_Shrink(p, lV, currRing); 1207 } 1208 else return TRUE; 1209 return FALSE; 1210 } 1211 else 1212 #endif 966 1213 //#ifndef HAVE_DYNAMIC_LOADING 967 1214 /*==================== pcv ==================================*/ 968 1215 #ifdef HAVE_PCV 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1216 if(strcmp(sys_cmd,"pcvLAddL")==0) 1217 { 1218 return pcvLAddL(res,h); 1219 } 1220 else 1221 if(strcmp(sys_cmd,"pcvPMulL")==0) 1222 { 1223 return pcvPMulL(res,h); 1224 } 1225 else 1226 if(strcmp(sys_cmd,"pcvMinDeg")==0) 1227 { 1228 return pcvMinDeg(res,h); 1229 } 1230 else 1231 if(strcmp(sys_cmd,"pcvP2CV")==0) 1232 { 1233 return pcvP2CV(res,h); 1234 } 1235 else 1236 if(strcmp(sys_cmd,"pcvCV2P")==0) 1237 { 1238 return pcvCV2P(res,h); 1239 } 1240 else 1241 if(strcmp(sys_cmd,"pcvDim")==0) 1242 { 1243 return pcvDim(res,h); 1244 } 1245 else 1246 if(strcmp(sys_cmd,"pcvBasis")==0) 1247 { 1248 return pcvBasis(res,h); 1249 } 1250 else 1004 1251 #endif 1005 1252 /*==================== eigenvalues ==================================*/ 1006 1253 #ifdef HAVE_EIGENVAL 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1254 if(strcmp(sys_cmd,"hessenberg")==0) 1255 { 1256 return evHessenberg(res,h); 1257 } 1258 else 1259 if(strcmp(sys_cmd,"eigenvals")==0) 1260 { 1261 return evEigenvals(res,h); 1262 } 1263 else 1017 1264 #endif 1018 1265 /*==================== Gauss-Manin system ==================================*/ 1019 1266 #ifdef HAVE_GMS 1020 1021 1022 1023 1024 1267 if(strcmp(sys_cmd,"gmsnf")==0) 1268 { 1269 return gmsNF(res,h); 1270 } 1271 else 1025 1272 #endif 1026 1273 //#endif /* HAVE_DYNAMIC_LOADING */ 1027 1274 /*==================== contributors =============================*/ 1028 1029 1030 1031 1275 if(strcmp(sys_cmd,"contributors") == 0) 1276 { 1277 res->rtyp=STRING_CMD; 1278 res->data=(void *)omStrDup( 1032 1279 "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"); 1033 1034 1035 1280 return FALSE; 1281 } 1282 else 1036 1283 /*==================== spectrum =============================*/ 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1284 #ifdef HAVE_SPECTRUM 1285 if(strcmp(sys_cmd,"spectrum") == 0) 1286 { 1287 if (h->Typ()!=POLY_CMD) 1288 { 1289 WerrorS("poly expected"); 1290 return TRUE; 1291 } 1292 if (h->next==NULL) 1293 return spectrumProc(res,h); 1294 if (h->next->Typ()!=INT_CMD) 1295 { 1296 WerrorS("poly,int expected"); 1297 return TRUE; 1298 } 1299 if(((long)h->next->Data())==1L) 1053 1300 return spectrumfProc(res,h); 1054 1055 1056 1301 return spectrumProc(res,h); 1302 } 1303 else 1057 1304 /*==================== semic =============================*/ 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1305 if(strcmp(sys_cmd,"semic") == 0) 1306 { 1307 if ((h->next!=NULL) 1308 && (h->Typ()==LIST_CMD) 1309 && (h->next->Typ()==LIST_CMD)) 1310 { 1311 if (h->next->next==NULL) 1312 return semicProc(res,h,h->next); 1313 else if (h->next->next->Typ()==INT_CMD) 1314 return semicProc3(res,h,h->next,h->next->next); 1315 } 1316 return TRUE; 1317 } 1318 else 1072 1319 /*==================== spadd =============================*/ 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1320 if(strcmp(sys_cmd,"spadd") == 0) 1321 { 1322 if ((h->next!=NULL) 1323 && (h->Typ()==LIST_CMD) 1324 && (h->next->Typ()==LIST_CMD)) 1325 { 1326 if (h->next->next==NULL) 1327 return spaddProc(res,h,h->next); 1328 } 1329 return TRUE; 1330 } 1331 else 1085 1332 /*==================== spmul =============================*/ 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 #endif 1099 1333 if(strcmp(sys_cmd,"spmul") == 0) 1334 { 1335 if ((h->next!=NULL) 1336 && (h->Typ()==LIST_CMD) 1337 && (h->next->Typ()==INT_CMD)) 1338 { 1339 if (h->next->next==NULL) 1340 return spmulProc(res,h,h->next); 1341 } 1342 return TRUE; 1343 } 1344 else 1345 #endif 1346 /*==================== tensorModuleMult ========================= */ 1100 1347 #define HAVE_SHEAFCOH_TRICKS 1 1101 1348 1102 1349 #ifdef HAVE_SHEAFCOH_TRICKS 1103 1104 1350 if(strcmp(sys_cmd,"tensorModuleMult")==0) 1351 { 1105 1352 // WarnS("tensorModuleMult!"); 1106 1353 if (h!=NULL && h->Typ()==INT_CMD && h->Data() != NULL && 1107 1354 h->next != NULL && h->next->Typ() == MODUL_CMD 1108 1355 && h->next->Data() != NULL) 1109 { 1110 int m = (int)( (long)h->Data() ); 1111 ideal M = (ideal)h->next->Data(); 1112 1113 res->rtyp=MODUL_CMD; 1114 res->data=(void *)id_TensorModuleMult(m, M, currRing); 1115 return FALSE; 1116 } 1117 WerrorS("system(\"tensorModuleMult\", int, module) expected"); 1118 return TRUE; 1119 } else 1120 #endif 1121 1356 { 1357 int m = (int)( (long)h->Data() ); 1358 ideal M = (ideal)h->next->Data(); 1359 res->rtyp=MODUL_CMD; 1360 res->data=(void *)id_TensorModuleMult(m, M, currRing); 1361 return FALSE; 1362 } 1363 WerrorS("system(\"tensorModuleMult\", int, module) expected"); 1364 return TRUE; 1365 } 1366 else 1367 #endif 1122 1368 //////////////////////////////////////////////////////////////////////// 1123 1369 /// Additional interface functions to non-commutative subsystem (PLURAL) … … 1125 1371 1126 1372 1373 /*==================== Approx_Step =================*/ 1127 1374 #ifdef HAVE_PLURAL 1128 /*==================== Approx_Step =================*/ 1129 if (strcmp(sys_cmd, "astep") == 0) 1130 { 1375 if (strcmp(sys_cmd, "astep") == 0) 1376 { 1131 1377 ideal I; 1132 1378 if ((h!=NULL) && (h->Typ()==IDEAL_CMD)) … … 1140 1386 else return TRUE; 1141 1387 return FALSE; 1142 } 1388 } 1389 else 1390 #endif 1143 1391 /*==================== PrintMat =================*/ 1144 if (strcmp(sys_cmd, "PrintMat") == 0) 1145 { 1392 #ifdef HAVE_PLURAL 1393 if (strcmp(sys_cmd, "PrintMat") == 0) 1394 { 1146 1395 int a; 1147 1396 int b; … … 1173 1422 else res->data=NULL; 1174 1423 return FALSE; 1175 } 1424 } 1425 else 1426 #endif 1176 1427 /*==================== twostd =================*/ 1177 if (strcmp(sys_cmd, "twostd") == 0) 1178 { 1428 #ifdef HAVE_PLURAL 1429 if (strcmp(sys_cmd, "twostd") == 0) 1430 { 1179 1431 ideal I; 1180 1432 if ((h!=NULL) && (h->Typ()==IDEAL_CMD)) … … 1189 1441 else return TRUE; 1190 1442 return FALSE; 1191 } 1443 } 1444 else 1445 #endif 1192 1446 /*==================== lie bracket =================*/ 1193 if (strcmp(sys_cmd, "bracket") == 0) 1194 { 1447 #ifdef HAVE_PLURAL 1448 if (strcmp(sys_cmd, "bracket") == 0) 1449 { 1195 1450 poly p; 1196 1451 poly q; … … 1210 1465 else res->data=NULL; 1211 1466 return FALSE; 1212 } 1213 if(strcmp(sys_cmd,"NCUseExtensions")==0) 1214 { 1215 1467 } 1468 else 1469 #endif 1470 /* ============ NCUseExtensions ======================== */ 1471 #ifdef HAVE_PLURAL 1472 if(strcmp(sys_cmd,"NCUseExtensions")==0) 1473 { 1216 1474 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1217 1475 res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) ); 1218 1476 else 1219 1477 res->data=(void *)(long)getNCExtensions(); 1220 1221 1478 res->rtyp=INT_CMD; 1222 1479 return FALSE; 1223 } 1224 1225 1226 if(strcmp(sys_cmd,"NCGetType")==0) 1227 { 1480 } 1481 else 1482 #endif 1483 /* ============ NCGetType ======================== */ 1484 #ifdef HAVE_PLURAL 1485 if(strcmp(sys_cmd,"NCGetType")==0) 1486 { 1228 1487 res->rtyp=INT_CMD; 1229 1230 1488 if( rIsPluralRing(currRing) ) 1231 1489 res->data=(void *)(long)ncRingType(currRing); 1232 1490 else 1233 1491 res->data=(void *)(-1L); 1234 1235 return FALSE; 1236 } 1237 1238 1239 if(strcmp(sys_cmd,"ForceSCA")==0) 1240 { 1492 return FALSE; 1493 } 1494 else 1495 #endif 1496 /* ============ ForceSCA ======================== */ 1497 #ifdef HAVE_PLURAL 1498 if(strcmp(sys_cmd,"ForceSCA")==0) 1499 { 1241 1500 if( !rIsPluralRing(currRing) ) 1242 1501 return TRUE; 1243 1244 1502 int b, e; 1245 1246 1503 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1247 1504 { … … 1250 1507 } 1251 1508 else return TRUE; 1252 1253 1509 if ((h!=NULL) && (h->Typ()==INT_CMD)) 1254 1510 { … … 1256 1512 } 1257 1513 else return TRUE; 1258 1259 1260 1514 if( !sca_Force(currRing, b, e) ) 1261 1515 return TRUE; 1262 1263 return FALSE; 1264 } 1265 1266 if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0) 1267 { 1516 return FALSE; 1517 } 1518 else 1519 #endif 1520 /* ============ ForceNewNCMultiplication ======================== */ 1521 #ifdef HAVE_PLURAL 1522 if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0) 1523 { 1268 1524 if( !rIsPluralRing(currRing) ) 1269 1525 return TRUE; 1270 1271 1526 if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural! 1272 1527 return TRUE; 1273 1528 1274 1529 return FALSE; 1275 } 1276 1277 if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0) 1278 { 1530 } 1531 else 1532 #endif 1533 /* ============ ForceNewOldNCMultiplication ======================== */ 1534 #ifdef HAVE_PLURAL 1535 if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0) 1536 { 1279 1537 if( !rIsPluralRing(currRing) ) 1280 1538 return TRUE; 1281 1282 1539 if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)! 1283 1540 return TRUE; 1284 1285 return FALSE; 1286 } 1287 1288 1289 1290 1291 /*==================== PLURAL =================*/ 1292 /*==================== opp ==================================*/ 1293 if (strcmp(sys_cmd, "opp")==0) 1294 { 1295 if ((h!=NULL) && (h->Typ()==RING_CMD)) 1296 { 1297 ring r=(ring)h->Data(); 1298 res->data=rOpposite(r); 1299 res->rtyp=RING_CMD; 1300 return FALSE; 1301 } 1302 else 1303 { 1304 WerrorS("`system(\"opp\",<ring>)` expected"); 1305 return TRUE; 1306 } 1307 } 1308 else 1541 return FALSE; 1542 } 1543 else 1544 #endif 1545 /* ============ opp ======================== */ 1546 #ifdef HAVE_PLURAL 1547 if (strcmp(sys_cmd, "opp")==0) 1548 { 1549 if ((h!=NULL) && (h->Typ()==RING_CMD)) 1550 { 1551 ring r=(ring)h->Data(); 1552 res->data=rOpposite(r); 1553 res->rtyp=RING_CMD; 1554 return FALSE; 1555 } 1556 else 1557 { 1558 WerrorS("`system(\"opp\",<ring>)` expected"); 1559 return TRUE; 1560 } 1561 } 1562 else 1563 #endif 1309 1564 /*==================== env ==================================*/ 1310 if (strcmp(sys_cmd, "env")==0) 1311 { 1565 #ifdef HAVE_PLURAL 1566 if (strcmp(sys_cmd, "env")==0) 1567 { 1312 1568 if ((h!=NULL) && (h->Typ()==RING_CMD)) 1313 1569 { … … 1322 1578 return TRUE; 1323 1579 } 1324 } 1325 else 1580 } 1581 else 1582 #endif 1326 1583 /*==================== oppose ==================================*/ 1327 if (strcmp(sys_cmd, "oppose")==0) 1328 { 1329 if ((h!=NULL) && (h->Typ()==RING_CMD) 1330 && (h->next!= NULL)) 1331 { 1332 ring Rop = (ring)h->Data(); 1333 h = h->next; 1334 idhdl w; 1335 if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL) 1336 { 1337 poly p = (poly)IDDATA(w); 1338 res->data = pOppose(Rop, p, currRing); // into CurrRing? 1339 res->rtyp = POLY_CMD; 1340 return FALSE; 1341 } 1342 } 1343 else 1344 { 1345 WerrorS("`system(\"oppose\",<ring>,<poly>)` expected"); 1346 return TRUE; 1347 } 1348 } 1349 else 1584 #ifdef HAVE_PLURAL 1585 if (strcmp(sys_cmd, "oppose")==0) 1586 { 1587 if ((h!=NULL) && (h->Typ()==RING_CMD) 1588 && (h->next!= NULL)) 1589 { 1590 ring Rop = (ring)h->Data(); 1591 h = h->next; 1592 idhdl w; 1593 if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL) 1594 { 1595 poly p = (poly)IDDATA(w); 1596 res->data = pOppose(Rop, p, currRing); // into CurrRing? 1597 res->rtyp = POLY_CMD; 1598 return FALSE; 1599 } 1600 } 1601 else 1602 { 1603 WerrorS("`system(\"oppose\",<ring>,<poly>)` expected"); 1604 return TRUE; 1605 } 1606 } 1607 else 1608 #endif 1350 1609 /*==================== freeGB, twosided GB in free algebra =================*/ 1610 #ifdef HAVE_PLURAL 1351 1611 #ifdef HAVE_SHIFTBBA 1352 1353 1612 if (strcmp(sys_cmd, "freegb") == 0) 1613 { 1354 1614 ideal I; 1355 1615 int uptodeg, lVblock; … … 1379 1639 else return TRUE; 1380 1640 return FALSE; 1381 1382 1641 } 1642 else 1383 1643 #endif /*SHIFTBBA*/ 1384 1644 #endif /*PLURAL*/ 1385 1645 /*==================== walk stuff =================*/ 1646 /*==================== walkNextWeight =================*/ 1386 1647 #ifdef HAVE_WALK 1387 1648 #ifdef OWNW 1388 1389 1649 if (strcmp(sys_cmd, "walkNextWeight") == 0) 1650 { 1390 1651 if (h == NULL || h->Typ() != INTVEC_CMD || 1391 1652 h->next == NULL || h->next->Typ() != INTVEC_CMD || 1392 1653 h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD) 1393 1654 { 1394 Werror ("system(\"walkNextWeight\", intvec, intvec, ideal) expected");1655 WerrorS("system(\"walkNextWeight\", intvec, intvec, ideal) expected"); 1395 1656 return TRUE; 1396 1657 } … … 1415 1676 } 1416 1677 return FALSE; 1417 } 1418 else if (strcmp(sys_cmd, "walkInitials") == 0) 1419 { 1678 } 1679 else 1680 /*==================== walkNextWeight =================*/ 1681 if (strcmp(sys_cmd, "walkInitials") == 0) 1682 { 1420 1683 if (h == NULL || h->Typ() != IDEAL_CMD) 1421 1684 { … … 1427 1690 res->rtyp = IDEAL_CMD; 1428 1691 return FALSE; 1429 } 1430 else 1431 #endif 1692 } 1693 else 1694 #endif 1695 /*==================== walkAddIntVec =================*/ 1432 1696 #ifdef WAIV 1433 1434 1697 if (strcmp(sys_cmd, "walkAddIntVec") == 0) 1698 { 1435 1699 if (h == NULL || h->Typ() != INTVEC_CMD || 1436 1700 h->next == NULL || h->next->Typ() != INTVEC_CMD) … … 1446 1710 res->rtyp = INTVEC_CMD; 1447 1711 return FALSE; 1448 } 1449 else 1450 #endif 1712 } 1713 else 1714 #endif 1715 /*==================== MwalkNextWeight =================*/ 1451 1716 #ifdef MwaklNextWeight 1452 1453 1717 if (strcmp(sys_cmd, "MwalkNextWeight") == 0) 1718 { 1454 1719 if (h == NULL || h->Typ() != INTVEC_CMD || 1455 1720 h->next == NULL || h->next->Typ() != INTVEC_CMD || 1456 1721 h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD) 1457 1722 { 1458 Werror ("system(\"MwalkNextWeight\", intvec, intvec, ideal) expected");1723 WerrorS("system(\"MwalkNextWeight\", intvec, intvec, ideal) expected"); 1459 1724 return TRUE; 1460 1725 } … … 1477 1742 1478 1743 return FALSE; 1479 1480 1744 } 1745 else 1481 1746 #endif //MWalkNextWeight 1482 if(strcmp(sys_cmd, "Mivdp") == 0) 1483 { 1747 /*==================== Mivdp =================*/ 1748 if(strcmp(sys_cmd, "Mivdp") == 0) 1749 { 1484 1750 if (h == NULL || h->Typ() != INT_CMD) 1485 1751 { 1486 Werror ("system(\"Mivdp\", int) expected");1752 WerrorS("system(\"Mivdp\", int) expected"); 1487 1753 return TRUE; 1488 1754 } … … 1501 1767 1502 1768 return FALSE; 1503 } 1504 1505 else if(strcmp(sys_cmd, "Mivlp") == 0) 1506 { 1769 } 1770 else 1771 /*==================== Mivlp =================*/ 1772 if(strcmp(sys_cmd, "Mivlp") == 0) 1773 { 1507 1774 if (h == NULL || h->Typ() != INT_CMD) 1508 1775 { 1509 Werror ("system(\"Mivlp\", int) expected");1776 WerrorS("system(\"Mivlp\", int) expected"); 1510 1777 return TRUE; 1511 1778 } … … 1524 1791 1525 1792 return FALSE; 1526 } 1527 else 1793 } 1794 else 1795 /*==================== MpDiv =================*/ 1528 1796 #ifdef MpDiv 1529 1530 1797 if(strcmp(sys_cmd, "MpDiv") == 0) 1798 { 1531 1799 if(h==NULL || h->Typ() != POLY_CMD || 1532 1800 h->next == NULL || h->next->Typ() != POLY_CMD) 1533 1801 { 1534 Werror ("system(\"MpDiv\",poly, poly) expected");1802 WerrorS("system(\"MpDiv\",poly, poly) expected"); 1535 1803 return TRUE; 1536 1804 } … … 1543 1811 res->data = result; 1544 1812 return FALSE; 1545 } 1546 else 1547 #endif 1813 } 1814 else 1815 #endif 1816 /*==================== MpMult =================*/ 1548 1817 #ifdef MpMult 1549 1550 1818 if(strcmp(sys_cmd, "MpMult") == 0) 1819 { 1551 1820 if(h==NULL || h->Typ() != POLY_CMD || 1552 1821 h->next == NULL || h->next->Typ() != POLY_CMD) 1553 1822 { 1554 Werror ("system(\"MpMult\",poly, poly) expected");1823 WerrorS("system(\"MpMult\",poly, poly) expected"); 1555 1824 return TRUE; 1556 1825 } … … 1562 1831 res->data = result; 1563 1832 return FALSE; 1564 } 1565 else 1566 #endif 1567 if (strcmp(sys_cmd, "MivSame") == 0) 1568 { 1833 } 1834 else 1835 #endif 1836 /*==================== MivSame =================*/ 1837 if (strcmp(sys_cmd, "MivSame") == 0) 1838 { 1569 1839 if(h == NULL || h->Typ() != INTVEC_CMD || 1570 1840 h->next == NULL || h->next->Typ() != INTVEC_CMD ) 1571 1841 { 1572 Werror ("system(\"MivSame\", intvec, intvec) expected");1842 WerrorS("system(\"MivSame\", intvec, intvec) expected"); 1573 1843 return TRUE; 1574 1844 } … … 1593 1863 res->data = (void*)(long) MivSame(arg1, arg2); 1594 1864 return FALSE; 1595 } 1596 else 1597 if (strcmp(sys_cmd, "M3ivSame") == 0) 1598 { 1865 } 1866 else 1867 /*==================== M3ivSame =================*/ 1868 if (strcmp(sys_cmd, "M3ivSame") == 0) 1869 { 1599 1870 if(h == NULL || h->Typ() != INTVEC_CMD || 1600 1871 h->next == NULL || h->next->Typ() != INTVEC_CMD || 1601 1872 h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ) 1602 1873 { 1603 Werror ("system(\"M3ivSame\", intvec, intvec, intvec) expected");1874 WerrorS("system(\"M3ivSame\", intvec, intvec, intvec) expected"); 1604 1875 return TRUE; 1605 1876 } … … 1626 1897 res->data = (void*)(long) M3ivSame(arg1, arg2, arg3); 1627 1898 return FALSE; 1628 } 1629 else 1630 if(strcmp(sys_cmd, "MwalkInitialForm") == 0) 1631 { 1899 } 1900 else 1901 /*==================== MwalkInitialForm =================*/ 1902 if(strcmp(sys_cmd, "MwalkInitialForm") == 0) 1903 { 1632 1904 if(h == NULL || h->Typ() != IDEAL_CMD || 1633 1905 h->next == NULL || h->next->Typ() != INTVEC_CMD) 1634 1906 { 1635 Werror ("system(\"MwalkInitialForm\", ideal, intvec) expected");1907 WerrorS("system(\"MwalkInitialForm\", ideal, intvec) expected"); 1636 1908 return TRUE; 1637 1909 } … … 1649 1921 res->data = result; 1650 1922 return FALSE; 1651 } 1652 else 1653 /************** Perturbation walk **********/ 1654 if(strcmp(sys_cmd, "MivMatrixOrder") == 0) 1655 { 1923 } 1924 else 1925 /*==================== MivMatrixOrder =================*/ 1926 /************** Perturbation walk **********/ 1927 if(strcmp(sys_cmd, "MivMatrixOrder") == 0) 1928 { 1656 1929 if(h==NULL || h->Typ() != INTVEC_CMD) 1657 1930 { 1658 Werror ("system(\"MivMatrixOrder\",intvec) expected");1931 WerrorS("system(\"MivMatrixOrder\",intvec) expected"); 1659 1932 return TRUE; 1660 1933 } … … 1666 1939 res->data = result; 1667 1940 return FALSE; 1668 } 1669 else 1670 if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0) 1671 { 1941 } 1942 else 1943 /*==================== MivMatrixOrderdp =================*/ 1944 if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0) 1945 { 1672 1946 if(h==NULL || h->Typ() != INT_CMD) 1673 1947 { 1674 Werror ("system(\"MivMatrixOrderdp\",intvec) expected");1948 WerrorS("system(\"MivMatrixOrderdp\",intvec) expected"); 1675 1949 return TRUE; 1676 1950 } … … 1683 1957 return FALSE; 1684 1958 } 1685 1686 if(strcmp(sys_cmd, "MPertVectors") == 0)1687 {1688 1959 else 1960 /*==================== MPertVectors =================*/ 1961 if(strcmp(sys_cmd, "MPertVectors") == 0) 1962 { 1689 1963 if(h==NULL || h->Typ() != IDEAL_CMD || 1690 1964 h->next == NULL || h->next->Typ() != INTVEC_CMD || 1691 1965 h->next->next == NULL || h->next->next->Typ() != INT_CMD) 1692 1966 { 1693 Werror ("system(\"MPertVectors\",ideal, intvec, int) expected");1967 WerrorS("system(\"MPertVectors\",ideal, intvec, int) expected"); 1694 1968 return TRUE; 1695 1969 } … … 1704 1978 res->data = result; 1705 1979 return FALSE; 1706 1707 1708 if(strcmp(sys_cmd, "MPertVectorslp") == 0)1709 {1710 1980 } 1981 else 1982 /*==================== MPertVectorslp =================*/ 1983 if(strcmp(sys_cmd, "MPertVectorslp") == 0) 1984 { 1711 1985 if(h==NULL || h->Typ() != IDEAL_CMD || 1712 1986 h->next == NULL || h->next->Typ() != INTVEC_CMD || 1713 1987 h->next->next == NULL || h->next->next->Typ() != INT_CMD) 1714 1988 { 1715 Werror ("system(\"MPertVectorslp\",ideal, intvec, int) expected");1989 WerrorS("system(\"MPertVectorslp\",ideal, intvec, int) expected"); 1716 1990 return TRUE; 1717 1991 } … … 1726 2000 res->data = result; 1727 2001 return FALSE; 1728 1729 1730 1731 1732 2002 } 2003 /************** fractal walk **********/ 2004 else 2005 if(strcmp(sys_cmd, "Mfpertvector") == 0) 2006 { 1733 2007 if(h==NULL || h->Typ() != IDEAL_CMD || 1734 2008 h->next==NULL || h->next->Typ() != INTVEC_CMD ) 1735 2009 { 1736 Werror ("system(\"Mfpertvector\", ideal,intvec) expected");2010 WerrorS("system(\"Mfpertvector\", ideal,intvec) expected"); 1737 2011 return TRUE; 1738 2012 } … … 1744 2018 res->data = result; 1745 2019 return FALSE; 1746 1747 1748 1749 2020 } 2021 else 2022 if(strcmp(sys_cmd, "MivUnit") == 0) 2023 { 1750 2024 int arg1 = (int) ((long)(h->Data())); 1751 2025 … … 1755 2029 res->data = result; 1756 2030 return FALSE; 1757 1758 1759 1760 2031 } 2032 else 2033 if(strcmp(sys_cmd, "MivWeightOrderlp") == 0) 2034 { 1761 2035 if(h==NULL || h->Typ() != INTVEC_CMD) 1762 2036 { 1763 Werror ("system(\"MivWeightOrderlp\",intvec) expected");2037 WerrorS("system(\"MivWeightOrderlp\",intvec) expected"); 1764 2038 return TRUE; 1765 2039 } … … 1770 2044 res->data = result; 1771 2045 return FALSE; 1772 1773 1774 1775 2046 } 2047 else 2048 if(strcmp(sys_cmd, "MivWeightOrderdp") == 0) 2049 { 1776 2050 if(h==NULL || h->Typ() != INTVEC_CMD) 1777 2051 { 1778 Werror ("system(\"MivWeightOrderdp\",intvec) expected");2052 WerrorS("system(\"MivWeightOrderdp\",intvec) expected"); 1779 2053 return TRUE; 1780 2054 } … … 1787 2061 res->data = result; 1788 2062 return FALSE; 1789 1790 1791 1792 2063 } 2064 else 2065 if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0) 2066 { 1793 2067 if(h==NULL || h->Typ() != INT_CMD) 1794 2068 { 1795 Werror ("system(\"MivMatrixOrderlp\",int) expected");2069 WerrorS("system(\"MivMatrixOrderlp\",int) expected"); 1796 2070 return TRUE; 1797 2071 } … … 1803 2077 res->data = result; 1804 2078 return FALSE; 1805 1806 1807 1808 2079 } 2080 else 2081 if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0) 2082 { 1809 2083 if (h == NULL || h->Typ() != INTVEC_CMD || 1810 2084 h->next == NULL || h->next->Typ() != INTVEC_CMD || 1811 2085 h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD) 1812 2086 { 1813 Werror ("system(\"MkInterRedNextWeight\", intvec, intvec, ideal) expected");2087 WerrorS("system(\"MkInterRedNextWeight\", intvec, intvec, ideal) expected"); 1814 2088 return TRUE; 1815 2089 } … … 1832 2106 1833 2107 return FALSE; 1834 1835 2108 } 2109 else 1836 2110 #ifdef MPertNextWeight 1837 1838 2111 if (strcmp(sys_cmd, "MPertNextWeight") == 0) 2112 { 1839 2113 if (h == NULL || h->Typ() != INTVEC_CMD || 1840 2114 h->next == NULL || h->next->Typ() != IDEAL_CMD || 1841 2115 h->next->next == NULL || h->next->next->Typ() != INT_CMD) 1842 2116 { 1843 Werror ("system(\"MPertNextWeight\", intvec, ideal, int) expected");2117 WerrorS("system(\"MPertNextWeight\", intvec, ideal, int) expected"); 1844 2118 return TRUE; 1845 2119 } … … 1861 2135 1862 2136 return FALSE; 1863 1864 2137 } 2138 else 1865 2139 #endif //MPertNextWeight 1866 2140 #ifdef Mivperttarget 1867 2141 if (strcmp(sys_cmd, "Mivperttarget") == 0) 1868 2142 { 1869 2143 if (h == NULL || h->Typ() != IDEAL_CMD || 1870 2144 h->next == NULL || h->next->Typ() != INT_CMD ) 1871 2145 { 1872 Werror ("system(\"Mivperttarget\", ideal, int) expected");2146 WerrorS("system(\"Mivperttarget\", ideal, int) expected"); 1873 2147 return TRUE; 1874 2148 } … … 1883 2157 1884 2158 return FALSE; 1885 1886 2159 } 2160 else 1887 2161 #endif //Mivperttarget 1888 1889 2162 if (strcmp(sys_cmd, "Mwalk") == 0) 2163 { 1890 2164 if (h == NULL || h->Typ() != IDEAL_CMD || 1891 2165 h->next == NULL || h->next->Typ() != INTVEC_CMD || 1892 2166 h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD) 1893 2167 { 1894 Werror ("system(\"Mwalk\", ideal, intvec, intvec) expected");2168 WerrorS("system(\"Mwalk\", ideal, intvec, intvec) expected"); 1895 2169 return TRUE; 1896 2170 } … … 1914 2188 1915 2189 return FALSE; 1916 1917 2190 } 2191 else 1918 2192 #ifdef MPWALK_ORIG 1919 1920 2193 if (strcmp(sys_cmd, "Mpwalk") == 0) 2194 { 1921 2195 if (h == NULL || h->Typ() != IDEAL_CMD || 1922 2196 h->next == NULL || h->next->Typ() != INT_CMD || … … 1927 2201 h->next->next->next->next->Typ() != INTVEC_CMD) 1928 2202 { 1929 Werror ("system(\"Mpwalk\", ideal, int, int, intvec, intvec) expected");2203 WerrorS("system(\"Mpwalk\", ideal, int, int, intvec, intvec) expected"); 1930 2204 return TRUE; 1931 2205 } … … 1951 2225 1952 2226 return FALSE; 1953 1954 1955 #endif 1956 1957 2227 } 2228 else 2229 #endif 2230 if (strcmp(sys_cmd, "Mpwalk") == 0) 2231 { 1958 2232 if (h == NULL || h->Typ() != IDEAL_CMD || 1959 2233 h->next == NULL || h->next->Typ() != INT_CMD || … … 1966 2240 h->next->next->next->next->next->Typ() != INT_CMD) 1967 2241 { 1968 Werror ("system(\"Mpwalk\", ideal, int, int, intvec, intvec, int) expected");2242 WerrorS("system(\"Mpwalk\", ideal, int, int, intvec, intvec, int) expected"); 1969 2243 return TRUE; 1970 2244 } … … 1991 2265 1992 2266 return FALSE; 1993 1994 1995 1996 2267 } 2268 else 2269 if (strcmp(sys_cmd, "Mrwalk") == 0) 2270 { // Random Walk 1997 2271 if (h == NULL || h->Typ() != IDEAL_CMD || 1998 2272 h->next == NULL || h->next->Typ() != INTVEC_CMD || … … 2001 2275 h->next->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD) 2002 2276 { 2003 Werror ("system(\"Mrwalk\", ideal, intvec, intvec, int, int) expected");2277 WerrorS("system(\"Mrwalk\", ideal, intvec, intvec, int, int) expected"); 2004 2278 return TRUE; 2005 2279 } … … 2025 2299 2026 2300 return FALSE; 2027 2028 2029 2030 2301 } 2302 else 2303 if (strcmp(sys_cmd, "MAltwalk1") == 0) 2304 { 2031 2305 if (h == NULL || h->Typ() != IDEAL_CMD || 2032 2306 h->next == NULL || h->next->Typ() != INT_CMD || … … 2037 2311 h->next->next->next->next->Typ() != INTVEC_CMD) 2038 2312 { 2039 Werror ("system(\"MAltwalk1\", ideal, int, int, intvec, intvec) expected");2313 WerrorS("system(\"MAltwalk1\", ideal, int, int, intvec, intvec) expected"); 2040 2314 return TRUE; 2041 2315 } … … 2061 2335 2062 2336 return FALSE; 2063 2337 } 2064 2338 #ifdef MFWALK_ALT 2065 2066 2067 2339 else 2340 if (strcmp(sys_cmd, "Mfwalk_alt") == 0) 2341 { 2068 2342 if (h == NULL || h->Typ() != IDEAL_CMD || 2069 2343 h->next == NULL || h->next->Typ() != INTVEC_CMD || … … 2071 2345 h->next->next->next == NULL || h->next->next->next->Typ() !=INT_CMD) 2072 2346 { 2073 Werror ("system(\"Mfwalk\", ideal, intvec, intvec,int) expected");2347 WerrorS("system(\"Mfwalk\", ideal, intvec, intvec,int) expected"); 2074 2348 return TRUE; 2075 2349 } … … 2093 2367 2094 2368 return FALSE; 2095 2096 #endif 2097 2098 2099 2369 } 2370 #endif 2371 else 2372 if (strcmp(sys_cmd, "Mfwalk") == 0) 2373 { 2100 2374 if (h == NULL || h->Typ() != IDEAL_CMD || 2101 2375 h->next == NULL || h->next->Typ() != INTVEC_CMD || 2102 2376 h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD) 2103 2377 { 2104 Werror ("system(\"Mfwalk\", ideal, intvec, intvec) expected");2378 WerrorS("system(\"Mfwalk\", ideal, intvec, intvec) expected"); 2105 2379 return TRUE; 2106 2380 } … … 2123 2397 2124 2398 return FALSE; 2125 2126 2127 2128 2399 } 2400 else 2401 if (strcmp(sys_cmd, "Mfrwalk") == 0) 2402 { 2129 2403 if (h == NULL || h->Typ() != IDEAL_CMD || 2130 2404 h->next == NULL || h->next->Typ() != INTVEC_CMD || … … 2132 2406 h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD) 2133 2407 { 2134 Werror ("system(\"Mfrwalk\", ideal, intvec, intvec, int) expected");2408 WerrorS("system(\"Mfrwalk\", ideal, intvec, intvec, int) expected"); 2135 2409 return TRUE; 2136 2410 } … … 2154 2428 2155 2429 return FALSE; 2156 2157 2430 } 2431 else 2158 2432 2159 2433 #ifdef TRAN_Orig 2160 2161 2434 if (strcmp(sys_cmd, "TranMImprovwalk") == 0) 2435 { 2162 2436 if (h == NULL || h->Typ() != IDEAL_CMD || 2163 2437 h->next == NULL || h->next->Typ() != INTVEC_CMD || 2164 2438 h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD) 2165 2439 { 2166 Werror ("system(\"TranMImprovwalk\", ideal, intvec, intvec) expected");2440 WerrorS("system(\"TranMImprovwalk\", ideal, intvec, intvec) expected"); 2167 2441 return TRUE; 2168 2442 } … … 2186 2460 2187 2461 return FALSE; 2188 2189 2190 #endif 2191 2192 2462 } 2463 else 2464 #endif 2465 if (strcmp(sys_cmd, "MAltwalk2") == 0) 2466 { 2193 2467 if (h == NULL || h->Typ() != IDEAL_CMD || 2194 2468 h->next == NULL || h->next->Typ() != INTVEC_CMD || 2195 2469 h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD) 2196 2470 { 2197 Werror ("system(\"MAltwalk2\", ideal, intvec, intvec) expected");2471 WerrorS("system(\"MAltwalk2\", ideal, intvec, intvec) expected"); 2198 2472 return TRUE; 2199 2473 } … … 2217 2491 2218 2492 return FALSE; 2219 2220 2221 2222 2493 } 2494 else 2495 if (strcmp(sys_cmd, "TranMImprovwalk") == 0) 2496 { 2223 2497 if (h == NULL || h->Typ() != IDEAL_CMD || 2224 2498 h->next == NULL || h->next->Typ() != INTVEC_CMD || … … 2226 2500 h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD) 2227 2501 { 2228 Werror ("system(\"TranMImprovwalk\", ideal, intvec, intvec, int) expected");2502 WerrorS("system(\"TranMImprovwalk\", ideal, intvec, intvec, int) expected"); 2229 2503 return TRUE; 2230 2504 } … … 2248 2522 2249 2523 return FALSE; 2250 2251 2252 2253 2524 } 2525 else 2526 if (strcmp(sys_cmd, "TranMrImprovwalk") == 0) 2527 { 2254 2528 if (h == NULL || h->Typ() != IDEAL_CMD || 2255 2529 h->next == NULL || h->next->Typ() != INTVEC_CMD || … … 2259 2533 h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD) 2260 2534 { 2261 Werror ("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");2535 WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected"); 2262 2536 return TRUE; 2263 2537 } … … 2282 2556 2283 2557 return FALSE; 2284 } 2285 else 2286 2558 } 2559 else 2287 2560 #endif 2288 2561 /*================= Extended system call ========================*/ 2289 2562 { 2290 2563 #ifndef MAKE_DISTRIBUTION 2291 2564 return(jjEXTENDED_SYSTEM(res, args)); … … 2293 2566 Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented ); 2294 2567 #endif 2295 2296 2297 2298 2568 } 2569 } /* typ==string */ 2570 return TRUE; 2571 } 2299 2572 2300 2573 … … 2878 3151 if (n != m->cols()) 2879 3152 { 2880 Werror ("expected exactly one argument: %s",3153 WerrorS("expected exactly one argument: " 2881 3154 "a square matrix with number entries"); 2882 3155 return TRUE; … … 2942 3215 return FALSE; 2943 3216 } 2944 else { Werror ("wrong typ"); return TRUE;}3217 else { WerrorS("wrong typ"); return TRUE;} 2945 3218 } 2946 3219 else … … 2979 3252 #endif 2980 3253 2981 /*==== countedref: reference and shared ====*/2982 if (strcmp(sys_cmd, "shared") == 0)2983 {2984 #ifndef SI_COUNTEDREF_AUTOLOAD2985 void countedref_shared_load();2986 countedref_shared_load();2987 #endif2988 res->rtyp = NONE;2989 return FALSE;2990 }2991 else if (strcmp(sys_cmd, "reference") == 0)2992 {2993 #ifndef SI_COUNTEDREF_AUTOLOAD2994 void countedref_reference_load();2995 countedref_reference_load();2996 #endif2997 res->rtyp = NONE;2998 return FALSE;2999 }3000 else3001 3254 3002 3255 /*==================== DLL =================*/ … … 3230 3483 #endif 3231 3484 /*==================== RatNF, noncomm rational coeffs =================*/ 3232 #ifdef HAVE_PLURAL3233 3485 #ifdef HAVE_RATGRING 3234 3486 if (strcmp(sys_cmd, "intratNF") == 0) … … 3373 3625 } 3374 3626 else 3375 /*==================== shift-test for freeGB =================*/3376 #ifdef HAVE_SHIFTBBA3377 if (strcmp(sys_cmd, "stest") == 0)3378 {3379 poly p;3380 int sh,uptodeg, lVblock;3381 if ((h!=NULL) && (h->Typ()==POLY_CMD))3382 {3383 p=(poly)h->CopyD();3384 h=h->next;3385 }3386 else return TRUE;3387 if ((h!=NULL) && (h->Typ()==INT_CMD))3388 {3389 sh=(int)((long)(h->Data()));3390 h=h->next;3391 }3392 else return TRUE;3393 3394 if ((h!=NULL) && (h->Typ()==INT_CMD))3395 {3396 uptodeg=(int)((long)(h->Data()));3397 h=h->next;3398 }3399 else return TRUE;3400 if ((h!=NULL) && (h->Typ()==INT_CMD))3401 {3402 lVblock=(int)((long)(h->Data()));3403 res->data = pLPshift(p,sh,uptodeg,lVblock);3404 res->rtyp = POLY_CMD;3405 }3406 else return TRUE;3407 return FALSE;3408 }3409 else3410 #endif3411 /*==================== block-test for freeGB =================*/3412 #ifdef HAVE_SHIFTBBA3413 if (strcmp(sys_cmd, "btest") == 0)3414 {3415 poly p;3416 int lV;3417 if ((h!=NULL) && (h->Typ()==POLY_CMD))3418 {3419 p=(poly)h->CopyD();3420 h=h->next;3421 }3422 else return TRUE;3423 if ((h!=NULL) && (h->Typ()==INT_CMD))3424 {3425 lV=(int)((long)(h->Data()));3426 res->rtyp = INT_CMD;3427 res->data = (void*)(long)pLastVblock(p, lV);3428 }3429 else return TRUE;3430 return FALSE;3431 }3432 else3433 /*==================== shrink-test for freeGB =================*/3434 if (strcmp(sys_cmd, "shrinktest") == 0)3435 {3436 poly p;3437 int lV;3438 if ((h!=NULL) && (h->Typ()==POLY_CMD))3439 {3440 p=(poly)h->CopyD();3441 h=h->next;3442 }3443 else return TRUE;3444 if ((h!=NULL) && (h->Typ()==INT_CMD))3445 {3446 lV=(int)((long)(h->Data()));3447 res->rtyp = POLY_CMD;3448 // res->data = p_mShrink(p, lV, currRing);3449 // kStrategy strat=new skStrategy;3450 // strat->tailRing = currRing;3451 res->data = p_Shrink(p, lV, currRing);3452 }3453 else return TRUE;3454 return FALSE;3455 }3456 else3457 #endif3458 #endif3459 3627 /*==================== t-rep-GB ==================================*/ 3460 3628 if (strcmp(sys_cmd, "unifastmult")==0) … … 3589 3757 { 3590 3758 res->data=(char *)singntl_HNF((intvec*)h->Data(), currRing); 3591 return FALSE;3592 }3593 else return TRUE;3594 }3595 else return TRUE;3596 }3597 else3598 if (strcmp(sys_cmd, "LLL") == 0)3599 {3600 if (h!=NULL)3601 {3602 res->rtyp=h->Typ();3603 if (h->Typ()==MATRIX_CMD)3604 {3605 res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);3606 return FALSE;3607 }3608 else if (h->Typ()==INTMAT_CMD)3609 {3610 res->data=(char *)singntl_LLL((intvec*)h->Data(), currRing);3611 return FALSE;3612 }3613 else return TRUE;3614 }3615 else return TRUE;3616 }3617 else3618 /*================= absBiFact ======================*/3619 if (strcmp(sys_cmd, "absFact") == 0)3620 {3621 if (h!=NULL)3622 {3623 res->rtyp=LIST_CMD;3624 if (h->Typ()==POLY_CMD)3625 {3626 intvec *v=NULL;3627 ideal mipos= NULL;3628 int n= 0;3629 ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);3630 if (f==NULL) return TRUE;3631 ivTest(v);3632 lists l=(lists)omAllocBin(slists_bin);3633 l->Init(4);3634 l->m[0].rtyp=IDEAL_CMD;3635 l->m[0].data=(void *)f;3636 l->m[1].rtyp=INTVEC_CMD;3637 l->m[1].data=(void *)v;3638 l->m[2].rtyp=IDEAL_CMD;3639 l->m[2].data=(void*) mipos;3640 l->m[3].rtyp=INT_CMD;3641 l->m[3].data=(void*) (long) n;3642 res->data=(void *)l;3643 3759 return FALSE; 3644 3760 } … … 3720 3836 3721 3837 #endif 3722 /*==================== semaphore =================*/3723 #ifdef HAVE_SIMPLEIPC3724 if (strcmp(sys_cmd,"semaphore")==0)3725 {3726 if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))3727 {3728 int v=1;3729 if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))3730 v=(int)(long)h->next->next->Data();3731 res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v);3732 res->rtyp=INT_CMD;3733 return FALSE;3734 }3735 else3736 {3737 WerrorS("Usage: system(\"semaphore\",<cmd>,int)");3738 return TRUE;3739 }3740 }3741 else3742 #endif3743 3838 /*======================= demon_list =====================*/ 3744 3839 if (strcmp(sys_cmd,"denom_list")==0) … … 3750 3845 } 3751 3846 else 3752 /*==================== install newstruct =================*/3753 if (strcmp(sys_cmd,"install")==0)3754 {3755 if ((h!=NULL) && (h->Typ()==STRING_CMD)3756 && (h->next!=NULL) && (h->next->Typ()==STRING_CMD)3757 && (h->next->next!=NULL) && (h->next->next->Typ()==PROC_CMD)3758 && (h->next->next->next!=NULL) && (h->next->next->next->Typ()==INT_CMD))3759 {3760 return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),3761 (int)(long)h->next->next->next->Data(),3762 (procinfov)h->next->next->Data());3763 }3764 return TRUE;3765 }3766 else3767 if (strcmp(sys_cmd,"newstruct")==0)3768 {3769 if ((h!=NULL) && (h->Typ()==STRING_CMD))3770 {3771 int id=0;3772 blackboxIsCmd((char*)h->Data(),id);3773 if (id>0)3774 {3775 blackbox *bb=getBlackboxStuff(id);3776 if (BB_LIKE_LIST(bb))3777 {3778 newstruct_desc desc=(newstruct_desc)bb->data;3779 newstructShow(desc);3780 return FALSE;3781 }3782 }3783 }3784 return TRUE;3785 }3786 else3787 if (strcmp(sys_cmd,"blackbox")==0)3788 {3789 printBlackboxTypes();3790 return FALSE;3791 }3792 else3793 /*==================== reserved port =================*/3794 if (strcmp(sys_cmd,"reserve")==0)3795 {3796 int ssiReservePort(int clients);3797 if ((h!=NULL) && (h->Typ()==INT_CMD))3798 {3799 res->rtyp=INT_CMD;3800 int p=ssiReservePort((int)(long)h->Data());3801 res->data=(void*)(long)p;3802 return (p==0);3803 }3804 else3805 {3806 WerrorS("system(\"reserve\",<int>)");3807 }3808 return TRUE;3809 }3810 else3811 if (strcmp(sys_cmd,"reservedLink")==0)3812 {3813 extern si_link ssiCommandLink();3814 res->rtyp=LINK_CMD;3815 si_link p=ssiCommandLink();3816 res->data=(void*)p;3817 return (p==NULL);3818 }3819 else3820 3847 /*==================== Error =================*/ 3821 3848 Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
Note: See TracChangeset
for help on using the changeset viewer.