4.3BSD - /usr/src/new/icon/rt/gc.c

   1: #include "../h/rt.h"
   2: #include "../h/gc.h"
   3: #ifdef VAX
   4: #define MAIN
   5: #endif VAX
   6: #ifdef PORT
   7: #define MAIN
   8: #endif PORT
   9: #ifdef MAIN
  10: /*
  11:  * hneed - insure that at least bytes of space are left in the heap.
  12:  *  The amount of space needed is transmitted to the collector via
  13:  *  the global variable heapneed.
  14:  */
  15: 
  16: hneed(bytes)
  17: unsigned bytes;
  18:    {
  19:    heapneed = bytes;
  20:    if (bytes > maxheap - hpfree)
  21:       gcollect(0);
  22:    }
  23: 
  24: /*
  25:  * sneed - insure that at least chars of space are left in the string
  26:  *  space.  The amount of space needed is transmitted to the collector
  27:  *  via the global variable strneed.
  28:  */
  29: 
  30: sneed(chars)
  31: unsigned chars;
  32:    {
  33:    strneed = chars;
  34:    if (chars > estrings - sfree)
  35:       gcollect(0);
  36:    }
  37: 
  38: /*
  39:  * esneed - insure that there is a free co-expression stack.  esfree
  40:  *  points to the linked list of free stacks.
  41:  */
  42: 
  43: esneed()
  44:    {
  45:    if (esfree == NULL)
  46:       gcollect(1);
  47:    }
  48: 
  49: /*
  50:  * escollect - collect the expression stack space.  This is done after
  51:  *  the marking phase of garbage collection and the stacks that are
  52:  *  reachable have pointers to data blocks, rather than T_ESTACK,
  53:  *  in their type field.
  54:  */
  55: 
  56: escollect()
  57:    {
  58:    register int *ep;
  59:    register struct b_estack *sp;
  60: 
  61:    /*
  62:     * Reset the type for &main.
  63:     */
  64:    BLKLOC(k_main)->estack.type = T_ESTACK;
  65: 
  66:    /*
  67:     * Reset the free list pointer.
  68:     */
  69:    esfree = NULL;
  70: 
  71:    /*
  72:     * The co-expression stacks start at stacks and lie contiguously.
  73:     *  ep is pointed at the low word of each stack and sp is pointed
  74:     *  at the b_estack block contained in the space for the stack.
  75:     *  (Note that the last word of the b_estack block is the last word
  76:     *  of the space for the co-expression stack.
  77:     */
  78:    for (ep = stacks; ep < estacks; ep += stksize) {
  79:       sp = (struct b_estack *) (ep + (stksize - sizeof(struct b_estack)/WORDSIZE));
  80:       if (blktype(sp) == T_ESTACK) {
  81:          /*
  82:           * This co-expression was not marked, so it can be collected.
  83:           *  The stacks are linked through the first word of the stack
  84:           *  space with esfree pointing to the last-collected stack.
  85:           */
  86:          *ep = (int) esfree;
  87:          esfree = ep;
  88:          }
  89:       else
  90:          /*
  91:           * The co-expression was marked, so just reset the type field.
  92:           */
  93:          blktype(sp) = T_ESTACK;
  94:       }
  95:    }
  96: 
  97: /*
  98:  * collect - do a garbage collection.  esneed indicates if a co-expression
  99:  *  stack is needed.
 100:  */
 101: 
 102: collect(esneed)
 103: int esneed;
 104:    {
 105:    register int extra;
 106:    register char *newend;
 107:    register struct descrip *dp;
 108:    char *sptr;
 109:    extern char *brk();
 110: 
 111:    /*
 112:     * Reset the string qualifier free list pointer.
 113:     */
 114:    sqfree = sqlist;
 115: 
 116:    /*
 117:     * Mark the stacks for &main and the current co-expression.
 118:     */
 119:    mark(&k_main);
 120:    mark(&current);
 121:    /*
 122:     * Mark &subject and the cached s2 and s3 strings for map().
 123:     */
 124:    mark(&k_subject);
 125:    mark(&maps2);
 126:    mark(&maps3);
 127:    /*
 128:     * Mark the tended descriptors and the global and static variables.
 129:     */
 130:    for (dp = tended; dp < etended; dp++)
 131:       mark(dp);
 132:    for (dp = globals; dp < eglobals; dp++)
 133:       mark(dp);
 134:    for (dp = statics; dp < estatics; dp++)
 135:       mark(dp);
 136: 
 137:    /*
 138:     * Collect available co-expression stacks.
 139:     */
 140:    escollect();
 141:    if (esneed && esfree == NULL) {
 142:       /*
 143:        * A co-expression stack is needed, but none are available.  The
 144:        *  new stack at the end of the stack space and is made available
 145:        *  by pointing esfree at it.  *estacks is zeroed to terminate the
 146:        *  (now one element) co-expression free list.
 147:        */
 148:       esfree = estacks;
 149:       *estacks = 0;
 150:       /*
 151:        * Move back the end of the expression space by the size of a
 152:        *  stack and indicate stksize words of memory are needed.
 153:        */
 154:       estacks += stksize;
 155:       extra = stksize*WORDSIZE;
 156:       newend = (char *) sqlist + extra;
 157:       /*
 158:        * This next calculation determines if there is space for the new
 159:        *  stack, but it's not clear what all's going on here.
 160:        */
 161:       if (newend < (char *)sqlist || newend > (char *)0x7fffffff ||
 162:           (newend > (char *)esqlist && ((int) brk(newend) == -1)))
 163:          runerr(305, NULL);
 164:       }
 165:    else
 166:       /*
 167:        * Another co-expression stack is not needed.
 168:        */
 169:       extra = 0;
 170: 
 171:    /*
 172:     * Collect the string space, indicating that it must be moved back
 173:     *  extra bytes.
 174:     */
 175:    scollect(extra);
 176:    /*
 177:     * sptr is post-gc value for strings.  Move back pointers for estrings
 178:     *  and sqlist according to value of extra.
 179:     */
 180:    sptr = strings + extra;
 181:    estrings += extra;
 182:    sqlist =  sqlist + extra;
 183:    if (sqlist > esqlist)
 184:       esqlist = sqlist;
 185: 
 186:    /*
 187:     * Calculate a value for extra space.  The value is (the larger of
 188:     *  (twice the string space needed) or (the number of words currently
 189:     *  in the string space)) plus the unallocated string space.
 190:     */
 191:    extra = (MAX(2*strneed, (estrings-(char *)estacks)/4) -
 192:             (estrings - extra - sfree) + (GRANSIZE-1)) & ~(GRANSIZE-1);
 193: 
 194:    while (extra > 0) {
 195:       /*
 196:        * Try to get extra more bytes of storage.  If it can't be gotten,
 197:        *  decrease the value by GRANSIZE and try again.  If it's gotten,
 198:        *  move back estrings and sqlist.
 199:        */
 200:       newend = (char *)sqlist + extra;
 201:       if (newend >= (char *)sqlist &&
 202:           (newend <= (char *)esqlist || ((int) brk(newend) != -1))) {
 203:          estrings += extra;
 204:          sqlist = (struct descrip **) newend;
 205:          break;
 206:          }
 207:       extra -= GRANSIZE;
 208:       }
 209: 
 210:    /*
 211:     * Adjust the pointers in the heap.  Note that hpbase is the old base
 212:     *  of the heap and estrings will be the post-gc base of the heap.
 213:     */
 214:    adjust(hpbase,estrings);
 215:    /*
 216:     * Compact the heap.
 217:     */
 218:    compact(hpbase);
 219:    /*
 220:     * Calculate a value for extra space.  The value is (the larger of
 221:     *  (twice the heap space needed) or (the number of words currently
 222:     *  in the heap space)) plus the unallocated heap space.
 223:     */
 224:    extra = (MAX(2*heapneed, (maxheap-hpbase)/4) +
 225:             hpfree - maxheap + (GRANSIZE-1)) & ~(GRANSIZE-1);
 226:    while (extra > 0) {
 227:       /*
 228:        * Try to get extra more bytes of storage.  If it can't be gotten,
 229:        *  decrease the value by GRANSIZE and try again.  If it's gotten,
 230:        *  move back sqlist.
 231:        */
 232:       newend = (char *)sqlist + extra;
 233:       if (newend >= (char *)sqlist &&
 234:           (newend <= (char *)esqlist || ((int) brk(newend) != -1))) {
 235:          sqlist = (struct descrip **) newend;
 236:          break;
 237:          }
 238:       extra -= GRANSIZE;
 239:       }
 240:    if (sqlist > esqlist)
 241:       esqlist = sqlist;
 242: 
 243:    if (estrings != hpbase) {
 244:       /*
 245:        * estrings is not equal to hpbase and this indicates that the
 246:        *  co-expression and/or string space was expanded and thus
 247:        *  the heap must be moved.  There is an assumption here that the
 248:        *  heap always moves up in memory, i.e., the co-expression and
 249:        *  string spaces never shrink.  With this assumption in hand,
 250:        *  the heap must be moved before the string space lest the string
 251:        *  space overwrite heap data.  The assumption is valid, but beware
 252:        *  if shrinking regions are ever implemented.
 253:        */
 254:       mvc((unsigned)(hpfree - hpbase), hpbase, estrings);
 255:       hpfree += estrings - hpbase;
 256:       hpbase = estrings;
 257:       }
 258:    if (sptr != strings) {
 259:       /*
 260:        * sptr is not equal to strings and this indicates that the
 261:        *  co-expression space was expanded and thus the string space
 262:        *  must be moved up in memory.
 263:        */
 264:       mvc((unsigned)(sfree - strings), strings, sptr);
 265:       sfree += sptr - strings;
 266:       strings = sptr;
 267:       }
 268: 
 269:    /*
 270:     * Expand the heap.
 271:     */
 272:    maxheap = (char *)sqlist;
 273:    return;
 274:    }
 275: /*
 276:  * mark - mark each accessible block in the heap and build back-list of
 277:  *  descriptors pointing to that block. (Phase I of garbage collection.)
 278:  */
 279: 
 280: mark(cdesc)
 281: struct descrip *cdesc;
 282:    {
 283:    register struct descrip *ndesc;
 284:    register char *endblock, *block;
 285:    static int type;
 286:    static int fdesc;
 287: 
 288:    if (QUAL(*cdesc))
 289:       /*
 290:        * The descriptor is for a string, so pass the buck to marksq.
 291:        */
 292:       marksq(cdesc);
 293:    else if (isptr(cdesc)) {
 294:       /*
 295:        * The descriptor is a pointer to a block or a variable.  Point
 296:        *  block at the block referenced by the descriptor.
 297:        */
 298:       block = (char *) BLKLOC(*cdesc);
 299:       if (VAR(*cdesc) && !TVAR(*cdesc))
 300:          /*
 301:           * The descriptor is a variable; point block at the start of the
 302:           *  block containing the descriptor that cdesc points to.  For
 303:           *  example, descriptors of this sort are created by subscripting
 304:           *  lists.
 305:           */
 306:          block = (char *) ((int *) block - OFFSET(*cdesc));
 307: 
 308:       if (block >= hpbase && block < hpfree) {
 309:          /*
 310:           * The block is the heap (blocks outside the heap are ignored);
 311:           *  get the type of the block.
 312:           */
 313:          type = blktype(block);
 314:          if (type <= MAXTYPE)
 315:             /*
 316:              * type is a valid type, indicating that this block hasn't
 317:              *  been marked.  Point endblock at the byte past the end
 318:              *  of the block.
 319:              */
 320:             endblock = block + getsize(block);
 321:          /*
 322:           * Add cdesc to the back-chain for the block and point the
 323:           *  block (via the type field) at cdesc.
 324:           */
 325:          BLKLOC(*cdesc) = (union block *) type;
 326:          blktype(block) = (int) cdesc;
 327:          if ((type <=  MAXTYPE) && ((fdesc = firstd[(int)type]) > 0))
 328:             /*
 329:              * The block has not been marked, and it does contain descriptors.
 330:              *  Mark each descriptor.
 331:              */
 332:             for (ndesc = (struct descrip *) (block + fdesc);
 333:                (char *) ndesc < endblock; ndesc++)
 334:                 mark(ndesc);
 335:          }
 336:       if (!VAR(*cdesc) && TYPE(*cdesc) == T_ESTACK &&
 337:          blktype(block) <= MAXTYPE) {
 338:          /*
 339:           * cdesc points to a co-expression block that hasn't been marked.
 340:           *  Point the block at cdesc.  Sweep the co-expression's stack
 341:           *  and mark the blocks for the activating co-expression and
 342:           *  the co-expression's refresh block.
 343:           */
 344:          blktype(block) = (int) cdesc;
 345:          sweep(((struct b_estack *)block)->boundary);
 346:          mark(&((struct b_estack *)block)->activator);
 347:          mark(&((struct b_estack *)block)->freshblk);
 348:          }
 349:       }
 350:    }
 351: 
 352: /*
 353:  * adjust - adjust pointers into heap, beginning with block oblk and
 354:  *  basing the "new" heap at nblk.  (Phase II of garbage collection.)
 355:  */
 356: 
 357: adjust(oblk,nblk)
 358: char *oblk, *nblk;
 359:    {
 360:    register struct descrip *nxtptr, *tptr;
 361: 
 362:    /*
 363:     * Loop through to end of allocated heap space moving oblk to each
 364:     *  block in turn, using the size of a block to find the next block.
 365:     */
 366:    while (oblk < hpfree) {
 367:       if ((int) (nxtptr = (struct descrip *) blktype(oblk)) > MAXTYPE) {
 368:          /*
 369:           * The type field of oblk is a back-pointer.  Work along the chain
 370:           *  of back pointers, changing each block location from oblk
 371:           *  to nblk.
 372:           */
 373:          while ((unsigned)nxtptr > MAXTYPE) {
 374:             tptr = nxtptr;
 375:             nxtptr = (struct descrip *) BLKLOC(*nxtptr);
 376:             if (VAR(*tptr) && !TVAR(*tptr))
 377:                BLKLOC(*tptr) = (union block *) ((int *) nblk + OFFSET(*tptr));
 378:             else
 379:                BLKLOC(*tptr) = (union block *) nblk;
 380:             }
 381:          blktype(oblk) = (unsigned)nxtptr | MARK;
 382:          nblk += getsize(oblk);
 383:          }
 384:       oblk += getsize(oblk);
 385:       }
 386:    }
 387: 
 388: /*
 389:  * compact - compact good blocks in heap. (Phase III of garbage collection.)
 390:  */
 391: 
 392: compact(oblk)
 393: char *oblk;
 394:    {
 395:    register char *nblk;
 396:    register int size;
 397: 
 398:    /*
 399:     * Start at oblk, which happens to be hpbase.
 400:     */
 401:    nblk = oblk;
 402:    /*
 403:     * Loop through to end of allocated heap space moving oblk to each
 404:     *  block in turn, using the size of a block to find the next block.
 405:     *  If a block has been marked, it is copied to the location pointed
 406:     *  at by nblk and nblk is pointed past the end of the block, which
 407:     *  is the location to place the next good block at.  Good blocks
 408:     *  are un-marked.
 409:     */
 410:    while (oblk < hpfree) {
 411:       size = getsize(oblk);
 412:       if (blktype(oblk) & MARK) {
 413:          blktype(oblk) &= ~MARK;
 414:          if (oblk != nblk)
 415:             mvc((unsigned)size,oblk,nblk);
 416:          nblk += size;
 417:          }
 418:       oblk += size;
 419:       }
 420:    /*
 421:     * nblk is the location of the next free block, so now that compaction
 422:     *  is complete, point hpfree at that location.
 423:     */
 424:    hpfree = nblk;
 425:    }
 426: 
 427: /*
 428:  * marksq - mark a string qualifier.  Strings outside the string space
 429:  *  are ignored.
 430:  */
 431: 
 432: marksq(d)
 433: struct descrip *d;
 434:    {
 435:    extern char *brk();
 436: 
 437:    if (STRLOC(*d) >= strings && STRLOC(*d) < estrings) {
 438:       /*
 439:        * The string is in the string space, add it to the string qualifier
 440:        *  list.  But before adding it, expand the string qualifier list
 441:        *  if necessary.
 442:        */
 443:       if (sqfree >= esqlist) {
 444:          esqlist += SQLINC;
 445:          if ((int) brk(esqlist) == -1)
 446:             runerr(303, NULL);
 447:          }
 448:       *sqfree++ = d;
 449:       }
 450:    }
 451: 
 452: /*
 453:  * scollect - collect the string space.  sqlist is a list of pointers to
 454:  *  descriptors for all the reachable strings in the string space.  For
 455:  *  ease of description, it is referred to as if it were composed of
 456:  *  descriptors rather than pointers to them.
 457:  */
 458: 
 459: scollect(extra)
 460: int extra;
 461:    {
 462:    register char *s, *d;
 463:    register struct descrip **p;
 464:    char *e;
 465:    extern int sqcmp();
 466: 
 467:    if (sqfree <= sqlist) {
 468:       /*
 469:        * There are no accessible strings, thus there are none to collect
 470:        *  and the whole string space is free.
 471:        */
 472:       sfree = strings;
 473:       return;
 474:       }
 475:    /*
 476:     * Sort the sqlist in ascending order of string locations.
 477:     */
 478:    qsort(sqlist, sqfree-sqlist, sizeof(struct descrip *), sqcmp);
 479:    /*
 480:     * The string qualifiers are now ordered by starting location.
 481:     *  The algorithm used is described in detail in one of the references
 482:     *  cited in the "tour", but briefly...
 483:     *
 484:     * The string region can be thought of as being made up of clumps,
 485:     *  where a clump is a contiguous area of strings that are referenced.
 486:     *  For example, imagine sqlist looks like:
 487:     *
 488:     *   [2,400]
 489:     *   [3,400]
 490:     *   [10,400]
 491:     *   [12,415]
 492:     *   [4,420]
 493:     *   [3,430]
 494:     *   [1,430]
 495:     *
 496:     * There are three clumps:  The first starts at location 400 and extends
 497:     *  to 409.  The second starts at 415 and extends to 426.  The third
 498:     *  starts at 430 and extends to 432.  Note that there are gaps, i.e.
 499:     *  garbage, at 410-414 and 427-429.
 500:     *
 501:     * After collection, sqlist will look like:
 502:     *
 503:     *        [2,400]
 504:     *        [3,400]
 505:     *        [10,400]
 506:     *        [12,410]
 507:     *        [4,415]
 508:     *        [3,422]
 509:     *        [1,422]
 510:     *
 511:     * Note how the gaps have been closed by moving the strings downward
 512:     *  in memory.
 513:     *
 514:     * The method used is to look at each qualifier in sqlist in turn
 515:     *  and determine which ones lie in clumps and the extent of each
 516:     *  clump.  The qualifiers referencing strings in each clump are
 517:     *  relocated and then the clump is moved down (compacted).
 518:     *
 519:     * d points to the next free location to compact into.  s is the
 520:     *  start of the current clump and e is the end.
 521:     */
 522:    d = strings;
 523:    s = e = STRLOC(**sqlist);
 524:    /*
 525:     * Loop through qualifiers for accessible strings.
 526:     */
 527:    for (p = sqlist; p < sqfree; p++) {
 528:       if (STRLOC(**p) > e) {
 529:          /*
 530:           * p is a qualifier for a string in the next clump; the last
 531:           *  clump is moved and s and e are set for the next clump.
 532:           */
 533:          while (s < e)
 534:             *d++ = *s++;
 535:          s = e = STRLOC(**p);
 536:          }
 537:       if (STRLOC(**p)+STRLEN(**p) > e)
 538:          /*
 539:           * p is a qualifier for a string in this clump, extend the clump.
 540:           */
 541:          e = STRLOC(**p) + STRLEN(**p);
 542:       /*
 543:        * Relocate the string qualifier.
 544:        */
 545:       STRLOC(**p) += d - s + extra;
 546:       }
 547:    /*
 548:     * Move the last clump.
 549:     */
 550:    while (s < e)
 551:       *d++ = *s++;
 552:    sfree = d;
 553:    }
 554: 
 555: /*
 556:  * sqcmp - compare the location fields of two string qualifiers for qsort.
 557:  */
 558: 
 559: sqcmp(q1,q2)
 560: struct descrip **q1, **q2;
 561:    {
 562:    return (STRLOC(**q1) - STRLOC(**q2));
 563:    }
 564: 
 565: /*
 566:  * mvc - move n bytes from src to dst.
 567:  */
 568: 
 569: mvc(n, s, d)
 570: unsigned n;
 571: register char *s, *d;
 572:    {
 573:    register int words;
 574:    register int *srcw, *dstw;
 575:    int bytes;
 576: 
 577:    words = n / sizeof(int);
 578:    bytes = n % sizeof(int);
 579: 
 580:    srcw = (int *)s;
 581:    dstw = (int *)d;
 582: 
 583:    if (d < s) {
 584:       /*
 585:        * The move is from higher memory to lower memory.  (It so happens
 586:        *  that leftover bytes are not moved.)
 587:        */
 588:       while (--words >= 0)
 589:          *(dstw)++ = *(srcw)++;
 590:       while (--bytes >= 0)
 591:          *d++ = *s++;
 592:       }
 593:    else if (d > s) {
 594:       /*
 595:        * The move is from lower memory to higher memory.
 596:        */
 597:       s += n;
 598:       d += n;
 599:       while (--bytes >= 0)
 600:          *--d = *--s;
 601:       srcw = (int *)s;
 602:       dstw = (int *)d;
 603:       while (--words >= 0)
 604:          *--dstw = *--srcw;
 605:       }
 606:    }
 607: 
 608: #endif MAIN
 609: #ifdef PDP11
 610: /*
 611:  * hneed(bytes) - insure at least 'bytes' space left in heap.
 612:  */
 613: 
 614: hneed(bytes)
 615: unsigned bytes;
 616:    {
 617:    heapneed = bytes;
 618:    if (bytes > maxheap - hpfree)
 619:       gcollect(0);
 620:    }
 621: 
 622: /*
 623:  * sneed(chars) - insure at least 'chars' bytes left in string space.
 624:  */
 625: 
 626: sneed(chars)
 627: unsigned chars;
 628:    {
 629:    strneed = chars;
 630:    if (chars > estrings - sfree)
 631:       gcollect(0);
 632:    }
 633: 
 634: /*
 635:  * esneed() - insure stack space free list is not empty.
 636:  */
 637: 
 638: esneed()
 639:    {
 640:    if (esfree == NULL)
 641:       gcollect(1);
 642:    }
 643: 
 644: /*
 645:  * escollect() - collect the expression stack space after marking.
 646:  */
 647: 
 648: escollect()
 649:    {
 650:    register int *ep;
 651:    register struct b_estack *sp;
 652:    register struct descrip *nxtptr, *tptr;
 653: 
 654:    BLKLOC(k_main)->estack.type = T_ESTACK;   /* must reset */
 655: 
 656:    esfree = NULL;
 657:    for (ep = stacks; ep < estacks; ep += stksize) {
 658:       sp = ep + (stksize - sizeof(struct b_estack)/2);
 659:       if (blktype(sp) == T_ESTACK) {      /* add to free list */
 660:          *ep = esfree;
 661:          esfree = ep;
 662:          }
 663:       else                               /* adjust type field */
 664:          blktype(sp) = T_ESTACK;
 665:       }
 666:    }
 667: 
 668: /*
 669:  * collect - call the heap garbage collector.
 670:  */
 671: 
 672: collect(esneed)
 673: int esneed;
 674:    {
 675:    register int extra;
 676:    register char *newend;
 677:    register struct descrip *dp;
 678:    char *sptr;
 679:    extern char *brk();
 680: 
 681:    sqfree = sqlist;                /* initialize string qualifier list */
 682: 
 683:    mark(&k_main);               /* mark main stack */
 684:    mark(&current);              /* mark current stack */
 685:    mark(&k_subject);            /* mark tended descriptors */
 686:    mark(&maps2);
 687:    mark(&maps3);
 688:    for (dp = tended; dp < etended; dp++)
 689:       mark(dp);
 690:    for (dp = globals; dp < eglobals; dp++)
 691:       mark(dp);
 692:    for (dp = statics; dp < estatics; dp++)
 693:       mark(dp);
 694: 
 695:    escollect();                        /* collect available expression stacks */
 696:    if (esneed && esfree == NULL) {
 697:       esfree = estacks;                /* need to make room for another stack */
 698:       *estacks = 0;
 699:       estacks += stksize;
 700:       extra = stksize*sizeof(int);        /* string and heap ptrs are chars */
 701:       newend = sqlist + extra;
 702:       if (newend < (char *)sqlist || newend > (char *)0177700 ||
 703:           (newend > (char *)esqlist && brk(newend) == -1))
 704:          runerr(305, NULL);
 705:       }
 706:    else
 707:       extra = 0;
 708: 
 709:    scollect(extra);                /* collect string space */
 710:    sptr = strings + extra;      /* remember new location of string space */
 711:    estrings += extra;
 712:    (char *)sqlist += extra;
 713:    if (sqlist > esqlist)
 714:       esqlist = sqlist;
 715: 
 716:    extra = (MAX(2*strneed, (estrings-estacks)/4) -
 717:             (estrings - extra - sfree) + 63) & ~077;
 718:    while (extra > 0) {                /* need breathing room? */
 719:       newend = (char *)sqlist + extra;
 720:       if (newend >= (char *)sqlist && newend <= (char *)0177700 &&
 721:           (newend <= (char *)esqlist ||        brk(newend) != -1)) {
 722:          estrings += extra;
 723:          sqlist = newend;
 724:          break;
 725:          }
 726:       extra -= 64;
 727:       }
 728:    adjust(hpbase,estrings);        /* adjust pointers into heap */
 729:    compact(hpbase);                /* compact heap */
 730:    extra = (MAX(2*heapneed, (maxheap-hpbase)/4) +
 731:             hpfree - maxheap + 63) & ~077;
 732:    while (extra > 0) {                /* need breathing room? */
 733:       newend = (char *)sqlist + extra;
 734:       if (newend >= (char *)sqlist && newend <= (char *)0177700 &&
 735:           (newend <= (char *)esqlist ||        brk(newend) != -1)) {
 736:          sqlist = newend;
 737:          break;
 738:          }
 739:       extra -= 64;
 740:       }
 741:    if (sqlist > esqlist)
 742:       esqlist = sqlist;
 743:    if (estrings != hpbase) {                /* move heap */
 744:       mvc((unsigned)(hpfree - hpbase), hpbase, estrings);
 745:       hpfree += estrings - hpbase;
 746:       hpbase = estrings;
 747:       }
 748:    if (sptr != strings) {                /* move string space */
 749:       mvc((unsigned)(sfree - strings), strings, sptr);
 750:       sfree += sptr - strings;
 751:       strings = sptr;
 752:       }
 753:    maxheap = (char *)sqlist;                /* expand heap */
 754: 
 755:    return;
 756:    }
 757: 
 758: /*
 759:  * mark - mark each accessible block in the heap and build back-list of
 760:  *  descriptors pointing to that block. (Phase I of garbage collection)
 761:  */
 762: 
 763: mark(cdesc)
 764: struct descrip *cdesc;                /* current descriptor */
 765:    {
 766:    register struct descrip *ndesc;
 767:    register char *endblock, *block;
 768:    static char *type;
 769:    static int fdesc;
 770: 
 771:    if (QUAL(*cdesc))                 /* if descriptor is a string qualifier, */
 772:       marksq(cdesc);                /*   mark it for scollect */
 773:    else if (isptr(cdesc)) {        /* ok, descriptor is a pointer */
 774:       block = BLKLOC(*cdesc);        /* get pointer to top of block */
 775:       if (VAR(*cdesc) && !TVAR(*cdesc))  /* if variable, need offset */
 776:          block = (int *)block - OFFSET(*cdesc);
 777: 
 778:       if (block >= hpbase && block < hpfree) {        /* insure it points to heap */
 779:          type = blktype(block);         /* save type and end of block */
 780:          if (type <= MAXTYPE)
 781:             endblock = block + getsize(block);
 782:          BLKLOC(*cdesc) = type;         /* add descriptor to back chain */
 783:          blktype(block) = cdesc;
 784:                                         /* sweep descriptors in block */
 785:          if ((type <=  MAXTYPE) && ((fdesc = firstd[(int)type]) > 0))
 786:             for (ndesc = block + fdesc; ndesc < endblock; ndesc++)
 787:                 mark(ndesc);
 788:          }
 789:       if (!VAR(*cdesc) && TYPE(*cdesc) == T_ESTACK &&
 790:          (char *)blktype(block) <= MAXTYPE) {
 791:          blktype(block) = cdesc;             /* note block as visited */
 792:          sweep(((struct b_estack *)block)->boundary);
 793:          mark(&((struct b_estack *)block)->activator);
 794:          mark(&((struct b_estack *)block)->freshblk);
 795:          }
 796:       }
 797:    }
 798: 
 799: /*
 800:  * adjust - adjust pointers into heap, beginning with heapblock 'oblk'.
 801:  *   (Phase II of garbage collection)
 802:  */
 803: 
 804: adjust(oblk,nblk)
 805: char *oblk, *nblk;
 806:    {
 807:    register struct descrip *nxtptr, *tptr;
 808: 
 809:    while (oblk < hpfree) {              /* linear sweep through heap */
 810:       if ((nxtptr = blktype(oblk)) > MAXTYPE) {
 811:          while ((unsigned)nxtptr > MAXTYPE) {
 812:             tptr = nxtptr;
 813:             nxtptr = BLKLOC(*nxtptr);
 814:             if (VAR(*tptr) && !TVAR(*tptr))
 815:                BLKLOC(*tptr) = (int *)nblk + OFFSET(*tptr);
 816:             else
 817:                BLKLOC(*tptr) = nblk;
 818:             }
 819:          blktype(oblk) = (unsigned)nxtptr | MARK;
 820:          nblk += getsize(oblk);
 821:          }
 822:       oblk += getsize(oblk);
 823:       }
 824:    }
 825: 
 826: /*
 827:  * compact - compact good blocks in heap, beginning with block 'oblk'.
 828:  *   (Phase III of garbage collection)
 829:  */
 830: 
 831: compact(oblk)
 832: char *oblk;
 833:    {
 834:    register char *nblk;
 835:    register int size;
 836: 
 837:    nblk = oblk;                  /* linear sweep through heap */
 838:    while (oblk < hpfree) {
 839:       size = getsize(oblk);
 840:       if (blktype(oblk) & MARK) {    /* move good block */
 841:          blktype(oblk) &= ~MARK;     /* turn off mark */
 842:          if (oblk != nblk)
 843:             mvc((unsigned)size,oblk,nblk);
 844:          nblk += size;
 845:          }
 846:       oblk += size;
 847:       }
 848:    hpfree = nblk;                /* reset free space pointer */
 849:    }
 850: 
 851: /*
 852:  * marksq - mark a string qualifier.  If it points into the
 853:  * string space, put a pointer to it in the string qualifier
 854:  * list.
 855:  */
 856: 
 857: marksq(d)
 858: struct descrip *d;
 859:    {
 860:    extern char *brk();
 861: 
 862:    if (STRLOC(*d) >= strings && STRLOC(*d) < estrings) {
 863:       if (sqfree >= esqlist) {
 864:          esqlist += SQLINC;
 865:          if ((int)brk(esqlist) == -1)
 866:             runerr(303, NULL);
 867:          }
 868:       *sqfree++ = d;
 869:       }
 870:    }
 871: 
 872: /*
 873:  * scollect - collect the string space.
 874:  * A list of string qualifiers points to all valid strings.
 875:  */
 876: 
 877: scollect(extra)
 878: int extra;
 879:    {
 880:    register char *s, *d;
 881:    register struct descrip **p;
 882:    char *e;
 883:    extern int sqcmp();
 884: 
 885:    if (sqfree <= sqlist) {
 886:       sfree = strings;
 887:       return;
 888:       }
 889:    qsort(sqlist, sqfree-sqlist, sizeof(struct descrip *), sqcmp);
 890:    d = strings;
 891:    s = e = STRLOC(**sqlist);
 892:    for (p = sqlist; p < sqfree; p++) {
 893:       if (STRLOC(**p) > e) {                /* outside last clump */
 894:          while (s < e)                        /* move the clump */
 895:             *d++ = *s++;
 896:          s = e = STRLOC(**p);                /* start a new clump */
 897:          }
 898:       if (STRLOC(**p)+STRLEN(**p) > e)        /* extend the clump */
 899:          e = STRLOC(**p) + STRLEN(**p);
 900:       STRLOC(**p) += d - s + extra;        /* relocate the string qualifier */
 901:       }
 902:    while (s < e)                        /* move the last clump */
 903:       *d++ = *s++;
 904:    sfree = d;
 905:    }
 906: 
 907: /*
 908:  * sqcmp - compare the location fields of two string qualifiers for qsort.
 909:  */
 910: 
 911: sqcmp(q1,q2)
 912: struct descrip **q1, **q2;
 913:    {
 914:    return (STRLOC(**q1) - STRLOC(**q2));
 915:    }
 916: 
 917: /*
 918:  * mvc - move n bytes from src to dst.
 919:  * src and dst must be at word boundaries.
 920:  */
 921: 
 922: mvc(n, s, d)
 923: unsigned n;
 924: register char *s, *d;
 925:    {
 926:    register int words;
 927:    int bytes;
 928: 
 929:    words = n / sizeof(int);
 930:    bytes = n % sizeof(int);
 931: 
 932:    if (d < s) {                  /* move back */
 933:       while (--words >= 0)
 934:          *((int *)d)++ = *((int *)s)++;
 935:       while (--bytes >= 0)
 936:          *d++ = *s++;
 937:       }
 938:    else if (d > s) {             /* move forward */
 939:       s += n;
 940:       d += n;
 941:       while (--bytes >= 0)
 942:          *--d = *--s;
 943:       while (--words >= 0)
 944:          *--(int *)d = *--(int *)s;
 945:       }
 946:    }
 947: #endif PDP11

Defined functions

Defined macros