Changeset 752f86 in git
- Timestamp:
- Dec 10, 2003, 5:28:03 PM (20 years ago)
- Branches:
- (u'spielwiese', '5b153614cbc72bfa198d75b1e9e33dab2645d9fe')
- Children:
- a830d2b37c7773703c1a3bd90df80f6f51dfc703
- Parents:
- e5a253c36a55093898d26a21f0ebdff4b3b6d024
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
kernel/ring.cc
re5a253 r752f86 2 2 * Computer Algebra System SINGULAR * 3 3 ****************************************/ 4 /* $Id: ring.cc,v 1. 1.1.1 2003-10-06 12:15:55Singular Exp $ */4 /* $Id: ring.cc,v 1.2 2003-12-10 16:28:03 Singular Exp $ */ 5 5 6 6 /* … … 105 105 } 106 106 107 void rSetHdl(idhdl h)108 {109 int i;110 ring rg = NULL;111 if (h!=NULL)112 {113 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));114 rg = IDRING(h);115 omCheckAddrSize((ADDRESS)h,sizeof(idrec));116 if (IDID(h)) // OB: ????117 omCheckAddr((ADDRESS)IDID(h));118 rTest(rg);119 }120 121 // clean up history122 if (sLastPrinted.RingDependend())123 {124 sLastPrinted.CleanUp();125 memset(&sLastPrinted,0,sizeof(sleftv));126 }127 128 /*------------ change the global ring -----------------------*/129 rChangeCurrRing(rg);130 currRingHdl = h;131 }132 107 133 108 ring rDefault(int ch, int N, char **n) … … 207 182 208 183 // set R->order, R->block, R->wvhdl, r->OrdSgn from sleftv 209 static BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R) 210 { 211 int last = 0, o=0, n = 1, i=0, typ = 1, j; 212 sleftv *sl = ord; 213 214 // determine nBlocks 215 while (sl!=NULL) 216 { 217 intvec *iv = (intvec *)(sl->data); 218 if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C)) i++; 219 else if ((*iv)[1]==ringorder_L) 220 { 221 R->bitmask=(*iv)[2]; 222 n--; 223 } 224 else if ((*iv)[1]!=ringorder_a) o++; 225 n++; 226 sl=sl->next; 227 } 228 // check whether at least one real ordering 229 if (o==0) 230 { 231 WerrorS("invalid combination of orderings"); 232 return TRUE; 233 } 234 // if no c/C ordering is given, increment n 235 if (i==0) n++; 236 else if (i != 1) 237 { 238 // throw error if more than one is given 239 WerrorS("more than one ordering c/C specified"); 240 return TRUE; 241 } 242 243 // initialize fields of R 244 R->order=(int *)omAlloc0(n*sizeof(int)); 245 R->block0=(int *)omAlloc0(n*sizeof(int)); 246 R->block1=(int *)omAlloc0(n*sizeof(int)); 247 R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr)); 248 249 // init order, so that rBlocks works correctly 250 for (j=0; j < n-1; j++) 251 R->order[j] = (int) ringorder_unspec; 252 // set last _C order, if no c/C order was given 253 if (i == 0) R->order[n-2] = ringorder_C; 254 255 /* init orders */ 256 sl=ord; 257 n=-1; 258 while (sl!=NULL) 259 { 260 intvec *iv; 261 iv = (intvec *)(sl->data); 262 if ((*iv)[1]!=ringorder_L) 263 { 264 n++; 265 266 /* the format of an ordering: 267 * iv[0]: factor 268 * iv[1]: ordering 269 * iv[2..end]: weights 270 */ 271 R->order[n] = (*iv)[1]; 272 switch ((*iv)[1]) 273 { 274 case ringorder_ws: 275 case ringorder_Ws: 276 typ=-1; 277 case ringorder_wp: 278 case ringorder_Wp: 279 R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int)); 280 for (i=2; i<iv->length(); i++) 281 R->wvhdl[n][i-2] = (*iv)[i]; 282 R->block0[n] = last+1; 283 last += iv->length()-2; 284 R->block1[n] = last; 285 break; 286 case ringorder_ls: 287 case ringorder_ds: 288 case ringorder_Ds: 289 typ=-1; 290 case ringorder_lp: 291 case ringorder_dp: 292 case ringorder_Dp: 293 case ringorder_rp: 294 R->block0[n] = last+1; 295 if (iv->length() == 3) last+=(*iv)[2]; 296 else last += (*iv)[0]; 297 R->block1[n] = last; 298 if (rCheckIV(iv)) return TRUE; 299 break; 300 case ringorder_S: 301 case ringorder_c: 302 case ringorder_C: 303 if (rCheckIV(iv)) return TRUE; 304 break; 305 case ringorder_aa: 306 case ringorder_a: 307 R->block0[n] = last+1; 308 R->block1[n] = min(last+iv->length()-2 , R->N); 309 R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int)); 310 for (i=2; i<iv->length(); i++) 311 { 312 R->wvhdl[n][i-2]=(*iv)[i]; 313 if ((*iv)[i]<0) typ=-1; 314 } 315 break; 316 case ringorder_M: 317 { 318 int Mtyp=rTypeOfMatrixOrder(iv); 319 if (Mtyp==0) return TRUE; 320 if (Mtyp==-1) typ = -1; 321 322 R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int)); 323 for (i=2; i<iv->length();i++) 324 R->wvhdl[n][i-2]=(*iv)[i]; 325 326 R->block0[n] = last+1; 327 last += (int)sqrt((double)(iv->length()-2)); 328 R->block1[n] = last; 329 break; 330 } 331 332 case ringorder_no: 333 R->order[n] = ringorder_unspec; 334 return TRUE; 335 336 default: 337 Werror("Internal Error: Unknown ordering %d", (*iv)[1]); 338 R->order[n] = ringorder_unspec; 339 return TRUE; 340 } 341 } 342 sl=sl->next; 343 } 344 345 // check for complete coverage 346 if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--; 347 if (R->block1[n] != R->N) 348 { 349 if (((R->order[n]==ringorder_dp) || 350 (R->order[n]==ringorder_ds) || 351 (R->order[n]==ringorder_Dp) || 352 (R->order[n]==ringorder_Ds) || 353 (R->order[n]==ringorder_rp) || 354 (R->order[n]==ringorder_lp) || 355 (R->order[n]==ringorder_ls)) 356 && 357 R->block0[n] <= R->N) 358 { 359 R->block1[n] = R->N; 360 } 361 else 362 { 363 Werror("mismatch of number of vars (%d) and ordering (%d vars)", 364 R->N,R->block1[n]); 365 return TRUE; 366 } 367 } 368 R->OrdSgn = typ; 369 return FALSE; 370 } 184 BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R); 371 185 372 186 // get array of strings from list of sleftv's 373 static BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p) 374 { 375 376 while(sl!=NULL) 377 { 378 if (sl->Name() == sNoName) 379 { 380 if (sl->Typ()==POLY_CMD) 381 { 382 sleftv s_sl; 383 iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl); 384 if (s_sl.Name() != sNoName) 385 *p = omStrDup(s_sl.Name()); 386 else 387 *p = NULL; 388 sl->next = s_sl.next; 389 s_sl.next = NULL; 390 s_sl.CleanUp(); 391 if (*p == NULL) return TRUE; 392 } 393 else 394 return TRUE; 395 } 396 else 397 *p = omStrDup(sl->Name()); 398 p++; 399 sl=sl->next; 400 } 401 return FALSE; 402 } 403 404 405 //////////////////// 406 // 407 // rInit itself: 408 // 409 // INPUT: s: name, pn: ch & parameter (names), rv: variable (names) 410 // ord: ordering 411 // RETURN: currRingHdl on success 412 // NULL on error 413 // NOTE: * makes new ring to current ring, on success 414 // * considers input sleftv's as read-only 415 //idhdl rInit(char *s, sleftv* pn, sleftv* rv, sleftv* ord) 416 ring rInit(sleftv* pn, sleftv* rv, sleftv* ord) 417 { 418 int ch; 419 int float_len=0; 420 int float_len2=0; 421 ring R = NULL; 422 idhdl tmp = NULL; 423 BOOLEAN ffChar=FALSE; 424 int typ = 1; 425 426 /* ch -------------------------------------------------------*/ 427 // get ch of ground field 428 int numberOfAllocatedBlocks; 429 430 if (pn->Typ()==INT_CMD) 431 { 432 ch=(int)pn->Data(); 433 } 434 else if ((pn->name != NULL) 435 && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0))) 436 { 437 BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0); 438 ch=-1; 439 if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD)) 440 { 441 float_len=(int)pn->next->Data(); 442 float_len2=float_len; 443 pn=pn->next; 444 if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD)) 445 { 446 float_len2=(int)pn->next->Data(); 447 pn=pn->next; 448 } 449 } 450 if ((pn->next==NULL) && complex_flag) 451 { 452 pn->next=(leftv)omAlloc0Bin(sleftv_bin); 453 pn->next->name=omStrDup("i"); 454 } 455 } 456 else 457 { 458 Werror("Wrong ground field specification"); 459 goto rInitError; 460 } 461 pn=pn->next; 462 463 int l, last; 464 sleftv * sl; 465 /*every entry in the new ring is initialized to 0*/ 466 467 /* characteristic -----------------------------------------------*/ 468 /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len 469 * 0 1 : Q(a,...) *names FALSE 470 * 0 -1 : R NULL FALSE 0 471 * 0 -1 : R NULL FALSE prec. >6 472 * 0 -1 : C *names FALSE prec. 0..? 473 * p p : Fp NULL FALSE 474 * p -p : Fp(a) *names FALSE 475 * q q : GF(q=p^n) *names TRUE 476 */ 477 if (ch!=-1) 478 { 479 int l = 0; 480 481 if (ch!=0 && (ch<2) 482 #ifndef NV_OPS 483 || (ch > 32003) 484 #endif 485 ) 486 { 487 Warn("%d is invalid characteristic of ground field. 32003 is used.", ch); 488 ch=32003; 489 } 490 // load fftable, if necessary 491 if (pn!=NULL) 492 { 493 while ((ch!=fftable[l]) && (fftable[l])) l++; 494 if (fftable[l]==0) ch = IsPrime(ch); 495 else 496 { 497 char *m[1]={(char *)sNoName}; 498 nfSetChar(ch,m); 499 if (errorreported) goto rInitError; 500 else ffChar=TRUE; 501 } 502 } 503 else 504 ch = IsPrime(ch); 505 } 506 // allocated ring and set ch 507 R = (ring) omAlloc0Bin(sip_sring_bin); 508 R->ch = ch; 509 if (ch == -1) 510 { 511 R->float_len= min(float_len,32767); 512 R->float_len2= min(float_len2,32767); 513 } 514 515 /* parameter -------------------------------------------------------*/ 516 if (pn!=NULL) 517 { 518 R->P=pn->listLength(); 519 //if ((ffChar|| (ch == 1)) && (R->P > 1)) 520 if ((R->P > 1) && (ffChar || (ch == -1))) 521 { 522 WerrorS("too many parameters"); 523 goto rInitError; 524 } 525 R->parameter=(char**)omAlloc0(R->P*sizeof(char_ptr)); 526 if (rSleftvList2StringArray(pn, R->parameter)) 527 { 528 WerrorS("parameter expected"); 529 goto rInitError; 530 } 531 if (ch>1 && !ffChar) R->ch=-ch; 532 else if (ch==0) R->ch=1; 533 } 534 else if (ffChar) 535 { 536 WerrorS("need one parameter"); 537 goto rInitError; 538 } 539 /* post-processing of field description */ 540 // we have short reals, but no short complex 541 if ((R->ch == - 1) 542 && (R->parameter !=NULL) 543 && (R->float_len < SHORT_REAL_LENGTH)) 544 { 545 R->float_len = SHORT_REAL_LENGTH; 546 R->float_len2 = SHORT_REAL_LENGTH; 547 } 548 549 /* names and number of variables-------------------------------------*/ 550 { 551 int l=rv->listLength(); 552 #if SIZEOF_SHORT == 2 553 #define MAX_SHORT 0x7fff 554 #endif 555 if (l>MAX_SHORT) 556 { 557 Werror("too many ring variables(%d), max is %d",l,MAX_SHORT); 558 goto rInitError; 559 } 560 R->N = l; /*rv->listLength();*/ 561 } 562 R->names = (char **)omAlloc0(R->N * sizeof(char_ptr)); 563 if (rSleftvList2StringArray(rv, R->names)) 564 { 565 WerrorS("name of ring variable expected"); 566 goto rInitError; 567 } 568 569 /* check names and parameters for conflicts ------------------------- */ 570 { 571 int i,j; 572 for(i=0;i<R->P; i++) 573 { 574 for(j=0;j<R->N;j++) 575 { 576 if (strcmp(R->parameter[i],R->names[j])==0) 577 { 578 Werror("parameter %d conflicts with variable %d",i+1,j+1); 579 goto rInitError; 580 } 581 } 582 } 583 } 584 /* ordering -------------------------------------------------------------*/ 585 if (rSleftvOrdering2Ordering(ord, R)) 586 goto rInitError; 587 588 // Complete the initialization 589 if (rComplete(R,1)) 590 goto rInitError; 591 592 rTest(R); 593 594 // try to enter the ring into the name list 595 // need to clean up sleftv here, before this ring can be set to 596 // new currRing or currRing can be killed beacuse new ring has 597 // same name 598 if (pn != NULL) pn->CleanUp(); 599 if (rv != NULL) rv->CleanUp(); 600 if (ord != NULL) ord->CleanUp(); 601 //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL) 602 // goto rInitError; 603 604 //memcpy(IDRING(tmp),R,sizeof(*R)); 605 // set current ring 606 //omFreeBin(R, ip_sring_bin); 607 //return tmp; 608 return R; 609 610 // error case: 611 rInitError: 612 if (R != NULL) rDelete(R); 613 if (pn != NULL) pn->CleanUp(); 614 if (rv != NULL) rv->CleanUp(); 615 if (ord != NULL) ord->CleanUp(); 616 return NULL; 617 } 187 BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p); 188 618 189 619 190 /*2 … … 843 414 } 844 415 omFreeBin(r, ip_sring_bin); 845 }846 847 void rKill(ring r)848 {849 if ((r->ref<=0)&&(r->order!=NULL))850 {851 #ifdef RDEBUG852 if (traceit &TRACE_SHOW_RINGS) Print("kill ring %x\n",r);853 #endif854 if (r==currRing)855 {856 if (r->qideal!=NULL)857 {858 idDelete(&r->qideal);859 r->qideal=NULL;860 currQuotient=NULL;861 }862 if (ppNoether!=NULL) pDelete(&ppNoether);863 if (sLastPrinted.RingDependend())864 {865 sLastPrinted.CleanUp();866 }867 if ((myynest>0) && (iiRETURNEXPR[myynest].RingDependend()))868 {869 WerrorS("return value depends on local ring variable (export missing ?)");870 iiRETURNEXPR[myynest].CleanUp();871 }872 currRing=NULL;873 currRingHdl=NULL;874 }875 else if (r->qideal!=NULL)876 {877 id_Delete(&r->qideal, r);878 r->qideal = NULL;879 }880 #ifdef HAVE_PLURAL881 // delete noncommutative extension882 if (r->nc!=NULL)883 {884 if (r->nc->ref>1) r->nc->ref--;885 else ncKill(r);886 }887 #endif888 nKillChar(r);889 int i=1;890 int j;891 int *pi=r->order;892 #ifdef USE_IILOCALRING893 for (j=0;j<iiRETURNEXPR_len;j++)894 {895 if (iiLocalRing[j]==r)896 {897 if (j<myynest) Warn("killing the basering for level %d",j);898 iiLocalRing[j]=NULL;899 }900 }901 #else /* USE_IILOCALRING */902 //#endif /* USE_IILOCALRING */903 {904 proclevel * nshdl = procstack;905 int lev=myynest-1;906 907 for(; nshdl != NULL; nshdl = nshdl->next)908 {909 if (nshdl->cRing==r)910 {911 Warn("killing the basering for level %d",lev);912 nshdl->cRing=NULL;913 nshdl->cRingHdl=NULL;914 }915 }916 }917 #endif /* USE_IILOCALRING */918 919 rDelete(r);920 return;921 }922 r->ref--;923 }924 925 void rKill(idhdl h)926 {927 ring r = IDRING(h);928 int ref=0;929 if (r!=NULL)930 {931 ref=r->ref;932 rKill(r);933 }934 if (h==currRingHdl)935 {936 if (ref<=0) { currRing=NULL; currRingHdl=NULL;}937 else938 {939 currRingHdl=rFindHdl(r,currRingHdl,NULL);940 }941 }942 }943 944 idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n=NULL)945 {946 idhdl h=root;947 while (h!=NULL)948 {949 if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))950 && (h!=n)951 && (h->data.uring==r)952 )953 return h;954 h=IDNEXT(h);955 }956 return NULL;957 416 } 958 417
Note: See TracChangeset
for help on using the changeset viewer.