Skunkware 5/Skunkware 5.iso/src/Tools/ObjectTcl-1.1/OtclClass.C

C/C++ Source or Header | 1995-06-30 | 37.1 KB | 1,240 lines

/*  _ __ ___ _
 * | |\ /  /| |  $Id: OtclClass.C,v 1.12 1995/05/25 08:25:47 deans Exp $
 * | | /  / | |  Copyright (C) 1995 IXI Limited.
 * |_|/__/_\|_|  IXI Limited, Cambridge, England.
 *
 * Component   : OtclClass
 *
 * Author      : Dean Sheehan ([e-mail])
 *
 * Description : Contains the implementation of OtclClass, OtclClassOtcl and
 *               OtclClassCpp. OtclClas is an abstract class. OtclClassOtcl
 *               models classes described in Object Tcl. OtclClassCpp is
 *               abstract and superclassed as a result of C++ code generated
 *               from the CDL processor.
 *
 * License     :
            Object Tcl License & Copyright
            ------------------------------

IXI Object Tcl software, both binary and source (hereafter, Software) is copyrighted by IXI Limited (IXI), and ownership remains with IXI.

IXI grants you (herafter, Licensee) a license to use the Software for academic, research and internal business purposes only, without a fee. Licensee may distribute the binary and source code (if required) to third parties provided that the copyright notice and this statement appears on all copies and that no charge is associated with such copies.

Licensee may make derivative works. However, if Licensee distributes any derivative work based on or derived from the Software, then Licensee will (1) notify IXI regarding its distribution of the derivative work, and (2) clearly notify users that such derivative work is a modified version and not the original IXI Object Tcl distributed by IXI. IXI strongly recommends that Licensee provide IXI the right to incorporate such modifications into future releases of the Software under these license terms.

Any Licensee wishing to make commercial use of the Software should contact IXI, to negotiate an appropriate license for such commercial use. Commercial use includes (1) integration of all or part of the source code into a product for sale or license by or on behalf of Licensee to third parties, or (2) distribution of the binary code or source code to third parties that need it to utilize a commercial product sold or licensed by or on behalf of Licensee.

IXI MAKES NO REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. IXI SHALL NOT BE LIABLE FOR ANY DAMAGES WHATSOEVER SUFFERED BY THE USERS OF THIS SOFTWARE.

Copyright (C) 1995, IXI Limited

By using or copying this Software, Licensee agrees to abide by the copyright law and all other applicable laws of England and the U.S., including, but not limited to, export control laws, and the terms of this license. IXI shall have the right to terminate this license immediately by written notice upon Licensee's breach of, or non-compliance with, any of its terms. Licensee may be held legally responsible for any copyright infringement that is caused or encouraged by Licensee's failure to abide by the terms of this license.

Comments and questions are welcome and can be sent to
[e-mail]

For more information on copyright and licensing issues, contact:
Legal Department, IXI Limited, Vision Park, Cambridge CB4 4ZR,
ENGLAND.

 *
 */

// Tcl Includes
#include <tclInt.h>

// Local Includes
#include "OtclClass.H"
#include "OtclMethod.H"
#include "OtclAttribute.H"
#include "OtclObject.H"
#include "OtclObjMgr.H"
#include "OtclPart.H"

// Class Attribute Definitions
OtclClassCpp *OtclClassCpp::head = NULL;
OtclClassCpp *OtclClassCpp::tail = NULL;
Tcl_HashTable OtclClassOtcl::commandTable;

OtclClass::OtclClass (char *n)
{
   name = strdup(n);
}

OtclClass::~OtclClass ()
{
   if (Otcl::tclInterp != NULL)
      Tcl_DeleteCommand(Otcl::tclInterp,name);
   free(name);
}




OtclClassOtcl::OtclClassOtcl (char *name, Otcl *parent) :
   OtclClass(name)
{
   noOfSuperclasses = 0;
   otcl = parent;
   Tcl_InitHashTable(&instanceMethods,TCL_STRING_KEYS);
   Tcl_InitHashTable(&classMethods,TCL_STRING_KEYS);
   Tcl_InitHashTable(&classAttributes,TCL_STRING_KEYS);
   Tcl_InitHashTable(&instanceAttributeTemplates,TCL_STRING_KEYS);
   otclConstructorMethod = NULL;
   otclDestructorMethod = NULL;
   complete = OTCL_FALSE;
}

OtclClassOtcl::~OtclClassOtcl ()
{
   // free instances! Not sure it would require a list of instances
   // which would be expensive to maintain on creation / deletion of objects,

   // If I keep the objects in command I could put in a command delete
   // proc that deletes the object. This way objs would be cleaned
   // up if the interp is deleted.

   Tcl_HashEntry *entry;
   Tcl_HashSearch search;

   // Clean up methods
   for (entry = Tcl_FirstHashEntry(&instanceMethods,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      delete ((OtclMethod*)Tcl_GetHashValue(entry));
   }
   Tcl_DeleteHashTable(&instanceMethods);
   for (entry = Tcl_FirstHashEntry(&classMethods,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      delete ((OtclMethod*)Tcl_GetHashValue(entry));
   }
   Tcl_DeleteHashTable(&classMethods);


   // Cleanup classAttributes
   for (entry = Tcl_FirstHashEntry(&classAttributes,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      delete ((OtclAttribute*)Tcl_GetHashValue(entry));
   }
   Tcl_DeleteHashTable(&classAttributes);

   // Cleanup instance attributes templates
   for (entry = Tcl_FirstHashEntry(&instanceAttributeTemplates,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      delete ((OtclAttributeTemplate*)Tcl_GetHashValue(entry));
   }
   Tcl_DeleteHashTable(&instanceAttributeTemplates);

   if (otclConstructorMethod != NULL)
   {
      delete otclConstructorMethod;
   }

   if (otclDestructorMethod)
   {
      delete otclDestructorMethod;
   }
}

int OtclClassOtcl::parseInterface (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_RANGE(3,5)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_INTERFACE_ERR);
   }

   if (argc > 3)
   {
     // Should have an "-isA" at argv[2] and a class list at argv[3]
     if (strcmp(argv[2],"-isA") != 0)
     {
         return Otcl::setTclError(interp,ARGS_CLASS_INTERFACE_ERR);
     }

     if (argc != 5)
     {
        // We are missing the class list
        return Otcl::setTclError(interp,ARGS_CLASS_INTERFACE_ERR);
     }

     if (parseIsAList(interp,argv[3]) != TCL_OK)
     {
        return TCL_ERROR;
     }
   }

   placeInterfaceCommandsInScope(interp);

   int returnCode = Tcl_Eval(interp,argv[argc-1]);

   removeInterfaceCommandsFromScope(interp);

   return returnCode;
}

void OtclClassOtcl::placeInterfaceCommandsInScope (Tcl_Interp *interp)
{
   // Need to take all of the global commands out and place our news ones
   // in. This is the easiest way I can see of doing this. Copy out
   // the commands hash table from the interp and initialise a new one in
   // its place.
   memcpy(&commandTable,&((Interp*)interp)->commandTable,sizeof(Tcl_HashTable));
   Tcl_InitHashTable(&((Interp*)interp)->commandTable,TCL_STRING_KEYS);

   // Install new commands
   Tcl_CreateCommand(interp,INSTANCE_METHOD_INTERFACE_CMD,
                     OtclClassOtcl::instanceMethodInterfaceCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,CLASS_METHOD_INTERFACE_CMD,
                     OtclClassOtcl::classMethodInterfaceCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,CONSTRUCTOR_INTERFACE_CMD,
                     OtclClassOtcl::constructorInterfaceCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);
}

void OtclClassOtcl::removeInterfaceCommandsFromScope (Tcl_Interp *interp)
{
   // Remove new commands
   Tcl_DeleteCommand(interp,INSTANCE_METHOD_INTERFACE_CMD);
   Tcl_DeleteCommand(interp,CLASS_METHOD_INTERFACE_CMD);
   Tcl_DeleteCommand(interp,CONSTRUCTOR_INTERFACE_CMD);

   // Delete, cleanup, old the hash table
   Tcl_DeleteHashTable(&((Interp*)interp)->commandTable);

   // Place old commands back in
   memcpy(&((Interp*)interp)->commandTable,&commandTable,sizeof(Tcl_HashTable));
}

int OtclClassOtcl::instanceMethodInterfaceCmd (ClientData cd,
                                               Tcl_Interp *interp,
                                               int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->instanceMethodInterface(interp,argc,argv);
}

int OtclClassOtcl::classMethodInterfaceCmd (ClientData cd,
                                            Tcl_Interp *interp,
                                            int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->classMethodInterface(interp,argc,argv);
}

int OtclClassOtcl::constructorInterfaceCmd (ClientData cd,
                                            Tcl_Interp *interp,
                                            int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->constructorInterface(interp,argc,argv);
}

int OtclClassOtcl::instanceMethodInterface (Tcl_Interp *interp,
                                            int argc, char *argv[])
{
   ARGC_VALUE(3)
   {
      return Otcl::setTclError(interp,ARGS_METHOD_INTERFACE_ERR);
   }

   if (validMethodName(argv[1]) == OTCL_FALSE)
   {
     return Otcl::setTclError(interp,BAD_NAME_FOR_INST_METHOD_ERR,argv[1]);
   }

   int newEntry;
   OtclMethod *otclMethod;
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&classMethods,argv[1]);
   if (hashEntry != NULL)
   {
      Otcl::setTclResult(interp,METHOD_INTERFACE_DUPLICATED_ERR,argv[1],name);
      return TCL_ERROR;
   }
   hashEntry = Tcl_CreateHashEntry(&instanceMethods,argv[1],&newEntry);
   if (newEntry == 1)
   {
      otclMethod = new OtclInstanceMethod(argv[1],OtclMethod::PUBLIC,this);
      Tcl_SetHashValue(hashEntry,otclMethod);
   }
   else
   {
      Otcl::setTclResult(interp,METHOD_INTERFACE_DUPLICATED_ERR,argv[1],name);
      return TCL_ERROR;
   }

   return otclMethod->setFormalArgs(interp,argv[2]);
}

int OtclClassOtcl::classMethodInterface (Tcl_Interp *interp,
                                         int argc, char *argv[])
{
   ARGC_VALUE(3)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_METHOD_INTERFACE_ERR);
   }

   if (validMethodName(argv[1]) == OTCL_FALSE)
   {
      return Otcl::setTclError(interp,BAD_NAME_FOR_CLASS_METHOD_ERR,argv[1]);
   }

   int newEntry;
   OtclMethod *otclMethod;
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&instanceMethods,argv[1]);
   if (hashEntry != NULL)
   {
      Otcl::setTclResult(interp,METHOD_INTERFACE_DUPLICATED_ERR,argv[1],name);
      return TCL_ERROR;
   }
   hashEntry = Tcl_CreateHashEntry(&classMethods,argv[1],&newEntry);
   if (newEntry == 1)
   {
      otclMethod = new OtclClassMethod(argv[1],OtclMethod::PUBLIC,this);
      Tcl_SetHashValue(hashEntry,otclMethod);
   }
   else
   {
      Otcl::setTclResult(interp,METHOD_INTERFACE_DUPLICATED_ERR,argv[1],name);
      return TCL_ERROR;
   }

   return otclMethod->setFormalArgs(interp,argv[2]);
}

int OtclClassOtcl::constructorInterface (Tcl_Interp *interp,
                                         int argc, char *argv[])
{
   ARGC_VALUE(2)
   {
      return Otcl::setTclError(interp,ARGS_CONSTRUCTOR_INTERFACE_ERR);
   }

   if (otclConstructorMethod == NULL)
   {
      otclConstructorMethod = new OtclConstructorMethod(this);
   }
   else
   {
      Otcl::setTclResult(interp,METHOD_INTERFACE_DUPLICATED_ERR,argv[0],name);
      return TCL_ERROR;
   }

   return otclConstructorMethod->setFormalArgs(interp,argv[1]);
}

int OtclClassOtcl::parseImplementation (Tcl_Interp *interp,
                                        int argc, char *argv[])
{
   ARGC_VALUE(3)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_IMPLEMENTATION_ERR);
   }

   if (complete == OTCL_TRUE)
   {
      Otcl::setTclResult(interp,CLASS_ALREADY_COMPLETED_ERR,name);
      return TCL_ERROR;
   }

   placeImplementationCommandsInScope(interp);

   int returnCode = Tcl_Eval(interp,argv[argc-1]);

   removeImplementationCommandsFromScope(interp);

   if (returnCode != TCL_OK)
   {
      return TCL_ERROR;
   }

   if (checkClassCompleteness(interp) == TCL_ERROR)
   {
      return TCL_ERROR;
   }

   addClassCommand(interp);

   complete = OTCL_TRUE;

   return returnCode;
}

int OtclClassOtcl::checkClassCompleteness (Tcl_Interp *interp)
{
   Tcl_HashEntry *entry;
   Tcl_HashSearch search;
   OtclMethod *method;
   char *paramName;

   for (entry = Tcl_FirstHashEntry(&instanceMethods,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      method = (OtclMethod*)Tcl_GetHashValue(entry);

      // Check method completed
      if (method->hasBody() == OTCL_FALSE)
      {
         return Otcl::setTclError(interp,INST_METHOD_NOT_COMPLETED_ERR,
                                  Tcl_GetHashKey(&instanceMethods,entry),
                                  name);
      }

      // Check method doesn't have any param names the same as attribute's
      for (paramName = method->giveFirstFormalArgName();
           paramName != NULL;
           paramName = method->giveNextFormalArgName())
      {
         if (Tcl_FindHashEntry(&instanceAttributeTemplates,paramName) != NULL ||
             Tcl_FindHashEntry(&classAttributes,paramName) != NULL)
         {
            return Otcl::setTclError(interp,FORMAL_ARG_ATTRIB_CLASH_ERR,
                                     Tcl_GetHashKey(&instanceMethods,entry),
                                     name,paramName);
         }
      }

   }
   for (entry = Tcl_FirstHashEntry(&classMethods,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      method = (OtclMethod*)Tcl_GetHashValue(entry);
      if (method->hasBody() == OTCL_FALSE)
      {
         return Otcl::setTclError(interp,CLASS_METHOD_NOT_COMPLETED_ERR,
                                  Tcl_GetHashKey(&classMethods,entry),
                                  name);
      }

      // Check method doesn't have any param names the same as attribute's
      for (paramName = method->giveFirstFormalArgName();
           paramName != NULL;
           paramName = method->giveNextFormalArgName())
      {
         if (Tcl_FindHashEntry(&classAttributes,paramName) != NULL)
         {
            return Otcl::setTclError(interp,FORMAL_ARG_ATTRIB_CLASH_ERR,
                                     Tcl_GetHashKey(&instanceMethods,entry),
                                     name,paramName);
         }
      }

   }
   if (otclConstructorMethod != NULL)
   {
      if (otclConstructorMethod->hasBody() == OTCL_FALSE)
      {
         return Otcl::setTclError(interp,INST_METHOD_NOT_COMPLETED_ERR,
                                  OTCL_CONSTRUCTOR_METHOD_NAME,name);
      }

      // Check method doesn't have any param names the same as attribute's
      for (paramName = otclConstructorMethod->giveFirstFormalArgName();
           paramName != NULL;
           paramName = otclConstructorMethod->giveNextFormalArgName())
      {
         if (Tcl_FindHashEntry(&instanceAttributeTemplates,paramName) != NULL ||
             Tcl_FindHashEntry(&classAttributes,paramName) != NULL)
         {
            return Otcl::setTclError(interp,FORMAL_ARG_ATTRIB_CLASH_ERR,
                                     OTCL_CONSTRUCTOR_METHOD_NAME,
                                     name,paramName);
         }
      }
   }

   return TCL_OK;
}

void OtclClassOtcl::addClassCommand (Tcl_Interp *interp)
{
   Tcl_CreateCommand(interp,name,Otcl::classCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);
}

void OtclClassOtcl::placeImplementationCommandsInScope (Tcl_Interp *interp)
{
   memcpy(&commandTable,&((Interp*)interp)->commandTable,sizeof(Tcl_HashTable));
   Tcl_InitHashTable(&((Interp*)interp)->commandTable,TCL_STRING_KEYS);

   Tcl_CreateCommand(interp,INSTANCE_METHOD_IMPLEMENTATION_CMD,
                     OtclClassOtcl::instanceMethodImplementationCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,CLASS_METHOD_IMPLEMENTATION_CMD,
                     OtclClassOtcl::classMethodImplementationCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,CONSTRUCTOR_IMPLEMENTATION_CMD,
                     OtclClassOtcl::constructorImplementationCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,DESTRUCTOR_IMPLEMENTATION_CMD,
                     OtclClassOtcl::destructorImplementationCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,INSTANCE_ATTRIBUTE_CMD,
                     OtclClassOtcl::instanceAttributeCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,CLASS_ATTRIBUTE_CMD,
                     OtclClassOtcl::classAttributeCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

}

void OtclClassOtcl::removeImplementationCommandsFromScope (Tcl_Interp *interp)
{
   Tcl_DeleteCommand(interp,INSTANCE_METHOD_IMPLEMENTATION_CMD);
   Tcl_DeleteCommand(interp,CLASS_METHOD_IMPLEMENTATION_CMD);
   Tcl_DeleteCommand(interp,CONSTRUCTOR_IMPLEMENTATION_CMD);
   Tcl_DeleteCommand(interp,DESTRUCTOR_IMPLEMENTATION_CMD);
   Tcl_DeleteCommand(interp,INSTANCE_ATTRIBUTE_CMD);
   Tcl_DeleteCommand(interp,CLASS_ATTRIBUTE_CMD);

   // Delete, cleanup, old the hash table
   Tcl_DeleteHashTable(&((Interp*)interp)->commandTable);

   // Place old commands back in
   memcpy(&((Interp*)interp)->commandTable,&commandTable,sizeof(Tcl_HashTable));
}

int OtclClassOtcl::shouldDelete (void)
{
   return OTCL_TRUE;
}

int OtclClassOtcl::parseIsAList (Tcl_Interp *interp, char *classList)
{

   int listArgc;
   char **listArgv;
   if (Tcl_SplitList(interp,classList,&listArgc,&listArgv) != TCL_OK)
   {
      return TCL_ERROR;
   }

   if (listArgc > MAX_SUPERCLASSES)
   {
      Otcl::setTclResult(interp,TOO_MANY_SUPERCLASSES_ERR,name,
                         MAX_SUPERCLASSES);
      free((char*)listArgv);
      return TCL_ERROR;
   }

   if (listArgc== 0)
   {
      Otcl::setTclResult(interp,NO_CLASSES_IN_ISA_LIST_ERR,name);
      free((char*)listArgv);
      return TCL_ERROR;
   }

   noOfSuperclasses = listArgc;
   int i;
   int j;
   for (i = 0; i < listArgc; i++)
   {
      superclass[i] = otcl->giveOtclClass(listArgv[i]);
      if (superclass[i] == NULL || superclass[i]->isComplete() == OTCL_FALSE)
      {
         Otcl::setTclResult(interp,SUPERCLASS_NOT_KNOWN_ERR,name,listArgv[i]);
         free((char*)listArgv);
         return TCL_ERROR;
      }
      for (j = 0; j < i; j++)
      {
         if (superclass[j] == superclass[i])
         {
            Otcl::setTclResult(interp,SUPERCLASS_DUPLICATION_ERR,
                               listArgv[i],name);
            free((char*)listArgv);
            return TCL_ERROR;
         }
      }
   }

   free((char*)listArgv);
   return TCL_OK;
}

int OtclClassOtcl::instanceMethodImplementationCmd (ClientData cd,
                                                    Tcl_Interp *interp,
                                                    int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->instanceMethodImplementation(interp,argc,argv);
}

int OtclClassOtcl::classMethodImplementationCmd (ClientData cd,
                                                 Tcl_Interp *interp,
                                                 int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->classMethodImplementation(interp,argc,argv);
}

int OtclClassOtcl::constructorImplementationCmd (ClientData cd,
                                                 Tcl_Interp *interp,
                                                 int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->constructorImplementation(interp,argc,argv);
}

int OtclClassOtcl::destructorImplementationCmd (ClientData cd,
                                                Tcl_Interp *interp,
                                                int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->destructorImplementation(interp,argc,argv);
}

int OtclClassOtcl::instanceAttributeCmd (ClientData cd,
                                         Tcl_Interp *interp,
                                         int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->instanceAttribute(interp,argc,argv);
}

int OtclClassOtcl::classAttributeCmd (ClientData cd,
                                      Tcl_Interp *interp,
                                      int argc, char *argv[])
{
   OtclClassOtcl *otclClassOtcl = (OtclClassOtcl*)cd;
   return otclClassOtcl->classAttribute(interp,argc,argv);
}

int OtclClassOtcl::classMethod (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_MIN(2)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_METHOD_EXE_ERR);
   }

   // Find the method name as argument 2 (argv[1])
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&classMethods,argv[1]);
   if (hashEntry == NULL)
   {
      Otcl::setTclResult(interp,CLASS_METHOD_NOT_FOUND_ERR,argv[1],name);
      return TCL_ERROR;
   }

   OtclClassMethod *method = (OtclClassMethod*)Tcl_GetHashValue(hashEntry);
   if (method->isAccessible(interp) == OTCL_FALSE)
   {
      Otcl::setTclResult(interp,PRIVATE_METHOD_NO_ACCESS_ERR,argv[1],name);
      return TCL_ERROR;
   }

   createClassScope(interp);
   int resultCode = method->execute(interp,argc-2,(argc > 2 ? &argv[2] : NULL));
   destroyClassScope (interp);

   return resultCode;
}

int OtclClassOtcl::instanceMethodImplementation (Tcl_Interp *interp,
                                                 int argc, char *argv[])
{
   ARGC_VALUE(4)
   {
      return Otcl::setTclError(interp,ARGS_METHOD_IMPLEMENTATION_ERR);
   }

   if (validMethodName(argv[1]) == OTCL_FALSE)
   {
      return Otcl::setTclError(interp,BAD_NAME_FOR_INST_METHOD_ERR,argv[1]);
   }

   int newEntry;
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&classMethods,argv[1]);
   if (hashEntry != NULL)
   {
      OtclMethod *method = (OtclMethod*)Tcl_GetHashValue(hashEntry);
      if (method->hasBody() == OTCL_TRUE)
      {
         return Otcl::setTclError(interp,BODY_ALREADY_SPECIFIED_ERR,argv[1]);
      }
      return Otcl::setTclError(interp,IMP_AS_INST_INT_AS_CLASS_ERR,argv[1]);
   }
   OtclMethod *otclMethod;
   hashEntry = Tcl_CreateHashEntry(&instanceMethods,argv[1],&newEntry);
   if (newEntry == 1)
   {
      otclMethod = new OtclInstanceMethod(argv[1],OtclMethod::PRIVATE,this);
      Tcl_SetHashValue(hashEntry,otclMethod);
   }
   else
   {
      otclMethod = (OtclMethod*)Tcl_GetHashValue(hashEntry);
   }

   int returnCode = otclMethod->setFormalArgs(interp,argv[2]);
   if (returnCode != TCL_OK)
   {
      return returnCode;
   }
   return otclMethod->setBody(interp,argv[3]);
}

int OtclClassOtcl::classMethodImplementation (Tcl_Interp *interp,
                                              int argc, char *argv[])
{
   ARGC_VALUE(4)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_METHOD_IMPLEMENTATION_ERR);
   }

   if (validMethodName(argv[1]) == OTCL_FALSE)
   {
      return Otcl::setTclError(interp,BAD_NAME_FOR_CLASS_METHOD_ERR,argv[1]);
   }

   int newEntry;
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&instanceMethods,argv[1]);
   if (hashEntry != NULL)
   {
      OtclMethod *method = (OtclMethod*)Tcl_GetHashValue(hashEntry);
      if (method->hasBody() == OTCL_TRUE)
      {
         return Otcl::setTclError(interp,BODY_ALREADY_SPECIFIED_ERR,argv[1]);
      }
      return Otcl::setTclError(interp,IMP_AS_CLASS_INT_AS_INST_ERR,argv[1]);
   }

   OtclMethod *otclMethod;
   hashEntry = Tcl_CreateHashEntry(&classMethods,argv[1],&newEntry);
   if (newEntry == 1)
   {
      otclMethod = new OtclClassMethod(argv[1],OtclMethod::PRIVATE,this);
      Tcl_SetHashValue(hashEntry,otclMethod);
   }
   else
   {
      otclMethod = (OtclMethod*)Tcl_GetHashValue(hashEntry);
   }

   int returnCode = otclMethod->setFormalArgs(interp,argv[2]);
   if (returnCode != TCL_OK)
   {
      return returnCode;
   }
   return otclMethod->setBody(interp,argv[3]);
}

int OtclClassOtcl::constructorImplementation (Tcl_Interp *interp,
                                              int argc, char *argv[])
{
   ARGC_VALUE(4)
   {
      return Otcl::setTclError(interp,ARGS_CONSTRUCTOR_IMPLEMENTATION_ERR);
   }

   if (otclConstructorMethod == NULL)
   {
      Otcl::setTclResult(interp,CONSTRUCTOR_NOT_INTERFACED_ERR,name);
      return TCL_ERROR;
   }

   int returnCode = otclConstructorMethod->setFormalArgs(interp,argv[1]);
   if (returnCode != TCL_OK)
   {
      return returnCode;
   }
   returnCode = otclConstructorMethod->setParentConstructors(interp,argv[2]);
   if (returnCode != TCL_OK)
   {
      return returnCode;
   }
   return otclConstructorMethod->setBody(interp,argv[3]);
}

int OtclClassOtcl::destructorImplementation (Tcl_Interp *interp,
                                             int argc, char *argv[])
{
   ARGC_VALUE(2)
   {
      return Otcl::setTclError(interp,ARGS_DESTRUCTOR_ERR);
   }

   if (otclDestructorMethod != NULL)
   {
      Otcl::setTclResult(interp,REDEFINED_DESTRUCTOR_ERR,name);
      return TCL_ERROR;
   }

   otclDestructorMethod = new OtclDestructorMethod(this);

   return otclDestructorMethod->setBody(interp,argv[1]);
}

int OtclClassOtcl::instanceAttribute (Tcl_Interp *interp,
                                      int argc, char *argv[])
{
   ARGC_RANGE(2,3)
   {
      return Otcl::setTclError(interp,ARGS_ATTRIBUTE_ERR);
   }

   if (strcmp(argv[1],OTCL_SELF_ATTRIBUTE) == 0)
   {
      return Otcl::setTclError(interp,ATTRIB_CANNOT_BE_CALLED_ERR,argv[1]);
   }

   int isArray = OTCL_FALSE;
   // check to see if it is an array attribute
   if (argv[1][strlen(argv[1])-1] == ')' &&
       argv[1][strlen(argv[1])-2] == '(')
   {
      argv[1][strlen(argv[1])-2] = '\0';
      isArray = OTCL_TRUE;
   }

   int newEntry;
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&classAttributes,argv[1]);
   if (hashEntry != NULL)
   {
      Otcl::setTclResult(interp,INST_ATTRIB_CLASH_CLASS_ERR,argv[1],name);
      return TCL_ERROR;
   }

   hashEntry = Tcl_CreateHashEntry(&instanceAttributeTemplates,
                                   argv[1],&newEntry);
   OtclAttributeTemplate *temp;
   if (newEntry == 1)
   {
      temp = new OtclAttributeTemplate(interp,isArray,(argc == 3? argv[2] : NULL));
      Tcl_SetHashValue(hashEntry,temp);
   }
   else
   {
      Otcl::setTclResult(interp,INST_ATTRIB_CLASH_ERR,argv[1],name);
      return TCL_ERROR;
   }

   return TCL_OK;
}

int OtclClassOtcl::classAttribute (Tcl_Interp *interp,
                                   int argc, char *argv[])
{
   ARGC_VALUE(3)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_ATTRIBUTE_ERR);
   }

   if (strcmp(argv[1],OTCL_SELF_ATTRIBUTE) == 0)
   {
      return Otcl::setTclError(interp,ATTRIB_CANNOT_BE_CALLED_ERR,argv[1]);
   }

   int isArray = OTCL_FALSE;
   // check to see if it is an array attribute
   if (argv[1][strlen(argv[1])-1] == ')' &&
       argv[1][strlen(argv[1])-2] == '(')
   {
      argv[1][strlen(argv[1])-2] = '\0';
      isArray = OTCL_TRUE;
   }

   int newEntry;
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&instanceAttributeTemplates,
                                                argv[1]);
   if (hashEntry != NULL)
   {
      Otcl::setTclResult(interp,CLASS_ATTRIB_CLASH_INST_ERR,argv[1],name);
      return TCL_ERROR;
   }

   hashEntry = Tcl_CreateHashEntry(&classAttributes,argv[1],&newEntry);
   OtclAttribute *attribute;
   if (newEntry == 1)
   {
      attribute = new OtclAttribute(hashEntry,isArray,argv[2],interp);
      Tcl_SetHashValue(hashEntry,attribute);
   }
   else
   {
      Otcl::setTclResult(interp,CLASS_ATTRIB_CLASH_ERR,argv[1],name);
      return TCL_ERROR;

   }

   return TCL_OK;
}

int OtclClassOtcl::giveIndexOfSuperclass (char *n)
{
   for (int s = 0; s < noOfSuperclasses; s++)
   {
      if (strcmp(superclass[s]->giveName(),n) == 0)
      {
         return s;
      }
   }

   return -1;
}

int OtclClass::instantiate (Tcl_Interp *interp, int argc, char *argv[],
                            OtclObjMgr *otclom)
{
   OtclObject *otclo = new OtclObject();

   char *symbolicRef = otclom->manageObject(otclo,interp);
   if (symbolicRef == NULL)
   {
      Otcl::setTclResult(interp,COULDNT_MANAGE_OBJECT_ERR,argv[1]);
      delete otclo;
      return TCL_ERROR;
   }

   char *sr = strdup(symbolicRef);

   otclo->setSelf(sr);

   int returnCode = TCL_OK;
   instantiatePart(interp,&returnCode,argc,argv,otclo,otclo->getPartPtrPtr());
   if (returnCode != TCL_OK)
   {
      otclom->unManageObject(sr,interp);
      // Think I may need to clean up through the parts as well without
      // executing the destructor's
      delete otclo;
      free(sr);
      return returnCode;
   }

   Tcl_SetResult(interp,sr,TCL_VOLATILE);
   free(sr);
   return TCL_OK;
}

OtclPart *OtclClassOtcl::instantiatePart (Tcl_Interp *interp,
                                          int *returnCode,
                                          int argc, char *argv[], OtclObject *o,
                                          OtclPart **partPtr)
{
   return new OtclPartOtcl(interp,returnCode,argc,argv,this,o,partPtr);
}

OtclClass *OtclClassOtcl::giveSuperclass (int s)
{
   // Dosn't check as call should be from trusted client!

   if (s < 0 || s >= noOfSuperclasses)
   {
      return NULL;
   }
   return superclass[s];
}

void OtclClassOtcl::instantiateInstanceAttributes (Tcl_HashTable *hash,
                                                   Tcl_Interp *interp)
{
   Tcl_HashEntry *entry;
   Tcl_HashEntry *newEntry;
   int dummy;
   Tcl_HashSearch search;
   OtclAttributeTemplate *otclat;
   for (entry = Tcl_FirstHashEntry(&instanceAttributeTemplates,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      otclat = (OtclAttributeTemplate*)Tcl_GetHashValue(entry);
      newEntry = Tcl_CreateHashEntry(hash,
                   Tcl_GetHashKey(&instanceAttributeTemplates, entry),&dummy);
      Tcl_SetHashValue(newEntry,otclat->instantiate(interp,newEntry));
   }
}

void OtclClassOtcl::createClassScope (Tcl_Interp *tclInterp)
{
   Interp *interp = (Interp*)tclInterp;

   // Set up a new call frame
   CallFrame *callFrame = new CallFrame;
   Tcl_InitHashTable(&callFrame->varTable,TCL_STRING_KEYS);
   callFrame->level = (interp->varFramePtr == NULL) ?
                      1 : interp->varFramePtr->level + 1;
   callFrame->callerPtr = interp->framePtr;
   callFrame->callerVarPtr = interp->varFramePtr;
   interp->framePtr = callFrame;
   interp->varFramePtr = callFrame;
   interp->returnCode = TCL_OK;

   // Add upvar's locating each class attribute
   Tcl_HashSearch search;
   Tcl_HashEntry *hashEntry;
   Tcl_HashEntry *newEntry;
   OtclAttribute *otcla;
   Var *link;
   int dummy;
   for (hashEntry = Tcl_FirstHashEntry(&classAttributes,&search);
        hashEntry != NULL;
        hashEntry = Tcl_NextHashEntry(&search))
   {
      otcla = (OtclAttribute*)Tcl_GetHashValue(hashEntry);
      newEntry = Tcl_CreateHashEntry(&callFrame->varTable,
                                   Tcl_GetHashKey(&classAttributes,hashEntry),
                                     &dummy);
      link = (Var*)malloc(sizeof(Var));
      link->valueLength = 0;
      link->valueSpace = 0;
      link->value.upvarPtr = (Var*)*otcla;
      link->value.upvarPtr->refCount++;
      link->hPtr = newEntry;
      link->refCount = 0;
      link->tracePtr = NULL;
      link->searchPtr = NULL;
      link->flags = VAR_UPVAR;
      Tcl_SetHashValue(newEntry,link);
   }

   // Add in the local variable that allows us to tell what class scope
   char value[10];
   sprintf(value,"%lx",(long)this);
   Tcl_SetVar(tclInterp,OTCL_CLASS_VARIABLE_NAME,value,0);
}

void OtclClassOtcl::destroyClassScope (Tcl_Interp *tclInterp)
{
   Interp *interp = (Interp*)tclInterp;

   CallFrame *topFrame = interp->framePtr;
   interp->framePtr = topFrame->callerPtr;
   interp->varFramePtr = topFrame->callerVarPtr;

   // Blow away all local variables
   // Code Taken from TclDeleteVars in tclVar.c from Tcl7.3 distribution

   // Starts Here
   Tcl_HashTable *tablePtr = &topFrame->varTable;
   Tcl_HashSearch search;
   Tcl_HashEntry *hPtr;
   Var *varPtr;
   Var *upvarPtr;
   int flags;
   ActiveVarTrace *activePtr;

   flags = TCL_TRACE_UNSETS;
   if (tablePtr == &interp->globalTable) {
       flags |= TCL_INTERP_DESTROYED | TCL_GLOBAL_ONLY;
   }
   for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
        hPtr = Tcl_NextHashEntry(&search)) {

      varPtr = (Var *) Tcl_GetHashValue(hPtr);

      /*
       * For global/upvar variables referenced in procedures, decrement
       * the reference count on the variable referred to, and free up
       * the referenced variable if it's no longer needed.
       */

      if (varPtr->flags & VAR_UPVAR)
      {
          upvarPtr = varPtr->value.upvarPtr;
          upvarPtr->refCount--;

          if ((upvarPtr->flags & VAR_UNDEFINED) && (upvarPtr->refCount == 0)
              && (upvarPtr->tracePtr == NULL))
          {
             if (upvarPtr->hPtr != NULL)
             {
                Tcl_DeleteHashEntry(upvarPtr->hPtr);
             }
             ckfree((char *) upvarPtr);
          }
      }

      /*
       * Invoke traces on the variable that is being deleted, then
       * free up the variable's space (no need to free the hash entry
       * here, unless we're dealing with a global variable:  the
       * hash entries will be deleted automatically when the whole
       * table is deleted).
       */

       if (varPtr->tracePtr != NULL)
       {
          Otcl::callTraces(interp, (Var *) NULL, varPtr,
                           Tcl_GetHashKey(tablePtr, hPtr),(char *)NULL, flags);
           while (varPtr->tracePtr != NULL)
           {
              VarTrace *tracePtr = varPtr->tracePtr;
              varPtr->tracePtr = tracePtr->nextPtr;
              ckfree((char *) tracePtr);
           }
           for (activePtr = interp->activeTracePtr; activePtr != NULL;
                activePtr = activePtr->nextPtr)
           {
              if (activePtr->varPtr == varPtr)
              {
                 activePtr->nextTracePtr = NULL;
              }
           }
        }
        if (varPtr->flags & VAR_ARRAY)
        {
           Otcl::deleteArray(interp,Tcl_GetHashKey(tablePtr,hPtr),varPtr,flags);
        }
        if (varPtr->valueSpace > 0)
        {
           /*
            * SPECIAL TRICK:  it's possible that the interpreter's result
            * currently points to this variable (for example, a "set" or
            * "lappend" command was the last command in a procedure that's
            * being returned from).  If this is the case, then just pass
            * ownership of the value string to the Tcl interpreter.
            */

           if (interp->result == varPtr->value.string)
           {
              interp->freeProc = (Tcl_FreeProc *) free;
           }
           else
           {
              ckfree(varPtr->value.string);
           }
           varPtr->valueSpace = 0;
        }
        varPtr->hPtr = NULL;
        varPtr->tracePtr = NULL;
        varPtr->flags = VAR_UNDEFINED;
        if (varPtr->refCount == 0)
        {
            ckfree((char *) varPtr);
        }
    }
    Tcl_DeleteHashTable(tablePtr);
    // Ends Here

   delete topFrame;
}

OtclConstructorMethod *OtclClassOtcl::giveConstructorMethod (void)
{
   return otclConstructorMethod;
}

OtclDestructorMethod *OtclClassOtcl::giveDestructorMethod (void)
{
   return otclDestructorMethod;
}

OtclInstanceMethod *OtclClassOtcl::giveInstanceMethod (char *mName)
{
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&instanceMethods,mName);
   if (hashEntry != NULL)
   {
      return (OtclInstanceMethod*)Tcl_GetHashValue(hashEntry);
   }

   return NULL;
}

int OtclClassOtcl::isComplete (void)
{
   return complete;
}

int OtclClassOtcl::validMethodName (char *n)
{
   if (strcmp(n,OTCL_CONSTRUCTOR_METHOD_NAME) == 0)
   {
      return OTCL_FALSE;
   }
   if (strcmp(n,OTCL_DESTRUCTOR_METHOD_NAME) == 0)
   {
      return OTCL_FALSE;
   }
   return OTCL_TRUE;
}

OtclClassCpp::OtclClassCpp (char *name) :
   OtclClass(name)
{
   // Place this object on the list of all OtclClassCpp objects
   next = NULL;
   if (tail == NULL)
   {
      head = this;
   }
   else
   {
      tail->next = this;
   }
   tail = this;
}

OtclClassCpp::~OtclClassCpp ()
{
   // Remove this object from this list of all OtclClassCpp objects
   OtclClassCpp *current = head;
   OtclClassCpp *previous = NULL;
   while (current != this)
   {
      previous = current;
      current = current->next;
   }
   if (previous != NULL)
   {
      previous->next = next;
   }
   if (head == this)
   {
      head = next;
   }
   if (tail == this)
   {
      tail = previous;
   }
}

int OtclClassCpp::shouldDelete (void)
{
   return OTCL_FALSE;
}

void OtclClassCpp::registerWithOtcl (Otcl *otcl)
{
   OtclClassCpp *current = head;
   while (current != NULL)
   {
      otcl->registerOtclClassCpp(current);
      current = current->next;
   }
}

OtclPart *OtclClassCpp::instantiatePart (Tcl_Interp *,
                                         int *returnCode,
                                         int , char *[], OtclObject *,
                                         OtclPart **)
{
   // Each CPP class specialises this to create an instance of the
   // appropriate OtclClassCpp C++ class with the constructor
   // from the argc and argvs....
   *returnCode = TCL_OK;
   return NULL;
}

int OtclClassCpp::isComplete (void)
{
   return OTCL_TRUE;
}