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