![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b1lta.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint|
Return to b1lta.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint |
1.1 ! root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */ ! 2: ! 3: /* ! 4: * $Header: b1lta.c,v 1.4 85/08/22 16:49:05 timo Exp $ ! 5: */ ! 6: ! 7: /* Access and update lists and tables */ ! 8: ! 9: #include "b.h" ! 10: #include "b0con.h" ! 11: #include "b1obj.h" ! 12: #ifndef INTEGRATION ! 13: #include "b1btr.h" ! 14: #include "b1val.h" ! 15: #include "b3err.h" ! 16: #include "b3scr.h" /* For at_nwl */ ! 17: #endif ! 18: #include "b1tlt.h" ! 19: ! 20: #ifndef INTEGRATION ! 21: ! 22: #ifndef DEBUG ! 23: #define check(v, where) /*nothing*/ ! 24: #endif DEBUG ! 25: ! 26: #define IsInner(p) (Flag(p) == Inner) ! 27: #define IsBottom(p) (Flag(p) == Bottom) ! 28: ! 29: #define _Pxitm(p, l, iw) (IsInner(p) ? Piitm(p, l, iw) : Pbitm(p, l, iw)) ! 30: ! 31: Hidden itemptr Pxitm(p, l, iw) btreeptr p; intlet l, iw; { ! 32: return _Pxitm(p, l, iw); ! 33: } ! 34: ! 35: #define Inil ((itemptr)0) ! 36: ! 37: #define Incr(p, n) ((p) += (n)) ! 38: ! 39: Visible width itemwidth[4]= {Cw, Lw, Tw, Kw}; ! 40: ! 41: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 42: ! 43: typedef struct { ! 44: btreeptr s_ptr; ! 45: int s_lim; ! 46: } finger[Maxheight], *fingertip; ! 47: ! 48: #define Snil ((fingertip)0) ! 49: ! 50: #define Push(s, p, l) ((s)->s_ptr= (p), ((s)->s_lim= (l)), (s)++) ! 51: #define Top(s, p, l) ((p)= ((s)-1)->s_ptr, (l)= ((s)-1)->s_lim) ! 52: #define Drop(s) (--(s)) ! 53: #define Pop(s, p, l) (--(s), (p)= (s)->s_ptr, (l)= (s)->s_lim) ! 54: /* Pop(s, p, l) is equivalent to Top(s, p, l); Drop(s) */ ! 55: ! 56: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 57: ! 58: Visible fingertip unzip(p, at, s) btreeptr p; int at; fingertip s; { ! 59: int syz; intlet l; ! 60: if (p == Bnil) return s; ! 61: for (;;) { ! 62: if (at <= 0) l= 0; ! 63: else if (at >= Size(p)) l= Lim(p); ! 64: else if (IsInner(p)) { ! 65: l= 0; ! 66: while (at > (syz= Size(Ptr(p, l)))) { ! 67: ++l; ! 68: at -= syz+1; ! 69: } ! 70: } ! 71: else if (at >= Lim(p)) l= Lim(p) - 1; /* for Irange/Crange */ ! 72: else l= at; /* Assume Bottom */ ! 73: Push(s, p, l); ! 74: if (!IsInner(p)) break; ! 75: p= Ptr(p, l); ! 76: } ! 77: return s; ! 78: } ! 79: ! 80: Visible Procedure cpynptrs(to, from, n) btreeptr *to, *from; int n; { ! 81: while (--n >= 0) { ! 82: *to= copybtree(*from); ! 83: Incr(to, 1); ! 84: Incr(from, 1); ! 85: } ! 86: } ! 87: ! 88: Visible int movnptrs(to, from, n) btreeptr *to, *from; int n; { ! 89: int syz= 0; /* Collects sum of sizes */ ! 90: while (--n >= 0) { ! 91: *to= *from; ! 92: syz += Size(*from); ! 93: Incr(to, 1); ! 94: Incr(from, 1); ! 95: } ! 96: return syz; ! 97: } ! 98: ! 99: /* The following two routines may prove machine-dependent when moving ! 100: N pointers is not equivalent to moving N*sizeof(pointer) characters. ! 101: Also, the latter may be slower. */ ! 102: ! 103: Visible Procedure movnitms(to, from, n, iw) itemptr to, from; intlet n, iw; { ! 104: register char *t= (char *)to, *f= (char *)from; ! 105: n *= iw; ! 106: while (--n >= 0) *t++ = *f++; ! 107: } ! 108: ! 109: Hidden Procedure shift(p, l, iw) btreeptr p; intlet l, iw; { ! 110: /* Move items and pointers from l upwards one to the right */ ! 111: btreeptr *to, *from; ! 112: intlet n= (Lim(p)-l) * iw; bool inner= IsInner(p); ! 113: char *f= (char *) Pxitm(p, Lim(p), iw); ! 114: char *t= f+iw; ! 115: while (--n >= 0) *--t = *--f; ! 116: if (inner) { ! 117: from= &Ptr(p, Lim(p)); ! 118: to= from; ! 119: Incr(to, 1); ! 120: n= Lim(p)-l; ! 121: while (--n >= 0) { ! 122: *to= *from; ! 123: Incr(to, -1); ! 124: Incr(from, -1); ! 125: } ! 126: } ! 127: } ! 128: ! 129: Visible Procedure cpynitms(to, from, n, it) itemptr to, from; intlet n, it; { ! 130: intlet i, iw= Itemwidth(it); ! 131: movnitms(to, from, n, iw); ! 132: switch (it) { ! 133: case Lt: ! 134: case Kt: ! 135: case Tt: ! 136: for (i= 0; i < n; ++i) { ! 137: copy(Keyval(to)); ! 138: if (it == Tt) copy(Ascval(to)); ! 139: else if (it == Kt) Ascval(to)= Vnil; ! 140: to= (itemptr) ((char*)to + iw); ! 141: } ! 142: } ! 143: } ! 144: ! 145: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 146: ! 147: /* Uflow uses a character array to hold the items. This may be wrong. */ ! 148: ! 149: Visible Procedure uflow(n, l, cbuf, pbuf, it) ! 150: intlet n, l; char cbuf[]; btreeptr pbuf[]; intlet it; { ! 151: char ncbuf[3*Maxbottom*sizeof(item)], *cp= ncbuf; ! 152: btreeptr npbuf[3*Maxinner], *pp= npbuf, q; ! 153: intlet iw= Itemwidth(it); bool inner= IsInner(pbuf[0]); ! 154: intlet i, j, k, nn, l1= l>0 ? l-1 : l, l2= l<n ? l+1 : l; ! 155: for (i= l1; i <= l2; ++i) { ! 156: q= pbuf[i]; j= Lim(q); ! 157: cpynitms((itemptr)cp, Pxitm(q, 0, iw), j, it); ! 158: cp += j*iw; ! 159: if (inner) { ! 160: cpynptrs(pp, &Ptr(q, 0), j+1); ! 161: Incr(pp, j+1); ! 162: } ! 163: if (i < l2) { ! 164: movnitms((itemptr)cp, (itemptr)(cbuf+i*iw), 1, iw); ! 165: cp += iw; ! 166: } ! 167: relbtree(q, it); ! 168: } ! 169: nn= (cp-ncbuf)/iw; ! 170: k= inner ? Maxinner : Maxbottom; ! 171: if (nn <= k) k= 1; ! 172: else if (nn <= 2*k) k= 2; ! 173: else k= 3; ! 174: /* (k <= l2-l1+1) */ ! 175: cp= ncbuf; pp= npbuf; ! 176: for (i= 0; i < k; ++i) { ! 177: if (i > 0) { ! 178: movnitms((itemptr)(cbuf+(l1+i-1)*iw), (itemptr)cp, 1, iw); ! 179: cp += iw; ! 180: --nn; ! 181: } ! 182: pbuf[l1+i]= q= grabbtreenode(inner ? Inner : Bottom, it); ! 183: Lim(q)= Size(q)= j= nn/(k-i); nn -= j; ! 184: movnitms(Pxitm(q, 0, iw), (itemptr)cp, j, iw); ! 185: cp += j*iw; ! 186: if (inner) { ! 187: Size(q) += movnptrs(&Ptr(q, 0), pp, j+1); ! 188: Incr(pp, j+1); ! 189: } ! 190: } ! 191: if (k < l2-l1+1) { ! 192: movnitms((itemptr)(cbuf+(l1+k-1)*iw), (itemptr)(cbuf+l2*iw), n-l2, iw); ! 193: VOID movnptrs(pbuf+l1+k, pbuf+l2+1, n-l2); ! 194: n -= l2-l1+1 - k; ! 195: } ! 196: return n; ! 197: } ! 198: ! 199: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 200: ! 201: /* Low level access routines */ ! 202: ! 203: /* Meaning of 'flags' parameter to searchkey: */ ! 204: #define NORMAL 0 ! 205: #define UNIQUE 1 /* uniquify visited nodes */ ! 206: #define DYAMAX 2 /* special for dyadic max (= previous element) */ ! 207: #define DYAMIN 4 /* special for dyadic min (= next element) */ ! 208: ! 209: Hidden bool searchkey(v, pw, flags, ft) ! 210: value v, *pw; int flags; fingertip *ft; { ! 211: btreeptr p, *pp; ! 212: intlet l, mid, h, it= Itemtype(*pw), iw= Itemwidth(it); ! 213: bool inner; relation r; ! 214: pp= &Root(*pw); ! 215: if (*pp == Bnil) return No; ! 216: if (flags&UNIQUE) { ! 217: killranges(pw); ! 218: uniql(pw); ! 219: pp= &Root(*pw); ! 220: } ! 221: for (;;) { ! 222: if (flags&UNIQUE) uniqlbtreenode(pp, it); ! 223: p= *pp; ! 224: inner= IsInner(p); ! 225: l= 0; h= Lim(p); ! 226: r= 1; /* For the (illegal?) case that there are no items */ ! 227: while (l < h) { /* Binary search in {l..h-1} */ ! 228: mid= (l+h)/2; ! 229: r= compare(v, Keyval(Pxitm(p, mid, iw))); ! 230: if (!comp_ok) return No; ! 231: if (r == 0) { /* Found it */ ! 232: if (flags&(DYAMIN|DYAMAX)) { ! 233: /* Pretend not found */ ! 234: if (flags&DYAMIN) r= 1; ! 235: else r= -1; ! 236: } ! 237: else { /* Normal case, report success */ ! 238: l= mid; ! 239: break; ! 240: } ! 241: } ! 242: if (r < 0) h= mid; /* Continue in {l..mid-1} */ ! 243: else if (r > 0) l= mid+1; /* Cont. in {mid+1..h-i} */ ! 244: } ! 245: Push(*ft, p, l); ! 246: if (r == 0) return Yes; ! 247: if (!inner) { ! 248: switch (Flag(p)) { ! 249: case Irange: return h > 0 && l < Lim(p) && integral(v); ! 250: case Crange: return h > 0 && l < Lim(p) && character(v); ! 251: default: case Bottom: return No; ! 252: } ! 253: } ! 254: pp= &Ptr(p, l); ! 255: } ! 256: } ! 257: ! 258: Hidden Procedure killranges(pv) value *pv; { ! 259: btreeptr p= Root(*pv); ! 260: if (p == Bnil) return; ! 261: switch (Flag(p)) { ! 262: case Crange: killCrange(p, pv); break; ! 263: case Irange: killIrange(p, pv); break; ! 264: } ! 265: } ! 266: ! 267: Hidden Procedure killCrange(p, pv) btreeptr p; value *pv; { ! 268: value w; intlet lwbchar= Lwbchar(p), upbchar= Upbchar(p); ! 269: release(*pv); ! 270: *pv= mk_elt(); ! 271: do { ! 272: w= mkchar(lwbchar); ! 273: insert(w, pv); ! 274: release(w); ! 275: } while (++lwbchar <= upbchar); ! 276: } ! 277: ! 278: Hidden Procedure killIrange(p, pv) btreeptr p; value *pv; { ! 279: value w, lwb= copy(Lwbval(p)), upb= copy(Upbval(p)); ! 280: release(*pv); ! 281: *pv= mk_elt(); ! 282: do { ! 283: insert(lwb, pv); ! 284: if (compare(lwb, upb) >= 0) break; ! 285: w= lwb; ! 286: lwb= sum(lwb, one); ! 287: release(w); ! 288: } while (still_ok); ! 289: release(lwb); ! 290: release(upb); ! 291: } ! 292: ! 293: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 294: ! 295: Hidden btreeptr rem(f, ft, it) fingertip f, ft; intlet it; { ! 296: btreeptr p, q, *pp; itemptr ip; intlet l, iw= Itemwidth(it); ! 297: bool inner, underflow; ! 298: Pop(ft, p, l); ! 299: inner= IsInner(p); ! 300: if (!inner) ip= Pbitm(p, l, iw); ! 301: else { ! 302: ip= Piitm(p, l, iw); ! 303: do { ! 304: Push(ft, p, l); ! 305: uniqlbtreenode(pp= &Ptr(p, l), it); ! 306: p= *pp; ! 307: l= Lim(p); ! 308: } while (IsInner(p)); ! 309: inner= No; ! 310: l -= 2; /* So the movnitms below works fine */ ! 311: } ! 312: release(Keyval(ip)); ! 313: if (it == Tt || it == Kt) release(Ascval(ip)); ! 314: --Lim(p); ! 315: movnitms(ip, Pbitm(p, l+1, iw), Lim(p)-l, iw); ! 316: for (;;) { ! 317: underflow= Lim(p) < (inner ? Mininner : Minbottom); ! 318: --Size(p); ! 319: if (ft == f) break; ! 320: Pop(ft, p, l); ! 321: if (underflow) ! 322: Lim(p)= uflow(Lim(p), l, (string)Piitm(p, 0, iw), &Ptr(p, 0), it); ! 323: inner= Yes; ! 324: } ! 325: if (Lim(p) == 0) { /* Reduce tree level */ ! 326: q= p; ! 327: p= inner ? copybtree(Ptr(p, 0)) : Bnil; ! 328: relbtree(q, it); ! 329: } ! 330: return p; ! 331: } ! 332: ! 333: Hidden btreeptr ins(ip, f, ft, it) itemptr ip; fingertip f, ft; intlet it; { ! 334: item new, old; btreeptr p, q= Bnil, pq, oldq, *pp; ! 335: intlet l, iw= Itemwidth(it), nn, np, nq; bool inner, overflow; ! 336: if (ft == f) { ! 337: /* unify with rest? */ ! 338: p= grabbtreenode(Bottom, it); ! 339: movnitms(Pbitm(p, 0, iw), ip, 1, iw); ! 340: Lim(p)= Size(p)= 1; ! 341: return p; ! 342: } ! 343: Pop(ft, p, l); ! 344: while (IsInner(p)) { ! 345: Push(ft, p, l); ! 346: uniqlbtreenode(pp= &Ptr(p, l), it); ! 347: p= *pp; ! 348: l= Lim(p); ! 349: } ! 350: overflow= Yes; inner= No; ! 351: for (;;) { ! 352: pq= p; ! 353: if (overflow) { ! 354: oldq= q; ! 355: movnitms(&old, ip, 1, iw); ! 356: ip= &new; ! 357: overflow= Lim(p) == (inner ? Maxinner : Maxbottom); ! 358: if (overflow) { ! 359: nn= Lim(p); np= nn/2; nq= nn-np-1; ! 360: q= grabbtreenode(inner ? Inner : Bottom, it); ! 361: Size(q)= Lim(q)= nq; ! 362: movnitms(&new, Pxitm(p, np, iw), 1, iw); ! 363: movnitms(Pxitm(q, 0, iw), Pxitm(p, np+1, iw), nq, iw); ! 364: if (inner) ! 365: Size(q) += movnptrs(&Ptr(q, 0), &Ptr(p, np+1), nq+1); ! 366: Lim(p)= np; ! 367: Size(p) -= Size(q)+1; ! 368: if (l > np) { ! 369: l -= np+1; ! 370: pq= q; ! 371: } ! 372: } ! 373: shift(pq, l, iw); ! 374: movnitms(Pxitm(pq, l, iw), &old, 1, iw); ! 375: ++Lim(pq); ! 376: if (inner) { ! 377: Size(p) -= Size(oldq); ! 378: Size(pq) += movnptrs(&Ptr(pq, l+1), &oldq, 1); ! 379: } ! 380: } ! 381: ++Size(pq); ! 382: if (ft == f) break; ! 383: Pop(ft, p, l); ! 384: inner= Yes; ! 385: } ! 386: if (overflow) ! 387: p= mknewroot(p, ip, q, it); ! 388: return p; ! 389: } ! 390: ! 391: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 392: ! 393: /* Tables */ ! 394: ! 395: Visible Procedure replace(a, pt, k) value a, *pt, k; { ! 396: item new; finger f; fingertip ft= f; btreeptr p; value *pp; ! 397: intlet it, iw, l; ! 398: check(*pt, " (replace in)"); ! 399: if (Is_ELT(*pt)) { (*pt)->type= Tab; Itemtype(*pt)= Tt; } ! 400: it= Itemtype(*pt); ! 401: if (searchkey(k, pt, UNIQUE, &ft)) { ! 402: iw= Itemwidth(it); ! 403: Pop(ft, p, l); ! 404: pp= &Ascval(Pxitm(p, l, iw)); ! 405: release(*pp); ! 406: *pp= copy(a); ! 407: } ! 408: else { ! 409: if (!comp_ok) return; ! 410: Keyval(&new)= copy(k); Ascval(&new)= copy(a); ! 411: Root(*pt)= ins(&new, f, ft, it); ! 412: } ! 413: check(*pt, " (replace out)"); ! 414: } ! 415: ! 416: Visible /*bool*/ delete(pt, k) value *pt, k; { ! 417: finger f; fingertip ft= f; intlet it= Itemtype(*pt); ! 418: check(*pt, " (delete in)"); ! 419: if (!searchkey(k, pt, UNIQUE, &ft)) return No; ! 420: Root(*pt)= rem(f, ft, it); ! 421: check(*pt, " (delete out)"); ! 422: return Yes; ! 423: } ! 424: ! 425: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 426: ! 427: /* Lists */ ! 428: ! 429: Visible Procedure insert(v, pl) value v, *pl; { ! 430: item new; finger f; fingertip ft= f; intlet it= Itemtype(*pl); ! 431: check(*pl, " (insert in)"); ! 432: if (Is_ELT(*pl)) (*pl)->type= Lis; ! 433: VOID searchkey(v, pl, UNIQUE, &ft); ! 434: if (!comp_ok) return; ! 435: Keyval(&new)= copy(v); Ascval(&new)= Vnil; ! 436: Root(*pl)= ins(&new, f, ft, it); ! 437: check(*pl, " (insert out)"); ! 438: } ! 439: ! 440: Visible Procedure remove(v, pl) value v, *pl; { ! 441: if (!delete(pl, v) && still_ok) ! 442: error(MESS(100, "removing non-existent list entry")); ! 443: } ! 444: ! 445: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 446: ! 447: /* Miscellaneous accesses */ ! 448: ! 449: Hidden itemptr findkey(key, pv, flags) value key, *pv; int flags; { ! 450: finger f; fingertip ft= f; btreeptr p; ! 451: intlet it= Itemtype(*pv), iw= Itemwidth(it), l; ! 452: if (!searchkey(key, pv, flags, &ft)) return Inil; ! 453: Pop(ft, p, l); ! 454: return Pxitm(p, l, iw); ! 455: } ! 456: ! 457: Visible value associate(t, k) value t, k; { /* t[k] */ ! 458: itemptr ip; ! 459: if (!Is_table(t)) { ! 460: error(MESS(101, "in t[k], t is not a table")); ! 461: return Vnil; ! 462: } ! 463: ip= findkey(k, &t, NORMAL); ! 464: if (!ip) { ! 465: if (still_ok) /* Could be type error; then shut up! */ ! 466: error(MESS(102, "key not in table")); ! 467: return Vnil; ! 468: } ! 469: return copy(Ascval(ip)); ! 470: } ! 471: ! 472: Visible value* adrassoc(t, k) value t, k; { /* &t[k] */ ! 473: itemptr ip= findkey(k, &t, NORMAL); ! 474: if (!ip) return Pnil; ! 475: return &Ascval(ip); ! 476: } ! 477: ! 478: Visible bool uniq_assoc(t, k) value t, k; { /* uniql(&t[k]) */ ! 479: itemptr ip= findkey(k, &t, UNIQUE); ! 480: if (ip == Inil) return No; ! 481: uniql(&Ascval(ip)); ! 482: return Yes; ! 483: } ! 484: ! 485: Visible bool in_keys(k, t) value k, t; { /* k in keys t */ ! 486: return findkey(k, &t, NORMAL) != Inil; ! 487: } ! 488: ! 489: Visible value keys(t) value t; { /* keys t */ ! 490: value v; ! 491: if (!Is_table(t)) { ! 492: error(MESS(103, "in keys t, t is not a table")); ! 493: return Vnil; ! 494: } ! 495: v= grab_tlt(Lis, Kt); ! 496: Root(v)= copybtree(Root(t)); ! 497: return v; ! 498: } ! 499: ! 500: /* WARNING! The following routine is not reentrant, since (for range lists) ! 501: it may return a pointer to static storage. */ ! 502: ! 503: Hidden itemptr getkth(k, v) int k; value v; { ! 504: finger f; fingertip ft; btreeptr p; ! 505: intlet it= Itemtype(v), iw= Itemwidth(it), l; ! 506: static item baked; value vk; ! 507: if (Root(v) == Bnil) return Inil; ! 508: ft= unzip(Root(v), k, f); ! 509: do { ! 510: if (ft == f) return Inil; ! 511: Pop(ft, p, l); ! 512: } while (l >= Lim(p)); ! 513: switch (Flag(p)) { ! 514: default: ! 515: case Inner: ! 516: case Bottom: ! 517: return Pxitm(p, l, iw); ! 518: case Irange: ! 519: release(Keyval(&baked)); ! 520: Keyval(&baked)= sum(Lwbval(p), vk= mk_integer(k)); ! 521: release(vk); ! 522: return &baked; ! 523: case Crange: ! 524: release(Keyval(&baked)); ! 525: Keyval(&baked)= mkchar(Lwbchar(p) + k); ! 526: return &baked; ! 527: } ! 528: } ! 529: ! 530: Visible value* key(v, k) value v; intlet k; { /* &(++k th'of keys v) */ ! 531: itemptr ip= getkth(k, v); ! 532: return ip ? &Keyval(ip) : Pnil; ! 533: } ! 534: ! 535: Visible value* assoc(v, k) value v; intlet k; { /* &v[++k th'of keys v] */ ! 536: itemptr ip= getkth(k, v); ! 537: return ip ? &Ascval(ip) : Pnil; ! 538: } ! 539: ! 540: Visible value thof(k, v) int k; value v; { /* k th'of v */ ! 541: itemptr ip= getkth(k-1, v); ! 542: if (!ip) return Vnil; ! 543: switch (Type(v)) { ! 544: case Tex: return mkchar(Charval(ip)); ! 545: case Lis: return copy(Keyval(ip)); ! 546: case Tab: return copy(Ascval(ip)); ! 547: default: return Vnil; ! 548: } ! 549: } ! 550: ! 551: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 552: ! 553: /* Compare B-trees. Should use fingers, but to keep things simple ! 554: (especially in the presence of range type nodes), doesn't. This ! 555: makes its behaviour O(N log N), where it could be O(N), alas. */ ! 556: ! 557: /* WARNING! getkth may return a pointer to static storage (when retrieving ! 558: elements from a range list). Therefore after the second call to getkth, ! 559: the return value of the first may be invalid, but only for lists. ! 560: So we extract the 'Key' values immediately after the call to getkth. */ ! 561: ! 562: Visible relation comp_tlt(u, v) value u, v; { ! 563: itemptr up, vp; int k, ulen, vlen, len; relation r= 0; ! 564: bool tex= Is_text(u), tab= Is_table(u); ! 565: value key_u; ! 566: len= ulen= Tltsize(u); vlen= Tltsize(v); ! 567: if (vlen < len) len= vlen; ! 568: for (k= 0; k < len; ++k) { ! 569: up= getkth(k, u); ! 570: if (!tex) key_u= copy(Keyval(up)); ! 571: vp= getkth(k, v); ! 572: if (tex) r= Charval(up) - Charval(vp); ! 573: else { ! 574: r= compare(key_u, Keyval(vp)); ! 575: release(key_u); ! 576: if (tab && r == 0) ! 577: r= compare(Ascval(up), Ascval(vp)); ! 578: } ! 579: if (r != 0) break; ! 580: } ! 581: if (r == 0) r= ulen - vlen; ! 582: return r; ! 583: } ! 584: ! 585: /* Compare texts. When both texts are bottom nodes, compare with ! 586: strncmp(), to speed up the most common use (look-up by the ! 587: system of tags in a symbol table). Otherwise, call comp_tlt(). */ ! 588: ! 589: Visible relation comp_text(u, v) value u, v; { ! 590: btreeptr p, q; int len; relation r; ! 591: if (!Is_text(u) || !Is_text(v)) syserr(MESS(104, "comp_text")); ! 592: p= Root(u), q= Root(v); ! 593: if (p EQ Bnil) return (q EQ Bnil) ? 0 : -1; ! 594: if (q EQ Bnil) return 1; ! 595: if (Flag(p) EQ Bottom && Flag(q) EQ Bottom) { ! 596: len= Lim(p); ! 597: if (Lim(q) < len) len= Lim(q); ! 598: r= strncmp(&Bchar(p, 0), &Bchar(q, 0), len); ! 599: if (r NE 0) return r; ! 600: return Lim(p) - Lim(q); ! 601: } ! 602: return comp_tlt(u, v); ! 603: } ! 604: ! 605: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 606: ! 607: /* Range type nodes */ ! 608: ! 609: Visible value mk_numrange(lwb, upb) value lwb, upb; { ! 610: value lis; ! 611: btreeptr proot; ! 612: ! 613: lis= grab_tlt(Lis, Lt); ! 614: if (numcomp(lwb, upb) > 0) ! 615: Root(lis)= Bnil; ! 616: else { ! 617: Root(lis)= proot= grabbtreenode(Irange, Lt); ! 618: Lwbval(proot)= copy(lwb); ! 619: Upbval(proot)= copy(upb); ! 620: set_size_and_lim(proot); ! 621: } ! 622: return(lis); ! 623: } ! 624: ! 625: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 626: ! 627: Visible value mk_charrange(lwb, upb) value lwb, upb; { ! 628: value lis; ! 629: btreeptr proot; ! 630: intlet rsyz; ! 631: ! 632: lis= grab_tlt(Lis, Lt); ! 633: rsyz= Bchar(Root(upb), 0) - Bchar(Root(lwb), 0) + 1; ! 634: if (rsyz <= 0) ! 635: Root(lis)= Bnil; ! 636: else { ! 637: Root(lis)= proot= grabbtreenode(Crange, Lt); ! 638: Size(proot)= rsyz; ! 639: Lim(proot)= rsyz > 1 ? 2 : 1; ! 640: Lwbval(proot)= copy(lwb); ! 641: Upbval(proot)= copy(upb); ! 642: } ! 643: return lis; ! 644: } ! 645: ! 646: ! 647: /* set size and lim for integer range node */ ! 648: ! 649: Hidden Procedure set_size_and_lim(pnode) btreeptr pnode; { ! 650: value uml, uml1; ! 651: ! 652: uml= diff(Upbval(pnode), Lwbval(pnode)); ! 653: uml1= sum(uml, one); ! 654: if (large(uml1)) { ! 655: Size(pnode)= Bigsize; ! 656: Lim(pnode)= 2; ! 657: error(MESS(105, "creating list of too many entries")); ! 658: } ! 659: else { ! 660: Size(pnode)= intval(uml1); ! 661: Lim(pnode)= Size(pnode) > 1 ? 2 : 1; ! 662: } ! 663: release(uml); ! 664: release(uml1); ! 665: } ! 666: ! 667: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 668: ! 669: /* Dyadic min, max, size of lists */ ! 670: ! 671: Visible value l2min(e, v) value e, v; { /* e min v */ ! 672: finger f; fingertip ft= f; btreeptr p; ! 673: intlet it= Itemtype(v), iw= Itemwidth(it), l; ! 674: VOID searchkey(e, &v, DYAMIN, &ft); ! 675: for (;;) { ! 676: if (ft == f) return Vnil; ! 677: Top(ft, p, l); ! 678: if (l < Lim(p)) { ! 679: switch (Flag(p)) { ! 680: case Inner: ! 681: return copy(Keyval(Piitm(p, l, iw))); ! 682: case Bottom: ! 683: return copy(Keyval(Pbitm(p, l, iw))); ! 684: case Irange: ! 685: if (l == 0) return copy(Lwbval(p)); ! 686: if (integral(e)) return sum(e, one); ! 687: return ceilf(e); ! 688: case Crange: ! 689: if (l == 0) return copy(Lwbval(p)); ! 690: return mkchar(Bchar(Root(e), 0) + 1); ! 691: } ! 692: } ! 693: Drop(ft); ! 694: } ! 695: } ! 696: ! 697: Visible value l2max(e, v) value e, v; { /* e max v */ ! 698: finger f; fingertip ft= f; btreeptr p; ! 699: intlet it= Itemtype(v), iw= Itemwidth(it), l; ! 700: VOID searchkey(e, &v, DYAMAX, &ft); ! 701: for (;;) { ! 702: if (ft == f) return Vnil; ! 703: Top(ft, p, l); ! 704: --l; ! 705: if (l >= 0) { ! 706: switch (Flag(p)) { ! 707: case Inner: ! 708: return copy(Keyval(Piitm(p, l, iw))); ! 709: case Bottom: ! 710: return copy(Keyval(Pbitm(p, l, iw))); ! 711: case Irange: ! 712: if (l == 1) return copy(Upbval(p)); ! 713: if (integral(e)) return diff(e, one); ! 714: return floorf(e); ! 715: case Crange: ! 716: if (l == 1) return copy(Upbval(p)); ! 717: return mkchar(Bchar(Root(e), 0) - 1); ! 718: } ! 719: } ! 720: Drop(ft); ! 721: } ! 722: } ! 723: ! 724: Visible int l2size(e, v) value e, v; { /* e#v */ ! 725: finger f; fingertip ft= f; btreeptr p; ! 726: int count= 0; intlet it= Itemtype(v), iw= Itemwidth(it), l, r; ! 727: VOID searchkey(e, &v, DYAMIN, &ft); ! 728: for (;;) { ! 729: if (ft == f) return count; ! 730: Pop(ft, p, l); ! 731: while (--l >= 0) { ! 732: r= compare(Keyval(Pxitm(p, l, iw)), e); ! 733: if (r != 0) { ! 734: switch (Flag(p)) { ! 735: case Irange: /* See footnote */ ! 736: if (l==0 && count==0 && integral(e)) ! 737: ++count; ! 738: break; ! 739: case Crange: /* See footnote */ ! 740: if (l==0 && count==0 && !character(e)) ! 741: ++count; ! 742: break; ! 743: } ! 744: return count; ! 745: } ! 746: ++count; ! 747: while (IsInner(p)) { ! 748: Push(ft, p, l); ! 749: p= Ptr(p, l); ! 750: l= Lim(p); ! 751: } ! 752: } ! 753: } ! 754: } ! 755: ! 756: /* Clarification of what happens for x#{a..b}: ! 757: * Consider these five cases: x<a; x=a; a<x<b; x=b; b<x. ! 758: * Only the case a<x<b need be treated specially. How do we find which ! 759: * case we're in? ! 760: * Searchkey gives us the following values for l on the stack, respectively: ! 761: * 0; 1; 1; 2; 2. After --l, this becomes -1; 0; 0; 1; 1. ! 762: * In cases x=a or x=b, the compare returns 0, and we go another time ! 763: * through the loop. So when the compare returns r!=0, the value of l ! 764: * is, respectively: -1; -1; 0; 0; 1. The -1 cases in fact don't even ! 765: * get at the compare, and the correct count is returned automatically. ! 766: * So we need to do extra work only if l==0, except if x==b. ! 767: * The latter condition is cared for by count==0 (if x==b, count is ! 768: * surely >= 1; if a<x<b, count is surely 0). This works even when ! 769: * range nodes may be mixed with other node types in one tree. ! 770: */ ! 771: ! 772: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ ! 773: ! 774: #ifdef DEBUG ! 775: /* Debug code */ ! 776: ! 777: Hidden Procedure check(v, whence) value v; string whence; { ! 778: if (!still_ok) return; ! 779: switch (Type(v)) { ! 780: case ELT: ! 781: return; ! 782: case Lis: ! 783: case Tab: ! 784: break; ! 785: default: ! 786: error3(MESS(106, "value not a list or table"), Vnil, ! 787: MESSMAKE(whence)); ! 788: return; ! 789: } ! 790: if (Root(v) != Bnil) ! 791: VOID cktree(Inil, Root(v), Inil, Itemtype(v), whence); ! 792: if (!still_ok && !interrupted) { ! 793: dumptree(Root(v), 0, Itemtype(v)); ! 794: printf("\n"); ! 795: fflush(stdout); ! 796: } ! 797: } ! 798: ! 799: Hidden int cktree(left, p, right, it, whence) ! 800: itemptr left; btreeptr p; itemptr right; intlet it; string whence; { ! 801: /* returns size of checked subtree */ ! 802: intlet i, iw= Itemwidth(it); int sz= 0; ! 803: if (!still_ok) return 0; ! 804: if (p == Bnil) { ! 805: error3(MESS(107, "unexpected nil subtree"), Vnil, ! 806: MESSMAKE(whence)); ! 807: return 0; ! 808: } ! 809: switch (Flag(p)) { ! 810: case Inner: ! 811: for (i= 0; i < Lim(p); ++i) { ! 812: sz += 1 + ! 813: cktree(left, Ptr(p, i), Piitm(p, i, iw), it, whence); ! 814: if (!still_ok) return; ! 815: left= Piitm(p, i, iw); ! 816: } ! 817: sz += cktree(left, Ptr(p, i), right, it, whence); ! 818: if (still_ok && sz != Size(p)) ! 819: error3(MESS(108, "size mismatch"), Vnil, ! 820: MESSMAKE(whence)); ! 821: break; ! 822: case Bottom: ! 823: for (i= 0; i < Lim(p); ++i) { ! 824: if (left != Inil && compare(Keyval(left), ! 825: Keyval(Pbitm(p, i, iw))) > 0) { ! 826: error3(MESS(109, "bottom items out of order"), ! 827: Vnil, MESSMAKE(whence)); ! 828: break; ! 829: } ! 830: left= Pbitm(p, i, iw); ! 831: sz++; ! 832: } ! 833: if (still_ok && right != Inil ! 834: && compare(Keyval(left), Keyval(right)) > 0) ! 835: error3(MESS(110, "bottom items out of order"), ! 836: Vnil, MESSMAKE(whence)); ! 837: return sz; ! 838: case Irange: ! 839: if (left != Inil && compare(Keyval(left), Lwbval(p)) > 0 ! 840: || right != Inil ! 841: && compare(Upbval(p), Keyval(right)) > 0) ! 842: error3(MESS(111, "irange items out of order"), Vnil, ! 843: MESSMAKE(whence)); ! 844: sz= Size(p); ! 845: default: ! 846: error3(MESS(112, "bad node type"), Vnil, MESSMAKE(whence)); ! 847: } ! 848: return sz; ! 849: } ! 850: #endif DEBUG ! 851: ! 852: #ifdef NOT_USED ! 853: Visible Procedure e_dumptree(v) value v; { ! 854: check(v, ""); ! 855: if (still_ok) { ! 856: if (!at_nwl) printf("\n"); ! 857: dumptree(Root(v), 0, Itemtype(v)); ! 858: printf("\n"); ! 859: fflush(stdout); ! 860: at_nwl= Yes; ! 861: } ! 862: } ! 863: #endif ! 864: ! 865: Hidden Procedure dumptree(p, indent, it) btreeptr p; intlet indent, it; { ! 866: intlet i, iw= Itemwidth(it); ! 867: if (interrupted) return; ! 868: printf("%*s", 3*indent, ""); ! 869: if (p == Bnil) { printf("<nil>"); return; } ! 870: switch (Flag(p)) { ! 871: case Inner: ! 872: printf("(\n"); ! 873: for (i= 0; !interrupted && i <= Lim(p); ++i) { ! 874: if (i > 0) { ! 875: printf("%*s", 3*indent, ""); ! 876: dumpval(Keyval(Piitm(p, i-1, iw))); ! 877: printf("\n"); ! 878: } ! 879: dumptree(Ptr(p, i), indent+1, it); ! 880: printf("\n"); ! 881: } ! 882: printf("%*s", 3*indent, ""); ! 883: printf(")"); ! 884: break; ! 885: case Bottom: ! 886: printf("["); ! 887: for (i= 0; i < Lim(p); ++i) { ! 888: if (i > 0) printf(" "); ! 889: dumpval(Keyval(Pbitm(p, i, iw))); ! 890: } ! 891: printf("]"); ! 892: break; ! 893: case Irange: ! 894: printf("{"); ! 895: dumpval(Lwbval(p)); ! 896: printf(" .. "); ! 897: dumpval(Upbval(p)); ! 898: printf("}"); ! 899: break; ! 900: default: ! 901: printf("?type='%c'?", Flag(p)); ! 902: break; ! 903: } ! 904: } ! 905: ! 906: Hidden Procedure dumpval(v) value v; { ! 907: if (interrupted) return; ! 908: if (v == Vnil) printf("(nil)"); ! 909: else switch(Type(v)) { ! 910: case Num: case Tex: case Lis: case Tab: case ELT: case Com: ! 911: wri(v, No, No, No); ! 912: break; ! 913: default: ! 914: printf("0x%lx", (long)v); ! 915: } ! 916: } ! 917: ! 918: #else INTEGRATION ! 919: ! 920: /* B lists */ ! 921: ! 922: Visible value list_elem(l, i) value l; intlet i; { ! 923: return List_elem(l, i); ! 924: } ! 925: ! 926: Visible insert(v, ll) value v, *ll; { ! 927: intlet len= Length(*ll); register value *lp, *lq; ! 928: intlet k; register intlet kk; ! 929: if (!Is_list(*ll)) { ! 930: error(MESS(113, "inserting in non-list")); ! 931: return; ! 932: } ! 933: VOID found(list_elem, *ll, v, &k); ! 934: if (Unique(*ll) && !Is_ELT(*ll)) { ! 935: xtndlt(ll, 1); ! 936: lq= Ats(*ll)+len; lp= lq-1; ! 937: for (kk= len; kk > k; kk--) *lq--= *lp--; ! 938: *lq= copy(v); ! 939: } else { ! 940: lp= Ats(*ll); ! 941: release(*ll); ! 942: *ll= grab_lis(++len); ! 943: lq= Ats(*ll); ! 944: for (kk= 0; kk < len; kk++) *lq++= copy (kk == k ? v : *lp++); ! 945: } ! 946: } ! 947: ! 948: Visible remove(v, ll) value v; value *ll; { ! 949: register value *lp, *lq; ! 950: intlet k, len= Length(*ll); ! 951: if (!Is_list(*ll)) ! 952: error(MESS(114, "removing from non-list")); ! 953: else if (len == 0) ! 954: error(MESS(115, "removing from empty list")); ! 955: else if (!found(list_elem, *ll, v, &k)) ! 956: error(MESS(116, "removing non-existing list entry")); ! 957: else { ! 958: lp= Ats(*ll); /* lp[k] = v */ ! 959: if (Unique(*ll)) { ! 960: release(*(lp+=k)); ! 961: for (k= k; k < len; k++) {*lp= *(lp+1); lp++;} ! 962: xtndlt(ll, -1); ! 963: } else { ! 964: intlet kk= k; ! 965: lq= Ats(*ll); ! 966: release(*ll); ! 967: *ll= grab_lis(--len); ! 968: lp= Ats(*ll); ! 969: Overall { ! 970: *lp++= copy (*lq++); ! 971: if (k == kk) lq++; ! 972: } ! 973: } ! 974: } ! 975: } ! 976: ! 977: Visible value mk_numrange(a, z) value a, z; { ! 978: value l= mk_elt(), m= copy(a), n; ! 979: ! 980: while (compare(m, z)<=0) { ! 981: insert(m, &l); ! 982: m= sum(n=m, one); ! 983: release(n); ! 984: } ! 985: release(m); ! 986: return l; ! 987: } ! 988: ! 989: Visible value mk_charrange(av, zv) value av, zv; { ! 990: char a= charval(av), z= charval(zv); ! 991: value l= grab_lis((intlet) (z-a+1)); register value *ep= Ats(l); ! 992: char m[2]; ! 993: m[1]= '\0'; ! 994: for (m[0]= a; m[0] <= z; m[0]++) { ! 995: *ep++= mk_text(m); ! 996: } ! 997: return l; ! 998: } ! 999: ! 1000: /**********************************************************************/ ! 1001: ! 1002: /* B tables */ ! 1003: ! 1004: Visible value* key(v, k) value v; intlet k; { /* k in {0..size-1}; no copy */ ! 1005: return Key(v, k); ! 1006: } ! 1007: ! 1008: Visible value* assoc(v, k) value v; intlet k; { /* k in {0..size-1}; no copy */ ! 1009: return Assoc(v, k); ! 1010: } ! 1011: ! 1012: Visible value associate(v, k) value v; value k; { ! 1013: value *p= adrassoc(v, k); ! 1014: if (p) return copy(*p); ! 1015: error(MESS(117, "key not in table")); ! 1016: return Vnil; ! 1017: } ! 1018: ! 1019: Visible value keys(ta) value ta; { ! 1020: ! 1021: if(!Is_table(ta)) { ! 1022: error(MESS(118, "in keys t, t is not a table")); ! 1023: return grab_lis(0); ! 1024: } else { ! 1025: value li= grab_lis(Length(ta)), *le, *te= (value *)Ats(ta); ! 1026: int k, len= Length(ta); ! 1027: le= (value *)Ats(li); ! 1028: Overall { *le++= copy(Cts(*te++)); } ! 1029: return li; ! 1030: } ! 1031: } ! 1032: ! 1033: Visible value key_elem(t, i) value t; intlet i; { /*The key of the i-th entry*/ ! 1034: return *Key(t, i); ! 1035: } ! 1036: ! 1037: /* adrassoc returns a pointer to the associate, rather than ! 1038: the associate itself, so that the caller can decide if a copy ! 1039: should be taken or not. If the key is not found, Pnil is returned. */ ! 1040: Visible value* adrassoc(t, ke) value t, ke; { ! 1041: intlet where; ! 1042: if (Type(t) != Tab && Type(t) != ELT) { ! 1043: error(MESS(119, "selection on non-table")); ! 1044: return Pnil; ! 1045: } ! 1046: return found(key_elem, t, ke, &where) ? Assoc(t, where) : Pnil; ! 1047: } ! 1048: ! 1049: Visible Procedure uniq_assoc(ta, ke) value ta, ke; { ! 1050: intlet k; ! 1051: if (found(key_elem, ta, ke, &k)) { ! 1052: uniql(Ats(ta)+k); ! 1053: uniql(Assoc(ta,k)); ! 1054: } else syserr(MESS(120, "uniq_assoc called for non-existent table entry")); ! 1055: } ! 1056: ! 1057: Visible Procedure replace(v, ta, ke) value *ta, ke, v; { ! 1058: intlet len= Length(*ta); value *tp, *tq; ! 1059: intlet k, kk; ! 1060: uniql(ta); ! 1061: if (Type(*ta) == ELT) (*ta)->type = Tab; ! 1062: else if (Type(*ta) != Tab) { ! 1063: error(MESS(121, "replacing in non-table")); ! 1064: return; ! 1065: } ! 1066: if (found(key_elem, *ta, ke, &k)) { ! 1067: value *a; ! 1068: uniql(Ats(*ta)+k); ! 1069: a= Assoc(*ta, k); ! 1070: uniql(a); ! 1071: release(*a); ! 1072: *a= copy(v); ! 1073: return; ! 1074: } else { ! 1075: xtndlt(ta, 1); ! 1076: tq= Ats(*ta)+len; tp= tq-1; ! 1077: for (kk= len; kk > k; kk--) *tq--= *tp--; ! 1078: *tq= grab_com(2); ! 1079: Cts(*tq)= copy(ke); ! 1080: Dts(*tq)= copy(v); ! 1081: } ! 1082: } ! 1083: ! 1084: Visible bool in_keys(ke, tl) value ke, tl; { ! 1085: intlet dummy; ! 1086: if (Type(tl) == ELT) return No; ! 1087: if (Type(tl) != Tab) syserr(MESS(122, "in_keys applied to non-table")); ! 1088: return found(key_elem, tl, ke, &dummy); ! 1089: } ! 1090: ! 1091: Visible Procedure delete(tl, ke) value *tl, ke; { ! 1092: intlet len, k; value *tp; ! 1093: if (Type(*tl) == ELT) syserr(MESS(123, "deleting table entry from empty table")); ! 1094: if (Type(*tl) != Tab) syserr(MESS(124, "deleting table entry from non-table")); ! 1095: tp= Ats(*tl); len= Length(*tl); ! 1096: if (!found(key_elem, *tl, ke, &k)) ! 1097: syserr(MESS(125, "deleting non-existent table entry")); ! 1098: if (Unique(*tl)) { ! 1099: release(*(tp+=k)); ! 1100: for (k= k; k < len; k++) {*tp= *(tp+1); tp++;} ! 1101: xtndlt(tl, -1); ! 1102: } else { ! 1103: intlet kk; value *tq= Ats(*tl); ! 1104: release(*tl); ! 1105: *tl= grab_tab(--len); ! 1106: tp= Ats(*tl); ! 1107: for (kk= 0; kk < len; kk++) { ! 1108: *tp++= copy (*tq++); ! 1109: if (kk == k) tq++; ! 1110: } ! 1111: } ! 1112: } ! 1113: ! 1114: #endif INTEGRATION
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.