Subversion Repositories openrisc_2011-10-31

//{{{  Banner                                                   
 
//============================================================================
//
//      interp.cxx
//
//      Provide access to Tcl interpreters
//
//============================================================================
//####COPYRIGHTBEGIN####
//                                                                          
// ----------------------------------------------------------------------------
// Copyright (C) 2002 Bart Veer
// Copyright (C) 1999, 2000, 2001 Red Hat, Inc.
//
// This file is part of the eCos host tools.
//
// This program is free software; you can redistribute it and/or modify it 
// under the terms of the GNU General Public License as published by the Free 
// Software Foundation; either version 2 of the License, or (at your option) 
// any later version.
// 
// This program is distributed in the hope that it will be useful, but WITHOUT 
// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
// FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for 
// more details.
// 
// You should have received a copy of the GNU General Public License along with
// this program; if not, write to the Free Software Foundation, Inc., 
// 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
//
// ----------------------------------------------------------------------------
//                                                                          
//####COPYRIGHTEND####
//============================================================================
//#####DESCRIPTIONBEGIN####
//
// Author(s):	bartv
// Contact(s):	bartv
// Date:	1999/01/20
// Version:	0.02
//
//####DESCRIPTIONEND####
//============================================================================
 
//}}}
//{{{  #include's                                               
 
// ----------------------------------------------------------------------------
#include "cdlconfig.h"
 
// Get the infrastructure types, assertions, tracing and similar
// facilities.
#include <cyg/infra/cyg_ass.h>
#include <cyg/infra/cyg_trac.h>
 
// <cdl.hxx> defines everything implemented in this module.
// It implicitly supplies <string>, <vector> and <map> because
// the class definitions rely on these headers. It also brings
// in <tcl.h>
#include <cdlcore.hxx>
 
//}}}
 
//{{{  Statics                                                  
 
// ----------------------------------------------------------------------------
// This key is used for accessing AssocData in the Tcl interpreters,
// specifically the CdlInterpreter object.
char* CdlInterpreterBody::cdlinterpreter_assoc_data_key = "__cdlinterpreter";
 
CYGDBG_DEFINE_MEMLEAK_COUNTER(CdlInterpreterBody);
 
//}}}
//{{{  CdlInterpreter:: creation                                
 
// ----------------------------------------------------------------------------
// Default constructor. This will only get invoked via the make() static
// member.
 
CdlInterpreterBody::CdlInterpreterBody(Tcl_Interp* tcl_interp_arg)
{
    CYG_REPORT_FUNCNAME("CdlInterpreter:: default constructor");
    CYG_REPORT_FUNCARG2XV(this, tcl_interp_arg);
    CYG_PRECONDITIONC(0 != tcl_interp_arg);
 
    tcl_interp          = tcl_interp_arg;
    owns_interp         = false;
    parent              = 0;
    toplevel            = 0;
    transaction         = 0;
    loadable            = 0;
    container           = 0;
    node                = 0;
    context             = "";
    error_fn_ptr        = 0;
    warning_fn_ptr      = 0;
    current_commands    = 0;
    cdl_result          = false;
 
    CYGDBG_MEMLEAK_CONSTRUCTOR();
    cdlinterpreterbody_cookie   = CdlInterpreterBody_Magic;
 
    Tcl_SetAssocData(tcl_interp, cdlinterpreter_assoc_data_key, 0, static_cast<ClientData>(this));
 
 
    CYG_POSTCONDITION_THISC();
    CYG_REPORT_RETURN();
}
 
// ----------------------------------------------------------------------------
// Create a new CDL interpreter. The underlying Tcl interpreter can be
// supplied by the caller, or else a suitable interpreter will be created
// with default settings. This default interpreter will only support Tcl,
// not Tk. There is no call to any AppInit() function, no support for
// autoloading packages, the "unknown" command is not implemented, and
// no command files will be read in.
//
// It is convenient to provide immediate access to two Tcl variables,
// cdl_version and cdl_interactive.
 
CdlInterpreter
CdlInterpreterBody::make(Tcl_Interp* tcl_interp_arg)
{
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::make", "interpreter %p");
    CYG_REPORT_FUNCARG1XV(tcl_interp_arg);
 
    Tcl_Interp* tcl_interp = tcl_interp_arg;
    if (0 == tcl_interp) {
        tcl_interp = Tcl_CreateInterp();
        if (0 == tcl_interp) {
            throw std::bad_alloc();
        }
    } else {
        // Make sure that this Tcl interpreter is not already used
        // for another CdlInterpreter object.
        ClientData tmp = Tcl_GetAssocData(tcl_interp, cdlinterpreter_assoc_data_key, 0);
        if (0 != tmp) {
            CYG_FAIL("Attempt to use a Tcl interpreter for multiple CDL interpreters");
            throw std::bad_alloc();
        }
    }
 
    CdlInterpreter result = 0;
    try {
        result = new CdlInterpreterBody(tcl_interp);
 
        std::string version = Cdl::get_library_version();
        if (0 == Tcl_SetVar(tcl_interp, "cdl_version", CDL_TCL_CONST_CAST(char*,version.c_str()), TCL_GLOBAL_ONLY)) {
            throw std::bad_alloc();
        }
        if (0 == Tcl_SetVar(tcl_interp, "cdl_interactive", CDL_TCL_CONST_CAST(char*, (Cdl::is_interactive() ? "1" : "0")),
                            TCL_GLOBAL_ONLY)) {
            throw std::bad_alloc();
        }
    }
    catch(std::bad_alloc) {
        if (0 == tcl_interp_arg) {
            Tcl_DeleteInterp(tcl_interp);
        }
        throw;
    }
    if (0 == tcl_interp_arg) {
        result->owns_interp     = true;
    }
    CYG_POSTCONDITION_CLASSC(result);
    CYG_REPORT_RETVAL(result);
    return result;
}
 
// ----------------------------------------------------------------------------
// Given a toplevel and a loadable, create a new slave interpreter
// for that loadable. There should be master interpreter associated
// with the toplevel already.
//
// FIXME: do slave interpreters automatically see cdl_version and
// cdl_interactive?
 
CdlInterpreter
CdlInterpreterBody::create_slave(CdlLoadable loadable_arg, bool safe)
{
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::create_slave", "slave %p");
    CYG_REPORT_FUNCARG3XV(this, loadable_arg, safe);
    CYG_PRECONDITION_THISC();
    CYG_PRECONDITION(0 == parent, "slave interpreters cannot be created inside slaves");
    CYG_PRECONDITION(0 != toplevel, "CDL's slave interpreters need an associated toplevel");
    CYG_PRECONDITION_CLASSC(loadable_arg);
 
    // Slave interpreters need a name. Use a counter to create them uniquely.
    static cdl_int      next_slave = 1;
    std::string         slave_name;
    Cdl::integer_to_string(next_slave++, slave_name);
    slave_name = "slave" + slave_name;
 
    // FIXME: creating a slave that is not safe appears to fail.
#if 0    
    Tcl_Interp* slave = Tcl_CreateSlave(interp, CDL_TCL_CONST_CAST(char*, slave_name.c_str()), safe);
#else
    Tcl_Interp* slave = Tcl_CreateInterp();
#endif
    if (0 == slave) {
        throw std::bad_alloc();
    }
 
    CdlInterpreter result = 0;
    try {
        result = new CdlInterpreterBody(slave);
    }
    catch(std::bad_alloc) {
        Tcl_DeleteInterp(slave);
        throw;
    }
    result->owns_interp = true;
#if 0    
    try {
        slaves.push_back(result);
    }
    catch(std::bad_alloc) {
        delete result;
        throw;
    }
#endif
 
    result->parent      = this;
    result->set_toplevel(toplevel);
    result->loadable    = loadable_arg;
    result->set_variable("cdl_version", get_variable("cdl_version"));
    result->set_variable("cdl_interactive", get_variable("cdl_interactive"));
 
    CYG_POSTCONDITION_CLASSC(result);
    CYG_REPORT_RETVAL(result);
    return result;
}
 
// -------------------------------------------------------