xldmem.c

Audacity是一款用於錄音和編輯聲音的、免費的開放源碼軟體。它可以執行於Mac OS X、Microsoft Windows、GNU/Linux和其它作業系統

            /* check cons and symbol nodes */
            if (((type = ntype(this))) == CONS || type == USTREAM) {
                if ((tmp = car(this))) {
                    this->n_flags |= MARK|LEFT;
                    rplaca(this,prev);
                }
                else if ((tmp = cdr(this))) {
                    this->n_flags |= MARK;
                    rplacd(this,prev);
                }
                else {				/* both sides nil */
                    this->n_flags |= MARK;
                    break;
                }
                prev = this;			/* step down the branch */
                this = tmp;
            }

            /* mark other node types */
            else {
                this->n_flags |= MARK;
                switch (type) {
                case SYMBOL:
                case OBJECT:
                case VECTOR:
                case CLOSURE:
                    for (i = 0, n = getsize(this); --n >= 0; ++i)
                        if ((tmp = getelement(this,i)))
                            mark(tmp);
                    break;
                case EXTERN:
                    if (getdesc(this)->mark_meth) { (*(getdesc(this)->mark_meth))(getinst(this));
                    }
                }
                break;
            }

        /* backup to a point where we can continue descending */
        for (;;)

            /* make sure there is a previous node */
            if (prev) {
                if (prev->n_flags & LEFT) {	/* came from left side */
                    prev->n_flags &= ~LEFT;
                    tmp = car(prev);
                    rplaca(prev,this);
                    if ((this = cdr(prev))) {
                        rplacd(prev,tmp);			
                        break;
                    }
                }
                else {				/* came from right side */
                    tmp = cdr(prev);
                    rplacd(prev,this);
                }
                this = prev;			/* step back up the branch */
                prev = tmp;
            }

            /* no previous node, must be done */
            else
                return;
    }
}

/* sweep - sweep all unmarked nodes and add them to the free list */
LOCAL void sweep(void)
{
    SEGMENT *seg;
    LVAL p;
    int n;

    /* empty the free list */
    fnodes = NIL;
    nfree = 0L;

    /* add all unmarked nodes */
    for (seg = segs; seg; seg = seg->sg_next) {
        if (seg == fixseg)	 /* don't sweep the fixnum segment */
            continue;
        else if (seg == charseg) /* don't sweep the character segment */
            continue;
        p = &seg->sg_nodes[0];
        for (n = seg->sg_size; --n >= 0; ++p) {
#ifdef DEBUG_MEM
            if (xldmem_trace &&
                  ntype(p) == EXTERN &&
                  xldmem_trace == getinst(p)) {
                printf("sweep: EXTERN node %lx is %smarked, points to %lx\n",
                       p, (p->n_flags & MARK ? "" : "un"), getinst(p));
            }
#endif
            if (!(p->n_flags & MARK)) {
                switch (ntype(p)) {
                case STRING:
                        if (getstring(p) != NULL) {
                            total -= (long)getslength(p);
                            free(getstring(p));
                        }
                        break;
                case STREAM:
                        if (getfile(p))
                            osclose(getfile(p));
                        break;
                case SYMBOL:
                case OBJECT:
                case VECTOR:
                case CLOSURE:
                        if (p->n_vsize) {
                            total -= (long) (p->n_vsize * sizeof(LVAL));
                            free((void *) p->n_vdata);
                        }
                        break;
                case EXTERN:
                        /* printf("GC about to free %x\n", p);  
                         * fflush(stdout);
                         */
                        if (getdesc(p)) { (*(getdesc(p)->free_meth))(getinst(p));
                        }
                        break;
                }
                p->n_type = FREE_NODE;
                rplaca(p,NIL);
                rplacd(p,fnodes);
                fnodes = p;
                nfree += 1L;
            }
            else
                p->n_flags &= ~MARK;
        }
    }
}

/* addseg - add a segment to the available memory */
LOCAL int addseg(void)
{
    SEGMENT *newseg;
    LVAL p;
    int n;

    /* allocate the new segment */
    if (anodes == 0 || (newseg = newsegment(anodes)) == NULL)
        return (FALSE);

    /* add each new node to the free list */
    p = &newseg->sg_nodes[0];
    for (n = anodes; --n >= 0; ++p) {
        rplacd(p,fnodes);
        fnodes = p;
    }

    /* return successfully */
    return (TRUE);
}

/* newsegment - create a new segment (only called here and in xlimage.c) */
SEGMENT *newsegment(int n)
{
    SEGMENT *newseg;

    /* allocate the new segment */
    if ((newseg = (SEGMENT *)calloc(1,segsize(n))) == NULL)
        return (NULL);

    /* initialize the new segment */
    newseg->sg_size = n;
    newseg->sg_next = NULL;
    if (segs)
        lastseg->sg_next = newseg;
    else
        segs = newseg;
    lastseg = newseg;

    /* update the statistics */
    total += (long)segsize(n);
    nnodes += (long)n;
    nfree += (long)n;
    ++nsegs;

    /* return the new segment */
    return (newseg);
}
 
/* stats - print memory statistics */
LOCAL void stats(void)
{
    sprintf(buf,"Nodes:       %ld\n",nnodes); stdputstr(buf);
    sprintf(buf,"Free nodes:  %ld\n",nfree);  stdputstr(buf);
    sprintf(buf,"Segments:    %d\n",nsegs);   stdputstr(buf);
    sprintf(buf,"Allocate:    %d\n",anodes);  stdputstr(buf);
    sprintf(buf,"Total:       %ld\n",total);  stdputstr(buf);
    sprintf(buf,"Collections: %d\n",gccalls); stdputstr(buf);
}

/* xgc - xlisp function to force garbage collection */
LVAL xgc(void)
{
    /* make sure there aren't any arguments */
    xllastarg();

    /* garbage collect */
    gc();

    /* return nil */
    return (NIL);
}

/* xexpand - xlisp function to force memory expansion */
LVAL xexpand(void)
{
    LVAL num;
    int n,i;

    /* get the new number to allocate */
    if (moreargs()) {
        num = xlgafixnum();
        n = getfixnum(num);
    }
    else
        n = 1;
    xllastarg();

    /* allocate more segments */
    for (i = 0; i < n; i++)
        if (!addseg())
            break;

    /* return the number of segments added */
    return (cvfixnum((FIXTYPE)i));
}

/* xalloc - xlisp function to set the number of nodes to allocate */
LVAL xalloc(void)
{
    int n,oldn;
    LVAL num;

    /* get the new number to allocate */
    num = xlgafixnum();
    n = getfixnum(num);

    /* make sure there aren't any more arguments */
    xllastarg();

    /* set the new number of nodes to allocate */
    oldn = anodes;
    anodes = n;

    /* return the old number */
    return (cvfixnum((FIXTYPE)oldn));
}

/* xmem - xlisp function to print memory statistics */
LVAL xmem(void)
{
    /* allow one argument for compatiblity with common lisp */
    if (moreargs()) xlgetarg();
    xllastarg();

    /* print the statistics */
    stats();

    /* return nil */
    return (NIL);
}

/* xinfo - show information on control-t */
LVAL xinfo()
{
    char buf[80];

    sprintf(buf,"\n[ Free: %d, GC calls: %d, Total: %d",
            (int)nfree, (int)gccalls, (int)total);
    stdputstr(buf);
    print_local_gc_info();
    stdputstr("]\n");
    return NULL;
}


#ifdef SAVERESTORE
/* xsave - save the memory image */
LVAL xsave(void)
{
    unsigned char *name;

    /* get the file name, verbose flag and print flag */
    name = getstring(xlgetfname());
    xllastarg();

    /* save the memory image */
    return (xlisave((char *) name) ? s_true : NIL);
}

/* xrestore - restore a saved memory image */
LVAL xrestore(void)
{
    extern jmp_buf top_level;
    unsigned char *name;

    /* get the file name, verbose flag and print flag */
    name = getstring(xlgetfname());
    xllastarg();

    /* restore the saved memory image */
    if (!xlirestore((char *) name))
        return (NIL);

    /* return directly to the top level */
    stdputstr("[ returning to the top level ]\n");
    longjmp(top_level,1);
}
#endif

/* xlminit - initialize the dynamic memory module */
void xlminit(void)
{
    LVAL p;
    int i;

    /* initialize our internal variables */
    segs = lastseg = NULL;
    nnodes = nfree = total = 0L;
    nsegs = gccalls = 0;
    anodes = NNODES;
    fnodes = NIL;

    /* allocate the fixnum segment */
    if ((fixseg = newsegment(SFIXSIZE)) == NULL)
        xlfatal("insufficient memory");

    /* initialize the fixnum segment */
    p = &fixseg->sg_nodes[0];
    for (i = SFIXMIN; i <= SFIXMAX; ++i) {
        p->n_type = FIXNUM;
        p->n_fixnum = i;
        ++p;
    }

    /* allocate the character segment */
    if ((charseg = newsegment(CHARSIZE)) == NULL)
        xlfatal("insufficient memory");

    /* initialize the character segment */
    p = &charseg->sg_nodes[0];
    for (i = CHARMIN; i <= CHARMAX; ++i) {
        p->n_type = CHAR;
        p->n_chcode = i;
        ++p;
    }

    /* initialize structures that are marked by the collector */
    obarray = xlenv = xlfenv = xldenv = NIL;
    s_gcflag = s_gchook = NIL;

    /* allocate the evaluation stack */
    if ((xlstkbase = (LVAL **)malloc(EDEPTH * sizeof(LVAL *))) == NULL)
        xlfatal("insufficient memory");
    xlstack = xlstktop = xlstkbase + EDEPTH;

    /* allocate the argument stack */
    if ((xlargstkbase = (LVAL *)malloc(ADEPTH * sizeof(LVAL))) == NULL)
        xlfatal("insufficient memory");
    xlargstktop = xlargstkbase + ADEPTH;
    xlfp = xlsp = xlargstkbase;
    *xlsp++ = NIL;
}