/*************************************************************************
*  PDSS (PIMOS Development Support System)  Version 2.52		 *
*  (C) Copyright 1988,1989,1990,1992.					 *
*  Institute for New Generation Computer Technology (ICOT), Japan.	 *
*  Read "../COPYRIGHT" for detailed information.			 *
*************************************************************************/

#include "pdss.h"
#include "memory.h"
#include "io.h"

static CHAR *atom_table[MAX_ATOMS];	 /* Atom Name Table */
unsigned int gensym_count1 = 0;		 /* for Named Atoms */
unsigned int gensym_count2 = 0xFFFFFFFF; /* for Atoms without Name */

/* Atom -> Atom Name Table */
#define TABLE_NAME		atom_name_table
#define ENTRY_TYPE_NAME		atom_table_entry
#define DATA_TYPE		unsigned int
#define TABLE_SIZE		2048
#define INIT_ROUTINE_NAME	clear_atom_table
#define LOOKUP_ROUTINE_NAME	lookup_atom
#define ENTRY_ROUTINE_NAME	enter_new_atom
#define MALLOC_FAILURE_ROUTINE1 {\
    Error(">>> Not Enough Memory (atom.c: malloc failure) -- Aborted.");\
    exit_pdss(1);\
}
#define MALLOC_FAILURE_ROUTINE2 {\
    Error(">>> Not Enough Memory (atom.c: malloc failure).");\
    return(gensym_count2--);\
}
#include "table.c"  /* General Purpose Name Table Lookup Subroutine Package */

CHAR *atom_name(atom)
    unsigned int atom;
{
    if(atom<MAX_ATOMS){
	return(atom_table[atom]);
    }else{
	static CHAR buf[4][16];
	static int i;
	i = (++i)&3;
	sprintf(buf[i], "$$$%d", 0xFFFFFFFF-atom);
	return(buf[i]);
    }
}

unsigned int new_atom()
{
    return(gensym_count2--);
}

unsigned int intern_atom(name)
    CHAR *name;
{
    unsigned int result;
    CHAR *name2;
    if(lookup_atom(name, &result)){
	if(gensym_count1 >= MAX_ATOMS){
	    Error(">>> Too Many Atoms.");
	    return(gensym_count2--);
	}
	name2 = (CHAR *)malloc(strlen(name)+1);
	if(name2 == NULL){
	    Error(">>> Not Enough Memory (atom.c: malloc failure).");
	    return(gensym_count2--);
	}
	strcpy(name2, name);
	(void) enter_new_atom(name2, &gensym_count1);
	atom_table[gensym_count1] = name2;
	return(gensym_count1++);
    }else {
	return(result);
    }
}

unsigned int intern_atom2(name)
    CHAR *name;
{
    unsigned int result;
    if(lookup_atom(name, &result)){
	if(gensym_count1 >= MAX_ATOMS){
	    Error(">>> Too Many Atoms.");
	    return(gensym_count2--);
	}
	(void) enter_new_atom(name, &gensym_count1);
	atom_table[gensym_count1] = name;
	return(gensym_count1++);
    } else {
	return(result);
    }
}

static unsigned int intern_atom3(name)
    CHAR *name;
{
    (void) enter_new_atom(name, &gensym_count1);
    atom_table[gensym_count1] = name;
    return(gensym_count1++);
}

initialize_atom_table()
{
    clear_atom_table();

    intern_atom3("[]");
    intern_atom3("$$$SYSTEM");
    intern_atom3("succeeded");
    intern_atom3("aborted");
    intern_atom3("reduction_limit");
    intern_atom3("exception");
    intern_atom3("raised");
    intern_atom3("deadlock");
    intern_atom3("merge");

    intern_atom3(",");
    intern_atom3(":");
    intern_atom3("|");
    intern_atom3("!");
    intern_atom3("(");
    intern_atom3(")");
    intern_atom3("[");
    intern_atom3("]");
    intern_atom3("{");
    intern_atom3("}");
    intern_atom3("+");
    intern_atom3("-");

    intern_atom3("atom");
    intern_atom3("integer");
    intern_atom3("float");
    intern_atom3("string");
    intern_atom3("open");
    intern_atom3("sign");
    intern_atom3("end");
    intern_atom3("illegal");
    intern_atom3("$VAR");
    intern_atom3("$SHOEN");
    intern_atom3("$NUE");
}

CELL const_nil			= {ATOM, MRBOFF, NIL};
CELL const_atom_succeeded	= {ATOM, MRBOFF, ATOM_SUCCEEDED};
CELL const_atom_aborted		= {ATOM, MRBOFF, ATOM_ABORTED};
CELL const_atom_reduction_limit = {ATOM, MRBOFF, ATOM_REDUCTION_LIMIT};
CELL const_atom_exception	= {ATOM, MRBOFF, ATOM_EXCEPTION};
CELL const_atom_raised		= {ATOM, MRBOFF, ATOM_RAISED};
CELL const_atom_deadlock	= {ATOM, MRBOFF, ATOM_DEADLOCK};
CELL const_atom_merge		= {ATOM, MRBOFF, ATOM_MERGE};
CELL const_atom_colon		= {ATOM, MRBOFF, ATOM_COLON};

CELL const_atom_atom		= {ATOM, MRBOFF, ATOM_ATOM};
CELL const_atom_integer		= {ATOM, MRBOFF, ATOM_INTEGER};
CELL const_atom_float		= {ATOM, MRBOFF, ATOM_FLOAT};
CELL const_atom_string		= {ATOM, MRBOFF, ATOM_STRING};
CELL const_atom_open		= {ATOM, MRBOFF, ATOM_OPEN};
CELL const_atom_sign		= {ATOM, MRBOFF, ATOM_SIGN};
CELL const_atom_end		= {ATOM, MRBOFF, ATOM_END};
CELL const_atom_illegal		= {ATOM, MRBOFF, ATOM_ILLEGAL};
CELL const_atom_d_var		= {ATOM, MRBOFF, ATOM_D_VAR};
CELL const_atom_d_shoen		= {ATOM, MRBOFF, ATOM_D_SHOEN};
