![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rmemmgt.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx|
Return to rmemmgt.c CVS log | Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx |
1.1 ! root 1: /* ! 2: * File: rmemmgt.c ! 3: * Contents: allocation routines, block description arrays, dump routines, ! 4: * garbage collaction, sweep, malloc/free ! 5: */ ! 6: ! 7: #include "../h/rt.h" ! 8: #include "gc.h" ! 9: ! 10: #ifdef IconAlloc ! 11: /* ! 12: * If IconAlloc is defined the system allocation routines are not overloaded. ! 13: * The names are changed so that Icon's allocation routines are independently ! 14: * used. This works as long as no other system calls cause the break value ! 15: * to change. ! 16: */ ! 17: #define malloc mem_alloc ! 18: #define free mem_free ! 19: #define realloc mem_realloc ! 20: #define calloc mem_calloc ! 21: #endif IconAlloc ! 22: ! 23: #ifdef RunStats ! 24: #ifndef VMS ! 25: #include <sys/types.h> ! 26: #include <sys/times.h> ! 27: #else VMS ! 28: #include <types.h> ! 29: #include <types.h> ! 30: struct tms { ! 31: time_t tms_utime; /* user time */ ! 32: time_t tms_stime; /* system time */ ! 33: time_t tms_cutime; /* user time, children */ ! 34: time_t tms_cstime; /* system time, children */ ! 35: }; ! 36: #endif VMS ! 37: #endif RunStats ! 38: ! 39: /* ! 40: * Note: function calls beginning with "MM" are just empty macros ! 41: * unless MEMMON is defined. ! 42: */ ! 43: ! 44: /* ! 45: * allocate - returns pointer to nbytes of free storage in block region. ! 46: */ ! 47: ! 48: static union block *allocate(nbytes) ! 49: word nbytes; ! 50: { ! 51: register uword fspace, *sloc; ! 52: ! 53: Inc(al_n_total); ! 54: IncSum(al_bc_btotal,nbytes); ! 55: /* ! 56: * See if there is enough room in the block region. ! 57: */ ! 58: fspace = maxblk - blkfree; ! 59: if (fspace < nbytes) ! 60: syserr("block allocation botch"); ! 61: ! 62: /* ! 63: * If monitoring, show the allocation. ! 64: */ ! 65: MMAlc(nbytes); ! 66: ! 67: /* ! 68: * Decrement the free space in the block region by the number of bytes allocated ! 69: * and return the address of the first byte of the allocated block. ! 70: */ ! 71: sloc = (uword *) blkfree; ! 72: blkneed -= nbytes; ! 73: blkfree = blkfree + nbytes; ! 74: return (union block *) (sloc); ! 75: } ! 76: ! 77: /* ! 78: * alclint - allocate a long integer block in the block region. ! 79: */ ! 80: ! 81: struct b_int *alclint(val) ! 82: long val; ! 83: { ! 84: register struct b_int *blk; ! 85: extern union block *allocate(); ! 86: ! 87: MMType(T_Longint); ! 88: blk = (struct b_int *)allocate((word)sizeof(struct b_int)); ! 89: blk->title = T_Longint; ! 90: blk->intval = val; ! 91: return blk; ! 92: } ! 93: ! 94: /* ! 95: * alcreal - allocate a real value in the block region. ! 96: */ ! 97: ! 98: struct b_real *alcreal(val) ! 99: double val; ! 100: { ! 101: register struct b_real *blk; ! 102: extern union block *allocate(); ! 103: ! 104: Inc(al_n_real); ! 105: MMType(T_Real); ! 106: blk = (struct b_real *) allocate((word)sizeof(struct b_real)); ! 107: blk->title = T_Real; ! 108: #ifdef Double ! 109: /* access real values one word at a time */ ! 110: { int *rp, *rq; ! 111: rp = (word *) &(blk->realval); ! 112: rq = (word *) &val; ! 113: *rp++ = *rq++; ! 114: *rp = *rq; ! 115: } ! 116: #else Double ! 117: blk->realval = val; ! 118: #endif Double ! 119: return blk; ! 120: } ! 121: ! 122: /* ! 123: * alccset - allocate a cset in the block region. ! 124: */ ! 125: ! 126: /* >alccset */ ! 127: struct b_cset *alccset(size) ! 128: int size; ! 129: { ! 130: register struct b_cset *blk; ! 131: register i; ! 132: extern union block *allocate(); ! 133: ! 134: Inc(al_n_cset); ! 135: MMType(T_Cset); ! 136: blk = (struct b_cset *) allocate((word)sizeof(struct b_cset)); ! 137: blk->title = T_Cset; ! 138: blk->size = size; ! 139: /* ! 140: * Zero the bit array. ! 141: */ ! 142: for (i = 0; i < CsetSize; i++) ! 143: blk->bits[i] = 0; ! 144: return blk; ! 145: } ! 146: /* <alccset */ ! 147: ! 148: ! 149: /* ! 150: * alcfile - allocate a file block in the block region. ! 151: */ ! 152: ! 153: struct b_file *alcfile(fd, status, name) ! 154: FILE *fd; ! 155: int status; ! 156: struct descrip *name; ! 157: { ! 158: register struct b_file *blk; ! 159: extern union block *allocate(); ! 160: ! 161: Inc(al_n_file); ! 162: MMType(T_File); ! 163: blk = (struct b_file *) allocate((word)sizeof(struct b_file)); ! 164: blk->title = T_File; ! 165: blk->fd = fd; ! 166: blk->status = status; ! 167: blk->fname = *name; ! 168: return blk; ! 169: } ! 170: ! 171: /* ! 172: * alcrecd - allocate record with nflds fields in the block region. ! 173: */ ! 174: ! 175: struct b_record *alcrecd(nflds, recptr) ! 176: int nflds; ! 177: struct descrip *recptr; ! 178: { ! 179: register struct b_record *blk; ! 180: register i, size; ! 181: extern union block *allocate(); ! 182: ! 183: Inc(al_n_recd); ! 184: MMType(T_Record); ! 185: size = Vsizeof(struct b_record) + nflds*sizeof(struct descrip); ! 186: blk = (struct b_record *) allocate((word)size); ! 187: blk->title = T_Record; ! 188: blk->blksize = size; ! 189: blk->recdesc.dword = D_Proc; ! 190: BlkLoc(blk->recdesc) = (union block *)recptr; ! 191: /* ! 192: * Assign &null to each field in the record. ! 193: */ ! 194: for (i = 0; i < nflds; i++) ! 195: blk->fields[i] = nulldesc; ! 196: return blk; ! 197: } ! 198: ! 199: /* ! 200: * alclist - allocate a list header block in the block region. ! 201: */ ! 202: ! 203: struct b_list *alclist(size) ! 204: word size; ! 205: { ! 206: register struct b_list *blk; ! 207: extern union block *allocate(); ! 208: ! 209: Inc(al_n_list); ! 210: MMType(T_List); ! 211: blk = (struct b_list *) allocate((word)sizeof(struct b_list)); ! 212: blk->title = T_List; ! 213: blk->size = size; ! 214: blk->listhead = nulldesc; ! 215: return blk; ! 216: } ! 217: ! 218: /* ! 219: * alclstb - allocate a list element block in the block region. ! 220: */ ! 221: ! 222: struct b_lelem *alclstb(nelem, first, nused) ! 223: word nelem, first, nused; ! 224: { ! 225: register struct b_lelem *blk; ! 226: register word i, size; ! 227: extern union block *allocate(); ! 228: ! 229: Inc(al_n_lstb); ! 230: MMType(T_Lelem); ! 231: #ifdef MaxListSize ! 232: if (nelem >= MaxListSize) ! 233: runerr(205, NULL); ! 234: #endif MaxListSize ! 235: size = Vsizeof(struct b_lelem)+nelem*sizeof(struct descrip); ! 236: blk = (struct b_lelem *) allocate(size); ! 237: blk->title = T_Lelem; ! 238: blk->blksize = size; ! 239: blk->nelem = nelem; ! 240: blk->first = first; ! 241: blk->nused = nused; ! 242: blk->listprev = nulldesc; ! 243: blk->listnext = nulldesc; ! 244: /* ! 245: * Set all elements to &null. ! 246: */ ! 247: for (i = 0; i < nelem; i++) ! 248: blk->lslots[i] = nulldesc; ! 249: return blk; ! 250: } ! 251: ! 252: /* ! 253: * alctable - allocate a table header block in the block region. ! 254: */ ! 255: ! 256: struct b_table *alctable(def) ! 257: struct descrip *def; ! 258: { ! 259: register int i; ! 260: register struct b_table *blk; ! 261: extern union block *allocate(); ! 262: ! 263: Inc(al_n_table); ! 264: MMType(T_Table); ! 265: blk = (struct b_table *) allocate((word)sizeof(struct b_table)); ! 266: blk->title = T_Table; ! 267: blk->size = 0; ! 268: blk->defvalue = *def; ! 269: /* ! 270: * Zero out the buckets. ! 271: */ ! 272: for (i = 0; i < TSlots; i++) ! 273: blk->buckets[i] = nulldesc; ! 274: return blk; ! 275: } ! 276: ! 277: /* ! 278: * alctelem - allocate a table element block in the block region. ! 279: */ ! 280: ! 281: struct b_telem *alctelem() ! 282: { ! 283: register struct b_telem *blk; ! 284: extern union block *allocate(); ! 285: ! 286: Inc(al_n_telem); ! 287: MMType(T_Telem); ! 288: blk = (struct b_telem *) allocate((word)sizeof(struct b_telem)); ! 289: blk->title = T_Telem; ! 290: blk->hashnum = 0; ! 291: blk->clink = nulldesc; ! 292: blk->tref = nulldesc; ! 293: blk->tval = nulldesc; ! 294: return blk; ! 295: } ! 296: ! 297: /* ! 298: * alcset - allocate a set header block. ! 299: */ ! 300: ! 301: struct b_set *alcset() ! 302: { ! 303: register int i; ! 304: register struct b_set *blk; ! 305: extern union block *allocate(); ! 306: ! 307: MMType(T_Set); ! 308: blk = (struct b_set *) allocate((word)sizeof(struct b_set)); ! 309: blk->title = T_Set; ! 310: blk->size = 0; ! 311: /* ! 312: * Zero out the buckets. ! 313: */ ! 314: for (i = 0; i < SSlots; i++) ! 315: blk->sbucks[i] = nulldesc; ! 316: return blk; ! 317: } ! 318: ! 319: /* ! 320: * alcselem - allocate a set element block. ! 321: */ ! 322: ! 323: struct b_selem *alcselem(mbr,hn) ! 324: word hn; ! 325: struct descrip *mbr; ! 326: ! 327: { register struct b_selem *blk; ! 328: extern union block *allocate(); ! 329: ! 330: MMType(T_Selem); ! 331: blk = (struct b_selem *) allocate((word)sizeof(struct b_selem)); ! 332: blk->title = T_Selem; ! 333: blk->clink = nulldesc; ! 334: blk->setmem = *mbr; ! 335: blk->hashnum = hn; ! 336: return blk; ! 337: } ! 338: ! 339: /* ! 340: * alcsubs - allocate a substring trapped variable in the block region. ! 341: */ ! 342: ! 343: struct b_tvsubs *alcsubs(len, pos, var) ! 344: word len, pos; ! 345: struct descrip *var; ! 346: { ! 347: register struct b_tvsubs *blk; ! 348: extern union block *allocate(); ! 349: ! 350: Inc(al_n_subs); ! 351: MMType(T_Tvsubs); ! 352: blk = (struct b_tvsubs *) allocate((word)sizeof(struct b_tvsubs)); ! 353: blk->title = T_Tvsubs; ! 354: blk->sslen = len; ! 355: blk->sspos = pos; ! 356: blk->ssvar = *var; ! 357: return blk; ! 358: } ! 359: ! 360: /* ! 361: * alctvtbl - allocate a table element trapped variable block in the block region. ! 362: */ ! 363: ! 364: struct b_tvtbl *alctvtbl(tbl, ref, hashnum) ! 365: register struct descrip *tbl, *ref; ! 366: word hashnum; ! 367: { ! 368: register struct b_tvtbl *blk; ! 369: extern union block *allocate(); ! 370: ! 371: Inc(al_n_tvtbl); ! 372: MMType(T_Tvtbl); ! 373: blk = (struct b_tvtbl *) allocate((word)sizeof(struct b_tvtbl)); ! 374: blk->title = T_Tvtbl; ! 375: blk->hashnum = hashnum; ! 376: blk->clink = *tbl; ! 377: blk->tref = *ref; ! 378: blk->tval = nulldesc; ! 379: return blk; ! 380: } ! 381: ! 382: /* ! 383: * alcstr - allocate a string in the string space. ! 384: */ ! 385: ! 386: /* >alcstr */ ! 387: char *alcstr(s, slen) ! 388: register char *s; ! 389: register word slen; ! 390: { ! 391: register char *d; ! 392: char *ofree; ! 393: ! 394: Inc(al_n_str); ! 395: IncSum(al_bc_stotal,slen); ! 396: MMStr(slen); ! 397: /* ! 398: * See if there is enough room in the string space. ! 399: */ ! 400: if (strfree + slen > strend) ! 401: syserr("string allocation botch"); ! 402: strneed -= slen; ! 403: ! 404: /* ! 405: * Copy the string into the string space, saving a pointer to its ! 406: * beginning. Note that s may be null, in which case the space ! 407: * is still to be allocated but nothing is to be copied into it. ! 408: */ ! 409: ofree = d = strfree; ! 410: if (s != NULL) { ! 411: while (slen-- > 0) ! 412: *d++ = *s++; ! 413: } ! 414: else ! 415: d += slen; ! 416: strfree = d; ! 417: return ofree; ! 418: } ! 419: /* <alcstr */ ! 420: ! 421: /* ! 422: * alcstk - allocate a co-expression stack block. ! 423: */ ! 424: ! 425: struct b_coexpr *alcstk() ! 426: { ! 427: struct b_coexpr *ep; ! 428: char *malloc(); ! 429: ! 430: Inc(al_n_estk); ! 431: ep = (struct b_coexpr *)malloc(stksize); ! 432: ep->title = T_Coexpr; ! 433: return ep; ! 434: } ! 435: ! 436: /* ! 437: * alceblk - allocate a co-expression block. ! 438: */ ! 439: ! 440: struct b_refresh *alceblk(entryx, na, nl) ! 441: word *entryx; ! 442: int na, nl; ! 443: { ! 444: int size; ! 445: struct b_refresh *blk; ! 446: extern union block *allocate(); ! 447: ! 448: Inc(al_n_eblk); ! 449: MMType(T_Refresh); ! 450: size = Vsizeof(struct b_refresh) + (na + nl) * sizeof(struct descrip); ! 451: blk = (struct b_refresh *) allocate((word)size); ! 452: blk->title = T_Refresh; ! 453: blk->blksize = size; ! 454: blk->ep = entryx; ! 455: blk->numlocals = nl; ! 456: return blk; ! 457: } ! 458: ! 459: ! 460: /* ! 461: * Allocated block size table (sizes given in bytes). A size of -1 is used ! 462: * for types that have no blocks; a size of 0 indicates that the ! 463: * second word of the block contains the size; a value greater than ! 464: * 0 is used for types with constant sized blocks. ! 465: */ ! 466: ! 467: int bsizes[] = { ! 468: -1, /* 0, not used */ ! 469: -1, /* 1, not used */ ! 470: sizeof(struct b_int), /* T_Longint (2), long integer type */ ! 471: sizeof(struct b_real), /* T_Real (3), real number */ ! 472: sizeof(struct b_cset), /* T_Cset (4), cset */ ! 473: sizeof(struct b_file), /* T_File (5), file block */ ! 474: 0, /* T_Proc (6), procedure block */ ! 475: sizeof(struct b_list), /* T_List (7), list header block */ ! 476: sizeof(struct b_table), /* T_Table (8), table header block */ ! 477: 0, /* T_Record (9), record block */ ! 478: sizeof(struct b_telem), /* T_Telem (10), table element block */ ! 479: 0, /* T_Lelem (11), list element block */ ! 480: sizeof(struct b_tvsubs), /* T_Tvsubs (12), substring trapped variable */ ! 481: -1, /* T_Tvkywd (13), keyword trapped variable */ ! 482: sizeof(struct b_tvtbl), /* T_Tvtbl (14), table element trapped variable */ ! 483: sizeof(struct b_set), /* T_Set (15), set header block */ ! 484: sizeof(struct b_selem), /* T_Selem (16), set element block */ ! 485: 0, /* T_Refresh (17), expression block */ ! 486: -1, /* T_Coexpr (18), expression stack header */ ! 487: }; ! 488: ! 489: /* ! 490: * Table of offsets (in bytes) to first descriptor in blocks. -1 is for ! 491: * types not allocated, 0 for blocks with no descriptors. ! 492: */ ! 493: int firstd[] = { ! 494: -1, /* 0, not used */ ! 495: -1, /* 1, not used */ ! 496: 0, /* T_Longint (2), long integer type */ ! 497: 0, /* T_Real (3), real number */ ! 498: 0, /* T_Cset (4), cset */ ! 499: 3*WordSize, /* T_File (5), file block */ ! 500: 8*WordSize, /* T_Proc (6), procedure block */ ! 501: 2*WordSize, /* T_List (7), list header block */ ! 502: 2*WordSize, /* T_Table (8), table header block */ ! 503: 2*WordSize, /* T_Record (9), record block */ ! 504: 2*WordSize, /* T_Telem (10), table element block */ ! 505: 5*WordSize, /* T_Lelem (11), list element block */ ! 506: 3*WordSize, /* T_Tvsubs (12), substring trapped variable */ ! 507: -1, /* T_Tvkywd (13), keyword trapped variable */ ! 508: 2*WordSize, /* T_Tvtbl (14), table element trapped variable */ ! 509: 2*WordSize, /* T_Set (15), set header block */ ! 510: 2*WordSize, /* T_Selem (16), set element block */ ! 511: (4+Vwsizeof(struct pf_marker))*WordSize, ! 512: /* T_Refresh (17), expression block */ ! 513: -1, /* T_Coexpr (18), expression stack header */ ! 514: }; ! 515: ! 516: /* ! 517: * Table of block names used by debugging functions. ! 518: */ ! 519: char *blkname[] = { ! 520: "illegal", /* T_Null (0), not block */ ! 521: "illegal", /* T_Integer (1), not block */ ! 522: "long integer", /* T_Longint (2) */ ! 523: "real number", /* T_Real (3) */ ! 524: "cset", /* T_Cset (4) */ ! 525: "file", /* T_File (5) */ ! 526: "procedure", /* T_Proc (6) */ ! 527: "list", /* T_List (7) */ ! 528: "table", /* T_Table (8) */ ! 529: "record", /* T_Record (9) */ ! 530: "table element", /* T_Telem (10) */ ! 531: "list element", /* T_Lelem (11) */ ! 532: "substring trapped variable", /* T_Tvsubs (12) */ ! 533: "keyword trapped variable", /* T_Tvkywd (13) */ ! 534: "table element trapped variable", /* T_Tvtbl (14) */ ! 535: "set", /* T_Set (15) */ ! 536: "set elememt", /* T_Selem (16) */ ! 537: "refresh", /* T_Refresh (17) */ ! 538: "co-expression", /* T_Coexpr (18) */ ! 539: }; ! 540: ! 541: ! 542: /* ! 543: * descr - dump a descriptor. Used only for debugging. ! 544: */ ! 545: ! 546: descr(dp) ! 547: struct descrip *dp; ! 548: { ! 549: int i; ! 550: ! 551: fprintf(stderr,"%08lx: ",(long)dp); ! 552: if (Qual(*dp)) ! 553: fprintf(stderr,"%15s","qualifier"); ! 554: else if (Var(*dp) && !Tvar(*dp)) ! 555: fprintf(stderr,"%15s","variable"); ! 556: else { ! 557: i = Type(*dp); ! 558: switch (i) { ! 559: case T_Null: ! 560: fprintf(stderr,"%15s","null"); ! 561: break; ! 562: case T_Integer: ! 563: fprintf(stderr,"%15s","integer"); ! 564: break; ! 565: default: ! 566: fprintf(stderr,"%15s",blkname[i]); ! 567: } ! 568: } ! 569: fprintf(stderr," %08lx %08lx\n",(long)dp->dword,(long)dp->vword.integr); ! 570: } ! 571: ! 572: /* ! 573: * blkdump - dump the allocated block region. Used only for debugging. ! 574: */ ! 575: ! 576: blkdump() ! 577: { ! 578: register char *blk; ! 579: register word type, size, fdesc; ! 580: register struct descrip *ndesc; ! 581: ! 582: fprintf(stderr,"\nDump of allocated block region. base:%08lx free:%08lx max:%08lx\n", ! 583: (long)blkbase,(long)blkfree,(long)maxblk); ! 584: fprintf(stderr," loc type size contents\n"); ! 585: ! 586: for (blk = blkbase; blk < blkfree; blk += BlkSize(blk)) { ! 587: type = BlkType(blk); ! 588: size = BlkSize(blk); ! 589: fprintf(stderr," %08lx %15s %4ld\n",(long)blk,blkname[type],(long)size); ! 590: if ((fdesc = firstd[type]) > 0) ! 591: for (ndesc = (struct descrip *) (blk + fdesc); ! 592: ndesc < (struct descrip *) (blk + size);ndesc++) { ! 593: fprintf(stderr," "); ! 594: descr(ndesc); ! 595: } ! 596: fprintf(stderr,"\n"); ! 597: } ! 598: fprintf(stderr,"end of block region.\n"); ! 599: } ! 600: ! 601: ! 602: /* ! 603: * blkreq - insure that at least bytes of space are left in the block region. ! 604: * The amount of space needed is transmitted to the collector via ! 605: * the global variable blkneed. ! 606: */ ! 607: ! 608: blkreq(bytes) ! 609: uword bytes; ! 610: { ! 611: blkneed = bytes; ! 612: if (bytes > maxblk - blkfree) { ! 613: Inc(gc_n_blk); ! 614: collect(); ! 615: } ! 616: } ! 617: ! 618: /* ! 619: * strreq - insure that at least n of space are left in the string ! 620: * space. The amount of space needed is transmitted to the collector ! 621: * via the global variable strneed. ! 622: */ ! 623: ! 624: /* >strreq */ ! 625: strreq(n) ! 626: uword n; ! 627: { ! 628: strneed = n; /* save in case of collection */ ! 629: if (n > strend - strfree) { ! 630: Inc(gc_n_string); ! 631: collect(); ! 632: } ! 633: } ! 634: /* <strreq */ ! 635: ! 636: /* ! 637: * cofree - collect co-expression blocks. This is done after ! 638: * the marking phase of garbage collection and the stacks that are ! 639: * reachable have pointers to data blocks, rather than T_Coexpr, ! 640: * in their type field. ! 641: */ ! 642: ! 643: /* >cofree */ ! 644: cofree() ! 645: { ! 646: register struct b_coexpr **ep, *xep; ! 647: ! 648: /* ! 649: * Reset the type for &main. ! 650: */ ! 651: BlkLoc(k_main)->coexpr.title = T_Coexpr; ! 652: ! 653: /* ! 654: * The co-expression blocks are linked together through their ! 655: * nextstk fields, with stklist pointing to the head of the list. ! 656: * The list is traversed and each stack that was not marked ! 657: * is freed. ! 658: */ ! 659: ep = &stklist; ! 660: while (*ep != NULL) { ! 661: if (BlkType(*ep) == T_Coexpr) { ! 662: xep = *ep; ! 663: *ep = (*ep)->nextstk; ! 664: free((char *)xep); ! 665: } ! 666: else { ! 667: BlkType(*ep) = T_Coexpr; ! 668: ep = &(*ep)->nextstk; ! 669: } ! 670: } ! 671: } ! 672: /* <cofree */ ! 673: ! 674: /* ! 675: * collect - do a garbage collection. ! 676: * the static region is needed. ! 677: */ ! 678: ! 679: collect() ! 680: { ! 681: register word extra; ! 682: register char *newend; ! 683: register struct descrip *dp; ! 684: char *strptr; ! 685: struct b_coexpr *cp; ! 686: #ifndef MSDOS ! 687: extern char *brk(); ! 688: #endif MSDOS ! 689: extern char *sbrk(); ! 690: #ifdef RunStats ! 691: struct tms tmbuf; ! 692: ! 693: times(&tmbuf); ! 694: gc_t_start = tmbuf.tms_utime + tmbuf.tms_stime; ! 695: Inc(gc_n_total); ! 696: #endif RunStats ! 697: MMBGC(); ! 698: ! 699: /* ! 700: * Sync the values (used by sweep) in the coexpr block for ¤t ! 701: * with the current values. ! 702: */ ! 703: cp = (struct b_coexpr *)BlkLoc(current); ! 704: cp->es_pfp = pfp; ! 705: cp->es_gfp = gfp; ! 706: cp->es_efp = efp; ! 707: cp->es_sp = sp; ! 708: ! 709: /* ! 710: * Reset the string qualifier free list pointer. ! 711: */ ! 712: qualfree = quallist; ! 713: ! 714: /* ! 715: * Mark the stacks for &main and the current co-expression. ! 716: */ ! 717: markblock(&k_main); ! 718: markblock(¤t); ! 719: /* ! 720: * Mark &subject and the cached s2 and s3 strings for map. ! 721: */ ! 722: postqual(&k_subject); ! 723: if (Qual(maps2)) /* caution: the cached arguments of */ ! 724: postqual(&maps2); /* map may not be strings. */ ! 725: else if (Pointer(maps2)) ! 726: markblock(&maps2); ! 727: if (Qual(maps3)) ! 728: postqual(&maps3); ! 729: else if (Pointer(maps3)) ! 730: markblock(&maps3); ! 731: /* ! 732: * Mark the tended descriptors and the global and static variables. ! 733: */ ! 734: for (dp = &tended[1]; dp <= &tended[ntended]; dp++) ! 735: /* >locate */ ! 736: if (Qual(*dp)) ! 737: postqual(dp); ! 738: else if (Pointer(*dp)) ! 739: markblock(dp); ! 740: /* <locate */ ! 741: for (dp = globals; dp < eglobals; dp++) ! 742: if (Qual(*dp)) ! 743: postqual(dp); ! 744: else if (Pointer(*dp)) ! 745: markblock(dp); ! 746: for (dp = statics; dp < estatics; dp++) ! 747: if (Qual(*dp)) ! 748: postqual(dp); ! 749: else if (Pointer(*dp)) ! 750: markblock(dp); ! 751: ! 752: /* ! 753: * Collect available co-expression stacks. ! 754: */ ! 755: cofree(); ! 756: if (statneed) { ! 757: /* ! 758: * The static region needs to be expanded. Make sure the end has not ! 759: * been changed by someone else. ! 760: */ ! 761: if (currend != sbrk(0)) ! 762: runerr(304, NULL); ! 763: extra = statneed; ! 764: newend = (char *) quallist + extra; ! 765: /* ! 766: * This next calculation determines if there is space for the requested ! 767: * static region expansion. The checks involving quallist and newend ! 768: * appear to only be required on machines where the above addition ! 769: * of extra might overflow. ! 770: */ ! 771: ! 772: if (newend < (char *)quallist || newend > (char *)0x7fffffff || ! 773: (newend > (char *)equallist && ((word) brk(newend) == (word)-1))) ! 774: runerr(303, NULL); ! 775: statend += statneed; ! 776: statneed = 0; ! 777: currend = sbrk(0); ! 778: } ! 779: else ! 780: /* ! 781: * Expansion of the static memory region is not required. ! 782: */ ! 783: extra = 0; ! 784: ! 785: /* ! 786: * Collect the string space, indicating that it must be moved back ! 787: * extra bytes. ! 788: */ ! 789: scollect(extra); ! 790: /* ! 791: * strptr is post-gc value for strings. Move back pointers for strend ! 792: * and quallist according to value of extra. ! 793: */ ! 794: strptr = strbase + extra; ! 795: strend += extra; ! 796: quallist = (struct descrip **)((char *)quallist + extra); ! 797: if (quallist > equallist) ! 798: equallist = quallist; ! 799: ! 800: /* ! 801: * Calculate a value for extra space. The value is (the larger of ! 802: * (twice the string space needed) or (the number of words currently ! 803: * in the string space)) plus the unallocated string space. ! 804: */ ! 805: extra = (Max(2*strneed, (strend-(char *)statend)/4) - ! 806: (strend - extra - strfree) + (GranSize-1)) & ~(GranSize-1); ! 807: ! 808: while (extra > 0) { ! 809: /* ! 810: * Try to get extra more bytes of storage. If it can't be gotten, ! 811: * decrease the value by GranSize and try again. If it's gotten, ! 812: * move back strend and quallist. First make sure that someone ! 813: * has not moved the end of the region. ! 814: */ ! 815: if (currend != sbrk(0)) ! 816: runerr(304, NULL); ! 817: newend = (char *)quallist + extra; ! 818: if (newend >= (char *)quallist && ! 819: (newend <= (char *)equallist || ((int) brk(newend) != -1))) { ! 820: strend += extra; ! 821: quallist = (struct descrip **) newend; ! 822: currend = sbrk(0); ! 823: break; ! 824: } ! 825: extra -= GranSize; ! 826: } ! 827: ! 828: /* ! 829: * Adjust the pointers in the block region. Note that blkbase is the old base ! 830: * of the block region and strend will be the post-gc base of the block region. ! 831: */ ! 832: adjust(blkbase,strend); ! 833: /* ! 834: * Compact the block region. ! 835: */ ! 836: compact(blkbase); ! 837: /* ! 838: * Calculate a value for extra space. The value is (the larger of ! 839: * (twice the block region space needed) or (the number of words currently ! 840: * in the block region space)) plus the unallocated block space. ! 841: */ ! 842: extra = (Max(2*blkneed, (maxblk-blkbase)/4) + ! 843: blkfree - maxblk + (GranSize-1)) & ~(GranSize-1); ! 844: while (extra > 0) { ! 845: /* ! 846: * Try to get extra more bytes of storage. If it can't be gotten, ! 847: * decrease the value by GranSize and try again. If it's gotten, ! 848: * move back quallist. First make sure the end has not been changed. ! 849: */ ! 850: if (currend != sbrk(0)) ! 851: runerr(304, NULL); ! 852: newend = (char *)quallist + extra; ! 853: if (newend >= (char *)quallist && ! 854: (newend <= (char *)equallist || ((int) brk(newend) != -1))) { ! 855: quallist = (struct descrip **) newend; ! 856: currend = sbrk(0); ! 857: break; ! 858: } ! 859: extra -= GranSize; ! 860: } ! 861: if (quallist > equallist) ! 862: equallist = quallist; ! 863: ! 864: if (strend != blkbase) { ! 865: /* ! 866: * strend is not equal to blkbase and this indicates that the ! 867: * static region or string region was expanded and thus ! 868: * the block region must be moved. There is an assumption here that the ! 869: * block region always moves up in memory, i.e., the static and ! 870: * string regions never shrink. With this assumption in hand, ! 871: * the block region must be moved before the string space lest the string ! 872: * space overwrite block data. The assumption is valid, but beware ! 873: * if shrinking regions are ever implemented. ! 874: */ ! 875: mvc((uword)(blkfree - blkbase), blkbase, strend); ! 876: blkfree += strend - blkbase; ! 877: blkbase = strend; ! 878: } ! 879: if (strptr != strbase) { ! 880: /* ! 881: * strptr is not equal to strbase and this indicates that the ! 882: * co-expression space was expanded and thus the string space ! 883: * must be moved up in memory. ! 884: */ ! 885: mvc((uword)(strfree - strbase), strbase, strptr); ! 886: strfree += strptr - strbase; ! 887: strbase = strptr; ! 888: } ! 889: ! 890: /* ! 891: * Expand the block region. ! 892: */ ! 893: maxblk = (char *)quallist; ! 894: #ifdef RunStats ! 895: times(&tmbuf); ! 896: gc_t_last = ! 897: 1000*(((tmbuf.tms_utime + tmbuf.tms_stime)-gc_t_start)/(double)Hz); ! 898: IncSum(gc_t_total,gc_t_last); ! 899: #endif RunStats ! 900: MMEGC(); ! 901: return; ! 902: } ! 903: /* ! 904: * markblock- mark each accessible block in the block region and build back-list of ! 905: * descriptors pointing to that block. (Phase I of garbage collection.) ! 906: */ ! 907: ! 908: /* >markblock */ ! 909: markblock(dp) ! 910: struct descrip *dp; ! 911: { ! 912: register struct descrip *dp1; ! 913: register char *endblock, *block; ! 914: static word type, fdesc, off; ! 915: ! 916: /* ! 917: * Get the block to which dp points. ! 918: */ ! 919: ! 920: block = (char *) BlkLoc(*dp); ! 921: if (block >= blkbase && block < blkfree) { /* check range */ ! 922: if (Var(*dp) && !Tvar(*dp)) { ! 923: ! 924: /* ! 925: * The descriptor is a variable; point block to the head of the ! 926: * block containing the descriptor to which dp points. ! 927: */ ! 928: off = Offset(*dp); ! 929: if (off == 0) ! 930: return; ! 931: else ! 932: block = (char *) ((word *) block - off); ! 933: } ! 934: ! 935: type = BlkType(block); ! 936: if ((uword)type <= MaxType) { ! 937: ! 938: /* ! 939: * The type is valid, which indicates that this block has not ! 940: * been marked. Point endblock to the byte past the end ! 941: * of the block. ! 942: */ ! 943: endblock = block + BlkSize(block); ! 944: MMMark(block,type); ! 945: } ! 946: ! 947: /* ! 948: * Add dp to the back-chain for the block and point the ! 949: * block (via the type field) to dp. ! 950: */ ! 951: BlkLoc(*dp) = (union block *) type; ! 952: BlkType(block) = (word)dp; ! 953: if (((unsigned)type <= MaxType) && ((fdesc = firstd[type]) > 0)) ! 954: ! 955: /* ! 956: * The block has not been marked, and it does contain ! 957: * descriptors. Mark each descriptor. ! 958: */ ! 959: for (dp1 = (struct descrip *) (block + fdesc); ! 960: (char *) dp1 < endblock; dp1++) { ! 961: if (Qual(*dp1)) ! 962: postqual(dp1); ! 963: else if (Pointer(*dp1)) ! 964: markblock(dp1); ! 965: } ! 966: } ! 967: else if (dp->dword == D_Coexpr && ! 968: (unsigned)BlkType(block) <= MaxType) { ! 969: ! 970: /* ! 971: * dp points to a co-expression block that has not been ! 972: * marked. Point the block to dp. Sweep the interpreter ! 973: * stack in the block and mark the block for the ! 974: * activating co-expression and the refresh block. ! 975: */ ! 976: BlkType(block) = (word)dp; ! 977: sweep((struct b_coexpr *)block); ! 978: markblock(&((struct b_coexpr *)block)->activator); ! 979: markblock(&((struct b_coexpr *)block)->freshblk); ! 980: } ! 981: } ! 982: /* <markblock */ ! 983: ! 984: /* ! 985: * adjust - adjust pointers into the block region, beginning with block oblk and ! 986: * basing the "new" block region at nblk. (Phase II of garbage collection.) ! 987: */ ! 988: ! 989: /* >adjust */ ! 990: adjust(source,dest) ! 991: char *source, *dest; ! 992: { ! 993: register struct descrip *nxtptr, *tptr; ! 994: ! 995: /* ! 996: * Loop through to the end of allocated block region, moving source ! 997: * to each block in turn and using the size of a block to find the ! 998: * next block. ! 999: */ ! 1000: while (source < blkfree) { ! 1001: if ((uword) (nxtptr = (struct descrip *)BlkType(source)) > MaxType) { ! 1002: ! 1003: /* ! 1004: * The type field of source is a back-pointer. Traverse the ! 1005: * chain of back pointers, changing each block location from ! 1006: * source to dest. ! 1007: */ ! 1008: while ((uword)nxtptr > MaxType) { ! 1009: tptr = nxtptr; ! 1010: nxtptr = (struct descrip *)BlkLoc(*nxtptr); ! 1011: if (Var(*tptr) && !Tvar(*tptr)) ! 1012: BlkLoc(*tptr) = (union block *)((word *)dest + Offset(*tptr)); ! 1013: else ! 1014: BlkLoc(*tptr) = (union block *)dest; ! 1015: } ! 1016: BlkType(source) = (uword)nxtptr | F_Mark; ! 1017: dest += BlkSize(source); ! 1018: } ! 1019: source += BlkSize(source); ! 1020: } ! 1021: } ! 1022: /* <adjust */ ! 1023: ! 1024: /* ! 1025: * compact - compact good blocks in the block region. (Phase III of garbage collection.) ! 1026: */ ! 1027: ! 1028: /* >compact */ ! 1029: compact(source) ! 1030: char *source; ! 1031: { ! 1032: register char *dest; ! 1033: register word size; ! 1034: ! 1035: /* ! 1036: * Start dest at source. ! 1037: */ ! 1038: dest = source; ! 1039: ! 1040: /* ! 1041: * Loop through to end of allocated block space moving source to ! 1042: * each block in turn, using the size of a block to find the next ! 1043: * block. If a block has been marked, it is copied to the ! 1044: * location pointed to by dest and dest is pointed past the end ! 1045: * of the block, which is the location to place the next saved ! 1046: * block. Marks are removed from the saved blocks. ! 1047: */ ! 1048: while (source < blkfree) { ! 1049: size = BlkSize(source); ! 1050: if (BlkType(source) & F_Mark) { ! 1051: BlkType(source) &= ~F_Mark; ! 1052: if (source != dest) ! 1053: mvc((uword)size,source,dest); ! 1054: dest += size; ! 1055: } ! 1056: source += size; ! 1057: } ! 1058: ! 1059: /* ! 1060: * dest is the location of the next free block. Now that compaction ! 1061: * is complete, point blkfree to that location. ! 1062: */ ! 1063: blkfree = dest; ! 1064: } ! 1065: /* <compact */ ! 1066: ! 1067: /* ! 1068: * postqual - mark a string qualifier. Strings outside the string space ! 1069: * are ignored. ! 1070: */ ! 1071: ! 1072: /* >postqual */ ! 1073: postqual(dp) ! 1074: struct descrip *dp; ! 1075: { ! 1076: #ifndef MSDOS ! 1077: extern char *brk(); ! 1078: #endif MSDOS ! 1079: extern char *sbrk(); ! 1080: ! 1081: if (StrLoc(*dp) >= strbase && StrLoc(*dp) < strend) { ! 1082: /* ! 1083: * The string is in the string space. Add it to the string qualifier ! 1084: * list. But before adding it, expand the string qualifier list ! 1085: * if necessary. ! 1086: */ ! 1087: if (qualfree >= equallist) { ! 1088: equallist += Sqlinc; ! 1089: if (currend != sbrk(0)) /* make sure region has not changed */ ! 1090: runerr(304, NULL); ! 1091: if ((int) brk(equallist) == -1) /* make sure region can be expanded */ ! 1092: runerr(303, NULL); ! 1093: currend = sbrk(0); ! 1094: } ! 1095: *qualfree++ = dp; ! 1096: } ! 1097: } ! 1098: /* <postqual */ ! 1099: ! 1100: /* ! 1101: * scollect - collect the string space. quallist is a list of pointers to ! 1102: * descriptors for all the reachable strings in the string space. For ! 1103: * ease of description, it is referred to as if it were composed of ! 1104: * descriptors rather than pointers to them. ! 1105: */ ! 1106: ! 1107: /* >scollect */ ! 1108: scollect(extra) ! 1109: word extra; ! 1110: { ! 1111: register char *source, *dest; ! 1112: register struct descrip **qptr; ! 1113: char *cend; ! 1114: extern int qlcmp(); ! 1115: ! 1116: if (qualfree <= quallist) { ! 1117: /* ! 1118: * There are no accessible strings. Thus, there are none to ! 1119: * collect and the whole string space is free. ! 1120: */ ! 1121: strfree = strbase; ! 1122: return; ! 1123: } ! 1124: /* ! 1125: * Sort the pointers on quallist in ascending order of string locations. ! 1126: */ ! 1127: qsort(quallist, qualfree-quallist, sizeof(struct descrip *), qlcmp); ! 1128: /* ! 1129: * The string qualifiers are now ordered by starting location. ! 1130: */ ! 1131: dest = strbase; ! 1132: source = cend = StrLoc(**quallist); ! 1133: ! 1134: /* ! 1135: * Loop through qualifiers for accessible strings. ! 1136: */ ! 1137: for (qptr = quallist; qptr < qualfree; qptr++) { ! 1138: if (StrLoc(**qptr) > cend) { ! 1139: ! 1140: /* ! 1141: * qptr points to a qualifier for a string in the next clump; ! 1142: * the last clump is moved and source and cend are set for ! 1143: * the next clump. ! 1144: */ ! 1145: MMSMark(source,cend - source); ! 1146: while (source < cend) ! 1147: *dest++ = *source++; ! 1148: source = cend = StrLoc(**qptr); ! 1149: } ! 1150: if (StrLoc(**qptr)+StrLen(**qptr) > cend) ! 1151: /* ! 1152: * qptr is a qualifier for a string in this clump; extend the clump. ! 1153: */ ! 1154: cend = StrLoc(**qptr) + StrLen(**qptr); ! 1155: /* ! 1156: * Relocate the string qualifier. ! 1157: */ ! 1158: StrLoc(**qptr) += dest - source + extra; ! 1159: } ! 1160: ! 1161: /* ! 1162: * Move the last clump. ! 1163: */ ! 1164: MMSMark(source,cend - source); ! 1165: while (source < cend) ! 1166: *dest++ = *source++; ! 1167: strfree = dest; ! 1168: } ! 1169: /* <scollect */ ! 1170: ! 1171: /* ! 1172: * qlcmp - compare the location fields of two string qualifiers for qsort. ! 1173: */ ! 1174: ! 1175: /* >qlcmp */ ! 1176: qlcmp(q1,q2) ! 1177: struct descrip **q1, **q2; ! 1178: { ! 1179: return (int)(StrLoc(**q1) - StrLoc(**q2)); ! 1180: } ! 1181: /* <qlcmp */ ! 1182: ! 1183: /* ! 1184: * mvc - move n bytes from src to dst. ! 1185: */ ! 1186: ! 1187: mvc(n, s, d) ! 1188: uword n; ! 1189: register char *s, *d; ! 1190: { ! 1191: register int words; ! 1192: register int *srcw, *dstw; ! 1193: int bytes; ! 1194: ! 1195: words = n / sizeof(int); ! 1196: bytes = n % sizeof(int); ! 1197: ! 1198: srcw = (int *)s; ! 1199: dstw = (int *)d; ! 1200: ! 1201: if (d < s) { ! 1202: /* ! 1203: * The move is from higher memory to lower memory. (It so happens ! 1204: * that leftover bytes are not moved.) ! 1205: */ ! 1206: while (--words >= 0) ! 1207: *(dstw)++ = *(srcw)++; ! 1208: while (--bytes >= 0) ! 1209: *d++ = *s++; ! 1210: } ! 1211: else if (d > s) { ! 1212: /* ! 1213: * The move is from lower memory to higher memory. ! 1214: */ ! 1215: s += n; ! 1216: d += n; ! 1217: while (--bytes >= 0) ! 1218: *--d = *--s; ! 1219: srcw = (int *)s; ! 1220: dstw = (int *)d; ! 1221: while (--words >= 0) ! 1222: *--dstw = *--srcw; ! 1223: } ! 1224: } ! 1225: ! 1226: /* ! 1227: * sweep - sweep the stack, marking all descriptors there. Method ! 1228: * is to start at a known point, specifically, the frame that the ! 1229: * fp points to, and then trace back along the stack looking for ! 1230: * descriptors and local variables, marking them when they are found. ! 1231: * The sp starts at the first frame, and then is moved down through ! 1232: * the stack. Procedure, generator, and expression frames are ! 1233: * recognized when the sp is a certain distance from the fp, gfp, ! 1234: * and efp respectively. ! 1235: * ! 1236: * Sweeping problems can be manifested in a variety of ways due to ! 1237: * the "if it can't be identified it's a descriptor" methodology. ! 1238: */ ! 1239: sweep(ce) ! 1240: struct b_coexpr *ce; ! 1241: { ! 1242: register word *s_sp; ! 1243: register struct pf_marker *fp; ! 1244: register struct gf_marker *s_gfp; ! 1245: register struct ef_marker *s_efp; ! 1246: word nargs, type, gsize; ! 1247: ! 1248: fp = ce->es_pfp; ! 1249: s_gfp = ce->es_gfp; ! 1250: if (s_gfp != 0) { ! 1251: type = s_gfp->gf_gentype; ! 1252: if (type == G_Psusp) ! 1253: gsize = Wsizeof(*s_gfp); ! 1254: else ! 1255: gsize = Wsizeof(struct gf_smallmarker); ! 1256: } ! 1257: s_efp = ce->es_efp; ! 1258: s_sp = ce->es_sp; ! 1259: nargs = 0; /* Nargs counter is 0 initially. */ ! 1260: ! 1261: while ((fp != 0 || nargs)) { /* Keep going until current fp is ! 1262: 0 and no arguments are left. */ ! 1263: if (s_sp == (word *)fp + Vwsizeof(*pfp) - 1) {/*The sp has reached the upper ! 1264: boundary of a procedure frame, ! 1265: process the frame. */ ! 1266: s_efp = fp->pf_efp; /* Get saved efp out of frame */ ! 1267: s_gfp = fp->pf_gfp; /* Get save gfp */ ! 1268: if (s_gfp != 0) { ! 1269: type = s_gfp->gf_gentype; ! 1270: if (type == G_Psusp) ! 1271: gsize = Wsizeof(*s_gfp); ! 1272: else ! 1273: gsize = Wsizeof(struct gf_smallmarker); ! 1274: } ! 1275: s_sp = (word *)fp - 1; /* First argument descriptor is ! 1276: first word above proc frame */ ! 1277: nargs = fp->pf_nargs; ! 1278: fp = fp->pf_pfp; ! 1279: } ! 1280: else if (s_sp == (word *)s_gfp + gsize - 1) { ! 1281: /* The sp has reached the lower end ! 1282: of a generator frame, process ! 1283: the frame.*/ ! 1284: if (type == G_Psusp) ! 1285: fp = s_gfp->gf_pfp; ! 1286: s_sp = (word *)s_gfp - 1; ! 1287: s_efp = s_gfp->gf_efp; ! 1288: s_gfp = s_gfp->gf_gfp; ! 1289: if (s_gfp != 0) { ! 1290: type = s_gfp->gf_gentype; ! 1291: if (type == G_Psusp) ! 1292: gsize = Wsizeof(*s_gfp); ! 1293: else ! 1294: gsize = Wsizeof(struct gf_smallmarker); ! 1295: } ! 1296: nargs = 1; ! 1297: } ! 1298: else if (s_sp == (word *)s_efp + Wsizeof(*s_efp) - 1) { ! 1299: /* The sp has reached the upper ! 1300: end of an expression frame, ! 1301: process the frame. */ ! 1302: s_gfp = s_efp->ef_gfp; /* Restore gfp, */ ! 1303: if (s_gfp != 0) { ! 1304: type = s_gfp->gf_gentype; ! 1305: if (type == G_Psusp) ! 1306: gsize = Wsizeof(*s_gfp); ! 1307: else ! 1308: gsize = Wsizeof(struct gf_smallmarker); ! 1309: } ! 1310: s_efp = s_efp->ef_efp; /* and efp from frame. */ ! 1311: s_sp -= Wsizeof(*s_efp); /* Move down past expression frame ! 1312: marker. */ ! 1313: } ! 1314: else { /* Assume the sp is pointing at a ! 1315: descriptor. */ ! 1316: if (Qual(*((struct descrip *)(&s_sp[-1])))) ! 1317: postqual(&s_sp[-1]); ! 1318: else if (Pointer(*((struct descrip *)(&s_sp[-1])))) ! 1319: markblock(&s_sp[-1]); ! 1320: s_sp -= 2; /* Move past descriptor. */ ! 1321: if (nargs) /* Decrement argument count if in an*/ ! 1322: nargs--; /* argument list. */ ! 1323: } ! 1324: } ! 1325: } ! 1326: ! 1327: typedef int ALIGN; /* pick most stringent type for alignment */ ! 1328: ! 1329: union bhead { /* header of free block */ ! 1330: struct { ! 1331: union bhead *ptr; /* pointer to next free block */ ! 1332: uword bsize; /* free block size */ ! 1333: } s; ! 1334: ALIGN x; /* force block alignment */ ! 1335: }; ! 1336: ! 1337: typedef union bhead HEADER; ! 1338: #define NALLOC 1024 /* units to request at one time */ ! 1339: ! 1340: ! 1341: static HEADER base; /* start with empty list */ ! 1342: static HEADER *allocp = NULL; /* last allocated block */ ! 1343: ! 1344: char *malloc(nbytes) ! 1345: unsigned nbytes; ! 1346: { ! 1347: HEADER *moremem(); ! 1348: register HEADER *p, *q; ! 1349: register word nunits; ! 1350: int attempts; ! 1351: ! 1352: nunits = 1 + (nbytes + sizeof(HEADER) - 1) / sizeof(HEADER); ! 1353: if ((q = allocp) == NULL) { /* no free list yet */ ! 1354: base.s.ptr = allocp = q = &base; ! 1355: base.s.bsize = 0; ! 1356: } ! 1357: ! 1358: for (attempts = 2; attempts--; q = allocp) { ! 1359: for (p = q->s.ptr;; q = p, p = p->s.ptr) { ! 1360: if (p->s.bsize >= nunits) { /* block is big enough */ ! 1361: if (p->s.bsize == nunits) /* exactly right */ ! 1362: q->s.ptr = p->s.ptr; ! 1363: else { /* allocate tail end */ ! 1364: p->s.bsize -= nunits; ! 1365: p += p->s.bsize; ! 1366: p->s.bsize = nunits; ! 1367: } ! 1368: allocp = q; ! 1369: return (char *)(p + 1); ! 1370: } ! 1371: if (p == allocp) { /* wrap around */ ! 1372: moremem(nunits); /* garbage collect and expand if needed */ ! 1373: break; ! 1374: } ! 1375: } ! 1376: } ! 1377: syserr("cannot allocate requested storage"); ! 1378: } ! 1379: ! 1380: /* ! 1381: * realloc() allocates a new block of memory of a different size ! 1382: * that contains the contents of the current block or as much as ! 1383: * will fit. ! 1384: */ ! 1385: ! 1386: char *realloc(curmem,newsiz) ! 1387: register char *curmem; /* the current memory pointer */ ! 1388: register int newsiz; /* the size of the new allocation */ ! 1389: { ! 1390: register char *newmem, *p; /* the new memory pointer */ ! 1391: register int cursiz; /* the size of the current allocation */ ! 1392: register int n; ! 1393: ! 1394: HEADER *head; /* the pointer to the current header */ ! 1395: ! 1396: if ((newmem = malloc(newsiz)) != NULL) { ! 1397: /* get the current allocation size */ ! 1398: head = (HEADER *) (curmem-1); ! 1399: cursiz = head->s.bsize; ! 1400: p = newmem; ! 1401: n = (cursiz < newsiz ? cursiz : newsiz); ! 1402: while (--n >= 0) ! 1403: *newmem++ = *curmem++; ! 1404: ! 1405: /* free the current block */ ! 1406: free(curmem); ! 1407: return(p); ! 1408: } ! 1409: syserr("malloc failed in realloc"); ! 1410: } ! 1411: ! 1412: /* ! 1413: * calloc() allocates memory using malloc and zeroes it. ! 1414: */ ! 1415: ! 1416: char *calloc(ecnt,esiz) ! 1417: register int ecnt, esiz; ! 1418: { ! 1419: register char *mem, *p; /* the memory pointer */ ! 1420: register int amount; /* the amount of memory needed */ ! 1421: ! 1422: amount = ecnt * esiz; ! 1423: ! 1424: if ((mem = malloc(amount)) != NULL) { ! 1425: p = mem; ! 1426: while (--amount >= 0) ! 1427: *mem++ = 0; ! 1428: return p; ! 1429: } ! 1430: syserr("malloc failure in calloc"); ! 1431: } ! 1432: ! 1433: static HEADER *moremem(nunits) ! 1434: uword nunits; ! 1435: { ! 1436: register char *cp; ! 1437: register HEADER *up; ! 1438: register word rnu; ! 1439: word n; ! 1440: ! 1441: rnu = NALLOC * ((nunits + NALLOC - 1) / NALLOC); ! 1442: n = rnu * sizeof(HEADER); ! 1443: if (statfree + n > statend) { ! 1444: statneed = ((n / statincr) + 1) * statincr; ! 1445: collect(); ! 1446: } ! 1447: if (statfree < statend) { /* that is, if there is any room left */ ! 1448: up = (HEADER *) statfree; ! 1449: up->s.bsize = (statend - statfree) / sizeof(HEADER); ! 1450: statfree = statend; ! 1451: free((char *) (up + 1)); /* add block to free memory */ ! 1452: } ! 1453: } ! 1454: ! 1455: free(ap) /* return block pointed to by ap to free list */ ! 1456: char *ap; ! 1457: { ! 1458: register HEADER *p, *q; ! 1459: ! 1460: p = (HEADER *)ap - 1; /* point to header */ ! 1461: if (p->s.bsize * sizeof(HEADER) >= statneed) ! 1462: statneed = 0; ! 1463: for (q = allocp; !(p > q && p < q->s.ptr); q = q->s.ptr) ! 1464: if (q >= q->s.ptr && (p > q || p < q->s.ptr)) ! 1465: break; /* at one end or the other */ ! 1466: if (p + p->s.bsize == q->s.ptr) { /* join to upper */ ! 1467: p->s.bsize += q->s.ptr->s.bsize; ! 1468: if (p->s.bsize * sizeof(HEADER) >= statneed) ! 1469: statneed = 0; ! 1470: p->s.ptr = q->s.ptr->s.ptr; ! 1471: } ! 1472: else ! 1473: p->s.ptr = q->s.ptr; ! 1474: if (q + q->s.bsize == p) { /* join to lower */ ! 1475: q->s.bsize += p->s.bsize; ! 1476: if (q->s.bsize * sizeof(HEADER) >= statneed) ! 1477: statneed = 0; ! 1478: q->s.ptr = p->s.ptr; ! 1479: } ! 1480: else ! 1481: q->s.ptr = p; ! 1482: allocp = q; ! 1483: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.