|
|
1.1 ! root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.