source: downloads/openal-0.0.8/src/al_config.c @ 17

/* -*- mode: C; tab-width:8; c-basic-offset:8 -*-
 * vi:set ts=8:
 *
 * al_config.c
 *
 * Handling of the configuration file and alrc configuration variables.
 *
 * FIXME: make thread safe
 *        needs to be more robust.
 *        leaks memory
 *        needs gc
 *
 */
#include "al_siteconfig.h"

#include <AL/al.h>
#include <ctype.h>
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#include <sys/stat.h>
#include <unistd.h>
#include <string.h>

#include "al_main.h"
#include "al_ext.h"
#include "al_config.h"
#include "al_error.h"
#include "al_debug.h"

#ifndef __MORPHOS__
#define _AL_FNAME "openalrc"
#else
#define _AL_FNAME "OpenAL.prefs"
#endif

#ifndef PATH_MAX
#define PATH_MAX 4096
#endif

#define alrc_cadr(ls) alrc_car(alrc_cdr(ls))

/*
 * our symbol table definition.  Simple binary tree.
 */
typedef struct _AL_SymTab {
        char str[ALRC_MAXSTRLEN + 1];
        AL_rctree *datum;

        struct _AL_SymTab *left;
        struct _AL_SymTab *right;
} AL_SymTab;

/*
 * root is our scratch space for evaluating expressions.
 */
static AL_rctree *root = NULL;

/*
 * symbols with global scope.
 */
static AL_SymTab *glsyms;

/*
 * _alOpenRcFile( void );
 *
 * Opens any openalrc file and returns its contents.
 */
static char *_alOpenRcFile( void );

/*
 * _alEval( AL_rctree *head )
 *
 * Evaluate an expression in AL_rctree form.
 */
static AL_rctree *_alEval( AL_rctree *head );

/*
 * _alSymbolTableAlloc( void )
 *
 * Allocate and return a new symbol table object.
 */
static AL_SymTab *_alSymbolTableAlloc( void );

/*
 * _alSymbolTableAdd( AL_SymTab *table,
 *                    const char *symname,
 *                    AL_rctree *datum )
 *
 * Adds binding for symbol named by str to table, returning the table.
 */
static AL_SymTab *_alSymbolTableAdd( AL_SymTab *table,
                                          const char *symname,
                                          AL_rctree *datum );

/*
 * _alSymbolTableRemove( AL_SymTab *table, const char *sym )
 *
 * Removes binding for symbol named by sym from table.
 */
static AL_SymTab *_alSymbolTableRemove( AL_SymTab *table, const char *sym );

/*
 * _alSymbolTableGet( AL_SymTab *head, const char *str )
 *
 * Returns the definition associated with the symbol named by str, or NULL if
 * no such definition exists.
 */
static AL_rctree *_alSymbolTableGet( AL_SymTab *head, const char *str );

/*
 * _alSymbolTableDestroy( AL_SymTab *head )
 *
 * Destroys the symbol table head.
 */
static void _alSymbolTableDestroy( AL_SymTab *head );

/*
 * is_string( const char *tokenname )
 *
 * Returns AL_TRUE if tokenname describes a string, AL_FALSE otherwise.  A
 * string in this context means any data contained between two quotation
 * marks.
 */
static ALboolean is_string( const char *tokenname );

/*
 * is_int( const char *tokenname )
 *
 * Returns AL_TRUE if tokenname describes an integer (either base 10 or 16),
 * AL_FALSE otherwise.
 */
static ALboolean is_int( const char *tokenname );

/*
 * is_float( const char *tokenname )
 *
 * Returns AL_TRUE if tokenname describes a float, AL_FALSE otherwise.
 */
static ALboolean is_float( const char *tokenname );

/*
 * is_lispchar( int ch )
 *
 * Returns AL_TRUE if ch is ( or ), AL_FALSE otherwise.
 */
static ALboolean is_lispchar( int ch );

/*
 * is_whitespace( int ch )
 *
 * Returns AL_TRUE if ch is any form of whitespace, AL_FALSE otherwise.
 */
static ALboolean is_whitespace( int ch );

/*
 * AL_rctree_copy( AL_rctree *src )
 *
 * Returns a copy of src, including car and cdr sections.
 */
static AL_rctree *AL_rctree_copy( AL_rctree *src );

/*
 * buildExp( const char *tokenstr, unsigned int *offset )
 *
 * Builds an AL_rctree representation of the alrc expression in
 * tokenstr[*offset], setting *offset to the last scanned position, or NULL if
 * tokenstr[*offset...] does not describe a valid alrc expression.
 */
static AL_rctree *buildExp( const char *tokenstr, unsigned int *offset );

/*
 * getTokenStr( const char *data, char *retbuf,
 *              ALuint *offset, ALuint size )
 *
 * copies the next alrc token from data[*offset] to retbuf, not exceeding
 * size ( size is the length of retbuf ), and returning the length of the
 * token.  -1 is returned on error.
 *
 */
static int getTokenStr( const char *data, char *retbuf,
                        ALuint *offset, ALuint size );

/*
 * literalExp( const char *foo )
 *
 * Creates and returns an AL_rctree * with the value described by foo.  Let's
 * just say that foo had better describe self-evaluating.
 */
static AL_rctree *literalExp( const char *foo );

/*
 * selfEvaluating( AL_rctree *head )
 *
 * Return AL_TRUE if the alrc token head is self-evaluating ( integer, float,
 * string, bool, or primitive ), AL_FALSE otherwise.
 */
static ALboolean selfEvaluating( AL_rctree *head );

/*
 * apply( AL_rctree *proc, AL_rctree *args )
 *
 * Calls procedure proc with arguments args, returning return.
 */
static AL_rctree *apply( AL_rctree *proc, AL_rctree *args );

/*
 * length( AL_rctree *ls )
 *
 * Returns length of list ls, or 0 if ls is not a cons cell.
 */
static ALuint length( AL_rctree *ls );

/**
 * primitives
 */

/*
 * and_prim( AL_rctree *env, AL_rctree *args )
 *
 * Evaluates each car in the list args, returning NULL if any evaluation is
 * NULL or #f, something else otherwise.
 */
static AL_rctree *and_prim( AL_rctree *env, AL_rctree *args );

/*
 * define_prim( AL_rctree *env, AL_rctree *args )
 *
 * Defines the car of args to be the evaluation of the cadr of args,
 * returning said evaluation.
 */
static AL_rctree *define_prim( AL_rctree *env, AL_rctree *args );

/*
 * load_ext_prim( AL_rctree *env, AL_rctree *args );
 *
 * Loads an extension library named by ( eval ( car args ) ).
 */
static AL_rctree *load_ext_prim( AL_rctree *env, AL_rctree *args );

/*
 * quote_prim( AL_rctree *env, AL_rctree *args )
 *
 * Evaluates to args.
 */
static AL_rctree *quote_prim( AL_rctree *env, AL_rctree *args );

/* symbols to be defined as primitives */
static struct _global_table {
        const char *symname;
        alrc_prim datum;
} global_primitive_table[] = {
        { "and",             and_prim      },
        { "define",          define_prim   },
        { "load-extension",  load_ext_prim },
        { "quote",           quote_prim    },
        {  NULL,  NULL }
};

/* string defining the default environment */
static const char *default_environment =
        "(define speaker-num 2)"
        "(define display-banner #t)"
        "(define source-gain 1.0)";

/* FIXME: get rid of this */
const AL_rctree scmtrue = { ALRC_BOOL, { 1 } };

/*
 * _alParseConfig( void )
 *
 * Parse the openalrc config file, if any.  Returns AL_TRUE if one was found
 * and contained valid openalrc syntax, AL_FALSE otherwise.
 *
 * FIXME: clean this up.
 */
ALboolean _alParseConfig( void ) {
        AL_rctree *temp;
        ALboolean retval;
        char *rcbuf;
        int i;

        if(root != NULL) {
                /* already been here */
                return AL_TRUE;
        }

        for(i = 0; global_primitive_table[i].symname != NULL; i++) {
                temp = _alRcTreeAlloc();

                temp->type = ALRC_PRIMITIVE;
                temp->data.proc = global_primitive_table[i].datum;

                glsyms = _alSymbolTableAdd( glsyms,
                                   global_primitive_table[i].symname,
                                   temp );
        }

        /* now, evaluate our default environment */
        root = _alEvalStr( default_environment );
        if(root == NULL) {
                _alDebug(ALD_CONFIG, __FILE__, __LINE__, "Invalid default");
                return AL_FALSE;
        }

        _alRcTreeFree( root );
        root = NULL;

        /* now, parse user's config */
        rcbuf = _alOpenRcFile();
        if(rcbuf == NULL) {
                return AL_FALSE;
        }

        root = _alEvalStr( rcbuf );

        retval = AL_TRUE;
        if(root == NULL) {
                retval = AL_FALSE;
        }

        _alRcTreeFree( root );
        root = NULL;

        free( rcbuf );

        return retval;
}

/*
 * _alOpenRcFile( void );
 *
 * Opens any openalrc file and returns its contents.
 */
static char *_alOpenRcFile( void ) {
        FILE *fh = NULL;
        struct stat buf;
        static char pathname[PATH_MAX];
        char *retval = NULL;
        unsigned long filelen = 0;
        int i;

#ifndef __MORPHOS__
        /*
         * try home dir
         */
        snprintf(pathname, sizeof(pathname), "%s/.%s", getenv("HOME"), _AL_FNAME);
#else
        snprintf(pathname, sizeof(pathname), "ENV:%s", _AL_FNAME);
#endif
        if(stat(pathname, &buf) != -1) {
                fh = fopen(pathname, "rb");

                /* for later malloc, get size */
                filelen = buf.st_size;
        } else {
                /* try system wide OpenAL config file */
                snprintf(pathname, sizeof(pathname), "/etc/%s", _AL_FNAME);
                if(stat(pathname, &buf) != -1) {
                        fh = fopen(pathname, "rb");

                        /* for later malloc, get size */
                        filelen = buf.st_size;
                }
        }

        if( fh == NULL ) {
                return NULL;
        }

        retval = malloc(filelen + 1);
        if(retval == NULL) {
                return NULL;
        }

        fread(retval, filelen, 1, fh);
        retval[filelen] = '\0';

        fclose( fh );

        i = strlen( retval );

        /* trim newlines */
        while(retval[--i] == '\n') {
                retval[i] = '\0';
        }

        return retval;
}

/*
 * is_float( const char *tokenname )
 *
 * Returns AL_TRUE if tokenname describes a float, AL_FALSE otherwise.
 */
static ALboolean is_float( const char *tokenname ) {
        int i = strlen( tokenname );
        int c;

        while(i--) {
                c = tokenname[i];

                if((isdigit(c) == 0) &&
                        (c != '-')   &&
                        (c != '.')) {
                        return AL_FALSE;
                }
        }

        return AL_TRUE;
}

/*
 * is_int( const char *tokenname )
 *
 * Returns AL_TRUE if tokenname describes an integer (either base 10 or 16),
 * AL_FALSE otherwise.
 */
ALboolean is_int( const char *tokenname ) {
        int i = strlen(tokenname);
        int c;

        while(i--) {
                c = tokenname[i];

                if(isdigit(c) == 0) {
                        return AL_FALSE;
                }
        }

        return AL_TRUE;
}

/*
 * is_string( const char *tokenname )
 *
 * Returns AL_TRUE if tokenname describes a string, AL_FALSE otherwise.  A
 * string in this context means any data contained between two quotation
 * marks.
 */
ALboolean is_string( const char *tokenname ) {
        int i = strlen( tokenname );
        int c;

        if(tokenname[0] != '"') {
                return AL_FALSE;
        }

        while(i--) {
                c = tokenname[i];

                if((isgraph(c) == 0) &&
                   (isspace(c) == 0)) {
                        _alDebug(ALD_CONFIG, __FILE__, __LINE__,
                                "tokenname %s failed at %d '%c'",
                                tokenname, i, tokenname[i]);

                        return AL_FALSE;
                }
        }

        return AL_TRUE;
}

/*
 * is_lispchar( int ch )
 *
 * Returns AL_TRUE if ch is ( or ), AL_FALSE otherwise.
 */
static ALboolean is_lispchar( int ch ) {
        switch(ch) {
                case ')':
                case '(':
                        return AL_TRUE;
                default:
                        break;
        }

        return AL_FALSE;
}

/*
 * is_whitespace( int ch )
 *
 * Returns AL_TRUE if ch is any form of whitespace, AL_FALSE otherwise.
 */
static ALboolean is_whitespace( int ch ) {
        switch(ch) {
                case ' ':
                case '\t':
                case '\n':
                case '\r':
                        return AL_TRUE;
                default:
                        break;
        }

        return AL_FALSE;
}

/*
 * Returns AL_TRUE if foo[offset...] describes a float.  Instead of simply
 * being limited to the NUL character, any form of whitespace or moving into
 * foo[len] is also a terminating condition.
 */
static int is_floatWS( const char *foo, ALuint offset, size_t len ) {
        int decimalPoints = 0;
        ALuint i = offset;

        if ( offset >= len ) {
                return -1;
        }

        if( foo[i] == '-' ) {
                i++;
        }

        while( foo[i] && !is_whitespace( foo[i] ) && ( i < len ) ) {
                if(!isdigit( (int) foo[i] )) {
                        if( foo[i] == '.' ) {
                                if( decimalPoints > 1 ) {
                                        return -1;
                                }

                                decimalPoints++;
                        } else {
                                return -1;
                        }
                }

                i++;
        }

        return i - offset;
}

/*
 * _alGlobalBinding( const char *str )
 *
 * If str names an existing alrc symbol, return a pointer to the value
 * associated with that symbol.  Otherwise, return NULL.
 *
 */
AL_rctree *_alGlobalBinding( const char *str ) {
        AL_rctree *retval;

        retval =  _alSymbolTableGet( glsyms, str );

        if( retval == NULL ) {
                _alDebug( ALD_CONFIG, __FILE__, __LINE__,
                          "could not resolve %s", str );
        }

        return retval;
}

/*
 * _alSymbolTableGet( AL_SymTab *head, const char *str )
 *
 * Returns the definition associated with the symbol named by str, or NULL if
 * no such definition exists.
 */
static AL_rctree *_alSymbolTableGet( AL_SymTab *head, const char *str ) {
        int i;

        if(head == NULL) {
                return NULL;
        }

        i = strncmp(head->str, str, ALRC_MAXSTRLEN);

        if(i < 0) {
                return _alSymbolTableGet(head->left, str);
        } else if (i == 0) {
                return head->datum;
        } else if (i > 0) {
                return _alSymbolTableGet(head->right, str);
        }

        return NULL;
}

/*
 * _alSymbolTableAdd( AL_SymTab *table, const char *sym, AL_rctree *datum )
 *
 * Adds binding for symbol named by sym to table, returning the table.
 *
 * Since AL_SymTab is a simple binary tree, this is a simple recursive
 * function.
 */
static AL_SymTab *_alSymbolTableAdd( AL_SymTab *head, const char *sym,
                                     AL_rctree *datum ) {
        int i;

        if(head == NULL) {
                head = _alSymbolTableAlloc();

                strncpy( head->str, sym, ALRC_MAXSTRLEN );

                head->datum = AL_rctree_copy( datum );

                return head;
        }

        i = strncmp(head->str, sym, ALRC_MAXSTRLEN);

        if(i < 0) {
                head->left = _alSymbolTableAdd( head->left, sym, datum);

                return head;
        }

        if(i == 0) {
                strncpy(head->str, sym, ALRC_MAXSTRLEN);

                head->datum = AL_rctree_copy( datum );

                return head;
        }

        if(i > 0) {
                head->right = _alSymbolTableAdd( head->right, sym, datum );
                return head;
        }

        return NULL;
}

/*
 * _alSymbolTableAlloc( void )
 *
 * Allocate and return a new symbol table object.
 */
AL_SymTab *_alSymbolTableAlloc( void ) {
        AL_SymTab *retval;

        retval = malloc( sizeof *retval );
        if(retval == NULL) {
                return NULL;
        }

        memset( retval->str, 0, ALRC_MAXSTRLEN + 1 );

        retval->datum = NULL;
        retval->left  = NULL;
        retval->right = NULL;

        return retval;
}

/*
 * define_prim( AL_rctree *env, AL_rctree *args )
 *
 * Defines the car of args to be the evaluation of the cadr of args,
 * returning said evaluation.
 */
static AL_rctree *define_prim( UNUSED(AL_rctree *env), AL_rctree *args ) {
        AL_rctree *symbol;
        AL_rctree *retval;

        symbol = alrc_car( args );
        retval = _alEval( alrc_cadr( args ) );

        if((symbol == NULL) || (retval == NULL)) {
                _alDebug(ALD_CONFIG, __FILE__, __LINE__,
                        "define_prim fail" );

                return NULL;
        }

        glsyms = _alSymbolTableAdd( glsyms,
                                symbol->data.str.c_str,
                                retval );

        _alDebug( ALD_CONFIG, __FILE__, __LINE__,
                        "define %s", symbol->data.str.c_str );

        return retval;
}

/*
 * and_prim( AL_rctree *env, AL_rctree *args )
 *
 * Evaluates each car in the list args, returning NULL if any evaluation is
 * NULL or #f, something else otherwise.
 */
static AL_rctree *and_prim( UNUSED(AL_rctree *env), AL_rctree *args ) {
        AL_rctree *result = NULL;
        AL_rctree *itr;
        AL_rctree *temp;
        ALboolean keepgoing = AL_TRUE;

        itr = args;
        while(itr && (keepgoing == AL_TRUE)) {
                temp = alrc_cdr( itr );

                result = _alEval( alrc_car( itr ) );

                if( result == NULL ) {
                        result         = _alRcTreeAlloc();
                        result->type   = ALRC_BOOL;
                        result->data.i = AL_FALSE;

                        _alDebug( ALD_CONFIG, __FILE__, __LINE__,
                                "and_prim false" );

                        return result;
                }

                itr = temp;

        }

        result         = _alRcTreeAlloc();
        result->type   = ALRC_BOOL;
        result->data.i = AL_TRUE;

        return result;
}


/*
 * _alDestroyConfig( void )
 *
 * Deallocate the memory reserved in the call to _alParseConfig, as well as
 * any alrc objects that have been created since that point.
 */
void _alDestroyConfig( void ) {
        _alSymbolTableDestroy( glsyms );
        glsyms = NULL;

        _alRcTreeDestroyAll(); /* gc replacement.  sigh */

        return;
}

/*
 * _alSymbolTableDestroy( AL_SymTab *head )
 *
 * Destroys the symbol table head.
 */
static void _alSymbolTableDestroy( AL_SymTab *head ) {
        if( head == NULL ) {
                return;
        }

        if( head->left ) {
                _alSymbolTableDestroy( head->left );
        }
        if( head->right ) {
                _alSymbolTableDestroy( head->right );
        }

        free( head );

        return;
}



/*
 * load_ext_prim( AL_rctree *env, AL_rctree *args );
 *
 * Loads an extension library named by ( eval ( car args ) ).
 *
 * FIXME: return #t or something?
 */
static AL_rctree *load_ext_prim(UNUSED(AL_rctree *env), AL_rctree *args) {
        AL_rctree *retval;
        static char fname[128]; /* FIXME */
        char *symname;
        size_t len;

        if(args->type != ALRC_STRING) {
                _alDebug(ALD_CONFIG, __FILE__, __LINE__,
                        "syntax error: load_ext_prim passed type is 0x%x",
                        args->type);

                return NULL;
        }

        /* skip first and last quote */
        symname = args->data.str.c_str;
        len     = args->data.str.len;

        /* copy data */
        memcpy(fname, symname, len);
        fname[len] = '\0';

        /* prepare retval */

        retval         = _alRcTreeAlloc();
        retval->type   = ALRC_BOOL;
        retval->data.i = AL_TRUE;

        if(_alLoadDL(fname) == AL_FALSE)
        {
                _alDebug(ALD_CONFIG, __FILE__, __LINE__,
                         "Couldn't load %s", fname);

                retval->data.i = AL_FALSE;
        }

        return retval;
}

/*
 * quote_prim( AL_rctree *env, AL_rctree *args )
 *
 * Evaluates to args.
 */
static AL_rctree *quote_prim(UNUSED(AL_rctree *env), AL_rctree *args) {
        return args;
}

/*
 * _alGetGlobalScalar( const char *str, ALRcEnum type, ALvoid *retref )
 *
 * If str names an existing alrc symbol, and type matches the type of that
 * symbol, *retref is populated with the value of that symbol and this call
 * returns AL_TRUE.  Otherwise, AL_FALSE is returned.
 *
 * NOTE: future revisions should replace this with a call to rc_lookup.
 *
 * FIXME: fill out literal support
 */
ALboolean _alGetGlobalScalar( const char *str, ALRcEnum type, ALvoid *retref ) {
        AL_rctree *sym;
        ALfloat *fvp;
        ALint   *ivp;

        if(retref == NULL) {
                return AL_FALSE;
        }

        /* [fi]vp, the dereference helper */
        fvp = retref;
        ivp = retref;

        sym = _alGlobalBinding(str);
        if(sym == NULL) {
                return AL_FALSE;
        }

        switch(sym->type) {
                case ALRC_INTEGER:
                case ALRC_BOOL:
                        switch(type) {
                                case ALRC_INTEGER:
                                case ALRC_BOOL:
                                        *ivp = sym->data.i;
                                        return AL_TRUE;
                                case ALRC_FLOAT:
                                        *fvp = sym->data.i;
                                        return AL_TRUE;
                                default:
                                        return AL_FALSE;
                        }
                case ALRC_FLOAT:
                        switch(type) {
                                case ALRC_INTEGER:
                                case ALRC_BOOL:
                                        *ivp = sym->data.f;
                                        return AL_TRUE;
                                case ALRC_FLOAT:
                                        *fvp = sym->data.f;
                                        return AL_TRUE;
                                default:
                                        return AL_FALSE;
                        }
                default:
                        return AL_FALSE;
        }
}

/*
 * _alDefine( const char *symname, AL_rctree *value )
 *
 * Bind a symbol, named by symname, to the evaluation of value.
 */
AL_rctree *_alDefine( const char *symname, AL_rctree *value ) {
        glsyms = _alSymbolTableAdd( glsyms, symname, _alEval( value ));

        _alDebug( ALD_CONFIG, __FILE__, __LINE__, "defining %s", symname );

        return value;
}

/*
 * selfEvaluating( AL_rctree *head )
 *
 * Return AL_TRUE if the alrc token head is self-evaluating ( integer, float,
 * string, bool, or primitive ), AL_FALSE otherwise.
 */
static ALboolean selfEvaluating( AL_rctree *head ) {
        switch( head->type ) {
                case ALRC_INVALID:
                case ALRC_INTEGER:
                case ALRC_FLOAT:
                case ALRC_STRING:
                case ALRC_BOOL:
                case ALRC_PRIMITIVE:
                        return AL_TRUE;
                        break;
                case ALRC_SYMBOL:
                case ALRC_CONSCELL:
                default:
                        break;
        }

        return AL_FALSE;
}

/*
 * alrc_cons( AL_rctree *ls1, AL_rctree *ls2 )
 *
 * Create and return a cons cell, with the car section pointing to ls1 and the
 * cdr section pointing to ls2.
 */
AL_rctree *alrc_cons( AL_rctree *ls1, AL_rctree *ls2 ) {
        AL_rctree *newc;

        assert( ls1->type == ALRC_CONSCELL );

        if( ls1->data.ccell.cdr == NULL ) {
                newc = ls1->data.ccell.cdr = _alRcTreeAlloc();
                newc->type = ALRC_CONSCELL;

                newc->data.ccell.car = ls2;

                return newc;
        }

        alrc_cons( alrc_cdr(ls1), ls2 );

        return ls1;
}

/*
 * alrc_car( AL_rctree *ls )
 *
 * Return the car section of the cons cell named by ls, or NULL if ls is not a
 * cons cell.
 */
AL_rctree *alrc_car( AL_rctree *ls ) {
        assert( ls->type == ALRC_CONSCELL );

        return ls->data.ccell.car;
}

/*
 * alrc_cdr( AL_rctree *ls )
 *
 * Return the cdr section of the cons cell named by ls, or NULL if ls is not a
 * cons cell.
 */
AL_rctree *alrc_cdr( AL_rctree *ls ) {
        assert( ls->type == ALRC_CONSCELL );

        return ls->data.ccell.cdr;
}

/*
 * apply( AL_rctree *proc, AL_rctree *args )
 *
 * Calls procedure proc with arguments args, returning return.
 */
AL_rctree *apply( AL_rctree *procobj, AL_rctree *args ) {
        AL_rctree *lobj;
        AL_rctree *prototype;
        AL_rctree *body;
        AL_rctree *retval;
        int i;

        if( procobj->type == ALRC_PRIMITIVE ) {
                alrc_prim proc = procobj->data.proc;

                return proc(root, args);
        }

        if( procobj->type != ALRC_CONSCELL) {
                assert(0);

                return NULL;
        }

        lobj      = alrc_cdr( procobj );

        prototype = alrc_car( lobj );
        body      = alrc_cadr( lobj );

        /* lambda expression */
        assert(length(prototype) == length(args));

        /* build bindings */
        i = length( prototype );
        while(i--) {
                glsyms = _alSymbolTableAdd(glsyms,
                        alrc_car(prototype)->data.str.c_str,
                        _alEval( alrc_car( args )));


                prototype = alrc_cdr(prototype);
                args = alrc_cdr(args);
        }

        retval = _alEval( body );

        /* remove bindings */
        prototype = alrc_car( lobj );
        i = length( prototype );
        while(i--) {
                glsyms = _alSymbolTableRemove( glsyms,
                                   alrc_car( prototype )->data.str.c_str );

                prototype = alrc_cdr( prototype );
        }

        return retval;
}

/*
 * length( AL_rctree *ls )
 *
 * Returns length of list ls, or 0 if ls is not a cons cell.
 */
static ALuint
length( AL_rctree *ls )
{
        return ( ls == NULL || ls->type != ALRC_CONSCELL ) ?
                0 :
                ( 1 + length( alrc_cdr( ls ) ));
}

/*
 * _alSymbolTableRemove( AL_SymTab *table, const char *sym )
 *
 * Removes binding for symbol named by sym from table.
 */
AL_SymTab *_alSymbolTableRemove( AL_SymTab *head, const char *sym ) {
        int i;

        if(head == NULL) {
                return NULL;
        }

        i = strncmp( head->str, sym, ALRC_MAXSTRLEN );
        if(i < 0) {
                head->left = _alSymbolTableRemove( head->left, sym );
                return head;
        }
        if(i == 0) {
                free( head );

                return NULL;
        }
        if(i > 0) {
                head->right = _alSymbolTableRemove( head->right, sym );
                return head;
        }

        return head;
}

/*
 * AL_rctree_copy( AL_rctree *src )
 *
 * Returns a copy of src, including car and cdr sections.
 */
static AL_rctree *AL_rctree_copy( AL_rctree *src ) {
        AL_rctree *retval;

        if( src == NULL ) {
                return NULL;
        }

        retval = _alRcTreeAlloc();

        if( src->type == ALRC_CONSCELL ) {
                retval->type = ALRC_CONSCELL;

                retval->data.ccell.car = AL_rctree_copy( src->data.ccell.car );
                retval->data.ccell.cdr = AL_rctree_copy( src->data.ccell.cdr );

                return retval;
        }

        *retval = *src;

        return retval;
}

/*
 * buildExp( const char *tokenstr, unsigned int *offset )
 *
 * Builds an AL_rctree representation of the alrc expression in
 * tokenstr[*offset], setting *offset to the last scanned position, or NULL if
 * tokenstr[*offset...] does not describe a valid alrc expression.
 */
static AL_rctree *buildExp( const char *tokenstr, unsigned int *offset ) {
        AL_rctree *retval = NULL;
        unsigned int len = strlen(tokenstr);
        char *buffer;

        while(is_whitespace(tokenstr[*offset]) && (*offset < len)) {
                (*offset)++;
        }

        /* skip comments */
        while(tokenstr[*offset] == ';') {
                /* FIXME: do dos crlf as well */
                while((tokenstr[*offset] != '\n') && (*offset < len))
                {
                        (*offset)++;
                }

                while(is_whitespace(tokenstr[*offset]) && (*offset < len)) {
                        (*offset)++;
                }
        }

        if((len == 0) || (*offset >= len)) {
                _alDebug( ALD_CONFIG, __FILE__, __LINE__, "NULL here");

                return NULL;
        }

        if(tokenstr[*offset] == '\'') {
                /* quoted */
                (*offset)++;

                retval = _alRcTreeAlloc();
                retval->type = ALRC_CONSCELL;

                retval->data.ccell.car = _alRcTreeAlloc();
                retval->data.ccell.car->type = ALRC_SYMBOL;
                snprintf(retval->data.ccell.car->data.str.c_str, ALRC_MAXSTRLEN,
                        "quote");
                retval->data.ccell.car->data.str.len = 5;

                retval->data.ccell.cdr = buildExp( tokenstr, offset );

                return retval;
        }

        if(tokenstr[*offset] == '(') {
                /* it's a list */
                AL_rctree *foo = NULL;
                AL_rctree *lp  = NULL;
                AL_rctree *rp  = NULL;

                (*offset)++;

                retval = rp = _alRcTreeAlloc();
                retval->type = ALRC_CONSCELL;

                /* cdr */
                while((foo = buildExp(tokenstr, offset)) != NULL) {
                        /*car(rp, foo); */
                        rp->data.ccell.car = foo;

                        /* cdr(rp, l_conscell_alloc(NULL, NULL));*/
                        rp->data.ccell.cdr = _alRcTreeAlloc();
                        rp->data.ccell.cdr->type = ALRC_CONSCELL;

                        lp = rp;
                        rp = rp->data.ccell.cdr;
                }

                if( lp != NULL ) {
                        _alRcTreeFree( lp->data.ccell.cdr );
                        lp->data.ccell.cdr = NULL;
                }

                return (AL_rctree *) retval;
        }

        if(tokenstr[*offset] == ')') {
                (*offset)++;

                return NULL;
        }

        buffer = malloc( len + 1 );

        getTokenStr(tokenstr, buffer, offset, len);

        retval = literalExp( buffer );

        free( buffer );

        return retval;
}

/*
 * literalExp( const char *foo )
 *
 * Creates and returns an AL_rctree * with the value described by foo.  Let's
 * just say that foo had better describe self-evaluating.
 */
static AL_rctree *literalExp( const char *foo ) {
        AL_rctree *retval = _alRcTreeAlloc();

        assert(foo[0] != '(');
        assert(foo[0] != '\'');
        assert(foo[0] != '(');

        if ((foo[0] == '#') && (foo[1] == 'p'))
        {
                long foop = strtol( &foo[2], NULL, 0 );

                retval->type = ALRC_POINTER;
                retval->data.p = (void *) foop;
        }
        else if ((foo[0] == '#') && ((foo[1] == 't') || (foo[1] == 'f')))
        {
                switch(foo[1]) {
                        case 'f':
                                retval->data.b = AL_FALSE;
                                break;
                        case 't':
                                retval->data.b = AL_TRUE;
                                break;
                        default:
                                assert( 0 );
                                _alRcTreeFree( retval );

                                return NULL;
                }

                retval->type = ALRC_BOOL;
        }
        else if (is_int(foo))
        {
                retval->type = ALRC_INTEGER;
                retval->data.i = atoi( foo );
        }
        else if (is_float( foo ))
        {
                retval->type = ALRC_FLOAT;
                retval->data.f = atof( foo );
        }
        else if (is_string(foo))
        {
                retval->type = ALRC_STRING;
                snprintf( retval->data.str.c_str, ALRC_MAXSTRLEN, &foo[1] );

                retval->data.str.len = strlen( foo ) - 2;
        }
        else
        {
                retval->type = ALRC_SYMBOL;
                snprintf( retval->data.str.c_str, ALRC_MAXSTRLEN, foo );

                retval->data.str.len = strlen( foo );
        }

        return retval;
}

/*
 * _alEval( AL_rctree *head )
 *
 * Evaluate an expression in AL_rctree form.
 */
static AL_rctree *_alEval( AL_rctree *head ) {
        AL_rctree *retval;

        if(head == NULL) {
                return NULL;
        }

        if( selfEvaluating( head ) == AL_TRUE ) {
                return head;
        }

        if( head->type == ALRC_CONSCELL ) {
                AL_rctree *procsym = alrc_car( head );
                AL_rctree *args;
                AL_rctree *proc;

                if( procsym == NULL ) {
                        _alDebug( ALD_CONFIG, __FILE__, __LINE__,
                                "trouble" );

                        return NULL;
                }

                proc =  _alGlobalBinding( procsym->data.str.c_str );
                args =  alrc_cdr(head);

                if( proc == NULL ) {
                        _alDebug( ALD_CONFIG, __FILE__, __LINE__,
                                "could not apply %s",
                                alrc_car(head)->data.str.c_str );

                        return NULL;
                }

                return apply( proc, args );
        } else {
                /* symbols are resolved */
                retval = _alGlobalBinding( head->data.str.c_str );
                if(retval == NULL) {
                        _alDebug( ALD_CONFIG, __FILE__, __LINE__,
                                "invalid symbol %s", head->data.str.c_str );
                }

                return retval;
        }
}

/*
 * getTokenStr( const char *data, char *retbuf,
 *              ALuint *offset, ALuint size )
 *
 * copies the next alrc token from data[*offset] to retbuf, not exceeding
 * size ( size is the length of retbuf ), and returning the length of the
 * token.  -1 is returned on error.
 *
 */
static int getTokenStr( const char *data, char *outp,
                 ALuint *offsetp, ALuint size ) {
        ALuint offset = *offsetp;
        int start  = 0;
        int end    = 0;
        int tokenlen = 0;
        size_t retlen = 0;

        while(is_whitespace(data[offset]) && (offset < size)) {
                offset++;
        }

        if((data[offset] == '\'') ||
           (data[offset] == '(')  ||
           (data[offset] == ')'))
        {
                start = offset++;
                end = offset;

        } else if((data[offset] == '#') && (data[offset+1] == 'p')) {
                /* pointer value */
                start = offset;

                offset += 2;

                if((data[offset] == '0') && (data[offset+1] == 'x')) {
                        /* in hex */
                        offset += 2;
                }

                while( isxdigit( (int) data[offset]) && (offset < size))
                {
                        offset++;
                }
        } else if((data[offset] == '#') && ((data[offset+1] == 'f') || (data[offset+1] == 't'))) {
                /* boolean */
                start = offset;

                offset += 2;
        } else if((data[offset] == '0') && (data[offset+1] == 'x')) {
                /* hex numbers */
                start = offset;

                while(isdigit( (int) data[offset]) && (offset < size)) {
                        offset++;
                }
        } else if((tokenlen = is_floatWS( data, offset, size )) > 0)  {
                /* float */
                start = offset;
                offset += tokenlen;

        } else if(data[offset] == '"') {
                /* it's a string */
                start = offset;

                offset++;

                while((data[offset] != '"') && (offset < size)) {
                        offset++;
                }

                offset++; /* get last one too */
        } else {
                start = offset;

                while(!is_whitespace(data[offset]) &&
                      !is_lispchar(data[offset])   &&
                      (offset < size)) {
                        offset++;
                }

        }

        if(offset > size) {
                *offsetp = size;

                /* invalid expression */
                return 0;
        }

        end = offset;

        retlen = end - start;

        memcpy(outp, &data[start], retlen);

        outp[retlen] = '\0';

        *offsetp = offset;

        return strlen( outp );
}

/*
 * _alEvalStr( const char *expression )
 *
 * Evaluate an alrc expression (expression), returning result.
 */
AL_rctree *_alEvalStr( const char *expression ) {
        ALuint offset = 0;
        ALuint len = strlen( expression );
        AL_rctree *retval = NULL;

        while( offset < len ) {
                retval = _alEval( buildExp( expression, &offset ) );
        }

        return retval;
}