tarot-viewing/vm/allocator.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "objects.h"
#include "allocator.h"

struct list *objects;

void
objects_push(scm *obj)
{
	struct list *link = malloc(sizeof(struct list));

	link->object = obj;

	link->next = objects;
	if (objects) {
		objects->prev = link;
	}

	objects = link;
}

scm *
allocate(scm len)
{
	scm *p;

	// TODO:

	p = calloc(len, sizeof(scm));
	objects_push(p);
	
	return p;
}

scm
allocate_strg(char *str, scm len)
{
	scm padded_len;
	scm *p;
	char *dst;
	
	padded_len = (len + 1 + 8)/8;
	p = allocate(padded_len + 2);
	
	p[0] = make_hdr(HDR_WHITE, padded_len + 1, 0);
	p[1] = len;
        dst = (void*)(p+2);

	if (str)
		strncpy(dst, str, len);

	return scm_puttag(p, TAG_STRG);
}

scm
allocate_cons(scm car, scm cdr)
{
	scm *p;

	p = allocate(3);
	
	p[0] = make_hdr(HDR_WHITE, 0, 2);
	p[1] = car;
	p[2] = cdr;
	
	return scm_puttag(p, TAG_CONS);
}

scm
allocate_vect(scm len, scm val)
{
	scm *p;
	scm i;

	p = allocate(len + 1);
	
	p[0] = make_hdr(HDR_WHITE, 0, len);
	for (i = 0; i < len; i++) {
		p[1 + i] = val;
	}
	
	return scm_puttag(p, TAG_VECT);
}

scm
allocate_clos(scm *lbl, scm len)
{
	scm *p;

	p = allocate(len + 2);
	
	p[0] = make_hdr(HDR_WHITE, 1, len);
	p[1] = SCM_PTR(lbl);
	// the rest are #f because calloc sets them to 0
	
	return scm_puttag(p, TAG_CLOS);
}