2004-03-03 21:24:06 +01:00
|
|
|
#include "stdafx.h"
|
|
|
|
#include "defs.h"
|
|
|
|
|
2006-01-06 23:41:24 +01:00
|
|
|
// up to 100 blocks of 100,000 atoms
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-01-06 23:41:24 +01:00
|
|
|
#define M 100
|
|
|
|
#define N 100000
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-01-06 23:41:24 +01:00
|
|
|
U *mem[M];
|
|
|
|
int mcount;
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-01-07 00:44:23 +01:00
|
|
|
U *free_list;
|
|
|
|
int free_count;
|
2004-03-03 21:24:06 +01:00
|
|
|
|
|
|
|
U *
|
|
|
|
alloc(void)
|
|
|
|
{
|
|
|
|
U *p;
|
2006-01-07 00:13:27 +01:00
|
|
|
if (free_count == 0) {
|
2006-01-07 00:44:23 +01:00
|
|
|
if (mcount == 0)
|
|
|
|
alloc_mem();
|
|
|
|
else {
|
|
|
|
gc();
|
|
|
|
if (free_count < N * mcount / 2)
|
|
|
|
alloc_mem();
|
|
|
|
}
|
2006-01-07 00:13:27 +01:00
|
|
|
if (free_count == 0)
|
2004-03-03 21:24:06 +01:00
|
|
|
stop("atom space exhausted");
|
|
|
|
}
|
|
|
|
p = free_list;
|
|
|
|
free_list = free_list->u.cons.cdr;
|
|
|
|
free_count--;
|
|
|
|
return p;
|
|
|
|
}
|
|
|
|
|
|
|
|
U *
|
|
|
|
alloc_tensor(int nelem)
|
|
|
|
{
|
|
|
|
int i;
|
|
|
|
U *p;
|
|
|
|
p = alloc();
|
|
|
|
p->k = TENSOR;
|
|
|
|
p->u.tensor = (T *) malloc(sizeof (T) + nelem * sizeof (U *));
|
|
|
|
if (p->u.tensor == NULL)
|
|
|
|
out_of_memory();
|
|
|
|
p->u.tensor->nelem = nelem;
|
|
|
|
for (i = 0; i < nelem; i++)
|
2004-06-25 22:45:15 +02:00
|
|
|
p->u.tensor->elem[i] = zero;
|
2004-03-03 21:24:06 +01:00
|
|
|
return p;
|
|
|
|
}
|
|
|
|
|
|
|
|
// garbage collector
|
|
|
|
|
|
|
|
void
|
|
|
|
gc(void)
|
|
|
|
{
|
2006-01-06 23:41:24 +01:00
|
|
|
int i, j;
|
|
|
|
U *p;
|
2004-03-03 21:24:06 +01:00
|
|
|
|
|
|
|
// tag everything
|
|
|
|
|
2006-01-06 23:41:24 +01:00
|
|
|
for (i = 0; i < mcount; i++) {
|
|
|
|
p = mem[i];
|
|
|
|
for (j = 0; j < N; j++)
|
|
|
|
p[j].tag = 1;
|
|
|
|
}
|
2004-03-03 21:24:06 +01:00
|
|
|
|
|
|
|
// untag what's used
|
|
|
|
|
2004-06-25 02:11:40 +02:00
|
|
|
untag_symbols();
|
2004-03-03 21:24:06 +01:00
|
|
|
|
|
|
|
untag(p1);
|
|
|
|
untag(p2);
|
|
|
|
untag(p3);
|
|
|
|
untag(p4);
|
|
|
|
untag(p5);
|
|
|
|
untag(p6);
|
|
|
|
untag(p7);
|
|
|
|
untag(p8);
|
|
|
|
|
2005-08-07 19:45:09 +02:00
|
|
|
untag(one);
|
|
|
|
untag(zero);
|
|
|
|
untag(imaginaryunit);
|
|
|
|
|
|
|
|
untag(table_of_fourier);
|
|
|
|
|
2004-03-03 21:24:06 +01:00
|
|
|
for (i = 0; i < tos; i++)
|
|
|
|
untag(stack[i]);
|
|
|
|
|
|
|
|
for (i = (int) (frame - stack); i < TOS; i++)
|
|
|
|
untag(stack[i]);
|
|
|
|
|
|
|
|
// collect everything that's still tagged
|
|
|
|
|
|
|
|
free_count = 0;
|
2006-01-06 23:41:24 +01:00
|
|
|
|
|
|
|
for (i = 0; i < mcount; i++) {
|
|
|
|
p = mem[i];
|
|
|
|
for (j = 0; j < N; j++) {
|
|
|
|
if (p[j].tag == 0)
|
|
|
|
continue;
|
|
|
|
// still tagged so it's unused, put on free list
|
|
|
|
switch (p[j].k) {
|
2004-03-03 21:24:06 +01:00
|
|
|
case TENSOR:
|
2006-01-06 23:41:24 +01:00
|
|
|
free(p[j].u.tensor);
|
2004-03-03 21:24:06 +01:00
|
|
|
break;
|
|
|
|
case STR:
|
2006-01-06 23:41:24 +01:00
|
|
|
free(p[j].u.str);
|
2004-03-03 21:24:06 +01:00
|
|
|
break;
|
|
|
|
case NUM:
|
2006-01-06 23:41:24 +01:00
|
|
|
mfree(p[j].u.q.a);
|
|
|
|
mfree(p[j].u.q.b);
|
2004-03-03 21:24:06 +01:00
|
|
|
break;
|
|
|
|
}
|
2006-01-06 23:41:24 +01:00
|
|
|
p[j].k = CONS; // so no double free occurs above
|
|
|
|
p[j].u.cons.cdr = free_list;
|
|
|
|
free_list = p + j;
|
2004-03-03 21:24:06 +01:00
|
|
|
free_count++;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2006-01-04 03:30:50 +01:00
|
|
|
void
|
2004-03-03 21:24:06 +01:00
|
|
|
untag_symbols(void)
|
|
|
|
{
|
|
|
|
int i;
|
2004-04-04 10:21:10 +02:00
|
|
|
for (i = 0; i < nsym; i++) {
|
|
|
|
untag(symtab[i].u.sym.binding);
|
2006-10-06 20:28:26 +02:00
|
|
|
untag(symtab[i].u.sym.arglist);
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2006-01-04 03:30:50 +01:00
|
|
|
void
|
2004-03-03 21:24:06 +01:00
|
|
|
untag(U *p)
|
|
|
|
{
|
|
|
|
int i;
|
|
|
|
|
|
|
|
while (iscons(p) && p->tag == 1) {
|
|
|
|
p->tag = 0;
|
|
|
|
untag(p->u.cons.car);
|
|
|
|
p = p->u.cons.cdr;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (p->tag != 1)
|
|
|
|
return;
|
|
|
|
|
|
|
|
p->tag = 0;
|
|
|
|
|
|
|
|
if (istensor(p)) {
|
|
|
|
for (i = 0; i < p->u.tensor->nelem; i++)
|
|
|
|
untag(p->u.tensor->elem[i]);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2006-01-06 23:41:24 +01:00
|
|
|
// get memory for 100,000 atoms
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-01-04 03:30:50 +01:00
|
|
|
void
|
2006-01-07 00:44:23 +01:00
|
|
|
alloc_mem(void)
|
2004-03-03 21:24:06 +01:00
|
|
|
{
|
2006-01-06 23:41:24 +01:00
|
|
|
int i;
|
|
|
|
U *p;
|
|
|
|
if (mcount == M)
|
|
|
|
return;
|
|
|
|
p = (U *) malloc(N * sizeof (struct U));
|
|
|
|
if (p == NULL)
|
2004-03-03 21:24:06 +01:00
|
|
|
return;
|
2006-01-06 23:41:24 +01:00
|
|
|
mem[mcount++] = p;
|
|
|
|
for (i = 0; i < N; i++) {
|
|
|
|
p[i].k = CONS; // so no free in gc
|
|
|
|
p[i].u.cons.cdr = p + i + 1;
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
2006-01-06 23:41:24 +01:00
|
|
|
p[N - 1].u.cons.cdr = free_list;
|
|
|
|
free_list = p;
|
|
|
|
free_count += N;
|
2006-01-07 00:44:23 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
print_mem_info(void)
|
|
|
|
{
|
|
|
|
static char buf[100];
|
|
|
|
sprintf(buf, "%d atoms %d free %d used %d bytes/atom\n",
|
|
|
|
N * mcount,
|
|
|
|
free_count,
|
|
|
|
N * mcount - free_count,
|
|
|
|
(int) sizeof (U));
|
|
|
|
printstr(buf);
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|