home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / lang / xlisp.sha / xldmem.c < prev    next >
Encoding:
C/C++ Source or Header  |  1985-02-17  |  6.4 KB  |  341 lines
  1. /* xldmem - xlisp dynamic memory management routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* useful definitions */
  6. #define ALLOCSIZE (sizeof(struct segment) + (anodes-1) * sizeof(NODE))
  7.  
  8. /* external variables */
  9. extern NODE *oblist,*keylist;
  10. extern NODE *xlstack;
  11. extern NODE *xlenv,*xlnewenv;
  12. extern long total;
  13. extern int anodes,nnodes,nsegs,nfree,gccalls;
  14. extern struct segment *segs;
  15. extern NODE *fnodes;
  16.  
  17. /* external procedures */
  18. extern char *malloc();
  19. extern char *calloc();
  20.  
  21. /* newnode - allocate a new node */
  22. NODE *newnode(type)
  23.   int type;
  24. {
  25.     NODE *nnode;
  26.  
  27.     /* get a free node */
  28.     if ((nnode = fnodes) == NIL) {
  29.     gc();
  30.     if ((nnode = fnodes) == NIL)
  31.         xlabort("insufficient node space");
  32.     }
  33.  
  34.     /* unlink the node from the free list */
  35.     fnodes = cdr(nnode);
  36.     nfree -= 1;
  37.  
  38.     /* initialize the new node */
  39.     nnode->n_type = type;
  40.     rplacd(nnode,NIL);
  41.  
  42.     /* return the new node */
  43.     return (nnode);
  44. }
  45.  
  46. /* stralloc - allocate memory for a string adding a byte for the terminator */
  47. char *stralloc(size)
  48.   int size;
  49. {
  50.     char *sptr;
  51.  
  52.     /* allocate memory for the string copy */
  53.     if ((sptr = malloc(size+1)) == NULL) {
  54.     gc();
  55.     if ((sptr = malloc(size+1)) == NULL)
  56.         xlfail("insufficient string space");
  57.     }
  58.     total += (long) (size+1);
  59.  
  60.     /* return the new string memory */
  61.     return (sptr);
  62. }
  63.  
  64. /* strsave - generate a dynamic copy of a string */
  65. char *strsave(str)
  66.   char *str;
  67. {
  68.     char *sptr;
  69.  
  70.     /* create a new string */
  71.     sptr = stralloc(strlen(str));
  72.     strcpy(sptr,str);
  73.  
  74.     /* return the new string */
  75.     return (sptr);
  76. }
  77.  
  78. /* strfree - free string memory */
  79. strfree(str)
  80.   char *str;
  81. {
  82.     total -= (long) (strlen(str)+1);
  83.     free(str);
  84. }
  85.  
  86. /* gc - garbage collect */
  87. gc()
  88. {
  89.     NODE *p;
  90.  
  91.     /* mark all accessible nodes */
  92.     mark(oblist); mark(keylist);
  93.     mark(xlenv);
  94.     mark(xlnewenv);
  95.  
  96.     /* mark the evaluation stack */
  97.     for (p = xlstack; p; p = cdr(p))
  98.     mark(car(p));
  99.  
  100.     /* sweep memory collecting all unmarked nodes */
  101.     sweep();
  102.  
  103.     /* if there's still nothing available, allocate more memory */
  104.     if (fnodes == NIL)
  105.     addseg();
  106.  
  107.     /* count the gc call */
  108.     gccalls++;
  109. }
  110.  
  111. /* mark - mark all accessible nodes */
  112. LOCAL mark(ptr)
  113.   NODE *ptr;
  114. {
  115.     NODE *this,*prev,*tmp;
  116.  
  117.     /* just return on nil */
  118.     if (ptr == NIL)
  119.     return;
  120.  
  121.     /* initialize */
  122.     prev = NIL;
  123.     this = ptr;
  124.  
  125.     /* mark this list */
  126.     while (TRUE) {
  127.  
  128.     /* descend as far as we can */
  129.     while (TRUE) {
  130.  
  131.         /* check for this node being marked */
  132.         if (this->n_flags & MARK)
  133.         break;
  134.  
  135.         /* mark it and its descendants */
  136.         else {
  137.  
  138.         /* mark the node */
  139.         this->n_flags |= MARK;
  140.  
  141.         /* follow the left sublist if there is one */
  142.         if (livecar(this)) {
  143.             this->n_flags |= LEFT;
  144.             tmp = prev;
  145.             prev = this;
  146.             this = car(prev);
  147.             rplaca(prev,tmp);
  148.         }
  149.  
  150.         /* otherwise, follow the right sublist if there is one */
  151.         else if (livecdr(this)) {
  152.             this->n_flags &= ~LEFT;
  153.             tmp = prev;
  154.             prev = this;
  155.             this = cdr(prev);
  156.             rplacd(prev,tmp);
  157.         }
  158.         else
  159.             break;
  160.         }
  161.     }
  162.  
  163.     /* backup to a point where we can continue descending */
  164.     while (TRUE) {
  165.  
  166.         /* check for termination condition */
  167.         if (prev == NIL)
  168.         return;
  169.  
  170.         /* check for coming from the left side */
  171.         if (prev->n_flags & LEFT)
  172.         if (livecdr(prev)) {
  173.             prev->n_flags &= ~LEFT;
  174.             tmp = car(prev);
  175.             rplaca(prev,this);
  176.             this = cdr(prev);
  177.             rplacd(prev,tmp);
  178.             break;
  179.         }
  180.         else {
  181.             tmp = prev;
  182.             prev = car(tmp);
  183.             rplaca(tmp,this);
  184.             this = tmp;
  185.         }
  186.  
  187.         /* otherwise, came from the right side */
  188.         else {
  189.         tmp = prev;
  190.         prev = cdr(tmp);
  191.         rplacd(tmp,this);
  192.         this = tmp;
  193.         }
  194.     }
  195.     }
  196. }
  197.  
  198. /* sweep - sweep all unmarked nodes and add them to the free list */
  199. LOCAL sweep()
  200. {
  201.     struct segment *seg;
  202.     NODE *p;
  203.     int n;
  204.  
  205.     /* empty the free list */
  206.     fnodes = NIL;
  207.     nfree = 0;
  208.  
  209.     /* add all unmarked nodes */
  210.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  211.     p = &seg->sg_nodes[0];
  212.     for (n = seg->sg_size; n--; p++)
  213.         if (!(p->n_flags & MARK)) {
  214.         switch (ntype(p)) {
  215.         case STR:
  216.             if (p->n_strtype == DYNAMIC && p->n_str != NULL)
  217.                 strfree(p->n_str);
  218.             break;
  219.         case FPTR:
  220.             if (p->n_fp)
  221.                 fclose(p->n_fp);
  222.             break;
  223.         }
  224.         p->n_type = FREE;
  225.         p->n_flags = 0;
  226.         rplaca(p,NIL);
  227.         rplacd(p,fnodes);
  228.         fnodes = p;
  229.         nfree++;
  230.         }
  231.         else
  232.         p->n_flags &= ~(MARK | LEFT);
  233.     }
  234. }
  235.  
  236. /* addseg - add a segment to the available memory */
  237. int addseg()
  238. {
  239.     struct segment *newseg;
  240.     NODE *p;
  241.     int n;
  242.  
  243.     /* check for zero allocation */
  244.     if (anodes == 0)
  245.     return (FALSE);
  246.  
  247.     /* allocate a new segment */
  248.     if ((newseg = (struct segment *) calloc(1,ALLOCSIZE)) != NULL) {
  249.  
  250.     /* initialize the new segment */
  251.     newseg->sg_size = anodes;
  252.     newseg->sg_next = segs;
  253.     segs = newseg;
  254.  
  255.     /* add each new node to the free list */
  256.     p = &newseg->sg_nodes[0];
  257.     for (n = anodes; n--; ) {
  258.         rplacd(p,fnodes);
  259.         fnodes = p++;
  260.     }
  261.  
  262.     /* update the statistics */
  263.     total += (long) ALLOCSIZE;
  264.     nnodes += anodes;
  265.     nfree += anodes;
  266.     nsegs++;
  267.  
  268.     /* return successfully */
  269.     return (TRUE);
  270.     }
  271.     else
  272.     return (FALSE);
  273. }
  274.  
  275. /* livecar - do we need to follow the car? */
  276. LOCAL int livecar(n)
  277.   NODE *n;
  278. {
  279.     switch (ntype(n)) {
  280.     case SUBR:
  281.     case FSUBR:
  282.     case INT:
  283.     case STR:
  284.     case FPTR:
  285.         return (FALSE);
  286.     case SYM:
  287.     case LIST:
  288.     case OBJ:
  289.         return (car(n) != NIL);
  290.     default:
  291.         printf("bad node type (%d) found during left scan\n",ntype(n));
  292.         exit();
  293.     }
  294. }
  295.  
  296. /* livecdr - do we need to follow the cdr? */
  297. LOCAL int livecdr(n)
  298.   NODE *n;
  299. {
  300.     switch (ntype(n)) {
  301.     case SUBR:
  302.     case FSUBR:
  303.     case INT:
  304.     case STR:
  305.     case FPTR:
  306.         return (FALSE);
  307.     case SYM:
  308.     case LIST:
  309.     case OBJ:
  310.         return (cdr(n) != NIL);
  311.     default:
  312.         printf("bad node type (%d) found during right scan\n",ntype(n));
  313.         exit();
  314.     }
  315. }
  316.  
  317. /* stats - print memory statistics */
  318. stats()
  319. {
  320.     printf("Nodes:       %d\n",nnodes);
  321.     printf("Free nodes:  %d\n",nfree);
  322.     printf("Segments:    %d\n",nsegs);
  323.     printf("Allocate:    %d\n",anodes);
  324.     printf("Total:       %ld\n",total);
  325.     printf("Collections: %d\n",gccalls);
  326. }
  327.  
  328. /* xlminit - initialize the dynamic memory module */
  329. xlminit()
  330. {
  331.     /* initialize our internal variables */
  332.     anodes = NNODES;
  333.     total = 0L;
  334.     nnodes = nsegs = nfree = gccalls = 0;
  335.     fnodes = NIL;
  336.     segs = NULL;
  337.  
  338.     /* initialize structures that are marked by the collector */
  339.     xlstack = xlenv = xlnewenv = oblist = keylist = NIL;
  340. }
  341.