src/clipsrules/core/insmoddp.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*              CLIPS Version 6.24  05/17/06           */
00005    /*                                                     */
00006    /*           INSTANCE MODIFY AND DUPLICATE MODULE      */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose:  Instance modify and duplicate support routines  */
00011 /*                                                           */
00012 /* Principal Programmer(s):                                  */
00013 /*      Brian L. Dantes                                      */
00014 /*                                                           */
00015 /* Contributing Programmer(s):                               */
00016 /*                                                           */
00017 /*                                                           */
00018 /* Revision History:                                         */
00019 /*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
00020 /*                                                           */
00021 /*            Changed name of variable exp to theExp         */
00022 /*            because of Unix compiler warnings of shadowed  */
00023 /*            definitions.                                   */
00024 /*                                                           */
00025 /*      6.24: Converted INSTANCE_PATTERN_MATCHING to         */
00026 /*            DEFRULE_CONSTRUCT.                             */
00027 /*                                                           */
00028 /*************************************************************/
00029 
00030 /* =========================================
00031    *****************************************
00032                EXTERNAL DEFINITIONS
00033    =========================================
00034    ***************************************** */
00035 #include "setup.h"
00036 
00037 #if OBJECT_SYSTEM
00038 
00039 #if DEFRULE_CONSTRUCT
00040 #include "network.h"
00041 #include "objrtmch.h"
00042 #endif
00043 
00044 #include "argacces.h"
00045 #include "memalloc.h"
00046 #include "envrnmnt.h"
00047 #include "extnfunc.h"
00048 #include "inscom.h"
00049 #include "insfun.h"
00050 #include "insmngr.h"
00051 #include "inspsr.h"
00052 #include "miscfun.h"
00053 #include "msgcom.h"
00054 #include "msgfun.h"
00055 #include "msgpass.h"
00056 #include "prccode.h"
00057 #include "router.h"
00058 
00059 #define _INSMODDP_SOURCE_
00060 #include "insmoddp.h"
00061 
00062 /* =========================================
00063    *****************************************
00064       INTERNALLY VISIBLE FUNCTION HEADERS
00065    =========================================
00066    ***************************************** */
00067 
00068 static DATA_OBJECT *EvaluateSlotOverrides(void *,EXPRESSION *,int *,int *);
00069 static void DeleteSlotOverrideEvaluations(void *,DATA_OBJECT *,int);
00070 static void ModifyMsgHandlerSupport(void *,DATA_OBJECT *,int);
00071 static void DuplicateMsgHandlerSupport(void *,DATA_OBJECT *,int);
00072 
00073 /* =========================================
00074    *****************************************
00075           EXTERNALLY VISIBLE FUNCTIONS
00076    =========================================
00077    ***************************************** */
00078 
00079 #if (! RUN_TIME)
00080 
00081 /***************************************************
00082   NAME         : SetupInstanceModDupCommands
00083   DESCRIPTION  : Defines function interfaces for
00084                  modify- and duplicate- instance
00085                  functions
00086   INPUTS       : None
00087   RETURNS      : Nothing useful
00088   SIDE EFFECTS : Functions defined to KB
00089   NOTES        : None
00090  ***************************************************/
00091 globle void SetupInstanceModDupCommands(
00092   void *theEnv)
00093   {
00094 #if DEFRULE_CONSTRUCT
00095    EnvDefineFunction2(theEnv,"modify-instance",'u',PTIEF InactiveModifyInstance,"InactiveModifyInstance",NULL);
00096    EnvDefineFunction2(theEnv,"active-modify-instance",'u',PTIEF ModifyInstance,"ModifyInstance",NULL);
00097    AddFunctionParser(theEnv,"active-modify-instance",ParseInitializeInstance);
00098    EnvDefineFunction2(theEnv,"message-modify-instance",'u',PTIEF InactiveMsgModifyInstance,
00099                    "InactiveMsgModifyInstance",NULL);
00100    EnvDefineFunction2(theEnv,"active-message-modify-instance",'u',PTIEF MsgModifyInstance,
00101                    "MsgModifyInstance",NULL);
00102    AddFunctionParser(theEnv,"active-message-modify-instance",ParseInitializeInstance);
00103 
00104    EnvDefineFunction2(theEnv,"duplicate-instance",'u',
00105                     PTIEF InactiveDuplicateInstance,"InactiveDuplicateInstance",NULL);
00106    EnvDefineFunction2(theEnv,"active-duplicate-instance",'u',PTIEF DuplicateInstance,"DuplicateInstance",NULL);
00107    AddFunctionParser(theEnv,"active-duplicate-instance",ParseInitializeInstance);
00108    EnvDefineFunction2(theEnv,"message-duplicate-instance",'u',PTIEF InactiveMsgDuplicateInstance,
00109                    "InactiveMsgDuplicateInstance",NULL);
00110    EnvDefineFunction2(theEnv,"active-message-duplicate-instance",'u',PTIEF MsgDuplicateInstance,
00111                    "MsgDuplicateInstance",NULL);
00112    AddFunctionParser(theEnv,"active-message-duplicate-instance",ParseInitializeInstance);
00113 #else
00114    EnvDefineFunction2(theEnv,"modify-instance",'u',PTIEF ModifyInstance,"ModifyInstance",NULL);
00115    EnvDefineFunction2(theEnv,"message-modify-instance",'u',PTIEF MsgModifyInstance,
00116                    "MsgModifyInstance",NULL);
00117    EnvDefineFunction2(theEnv,"duplicate-instance",'u',PTIEF DuplicateInstance,"DuplicateInstance",NULL);
00118    EnvDefineFunction2(theEnv,"message-duplicate-instance",'u',PTIEF MsgDuplicateInstance,
00119                    "MsgDuplicateInstance",NULL);
00120 #endif
00121 
00122    EnvDefineFunction2(theEnv,"(direct-modify)",'u',PTIEF DirectModifyMsgHandler,"DirectModifyMsgHandler",NULL);
00123    EnvDefineFunction2(theEnv,"(message-modify)",'u',PTIEF MsgModifyMsgHandler,"MsgModifyMsgHandler",NULL);
00124    EnvDefineFunction2(theEnv,"(direct-duplicate)",'u',PTIEF DirectDuplicateMsgHandler,"DirectDuplicateMsgHandler",NULL);
00125    EnvDefineFunction2(theEnv,"(message-duplicate)",'u',PTIEF MsgDuplicateMsgHandler,"MsgDuplicateMsgHandler",NULL);
00126 
00127    AddFunctionParser(theEnv,"modify-instance",ParseInitializeInstance);
00128    AddFunctionParser(theEnv,"message-modify-instance",ParseInitializeInstance);
00129    AddFunctionParser(theEnv,"duplicate-instance",ParseInitializeInstance);
00130    AddFunctionParser(theEnv,"message-duplicate-instance",ParseInitializeInstance);
00131   }
00132 
00133 #endif
00134 
00135 /*************************************************************
00136   NAME         : ModifyInstance
00137   DESCRIPTION  : Modifies slots of an instance via the
00138                  direct-modify message
00139   INPUTS       : The address of the result value
00140   RETURNS      : Nothing useful
00141   SIDE EFFECTS : Slot updates performed directly
00142   NOTES        : H/L Syntax:
00143                  (modify-instance <instance> <slot-override>*)
00144  *************************************************************/
00145 globle void ModifyInstance(
00146   void *theEnv,
00147   DATA_OBJECT *result)
00148   {
00149    INSTANCE_TYPE *ins;
00150    EXPRESSION theExp;
00151    DATA_OBJECT *overrides;
00152    int oldOMDMV,overrideCount,error;
00153 
00154    /* ===========================================
00155       The slot-overrides need to be evaluated now
00156       to resolve any variable references before a
00157       new frame is pushed for message-handler
00158       execution
00159       =========================================== */
00160 
00161    overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg,
00162                                      &overrideCount,&error);
00163    if (error)
00164      {
00165       SetpType(result,SYMBOL);
00166       SetpValue(result,EnvFalseSymbol(theEnv));
00167       return;
00168      }
00169 
00170    /* ==================================
00171       Find the instance and make sure it
00172       wasn't deleted by the overrides
00173       ================================== */
00174    ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)));
00175    if (ins == NULL)
00176      {
00177       SetpType(result,SYMBOL);
00178       SetpValue(result,EnvFalseSymbol(theEnv));
00179       DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00180       return;
00181      }
00182 
00183    /* ======================================
00184       We are passing the slot override
00185       expression information along
00186       to whatever message-handler implements
00187       the modify
00188       ====================================== */
00189    theExp.type = DATA_OBJECT_ARRAY;
00190    theExp.value = (void *) overrides;
00191    theExp.argList = NULL;
00192    theExp.nextArg = NULL;
00193 
00194    oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid;
00195    InstanceData(theEnv)->ObjectModDupMsgValid = TRUE;
00196    DirectMessage(theEnv,FindSymbolHN(theEnv,DIRECT_MODIFY_STRING),ins,result,&theExp);
00197    InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV;
00198 
00199    DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00200   }
00201 
00202 /*************************************************************
00203   NAME         : MsgModifyInstance
00204   DESCRIPTION  : Modifies slots of an instance via the
00205                  direct-modify message
00206   INPUTS       : The address of the result value
00207   RETURNS      : Nothing useful
00208   SIDE EFFECTS : Slot updates performed with put- messages
00209   NOTES        : H/L Syntax:
00210                  (message-modify-instance <instance>
00211                     <slot-override>*)
00212  *************************************************************/
00213 globle void MsgModifyInstance(
00214   void *theEnv,
00215   DATA_OBJECT *result)
00216   {
00217    INSTANCE_TYPE *ins;
00218    EXPRESSION theExp;
00219    DATA_OBJECT *overrides;
00220    int oldOMDMV,overrideCount,error;
00221 
00222    /* ===========================================
00223       The slot-overrides need to be evaluated now
00224       to resolve any variable references before a
00225       new frame is pushed for message-handler
00226       execution
00227       =========================================== */
00228    overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg,
00229                                      &overrideCount,&error);
00230    if (error)
00231      {
00232       SetpType(result,SYMBOL);
00233       SetpValue(result,EnvFalseSymbol(theEnv));
00234       return;
00235      }
00236 
00237    /* ==================================
00238       Find the instance and make sure it
00239       wasn't deleted by the overrides
00240       ================================== */
00241    ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)));
00242    if (ins == NULL)
00243      {
00244       SetpType(result,SYMBOL);
00245       SetpValue(result,EnvFalseSymbol(theEnv));
00246       DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00247       return;
00248      }
00249 
00250    /* ======================================
00251       We are passing the slot override
00252       expression information along
00253       to whatever message-handler implements
00254       the modify
00255       ====================================== */
00256    theExp.type = DATA_OBJECT_ARRAY;
00257    theExp.value = (void *) overrides;
00258    theExp.argList = NULL;
00259    theExp.nextArg = NULL;
00260 
00261    oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid;
00262    InstanceData(theEnv)->ObjectModDupMsgValid = TRUE;
00263    DirectMessage(theEnv,FindSymbolHN(theEnv,MSG_MODIFY_STRING),ins,result,&theExp);
00264    InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV;
00265 
00266    DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00267   }
00268 
00269 /*************************************************************
00270   NAME         : DuplicateInstance
00271   DESCRIPTION  : Duplicates an instance via the
00272                  direct-duplicate message
00273   INPUTS       : The address of the result value
00274   RETURNS      : Nothing useful
00275   SIDE EFFECTS : Slot updates performed directly
00276   NOTES        : H/L Syntax:
00277                  (duplicate-instance <instance>
00278                    [to <instance-name>] <slot-override>*)
00279  *************************************************************/
00280 globle void DuplicateInstance(
00281   void *theEnv,
00282   DATA_OBJECT *result)
00283   {
00284    INSTANCE_TYPE *ins;
00285    DATA_OBJECT newName;
00286    EXPRESSION theExp[2];
00287    DATA_OBJECT *overrides;
00288    int oldOMDMV,overrideCount,error;
00289 
00290    /* ===========================================
00291       The slot-overrides need to be evaluated now
00292       to resolve any variable references before a
00293       new frame is pushed for message-handler
00294       execution
00295       =========================================== */
00296    overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg->nextArg,
00297                                      &overrideCount,&error);
00298    if (error)
00299      {
00300       SetpType(result,SYMBOL);
00301       SetpValue(result,EnvFalseSymbol(theEnv));
00302       return;
00303      }
00304 
00305    /* ==================================
00306       Find the instance and make sure it
00307       wasn't deleted by the overrides
00308       ================================== */
00309    ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)));
00310    if (ins == NULL)
00311      {
00312       SetpType(result,SYMBOL);
00313       SetpValue(result,EnvFalseSymbol(theEnv));
00314       DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00315       return;
00316      }
00317    if (EnvArgTypeCheck(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
00318                     2,INSTANCE_NAME,&newName) == FALSE)
00319      {
00320       SetpType(result,SYMBOL);
00321       SetpValue(result,EnvFalseSymbol(theEnv));
00322       DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00323       return;
00324      }
00325 
00326    /* ======================================
00327       We are passing the slot override
00328       expression information along
00329       to whatever message-handler implements
00330       the duplicate
00331       ====================================== */
00332    theExp[0].type = INSTANCE_NAME;
00333    theExp[0].value = newName.value;
00334    theExp[0].argList = NULL;
00335    theExp[0].nextArg = &theExp[1];
00336    theExp[1].type = DATA_OBJECT_ARRAY;
00337    theExp[1].value = (void *) overrides;
00338    theExp[1].argList = NULL;
00339    theExp[1].nextArg = NULL;
00340 
00341    oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid;
00342    InstanceData(theEnv)->ObjectModDupMsgValid = TRUE;
00343    DirectMessage(theEnv,FindSymbolHN(theEnv,DIRECT_DUPLICATE_STRING),ins,result,&theExp[0]);
00344    InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV;
00345 
00346    DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00347   }
00348 
00349 /*************************************************************
00350   NAME         : MsgDuplicateInstance
00351   DESCRIPTION  : Duplicates an instance via the
00352                  message-duplicate message
00353   INPUTS       : The address of the result value
00354   RETURNS      : Nothing useful
00355   SIDE EFFECTS : Slot updates performed w/ int & put- messages
00356   NOTES        : H/L Syntax:
00357                  (duplicate-instance <instance>
00358                    [to <instance-name>] <slot-override>*)
00359  *************************************************************/
00360 globle void MsgDuplicateInstance(
00361   void *theEnv,
00362   DATA_OBJECT *result)
00363   {
00364    INSTANCE_TYPE *ins;
00365    DATA_OBJECT newName;
00366    EXPRESSION theExp[2];
00367    DATA_OBJECT *overrides;
00368    int oldOMDMV,overrideCount,error;
00369 
00370    /* ===========================================
00371       The slot-overrides need to be evaluated now
00372       to resolve any variable references before a
00373       new frame is pushed for message-handler
00374       execution
00375       =========================================== */
00376    overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg->nextArg,
00377                                      &overrideCount,&error);
00378    if (error)
00379      {
00380       SetpType(result,SYMBOL);
00381       SetpValue(result,EnvFalseSymbol(theEnv));
00382       return;
00383      }
00384 
00385    /* ==================================
00386       Find the instance and make sure it
00387       wasn't deleted by the overrides
00388       ================================== */
00389    ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)));
00390    if (ins == NULL)
00391      {
00392       SetpType(result,SYMBOL);
00393       SetpValue(result,EnvFalseSymbol(theEnv));
00394       DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00395       return;
00396      }
00397    if (EnvArgTypeCheck(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
00398                     2,INSTANCE_NAME,&newName) == FALSE)
00399      {
00400       SetpType(result,SYMBOL);
00401       SetpValue(result,EnvFalseSymbol(theEnv));
00402       DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00403       return;
00404      }
00405 
00406    /* ======================================
00407       We are passing the slot override
00408       expression information along
00409       to whatever message-handler implements
00410       the duplicate
00411       ====================================== */
00412    theExp[0].type = INSTANCE_NAME;
00413    theExp[0].value = newName.value;
00414    theExp[0].argList = NULL;
00415    theExp[0].nextArg = &theExp[1];
00416    theExp[1].type = DATA_OBJECT_ARRAY;
00417    theExp[1].value = (void *) overrides;
00418    theExp[1].argList = NULL;
00419    theExp[1].nextArg = NULL;
00420 
00421    oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid;
00422    InstanceData(theEnv)->ObjectModDupMsgValid = TRUE;
00423    DirectMessage(theEnv,FindSymbolHN(theEnv,MSG_DUPLICATE_STRING),ins,result,&theExp[0]);
00424    InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV;
00425 
00426    DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
00427   }
00428 
00429 #if DEFRULE_CONSTRUCT
00430 
00431 /**************************************************************
00432   NAME         : InactiveModifyInstance
00433   DESCRIPTION  : Modifies slots of an instance of a class
00434                  Pattern-matching is automatically
00435                  delayed until the slot updates are done
00436   INPUTS       : The address of the result value
00437   RETURNS      : Nothing useful
00438   SIDE EFFECTS : Slot updates performed directly
00439   NOTES        : H/L Syntax:
00440                  (modify-instance <instance-name>
00441                    <slot-override>*)
00442  **************************************************************/
00443 globle void InactiveModifyInstance(
00444   void *theEnv,
00445   DATA_OBJECT *result)
00446   {
00447    int ov;
00448 
00449    ov = SetDelayObjectPatternMatching(theEnv,TRUE);
00450    ModifyInstance(theEnv,result);
00451    SetDelayObjectPatternMatching(theEnv,ov);
00452   }
00453 
00454 /**************************************************************
00455   NAME         : InactiveMsgModifyInstance
00456   DESCRIPTION  : Modifies slots of an instance of a class
00457                  Pattern-matching is automatically
00458                  delayed until the slot updates are done
00459   INPUTS       : The address of the result value
00460   RETURNS      : Nothing useful
00461   SIDE EFFECTS : Slot updates performed with put- messages
00462   NOTES        : H/L Syntax:
00463                  (message-modify-instance <instance-name>
00464                    <slot-override>*)
00465  **************************************************************/
00466 globle void InactiveMsgModifyInstance(
00467   void *theEnv,
00468   DATA_OBJECT *result)
00469   {
00470    int ov;
00471 
00472    ov = SetDelayObjectPatternMatching(theEnv,TRUE);
00473    MsgModifyInstance(theEnv,result);
00474    SetDelayObjectPatternMatching(theEnv,ov);
00475   }
00476 
00477 /*******************************************************************
00478   NAME         : InactiveDuplicateInstance
00479   DESCRIPTION  : Duplicates an instance of a class
00480                  Pattern-matching is automatically
00481                  delayed until the slot updates are done
00482   INPUTS       : The address of the result value
00483   RETURNS      : Nothing useful
00484   SIDE EFFECTS : Slot updates performed directly
00485   NOTES        : H/L Syntax:
00486                  (duplicate-instance <instance> [to <instance-name>]
00487                    <slot-override>*)
00488  *******************************************************************/
00489 globle void InactiveDuplicateInstance(
00490   void *theEnv,
00491   DATA_OBJECT *result)
00492   {
00493    int ov;
00494 
00495    ov = SetDelayObjectPatternMatching(theEnv,TRUE);
00496    DuplicateInstance(theEnv,result);
00497    SetDelayObjectPatternMatching(theEnv,ov);
00498   }
00499 
00500 /**************************************************************
00501   NAME         : InactiveMsgDuplicateInstance
00502   DESCRIPTION  : Duplicates an instance of a class
00503                  Pattern-matching is automatically
00504                  delayed until the slot updates are done
00505   INPUTS       : The address of the result value
00506   RETURNS      : Nothing useful
00507   SIDE EFFECTS : Slot updates performed with put- messages
00508   NOTES        : H/L Syntax:
00509                  (message-duplicate-instance <instance>
00510                    [to <instance-name>]
00511                    <slot-override>*)
00512  **************************************************************/
00513 globle void InactiveMsgDuplicateInstance(
00514   void *theEnv,
00515   DATA_OBJECT *result)
00516   {
00517    int ov;
00518 
00519    ov = SetDelayObjectPatternMatching(theEnv,TRUE);
00520    MsgDuplicateInstance(theEnv,result);
00521    SetDelayObjectPatternMatching(theEnv,ov);
00522   }
00523 
00524 #endif
00525 
00526 /*****************************************************
00527   NAME         : DirectDuplicateMsgHandler
00528   DESCRIPTION  : Implementation for the USER class
00529                  handler direct-duplicate
00530 
00531                  Implements duplicate-instance message
00532                  with a series of direct slot
00533                  placements
00534   INPUTS       : A data object buffer to hold the
00535                  result
00536   RETURNS      : Nothing useful
00537   SIDE EFFECTS : Slot values updated
00538   NOTES        : None
00539  *****************************************************/
00540 globle void DirectDuplicateMsgHandler(
00541   void *theEnv,
00542   DATA_OBJECT *result)
00543   {
00544    DuplicateMsgHandlerSupport(theEnv,result,FALSE);
00545   }
00546 
00547 /*****************************************************
00548   NAME         : MsgDuplicateMsgHandler
00549   DESCRIPTION  : Implementation for the USER class
00550                  handler message-duplicate
00551 
00552                  Implements duplicate-instance message
00553                  with a series of put- messages
00554   INPUTS       : A data object buffer to hold the
00555                  result
00556   RETURNS      : Nothing useful
00557   SIDE EFFECTS : Slot values updated
00558   NOTES        : None
00559  *****************************************************/
00560 globle void MsgDuplicateMsgHandler(
00561   void *theEnv,
00562   DATA_OBJECT *result)
00563   {
00564    DuplicateMsgHandlerSupport(theEnv,result,TRUE);
00565   }
00566 
00567 /***************************************************
00568   NAME         : DirectModifyMsgHandler
00569   DESCRIPTION  : Implementation for the USER class
00570                  handler direct-modify
00571 
00572                  Implements modify-instance message
00573                  with a series of direct slot
00574                  placements
00575   INPUTS       : A data object buffer to hold the
00576                  result
00577   RETURNS      : Nothing useful
00578   SIDE EFFECTS : Slot values updated
00579   NOTES        : None
00580  ***************************************************/
00581 globle void DirectModifyMsgHandler(
00582   void *theEnv,
00583   DATA_OBJECT *result)
00584   {
00585    ModifyMsgHandlerSupport(theEnv,result,FALSE);
00586   }
00587 
00588 /***************************************************
00589   NAME         : MsgModifyMsgHandler
00590   DESCRIPTION  : Implementation for the USER class
00591                  handler message-modify
00592 
00593                  Implements modify-instance message
00594                  with a series of put- messages
00595   INPUTS       : A data object buffer to hold the
00596                  result
00597   RETURNS      : Nothing useful
00598   SIDE EFFECTS : Slot values updated
00599   NOTES        : None
00600  ***************************************************/
00601 globle void MsgModifyMsgHandler(
00602   void *theEnv,
00603   DATA_OBJECT *result)
00604   {
00605    ModifyMsgHandlerSupport(theEnv,result,TRUE);
00606   }
00607 
00608 /* =========================================
00609    *****************************************
00610           INTERNALLY VISIBLE FUNCTIONS
00611    =========================================
00612    ***************************************** */
00613 
00614 /***********************************************************
00615   NAME         : EvaluateSlotOverrides
00616   DESCRIPTION  : Evaluates the slot-override expressions
00617                  for modify-instance and duplicate-instance
00618                  Evaluations are stored in an array of
00619                  data objects, where the supplementalInfo
00620                  field points at the name of the slot
00621                  The data object next fields are used
00622                  to link the array as well.
00623   INPUTS       : 1) The slot override expressions
00624                  2) A buffer to hold the number
00625                     of slot overrides
00626                  3) A buffer to hold an error flag
00627   RETURNS      : The slot override data object array
00628   SIDE EFFECTS : Data object array allocated and initialized
00629                  override count and error buffers set
00630   NOTES        : Slot overrides must be evaluated before
00631                  calling supporting message-handlers for
00632                  modify- and duplicate-instance in the
00633                  event that the overrides contain variable
00634                  references to an outer frame
00635  ***********************************************************/
00636 static DATA_OBJECT *EvaluateSlotOverrides(
00637   void *theEnv,
00638   EXPRESSION *ovExprs,
00639   int *ovCnt,
00640   int *error)
00641   {
00642    DATA_OBJECT *ovs;
00643    int ovi;
00644    void *slotName;
00645 
00646    *error = FALSE;
00647 
00648    /* ==========================================
00649       There are two expressions chains for every
00650       slot override: one for the slot name and
00651       one for the slot value
00652       ========================================== */
00653    *ovCnt = CountArguments(ovExprs) / 2;
00654    if (*ovCnt == 0)
00655      return(NULL);
00656 
00657    /* ===============================================
00658       Evaluate all the slot override names and values
00659       and store them in a contiguous array
00660       =============================================== */
00661    ovs = (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * (*ovCnt)));
00662    ovi = 0;
00663    while (ovExprs != NULL)
00664      {
00665       if (EvaluateExpression(theEnv,ovExprs,&ovs[ovi]))
00666         goto EvaluateOverridesError;
00667       if (ovs[ovi].type != SYMBOL)
00668         {
00669          ExpectedTypeError1(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
00670                             ovi+1,"slot name");
00671          SetEvaluationError(theEnv,TRUE);
00672          goto EvaluateOverridesError;
00673         }
00674       slotName = ovs[ovi].value;
00675       if (ovExprs->nextArg->argList)
00676         {
00677          if (EvaluateAndStoreInDataObject(theEnv,FALSE,ovExprs->nextArg->argList,
00678                                                &ovs[ovi],TRUE) == FALSE)
00679            goto EvaluateOverridesError;
00680         }
00681       else
00682         {
00683          SetpDOBegin(&ovs[ovi],1);
00684          SetpDOEnd(&ovs[ovi],0);
00685          SetpType(&ovs[ovi],MULTIFIELD);
00686          SetpValue(&ovs[ovi],ProceduralPrimitiveData(theEnv)->NoParamValue);
00687         }
00688       ovs[ovi].supplementalInfo = slotName;
00689       ovExprs = ovExprs->nextArg->nextArg;
00690       ovs[ovi].next = (ovExprs != NULL) ? &ovs[ovi+1] : NULL;
00691       ovi++;
00692      }
00693    return(ovs);
00694 
00695 EvaluateOverridesError:
00696    rm(theEnv,(void *) ovs,(sizeof(DATA_OBJECT) * (*ovCnt)));
00697    *error = TRUE;
00698    return(NULL);
00699   }
00700 
00701 /**********************************************************
00702   NAME         : DeleteSlotOverrideEvaluations
00703   DESCRIPTION  : Deallocates slot override evaluation array
00704   INPUTS       : 1) The data object array
00705                  2) The number of elements
00706   RETURNS      : Nothing useful
00707   SIDE EFFECTS : Deallocates slot override data object
00708                  array for modify- and duplicate- instance
00709   NOTES        : None
00710  **********************************************************/
00711 static void DeleteSlotOverrideEvaluations(
00712   void *theEnv,
00713   DATA_OBJECT *ovEvals,
00714   int ovCnt)
00715   {
00716    if (ovEvals != NULL)
00717      rm(theEnv,(void *) ovEvals,(sizeof(DATA_OBJECT) * ovCnt));
00718   }
00719 
00720 /**********************************************************
00721   NAME         : ModifyMsgHandlerSupport
00722   DESCRIPTION  : Support routine for DirectModifyMsgHandler
00723                  and MsgModifyMsgHandler
00724 
00725                  Performs a series of slot updates
00726                  directly or with messages
00727   INPUTS       : 1) A data object buffer to hold the result
00728                  2) A flag indicating whether to use
00729                     put- messages or direct placement
00730   RETURNS      : Nothing useful
00731   SIDE EFFECTS : Slots updated (messages sent)
00732   NOTES        : None
00733  **********************************************************/
00734 static void ModifyMsgHandlerSupport(
00735   void *theEnv,
00736   DATA_OBJECT *result,
00737   int msgpass)
00738   {
00739    DATA_OBJECT *slotOverrides,*newval,temp,junk;
00740    EXPRESSION msgExp;
00741    INSTANCE_TYPE *ins;
00742    INSTANCE_SLOT *insSlot;
00743 
00744    result->type = SYMBOL;
00745    result->value = EnvFalseSymbol(theEnv);
00746    if (InstanceData(theEnv)->ObjectModDupMsgValid == FALSE)
00747      {
00748       PrintErrorID(theEnv,"INSMODDP",1,FALSE);
00749       EnvPrintRouter(theEnv,WERROR,"Direct/message-modify message valid only in modify-instance.\n");
00750       SetEvaluationError(theEnv,TRUE);
00751       return;
00752      }
00753    InstanceData(theEnv)->ObjectModDupMsgValid = FALSE;
00754 
00755    ins = GetActiveInstance(theEnv);
00756    if (ins->garbage)
00757      {
00758       StaleInstanceAddress(theEnv,"modify-instance",0);
00759       SetEvaluationError(theEnv,TRUE);
00760       return;
00761      }
00762 
00763    /* =======================================
00764       Retrieve the slot override data objects
00765       passed from ModifyInstance - the slot
00766       name is stored in the supplementalInfo
00767       field - and the next fields are links
00768       ======================================= */
00769    slotOverrides = (DATA_OBJECT *) GetNthMessageArgument(theEnv,1)->value;
00770 
00771    while (slotOverrides != NULL)
00772      {
00773       /* ===========================================================
00774          No evaluation or error checking needs to be done
00775          since this has already been done by EvaluateSlotOverrides()
00776          =========================================================== */
00777       insSlot = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) slotOverrides->supplementalInfo);
00778       if (insSlot == NULL)
00779         {
00780          SlotExistError(theEnv,ValueToString(slotOverrides->supplementalInfo),"modify-instance");
00781          SetEvaluationError(theEnv,TRUE);
00782          return;
00783         }
00784       if (msgpass)
00785         {
00786          msgExp.type = slotOverrides->type;
00787          if (msgExp.type != MULTIFIELD)
00788            msgExp.value = slotOverrides->value;
00789          else
00790            msgExp.value = (void *) slotOverrides;
00791          msgExp.argList = NULL;
00792          msgExp.nextArg = NULL;
00793          DirectMessage(theEnv,insSlot->desc->overrideMessage,ins,&temp,&msgExp);
00794          if (EvaluationData(theEnv)->EvaluationError ||
00795              ((temp.type == SYMBOL) && (temp.value == EnvFalseSymbol(theEnv))))
00796            return;
00797         }
00798       else
00799         {
00800          if (insSlot->desc->multiple && (slotOverrides->type != MULTIFIELD))
00801            {
00802             temp.type = MULTIFIELD;
00803             temp.value = EnvCreateMultifield(theEnv,1L);
00804             SetDOBegin(temp,1);
00805             SetDOEnd(temp,1);
00806             SetMFType(temp.value,1,(short) slotOverrides->type);
00807             SetMFValue(temp.value,1,slotOverrides->value);
00808             newval = &temp;
00809            }
00810          else
00811            newval = slotOverrides;
00812          if (PutSlotValue(theEnv,ins,insSlot,newval,&junk,"modify-instance") == FALSE)
00813            return;
00814         }
00815 
00816       slotOverrides = slotOverrides->next;
00817      }
00818    result->value = EnvTrueSymbol(theEnv);
00819   }
00820 
00821 /*************************************************************
00822   NAME         : DuplicateMsgHandlerSupport
00823   DESCRIPTION  : Support routine for DirectDuplicateMsgHandler
00824                  and MsgDuplicateMsgHandler
00825 
00826                  Performs a series of slot updates
00827                  directly or with messages
00828   INPUTS       : 1) A data object buffer to hold the result
00829                  2) A flag indicating whether to use
00830                     put- messages or direct placement
00831   RETURNS      : Nothing useful
00832   SIDE EFFECTS : Slots updated (messages sent)
00833   NOTES        : None
00834  *************************************************************/
00835 static void DuplicateMsgHandlerSupport(
00836   void *theEnv,
00837   DATA_OBJECT *result,
00838   int msgpass)
00839   {
00840    INSTANCE_TYPE *srcins,*dstins;
00841    SYMBOL_HN *newName;
00842    DATA_OBJECT *slotOverrides;
00843    EXPRESSION *valArg,msgExp;
00844    long i;
00845    int oldMkInsMsgPass;
00846    INSTANCE_SLOT *dstInsSlot;
00847    DATA_OBJECT temp,junk,*newval;
00848 
00849    result->type = SYMBOL;
00850    result->value = EnvFalseSymbol(theEnv);
00851    if (InstanceData(theEnv)->ObjectModDupMsgValid == FALSE)
00852      {
00853       PrintErrorID(theEnv,"INSMODDP",2,FALSE);
00854       EnvPrintRouter(theEnv,WERROR,"Direct/message-duplicate message valid only in duplicate-instance.\n");
00855       SetEvaluationError(theEnv,TRUE);
00856       return;
00857      }
00858    InstanceData(theEnv)->ObjectModDupMsgValid = FALSE;
00859 
00860    /* ==================================
00861       Grab the slot override expressions
00862       and determine the source instance
00863       and the name of the new instance
00864       ================================== */
00865    srcins = GetActiveInstance(theEnv);
00866    newName = (SYMBOL_HN *) GetNthMessageArgument(theEnv,1)->value;
00867    slotOverrides = (DATA_OBJECT *) GetNthMessageArgument(theEnv,2)->value;
00868    if (srcins->garbage)
00869      {
00870       StaleInstanceAddress(theEnv,"duplicate-instance",0);
00871       SetEvaluationError(theEnv,TRUE);
00872       return;
00873      }
00874    if (newName == srcins->name)
00875      {
00876       PrintErrorID(theEnv,"INSMODDP",3,FALSE);
00877       EnvPrintRouter(theEnv,WERROR,"Instance copy must have a different name in duplicate-instance.\n");
00878       SetEvaluationError(theEnv,TRUE);
00879       return;
00880      }
00881 
00882    /* ==========================================
00883       Create an uninitialized new instance of
00884       the new name (delete old version - if any)
00885       ========================================== */
00886    oldMkInsMsgPass = InstanceData(theEnv)->MkInsMsgPass;
00887    InstanceData(theEnv)->MkInsMsgPass = msgpass;
00888    dstins = BuildInstance(theEnv,newName,srcins->cls,TRUE);
00889    InstanceData(theEnv)->MkInsMsgPass = oldMkInsMsgPass;
00890    if (dstins == NULL)
00891      return;
00892    dstins->busy++;
00893 
00894    /* ================================
00895       Place slot overrides directly or
00896       with put- messages
00897       ================================ */
00898    while (slotOverrides != NULL)
00899      {
00900       /* ===========================================================
00901          No evaluation or error checking needs to be done
00902          since this has already been done by EvaluateSlotOverrides()
00903          =========================================================== */
00904       dstInsSlot = FindInstanceSlot(theEnv,dstins,(SYMBOL_HN *) slotOverrides->supplementalInfo);
00905       if (dstInsSlot == NULL)
00906         {
00907          SlotExistError(theEnv,ValueToString(slotOverrides->supplementalInfo),
00908                         "duplicate-instance");
00909          goto DuplicateError;
00910         }
00911       if (msgpass)
00912         {
00913          msgExp.type = slotOverrides->type;
00914          if (msgExp.type != MULTIFIELD)
00915            msgExp.value = slotOverrides->value;
00916          else
00917            msgExp.value = (void *) slotOverrides;
00918          msgExp.argList = NULL;
00919          msgExp.nextArg = NULL;
00920          DirectMessage(theEnv,dstInsSlot->desc->overrideMessage,dstins,&temp,&msgExp);
00921          if (EvaluationData(theEnv)->EvaluationError ||
00922              ((temp.type == SYMBOL) && (temp.value == EnvFalseSymbol(theEnv))))
00923            goto DuplicateError;
00924         }
00925       else
00926         {
00927          if (dstInsSlot->desc->multiple && (slotOverrides->type != MULTIFIELD))
00928            {
00929             temp.type = MULTIFIELD;
00930             temp.value = EnvCreateMultifield(theEnv,1L);
00931             SetDOBegin(temp,1);
00932             SetDOEnd(temp,1);
00933             SetMFType(temp.value,1,(short) slotOverrides->type);
00934             SetMFValue(temp.value,1,slotOverrides->value);
00935             newval = &temp;
00936            }
00937          else
00938            newval = slotOverrides;
00939          if (PutSlotValue(theEnv,dstins,dstInsSlot,newval,&junk,"duplicate-instance") == FALSE)
00940            goto DuplicateError;
00941         }
00942       dstInsSlot->override = TRUE;
00943       slotOverrides = slotOverrides->next;
00944      }
00945 
00946    /* =======================================
00947       Copy values from source instance to new
00948       directly or with put- messages
00949       ======================================= */
00950    for (i = 0 ; i < dstins->cls->localInstanceSlotCount ; i++)
00951      {
00952       if (dstins->slots[i].override == FALSE)
00953         {
00954          if (msgpass)
00955            {
00956             temp.type = (unsigned short)  srcins->slots[i].type;
00957             temp.value = srcins->slots[i].value;
00958             if (temp.type == MULTIFIELD)
00959               {
00960                SetDOBegin(temp,1);
00961                SetDOEnd(temp,GetMFLength(temp.value));
00962               }
00963             valArg = ConvertValueToExpression(theEnv,&temp);
00964             DirectMessage(theEnv,dstins->slots[i].desc->overrideMessage,
00965                           dstins,&temp,valArg);
00966             ReturnExpression(theEnv,valArg);
00967             if (EvaluationData(theEnv)->EvaluationError ||
00968                 ((temp.type == SYMBOL) && (temp.value == EnvFalseSymbol(theEnv))))
00969               goto DuplicateError;
00970            }
00971          else
00972            {
00973             temp.type = (unsigned short) srcins->slots[i].type;
00974             temp.value = srcins->slots[i].value;
00975             if (srcins->slots[i].type == MULTIFIELD)
00976               {
00977                SetDOBegin(temp,1);
00978                SetDOEnd(temp,GetMFLength(srcins->slots[i].value));
00979               }
00980             if (PutSlotValue(theEnv,dstins,&dstins->slots[i],&temp,&junk,"duplicate-instance")
00981                  == FALSE)
00982               goto DuplicateError;
00983            }
00984         }
00985      }
00986 
00987    /* =======================================
00988       Send init message for message-duplicate
00989       ======================================= */
00990    if (msgpass)
00991      {
00992       for (i = 0 ; i < dstins->cls->instanceSlotCount ; i++)
00993         dstins->slotAddresses[i]->override = TRUE;
00994       dstins->initializeInProgress = 1;
00995       DirectMessage(theEnv,MessageHandlerData(theEnv)->INIT_SYMBOL,dstins,result,NULL);
00996      }
00997    dstins->busy--;
00998    if (dstins->garbage)
00999      {
01000       result->type = SYMBOL;
01001       result->value = EnvFalseSymbol(theEnv);
01002       SetEvaluationError(theEnv,TRUE);
01003      }
01004    else
01005      {
01006       result->type = INSTANCE_NAME;
01007       result->value = (void *) GetFullInstanceName(theEnv,dstins);
01008      }
01009    return;
01010 
01011 DuplicateError:
01012    dstins->busy--;
01013    QuashInstance(theEnv,dstins);
01014    SetEvaluationError(theEnv,TRUE);
01015   }
01016 
01017 #endif
01018 
01019