/* Scratchpad.pmc
 *  Copyright: 2001-2003 The Perl Foundation.  All Rights Reserved.
 *  CVS Info
 *     $Id: scratchpad.pmc,v 1.14 2003/08/28 13:17:01 leo Exp $
 *  Overview:
 *     These are the vtable functions for the Scratchpad base class.
 *  Data Structure and Algorithms:
 *     Currently a simple array of Parrot_Lexicals.
 *  History:
 *  Notes:
 *  References:
 */

#include "parrot/parrot.h"

pmclass Scratchpad need_ext {

    void init () {
        PObj_custom_mark_destroy_SETALL(SELF);
        SELF->cache.int_val = 0;
    }

    void mark () {
	int j;
        struct Parrot_Lexicals * lex;

	for (j = 0; j < SELF->cache.int_val; j++) {
            lex = &(((struct Parrot_Lexicals *)PMC_data(SELF))[j]);
            lexicals_mark(INTERP, lex);
        }
    }

    void destroy () {
        if (PMC_data(SELF))
	    mem_sys_free(PMC_data(SELF));
    }

    void clone (PMC *ret) {
        PObj_custom_mark_destroy_SETALL(ret);
	PMC_data(ret) = mem_sys_allocate(SELF->cache.int_val *
                                     sizeof(struct Parrot_Lexicals));
	ret->cache.int_val = SELF->cache.int_val;
	mem_sys_memcopy(PMC_data(ret), PMC_data(SELF),
			SELF->cache.int_val * sizeof(struct Parrot_Lexicals));
    }

    INTVAL elements () {
	return SELF->cache.int_val;
    }

    PMC* get_pmc () {
	return SELF;
    }

    /*
     * Get a lexical variable. The key types are expected to match
     * one of the following:
     *
     *  - [STRING]     a lexical name
     *  - [INT]        a lexical position in current scope
     *  - [INT;STRING] a scope, and a lexical name
     *  - [INT;INT]    a scope, and a lexical position in that scope
     */
    PMC* get_pmc_keyed (PMC* key) {
	INTVAL pad_index = 0, position = 0;
        STRING * name = NULL;
        PMC * ret = NULL;
        PMC * key2 = key_next(INTERP, key);
        PMC * name_key = key2 ? key2 : key;

        if (key_type(INTERP, name_key) == KEY_integer_FLAG) {
            position = key_integer(INTERP, name_key);
        }
        else if (key_type(INTERP, name_key) == KEY_string_FLAG) {
            name = key_string(INTERP, name_key);
        }
        else {
            internal_exception(-1, "Invalid key");
        }

        if (key2) {
            if (key_type(INTERP, key) == KEY_integer_FLAG) {
                pad_index = key_integer(INTERP, key);
            }
            else {
                internal_exception(-1, "Invalid key");
            }
            ret = scratchpad_get_index(INTERP, SELF, pad_index,
                                       name, position);
        }
        else {
            ret = scratchpad_get(INTERP, SELF, name, position);
        }

        return ret;
    }

    /*
     * Store a value as a lexical variable. The same key types that
     * get_pmc_keyed supports are supported here.
     */
    void set_pmc_keyed (PMC* key, PMC* value) {
	INTVAL pad_index = 0, position = 0;
        STRING * name = NULL;
        PMC * key2 = key_next(INTERP, key);
        PMC * name_key = key2 ? key2 : key;

        if (key_type(INTERP, name_key) == KEY_integer_FLAG) {
            position = key_integer(INTERP, name_key);
        }
        else if (key_type(INTERP, name_key) == KEY_string_FLAG) {
            name = key_string(INTERP, name_key);
        }
        else {
            internal_exception(-1, "Invalid key");
        }

        if (key2) {
            if (key_type(INTERP, key) == KEY_integer_FLAG) {
                pad_index = key_integer(INTERP, key);
            }
            else {
                internal_exception(-1, "Invalid key");
            }
            scratchpad_store_index(INTERP, SELF, pad_index, name,
                                   position, value);
        }
        else {
            scratchpad_store(INTERP, SELF, name, position, value);
        }
    }

    void delete_keyed(PMC* key) {
        STRING * name = NULL;
	INTVAL position;
	struct Parrot_Lexicals * lex;

        if (key_type(INTERP, key) == KEY_integer_FLAG) {
            position = key_integer(INTERP, key);
	    /* TODO */
        }
        else if (key_type(INTERP, key) == KEY_string_FLAG) {
            name = key_string(INTERP, key);
	    scratchpad_delete(INTERP, SELF, name);
        }
        else {
	    return;
	}
    }
}
