1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */ 2: 3: /* 4: $Header: b1val.c,v 1.4 85/08/22 16:53:49 timo Exp $ 5: */ 6: 7: /* General operations for objects */ 8: 9: #include "b.h" 10: #include "b0con.h" 11: #include "b1obj.h" 12: #include "b1mem.h" 13: #ifndef INTEGRATION 14: #include "b1btr.h" 15: #include "b1val.h" 16: #endif 17: #include "b1tlt.h" 18: #include "b2nod.h" /* for _Nbranches */ 19: #include "b3scr.h" /* TEMPORARY for at_nwl */ 20: #include "b1num.h" /* for ccopy, rrelease, grab, grab_num, grab_rat, grab_approx */ 21: #ifdef INTEGRATION 22: #include "node.h" 23: #endif INTEGRATION 24: 25: #ifdef vax 26: /* 4.2 BSD malloc already takes care of using a small number of sizes */ 27: #define Len len 28: #else 29: #define Len (len < 200 ? len : ((len-1)/8+1)*8) 30: #endif 31: 32: #define Hdrsize (sizeof(struct value)-sizeof(string)) 33: #define Tsize (sizeof(a_telita)) 34: #define Adj(s) (unsigned) (Hdrsize+(s)) 35: #define Unadj(s) (unsigned) ((s)-Hdrsize) 36: #define NodOffset (sizeof(int) + 2*sizeof(intlet)) 37: 38: #define Grabber() {if(len>Maxintlet)syserr(MESS(1800, "big grabber"));} 39: #define Regrabber() {if(len>Maxintlet)syserr(MESS(1801, "big regrabber"));} 40: 41: /*************************** Grabbing ***********************************/ 42: 43: #ifdef NOT_USED 44: long gr= 0; 45: 46: Visible Procedure prgr() {at_nwl=No;printf(" gr:%ld",gr);gr=0;} 47: #endif 48: 49: Hidden unsigned 50: getsyze(type, len, pnptrs) 51: literal type; intlet len; int *pnptrs; 52: { 53: register unsigned syze= 0; 54: register int nptrs= 0; 55: switch (type) { 56: case Num: 57: if (len >= 0) syze= Len*sizeof(digit); /* Integral */ 58: else if (len == -1) { 59: #ifdef EXT_RANGE 60: syze= 2*sizeof(double); /* Approximate */ 61: #else 62: syze= sizeof(double); /* Approximate */ 63: #endif 64: } 65: else { syze= 2*sizeof(value); nptrs= 2; } /* Rational */ 66: break; 67: case Ptn: len= _Nbranches(len); 68: syze= (len+2)*sizeof(value); nptrs= len; break; 69: case Com: syze= len*sizeof(value); nptrs= len; break; 70: 71: case Sim: syze= sizeof(simploc); nptrs= 1; break; 72: case Tri: syze= sizeof(trimloc); nptrs= 3; break; 73: case Tse: syze= sizeof(tbseloc); nptrs= 2; break; 74: case How: syze= sizeof(how); nptrs= 1; break; 75: case For: syze= sizeof(formal); nptrs= 1; /*uname!*/ break; 76: case Per: syze= sizeof(per); nptrs= 1; break; 77: case Fun: 78: case Prd: syze= sizeof(funprd); nptrs= 1; break; 79: case Ref: syze= sizeof(ref); nptrs= 1; break; 80: #ifndef INTEGRATION 81: case Tex: 82: case ELT: 83: case Lis: 84: case Tab: syze= sizeof(value); nptrs= 1; break; 85: #else 86: case Tex: syze= (len+1)*sizeof(char); break; 87: case ELT: 88: case Lis: 89: case Tab: syze = Len*sizeof(value); nptrs= len; break; 90: case Pat: syze= sizeof(struct path) - Hdrsize; nptrs= 2; break; 91: case Nod: syze= sizeof(struct node) - Hdrsize - sizeof(node) 92: + len*sizeof(node); 93: nptrs= len; break; 94: #endif 95: default: 96: printf("\ngetsyze{%c}\n", type); 97: syserr(MESS(1803, "getsyze called with unknown type")); 98: } 99: if (pnptrs != NULL) *pnptrs= nptrs; 100: return syze; 101: } 102: 103: Hidden value 104: grab(type, len) 105: literal type; intlet len; 106: { 107: unsigned syze= getsyze(type, len, (int*)NULL); 108: value v; 109: Grabber(); 110: v= (value) getmem(Adj(syze)); 111: v->type= type; v->len= len; v->refcnt= 1; 112: #ifdef NOT_USED 113: gr+=1; 114: #endif 115: return v; 116: } 117: 118: #ifndef INTEGRATION 119: 120: Visible value grab_tlt(type, it) literal type, it; { return grab(type, it); } 121: 122: #else 123: 124: Visible value grab_tex(len) intlet len; { return grab(Tex, len); } 125: 126: Visible value grab_elt() { return grab(ELT, 0); } 127: 128: Visible value grab_lis(len) intlet len; { return grab(Lis, len); } 129: 130: Visible value grab_tab(len) intlet len; { return grab(Tab, len); } 131: 132: #endif 133: 134: Visible value 135: grab_num(len) 136: register int len; 137: { 138: integer v; 139: register int i; 140: 141: if (len > Maxintlet) { 142: error(MESS(1804, "exceptionally large number")); 143: return Vnil; 144: } 145: if (len < -Maxintlet) len = -2; 146: v = (integer) grab(Num, len); 147: for (i = Length(v)-1; i >= 0; --i) Digit(v, i) = 0; 148: return (value) v; 149: } 150: 151: Visible value grab_rat() { return grab(Num, -2); } 152: 153: Visible value 154: regrab_num(v, len) 155: value v; register int len; 156: { 157: register unsigned syze; 158: 159: syze = Len * sizeof(digit); 160: uniql(&v); 161: regetmem((ptr*)&v, Adj(syze)); 162: Length(v) = len; 163: return v; 164: } 165: 166: Visible value grab_com(len) intlet len; { return grab(Com, len); } 167: 168: Visible value grab_ptn(len) intlet len; { return grab(Ptn, len); } 169: 170: Visible value grab_sim() { return grab(Sim, 0); } 171: 172: Visible value grab_tri() { return grab(Tri, 0); } 173: 174: Visible value grab_tse() { return grab(Tse, 0); } 175: 176: Visible value grab_how() { return grab(How, 0); } 177: 178: Visible value grab_for() { return grab(For, 0); } 179: 180: Visible value grab_per() { return grab(Per, 0); } 181: 182: Visible value grab_fun() { return grab(Fun, 0); } 183: 184: Visible value grab_prd() { return grab(Prd, 0); } 185: 186: Visible value grab_ref() { return grab(Ref, 0); } 187: 188: #ifdef INTEGRATION 189: 190: /* 191: * Allocate a node with nch children. 192: */ 193: 194: Visible node 195: grab_node(nch) 196: register int nch; 197: { 198: register node n = (node) grab(Nod, nch); 199: register int i; 200: 201: n->n_marks = 0; 202: n->n_width = 0; 203: n->n_symbol = 0; 204: for (i = nch-1; i >= 0; --i) 205: n->n_child[i] = Nnil; 206: return n; 207: } 208: 209: /* 210: * Allocate a path. 211: */ 212: 213: Visible path 214: grab_path() 215: { 216: register path p = (path) grab(Pat, 0); 217: 218: p->p_parent = PATHnil; 219: p->p_tree = Nnil; 220: p->p_ichild = 0; 221: p->p_ycoord = 0; 222: p->p_xcoord = 0; 223: p->p_level = 0; 224: p->p_addmarks = 0; 225: p->p_delmarks = 0; 226: return p; 227: } 228: 229: #endif INTEGRATION 230: 231: 232: /******************************* Copying and releasing *********************/ 233: 234: Visible value 235: copy(v) 236: value v; 237: { 238: if (IsSmallInt(v)) return v; 239: if (v != Vnil && v->refcnt < Maxrefcnt) (v->refcnt)++; 240: #ifdef NOT_USED 241: gr+=1; 242: #endif 243: return v; 244: } 245: 246: Visible Procedure 247: release(v) 248: value v; 249: { 250: #ifdef IBMPC 251: literal *r; 252: #else 253: intlet *r; 254: #endif 255: if (IsSmallInt(v)) return; 256: if (v == Vnil) return; 257: r= &(v->refcnt); 258: if (*r == 0) syserr(MESS(1805, "releasing unreferenced value")); 259: if (bugs) { 260: printf("releasing: "); 261: if (Type(v) == Num) bugs= No; 262: wri(v,No,No,No); newline(); 263: bugs= Yes; 264: } 265: if (*r < Maxrefcnt && --(*r) == 0) rrelease(v); 266: #ifdef NOT_USED 267: gr-=1; 268: #endif 269: } 270: 271: Hidden value 272: ccopy(v) 273: value v; 274: { 275: literal type= v->type; intlet len; value w; 276: int nptrs; unsigned syze; register string from, to, end; 277: register value p, *pp, *pend; 278: len= Length(v); 279: syze= getsyze(type, len, &nptrs); 280: Grabber(); 281: w= (value) getmem(Adj(syze)); 282: w->type= type; w->len= len; w->refcnt= 1; 283: from= Str(v); to= Str(w); end= to+syze; 284: while (to < end) *to++ = *from++; 285: pp= Ats(w); 286: #ifdef INTEGRATION 287: if (type == Nod) pp= (value*) ((char*)pp + NodOffset); 288: #endif 289: pend= pp+nptrs; 290: while (pp < pend) { 291: p= *pp++; 292: if (p != Vnil && !IsSmallInt(p) && Refcnt(p) < Maxrefcnt) 293: ++Refcnt(p); 294: } 295: return w; 296: } 297: 298: Visible Procedure 299: uniql(ll) 300: value *ll; 301: { 302: if (*ll != Vnil && !IsSmallInt(*ll) && (*ll)->refcnt > 1) { 303: value c= ccopy(*ll); 304: release(*ll); 305: *ll= c; 306: } 307: } 308: 309: Hidden Procedure 310: rrelease(v) 311: value v; 312: { 313: literal type= v->type; intlet len; 314: int nptrs; register value *pp, *pend; 315: len= Length(v); 316: #ifndef INTEGRATION 317: switch (type) { 318: case Tex: 319: case Tab: 320: case Lis: 321: case ELT: 322: relbtree(Root(v), Itemtype(v)); 323: break; 324: default: 325: #endif 326: VOID getsyze(type, len, &nptrs); 327: pp= Ats(v); 328: #ifdef INTEGRATION 329: if (type == Nod) pp= (value*) ((char*)pp + NodOffset); 330: #endif 331: pend= pp+nptrs; 332: while (pp < pend) release(*pp++); 333: #ifndef INTEGRATION 334: } 335: #endif 336: v->type= '\0'; freemem((ptr) v); 337: } 338: 339: #ifdef INTEGRATION 340: 341: Visible Procedure 342: xtndtex(a, d) 343: value *a; intlet d; 344: { 345: intlet len= Length(*a)+d; 346: Regrabber(); 347: regetmem((ptr *) a, Adj((len+1)*sizeof(char))); 348: (*a)->len= len; 349: } 350: 351: Visible Procedure 352: xtndlt(a, d) 353: value *a; intlet d; 354: { 355: intlet len= Length(*a); intlet l1= Len, l2; 356: len+= d; l2= Len; 357: if (l1 != l2) { 358: Regrabber(); 359: regetmem((ptr *) a, Adj(l2*sizeof(value))); 360: } 361: (*a)->len= len; 362: } 363: 364: /* 365: * Set an object's refcnt to infinity, so it will never be released. 366: */ 367: 368: Visible Procedure 369: fix_refcnt(v) 370: register value v; 371: { 372: register int i; 373: register node n; 374: register path p; 375: 376: Assert(v->refcnt > 0); 377: v->refcnt = Maxrefcnt; 378: switch (v->type) { 379: case Tex: 380: break; 381: case Nod: 382: n = (node)v; 383: for (i = v->len - 1; i >= 0; --i) 384: if (n->n_child[i]) 385: fix_refcnt((value)(n->n_child[i])); 386: break; 387: case Pat: 388: p = (path)v; 389: if (p->p_parent) 390: fix_refcnt((value)(p->p_parent)); 391: if (p->p_tree) 392: fix_refcnt((value)(p->p_tree)); 393: break; 394: default: 395: Abort(); 396: } 397: } 398: 399: #endif INTEGRATION 400: 401: #ifndef INTEGRATION 402: 403: /*********************************************************************/ 404: /* grab, copy, release of btree(node)s 405: /*********************************************************************/ 406: 407: Visible btreeptr 408: grabbtreenode(flag, it) 409: literal flag; literal it; 410: { 411: btreeptr pnode; unsigned syz; 412: static intlet isize[]= { 413: sizeof(itexnode), sizeof(ilisnode), 414: sizeof(itabnode), sizeof(itabnode)}; 415: static intlet bsize[]= { 416: sizeof(btexnode), sizeof(blisnode), 417: sizeof(btabnode), sizeof(btabnode)}; 418: switch (flag) { 419: case Inner: 420: syz= isize[it]; 421: break; 422: case Bottom: 423: syz= bsize[it]; 424: break; 425: case Irange: 426: case Crange: 427: syz = sizeof(rangenode); 428: break; 429: } 430: pnode = (btreeptr) getmem((unsigned) syz); 431: Refcnt(pnode) = 1; 432: Flag(pnode) = flag; 433: return(pnode); 434: } 435: 436: /* ----------------------------------------------------------------- */ 437: 438: Visible btreeptr copybtree(pnode) btreeptr pnode; { 439: if (pnode != Bnil && Refcnt(pnode) < Maxrefcnt) ++Refcnt(pnode); 440: return(pnode); 441: } 442: 443: Visible Procedure uniqlbtreenode(pptr, it) btreeptr *pptr; literal it; { 444: if (*pptr NE Bnil && Refcnt(*pptr) > 1) { 445: btreeptr qnode = *pptr; 446: *pptr = ccopybtreenode(*pptr, it); 447: relbtree(qnode, it); 448: } 449: } 450: 451: Visible btreeptr ccopybtreenode(pnode, it) btreeptr pnode; literal it; { 452: intlet limp; 453: btreeptr qnode; 454: intlet iw; 455: 456: iw = Itemwidth(it); 457: qnode = grabbtreenode(Flag(pnode), it); 458: Lim(qnode) = limp = Lim(pnode); 459: Size(qnode) = Size(pnode); 460: switch (Flag(qnode)) { 461: case Inner: 462: cpynitms(Piitm(qnode, 0, iw), Piitm(pnode, 0, iw), limp, it); 463: cpynptrs(&Ptr(qnode, 0), &Ptr(pnode, 0), limp+1); 464: break; 465: case Bottom: 466: cpynitms(Pbitm(qnode, 0, iw), Pbitm(pnode, 0, iw), limp, it); 467: break; 468: case Irange: 469: case Crange: 470: Lwbval(qnode) = copy(Lwbval(pnode)); 471: Upbval(qnode) = copy(Upbval(pnode)); 472: break; 473: default: 474: syserr(MESS(1808, "unknown flag in ccopybtreenode")); 475: } 476: return(qnode); 477: } 478: 479: /* make a new root (after the old ptr0 split) */ 480: 481: Visible btreeptr mknewroot(ptr0, pitm0, ptr1, it) 482: btreeptr ptr0, ptr1; itemptr pitm0; literal it; 483: { 484: int r; 485: intlet iw = Itemwidth(it); 486: btreeptr qnode = grabbtreenode(Inner, it); 487: Ptr(qnode, 0) = ptr0; 488: movnitms(Piitm(qnode, 0, iw), pitm0, 1, iw); 489: Ptr(qnode, 1) = ptr1; 490: Lim(qnode) = 1; 491: r= Sincr(Size(ptr0)); 492: Size(qnode) = Ssum(r, Size(ptr1)); 493: return(qnode); 494: } 495: 496: /* ----------------------------------------------------------------- */ 497: 498: /* release btree */ 499: 500: Visible Procedure relbtree(pnode, it) btreeptr pnode; literal it; { 501: width iw; 502: 503: iw = Itemwidth(it); 504: if (pnode EQ Bnil) 505: return; 506: if (Refcnt(pnode) EQ 0) { 507: syserr(MESS(1809, "releasing unreferenced btreenode")); 508: return; 509: } 510: if (Refcnt(pnode) < Maxrefcnt && --Refcnt(pnode) EQ 0) { 511: intlet l; 512: switch (Flag(pnode)) { 513: case Inner: 514: for (l = 0; l < Lim(pnode); l++) { 515: relbtree(Ptr(pnode, l), it); 516: switch (it) { 517: case Tt: 518: case Kt: 519: release(Ascval(Piitm(pnode, l, iw))); 520: case Lt: 521: release(Keyval(Piitm(pnode, l, iw))); 522: } 523: } 524: relbtree(Ptr(pnode, l), it); 525: break; 526: case Bottom: 527: for (l = 0; l < Lim(pnode); l++) { 528: switch (it) { 529: case Tt: 530: case Kt: 531: release(Ascval(Pbitm(pnode, l, iw))); 532: case Lt: 533: release(Keyval(Pbitm(pnode, l, iw))); 534: } 535: } 536: break; 537: case Irange: 538: case Crange: 539: release(Lwbval(pnode)); 540: release(Upbval(pnode)); 541: break; 542: default: 543: syserr(MESS(1810, "wrong flag in relbtree()")); 544: } 545: freemem((ptr) pnode); 546: } 547: } 548: 549: #endif !INTEGRATION