home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / Tools / ObjectTcl-1.1 / OtclPart.C < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-30  |  11.5 KB  |  383 lines
  1. /*  _ __ ___ _
  2.  * | |\ /  /| |  $Id: OtclPart.C,v 1.9 1995/05/09 16:14:44 deans Exp $
  3.  * | | /  / | |  Copyright (C) 1995 IXI Limited.
  4.  * |_|/__/_\|_|  IXI Limited, Cambridge, England.
  5.  *
  6.  * Component   : OtclPart.C
  7.  *
  8.  * Author      : Dean Sheehan (deans@x.co.uk)
  9.  *
  10.  * Description : Contains the implementation for OtclPart an abstract class,
  11.  *               OtclPartOtcl responsible for modelling the parts of an object
  12.  *               that relate to classes in the inheritance hierarchy of an
  13.  *               OtclClass, and OtclPartCpp an abstract class that is subclassed
  14.  *               in C++ code generated by the CDL processor.
  15.  *
  16.  * License     :
  17.             Object Tcl License & Copyright
  18.             ------------------------------
  19.  
  20. IXI Object Tcl software, both binary and source (hereafter, Software) is copyrighted by IXI Limited (IXI), and ownership remains with IXI. 
  21.  
  22. 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. 
  23.  
  24. 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. 
  25.  
  26. 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. 
  27.  
  28. 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. 
  29.  
  30. Copyright (C) 1995, IXI Limited 
  31.  
  32. 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. 
  33.  
  34. Comments and questions are welcome and can be sent to
  35. otcl@x.co.uk 
  36.  
  37. For more information on copyright and licensing issues, contact: 
  38. Legal Department, IXI Limited, Vision Park, Cambridge CB4 4ZR,
  39. ENGLAND. 
  40.  
  41.  *
  42.  */
  43.  
  44. // System Includes
  45. #include <iostream.h>
  46.  
  47. // Tcl Includes
  48. #include <tclInt.h>
  49.  
  50. // Local Includes
  51. #include "Otcl.H"
  52. #include "OtclPart.H"
  53. #include "OtclObject.H"
  54. #include "OtclMethod.H"
  55. #include "OtclAttribute.H"
  56.  
  57. OtclPart::OtclPart (OtclObject *o)
  58. {
  59.    if (o == NULL)
  60.    {
  61.      if ((owner = Otcl::createObjectWrapper(this)) == NULL)
  62.      {
  63.         // report some kind of error and do something?
  64.      }
  65.    }
  66.    else
  67.    {
  68.       owner = o;
  69.    }
  70. }
  71.  
  72. OtclPart::~OtclPart ()
  73. {
  74. }
  75.  
  76. OtclObject *OtclPart::giveOwner (void)
  77. {
  78.    return owner;
  79. }
  80.  
  81. OtclPartOtcl::OtclPartOtcl (Tcl_Interp *interp, int *result, int argc,
  82.                             char *argv[], OtclClassOtcl *c, OtclObject *o,
  83.                             OtclPart **partPtr) :
  84.    OtclPart(o)
  85. {
  86.    otclc = c;
  87.    *partPtr = this;
  88.  
  89.    Tcl_InitHashTable(&attributes,TCL_STRING_KEYS);
  90.    otclc->instantiateInstanceAttributes(&attributes,interp);
  91.    
  92.    otclc->createClassScope(interp);
  93.    owner->addObjectScope(interp);
  94.    addPartScope(interp);
  95.  
  96.    OtclConstructorMethod *constructor = otclc->giveConstructorMethod();
  97.    if (constructor != NULL)
  98.    {
  99.       *result = constructor->execute(interp,argc,argv,this);
  100.       if (*result != TCL_OK)
  101.       {
  102.          removePartScope(interp);
  103.          owner->removeObjectScope(interp);
  104.          otclc->destroyClassScope(interp);
  105.          return;
  106.       }
  107.    }
  108.    else
  109.    {
  110.       // Invoke the parent constructors ourself. 
  111.       for (int s = 0; s < MAX_SUPERCLASSES; s++)
  112.       {
  113.          if (constructParent(s,interp,"") != TCL_OK)
  114.          {
  115.             (*result) = TCL_ERROR;
  116.             removePartScope(interp);
  117.             owner->removeObjectScope(interp);
  118.             otclc->destroyClassScope(interp);
  119.             return;
  120.  
  121.             // Similar to destructors in that we could pass around an att
  122.             // that sadi not to record error - al constructors executued
  123.             // only the first error report!
  124.          }
  125.       }
  126.    }
  127.  
  128.    removePartScope(interp);
  129.    owner->removeObjectScope(interp);
  130.    otclc->destroyClassScope(interp);
  131.  
  132.    *result = TCL_OK;
  133. }
  134.  
  135. int OtclPartOtcl::constructParent (int parentNo, Tcl_Interp *interp, char *args)
  136. {
  137.    OtclClass *otclClass = otclc->giveSuperclass(parentNo);
  138.    if (otclClass == NULL)
  139.    {
  140.       superPart[parentNo] = NULL;
  141.       return TCL_OK;
  142.    }
  143.    else
  144.    {
  145.       int argc;
  146.       char **argv;
  147.       int result = expandParentConstructorArgs(interp,args,&argc,&argv);
  148.       if (result != TCL_OK)
  149.       {
  150.          return result;
  151.       }
  152.  
  153.       superPart[parentNo] = otclClass->instantiatePart(interp,&result,
  154.                                                        argc,argv,owner,
  155.                                                        &superPart[parentNo]);
  156.       if (result != TCL_OK)
  157.       {
  158. // Do something
  159.       }
  160.  
  161.       free((char*)argv);
  162.       return result;
  163.    }
  164. }
  165.  
  166. int OtclPartOtcl::expandParentConstructorArgs (Tcl_Interp *interp, char *args,
  167.                                                int *argc, char **argv[])
  168. {
  169.    int result;
  170.    result = Tcl_VarEval(interp,OTCL_NOP_CMD," ",args,NULL);
  171.    if (result != TCL_OK)
  172.    {
  173.       return result;
  174.    }  
  175.  
  176.    return Tcl_SplitList(interp,interp->result,argc,argv);
  177. }
  178.  
  179. OtclPartOtcl::~OtclPartOtcl ()
  180. {
  181.    // clean up attributes.
  182.    Tcl_HashEntry *entry;
  183.    Tcl_HashSearch search;
  184.    for (entry = Tcl_FirstHashEntry(&attributes,&search);
  185.         entry != NULL;
  186.         entry = Tcl_NextHashEntry(&search))
  187.    {
  188.       delete ((OtclAttribute*)Tcl_GetHashValue(entry));
  189.    }
  190.    Tcl_DeleteHashTable(&attributes);
  191. }
  192.  
  193. int OtclPartOtcl::discardPart (Tcl_Interp *interp, int fromCpp)
  194. {
  195.    // execute destructor
  196.    int result = TCL_OK;
  197.  
  198.    OtclDestructorMethod *destructor = otclc->giveDestructorMethod();
  199.    if (destructor != NULL)
  200.    {
  201.       otclc->createClassScope(interp);
  202.       owner->addObjectScope(interp);
  203.       addPartScope(interp);
  204.       result = destructor->execute(interp,0,NULL);
  205.       removePartScope(interp);
  206.       owner->removeObjectScope(interp);
  207.       otclc->destroyClassScope(interp);
  208.    }
  209.  
  210.    // If an error in the body of a destructor, don't execute parent
  211.    // constructors. Any error is serious and we shouldn't bother to attempt
  212.    // to keep memory and status in a sensible state.
  213.    if (result == TCL_OK)
  214.    {
  215.       for (int s = MAX_SUPERCLASSES - 1; s >= 0; s--)
  216.       {
  217.          if (superPart[s] != NULL) 
  218.          {
  219.             if (superPart[s]->discardPart(interp,fromCpp) == TCL_ERROR)
  220.             {
  221.                return TCL_ERROR;
  222.             }
  223.             superPart[s] = NULL;
  224.          }
  225.       }
  226.    }
  227.  
  228.    delete this;
  229.    return result;
  230. }
  231.  
  232. void OtclPartOtcl::addPartScope (Tcl_Interp *tclInterp)
  233. {
  234.    Interp *interp = (Interp*)tclInterp;
  235.    Tcl_HashTable *varTable = &interp->framePtr->varTable;
  236.    
  237.    // Add upvar's locating each instance attributes
  238.    Tcl_HashSearch search;
  239.    Tcl_HashEntry *hashEntry;
  240.    Tcl_HashEntry *newEntry;
  241.    OtclAttribute *otcla;
  242.    Var *link;
  243.    int dummy;
  244.    for (hashEntry = Tcl_FirstHashEntry(&attributes,&search);
  245.         hashEntry != NULL;
  246.         hashEntry = Tcl_NextHashEntry(&search))
  247.    {
  248.       otcla = (OtclAttribute*)Tcl_GetHashValue(hashEntry);
  249.       newEntry = Tcl_CreateHashEntry(varTable,
  250.                                      Tcl_GetHashKey(&attributes,hashEntry),
  251.                                      &dummy);
  252.       link = (Var*)malloc(sizeof(Var));
  253.       link->valueLength = 0;
  254.       link->valueSpace = 0;
  255.       link->value.upvarPtr = (Var*)*otcla;
  256.       link->value.upvarPtr->refCount++;
  257.       link->hPtr = newEntry;
  258.       link->refCount = 0;
  259.       link->tracePtr = NULL;
  260.       link->searchPtr = NULL;
  261.       link->flags = VAR_UPVAR;
  262.       Tcl_SetHashValue(newEntry,link);
  263.    }
  264.  
  265.    char value[10];
  266.    sprintf(value,"%lx",(long)this);
  267.    Tcl_SetVar(tclInterp,OTCL_PART_ATTRIBUTE_NAME,value,0);
  268.  
  269. }
  270.  
  271. void OtclPartOtcl::removePartScope (Tcl_Interp *)
  272. {
  273.    // Remove instance attributes from call frame
  274.    // This is done by OtclClass:;destroyCallFrame
  275. }
  276.  
  277. char *OtclPartOtcl::giveClassName (void)
  278. {
  279.    return otclc->giveName();
  280. }
  281.  
  282. int OtclPartOtcl::executeMethod (Tcl_Interp *interp, char *methodName, int argc,
  283.                                  char *argv[], int *found)
  284. {
  285.    int result = TCL_OK;
  286.  
  287.    // Look for it as an instance method at the level of the hierarchy
  288.    OtclInstanceMethod *method = otclc->giveInstanceMethod(methodName);
  289.    if (method != NULL)
  290.    {
  291.       if (method->isAccessible(interp) != OTCL_TRUE)
  292.       {
  293.          Otcl::setTclResult(interp,PRIVATE_METHOD_NO_ACCESS_ERR,methodName,
  294.                             otclc->giveName());
  295.          *found = OTCL_TRUE;
  296.          return TCL_ERROR;
  297.       }
  298.       otclc->createClassScope(interp);
  299.       owner->addObjectScope(interp);
  300.       addPartScope(interp);
  301.       result = method->execute(interp,argc,argv);
  302.       removePartScope(interp);
  303.       owner->removeObjectScope(interp);
  304.       otclc->destroyClassScope(interp);
  305.       *found = OTCL_TRUE;
  306.       return result;
  307.    }
  308.  
  309.    // Don't look for it in class methods. 
  310.  
  311.    // Couldn't find it at this level look upwards.
  312.    for (int s = 0; s < MAX_SUPERCLASSES; s++)
  313.    {
  314.       if (superPart[s] != NULL)
  315.       {
  316.          result = superPart[s]->executeMethod(interp,methodName,argc,argv,
  317.                                               found);
  318.          if (*found == OTCL_TRUE)
  319.          {
  320.             return result;
  321.          }
  322.       }
  323.    }
  324.  
  325.    // Couldn't find it at all!
  326.  
  327.    *found = OTCL_FALSE;
  328.    return TCL_OK;
  329. }
  330.  
  331.  
  332. int OtclPartOtcl::executeParentMethod (Tcl_Interp *interp, char *pClassName,
  333.                                        char *methodName, int argc,
  334.                                        char *argv[], int *found)
  335. {
  336.    int s = otclc->giveIndexOfSuperclass(pClassName);
  337.    if (s == -1)
  338.    {
  339.       // No such superclass!!!!!!!!!!!!
  340.       
  341.       Otcl::setTclResult(interp,NOT_A_BASE_CLASS_ERR,pClassName,
  342.                             otclc->giveName());
  343.       *found = OTCL_TRUE;
  344.       return TCL_ERROR;
  345.    }
  346.  
  347.    return superPart[s]->executeMethod(interp,methodName,argc,argv,found);
  348. }
  349.  
  350. void *OtclPartOtcl::toCpp (char *cppClassName)
  351. {
  352.    void *res;
  353.    for (int s = 0; s < MAX_SUPERCLASSES; s++)
  354.    {
  355.       if (superPart[s] != NULL)
  356.       {
  357.          res = superPart[s]->toCpp(cppClassName);
  358.          if (res != NULL)
  359.          {     
  360.             return res;
  361.          }
  362.       }
  363.    }
  364.    return NULL;
  365. }
  366.  
  367. OtclPartCpp::OtclPartCpp (OtclObject *o) :
  368.    OtclPart(o)
  369. {
  370. }
  371.  
  372. OtclPartCpp::~OtclPartCpp ()
  373. {
  374. }
  375.  
  376. void OtclPartCpp::otclErrorMethod (char *mName, char *error)
  377. {
  378.    fprintf(stderr,"Otcl::error in method described in Tcl.\n");
  379.    fprintf(stderr,"      Method name: %s\n",mName);
  380.    fprintf(stderr,"      Error: %s\n",error);
  381.    exit(1);
  382. }
  383.