/* Copyright (C) 1995 Bjoern Beutel. */
/* Description. =============================================================*/
/* This module compiles malaga symbol files. */
/* Includes. ================================================================*/
#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <setjmp.h>
#include <glib.h>
#include "basic.h"
#include "pools.h"
#include "values.h"
#include "scanner.h"
#include "files.h"
#include "malaga_files.h"
#include "symbols.h"
#include "avl_trees.h"
#include "hangul.h"
#include "sym_compiler.h"
/* Types. ===================================================================*/
typedef struct /* A node of the symbol table. */
{
avln_node_t node; /* The symbol tree is an AVLN tree. */
value_t atoms; /* List of atoms in VALUE_POOL. */
symbol_t symbol; /* Symbol which this node represents. */
} symbol_node_t;
typedef struct /* A node of the atoms tree. */
{
avl_node_t node; /* The atoms tree is an AVL tree, sorted by its atoms. */
value_t atoms;
symbol_t symbol;
string_t name;
} atoms_node_t;
/* Variables. ===============================================================*/
static avln_node_t *symbol_tree; /* The symbol table, sorted by names.
* This is actually a symbol_node_t. */
static avl_node_t *atoms_tree; /* The symbol table, sorted by atoms.
* This is actually a atoms_node_t. */
static pool_t symbol_pool; /* Symbol entries. */
static pool_t value_pool; /* Lists of atomic symbols. */
static pool_t string_pool; /* Symbol names. */
/* Functions. ===============================================================*/
static int_t
compare_by_atoms( avl_node_t *node1, avl_node_t *node2 )
/* Callback function for AVL tree functions. */
{
return compare_atom_lists( ((atoms_node_t *) node1)->atoms,
((atoms_node_t *) node2)->atoms );
}
/*---------------------------------------------------------------------------*/
static symbol_node_t *
find_symbol_node( string_t name )
/* Find and return a symbol node with given name.
* If no symbol node exists, return NULL. */
{
avln_node_t *node;
int_t result;
/* Look for existing node. */
node = symbol_tree;
while (node != NULL)
{
result = strcmp_no_case( name, node->name );
if (result < 0)
node = node->left;
else if (result > 0)
node = node->right;
else
return (symbol_node_t *) node;
}
return NULL;
}
/*---------------------------------------------------------------------------*/
static symbol_t
find_atomic_symbol( string_t name )
/* Find symbol NAME and check if it is atomic. Return the symbol. */
{
symbol_node_t *node;
node = find_symbol_node( name );
if (node == NULL)
complain( "Symbol \"%s\" is not defined.", name );
else if (get_list_length( node->atoms ) > 1)
complain( "Symbol \"%s\" is not atomic.", name );
return node->symbol;
}
/*---------------------------------------------------------------------------*/
static void
enter_symbol( string_t name, value_t atoms )
/* Enter NAME as a symbol name with atomic symbol list ATOMS
* in the symbol tree. */
{
symbol_node_t *node;
atoms_node_t *atoms_node;
symbol_entry_t symbol_entry;
int_t result;
node = find_symbol_node( name );
if (atoms == NULL)
{
/* Make atom list for atomic symbol. */
top = 0;
if (node != NULL)
push_symbol_value( node->symbol );
else
push_symbol_value( pool_item_count( symbol_pool ) );
build_list(1);
atoms = value_stack[0];
}
if (node != NULL)
{
/* Compare with previous definition. */
if (compare_atom_lists( atoms, node->atoms ) != 0)
{
complain( "Atom list for \"%s\" differs in previous definition.",
node->node.name );
}
}
else
{
/* Create new symbol node. */
node = new_mem( sizeof( symbol_node_t ) );
node->node.name = copy_string_to_pool( string_pool, name,
&symbol_entry.name );
node->symbol = pool_item_count( symbol_pool );
if (node->symbol >= SYMBOL_MAX)
complain( "Too many symbols." );
node->atoms = copy_value_to_pool( value_pool, atoms, &symbol_entry.atoms );
insert_avln_node( (avln_node_t *) node, &symbol_tree );
copy_to_pool( symbol_pool, &symbol_entry, 1, NULL );
if (get_list_length( atoms ) > 1)
{
/* Check that there is no identical atom list. */
atoms_node = (atoms_node_t *) atoms_tree;
while (atoms_node != NULL)
{
result = compare_atom_lists( atoms, atoms_node->atoms );
if (result < 0)
atoms_node = (atoms_node_t *) atoms_node->node.left;
else if (result > 0)
atoms_node = (atoms_node_t *) atoms_node->node.right;
else
{
complain( "Atom list is the same as for \"%s\".",
atoms_node->name );
}
}
/* Create new atoms node. */
atoms_node = new_mem( sizeof( atoms_node_t ) );
atoms_node->atoms = node->atoms;
atoms_node->name = node->node.name;
atoms_node->symbol = node->symbol;
insert_avl_node( (avl_node_t *) atoms_node, &atoms_tree,
compare_by_atoms );
}
}
}
/*---------------------------------------------------------------------------*/
static void
parse_atom_list( value_t *atom_list_p )
/* Stack effects: (nothing) -> LIST.
* Parse a list of symbols. Return it as *ATOM_LIST_P. */
{
int_t i;
top = 0;
test_token( '<' );
do
{
read_next_token();
test_token( TOK_IDENT );
push_symbol_value( find_atomic_symbol( token_name ) );
/* Test if SYMBOL already occurs in symbol list. */
for (i = 0; i < top-1; i++)
{
if (values_equal( value_stack[ top - 1 ], value_stack[i] ))
complain( "Symbol \"%s\" twice in atom list.", token_name );
}
/* Read after TOKEN_NAME. */
read_next_token();
} while (next_token == ',');
parse_token( '>' );
if (top < 2)
complain( "Atom list must contain at least two atoms." );
build_list( top );
*atom_list_p = value_stack[0];
}
/*---------------------------------------------------------------------------*/
static void
parse_symbols( void )
/* Parse a symbol file. */
{
string_t file_name, symbol_name;
value_t atom_list;
while (next_token != EOF)
{
if (next_token == TOK_INCLUDE)
{
/* Include a new file. */
read_next_token();
test_token( TOK_STRING );
file_name = absolute_path( token_string, current_file_name() );
read_next_token();
begin_include( file_name );
parse_symbols();
end_include();
free_mem( &file_name );
parse_token( ';' );
}
else
{
/* Read a symbol. */
test_token( TOK_IDENT );
symbol_name = new_string( token_name, NULL );
read_next_token();
if (next_token == TOK_ASSIGN)
{
read_next_token();
parse_atom_list( &atom_list );
}
else
atom_list = NULL;
enter_symbol( symbol_name, atom_list );
free_mem( &symbol_name );
parse_token( ';' );
}
}
}
/*---------------------------------------------------------------------------*/
static void
write_symbols( string_t file_name )
/* Write symbol table to file FILE_NAME. */
{
FILE *stream;
symbol_header_t symbol_header;
stream = open_stream( file_name, "wb" );
/* Set rule file header data. */
set_header( &symbol_header.common_header, SYMBOL_FILE, SYMBOL_CODE_VERSION );
symbol_header.symbol_count = pool_item_count( symbol_pool );
symbol_header.values_size = pool_item_count( value_pool );
symbol_header.strings_size = pool_item_count( string_pool );
/* Write header. */
write_vector( &symbol_header, sizeof( symbol_header ), 1, stream,
file_name );
/* Write tables to stream. */
write_pool( symbol_pool, stream, file_name );
write_pool( value_pool, stream, file_name );
write_pool( string_pool, stream, file_name );
close_stream( &stream, file_name );
}
/*---------------------------------------------------------------------------*/
static void
init_sym_compiler( void )
/* Initialise this module. */
{
symbol_pool = new_pool( sizeof( symbol_entry_t ) );
value_pool = new_pool( sizeof( symbol_t ) );
string_pool = new_pool( sizeof( char_t ) );
}
/*---------------------------------------------------------------------------*/
static void free_tree( avl_node_t *node )
{
if (node == NULL)
return;
free_tree( node->left );
free_tree( node->right );
free_mem( &node );
}
/*---------------------------------------------------------------------------*/
static void
terminate_sym_compiler( void )
/* Terminate this module. */
{
free_tree( (avl_node_t *) symbol_tree );
symbol_tree = NULL;
free_tree( (avl_node_t *) atoms_tree );
atoms_tree = NULL;
free_pool( &symbol_pool );
free_pool( &value_pool );
free_pool( &string_pool );
}
/*---------------------------------------------------------------------------*/
void
compile_symbol_file( string_t source_file, string_t object_file,
string_t old_symbol_file )
/* Read symbol file SOURCE_FILE and create translated file OBJECT_FILE.
* If OLD_SYMBOL_FILE != NULL, all symbols from this file are included in
* the new file. */
{
value_t atoms;
symbol_t symbol;
init_sym_compiler();
if (old_symbol_file != NULL)
{
/* Enter the symbols from OLD_SYMBOL_FILE. */
init_symbols( old_symbol_file );
init_hangul();
for (symbol = 0; symbol < symbol_count(); symbol++)
{
atoms = get_atoms( symbol );
if (get_list_length( atoms ) <= 1)
atoms = NULL;
enter_symbol( get_symbol_name( symbol ), atoms );
}
terminate_symbols();
set_esym_stamp();
}
else
{
/* Enter the standard symbols in the same order as in "values.h". */
enter_symbol( "nil", NULL );
enter_symbol( "yes", NULL );
enter_symbol( "no", NULL );
enter_symbol( "symbol", NULL );
enter_symbol( "string", NULL );
enter_symbol( "number", NULL );
enter_symbol( "list", NULL );
enter_symbol( "record", NULL );
set_sym_stamp();
}
begin_include( source_file );
TRY
{
parse_symbols();
if (next_token != EOF)
complain( "Symbol definition expected." );
}
IF_ERROR
{
print_text( error_text, " (\"%s\", line %d, column %d)",
name_in_path( current_file_name() ),
current_line_number(), current_column() );
if (in_emacs_malaga_mode)
{
printf( "SHOW \"%s\":%d:%d\n", current_file_name(),
current_line_number(), current_column() );
}
}
FINALLY
end_includes();
END_TRY;
write_symbols( object_file );
terminate_sym_compiler();
terminate_hangul();
}
/* End of file. =============================================================*/