Subversion Repositories openrisc_me

//{{{  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;

}

// ----------------------------------------------------------------------------

// Given an existing interpreter, turn it into a safe one. This is a one-way

// transformation.

void

CdlInterpreterBody::make_safe(void)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::make_safe");

    CYG_PRECONDITION_THISC();

    if (0 != Tcl_MakeSafe(tcl_interp)) {

        throw std::bad_alloc();

    }

    CYG_REPORT_RETURN();

}

//}}}

//{{{  CdlInterpreter:: destructor                              

// ----------------------------------------------------------------------------

// Default destructor. It is necessary to worry about any slave

// interpreters, but otherwise there are no complications.

CdlInterpreterBody::~CdlInterpreterBody()

{

    CYG_REPORT_FUNCNAME("CdlInterpreter:: destructor");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    cdlinterpreterbody_cookie   = CdlInterpreterBody_Invalid;

    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;

    // Make sure slave interpreters get deleted before the current one

    for (std::vector<CdlInterpreter>::iterator i = slaves.begin(); i != slaves.end(); i++) {

        delete *i;

        *i = 0;

    }

    Tcl_DeleteAssocData(tcl_interp, cdlinterpreter_assoc_data_key);

    if (owns_interp) {

        Tcl_DeleteInterp(tcl_interp);

    }

    owns_interp = false;

    tcl_interp  = 0;

    CYGDBG_MEMLEAK_DESTRUCTOR();

    CYG_REPORT_RETURN();

}

//}}}

//{{{  CdlInterpreter:: check_this()                            

// ----------------------------------------------------------------------------

// check_this().

bool

CdlInterpreterBody::check_this(cyg_assert_class_zeal zeal) const

{

    if (CdlInterpreterBody_Magic != cdlinterpreterbody_cookie)

        return false;

    CYGDBG_MEMLEAK_CHECKTHIS();

    switch(zeal) {

      case cyg_system_test  :

      case cyg_extreme      :

          if (slaves.size() > 0) {

              for (std::vector<CdlInterpreter>::const_iterator i = slaves.begin(); i != slaves.end(); i++) {

                  if (!(*i)->check_this(cyg_quick)) {

                      return false;

                  }

              }

          }

      case cyg_thorough     :

          if ((0 != toplevel) && !toplevel->check_this(cyg_quick)) {

              return false;

          }

          if ((0 != transaction) && !transaction->check_this(cyg_quick)) {

              return false;

          }

          if ((0 != loadable) && !loadable->check_this(cyg_quick)) {

              return false;

          }

          if ((0 != container) && !container->check_this(cyg_quick)) {

              return false;

          }

          if ((0 != node) && !node->check_this(cyg_quick)) {

              return false;

          }

      case cyg_quick        :

          // For now only the toplevel interpreter should have slaves.

          if ((0 != parent) && (slaves.size() > 0)) {

              return false;

          }

          if( 0 == tcl_interp) {

              return false;

          }

      case cyg_trivial      :

      case cyg_none         :

          break;

    }

    return true;

}

//}}}

//{{{  CdlInterpreter:: set_toplevel() etc.                     

// ----------------------------------------------------------------------------

// Keep track of the current toplevel, container, etc. This gives commands

// added to the Tcl interpreter a simple way of figuring out the current

// state of the world so that properties get added to the right node, etc.

//

// set_toplevel() should only be called once, for the master interpreter

// associated with a toplevel. All slave interpreters inherit this value.

//

// There is no set_loadable(), instead the loadable field is filled in

// by create_slave() and cannot be changed.

CdlToplevel

CdlInterpreterBody::get_toplevel() const

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_toplevel", "result %p");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CdlToplevel result = toplevel;

    CYG_REPORT_RETVAL(result);

    return result;

}

CdlTransaction

CdlInterpreterBody::get_transaction() const

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_transaction", "result %p");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CdlTransaction result = transaction;

    CYG_REPORT_RETVAL(result);

    return result;

}

CdlLoadable

CdlInterpreterBody::get_loadable() const

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter:get_loadable", "result %p");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CdlLoadable result = loadable;

    CYG_REPORT_RETVAL(result);

    return result;

}

CdlContainer

CdlInterpreterBody::get_container() const

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_container", "result %p");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CdlContainer result = container;

    CYG_REPORT_RETVAL(result);

    return result;

}

CdlNode

CdlInterpreterBody::get_node() const

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_node", "result %p");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CdlNode result = node;

    CYG_REPORT_RETVAL(result);

    return result;

}

std::string

CdlInterpreterBody::get_context() const

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::get_context");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CYG_REPORT_RETURN();

    return context;

}

CdlDiagnosticFnPtr

CdlInterpreterBody::get_error_fn_ptr() const

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_error_fn_ptr", "result %p");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CdlDiagnosticFnPtr result = error_fn_ptr;

    CYG_REPORT_RETVAL(result);

    return result;

}

CdlDiagnosticFnPtr

CdlInterpreterBody::get_warning_fn_ptr() const

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_warning_fn_ptr", "result %p");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CdlDiagnosticFnPtr result = warning_fn_ptr;

    CYG_REPORT_RETVAL(result);

    return result;

}

void

CdlInterpreterBody::set_toplevel(CdlToplevel new_toplevel)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::set_toplevel");

    CYG_REPORT_FUNCARG2XV(this, new_toplevel);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITION(0 == toplevel, "changing toplevels is not allowed");

    CYG_PRECONDITION_CLASSC(new_toplevel);

    toplevel = new_toplevel;

    CYG_REPORT_RETURN();

}

void

CdlInterpreterBody::set_transaction(CdlTransaction new_transaction)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::set_transaction");

    CYG_REPORT_FUNCARG2XV(this, new_transaction);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITION_ZERO_OR_CLASSC(new_transaction);

    transaction = new_transaction;

    CYG_REPORT_RETURN();

}

CdlContainer

CdlInterpreterBody::push_container(CdlContainer new_container)

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_container", "result %p");

    CYG_REPORT_FUNCARG2XV(this, new_container);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITION_CLASSC(new_container);

    CdlContainer result = container;

    container = new_container;

    CYG_REPORT_RETVAL(result);

    return result;

}

void

CdlInterpreterBody::pop_container(CdlContainer old_container)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_container");

    CYG_REPORT_FUNCARG2XV(this, old_container);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITION_ZERO_OR_CLASSC(old_container);

    CYG_PRECONDITIONC(0 != container);

    container = old_container;

    CYG_REPORT_RETURN();

}

CdlNode

CdlInterpreterBody::push_node(CdlNode new_node)

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_node", "result %p");

    CYG_REPORT_FUNCARG2XV(this, new_node);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITION_CLASSC(new_node);

    CdlNode result = node;

    node = new_node;

    CYG_REPORT_RETVAL(result);

    return result;

}

void

CdlInterpreterBody::pop_node(CdlNode old_node)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_node");

    CYG_REPORT_FUNCARG2XV(this, old_node);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITIONC(0 != node);

    CYG_PRECONDITION_ZERO_OR_CLASSC(old_node);

    node = old_node;

    CYG_REPORT_RETURN();

}

std::string

CdlInterpreterBody::push_context(std::string new_context)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::push_context");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITIONC("" != new_context);

    std::string result = context;

    context = new_context;

    return result;

}

void

CdlInterpreterBody::pop_context(std::string old_context)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_context");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITIONC("" != context);

    context = old_context;

    CYG_REPORT_RETURN();

}

CdlDiagnosticFnPtr

CdlInterpreterBody::push_error_fn_ptr(CdlDiagnosticFnPtr new_fn_ptr)

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_error_fn_ptr", "result %p");

    CYG_REPORT_FUNCARG2XV(this, new_fn_ptr);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITIONC(0 != new_fn_ptr);

    CdlDiagnosticFnPtr result = error_fn_ptr;

    error_fn_ptr = new_fn_ptr;

    CYG_REPORT_RETVAL(result);

    return result;

}

void

CdlInterpreterBody::pop_error_fn_ptr(CdlDiagnosticFnPtr old_fn_ptr)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_error_fn_ptr");

    CYG_REPORT_FUNCARG2XV(this, old_fn_ptr);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITIONC(0 != error_fn_ptr);

    error_fn_ptr = old_fn_ptr;

    CYG_REPORT_RETURN();

}

CdlDiagnosticFnPtr

CdlInterpreterBody::push_warning_fn_ptr(CdlDiagnosticFnPtr new_fn_ptr)

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_warning_fn_ptr", "result %p");

    CYG_REPORT_FUNCARG2XV(this, new_fn_ptr);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITIONC(0 != new_fn_ptr);

    CdlDiagnosticFnPtr result = warning_fn_ptr;

    warning_fn_ptr = new_fn_ptr;

    CYG_REPORT_RETVAL(result);

    return result;

}

void

CdlInterpreterBody::pop_warning_fn_ptr(CdlDiagnosticFnPtr old_fn_ptr)

{

    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_warning_fn_ptr");

    CYG_REPORT_FUNCARG2XV(this, old_fn_ptr);

    CYG_PRECONDITION_THISC();

    CYG_PRECONDITIONC(0 != warning_fn_ptr);

    warning_fn_ptr = old_fn_ptr;

    CYG_REPORT_RETURN();

}

//}}}

//{{{  CdlInterpreter:: get information                         

// ----------------------------------------------------------------------------

// Get hold of the underlying Tcl interpreter. This makes it easier to

// use miscellaneous Tcl library facilities such as Tcl_SplitList()

Tcl_Interp*

CdlInterpreterBody::get_tcl_interpreter(void) const

{

    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_tcl_interpreter", "interpreter %p");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    Tcl_Interp* result = tcl_interp;

    CYG_REPORT_RETVAL(result);

    return result;

}

//}}}

//{{{  CdlInterpreter:: eval()                                  

// ----------------------------------------------------------------------------

// Evaluate a Cdl script held in a string. The result of this evaluation, 

// e.g. TCL_OK, is returned directly. The string result is made available

// in an in-out parameter.

//

// According to the spec the underlying Tcl_Eval() routine needs to be able

// to make temporary changes to the script, so the latter must be held in

// writable memory. This requires a copy operation.

int

CdlInterpreterBody::eval(std::string script, std::string& str_result)

{

    CYG_REPORT_FUNCNAMETYPE("CdInterpreter::eval", "result %d");

    CYG_REPORT_FUNCARG1XV(this);

    CYG_PRECONDITION_THISC();

    int result  = TCL_OK;

    int size    = script.size();

    // Distinguish between results set by the Tcl interpreter and results

    // set by CDL-related commands running in that interpreter.

    cdl_result = false;

    if (size < 2048) {

        char buf[2048];

        script.copy(buf, size, 0);

        buf[size] = '\0';

        result = Tcl_Eval(tcl_interp, buf);

    } else {

        char* buf = static_cast<char*>(malloc(script.size() + 1));

        if (0 == buf) {

            this->set_result(CdlParse::construct_diagnostic(this, "internal error", "", "Out of memory"));

            result = TCL_ERROR;

        } else {

            script.copy(buf, size, 0);

            buf[size] = '\0';

            result = Tcl_Eval(tcl_interp, buf);

            free(buf);

        }

    }

    // The distinction between TCL_OK and TCL_RETURN is probably not worth

    // worrying about.

    if (TCL_RETURN == result) {

        result = TCL_OK;

    }

    // If we have an error condition that was raised by the Tcl

    // interpreter rather than by the library, it needs to be

    // raised up to the library level. That way the error count

    // etc. are kept accurate.

    if ((TCL_OK != result) && !cdl_result) {

        const char* tcl_result = Tcl_GetStringResult(tcl_interp);

        if ((0 == tcl_result) || ('\0' == tcl_result[0])) {

            tcl_result = "Internal error, no additional information available.";

        }