|
|
1.1 ! root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */ ! 2: static char rcsid[] = "$Header: bobj.c,v 2.5 85/08/22 15:59:59 timo Exp $"; ! 3: ! 4: /* ! 5: * B editor -- A shrunken version of the B interpreter's run-time system. ! 6: */ ! 7: ! 8: #include "b.h" ! 9: #include "bobj.h" ! 10: #include "node.h" ! 11: ! 12: #define COMPOUNDS ! 13: ! 14: string malloc(); ! 15: string calloc(); ! 16: string realloc(); ! 17: string strcpy(); ! 18: ! 19: extern bool dflag; ! 20: ! 21: struct head { ! 22: char type; ! 23: intlet refcnt; ! 24: intlet len; ! 25: }; ! 26: #define Intsize (sizeof(int)) ! 27: #define Hsize (sizeof(struct head)) ! 28: #define Headsize (((Hsize-1)/Intsize + 1) * Intsize) ! 29: ! 30: #define Field(v, i) (((value *)&(v)->cts)[i]) ! 31: ! 32: #ifndef NDEBUG ! 33: ! 34: /* Statistics on allocation/sharing */ ! 35: ! 36: int nobjs; ! 37: int nrefs; ! 38: ! 39: #define Increfs ++nrefs ! 40: #define Decrefs --nrefs ! 41: ! 42: #else NDEBUG ! 43: ! 44: #define Increfs ! 45: #define Decrefs ! 46: ! 47: #endif NDEBUG ! 48: ! 49: ! 50: #define Copy(v) if ((v) && Refcnt(v) < Maxintlet) { ++Refcnt(v); Increfs; } ! 51: #define Release(v) if (!(v) || Refcnt(v) == Maxintlet) ; else RRelease(v) ! 52: #define RRelease(v) \ ! 53: if (Refcnt(v) > 1) { --Refcnt(v); Decrefs; } else release(v) ! 54: ! 55: ! 56: /* ! 57: * Allocate a value with nbytes of data after the usual type, len, refcnt ! 58: * fields. ! 59: */ ! 60: ! 61: value ! 62: grabber(nbytes) ! 63: register int nbytes; ! 64: { ! 65: register value v = (value) malloc((unsigned) (Headsize + nbytes)); ! 66: ! 67: if (!v) ! 68: syserr("grabber: malloc"); ! 69: #ifndef NDEBUG ! 70: if (dflag) ! 71: newval(v); ! 72: #endif ! 73: #ifndef NDEBUG ! 74: ++nobjs; ! 75: #endif ! 76: Increfs; ! 77: v->refcnt = 1; ! 78: return v; ! 79: } ! 80: ! 81: ! 82: /* ! 83: * Reallocate a value with nbytes of data after the usual type, len, refcnt ! 84: * fields. ! 85: */ ! 86: ! 87: value ! 88: regrabber(v, nbytes) ! 89: register value v; ! 90: register int nbytes; ! 91: { ! 92: Assert(v && v->refcnt == 1); ! 93: v = (value) realloc((char*)v, (unsigned) (Headsize + nbytes)); ! 94: if (!v) ! 95: syserr("regrabber: realloc"); ! 96: return v; ! 97: } ! 98: ! 99: ! 100: /* ! 101: * Set an object's refcnt to infinity, so it will never be released. ! 102: */ ! 103: ! 104: fix(v) ! 105: register value v; ! 106: { ! 107: register int i; ! 108: register node n; ! 109: register path p; ! 110: ! 111: Assert(v->refcnt > 0); ! 112: #ifndef NDEBUG ! 113: if (v->refcnt < Maxintlet) ! 114: nrefs -= v->refcnt; ! 115: #endif ! 116: v->refcnt = Maxintlet; ! 117: #if OBSOLETE ! 118: switch (v->type) { ! 119: case Tex: ! 120: break; ! 121: case Nod: ! 122: n = (node)v; ! 123: for (i = v->len - 1; i >= 0; --i) ! 124: if (n->n_child[i]) ! 125: fix((value)(n->n_child[i])); ! 126: break; ! 127: case Pat: ! 128: p = (path)v; ! 129: if (p->p_parent) ! 130: fix((value)(p->p_parent)); ! 131: if (p->p_tree) ! 132: fix((value)(p->p_tree)); ! 133: break; ! 134: #ifdef COMPOUNDS ! 135: case Com: ! 136: for (i = v->len-1; i >= 0; --i) ! 137: if (Field(v, i)) ! 138: fix(Field(v, i)); ! 139: break; ! 140: #endif COMPOUNDS ! 141: #ifdef SLOW_INTS ! 142: case Num: ! 143: #endif SLOW_INTS ! 144: default: ! 145: Abort(); ! 146: } ! 147: #endif OBSOLETE ! 148: } ! 149: ! 150: ! 151: #ifdef COMPOUNDS ! 152: /* ! 153: * Allocate a compound with n fields. ! 154: */ ! 155: ! 156: Visible value ! 157: grab_com(n) ! 158: int n; ! 159: { ! 160: value v = grabber(n*sizeof(value)); ! 161: ! 162: v->type = Com; ! 163: v->len = n; ! 164: for (--n; n >= 0; --n) ! 165: Field(v, n) = Vnil; ! 166: return v; ! 167: } ! 168: #endif COMPOUNDS ! 169: ! 170: ! 171: /* ! 172: * Allocate a node with nch children. ! 173: */ ! 174: ! 175: node ! 176: grab_node(nch) ! 177: register int nch; ! 178: { ! 179: register node n = (node) grabber( ! 180: sizeof(struct node) - Headsize + ! 181: sizeof(value) * (nch-1)); ! 182: register int i; ! 183: ! 184: n->type = Nod; ! 185: n->len = nch; ! 186: n->n_marks = 0; ! 187: n->n_width = 0; ! 188: n->n_symbol = 0; ! 189: for (i = nch-1; i >= 0; --i) ! 190: n->n_child[i] = Nnil; ! 191: return n; ! 192: } ! 193: ! 194: ! 195: /* ! 196: * Allocate a path. ! 197: */ ! 198: ! 199: path ! 200: grab_path() ! 201: { ! 202: register path p = (path) grabber( ! 203: sizeof(struct path) - Headsize); ! 204: ! 205: p->type = Pat; ! 206: p->p_parent = Pnil; ! 207: p->p_tree = Nnil; ! 208: p->p_ichild = 0; ! 209: p->p_ycoord = 0; ! 210: p->p_xcoord = 0; ! 211: p->p_level = 0; ! 212: p->p_addmarks = 0; ! 213: p->p_delmarks = 0; ! 214: return p; ! 215: } ! 216: ! 217: ! 218: #ifdef SLOW_INTS ! 219: /* ! 220: * Make an integer. ! 221: */ ! 222: ! 223: value ! 224: mk_integer(i) ! 225: int i; ! 226: { ! 227: value v; ! 228: static value tab[128]; ! 229: ! 230: if (!i) ! 231: return Vnil; ! 232: if (!(i&~127) && tab[i]) ! 233: return tab[i]; ! 234: ! 235: v = grabber(sizeof(value)); ! 236: v->type = Num; ! 237: Field(v, 0) = (value) i; ! 238: if (!(i&~127)) { ! 239: tab[i] = v; ! 240: v->refcnt = Maxintlet; ! 241: } ! 242: return v; ! 243: } ! 244: #endif SLOW_INTS ! 245: ! 246: ! 247: /* ! 248: * Make a text object out of a C string. ! 249: */ ! 250: ! 251: value ! 252: mk_text(str) ! 253: register string str; ! 254: { ! 255: register int len = strlen(str); ! 256: register value v = grabber(len+1); ! 257: ! 258: v->type = Tex; ! 259: v->len = len; ! 260: strcpy(Str(v), str); ! 261: return v; ! 262: } ! 263: ! 264: ! 265: /* ! 266: * Concatenate a C string to a text object (at the end). ! 267: */ ! 268: ! 269: concato(pv, str) ! 270: register value *pv; ! 271: register string str; ! 272: { ! 273: register value v = *pv; ! 274: register int vlen = v->len; ! 275: register int len = strlen(str); ! 276: ! 277: Assert(v && v->refcnt > 0); ! 278: if (!len) ! 279: return; ! 280: ! 281: len += vlen; ! 282: if (v->refcnt == 1) ! 283: v = regrabber(v, len+1); ! 284: else { ! 285: v = grabber(len+1); ! 286: v->type = Tex; ! 287: strcpy(Str(v), Str(*pv)); ! 288: Release(*pv); ! 289: } ! 290: strcpy(Str(v) + vlen, str); ! 291: v->len = len; ! 292: *pv = v; ! 293: } ! 294: ! 295: ! 296: /* ! 297: * Return a substring (trim) of a text object. ! 298: */ ! 299: ! 300: value ! 301: trim(v, behead, curtail) ! 302: register value v; ! 303: register int behead; ! 304: register int curtail; ! 305: { ! 306: register value w; ! 307: register int c; ! 308: ! 309: Assert(v && v->refcnt > 0); ! 310: Assert(behead >= 0 && curtail >= 0 && behead+curtail <= v->len); ! 311: if (behead + curtail == 0) { ! 312: Copy(v); ! 313: return v; ! 314: } ! 315: ! 316: c = Str(v)[v->len - curtail]; ! 317: Str(v)[v->len - curtail] = 0; /* TEMPORARILY */ ! 318: w = mk_text(Str(v) + behead); ! 319: Str(v)[v->len - curtail] = c; ! 320: return w; ! 321: } ! 322: ! 323: ! 324: #ifdef SLOW_INTS ! 325: /* ! 326: * Return the C value if an integer object. ! 327: */ ! 328: ! 329: int ! 330: intval(v) ! 331: register value v; ! 332: { ! 333: if (!v) ! 334: return 0; ! 335: return (int) Field(v, 0); ! 336: } ! 337: #endif SLOW_INTS ! 338: ! 339: ! 340: /* ! 341: * Make sure a location (pointer variable) contains a unique object. ! 342: */ ! 343: ! 344: uniql(pv) ! 345: register value *pv; ! 346: { ! 347: register value v = *pv; ! 348: register value w; ! 349: register path p; ! 350: register node n; ! 351: register int i; ! 352: ! 353: Assert(v && v->refcnt > 0); ! 354: if (v->refcnt == 1) ! 355: return; ! 356: ! 357: switch (v->type) { ! 358: ! 359: case Nod: ! 360: n = grab_node(v->len); ! 361: for (i = v->len - 1; i >= 0; --i) { ! 362: w = (value) (n->n_child[i] = ((node)v)->n_child[i]); ! 363: Copy(w); /* This is ugly */ ! 364: } ! 365: n->n_marks = ((node)v)->n_marks; ! 366: n->n_width = ((node)v)->n_width; ! 367: n->n_symbol = ((node)v)->n_symbol; ! 368: w = (value)n; ! 369: break; ! 370: ! 371: case Pat: ! 372: p = grab_path(); ! 373: p->p_parent = ((path)v)->p_parent; ! 374: Copy(p->p_parent); ! 375: p->p_tree = ((path)v)->p_tree; ! 376: Copy(p->p_tree); ! 377: p->p_ichild = ((path)v)->p_ichild; ! 378: p->p_ycoord = ((path)v)->p_ycoord; ! 379: p->p_xcoord = ((path)v)->p_xcoord; ! 380: p->p_level = ((path)v)->p_level; ! 381: w = (value)p; ! 382: break; ! 383: ! 384: #ifdef SLOW_INTS ! 385: case Num: ! 386: w = mk_integer(intval(v)); ! 387: break; ! 388: #endif SLOW_INTS ! 389: ! 390: #ifdef COMPOUNDS ! 391: case Com: ! 392: w = grab_com(v->len); ! 393: for (i = v->len - 1; i >= 0; --i) { ! 394: n = (node) (Field(w, i) = Field(v, i)); ! 395: Copy(n); /* This is uglier */ ! 396: } ! 397: break; ! 398: #endif COMPOUNDS ! 399: ! 400: case Tex: ! 401: w = mk_text(Str(v)); ! 402: break; ! 403: ! 404: default: ! 405: Abort(); ! 406: ! 407: } ! 408: Release(v); ! 409: *pv = w; ! 410: } ! 411: ! 412: ! 413: /* ! 414: * Increase the reference count of an object, unless it is infinite. ! 415: */ ! 416: ! 417: value ! 418: copy(v) ! 419: value v; ! 420: { ! 421: if (!v) ! 422: return v; ! 423: ! 424: Assert(v->refcnt > 0); ! 425: if (v->refcnt < Maxintlet) { ! 426: ++v->refcnt; ! 427: Increfs; ! 428: } ! 429: return v; ! 430: } ! 431: ! 432: ! 433: /* ! 434: * Decrease the reference count of an object, unless it is infinite. ! 435: * If it reaches zero, free the storage occupied by the object. ! 436: */ ! 437: ! 438: release(v) ! 439: register value v; ! 440: { ! 441: register int i; ! 442: register value w; ! 443: ! 444: if (!v) ! 445: return; ! 446: Assert(v->refcnt > 0); ! 447: if (v->refcnt == Maxintlet) ! 448: return; ! 449: ! 450: Decrefs; ! 451: --v->refcnt; ! 452: if (v->refcnt == 0) { ! 453: switch (v->type) { ! 454: #ifdef SLOW_INTS ! 455: case Num: ! 456: #endif SLOW_INTS ! 457: case Tex: ! 458: break; ! 459: #ifdef COMPOUNDS ! 460: case Com: ! 461: for (i = v->len - 1; i >= 0; --i) { ! 462: w = Field(v, i); ! 463: Release(w); ! 464: } ! 465: break; ! 466: #endif COMPOUNDS ! 467: case Nod: ! 468: for (i = v->len - 1; i >= 0; --i) { ! 469: w = (value)(((node)v)->n_child[i]); ! 470: Release(w); ! 471: } ! 472: break; ! 473: case Pat: ! 474: w = (value)(((path)v)->p_parent); ! 475: Release(w); ! 476: w = (value)(((path)v)->p_tree); ! 477: Release(w); ! 478: break; ! 479: default: ! 480: Abort(); ! 481: } ! 482: #ifndef NDEBUG ! 483: if (dflag) ! 484: delval(v); ! 485: --nobjs; ! 486: #endif NDEBUG ! 487: free((string)v); ! 488: } ! 489: } ! 490: ! 491: objstats() ! 492: { ! 493: #ifndef NDEBUG ! 494: fprintf(stderr, "*** Object statistics: %d objects, %d references\n", ! 495: nobjs, nrefs); ! 496: #ifdef MSTATS ! 497: mstats("(at end)"); /* A routine which some malloc versions have to print ! 498: memory statistics. Remove if your malloc hasn't. */ ! 499: #endif MSTATS ! 500: #endif NDEBUG ! 501: } ! 502: ! 503: #ifndef NDEBUG ! 504: valdump(v) ! 505: value v; ! 506: { ! 507: if (!v) ! 508: fputs("(nil)", stderr); ! 509: else { ! 510: fprintf(stderr, "v=0x%x, type='%c', len=%d, refcnt=", ! 511: v, v->type, v->len); ! 512: if (v->refcnt == Maxintlet) ! 513: putc('*', stderr); ! 514: else ! 515: fprintf(stderr, "%d", v->refcnt); ! 516: fputs(": ", stderr); ! 517: wrval(v); ! 518: ! 519: } ! 520: putc('\n', stderr); ! 521: } ! 522: ! 523: #define QUOTE '\'' ! 524: ! 525: wrval(v) ! 526: value v; ! 527: { ! 528: register string cp; ! 529: register int c; ! 530: ! 531: if (!v) { ! 532: fputs("nil", stderr); ! 533: return; ! 534: } ! 535: ! 536: switch (v->type) { ! 537: ! 538: #ifdef SLOW_INTS ! 539: case Num: ! 540: fprintf(stderr, "%d", intval(v)); ! 541: break; ! 542: #endif SLOW_INTS ! 543: ! 544: case Tex: ! 545: putc(QUOTE, stderr); ! 546: for (cp = Str(v); c = *cp; ++cp) { ! 547: if (' ' <= c && c < 0177) { ! 548: putc(c, stderr); ! 549: if (c == QUOTE) ! 550: putc(c, stderr); ! 551: } ! 552: else if (0 <= c && c < ' ') ! 553: putc('^', stderr), putc(c + '@', stderr); ! 554: else ! 555: fprintf(stderr, "\\%03o", c); ! 556: } ! 557: putc(QUOTE, stderr); ! 558: break; ! 559: ! 560: #ifdef COMPOUNDS ! 561: case Com: ! 562: { ! 563: int i; ! 564: value f; ! 565: putc('(', stderr); ! 566: for (i = 0; i < v->len; ++i) { ! 567: if (i) ! 568: putc(',', stderr), putc(' ', stderr); ! 569: f = Field(v, i); ! 570: if (!f || f->refcnt == 1 || f->type != Com) { ! 571: if (f && f->type == Com) ! 572: fprintf(stderr, "0x%x=", f); ! 573: wrval(f); ! 574: } ! 575: else ! 576: fprintf(stderr, "0x%x", f); ! 577: } ! 578: putc(')', stderr); ! 579: break; ! 580: } ! 581: #endif COMPOUNDS ! 582: ! 583: default: ! 584: fprintf(stderr, "0x%x", v); ! 585: ! 586: } ! 587: } ! 588: ! 589: static struct list { ! 590: struct list *link; ! 591: value val; ! 592: } head; ! 593: #endif NDEBUG ! 594: ! 595: objdump() ! 596: { ! 597: #ifndef NDEBUG ! 598: struct list *l; ! 599: ! 600: for (l = head.link; l; l = l->link) ! 601: valdump(l->val); ! 602: #endif NDEBUG ! 603: } ! 604: ! 605: objcheck() ! 606: { ! 607: #ifndef NDEBUG ! 608: struct list *l; ! 609: ! 610: for (l = head.link; l; l = l->link) ! 611: if (l->val->refcnt != Maxintlet) ! 612: valdump(l->val); ! 613: #endif NDEBUG ! 614: } ! 615: ! 616: #ifndef NDEBUG ! 617: newval(v) ! 618: register value v; ! 619: { ! 620: register struct list *l = ! 621: (struct list *) malloc((unsigned) sizeof(struct list)); ! 622: ! 623: if (!l) ! 624: syserr("newval: malloc"); ! 625: l->link = head.link; ! 626: l->val = v; ! 627: head.link = l; ! 628: } ! 629: ! 630: delval(v) ! 631: register value v; ! 632: { ! 633: register struct list *l; ! 634: register struct list *p; ! 635: ! 636: for (p = &head, l = head.link; l; p = l, l = l->link) { ! 637: if (l->val == v) { ! 638: p->link = l->link; ! 639: free((string)l); ! 640: return; ! 641: } ! 642: } ! 643: Abort(); ! 644: } ! 645: #endif NDEBUG
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.