home *** CD-ROM | disk | FTP | other *** search
- /* xldmem - xlisp dynamic memory management routines */
-
- #ifdef AZTEC
- #include "stdio.h"
- #else
- #include <stdio.h>
- #endif
-
- #include "xlisp.h"
-
- /* useful definitions */
- #define ALLOCSIZE (sizeof(struct segment) + (anodes-1) * sizeof(struct node))
-
- /* memory segment structure definition */
- struct segment {
- int sg_size;
- struct segment *sg_next;
- struct node sg_nodes[1];
- };
-
- /* external variables */
- extern struct node *oblist;
- extern struct node *xlstack;
- extern struct node *xlenv;
-
- /* external procedures */
- extern char *malloc();
- extern char *calloc();
-
- /* local variables */
- int anodes,nnodes,nsegs,nfree,gccalls;
- static struct segment *segs;
- static struct node *fnodes;
-
- /* newnode - allocate a new node */
- struct node *newnode(type)
- int type;
- {
- struct node *nnode;
-
- /* get a free node */
- if ((nnode = fnodes) == NULL) {
- gc();
- if ((nnode = fnodes) == NULL)
- xlfail("insufficient node space");
- }
-
- /* unlink the node from the free list */
- fnodes = nnode->n_right;
- nfree -= 1;
-
- /* initialize the new node */
- nnode->n_type = type;
- nnode->n_right = NULL;
-
- /* return the new node */
- return (nnode);
- }
-
- /* stralloc - allocate memory for a string adding a byte for the terminator */
- char *stralloc(size)
- int size;
- {
- char *sptr;
-
- /* allocate memory for the string copy */
- if ((sptr = malloc(size+1)) == NULL) {
- gc();
- if ((sptr = malloc(size+1)) == NULL)
- xlfail("insufficient string space");
- }
-
- /* return the new string memory */
- return (sptr);
- }
-
- /* strsave - generate a dynamic copy of a string */
- char *strsave(str)
- char *str;
- {
- char *sptr;
-
- /* create a new string */
- sptr = stralloc(strlen(str));
- strcpy(sptr,str);
-
- /* return the new string */
- return (sptr);
- }
-
- /* strfree - free string memory */
- strfree(str)
- char *str;
- {
- free(str);
- }
-
- /* gc - garbage collect */
- gc()
- {
- struct node *p;
-
- /* mark all accessible nodes */
- mark(oblist);
- mark(xlenv);
-
- /* mark the evaluation stack */
- for (p = xlstack; p; p = p->n_listnext)
- mark(p->n_listvalue);
-
- /* sweep memory collecting all unmarked nodes */
- sweep();
-
- /* if there's still nothing available, allocate more memory */
- if (fnodes == NULL)
- addseg();
-
- /* count the gc call */
- gccalls += 1;
- }
-
- /* mark - mark all accessible nodes */
- LOCAL mark(ptr)
- struct node *ptr;
- {
- struct node *this,*prev,*tmp;
-
- /* just return on null */
- if (ptr == NULL)
- return;
-
- /* initialize */
- prev = NULL;
- this = ptr;
-
- /* mark this list */
- while (TRUE) {
-
- /* descend as far as we can */
- while (TRUE) {
-
- /* check for this node being marked */
- if (this->n_flags & MARK)
- break;
-
- /* mark it and its descendants */
- else {
-
- /* mark the node */
- this->n_flags |= MARK;
-
- /* follow the left sublist if there is one */
- if (left(this)) {
- this->n_flags |= LEFT;
- tmp = prev;
- prev = this;
- this = prev->n_left;
- prev->n_left = tmp;
- }
- else if (right(this)) {
- this->n_flags &= ~LEFT;
- tmp = prev;
- prev = this;
- this = prev->n_right;
- prev->n_right = tmp;
- }
- else
- break;
- }
- }
-
- /* backup to a point where we can continue descending */
- while (TRUE) {
-
- /* check for termination condition */
- if (prev == NULL)
- return;
-
- /* check for coming from the left side */
- if (prev->n_flags & LEFT)
- if (right(prev)) {
- prev->n_flags &= ~LEFT;
- tmp = prev->n_left;
- prev->n_left = this;
- this = prev->n_right;
- prev->n_right = tmp;
- break;
- }
- else {
- tmp = prev;
- prev = tmp->n_left;
- tmp->n_left = this;
- this = tmp;
- }
-
- /* came from the right side */
- else {
- tmp = prev;
- prev = tmp->n_right;
- tmp->n_right = this;
- this = tmp;
- }
- }
- }
- }
-
- /* sweep - sweep all unmarked nodes and add them to the free list */
- LOCAL sweep()
- {
- struct segment *seg;
- struct node *p;
- int n;
-
- /* empty the free list */
- fnodes = NULL;
- nfree = 0;
-
- /* add all unmarked nodes */
- for (seg = segs; seg != NULL; seg = seg->sg_next) {
- p = &seg->sg_nodes[0];
- for (n = seg->sg_size; n--; p++)
- if (!(p->n_flags & MARK)) {
- switch (p->n_type) {
- case STR:
- if (p->n_strtype == DYNAMIC && p->n_str != NULL)
- strfree(p->n_str);
- break;
- }
- p->n_type = FREE;
- p->n_flags = 0;
- p->n_left = NULL;
- p->n_right = fnodes;
- fnodes = p;
- nfree += 1;
- }
- else
- p->n_flags &= ~(MARK | LEFT);
- }
- }
-
- /* addseg - add a segment to the available memory */
- int addseg()
- {
- struct segment *newseg;
- struct node *p;
- int n;
-
- /* check for zero allocation */
- if (anodes == 0)
- return (FALSE);
-
- /* allocate a new segment */
- if ((newseg = (struct segment *) calloc(1,ALLOCSIZE)) != NULL) {
-
- /* initialize the new segment */
- newseg->sg_size = anodes;
- newseg->sg_next = segs;
- segs = newseg;
-
- /* add each new node to the free list */
- p = &newseg->sg_nodes[0];
- for (n = anodes; n--; ) {
- p->n_right = fnodes;
- fnodes = p++;
- }
-
- /* update the statistics */
- nnodes += anodes;
- nfree += anodes;
- nsegs += 1;
-
- /* return successfully */
- return (TRUE);
- }
- else
- return (FALSE);
- }
-
- /* left - check for a left sublist */
- LOCAL int left(n)
- struct node *n;
- {
- switch (n->n_type) {
- case SUBR:
- case FSUBR:
- case INT:
- case STR:
- case FPTR:
- return (FALSE);
- case SYM:
- case LIST:
- case OBJ:
- return (n->n_left != NULL);
- default:
- printf("bad node type (%d) found during left scan\n",n->n_type);
- exit();
- }
- }
-
- /* right - check for a right sublist */
- LOCAL int right(n)
- struct node *n;
- {
- switch (n->n_type) {
- case SUBR:
- case FSUBR:
- case INT:
- case STR:
- case FPTR:
- return (FALSE);
- case SYM:
- case LIST:
- case OBJ:
- return (n->n_right != NULL);
- default:
- printf("bad node type (%d) found during right scan\n",n->n_type);
- exit();
- }
- }
-
- /* stats - print memory statistics */
- stats()
- {
- printf("Nodes: %d\n",nnodes);
- printf("Free nodes: %d\n",nfree);
- printf("Segments: %d\n",nsegs);
- printf("Allocate: %d\n",anodes);
- printf("Collections: %d\n",gccalls);
- }
-
- /* xlminit - initialize the dynamic memory module */
- xlminit()
- {
- /* initialize our internal variables */
- anodes = NNODES;
- nnodes = nsegs = nfree = gccalls = 0;
- segs = fnodes = NULL;
-
- /* initialize structures that are marked by the collector */
- xlstack = xlenv = oblist = NULL;
- }