NAME ^

src/inter_misc.c - Parrot Interpreter miscellaneous functions

DESCRIPTION ^

NCI function setup, compiler registration, interpinfo, and sysinfo opcodes.

Functions ^

*/

#include "parrot/parrot.h" #include "inter_misc.str" #include "../compilers/imcc/imc.h"

/* XXX Put me somewhere else */ void Parrot_NCI_nci_make_raw_nci(PARROT_INTERP, PMC *method, void *func);

/* HEADERIZER HFILE: include/parrot/interpreter.h */

/*

FUNCDOC: register_nci_method

Create an entry in the nci_method_table for the given NCI method of PMC class type.

*/

PARROT_API void register_nci_method(PARROT_INTERP, const int type, void *func, const char *name, const char *proto) { PMC * const method = pmc_new(interp, enum_class_NCI); STRING * const method_name = string_make(interp, name, strlen(name), NULL, PObj_constant_FLAG|PObj_external_FLAG); PMC *proxy;

    /* create call func */
    VTABLE_set_pointer_keyed_str(interp, method,
            string_make(interp, proto, strlen(proto), NULL,
                PObj_constant_FLAG|PObj_external_FLAG),
            func);

    /* insert it into namespace */
    VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
            method_name, method);

    /* Also need to list the method in the PMCProxy PMC's method list, so it
     * can be introspected. */
    proxy = VTABLE_get_pmc_keyed_int(interp, interp->pmc_proxies, type);
    VTABLE_set_pmc_keyed_str(interp, PARROT_PMCPROXY(proxy)->methods,
            method_name, method);
}

PARROT_API void register_raw_nci_method_in_ns(PARROT_INTERP, const int type, void *func, const char *name) { PMC * const method = pmc_new(interp, enum_class_NCI); STRING * const method_name = string_make(interp, name, strlen(name), NULL, PObj_constant_FLAG|PObj_external_FLAG); PMC *proxy;

    /* setup call func */
    Parrot_NCI_nci_make_raw_nci(interp, method, func);

    /* insert it into namespace */
    VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
            method_name, method);

    /* Also need to list the method in the PMCProxy PMC's method list, so it
     * can be introspected. */
    proxy = VTABLE_get_pmc_keyed_int(interp, interp->pmc_proxies, type);
    VTABLE_set_pmc_keyed_str(interp, PARROT_PMCPROXY(proxy)->methods,
            method_name, method);
}

/*

FUNCDOC: Parrot_mark_method_writes

Mark the method name on PMC type type as one that modifies the PMC.

*/

PARROT_API void Parrot_mark_method_writes(PARROT_INTERP, int type, NOTNULL(const char *name)) { STRING *const str_name = const_string(interp, name); PMC *const pmc_true = pmc_new(interp, enum_class_Integer); PMC *const method = VTABLE_get_pmc_keyed_str( interp, interp->vtables[type]->_namespace, str_name); VTABLE_set_integer_native(interp, pmc_true, 1); VTABLE_setprop(interp, method, const_string(interp, "write"), pmc_true); }

/*

FUNCDOC: Parrot_compreg

Register a parser/compiler function.

*/

PARROT_API void Parrot_compreg(PARROT_INTERP, STRING *type, Parrot_compiler_func_t func) { PMC* const iglobals = interp->iglobals; PMC *hash, *nci; STRING *sc;

    hash = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
            IGLOBALS_COMPREG_HASH);
    if (!hash) {
        hash = pmc_new_noinit(interp, enum_class_Hash);
        VTABLE_init(interp, hash);
        VTABLE_set_pmc_keyed_int(interp, iglobals,
                (INTVAL)IGLOBALS_COMPREG_HASH, hash);
    }
    nci = pmc_new(interp, enum_class_Compiler);
    VTABLE_set_pmc_keyed_str(interp, hash, type, nci);
    /* build native call interface for the C sub in "func" */
    sc = CONST_STRING(interp, "PJt");
    VTABLE_set_pointer_keyed_str(interp, nci, sc, (void*)func);
}

/*

FUNCDOC: Parrot_compile_string

Compile code string.

*/

PARROT_API PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC * Parrot_compile_string(PARROT_INTERP, NOTNULL(STRING *type), NOTNULL(const char *code), NOTNULL(STRING **error)) { if (string_compare(interp, const_string(interp, "PIR"), type) == 0) return IMCC_compile_pir_s(interp, code, error);

    if (string_compare(interp,const_string(interp, "PASM"), type) == 0)
        return IMCC_compile_pasm_s(interp, code, error);

    *error=const_string(interp, "Invalid interpreter type");
    return NULL;
}

/*

FUNCDOC: Parrot_compile_file

Compile code file.

*/

PARROT_API PARROT_CANNOT_RETURN_NULL void * Parrot_compile_file(PARROT_INTERP, NOTNULL(const char *fullname), NOTNULL(STRING **error)) { return IMCC_compile_file_s(interp, fullname, error); }

#ifdef GC_IS_MALLOC # if 0 struct mallinfo { int arena; /* non-mmapped space allocated from system */ int ordblks; /* number of free chunks */ int smblks; /* number of fastbin blocks */ int hblks; /* number of mmapped regions */ int hblkhd; /* space in mmapped regions */ int usmblks; /* maximum total allocated space */ int fsmblks; /* space available in freed fastbin blocks */ int uordblks; /* total allocated space */ int fordblks; /* total free space */ int keepcost; /* top-most, releasable (via malloc_trim) * space */ }; # endif extern struct mallinfo mallinfo(void); #endif /* GC_IS_MALLOC */

/*

FUNCDOC: interpinfo

what specifies the type of information you want about the interpreter.

FUNCDOC: interpinfo_p

what specifies the type of information you want about the interpreter.

*/

PARROT_API INTVAL interpinfo(PARROT_INTERP, INTVAL what) { INTVAL ret = 0; int j; Arenas *arena_base = interp->arena_base;

    switch (what) {
        case TOTAL_MEM_ALLOC:
#ifdef GC_IS_MALLOC
#  if 0
            interp->memory_allocated = mallinfo().uordblks;
#  endif
#endif
            ret = arena_base->memory_allocated;
            break;
        case DOD_RUNS:
            ret = arena_base->dod_runs;
            break;
        case LAZY_DOD_RUNS:
            ret = arena_base->lazy_dod_runs;
            break;
        case COLLECT_RUNS:
            ret = arena_base->collect_runs;
            break;
        case ACTIVE_PMCS:
            ret = arena_base->pmc_pool->total_objects -
                arena_base->pmc_pool->num_free_objects;
            break;
        case ACTIVE_BUFFERS:
            ret = 0;
            for (j = 0; j < (INTVAL)arena_base->num_sized; j++) {
                Small_Object_Pool * const header_pool =
                    arena_base->sized_header_pools[j];
                if (header_pool)
                    ret += header_pool->total_objects -
                        header_pool->num_free_objects;
            }
            break;
        case TOTAL_PMCS:
            ret = arena_base->pmc_pool->total_objects;
            break;
        case TOTAL_BUFFERS:
            ret = 0;
            for (j = 0; j < (INTVAL)arena_base->num_sized; j++) {
                Small_Object_Pool * const header_pool =
                    arena_base->sized_header_pools[j];
                if (header_pool)
                    ret += header_pool->total_objects;
            }
            break;
        case HEADER_ALLOCS_SINCE_COLLECT:
            ret = arena_base->header_allocs_since_last_collect;
            break;
        case MEM_ALLOCS_SINCE_COLLECT:
            ret = arena_base->mem_allocs_since_last_collect;
            break;
        case TOTAL_COPIED:
            ret = arena_base->memory_collected;
            break;
        case IMPATIENT_PMCS:
            ret = arena_base->num_early_DOD_PMCs;
            break;
        case EXTENDED_PMCS:
            ret = arena_base->num_extended_PMCs;
            break;
        default:        /* or a warning only? */
            real_exception(interp, NULL, UNIMPLEMENTED,
                    "illegal argument in interpinfo");
    }
    return ret;
}

PARROT_API PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC* interpinfo_p(PARROT_INTERP, INTVAL what) { switch (what) { case CURRENT_SUB: return CONTEXT(interp->ctx)->current_sub; case CURRENT_CONT: { PMC * const cont = CONTEXT(interp->ctx)->current_cont; if (!PMC_IS_NULL(cont) && cont->vtable->base_type == enum_class_RetContinuation) return VTABLE_clone(interp, cont); return cont; } case CURRENT_OBJECT: return CONTEXT(interp->ctx)->current_object; case CURRENT_LEXPAD: return CONTEXT(interp->ctx)->lex_pad; default: /* or a warning only? */ real_exception(interp, NULL, UNIMPLEMENTED, "illegal argument in interpinfo"); } return PMCNULL; }

PARROT_API PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL STRING* interpinfo_s(PARROT_INTERP, INTVAL what) { STRING *fullname, *basename; char *fullname_c; int pos;

    switch (what) {
        case EXECUTABLE_FULLNAME:
            return VTABLE_get_string(interp,
                VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
                    IGLOBALS_EXECUTABLE));
        case EXECUTABLE_BASENAME:
            /* Need to strip back to what follows the final / or \. */
            fullname = VTABLE_get_string(interp,
                VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
                    IGLOBALS_EXECUTABLE));
            fullname_c = string_to_cstring(interp, fullname);
            pos = strlen(fullname_c) - 1;
            while (pos > 0 && fullname_c[pos] != '/' && fullname_c[pos] != '\\')
                pos--;
            if (pos > 0)
                pos++;
            basename = string_from_cstring(interp, fullname_c + pos, 0);
            mem_sys_free(fullname_c);
            return basename;

        case RUNTIME_PREFIX:
            fullname_c = Parrot_get_runtime_prefix(interp, NULL);
            fullname = string_from_cstring(interp, fullname_c, 0);
            mem_sys_free(fullname_c);
            return fullname;
    } /* switch */

    real_exception(interp, NULL, UNIMPLEMENTED,
            "illegal argument in interpinfo");
}

/*

FUNCDOC: sysinfo_i

Returns the system info.

info_wanted is one of:

    PARROT_INTSIZE
    PARROT_FLOATSIZE
    PARROT_POINTERSIZE

In unknown info is requested then -1 is returned.

*/

PARROT_WARN_UNUSED_RESULT INTVAL sysinfo_i(SHIM_INTERP, INTVAL info_wanted) { switch (info_wanted) { case PARROT_INTSIZE: return sizeof (INTVAL); case PARROT_FLOATSIZE: return sizeof (FLOATVAL); case PARROT_POINTERSIZE: return sizeof (void *); default: return -1; } }

/*

FUNCDOC: sysinfo_s

Returns the system info string.

info_wanted is one of:

    PARROT_OS
    PARROT_OS_VERSION
    PARROT_OS_VERSION_NUMBER
    CPU_ARCH
    CPU_TYPE

If unknown info is requested then and empty string is returned.

*/

PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT STRING * sysinfo_s(PARROT_INTERP, INTVAL info_wanted) { switch (info_wanted) { case PARROT_OS: return string_from_literal(interp, BUILD_OS_NAME); case PARROT_OS_VERSION: case PARROT_OS_VERSION_NUMBER: case CPU_ARCH: case CPU_TYPE: default: return CONST_STRING(interp, ""); } }

/* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */


parrot