home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / rmemmgt.r < prev    next >
Text File  |  2002-01-18  |  46KB  |  1,482 lines
  1. /*
  2.  * File: rmemmgt.r
  3.  *  Contents: block description arrays, memory initialization,
  4.  *   garbage collection, dump routines
  5.  */
  6.  
  7. /*
  8.  * Prototypes
  9.  */
  10. static void postqual        (dptr dp);
  11. static void markblock    (dptr dp);
  12. static void markptr        (union block **ptr);
  13. static void sweep        (struct b_coexpr *ce);
  14. static void sweep_stk    (struct b_coexpr *ce);
  15. static void reclaim        (void);
  16. static void cofree        (void);
  17. static void scollect        (word extra);
  18. static int     qlcmp        (dptr  *q1,dptr  *q2);
  19. static void adjust        (char *source, char *dest);
  20. static void compact        (char *source);
  21. static void mvc        (uword n, char *src, char *dest);
  22.  
  23. #ifdef MultiThread
  24. static void markprogram    (struct progstate *pstate);
  25. #endif                    /*MultiThread*/
  26.  
  27. /*
  28.  * Variables
  29.  */
  30.  
  31. #ifndef MultiThread
  32. word coll_stat = 0;             /* collections in static region */
  33. word coll_str = 0;              /* collections in string region */
  34. word coll_blk = 0;              /* collections in block region */
  35. word coll_tot = 0;              /* total collections */
  36. #endif                /* MultiThread */
  37. word alcnum = 0;                /* co-expressions allocated since g.c. */
  38.  
  39. dptr *quallist;                 /* string qualifier list */
  40. dptr *qualfree;                 /* qualifier list free pointer */
  41. dptr *equallist;                /* end of qualifier list */
  42.  
  43. int qualfail;                   /* flag: qualifier list overflow */
  44.  
  45. /*
  46.  * Allocated block size table (sizes given in bytes).  A size of -1 is used
  47.  *  for types that have no blocks; a size of 0 indicates that the
  48.  *  second word of the block contains the size; a value greater than
  49.  *  0 is used for types with constant sized blocks.
  50.  */
  51.  
  52. int bsizes[] = {
  53.     -1,                       /* T_Null (0), not block */
  54.     -1,                       /* T_Integer (1), not block */
  55.      0,                       /* T_Lrgint (2), large integer */
  56.      sizeof(struct b_real),   /* T_Real (3), real number */
  57.      sizeof(struct b_cset),   /* T_Cset (4), cset */
  58.      sizeof(struct b_file),   /* T_File (5), file block */
  59.      0,                       /* T_Proc (6), procedure block */
  60.      0,                       /* T_Record (7), record block */
  61.      sizeof(struct b_list),   /* T_List (8), list header block */
  62.      0,                       /* T_Lelem (9), list element block */
  63.      sizeof(struct b_set),    /* T_Set (10), set header block */
  64.      sizeof(struct b_selem),  /* T_Selem (11), set element block */
  65.      sizeof(struct b_table),  /* T_Table (12), table header block */
  66.      sizeof(struct b_telem),  /* T_Telem (13), table element block */
  67.      sizeof(struct b_tvtbl),  /* T_Tvtbl (14), table element trapped variable */
  68.      0,                       /* T_Slots (15), set/table hash block */
  69.      sizeof(struct b_tvsubs), /* T_Tvsubs (16), substring trapped variable */
  70.      0,                       /* T_Refresh (17), refresh block */
  71.     -1,                       /* T_Coexpr (18), co-expression block */
  72.      0,                       /* T_External (19) external block */
  73.      -1,                      /* T_Kywdint (20), integer keyword variable */
  74.      -1,                      /* T_Kywdpos (21), keyword &pos */
  75.      -1,                      /* T_Kywdsubj (22), keyword &subject */
  76.      -1,                      /* T_Kywdwin (23), keyword &window */
  77.      -1,                      /* T_Kywdstr (24), string keyword variable */
  78.      -1,                      /* T_Kywdevent (25), event keyword variable */
  79.     };
  80.  
  81. /*
  82.  * Table of offsets (in bytes) to first descriptor in blocks.  -1 is for
  83.  *  types not allocated, 0 for blocks with no descriptors.
  84.  */
  85. int firstd[] = {
  86.     -1,                       /* T_Null (0), not block */
  87.     -1,                       /* T_Integer (1), not block */
  88.      0,                       /* T_Lrgint (2), large integer */
  89.      0,                       /* T_Real (3), real number */
  90.      0,                       /* T_Cset (4), cset */
  91.      3*WordSize,              /* T_File (5), file block */
  92.  
  93. #ifdef MultiThread
  94.      8*WordSize,              /* T_Proc (6), procedure block */
  95. #else                /* MultiThread */
  96.      7*WordSize,              /* T_Proc (6), procedure block */
  97. #endif                /* MultiThread */
  98.  
  99.      4*WordSize,              /* T_Record (7), record block */
  100.      0,                       /* T_List (8), list header block */
  101.      7*WordSize,              /* T_Lelem (9), list element block */
  102.      0,                       /* T_Set (10), set header block */
  103.      3*WordSize,              /* T_Selem (11), set element block */
  104.      (4+HSegs)*WordSize,      /* T_Table (12), table header block */
  105.      3*WordSize,              /* T_Telem (13), table element block */
  106.      3*WordSize,              /* T_Tvtbl (14), table element trapped variable */
  107.      0,                       /* T_Slots (15), set/table hash block */
  108.      3*WordSize,              /* T_Tvsubs (16), substring trapped variable */
  109.  
  110. #if COMPILER
  111.      2*WordSize,              /* T_Refresh (17), refresh block */
  112. #else                /* COMPILER */
  113.      (4+Wsizeof(struct pf_marker))*WordSize, /* T_Refresh (17), refresh block */
  114. #endif                /* COMPILER */
  115.  
  116.     -1,                       /* T_Coexpr (18), co-expression block */
  117.      0,                       /* T_External (19), external block */
  118.      -1,                      /* T_Kywdint (20), integer keyword variable */
  119.      -1,                      /* T_Kywdpos (21), keyword &pos */
  120.      -1,                      /* T_Kywdsubj (22), keyword &subject */
  121.      -1,                      /* T_Kywdwin (23), keyword &window */
  122.      -1,                      /* T_Kywdstr (24), string keyword variable */
  123.      -1,                      /* T_Kywdevent (25), event keyword variable */
  124.     };
  125.  
  126. /*
  127.  * Table of offsets (in bytes) to first pointer in blocks.  -1 is for
  128.  *  types not allocated, 0 for blocks with no pointers.
  129.  */
  130. int firstp[] = {
  131.     -1,                       /* T_Null (0), not block */
  132.     -1,                       /* T_Integer (1), not block */
  133.      0,                       /* T_Lrgint (2), large integer */
  134.      0,                       /* T_Real (3), real number */
  135.      0,                       /* T_Cset (4), cset */
  136.      0,                       /* T_File (5), file block */
  137.      0,                       /* T_Proc (6), procedure block */
  138.      3*WordSize,              /* T_Record (7), record block */
  139.      3*WordSize,              /* T_List (8), list header block */
  140.      2*WordSize,              /* T_Lelem (9), list element block */
  141.      4*WordSize,              /* T_Set (10), set header block */
  142.      1*WordSize,              /* T_Selem (11), set element block */
  143.      4*WordSize,              /* T_Table (12), table header block */
  144.      1*WordSize,              /* T_Telem (13), table element block */
  145.      1*WordSize,              /* T_Tvtbl (14), table element trapped variable */
  146.      2*WordSize,              /* T_Slots (15), set/table hash block */
  147.      0,                       /* T_Tvsubs (16), substring trapped variable */
  148.      0,                       /* T_Refresh (17), refresh block */
  149.     -1,                       /* T_Coexpr (18), co-expression block */
  150.      0,                       /* T_External (19), external block */
  151.      -1,                      /* T_Kywdint (20), integer keyword variable */
  152.      -1,                      /* T_Kywdpos (21), keyword &pos */
  153.      -1,                      /* T_Kywdsubj (22), keyword &subject */
  154.      -1,                      /* T_Kywdwin (23), keyword &window */
  155.      -1,                      /* T_Kywdstr (24), string keyword variable */
  156.      -1,                      /* T_Kywdevent (25), event keyword variable */
  157.     };
  158.  
  159. /*
  160.  * Table of number of pointers in blocks.  -1 is for types not allocated and
  161.  *  types without pointers, 0 for pointers through the end of the block.
  162.  */
  163. int ptrno[] = {
  164.     -1,                       /* T_Null (0), not block */
  165.     -1,                       /* T_Integer (1), not block */
  166.     -1,                       /* T_Lrgint (2), large integer */
  167.     -1,                       /* T_Real (3), real number */
  168.     -1,                       /* T_Cset (4), cset */
  169.     -1,                       /* T_File (5), file block */
  170.     -1,                       /* T_Proc (6), procedure block */
  171.      1,                       /* T_Record (7), record block */
  172.      2,                       /* T_List (8), list header block */
  173.      2,                       /* T_Lelem (9), list element block */
  174.      HSegs,                   /* T_Set (10), set header block */
  175.      1,                       /* T_Selem (11), set element block */
  176.      HSegs,                   /* T_Table (12), table header block */
  177.      1,                       /* T_Telem (13), table element block */
  178.      1,                       /* T_Tvtbl (14), table element trapped variable */
  179.      0,                       /* T_Slots (15), set/table hash block */
  180.     -1,                       /* T_Tvsubs (16), substring trapped variable */
  181.     -1,                       /* T_Refresh (17), refresh block */
  182.     -1,                       /* T_Coexpr (18), co-expression block */
  183.     -1,                       /* T_External (19), external block */
  184.     -1,                       /* T_Kywdint (20), integer keyword variable */
  185.     -1,                       /* T_Kywdpos (21), keyword &pos */
  186.     -1,                       /* T_Kywdsubj (22), keyword &subject */
  187.     -1,                       /* T_Kywdwin (23), keyword &window */
  188.     -1,                       /* T_Kywdstr (24), string keyword variable */
  189.     -1,                       /* T_Kywdevent (25), event keyword variable */
  190.     };
  191.  
  192. /*
  193.  * Table of block names used by debugging functions.
  194.  */
  195. char *blkname[] = {
  196.    "illegal object",                    /* T_Null (0), not block */
  197.    "illegal object",                    /* T_Integer (1), not block */
  198.    "large integer",                     /* T_Largint (2) */
  199.    "real number",                       /* T_Real (3) */
  200.    "cset",                              /* T_Cset (4) */
  201.    "file",                              /* T_File (5) */
  202.    "procedure",                         /* T_Proc (6) */
  203.    "record",                            /* T_Record (7) */
  204.    "list",                              /* T_List (8) */
  205.    "list element",                      /* T_Lelem (9) */
  206.    "set",                               /* T_Set (10) */
  207.    "set element",                       /* T_Selem (11) */
  208.    "table",                             /* T_Table (12) */
  209.    "table element",                     /* T_Telem (13) */
  210.    "table element trapped variable",    /* T_Tvtbl (14) */
  211.    "hash block",                        /* T_Slots (15) */
  212.    "substring trapped variable",        /* T_Tvsubs (16) */
  213.    "refresh block",                     /* T_Refresh (17) */
  214.    "co-expression",                     /* T_Coexpr (18) */
  215.    "external block",                    /* T_External (19) */
  216.    "integer keyword variable",          /* T_Kywdint (20) */
  217.    "&pos",                              /* T_Kywdpos (21) */
  218.    "&subject",                          /* T_Kywdsubj (22) */
  219.    "illegal object",                    /* T_Kywdwin (23) */
  220.    "illegal object",                    /* T_Kywdstr (24) */
  221.    "illegal object",                    /* T_Kywdevent (25) */
  222.    };
  223.  
  224. /*
  225.  * Sizes of hash chain segments.
  226.  *  Table size must equal or exceed HSegs.
  227.  */
  228. uword segsize[] = {
  229.    ((uword)HSlots),            /* segment 0 */
  230.    ((uword)HSlots),            /* segment 1 */
  231.    ((uword)HSlots) << 1,        /* segment 2 */
  232.    ((uword)HSlots) << 2,        /* segment 3 */
  233.    ((uword)HSlots) << 3,        /* segment 4 */
  234.    ((uword)HSlots) << 4,        /* segment 5 */
  235.    ((uword)HSlots) << 5,        /* segment 6 */
  236.    ((uword)HSlots) << 6,        /* segment 7 */
  237.    ((uword)HSlots) << 7,        /* segment 8 */
  238.    ((uword)HSlots) << 8,        /* segment 9 */
  239.    ((uword)HSlots) << 9,        /* segment 10 */
  240.    ((uword)HSlots) << 10,        /* segment 11 */
  241.    ((uword)HSlots) << 11,        /* segment 12 */
  242.    ((uword)HSlots) << 12,        /* segment 13 */
  243.    ((uword)HSlots) << 13,        /* segment 14 */
  244.    ((uword)HSlots) << 14,        /* segment 15 */
  245.    ((uword)HSlots) << 15,        /* segment 16 */
  246.    ((uword)HSlots) << 16,        /* segment 17 */
  247.    ((uword)HSlots) << 17,        /* segment 18 */
  248.    ((uword)HSlots) << 18,        /* segment 19 */
  249.    };
  250.  
  251. /*
  252.  * initalloc - initialization routine to allocate memory regions
  253.  */
  254.  
  255. #if COMPILER
  256. void initalloc()
  257.    {
  258.  
  259. #else                    /* COMPILER */
  260. #ifdef MultiThread
  261. void initalloc(codesize,p)
  262. struct progstate *p;
  263. #else                    /* MultiThread */
  264. void initalloc(codesize)
  265. #endif                    /* MultiThread */
  266. word codesize;
  267.    {
  268. #ifdef MultiThread
  269.    struct region *ps, *pb;
  270. #endif
  271.  
  272.    if ((uword)codesize > (unsigned)MaxBlock)
  273.       error(NULL, "icode file too large");
  274.    /*
  275.     * Allocate icode region
  276.     */
  277. #ifdef MultiThread
  278.    if (codesize)
  279. #endif                    /* MultiThread */
  280.    if ((code = (char *)AllocReg(codesize)) == NULL)
  281.       error(NULL,
  282.      "insufficient memory, corrupted icode file, or wrong platform");
  283. #endif                    /* COMPILER */
  284.  
  285.    /*
  286.     * Set up allocated memory.    The regions are:
  287.     *    Static memory region (not used)
  288.     *    Allocated string region
  289.     *    Allocate block region
  290.     *    Qualifier list
  291.     */
  292.  
  293. #ifdef MultiThread
  294.    ps = p->stringregion;
  295.    ps->free = ps->base = (char *)AllocReg(ps->size);
  296.    if (ps->free == NULL)
  297.       error(NULL, "insufficient memory for string region");
  298.    ps->end = ps->base + ps->size;
  299.  
  300.    pb = p->blockregion;
  301.    pb->free = pb->base = (char *)AllocReg(pb->size);
  302.    if (pb->free == NULL)
  303.       error(NULL, "insufficient memory for block region");
  304.    pb->end = pb->base + pb->size;
  305.  
  306.    if (p == &rootpstate) {
  307.       if ((quallist = (dptr *)malloc(qualsize)) == NULL)
  308.          error(NULL, "insufficient memory for qualifier list");
  309.       equallist = (dptr *)((char *)quallist + qualsize);
  310.       }
  311. #else                    /* MultiThread */
  312.    {
  313.    uword t1, t2;
  314.    t1 = ssize;
  315.    t2 = abrsize;
  316.    curstring = (struct region *)malloc(sizeof(struct region));
  317.    curblock = (struct region *)malloc(sizeof(struct region));
  318.    curstring->size = t1;
  319.    curblock->size = t2;
  320.    }
  321.    curstring->next = curstring->prev = NULL;
  322.    curstring->Gnext = curstring->Gprev = NULL;
  323.    curblock->next = curblock->prev = NULL;
  324.    curblock->Gnext = curblock->Gprev = NULL;
  325.    if ((strfree = strbase = (char *)AllocReg(ssize)) == NULL)
  326.       error(NULL, "insufficient memory for string region");
  327.    strend = strbase + ssize;
  328.    if ((blkfree = blkbase = (char *)AllocReg(abrsize)) == NULL)
  329.       error(NULL, "insufficient memory for block region");
  330.    blkend = blkbase + abrsize;
  331.    if ((quallist = (dptr *)malloc(qualsize)) == NULL)
  332.       error(NULL, "insufficient memory for qualifier list");
  333.    equallist = (dptr *)((char *)quallist + qualsize);
  334. #endif                    /* MultiThread */
  335.    }
  336.  
  337. /*
  338.  * collect - do a garbage collection of currently active regions.
  339.  */
  340.  
  341. int collect(region)
  342. int region;
  343.    {
  344.    struct b_coexpr *cp;
  345.  
  346. #ifdef EventMon
  347.    if (!noMTevents)
  348.       EVVal((word)region,E_Collect);
  349. #endif                    /* EventMon */
  350.  
  351.    switch (region) {
  352.       case Static:
  353.          coll_stat++;
  354.          break;
  355.       case Strings:
  356.          coll_str++;
  357.          break;
  358.       case Blocks:
  359.          coll_blk++;
  360.          break;
  361.       }
  362.    coll_tot++;
  363.  
  364.    alcnum = 0;
  365.  
  366.    /*
  367.     * Garbage collection cannot be done until initialization is complete.
  368.     */
  369.  
  370. #if !COMPILER
  371.    if (sp == NULL)
  372.       return 0;
  373. #endif                    /* !COMPILER */
  374.  
  375. #if MACINTOSH
  376. #if MPW
  377.    {
  378.       void SetWatchCursor(void);
  379.       SetWatchCursor();
  380.       }
  381. #endif                    /* MPW */
  382. #endif                    /* MACINTOSH */
  383.  
  384.    /*
  385.     * Sync the values (used by sweep) in the coexpr block for ¤t
  386.     *  with the current values.
  387.     */
  388.    cp = (struct b_coexpr *)BlkLoc(k_current);
  389.    cp->es_tend = tend;
  390.  
  391. #if !COMPILER
  392.    cp->es_pfp = pfp;
  393.    cp->es_gfp = gfp;
  394.    cp->es_efp = efp;
  395.    cp->es_sp = sp;
  396. #endif                    /* !COMPILER */
  397.  
  398.    /*
  399.     * Reset qualifier list.
  400.     */
  401.    qualfree = quallist;
  402.    qualfail = 0;
  403.  
  404.    /*
  405.     * Mark the stacks for &main and the current co-expression.
  406.     */
  407. #ifdef MultiThread
  408.    markprogram(&rootpstate);
  409. #endif                    /* MultiThread */
  410.    markblock(&k_main);
  411.    markblock(&k_current);
  412.    /*
  413.     * Mark &subject and the cached s2 and s3 strings for map.
  414.     */
  415. #ifndef MultiThread
  416.    postqual(&k_subject);
  417.    postqual(&kywd_prog);
  418. #endif                    /* MultiThread */
  419.    if (Qual(maps2))                     /*  caution: the cached arguments of */
  420.       postqual(&maps2);                 /*  map may not be strings. */
  421.    else if (Pointer(maps2))
  422.       markblock(&maps2);
  423.    if (Qual(maps3))
  424.       postqual(&maps3);
  425.    else if (Pointer(maps3))
  426.       markblock(&maps3);
  427.  
  428. #ifdef Graphics
  429.    /*
  430.     * Mark file and list values for windows
  431.     */
  432.    {
  433.      wsp ws;
  434.  
  435.      for (ws = wstates; ws ; ws = ws->next) {
  436.         if (is:file(ws->filep))
  437.           markblock(&(ws->filep));
  438.         if (is:list(ws->listp))
  439.           markblock(&(ws->listp));
  440.         }
  441.    }
  442. #endif                    /* Graphics */
  443.  
  444.    /*
  445.     * Mark the globals and the statics.
  446.     */
  447.  
  448. #ifndef MultiThread
  449.    { register struct descrip *dp;
  450.    for (dp = globals; dp < eglobals; dp++)
  451.       if (Qual(*dp))
  452.      postqual(dp);
  453.       else if (Pointer(*dp))
  454.      markblock(dp);
  455.  
  456.    for (dp = statics; dp < estatics; dp++)
  457.       if (Qual(*dp))
  458.      postqual(dp);
  459.       else if (Pointer(*dp))
  460.      markblock(dp);
  461.    }
  462.  
  463. #ifdef Graphics
  464.    if (is:file(kywd_xwin[XKey_Window]))
  465.       markblock(&(kywd_xwin[XKey_Window]));
  466.    if (is:file(lastEventWin))
  467.       markblock(&(lastEventWin));
  468. #endif                    /* Graphics */
  469. #endif                    /* MultiThread */
  470.  
  471.    reclaim();
  472.  
  473.    /*
  474.     * Turn off all the marks in all the block regions everywhere
  475.     */
  476.    { struct region *br;
  477.    for (br = curblock->Gnext; br; br = br->Gnext) {
  478.       char *source = br->base, *free = br->free;
  479.       uword NoMark = (uword) ~F_Mark;
  480.       while (source < free) {
  481.      BlkType(source) &= NoMark;
  482.          source += BlkSize(source);
  483.          }
  484.       }
  485.    for (br = curblock->Gprev; br; br = br->Gprev) {
  486.       char *source = br->base, *free = br->free;
  487.       uword NoMark = (uword) ~F_Mark;
  488.       while (source < free) {
  489.      BlkType(source) &= NoMark;
  490.          source += BlkSize(source);
  491.          }
  492.       }
  493.    }
  494.  
  495. #ifdef EventMon
  496.    if (!noMTevents) {
  497.       mmrefresh();
  498.       EVValD(&nulldesc, E_EndCollect);
  499.       }
  500. #endif                    /* EventMon */
  501.  
  502.    return 1;
  503.    }
  504.  
  505. /*
  506.  * markprogram - traverse pointers out of a program state structure
  507.  */
  508.  
  509. #ifdef MultiThread
  510. #define PostDescrip(d) \
  511.    if (Qual(d)) \
  512.       postqual(&(d)); \
  513.    else if (Pointer(d))\
  514.       markblock(&(d));
  515.  
  516. static void markprogram(pstate)
  517. struct progstate *pstate;
  518.    {
  519.    struct descrip *dp;
  520.  
  521.    PostDescrip(pstate->parentdesc);
  522.    PostDescrip(pstate->eventmask);
  523.    PostDescrip(pstate->opcodemask);
  524.    PostDescrip(pstate->eventcode);
  525.    PostDescrip(pstate->eventval);
  526.    PostDescrip(pstate->eventsource);
  527.  
  528.    /* Kywd_err, &error, always an integer */
  529.    /* Kywd_pos, &pos, always an integer */
  530.    postqual(&(pstate->ksub));
  531.    postqual(&(pstate->Kywd_prog));
  532.    /* Kywd_ran, &random, always an integer */
  533.    /* Kywd_trc, &trace, always an integer */
  534.  
  535.    /*
  536.     * Mark the globals and the statics.
  537.     */
  538.    for (dp = pstate->Globals; dp < pstate->Eglobals; dp++)
  539.       if (Qual(*dp))
  540.      postqual(dp);
  541.       else if (Pointer(*dp))
  542.      markblock(dp);
  543.  
  544.    for (dp = pstate->Statics; dp < pstate->Estatics; dp++)
  545.       if (Qual(*dp))
  546.      postqual(dp);
  547.       else if (Pointer(*dp))
  548.      markblock(dp);
  549.  
  550.    /*
  551.     * no marking for &x, &y, &row, &col, &interval, all integers
  552.     */
  553. #ifdef Graphics
  554.    PostDescrip(pstate->LastEventWin);    /* last Event() win */
  555.    PostDescrip(pstate->Kywd_xwin[XKey_Window]);    /* &window */
  556. #endif                    /* Graphics */
  557.  
  558.    PostDescrip(pstate->K_errorvalue);
  559.    PostDescrip(pstate->T_errorvalue);
  560.    }
  561. #endif                    /* MultiThread */
  562.  
  563. /*
  564.  * postqual - mark a string qualifier.  Strings outside the string space
  565.  *  are ignored.
  566.  */
  567.  
  568. static void postqual(dp)
  569. dptr dp;
  570.    {
  571.    char *newqual;
  572.  
  573.    if (InRange(strbase,StrLoc(*dp),strfree + 1)) {
  574.       /*
  575.        * The string is in the string space.  Add it to the string qualifier
  576.        *  list, but before adding it, expand the string qualifier list if
  577.        *  necessary.
  578.        */
  579.       if (qualfree >= equallist) {
  580.  
  581.      /* reallocate a new qualifier list that's twice as large */
  582.      newqual = realloc(quallist, 2 * qualsize);
  583.      if (newqual) {
  584.         quallist = (dptr *)newqual;
  585.         qualfree = (dptr *)(newqual + qualsize);
  586.         qualsize *= 2;
  587.         equallist = (dptr *)(newqual + qualsize);
  588.         }
  589.      else {
  590.             qualfail = 1;
  591.             return;
  592.         }
  593.  
  594.          }
  595.       *qualfree++ = dp;
  596.       }
  597.    }
  598.  
  599. /*
  600.  * markblock - mark each accessible block in the block region and build
  601.  *  back-list of descriptors pointing to that block. (Phase I of garbage
  602.  *  collection.)
  603.  */
  604. static void markblock(dp)
  605. dptr dp;
  606.    {
  607.    register dptr dp1;
  608.    register char *block, *endblock;
  609.    word type, fdesc;
  610.    int numptr;
  611.    register union block **ptr, **lastptr;
  612.  
  613.    if (Var(*dp)) {
  614.        if (dp->dword & F_Typecode) {
  615.           switch (Type(*dp)) {
  616.              case T_Kywdint:
  617.              case T_Kywdpos:
  618.              case T_Kywdsubj:
  619.                 /*
  620.                  * The descriptor points to a keyword, not a block.
  621.                  */
  622.                 return;
  623.              }
  624.           }
  625.        else if (Offset(*dp) == 0) {
  626.           /*
  627.            * The descriptor is a simple variable not residing in a block.
  628.            */
  629.           return;
  630.           }
  631.       }
  632.  
  633.    /*
  634.     * Get the block to which dp points.
  635.     */
  636.    block = (char *)BlkLoc(*dp);
  637.  
  638.    if (InRange(blkbase,block,blkfree)) {
  639.       type = BlkType(block);
  640.       if ((uword)type <= MaxType) {
  641.  
  642.          /*
  643.           * The type is valid, which indicates that this block has not
  644.           *  been marked.  Point endblock to the byte past the end
  645.           *  of the block.
  646.           */
  647.          endblock = block + BlkSize(block);
  648.          }
  649.  
  650.       /*
  651.        * Add dp to the back chain for the block and point the
  652.        *  block (via the type field) to dp.vword.
  653.        */
  654.       BlkLoc(*dp) = (union block *)type;
  655.       BlkType(block) = (uword)&BlkLoc(*dp);
  656.  
  657.       if ((uword)type <= MaxType) {
  658.          /*
  659.           * The block was not marked; process pointers and descriptors
  660.           *  within the block.
  661.           */
  662.          if ((fdesc = firstp[type]) > 0) {
  663.             /*
  664.              * The block contains pointers; mark each pointer.
  665.              */
  666.             ptr = (union block **)(block + fdesc);
  667.         numptr = ptrno[type];
  668.         if (numptr > 0)
  669.            lastptr = ptr + numptr;
  670.         else
  671.            lastptr = (union block **)endblock;
  672.         for (; ptr < lastptr; ptr++)
  673.            if (*ptr != NULL)
  674.                   markptr(ptr);
  675.         }
  676.          if ((fdesc = firstd[type]) > 0)
  677.             /*
  678.              * The block contains descriptors; mark each descriptor.
  679.              */
  680.             for (dp1 = (dptr)(block + fdesc);
  681.                  (char *)dp1 < endblock; dp1++) {
  682.                if (Qual(*dp1))
  683.                   postqual(dp1);
  684.                else if (Pointer(*dp1))
  685.                   markblock(dp1);
  686.                }
  687.          }
  688.       }
  689.  
  690.    else if ((unsigned int)BlkType(block) == T_Coexpr) {
  691.       struct b_coexpr *cp;
  692.       struct astkblk *abp;
  693.       int i;
  694.       struct descrip adesc;
  695.  
  696.       /*
  697.        * dp points to a co-expression block that has not been
  698.        *  marked.  Point the block to dp.  Sweep the interpreter
  699.        *  stack in the block.  Then mark the block for the
  700.        *  activating co-expression and the refresh block.
  701.        */
  702.       BlkType(block) = (uword)dp;
  703.       sweep((struct b_coexpr *)block);
  704.  
  705. #ifdef MultiThread
  706.       if (((struct b_coexpr *)block)+1 ==
  707.          (struct b_coexpr *)((struct b_coexpr *)block)->program){
  708.          /*
  709.           * This coexpr is an &main; traverse its roots
  710.           */
  711.          markprogram(((struct b_coexpr *)block)->program);
  712.          }
  713. #endif                    /* MultiThread */
  714.  
  715. #ifdef Coexpr
  716.       /*
  717.        * Mark the activators of this co-expression.   The activators are
  718.        *  stored as a list of addresses, but markblock requires the address
  719.        *  of a descriptor.  To accommodate markblock, the dummy descriptor
  720.        *  adesc is filled in with each activator address in turn and then
  721.        *  marked.  Since co-expressions and the descriptors that reference
  722.        *  them don't participate in the back-chaining scheme, it's ok to
  723.        *  reuse the descriptor in this manner.
  724.        */
  725.       cp = (struct b_coexpr *)block;
  726.       adesc.dword = D_Coexpr;
  727.       for (abp = cp->es_actstk; abp != NULL; abp = abp->astk_nxt) {
  728.          for (i = 1; i <= abp->nactivators; i++) {
  729.             BlkLoc(adesc) = (union block *)abp->arec[i-1].activator;
  730.             markblock(&adesc);
  731.             }
  732.          }
  733.       if(BlkLoc(cp->freshblk) != NULL)
  734.          markblock(&((struct b_coexpr *)block)->freshblk);
  735. #endif                                  /* Coexpr */
  736.       }
  737.  
  738.    else {
  739.       struct region *rp;
  740.  
  741.       /*
  742.        * Look for this block in other allocated block regions.
  743.        */
  744.       for (rp = curblock->Gnext; rp; rp = rp->Gnext)
  745.      if (InRange(rp->base,block,rp->free)) break;
  746.  
  747.       if (rp == NULL)
  748.          for (rp = curblock->Gprev; rp; rp = rp->Gprev)
  749.             if (InRange(rp->base,block,rp->free)) break;
  750.  
  751.       /*
  752.        * If this block is not in a block region, its something else
  753.        *  like a procedure block.
  754.        */
  755.       if (rp == NULL)
  756.          return;
  757.  
  758.       /*
  759.        * Get this block's type field; return if it is marked
  760.        */
  761.       type = BlkType(block);
  762.       if ((uword)type > MaxType)
  763.          return;
  764.  
  765.       /*
  766.        * this is an unmarked block outside the (collecting) block region;
  767.        * process pointers and descriptors within the block.
  768.        *
  769.        * The type is valid, which indicates that this block has not
  770.        *  been marked.  Point endblock to the byte past the end
  771.        *  of the block.
  772.        */
  773.       endblock = block + BlkSize(block);
  774.  
  775.       BlkType(block) |= F_Mark;            /* mark the block */
  776.  
  777.       if ((fdesc = firstp[type]) > 0) {
  778.          /*
  779.           * The block contains pointers; mark each pointer.
  780.           */
  781.          ptr = (union block **)(block + fdesc);
  782.      numptr = ptrno[type];
  783.      if (numptr > 0)
  784.         lastptr = ptr + numptr;
  785.      else
  786.         lastptr = (union block **)endblock;
  787.      for (; ptr < lastptr; ptr++)
  788.         if (*ptr != NULL)
  789.                markptr(ptr);
  790.      }
  791.       if ((fdesc = firstd[type]) > 0)
  792.          /*
  793.           * The block contains descriptors; mark each descriptor.
  794.           */
  795.          for (dp1 = (dptr)(block + fdesc);
  796.               (char *)dp1 < endblock; dp1++) {
  797.             if (Qual(*dp1))
  798.                postqual(dp1);
  799.             else if (Pointer(*dp1))
  800.                markblock(dp1);
  801.             }
  802.       }
  803.    }
  804.  
  805. /*
  806.  * markptr - just like mark block except the object pointing at the block
  807.  *  is just a block pointer, not a descriptor.
  808.  */
  809.  
  810. static void markptr(ptr)
  811. union block **ptr;
  812.    {
  813.    register dptr dp;
  814.    register char *block, *endblock;
  815.    word type, fdesc;
  816.    int numptr;
  817.    register union block **ptr1, **lastptr;
  818.  
  819.    /*
  820.     * Get the block to which ptr points.
  821.     */
  822.    block = (char *)*ptr;
  823.    if (InRange(blkbase,block,blkfree)) {
  824.       type = BlkType(block);
  825.       if ((uword)type <= MaxType) {
  826.          /*
  827.           * The type is valid, which indicates that this block has not
  828.           *  been marked.  Point endblock to the byte past the end
  829.           *  of the block.
  830.           */
  831.          endblock = block + BlkSize(block);
  832.          }
  833.  
  834.       /*
  835.        * Add ptr to the back chain for the block and point the
  836.        *  block (via the type field) to ptr.
  837.        */
  838.       *ptr = (union block *)type;
  839.       BlkType(block) = (uword)ptr;
  840.  
  841.       if ((uword)type <= MaxType) {
  842.          /*
  843.           * The block was not marked; process pointers and descriptors
  844.           *  within the block.
  845.           */
  846.          if ((fdesc = firstp[type]) > 0) {
  847.             /*
  848.              * The block contains pointers; mark each pointer.
  849.              */
  850.             ptr1 = (union block **)(block + fdesc);
  851.             numptr = ptrno[type];
  852.             if (numptr > 0)
  853.                lastptr = ptr1 + numptr;
  854.             else
  855.                lastptr = (union block **)endblock;
  856.             for (; ptr1 < lastptr; ptr1++)
  857.                if (*ptr1 != NULL)
  858.                   markptr(ptr1);
  859.             }
  860.          if ((fdesc = firstd[type]) > 0)
  861.             /*
  862.              * The block contains descriptors; mark each descriptor.
  863.              */
  864.             for (dp = (dptr)(block + fdesc);
  865.                  (char *)dp < endblock; dp++) {
  866.                if (Qual(*dp))
  867.                   postqual(dp);
  868.                else if (Pointer(*dp))
  869.                   markblock(dp);
  870.                }
  871.          }
  872.       }
  873.  
  874.    else {
  875.       struct region *rp;
  876.  
  877.       /*
  878.        * Look for this block in other allocated block regions.
  879.        */
  880.       for (rp = curblock->Gnext;rp;rp = rp->Gnext)
  881.      if (InRange(rp->base,block,rp->free)) break;
  882.  
  883.       if (rp == NULL)
  884.          for (rp = curblock->Gprev;rp;rp = rp->Gprev)
  885.             if (InRange(rp->base,block,rp->free)) break;
  886.  
  887.       /*
  888.        * If this block is not in a block region, its something else
  889.        *  like a procedure block.
  890.        */
  891.       if (rp == NULL)
  892.          return;
  893.  
  894.       /*
  895.        * Get this block's type field; return if it is marked
  896.        */
  897.       type = BlkType(block);
  898.       if ((uword)type > MaxType)
  899.          return;
  900.  
  901.       /*
  902.        * this is an unmarked block outside the (collecting) block region;
  903.        * process pointers and descriptors within the block.
  904.        *
  905.        * The type is valid, which indicates that this block has not
  906.        *  been marked.  Point endblock to the byte past the end
  907.        *  of the block.
  908.        */
  909.       endblock = block + BlkSize(block);
  910.  
  911.       BlkType(block) |= F_Mark;            /* mark the block */
  912.  
  913.       if ((fdesc = firstp[type]) > 0) {
  914.          /*
  915.           * The block contains pointers; mark each pointer.
  916.           */
  917.          ptr1 = (union block **)(block + fdesc);
  918.          numptr = ptrno[type];
  919.          if (numptr > 0)
  920.         lastptr = ptr1 + numptr;
  921.      else
  922.         lastptr = (union block **)endblock;
  923.      for (; ptr1 < lastptr; ptr1++)
  924.         if (*ptr1 != NULL)
  925.                markptr(ptr1);
  926.      }
  927.       if ((fdesc = firstd[type]) > 0)
  928.          /*
  929.           * The block contains descriptors; mark each descriptor.
  930.           */
  931.          for (dp = (dptr)(block + fdesc);
  932.               (char *)dp < endblock; dp++) {
  933.             if (Qual(*dp))
  934.                postqual(dp);
  935.             else if (Pointer(*dp))
  936.                markblock(dp);
  937.             }
  938.          }
  939.    }
  940.  
  941. /*
  942.  * sweep - sweep the chain of tended descriptors for a co-expression
  943.  *  marking the descriptors.
  944.  */
  945.  
  946. static void sweep(ce)
  947. struct b_coexpr *ce;
  948.    {
  949.    register struct tend_desc *tp;
  950.    register int i;
  951.  
  952.    for (tp = ce->es_tend; tp != NULL; tp = tp->previous) {
  953.       for (i = 0; i < tp->num; ++i) {
  954.          if (Qual(tp->d[i]))
  955.             postqual(&tp->d[i]);
  956.          else if (Pointer(tp->d[i])) {
  957.             if(BlkLoc(tp->d[i]) != NULL)
  958.                markblock(&tp->d[i]);
  959.         }
  960.          }
  961.       }
  962. #if !COMPILER
  963.    sweep_stk(ce);
  964. #endif                    /* !COMPILER */
  965.    }
  966.  
  967. #if !COMPILER
  968. /*
  969.  * sweep_stk - sweep the stack, marking all descriptors there.  Method
  970.  *  is to start at a known point, specifically, the frame that the
  971.  *  fp points to, and then trace back along the stack looking for
  972.  *  descriptors and local variables, marking them when they are found.
  973.  *  The sp starts at the first frame, and then is moved down through
  974.  *  the stack.  Procedure, generator, and expression frames are
  975.  *  recognized when the sp is a certain distance from the fp, gfp,
  976.  *  and efp respectively.
  977.  *
  978.  * Sweeping problems can be manifested in a variety of ways due to
  979.  *  the "if it can't be identified it's a descriptor" methodology.
  980.  */
  981.  
  982. static void sweep_stk(ce)
  983. struct b_coexpr *ce;
  984.    {
  985.    register word *s_sp;
  986.    register struct pf_marker *fp;
  987.    register struct gf_marker *s_gfp;
  988.    register struct ef_marker *s_efp;
  989.    word nargs, type = 0, gsize = 0;
  990.  
  991.    fp = ce->es_pfp;
  992.    s_gfp = ce->es_gfp;
  993.    if (s_gfp != 0) {
  994.       type = s_gfp->gf_gentype;
  995.       if (type == G_Psusp)
  996.          gsize = Wsizeof(*s_gfp);
  997.       else
  998.          gsize = Wsizeof(struct gf_smallmarker);
  999.       }
  1000.    s_efp = ce->es_efp;
  1001.    s_sp =  ce->es_sp;
  1002.    nargs = 0;                           /* Nargs counter is 0 initially. */
  1003.  
  1004. #ifdef MultiThread
  1005.    if (fp == 0) {
  1006.       if (is:list(* (dptr) (s_sp - 1))) {
  1007.      /*
  1008.       * this is the argument list of an un-started task
  1009.       */
  1010.          if (Pointer(*((dptr)(&s_sp[-1])))) {
  1011.             markblock((dptr)&s_sp[-1]);
  1012.         }
  1013.      }
  1014.       }
  1015. #endif                    /* MultiThread */
  1016.  
  1017.    while ((fp != 0 || nargs)) {         /* Keep going until current fp is
  1018.                                             0 and no arguments are left. */
  1019.       if (s_sp == (word *)fp + Vwsizeof(*pfp) - 1) {
  1020.                                         /* sp has reached the upper
  1021.                                             boundary of a procedure frame,
  1022.                                             process the frame. */
  1023.          s_efp = fp->pf_efp;            /* Get saved efp out of frame */
  1024.          s_gfp = fp->pf_gfp;            /* Get save gfp */
  1025.          if (s_gfp != 0) {
  1026.             type = s_gfp->gf_gentype;
  1027.             if (type == G_Psusp)
  1028.                gsize = Wsizeof(*s_gfp);
  1029.             else
  1030.                gsize = Wsizeof(struct gf_smallmarker);
  1031.             }
  1032.          s_sp = (word *)fp - 1;         /* First argument descriptor is
  1033.                                             first word above proc frame */
  1034.          nargs = fp->pf_nargs;
  1035.          fp = fp->pf_pfp;
  1036.          }
  1037.       else if (s_gfp != NULL && s_sp == (word *)s_gfp + gsize - 1) {
  1038.                                         /* The sp has reached the lower end
  1039.                                             of a generator frame, process
  1040.                                             the frame.*/
  1041.          if (type == G_Psusp)
  1042.             fp = s_gfp->gf_pfp;
  1043.          s_sp = (word *)s_gfp - 1;
  1044.          s_efp = s_gfp->gf_efp;
  1045.          s_gfp = s_gfp->gf_gfp;
  1046.          if (s_gfp != 0) {
  1047.             type = s_gfp->gf_gentype;
  1048.             if (type == G_Psusp)
  1049.                gsize = Wsizeof(*s_gfp);
  1050.             else
  1051.                gsize = Wsizeof(struct gf_smallmarker);
  1052.             }
  1053.          nargs = 1;
  1054.          }
  1055.       else if (s_sp == (word *)s_efp + Wsizeof(*s_efp) - 1) {
  1056.                                             /* The sp has reached the upper
  1057.                                                 end of an expression frame,
  1058.                                                 process the frame. */
  1059.          s_gfp = s_efp->ef_gfp;         /* Restore gfp, */
  1060.          if (s_gfp != 0) {
  1061.             type = s_gfp->gf_gentype;
  1062.             if (type == G_Psusp)
  1063.                gsize = Wsizeof(*s_gfp);
  1064.             else
  1065.                gsize = Wsizeof(struct gf_smallmarker);
  1066.             }
  1067.          s_efp = s_efp->ef_efp;         /*  and efp from frame. */
  1068.          s_sp -= Wsizeof(*s_efp);       /* Move past expression frame marker. */
  1069.          }
  1070.       else {                            /* Assume the sp is pointing at a
  1071.                                             descriptor. */
  1072.          if (Qual(*((dptr)(&s_sp[-1]))))
  1073.             postqual((dptr)&s_sp[-1]);
  1074.          else if (Pointer(*((dptr)(&s_sp[-1])))) {
  1075.             markblock((dptr)&s_sp[-1]);
  1076.         }
  1077.          s_sp -= 2;                     /* Move past descriptor. */
  1078.          if (nargs)                     /* Decrement argument count if in an*/
  1079.             nargs--;                    /*  argument list. */
  1080.          }
  1081.       }
  1082.    }
  1083. #endif                    /* !COMPILER */
  1084.  
  1085. /*
  1086.  * reclaim - reclaim space in the allocated memory regions. The marking
  1087.  *   phase has already been completed.
  1088.  */
  1089.  
  1090. static void reclaim()
  1091.    {
  1092.    /*
  1093.     * Collect available co-expression blocks.
  1094.     */
  1095.    cofree();
  1096.  
  1097.    /*
  1098.     * Collect the string space leaving it where it is.
  1099.     */
  1100.    if (!qualfail)
  1101.       scollect((word)0);
  1102.  
  1103.    /*
  1104.     * Adjust the blocks in the block region in place.
  1105.     */
  1106.    adjust(blkbase,blkbase);
  1107.  
  1108.    /*
  1109.     * Compact the block region.
  1110.     */
  1111.    compact(blkbase);
  1112.    }
  1113.  
  1114. /*
  1115.  * cofree - collect co-expression blocks.  This is done after
  1116.  *  the marking phase of garbage collection and the stacks that are
  1117.  *  reachable have pointers to data blocks, rather than T_Coexpr,
  1118.  *  in their type field.
  1119.  */
  1120.  
  1121. static void cofree()
  1122.    {
  1123.    register struct b_coexpr **ep, *xep;
  1124.    register struct astkblk *abp, *xabp;
  1125.  
  1126.    /*
  1127.     * Reset the type for &main.
  1128.     */
  1129.  
  1130. #ifdef MultiThread
  1131.    rootpstate.Mainhead->title = T_Coexpr;
  1132. #else                /* MultiThread */
  1133.    BlkLoc(k_main)->coexpr.title = T_Coexpr;
  1134. #endif                /* MultiThread */
  1135.  
  1136.    /*
  1137.     * The co-expression blocks are linked together through their
  1138.     *  nextstk fields, with stklist pointing to the head of the list.
  1139.     *  The list is traversed and each stack that was not marked
  1140.     *  is freed.
  1141.     */
  1142.    ep = &stklist;
  1143.    while (*ep != NULL) {
  1144.       if (BlkType(*ep) == T_Coexpr) {
  1145.          xep = *ep;
  1146.          *ep = (*ep)->nextstk;
  1147.          /*
  1148.           * Free the astkblks.  There should always be one and it seems that
  1149.           *  it's not possible to have more than one, but nonetheless, the
  1150.           *  code provides for more than one.
  1151.           */
  1152.          for (abp = xep->es_actstk; abp; ) {
  1153.             xabp = abp;
  1154.             abp = abp->astk_nxt;
  1155.             free((pointer)xabp);
  1156.             }
  1157.          #ifdef CoClean
  1158.         coclean(xep->cstate);
  1159.          #endif            /* CoClean */
  1160.          free((pointer)xep);
  1161.          }
  1162.       else {
  1163.          BlkType(*ep) = T_Coexpr;
  1164.          ep = &(*ep)->nextstk;
  1165.          }
  1166.       }
  1167.    }
  1168.  
  1169. /*
  1170.  * scollect - collect the string space.  quallist is a list of pointers to
  1171.  *  descriptors for all the reachable strings in the string space.  For
  1172.  *  ease of description, it is referred to as if it were composed of
  1173.  *  descriptors rather than pointers to them.
  1174.  */
  1175.  
  1176. static void scollect(extra)
  1177. word extra;
  1178.    {
  1179.    register char *source, *dest;
  1180.    register dptr *qptr;
  1181.    char *cend;
  1182.  
  1183.    if (qualfree <= quallist) {
  1184.       /*
  1185.        * There are no accessible strings.  Thus, there are none to
  1186.        *  collect and the whole string space is free.
  1187.        */
  1188.       strfree = strbase;
  1189.       return;
  1190.       }
  1191.    /*
  1192.     * Sort the pointers on quallist in ascending order of string
  1193.     *  locations.
  1194.     */
  1195.    qsort((char *)quallist, (int)(DiffPtrs((char *)qualfree,(char *)quallist)) /
  1196.      sizeof(dptr *), sizeof(dptr), (int (*)())qlcmp);
  1197.    /*
  1198.     * The string qualifiers are now ordered by starting location.
  1199.     */
  1200.    dest = strbase;
  1201.    source = cend = StrLoc(**quallist);
  1202.  
  1203.    /*
  1204.     * Loop through qualifiers for accessible strings.
  1205.     */
  1206.    for (qptr = quallist; qptr < qualfree; qptr++) {
  1207.       if (StrLoc(**qptr) > cend) {
  1208.  
  1209.          /*
  1210.           * qptr points to a qualifier for a string in the next clump.
  1211.           *  The last clump is moved, and source and cend are set for
  1212.           *  the next clump.
  1213.           */
  1214.          while (source < cend)
  1215.             *dest++ = *source++;
  1216.          source = cend = StrLoc(**qptr);
  1217.          }
  1218.       if ((StrLoc(**qptr) + StrLen(**qptr)) > cend)
  1219.          /*
  1220.           * qptr is a qualifier for a string in this clump; extend
  1221.           *  the clump.
  1222.           */
  1223.          cend = StrLoc(**qptr) + StrLen(**qptr);
  1224.       /*
  1225.        * Relocate the string qualifier.
  1226.        */
  1227.       StrLoc(**qptr) = StrLoc(**qptr) + DiffPtrs(dest,source) + (uword)extra;
  1228.       }
  1229.  
  1230.    /*
  1231.     * Move the last clump.
  1232.     */
  1233.    while (source < cend)
  1234.       *dest++ = *source++;
  1235.    strfree = dest;
  1236.    }
  1237.  
  1238. /*
  1239.  * qlcmp - compare the location fields of two string qualifiers for qsort.
  1240.  */
  1241.  
  1242. static int qlcmp(q1,q2)
  1243. dptr *q1, *q2;
  1244.    {
  1245.  
  1246. #if IntBits == 16
  1247.    long l;
  1248.    l = (long)(DiffPtrs(StrLoc(**q1),StrLoc(**q2)));
  1249.    if (l < 0)
  1250.       return -1;
  1251.    else if (l > 0)
  1252.       return 1;
  1253.    else
  1254.       return 0;
  1255. #else                                   /* IntBits = 16 */
  1256.    return (int)(DiffPtrs(StrLoc(**q1),StrLoc(**q2)));
  1257. #endif                                  /* IntBits == 16 */
  1258.  
  1259.    }
  1260.  
  1261. /*
  1262.  * adjust - adjust pointers into the block region, beginning with block oblk
  1263.  *  and basing the "new" block region at nblk.  (Phase II of garbage
  1264.  *  collection.)
  1265.  */
  1266.  
  1267. static void adjust(source,dest)
  1268. char *source, *dest;
  1269.    {
  1270.    register union block **nxtptr, **tptr;
  1271.  
  1272.    /*
  1273.     * Loop through to the end of allocated block region, moving source
  1274.     *  to each block in turn and using the size of a block to find the
  1275.     *  next block.
  1276.     */
  1277.    while (source < blkfree) {
  1278.       if ((uword)(nxtptr = (union block **)BlkType(source)) > MaxType) {
  1279.  
  1280.          /*
  1281.           * The type field of source is a back pointer.  Traverse the
  1282.           *  chain of back pointers, changing each block location from
  1283.           *  source to dest.
  1284.           */
  1285.          while ((uword)nxtptr > MaxType) {
  1286.             tptr = nxtptr;
  1287.             nxtptr = (union block **) *nxtptr;
  1288.             *tptr = (union block *)dest;
  1289.             }
  1290.          BlkType(source) = (uword)nxtptr | F_Mark;
  1291.          dest += BlkSize(source);
  1292.          }
  1293.       source += BlkSize(source);
  1294.       }
  1295.    }
  1296.  
  1297. /*
  1298.  * compact - compact good blocks in the block region. (Phase III of garbage
  1299.  *  collection.)
  1300.  */
  1301.  
  1302. static void compact(source)
  1303. char *source;
  1304.    {
  1305.    register char *dest;
  1306.    register word size;
  1307.  
  1308.    /*
  1309.     * Start dest at source.
  1310.     */
  1311.    dest = source;
  1312.  
  1313.    /*
  1314.     * Loop through to end of allocated block space, moving source
  1315.     *  to each block in turn, using the size of a block to find the next
  1316.     *  block.  If a block has been marked, it is copied to the
  1317.     *  location pointed to by dest and dest is pointed past the end
  1318.     *  of the block, which is the location to place the next saved
  1319.     *  block.  Marks are removed from the saved blocks.
  1320.     */
  1321.    while (source < blkfree) {
  1322.       size = BlkSize(source);
  1323.       if (BlkType(source) & F_Mark) {
  1324.          BlkType(source) &= ~F_Mark;
  1325.          if (source != dest)
  1326.             mvc((uword)size,source,dest);
  1327.          dest += size;
  1328.          }
  1329.       source += size;
  1330.       }
  1331.  
  1332.    /*
  1333.     * dest is the location of the next free block.  Now that compaction
  1334.     *  is complete, point blkfree to that location.
  1335.     */
  1336.    blkfree = dest;
  1337.    }
  1338.  
  1339. /*
  1340.  * mvc - move n bytes from src to dest
  1341.  *
  1342.  *      The algorithm is to copy the data (using memcpy) in the largest
  1343.  * chunks possible, which is the size of area of the source data not in
  1344.  * the destination area (ie non-overlapped area).  (Chunks are expected to
  1345.  * be fairly large.)
  1346.  */
  1347.  
  1348. static void mvc(n, src, dest)
  1349. uword n;
  1350. register char *src, *dest;
  1351.    {
  1352.    register char *srcend, *destend;        /* end of data areas */
  1353.    word copy_size;                  /* of size copy_size */
  1354.    word left_over;         /* size of last chunk < copy_size */
  1355.  
  1356.    if (n == 0)
  1357.       return;
  1358.  
  1359.    srcend  = src + n;    /* point at byte after src data */
  1360.    destend = dest + n;   /* point at byte after dest area */
  1361.  
  1362.    if ((destend <= src) || (srcend <= dest))  /* not overlapping */
  1363.       memcpy(dest,src,n);
  1364.  
  1365.    else {                     /* overlapping data areas */
  1366.       if (dest < src) {
  1367.          /*
  1368.           * The move is from higher memory to lower memory.
  1369.           */
  1370.          copy_size = DiffPtrs(src,dest);
  1371.  
  1372.          /* now loop round copying copy_size chunks of data */
  1373.  
  1374.          do {
  1375.             memcpy(dest,src,copy_size);
  1376.             dest = src;
  1377.             src = src + copy_size;
  1378.             }
  1379.          while (DiffPtrs(srcend,src) > copy_size);
  1380.  
  1381.          left_over = DiffPtrs(srcend,src);
  1382.  
  1383.          /* copy final fragment of data - if there is one */
  1384.  
  1385.          if (left_over > 0)
  1386.             memcpy(dest,src,left_over);
  1387.          }
  1388.  
  1389.       else if (dest > src) {
  1390.          /*
  1391.           * The move is from lower memory to higher memory.
  1392.           */
  1393.          copy_size = DiffPtrs(destend,srcend);
  1394.  
  1395.          /* now loop round copying copy_size chunks of data */
  1396.  
  1397.          do {
  1398.             destend = srcend;
  1399.             srcend  = srcend - copy_size;
  1400.             memcpy(destend,srcend,copy_size);
  1401.             }
  1402.          while (DiffPtrs(srcend,src) > copy_size);
  1403.  
  1404.          left_over = DiffPtrs(srcend,src);
  1405.  
  1406.          /* copy intial fragment of data - if there is one */
  1407.  
  1408.          if (left_over > 0) memcpy(dest,src,left_over);
  1409.          }
  1410.  
  1411.       } /* end of overlapping data area code */
  1412.  
  1413.    /*
  1414.     *  Note that src == dest implies no action
  1415.     */
  1416.    }
  1417.  
  1418. #ifdef DeBugIconx
  1419. /*
  1420.  * descr - dump a descriptor.  Used only for debugging.
  1421.  */
  1422.  
  1423. void descr(dp)
  1424. dptr dp;
  1425.    {
  1426.    int i;
  1427.  
  1428.    fprintf(stderr,"%08lx: ",(long)dp);
  1429.    if (Qual(*dp))
  1430.       fprintf(stderr,"%15s","qualifier");
  1431.  
  1432.    else if (Var(*dp))
  1433.       fprintf(stderr,"%15s","variable");
  1434.    else {
  1435.       i =  Type(*dp);
  1436.       switch (i) {
  1437.          case T_Null:
  1438.             fprintf(stderr,"%15s","null");
  1439.             break;
  1440.          case T_Integer:
  1441.             fprintf(stderr,"%15s","integer");
  1442.             break;
  1443.          default:
  1444.             fprintf(stderr,"%15s",blkname[i]);
  1445.          }
  1446.       }
  1447.    fprintf(stderr," %08lx %08lx\n",(long)dp->dword,(long)IntVal(*dp));
  1448.    }
  1449.  
  1450. /*
  1451.  * blkdump - dump the allocated block region.  Used only for debugging.
  1452.  *   NOTE:  Not adapted for multiple regions.
  1453.  */
  1454.  
  1455. void blkdump()
  1456.    {
  1457.    register char *blk;
  1458.    register word type, size, fdesc;
  1459.    register dptr ndesc;
  1460.  
  1461.    fprintf(stderr,
  1462.       "\nDump of allocated block region.  base:%08lx free:%08lx max:%08lx\n",
  1463.          (long)blkbase,(long)blkfree,(long)blkend);
  1464.    fprintf(stderr,"  loc     type              size  contents\n");
  1465.  
  1466.    for (blk = blkbase; blk < blkfree; blk += BlkSize(blk)) {
  1467.       type = BlkType(blk);
  1468.       size = BlkSize(blk);
  1469.       fprintf(stderr," %08lx   %15s   %4ld\n",(long)blk,blkname[type],
  1470.          (long)size);
  1471.       if ((fdesc = firstd[type]) > 0)
  1472.          for (ndesc = (dptr)(blk + fdesc);
  1473.                ndesc < (dptr)(blk + size); ndesc++) {
  1474.             fprintf(stderr,"                                 ");
  1475.             descr(ndesc);
  1476.             }
  1477.       fprintf(stderr,"\n");
  1478.       }
  1479.    fprintf(stderr,"end of block region.\n");
  1480.    }
  1481. #endif                                  /* DeBugIconx */
  1482.