Skip to content
vars.c 3.63 KiB
Newer Older
Raymond Toy's avatar
Raymond Toy committed
/*

 This code was written as part of the CMU Common Lisp project at
 Carnegie Mellon University, and has been placed in the public domain.

*/

wlott's avatar
wlott committed
#include <stdio.h>
#include <sys/types.h>
#include <stdlib.h>
rtoy's avatar
rtoy committed
#include <string.h>
wlott's avatar
wlott committed

#include "lisp.h"
#include "vars.h"
ram's avatar
ram committed
#include "os.h"
wlott's avatar
wlott committed

#define NAME_BUCKETS 31
#define OBJ_BUCKETS 31

static struct var *NameHash[NAME_BUCKETS], *ObjHash[OBJ_BUCKETS];
static int tempcntr = 1;

struct var {
    lispobj obj;
      lispobj(*update_fn) (struct var * var);
wlott's avatar
wlott committed
    char *name;
    long clock;
    boolean map_back, permanent;

    struct var *nnext;		/* Next in name list */
    struct var *onext;		/* Next in object list */
wlott's avatar
wlott committed
};

static int
hash_name(char *name)
wlott's avatar
wlott committed
{
    unsigned long value = 0;

    while (*name != '\0') {
	value = (value << 1) ^ *(unsigned char *) (name++);
	value = (value & (1 - (1 << 24))) ^ (value >> 24);
wlott's avatar
wlott committed
    }

    return value % NAME_BUCKETS;
}

static int
hash_obj(lispobj obj)
wlott's avatar
wlott committed
{
    return (unsigned long) obj % OBJ_BUCKETS;
wlott's avatar
wlott committed
}


wlott's avatar
wlott committed
{
    int index;
    struct var *var, *next, *perm = NULL;

    /* Note: all vars in the object hash table also appear in the name hash table, so if we free everything in the name hash table, we free everything in the object hash table. */

    for (index = 0; index < NAME_BUCKETS; index++)
	for (var = NameHash[index]; var != NULL; var = next) {
	    next = var->nnext;
	    if (var->permanent) {
		var->nnext = perm;
		perm = var;
	    } else {
		free(var->name);
		free(var);
	    }
	}
    memset(NameHash, 0, sizeof(NameHash));
    memset(ObjHash, 0, sizeof(ObjHash));
wlott's avatar
wlott committed
    tempcntr = 1;

    for (var = perm; var != NULL; var = next) {
	next = var->nnext;
	index = hash_name(var->name);
	var->nnext = NameHash[index];
	NameHash[index] = var;
	if (var->map_back) {
	    index = hash_obj(var->obj);
	    var->onext = ObjHash[index];
	    ObjHash[index] = var;
	}
wlott's avatar
wlott committed
    }
}

wlott's avatar
wlott committed
{
    struct var *var;

    for (var = NameHash[hash_name(name)]; var != NULL; var = var->nnext)
	if (strcmp(var->name, name) == 0)
	    return var;
wlott's avatar
wlott committed
    return NULL;
}

wlott's avatar
wlott committed
{
    struct var *var;

    for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext)
	if (var->obj == obj)
	    return var;
wlott's avatar
wlott committed
    return NULL;
}

static struct var *
make_var(char *name, boolean perm)
wlott's avatar
wlott committed
{
    struct var *var;
wlott's avatar
wlott committed
    char buffer[256];
    int index;

    var = (struct var *) malloc(sizeof(struct var));

    if (var == NULL) {
	perror("malloc");
	exit(1);
wlott's avatar
wlott committed
    if (name == NULL) {
	sprintf(buffer, "%d", tempcntr++);
	name = buffer;
wlott's avatar
wlott committed
    }
    var->name = (char *) malloc(strlen(name) + 1);
wlott's avatar
wlott committed
    strcpy(var->name, name);
    var->clock = 0;
    var->permanent = perm;
    var->map_back = FALSE;
wlott's avatar
wlott committed
    index = hash_name(name);
    var->nnext = NameHash[index];
    NameHash[index] = var;

    return var;
wlott's avatar
wlott committed

struct var *
define_var(char *name, lispobj obj, boolean perm)
wlott's avatar
wlott committed
{
    struct var *var = make_var(name, perm);
    int index;

    var->obj = obj;
    var->update_fn = NULL;

    if (lookup_by_obj(obj) == NULL) {
	var->map_back = TRUE;
	index = hash_obj(obj);
	var->onext = ObjHash[index];
	ObjHash[index] = var;
wlott's avatar
wlott committed
    }

    return var;
}

struct var *
define_dynamic_var(char *name, lispobj updatefn(struct var *), boolean perm)
wlott's avatar
wlott committed
{
    struct var *var = make_var(name, perm);

    var->update_fn = updatefn;

    return var;
}

char *
var_name(struct var *var)
wlott's avatar
wlott committed
{
    return var->name;
}

lispobj
var_value(struct var * var)
wlott's avatar
wlott committed
{
    if (var->update_fn != NULL)
	var->obj = (*var->update_fn) (var);
wlott's avatar
wlott committed
    return var->obj;
}

long
var_clock(struct var *var)
wlott's avatar
wlott committed
{
    return var->clock;
}

void
var_setclock(struct var *var, long val)
wlott's avatar
wlott committed
{
    var->clock = val;
}