Beispiel #1
0
/**********************************************************************
  NAME         : WatchMethod
  DESCRIPTION  : Prints out a trace of the beginning or end
                   of the execution of a generic function
                   method
  INPUTS       : A string to indicate beginning or end of execution
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Uses the globals CurrentGeneric, CurrentMethod,
                   ProcParamArraySize and ProcParamArray for
                   other trace info
 **********************************************************************/
static void WatchMethod(
  Environment *theEnv,
  const char *tstring)
  {
   if (ConstructData(theEnv)->ClearReadyInProgress ||
       ConstructData(theEnv)->ClearInProgress)
     { return; }

   WriteString(theEnv,STDOUT,"MTH ");
   WriteString(theEnv,STDOUT,tstring);
   WriteString(theEnv,STDOUT," ");
   if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != GetCurrentModule(theEnv))
     {
      WriteString(theEnv,STDOUT,DefgenericModule(DefgenericData(theEnv)->CurrentGeneric));
      WriteString(theEnv,STDOUT,"::");
     }
   WriteString(theEnv,STDOUT,DefgenericData(theEnv)->CurrentGeneric->header.name->contents);
   WriteString(theEnv,STDOUT,":#");
   if (DefgenericData(theEnv)->CurrentMethod->system)
     WriteString(theEnv,STDOUT,"SYS");
   PrintUnsignedInteger(theEnv,STDOUT,DefgenericData(theEnv)->CurrentMethod->index);
   WriteString(theEnv,STDOUT," ");
   WriteString(theEnv,STDOUT," ED:");
   WriteInteger(theEnv,STDOUT,EvaluationData(theEnv)->CurrentEvaluationDepth);
   PrintProcParamArray(theEnv,STDOUT);
  }
Beispiel #2
0
/****************************************************************
  NAME         : SingleDefgenericToCode
  DESCRIPTION  : Writes out a single defgeneric's
                 data to the file
  INPUTS       : 1)  The output file
                 2)  The compile image id
                 3)  The maximum number of
                     elements in an array
                 4)  The defgeneric
                 5)  The module index
                 6)  The partition holding the
                     generic methods
                 7) The relative index of the
                    generics methods in the partition
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defgeneric data written
  NOTES        : None
 ***************************************************************/
static void SingleDefgenericToCode(
  void *theEnv,
  FILE *theFile,
  int imageID,
  int maxIndices,
  DEFGENERIC *theDefgeneric,
  int moduleCount,
  int methodArrayVersion,
  int methodArrayCount)
  {
   /* ==================
      Defgeneric Header
      ================== */
   fprintf(theFile,"{");
   ConstructHeaderToCode(theEnv,theFile,&theDefgeneric->header,imageID,maxIndices,moduleCount,
                         ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem),
                         ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem));

   /* =========================
      Defgeneric specific data
      ========================= */
   fprintf(theFile,",0,0,");
   if (theDefgeneric->methods == NULL)
     fprintf(theFile,"NULL");
   else
     {
      fprintf(theFile,"&%s%d_%d[%d]",MethodPrefix(),imageID,
                      methodArrayVersion,methodArrayCount);
     }
   fprintf(theFile,",%hd,0}",theDefgeneric->mcnt);
  }
Beispiel #3
0
/***********************************************************
  NAME         : GetGenericCurrentArgument
  DESCRIPTION  : Returns the value of the generic function
                   argument being tested in the method
                   applicability determination process
  INPUTS       : A data-object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Data-object set
  NOTES        : Useful for queries in wildcard restrictions
 ***********************************************************/
void GetGenericCurrentArgument(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   returnValue->value = DefgenericData(theEnv)->GenericCurrentArgument->value;
   returnValue->begin = DefgenericData(theEnv)->GenericCurrentArgument->begin;
   returnValue->range = DefgenericData(theEnv)->GenericCurrentArgument->range;
  }
Beispiel #4
0
/*******************************************************
  NAME         : UnboundMethodErr
  DESCRIPTION  : Print out a synopis of the currently
                   executing method for unbound variable
                   errors
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Error synopsis printed to WERROR
  NOTES        : None
 *******************************************************/
void UnboundMethodErr(
  void *theEnv)
  {
   EnvPrintRouter(theEnv,WERROR,"generic function ");
   EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric));
   EnvPrintRouter(theEnv,WERROR," method #");
   PrintLongInteger(theEnv,WERROR,(long long) DefgenericData(theEnv)->CurrentMethod->index);
   EnvPrintRouter(theEnv,WERROR,".\n");
  }
Beispiel #5
0
/*******************************************************
  NAME         : UnboundMethodErr
  DESCRIPTION  : Print out a synopis of the currently
                   executing method for unbound variable
                   errors
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Error synopsis printed to STDERR
  NOTES        : None
 *******************************************************/
void UnboundMethodErr(
  Environment *theEnv,
  const char *logName)
  {
   WriteString(theEnv,logName,"generic function '");
   WriteString(theEnv,logName,DefgenericName(DefgenericData(theEnv)->CurrentGeneric));
   WriteString(theEnv,logName,"' method #");
   PrintUnsignedInteger(theEnv,logName,DefgenericData(theEnv)->CurrentMethod->index);
   WriteString(theEnv,logName,".\n");
  }
Beispiel #6
0
/***********************************************************
  NAME         : GetGenericCurrentArgument
  DESCRIPTION  : Returns the value of the generic function
                   argument being tested in the method
                   applicability determination process
  INPUTS       : A data-object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Data-object set
  NOTES        : Useful for queries in wildcard restrictions
 ***********************************************************/
void GetGenericCurrentArgument(
  UDFContext *context,
  CLIPSValue *returnValue)
  {
   Environment *theEnv = UDFContextEnvironment(context);
   
   returnValue->type = DefgenericData(theEnv)->GenericCurrentArgument->type;
   returnValue->value = DefgenericData(theEnv)->GenericCurrentArgument->value;
   returnValue->begin = DefgenericData(theEnv)->GenericCurrentArgument->begin;
   returnValue->end = DefgenericData(theEnv)->GenericCurrentArgument->end;
  }
Beispiel #7
0
/***************************************************
  NAME         : BsaveGenericsExpressions
  DESCRIPTION  : Writes out all expressions needed
                   by generic functions
  INPUTS       : The file pointer of the binary file
  RETURNS      : Nothing useful
  SIDE EFFECTS : File updated
  NOTES        : None
 ***************************************************/
static void BsaveGenericsExpressions(
  void *theEnv,
  FILE *fp)
  {
   /* ================================================================
      Important to save all expressions for methods before any
      expressions for restrictions, since methods will be stored first
      ================================================================ */
   DoForAllConstructs(theEnv,BsaveMethodExpressions,DefgenericData(theEnv)->DefgenericModuleIndex,
                      FALSE,(void *) fp);

   DoForAllConstructs(theEnv,BsaveRestrictionExpressions,DefgenericData(theEnv)->DefgenericModuleIndex,
                      FALSE,(void *) fp);
  }
Beispiel #8
0
/***************************************************
  NAME         : NextMethodP
  DESCRIPTION  : Determines if a shadowed generic
                   function method is available for
                   execution
  INPUTS       : None
  RETURNS      : true if there is a method available,
                   false otherwise
  SIDE EFFECTS : None
  NOTES        : H/L Syntax: (next-methodp)
 ***************************************************/
bool NextMethodP(
  void *theEnv)
  {
   register DEFMETHOD *meth;

   if (DefgenericData(theEnv)->CurrentMethod == NULL)
     return(false);
   meth = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod);
   if (meth != NULL)
     {
      meth->busy--;
      return(true);
     }
   return(false);
  }
Beispiel #9
0
/***************************************************
  NAME         : DetermineRestrictionClass
  DESCRIPTION  : Finds the class of an argument in
                   the ProcParamArray
  INPUTS       : The argument data object
  RETURNS      : The class address, NULL if error
  SIDE EFFECTS : EvaluationError set on errors
  NOTES        : None
 ***************************************************/
static Defclass *DetermineRestrictionClass(
  Environment *theEnv,
  UDFValue *dobj)
  {
   Instance *ins;
   Defclass *cls;

   if (dobj->header->type == INSTANCE_NAME_TYPE)
     {
      ins = FindInstanceBySymbol(theEnv,dobj->lexemeValue);
      cls = (ins != NULL) ? ins->cls : NULL;
     }
   else if (dobj->header->type == INSTANCE_ADDRESS_TYPE)
     {
      ins = dobj->instanceValue;
      cls = (ins->garbage == 0) ? ins->cls : NULL;
     }
   else
     return(DefclassData(theEnv)->PrimitiveClassMap[dobj->header->type]);
   if (cls == NULL)
     {
      SetEvaluationError(theEnv,true);
      PrintErrorID(theEnv,"GENRCEXE",3,false);
      WriteString(theEnv,STDERR,"Unable to determine class of ");
      WriteUDFValue(theEnv,STDERR,dobj);
      WriteString(theEnv,STDERR," in generic function '");
      WriteString(theEnv,STDERR,DefgenericName(DefgenericData(theEnv)->CurrentGeneric));
      WriteString(theEnv,STDERR,"'.\n");
     }
   return(cls);
  }
Beispiel #10
0
/***************************************************
  NAME         : DetermineRestrictionClass
  DESCRIPTION  : Finds the class of an argument in
                   the ProcParamArray
  INPUTS       : The argument data object
  RETURNS      : The class address, NULL if error
  SIDE EFFECTS : EvaluationError set on errors
  NOTES        : None
 ***************************************************/
static DEFCLASS *DetermineRestrictionClass(
  void *theEnv,
  DATA_OBJECT *dobj)
  {
   INSTANCE_TYPE *ins;
   DEFCLASS *cls;

   if (dobj->type == INSTANCE_NAME)
     {
      ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) dobj->value);
      cls = (ins != NULL) ? ins->cls : NULL;
     }
   else if (dobj->type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) dobj->value;
      cls = (ins->garbage == 0) ? ins->cls : NULL;
     }
   else
     return(DefclassData(theEnv)->PrimitiveClassMap[dobj->type]);
   if (cls == NULL)
     {
      EnvSetEvaluationError(theEnv,true);
      PrintErrorID(theEnv,"GENRCEXE",3,false);
      EnvPrintRouter(theEnv,WERROR,"Unable to determine class of ");
      PrintDataObject(theEnv,WERROR,dobj);
      EnvPrintRouter(theEnv,WERROR," in generic function ");
      EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric));
      EnvPrintRouter(theEnv,WERROR,".\n");
     }
   return(cls);
  }
Beispiel #11
0
/***************************************************
  NAME         : NextMethodP
  DESCRIPTION  : Determines if a shadowed generic
                   function method is available for
                   execution
  INPUTS       : None
  RETURNS      : True if there is a method available,
                   false otherwise
  SIDE EFFECTS : None
  NOTES        : H/L Syntax: (next-methodp)
 ***************************************************/
bool NextMethodP(
  Environment *theEnv)
  {
   Defmethod *meth;

   if (DefgenericData(theEnv)->CurrentMethod == NULL)
     { return false; }

   meth = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod);
   if (meth != NULL)
     {
      meth->busy--;
      return true;
     }
   else
     { return false; }
  }
Beispiel #12
0
/*************************************************************
  NAME         : PreviewGeneric
  DESCRIPTION  : Allows the user to see a printout of all the
                   applicable methods for a particular generic
                   function call
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of evaluating the generic
                   function arguments
                 and evaluating query-functions to determine
                   the set of applicable methods
  NOTES        : H/L Syntax: (preview-generic <func> <args>)
 *************************************************************/
globle void PreviewGeneric(
  void *theEnv,
  EXEC_STATUS)
  {
   DEFGENERIC *gfunc;
   DEFGENERIC *previousGeneric;
   int oldce;
   DATA_OBJECT temp;

   execStatus->EvaluationError = FALSE;
   if (EnvArgTypeCheck(theEnv,execStatus,"preview-generic",1,SYMBOL,&temp) == FALSE)
     return;
   gfunc = LookupDefgenericByMdlOrScope(theEnv,execStatus,DOToString(temp));
   if (gfunc == NULL)
     {
      PrintErrorID(theEnv,execStatus,"GENRCFUN",3,FALSE);
      EnvPrintRouter(theEnv,execStatus,WERROR,"Unable to find generic function ");
      EnvPrintRouter(theEnv,execStatus,WERROR,DOToString(temp));
      EnvPrintRouter(theEnv,execStatus,WERROR," in function preview-generic.\n");
      return;
     }
   oldce = ExecutingConstruct(theEnv,execStatus);
   SetExecutingConstruct(theEnv,execStatus,TRUE);
   previousGeneric = DefgenericData(theEnv,execStatus)->CurrentGeneric;
   DefgenericData(theEnv,execStatus)->CurrentGeneric = gfunc;
   execStatus->CurrentEvaluationDepth++;
   PushProcParameters(theEnv,execStatus,GetFirstArgument()->nextArg,
                          CountArguments(GetFirstArgument()->nextArg),
                          EnvGetDefgenericName(theEnv,execStatus,(void *) gfunc),"generic function",
                          UnboundMethodErr);
   if (execStatus->EvaluationError)
     {
      PopProcParameters(theEnv,execStatus);
      DefgenericData(theEnv,execStatus)->CurrentGeneric = previousGeneric;
      execStatus->CurrentEvaluationDepth--;
      SetExecutingConstruct(theEnv,execStatus,oldce);
      return;
     }
   gfunc->busy++;
   DisplayGenericCore(theEnv,execStatus,gfunc);
   gfunc->busy--;
   PopProcParameters(theEnv,execStatus);
   DefgenericData(theEnv,execStatus)->CurrentGeneric = previousGeneric;
   execStatus->CurrentEvaluationDepth--;
   SetExecutingConstruct(theEnv,execStatus,oldce);
  }
Beispiel #13
0
/***********************************************************************
  NAME         : OverrideNextMethod
  DESCRIPTION  : Changes the arguments to shadowed methods, thus the set
                 of applicable methods to this call may change
  INPUTS       : A buffer to hold the result of the call
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any of evaluating method restrictions and bodies
  NOTES        : H/L Syntax: (override-next-method <args>)
 ***********************************************************************/
void OverrideNextMethod(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   returnValue->lexemeValue = FalseSymbol(theEnv);
   if (EvaluationData(theEnv)->HaltExecution)
     return;
   if (DefgenericData(theEnv)->CurrentMethod == NULL)
     {
      PrintErrorID(theEnv,"GENRCEXE",2,false);
      WriteString(theEnv,STDERR,"Shadowed methods not applicable in current context.\n");
      SetEvaluationError(theEnv,true);
      return;
     }
   GenericDispatch(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod,NULL,
                   GetFirstArgument(),returnValue);
  }
Beispiel #14
0
/***************************************************
  NAME         : FreeDefgenericModule
  DESCRIPTION  : Removes a deffunction module and
                 all associated deffunctions
  INPUTS       : The deffunction module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Module and deffunctions deleted
  NOTES        : None
 ***************************************************/
globle void FreeDefgenericModule(
  void *theEnv,
  void *theItem)
  {
#if (! BLOAD_ONLY)
   FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefgenericData(theEnv)->DefgenericConstruct);
#endif
   rtn_struct(theEnv,defgenericModule,theItem);
  }
Beispiel #15
0
/**********************************************************************
  NAME         : WatchGeneric
  DESCRIPTION  : Prints out a trace of the beginning or end
                   of the execution of a generic function
  INPUTS       : A string to indicate beginning or end of execution
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Uses the globals CurrentGeneric, ProcParamArraySize and
                   ProcParamArray for other trace info
 **********************************************************************/
static void WatchGeneric(
  void *theEnv,
  const char *tstring)
  {
   EnvPrintRouter(theEnv,WTRACE,"GNC ");
   EnvPrintRouter(theEnv,WTRACE,tstring);
   EnvPrintRouter(theEnv,WTRACE," ");
   if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
     {
      EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *)
                        DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule));
      EnvPrintRouter(theEnv,WTRACE,"::");
     }
   EnvPrintRouter(theEnv,WTRACE,ValueToString((void *) DefgenericData(theEnv)->CurrentGeneric->header.name));
   EnvPrintRouter(theEnv,WTRACE," ");
   EnvPrintRouter(theEnv,WTRACE," ED:");
   PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth);
   PrintProcParamArray(theEnv,WTRACE);
  }
Beispiel #16
0
/***********************************************************************
  NAME         : OverrideNextMethod
  DESCRIPTION  : Changes the arguments to shadowed methods, thus the set
                 of applicable methods to this call may change
  INPUTS       : A buffer to hold the result of the call
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any of evaluating method restrictions and bodies
  NOTES        : H/L Syntax: (override-next-method <args>)
 ***********************************************************************/
void OverrideNextMethod(
  UDFContext *context,
  CLIPSValue *returnValue)
  {
   Environment *theEnv = UDFContextEnvironment(context);
   
   mCVSetBoolean(returnValue,false);
   if (EvaluationData(theEnv)->HaltExecution)
     return;
   if (DefgenericData(theEnv)->CurrentMethod == NULL)
     {
      PrintErrorID(theEnv,"GENRCEXE",2,false);
      EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n");
      EnvSetEvaluationError(theEnv,true);
      return;
     }
   GenericDispatch(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod,NULL,
                   GetFirstArgument(),returnValue);
  }
Beispiel #17
0
/***************************************************
  NAME         : DefgenericModuleToCode
  DESCRIPTION  : Writes out the C values for a
                 defgeneric module item
  INPUTS       : 1) The output file
                 2) The module for the defgenerics
                 3) The compile image id
                 4) The maximum number of elements
                    in an array
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defgeneric module item written
  NOTES        : None
 ***************************************************/
static void DefgenericModuleToCode(
  void *theEnv,
  FILE *theFile,
  struct defmodule *theModule,
  int imageID,
  int maxIndices)
  {
   fprintf(theFile,"{");
   ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices,
                         DefgenericData(theEnv)->DefgenericModuleIndex,ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem));
   fprintf(theFile,"}");
  }
Beispiel #18
0
/****************************************************
  NAME         : DefgenericCModuleReference
  DESCRIPTION  : Prints out a reference to a
                 defgeneric module
  INPUTS       : 1) The output file
                 2) The id of the module item
                 3) The id of the image
                 4) The maximum number of elements
                    allowed in an array
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defgeneric module reference printed
  NOTES        : None
 ****************************************************/
globle void DefgenericCModuleReference(
  void *theEnv,
  FILE *theFile,
  int count,
  int imageID,
  int maxIndices)
  {
   fprintf(theFile,"MIHS &%s%d_%d[%d]",
                      ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem),
                      imageID,
                      (count / maxIndices) + 1,
                      (count % maxIndices));
  }
Beispiel #19
0
/***************************************************
  NAME         : PrintGenericFunctionReference
  DESCRIPTION  : Prints a reference to the run-time
                 generic array for the construct
                 compiler
  INPUTS       : 1) The file output destination
                 2) A pointer to the generic
                 3) The id of the run-time image
                 4) The maximum number of indices
                    in any array
  RETURNS      : Nothing useful
  SIDE EFFECTS : Reference printed
  NOTES        : None
 ***************************************************/
globle void PrintGenericFunctionReference(
  void *theEnv,
  FILE *fp,
  DEFGENERIC *gfunc,
  int imageID,
  int maxIndices)
  {
   if (gfunc == NULL)
     fprintf(fp,"NULL");
   else
     fprintf(fp,"&%s%d_%d[%d]",ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem),imageID,
                                (int) ((gfunc->header.bsaveID / maxIndices) + 1),
                                (int) (gfunc->header.bsaveID % maxIndices));
  }
Beispiel #20
0
/***************************************************************************
  NAME         : BsaveGenericsFind
  DESCRIPTION  : For all generic functions and their
                   methods, this routine marks all
                   the needed symbols and system functions.
                 Also, it also counts the number of
                   expression structures needed.
                 Also, counts total number of generics, methods,
                   restrictions and types.
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented
                   for every expression needed
                 Symbols and system function are marked in their structures
  NOTES        : Also sets bsaveIndex for each generic function (assumes
                   generic functions will be bsaved in order of binary list)
 ***************************************************************************/
static void BsaveGenericsFind(
  void *theEnv)
  {
   SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->ModuleCount);
   SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->GenericCount);
   SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->MethodCount);
   SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->RestrictionCount);
   SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->TypeCount);

   DefgenericBinaryData(theEnv)->GenericCount = 0L;
   DefgenericBinaryData(theEnv)->MethodCount = 0L;
   DefgenericBinaryData(theEnv)->RestrictionCount = 0L;
   DefgenericBinaryData(theEnv)->TypeCount = 0L;

   DefgenericBinaryData(theEnv)->ModuleCount = 
      DoForAllConstructs(theEnv,MarkDefgenericItems,DefgenericData(theEnv)->DefgenericModuleIndex,
                                    FALSE,NULL);
  }
Beispiel #21
0
static void UpdateGeneric(
  void *theEnv,
  void *buf,
  long obji)
  {
   BSAVE_GENERIC *bgp;
   DEFGENERIC *gp;

   bgp = (BSAVE_GENERIC *) buf;
   gp = (DEFGENERIC *) &DefgenericBinaryData(theEnv)->DefgenericArray[obji];

   UpdateConstructHeader(theEnv,&bgp->header,&gp->header,
                         (int) sizeof(DEFGENERIC_MODULE),(void *) DefgenericBinaryData(theEnv)->ModuleArray,
                         (int) sizeof(DEFGENERIC),(void *) DefgenericBinaryData(theEnv)->DefgenericArray);
   DefgenericBinaryData(theEnv)->DefgenericArray[obji].busy = 0;
#if DEBUGGING_FUNCTIONS
   DefgenericBinaryData(theEnv)->DefgenericArray[obji].trace = DefgenericData(theEnv)->WatchGenerics;
#endif
   DefgenericBinaryData(theEnv)->DefgenericArray[obji].methods = MethodPointer(bgp->methods);
   DefgenericBinaryData(theEnv)->DefgenericArray[obji].mcnt = bgp->mcnt;
   DefgenericBinaryData(theEnv)->DefgenericArray[obji].new_index = 0;
  }
Beispiel #22
0
static void UpdateMethod(
  void *theEnv,
  void *buf,
  long obji)
  {
   BSAVE_METHOD *bmth;

   bmth = (BSAVE_METHOD *) buf;
   DefgenericBinaryData(theEnv)->MethodArray[obji].index = bmth->index;
   DefgenericBinaryData(theEnv)->MethodArray[obji].busy = 0;
#if DEBUGGING_FUNCTIONS
   DefgenericBinaryData(theEnv)->MethodArray[obji].trace = DefgenericData(theEnv)->WatchMethods;
#endif
   DefgenericBinaryData(theEnv)->MethodArray[obji].restrictionCount = bmth->restrictionCount;
   DefgenericBinaryData(theEnv)->MethodArray[obji].minRestrictions = bmth->minRestrictions;
   DefgenericBinaryData(theEnv)->MethodArray[obji].maxRestrictions = bmth->maxRestrictions;
   DefgenericBinaryData(theEnv)->MethodArray[obji].localVarCount = bmth->localVarCount;
   DefgenericBinaryData(theEnv)->MethodArray[obji].system = bmth->system;
   DefgenericBinaryData(theEnv)->MethodArray[obji].restrictions = RestrictionPointer(bmth->restrictions);
   DefgenericBinaryData(theEnv)->MethodArray[obji].actions = ExpressionPointer(bmth->actions);
   DefgenericBinaryData(theEnv)->MethodArray[obji].ppForm = NULL;
   DefgenericBinaryData(theEnv)->MethodArray[obji].usrData = NULL;
  }
Beispiel #23
0
/****************************************************
  NAME         : CallNextMethod
  DESCRIPTION  : Executes the next available method
                   in the core for a generic function
  INPUTS       : Caller's buffer for the result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Side effects of execution of shadow
                 EvaluationError set if no method
                   is available to execute.
  NOTES        : H/L Syntax: (call-next-method)
 ****************************************************/
void CallNextMethod(
  UDFContext *context,
  CLIPSValue *returnValue)
  {
   DEFMETHOD *oldMethod;
   Environment *theEnv = UDFContextEnvironment(context);
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif

   mCVSetBoolean(returnValue,false);
   
   if (EvaluationData(theEnv)->HaltExecution)
     return;
   oldMethod = DefgenericData(theEnv)->CurrentMethod;
   if (DefgenericData(theEnv)->CurrentMethod != NULL)
     DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod);
   if (DefgenericData(theEnv)->CurrentMethod == NULL)
     {
      DefgenericData(theEnv)->CurrentMethod = oldMethod;
      PrintErrorID(theEnv,"GENRCEXE",2,false);
      EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n");
      EnvSetEvaluationError(theEnv,true);
      return;
     }

#if DEBUGGING_FUNCTIONS
   if (DefgenericData(theEnv)->CurrentMethod->trace)
     WatchMethod(theEnv,BEGIN_TRACE);
#endif
   if (DefgenericData(theEnv)->CurrentMethod->system)
     {
      EXPRESSION fcall;

      fcall.type = FCALL;
      fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value;
      fcall.nextArg = NULL;
      fcall.argList = GetProcParamExpressions(theEnv);
      EvaluateExpression(theEnv,&fcall,returnValue);
     }
   else
     {
#if PROFILING_FUNCTIONS
      StartProfile(theEnv,&profileFrame,
                   &DefgenericData(theEnv)->CurrentGeneric->header.usrData,
                   ProfileFunctionData(theEnv)->ProfileConstructs);
#endif

      EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule,
                         DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount,
                         returnValue,UnboundMethodErr);

#if PROFILING_FUNCTIONS
      EndProfile(theEnv,&profileFrame);
#endif
     }

   DefgenericData(theEnv)->CurrentMethod->busy--;
#if DEBUGGING_FUNCTIONS
   if (DefgenericData(theEnv)->CurrentMethod->trace)
     WatchMethod(theEnv,END_TRACE);
#endif
   DefgenericData(theEnv)->CurrentMethod = oldMethod;
   ProcedureFunctionData(theEnv)->ReturnFlag = false;
  }
Beispiel #24
0
/***********************************************************************************
  NAME         : GenericDispatch
  DESCRIPTION  : Executes the most specific applicable method
  INPUTS       : 1) The generic function
                 2) The method to start after in the search for an applicable
                    method (ignored if arg #3 is not NULL).
                 3) A specific method to call (NULL if want highest precedence
                    method to be called)
                 4) The generic function argument expressions
                 5) The caller's result value buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of evaluating the generic function arguments
                 Any side-effects of evaluating query functions on method parameter
                   restrictions when determining the core (see warning #1)
                 Any side-effects of actual execution of methods (see warning #2)
                 Caller's buffer set to the result of the generic function call

                 In case of errors, the result is false, otherwise it is the
                   result returned by the most specific method (which can choose
                   to ignore or return the values of more general methods)
  NOTES        : WARNING #1: Query functions on method parameter restrictions
                    should not have side-effects, for they might be evaluated even
                    for methods that aren't applicable to the generic function call.
                 WARNING #2: Side-effects of method execution should not always rely
                    on only being executed once per generic function call.  Every
                    time a method calls (shadow-call) the same next-most-specific
                    method is executed.  Thus, it is possible for a method to be
                    executed multiple times per generic function call.
 ***********************************************************************************/
void GenericDispatch(
  Environment *theEnv,
  Defgeneric *gfunc,
  Defmethod *prevmeth,
  Defmethod *meth,
  Expression *params,
  UDFValue *returnValue)
  {
   Defgeneric *previousGeneric;
   Defmethod *previousMethod;
   bool oldce;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif
   GCBlock gcb;

   returnValue->value = FalseSymbol(theEnv);
   EvaluationData(theEnv)->EvaluationError = false;
   if (EvaluationData(theEnv)->HaltExecution)
     return;

   GCBlockStart(theEnv,&gcb);

   oldce = ExecutingConstruct(theEnv);
   SetExecutingConstruct(theEnv,true);
   previousGeneric = DefgenericData(theEnv)->CurrentGeneric;
   previousMethod = DefgenericData(theEnv)->CurrentMethod;
   DefgenericData(theEnv)->CurrentGeneric = gfunc;
   EvaluationData(theEnv)->CurrentEvaluationDepth++;
   gfunc->busy++;
   PushProcParameters(theEnv,params,CountArguments(params),
                      DefgenericName(gfunc),
                      "generic function",UnboundMethodErr);
   if (EvaluationData(theEnv)->EvaluationError)
     {
      gfunc->busy--;
      DefgenericData(theEnv)->CurrentGeneric = previousGeneric;
      DefgenericData(theEnv)->CurrentMethod = previousMethod;
      EvaluationData(theEnv)->CurrentEvaluationDepth--;

      GCBlockEndUDF(theEnv,&gcb,returnValue);
      CallPeriodicTasks(theEnv);

      SetExecutingConstruct(theEnv,oldce);
      return;
     }
   if (meth != NULL)
     {
      if (IsMethodApplicable(theEnv,meth))
        {
         meth->busy++;
         DefgenericData(theEnv)->CurrentMethod = meth;
        }
      else
        {
         PrintErrorID(theEnv,"GENRCEXE",4,false);
         SetEvaluationError(theEnv,true);
         DefgenericData(theEnv)->CurrentMethod = NULL;
         WriteString(theEnv,STDERR,"Generic function '");
         WriteString(theEnv,STDERR,DefgenericName(gfunc));
         WriteString(theEnv,STDERR,"' method #");
         PrintUnsignedInteger(theEnv,STDERR,meth->index);
         WriteString(theEnv,STDERR," is not applicable to the given arguments.\n");
        }
     }
   else
     DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth);
   if (DefgenericData(theEnv)->CurrentMethod != NULL)
     {
#if DEBUGGING_FUNCTIONS
      if (DefgenericData(theEnv)->CurrentGeneric->trace)
        WatchGeneric(theEnv,BEGIN_TRACE);
      if (DefgenericData(theEnv)->CurrentMethod->trace)
        WatchMethod(theEnv,BEGIN_TRACE);
#endif
      if (DefgenericData(theEnv)->CurrentMethod->system)
        {
         Expression fcall;

         fcall.type = FCALL;
         fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value;
         fcall.nextArg = NULL;
         fcall.argList = GetProcParamExpressions(theEnv);
         EvaluateExpression(theEnv,&fcall,returnValue);
        }
      else
        {
#if PROFILING_FUNCTIONS
         StartProfile(theEnv,&profileFrame,
                      &DefgenericData(theEnv)->CurrentMethod->header.usrData,
                      ProfileFunctionData(theEnv)->ProfileConstructs);
#endif

         EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule,
                             DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount,
                             returnValue,UnboundMethodErr);

#if PROFILING_FUNCTIONS
         EndProfile(theEnv,&profileFrame);
#endif
        }
      DefgenericData(theEnv)->CurrentMethod->busy--;
#if DEBUGGING_FUNCTIONS
      if (DefgenericData(theEnv)->CurrentMethod->trace)
        WatchMethod(theEnv,END_TRACE);
      if (DefgenericData(theEnv)->CurrentGeneric->trace)
        WatchGeneric(theEnv,END_TRACE);
#endif
     }
   else if (! EvaluationData(theEnv)->EvaluationError)
     {
      PrintErrorID(theEnv,"GENRCEXE",1,false);
      WriteString(theEnv,STDERR,"No applicable methods for '");
      WriteString(theEnv,STDERR,DefgenericName(gfunc));
      WriteString(theEnv,STDERR,"'.\n");
      SetEvaluationError(theEnv,true);
     }
   gfunc->busy--;
   ProcedureFunctionData(theEnv)->ReturnFlag = false;
   PopProcParameters(theEnv);
   DefgenericData(theEnv)->CurrentGeneric = previousGeneric;
   DefgenericData(theEnv)->CurrentMethod = previousMethod;
   EvaluationData(theEnv)->CurrentEvaluationDepth--;

   GCBlockEndUDF(theEnv,&gcb,returnValue);
   CallPeriodicTasks(theEnv);

   SetExecutingConstruct(theEnv,oldce);
  }
Beispiel #25
0
/***********************************************************************************
  NAME         : GenericDispatch
  DESCRIPTION  : Executes the most specific applicable method
  INPUTS       : 1) The generic function
                 2) The method to start after in the search for an applicable
                    method (ignored if arg #3 is not NULL).
                 3) A specific method to call (NULL if want highest precedence
                    method to be called)
                 4) The generic function argument expressions
                 5) The caller's result value buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of evaluating the generic function arguments
                 Any side-effects of evaluating query functions on method parameter
                   restrictions when determining the core (see warning #1)
                 Any side-effects of actual execution of methods (see warning #2)
                 Caller's buffer set to the result of the generic function call

                 In case of errors, the result is false, otherwise it is the
                   result returned by the most specific method (which can choose
                   to ignore or return the values of more general methods)
  NOTES        : WARNING #1: Query functions on method parameter restrictions
                    should not have side-effects, for they might be evaluated even
                    for methods that aren't applicable to the generic function call.
                 WARNING #2: Side-effects of method execution should not always rely
                    on only being executed once per generic function call.  Every
                    time a method calls (shadow-call) the same next-most-specific
                    method is executed.  Thus, it is possible for a method to be
                    executed multiple times per generic function call.
 ***********************************************************************************/
void GenericDispatch(
  void *theEnv,
  DEFGENERIC *gfunc,
  DEFMETHOD *prevmeth,
  DEFMETHOD *meth,
  EXPRESSION *params,
  DATA_OBJECT *result)
  {
   DEFGENERIC *previousGeneric;
   DEFMETHOD *previousMethod;
   int oldce;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif
   struct CLIPSBlock gcBlock;
   
   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);
   EvaluationData(theEnv)->EvaluationError = false;
   if (EvaluationData(theEnv)->HaltExecution)
     return;

   CLIPSBlockStart(theEnv,&gcBlock);
   
   oldce = ExecutingConstruct(theEnv);
   SetExecutingConstruct(theEnv,true);
   previousGeneric = DefgenericData(theEnv)->CurrentGeneric;
   previousMethod = DefgenericData(theEnv)->CurrentMethod;
   DefgenericData(theEnv)->CurrentGeneric = gfunc;
   EvaluationData(theEnv)->CurrentEvaluationDepth++;
   gfunc->busy++;
   PushProcParameters(theEnv,params,CountArguments(params),
                      EnvGetDefgenericName(theEnv,(void *) gfunc),
                      "generic function",UnboundMethodErr);
   if (EvaluationData(theEnv)->EvaluationError)
     {
      gfunc->busy--;
      DefgenericData(theEnv)->CurrentGeneric = previousGeneric;
      DefgenericData(theEnv)->CurrentMethod = previousMethod;
      EvaluationData(theEnv)->CurrentEvaluationDepth--;
      
      CLIPSBlockEnd(theEnv,&gcBlock,result);
      CallPeriodicTasks(theEnv);
     
      SetExecutingConstruct(theEnv,oldce);
      return;
     }
   if (meth != NULL)
     {
      if (IsMethodApplicable(theEnv,meth))
        {
         meth->busy++;
         DefgenericData(theEnv)->CurrentMethod = meth;
        }
      else
        {
         PrintErrorID(theEnv,"GENRCEXE",4,false);
         EnvSetEvaluationError(theEnv,true);
         DefgenericData(theEnv)->CurrentMethod = NULL;
         EnvPrintRouter(theEnv,WERROR,"Generic function ");
         EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc));
         EnvPrintRouter(theEnv,WERROR," method #");
         PrintLongInteger(theEnv,WERROR,(long long) meth->index);
         EnvPrintRouter(theEnv,WERROR," is not applicable to the given arguments.\n");
        }
     }
   else
     DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth);
   if (DefgenericData(theEnv)->CurrentMethod != NULL)
     {
#if DEBUGGING_FUNCTIONS
      if (DefgenericData(theEnv)->CurrentGeneric->trace)
        WatchGeneric(theEnv,BEGIN_TRACE);
      if (DefgenericData(theEnv)->CurrentMethod->trace)
        WatchMethod(theEnv,BEGIN_TRACE);
#endif
      if (DefgenericData(theEnv)->CurrentMethod->system)
        {
         EXPRESSION fcall;

         fcall.type = FCALL;
         fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value;
         fcall.nextArg = NULL;
         fcall.argList = GetProcParamExpressions(theEnv);
         EvaluateExpression(theEnv,&fcall,result);
        }
      else
        {
#if PROFILING_FUNCTIONS
         StartProfile(theEnv,&profileFrame,
                      &DefgenericData(theEnv)->CurrentMethod->usrData,
                      ProfileFunctionData(theEnv)->ProfileConstructs);
#endif

         EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule,
                             DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount,
                             result,UnboundMethodErr);

#if PROFILING_FUNCTIONS
         EndProfile(theEnv,&profileFrame);
#endif
        }
      DefgenericData(theEnv)->CurrentMethod->busy--;
#if DEBUGGING_FUNCTIONS
      if (DefgenericData(theEnv)->CurrentMethod->trace)
        WatchMethod(theEnv,END_TRACE);
      if (DefgenericData(theEnv)->CurrentGeneric->trace)
        WatchGeneric(theEnv,END_TRACE);
#endif
     }
   else if (! EvaluationData(theEnv)->EvaluationError)
     {
      PrintErrorID(theEnv,"GENRCEXE",1,false);
      EnvPrintRouter(theEnv,WERROR,"No applicable methods for ");
      EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc));
      EnvPrintRouter(theEnv,WERROR,".\n");
      EnvSetEvaluationError(theEnv,true);
     }
   gfunc->busy--;
   ProcedureFunctionData(theEnv)->ReturnFlag = false;
   PopProcParameters(theEnv);
   DefgenericData(theEnv)->CurrentGeneric = previousGeneric;
   DefgenericData(theEnv)->CurrentMethod = previousMethod;
   EvaluationData(theEnv)->CurrentEvaluationDepth--;

   CLIPSBlockEnd(theEnv,&gcBlock,result);
   CallPeriodicTasks(theEnv);
   
   SetExecutingConstruct(theEnv,oldce);
  }
Beispiel #26
0
/***************************************************
  NAME         : ReadyDefgenericsForCode
  DESCRIPTION  : Sets index of generic-functions
                   for use in compiled expressions
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : BsaveIndices set
  NOTES        : None
 ***************************************************/
static void ReadyDefgenericsForCode(
  void *theEnv)
  {
   MarkConstructBsaveIDs(theEnv,DefgenericData(theEnv)->DefgenericModuleIndex);
  }
Beispiel #27
0
/*******************************************************
  NAME         : DefgenericsToCode
  DESCRIPTION  : Writes out static array code for
                   generic functions, methods, etc.
  INPUTS       : 1) The base name of the construct set
                 2) The base id for this construct
                 3) The file pointer for the header file
                 4) The base id for the construct set
                 5) The max number of indices allowed
                    in an array
  RETURNS      : -1 if no generic functions, 0 on errors,
                  1 if generic functions written
  SIDE EFFECTS : Code written to files
  NOTES        : None
 *******************************************************/
static int DefgenericsToCode(
  void *theEnv,
  char *fileName,
  char *pathName,
  char *fileNameBuffer,
  int fileID,
  FILE *headerFP,
  int imageID,
  int maxIndices)
  {
   int fileCount = 1;
   struct defmodule *theModule;
   DEFGENERIC *theDefgeneric;
   DEFMETHOD *theMethod;
   RESTRICTION *theRestriction;
   short i,j,k;
   int moduleCount = 0;
   int itemArrayCounts[SAVE_ITEMS];
   int itemArrayVersions[SAVE_ITEMS];
   FILE *itemFiles[SAVE_ITEMS];
   int itemReopenFlags[SAVE_ITEMS];
   struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS];

   for (i = 0 ; i < SAVE_ITEMS ; i++)
     {
      itemArrayCounts[i] = 0;
      itemArrayVersions[i] = 1;
      itemFiles[i] = NULL;
      itemReopenFlags[i] = FALSE;
      itemCodeFiles[i].filePrefix = NULL;
      itemCodeFiles[i].pathName = pathName;
      itemCodeFiles[i].fileNameBuffer = fileNameBuffer;
     }

   /* ===========================================
      Include the appropriate generic header file
      =========================================== */
   fprintf(headerFP,"#include \"genrcfun.h\"\n");

   /* =============================================================
      Loop through all the modules and all the defgenerics writing
      their C code representation to the file as they are traversed
      ============================================================= */
   theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);

   while (theModule != NULL)
     {
      EnvSetCurrentModule(theEnv,(void *) theModule);

      itemFiles[MODULEI] =
         OpenFileIfNeeded(theEnv,itemFiles[MODULEI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount,
                          itemArrayVersions[MODULEI],headerFP,
                          (char*)"DEFGENERIC_MODULE",ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem),
                          itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]);
      if (itemFiles[MODULEI] == NULL)
        goto GenericCodeError;

      DefgenericModuleToCode(theEnv,itemFiles[MODULEI],theModule,imageID,maxIndices);
      itemFiles[MODULEI] =
          CloseFileIfNeeded(theEnv,itemFiles[MODULEI],&itemArrayCounts[MODULEI],
                            &itemArrayVersions[MODULEI],maxIndices,
                            &itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]);

      theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL);

      while (theDefgeneric != NULL)
        {
         itemFiles[GENERICI] =
            OpenFileIfNeeded(theEnv,itemFiles[GENERICI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount,
                             itemArrayVersions[GENERICI],headerFP,
                             (char*)"DEFGENERIC",ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem),
                             itemReopenFlags[GENERICI],&itemCodeFiles[GENERICI]);
         if (itemFiles[GENERICI] == NULL)
           goto GenericCodeError;

         SingleDefgenericToCode(theEnv,itemFiles[GENERICI],imageID,maxIndices,theDefgeneric,
                                moduleCount,itemArrayVersions[METHODI],
                                itemArrayCounts[METHODI]);
         itemArrayCounts[GENERICI]++;
         itemFiles[GENERICI] =
           CloseFileIfNeeded(theEnv,itemFiles[GENERICI],&itemArrayCounts[GENERICI],
                             &itemArrayVersions[GENERICI],maxIndices,
                             &itemReopenFlags[GENERICI],&itemCodeFiles[GENERICI]);
         if (theDefgeneric->mcnt > 0)
           {

            /* ===========================================
               Make sure that all methods for a particular
               generic function go into the same array
               =========================================== */
            itemFiles[METHODI] =
                OpenFileIfNeeded(theEnv,itemFiles[METHODI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount,
                                 itemArrayVersions[METHODI],headerFP,
                                 (char*)"DEFMETHOD",MethodPrefix(),
                                 itemReopenFlags[METHODI],&itemCodeFiles[METHODI]);
            if (itemFiles[METHODI] == NULL)
              goto GenericCodeError;

            for (i = 0 ; i < theDefgeneric->mcnt ; i++)
              {
               theMethod = &theDefgeneric->methods[i];
               if (i > 0)
                 fprintf(itemFiles[METHODI],",\n");
               MethodToCode(theEnv,itemFiles[METHODI],imageID,theMethod,
                            itemArrayVersions[RESTRICTIONI],itemArrayCounts[RESTRICTIONI]);
               if (theMethod->restrictionCount > 0)
                 {
                  /* ========================================
                     Make sure that all restrictions for a
                     particular method go into the same array
                     ======================================== */
                  itemFiles[RESTRICTIONI] =
                     OpenFileIfNeeded(theEnv,itemFiles[RESTRICTIONI],fileName,pathName,fileNameBuffer,fileID,
                                      imageID,&fileCount,
                                      itemArrayVersions[RESTRICTIONI],headerFP,
                                      (char*)"RESTRICTION",RestrictionPrefix(),
                                      itemReopenFlags[RESTRICTIONI],&itemCodeFiles[RESTRICTIONI]);
                  if (itemFiles[RESTRICTIONI] == NULL)
                    goto GenericCodeError;
                  for (j = 0 ; j < theMethod->restrictionCount ; j++)
                    {
                     theRestriction = &theMethod->restrictions[j];
                     if (j > 0)
                       fprintf(itemFiles[RESTRICTIONI],",\n");
                     RestrictionToCode(theEnv,itemFiles[RESTRICTIONI],imageID,theRestriction,
                                       itemArrayVersions[TYPEI],itemArrayCounts[TYPEI]);

                     if (theRestriction->tcnt > 0)
                       {
                        /* =========================================
                           Make sure that all types for a particular
                           restriction go into the same array
                           ========================================= */
                        itemFiles[TYPEI] =
                           OpenFileIfNeeded(theEnv,itemFiles[TYPEI],fileName,pathName,fileNameBuffer,fileID,
                                            imageID,&fileCount,
                                            itemArrayVersions[TYPEI],headerFP,
                                            (char*)"void *",TypePrefix(),
                                            itemReopenFlags[TYPEI],&itemCodeFiles[TYPEI]);
                        if (itemFiles[TYPEI] == NULL)
                          goto GenericCodeError;
                        for (k = 0 ; k < theRestriction->tcnt ; k++)
                          {
                           if (k > 0)
                             fprintf(itemFiles[TYPEI],",\n");
                           TypeToCode(theEnv,itemFiles[TYPEI],imageID,
                                      theRestriction->types[k],maxIndices);
                          }
                        itemArrayCounts[TYPEI] += (int) theRestriction->tcnt;
                        itemFiles[TYPEI] =
                           CloseFileIfNeeded(theEnv,itemFiles[TYPEI],&itemArrayCounts[TYPEI],
                                             &itemArrayVersions[TYPEI],maxIndices,
                                             &itemReopenFlags[TYPEI],&itemCodeFiles[TYPEI]);
                       }
                    }
                  itemArrayCounts[RESTRICTIONI] += theMethod->restrictionCount;
                  itemFiles[RESTRICTIONI] =
                     CloseFileIfNeeded(theEnv,itemFiles[RESTRICTIONI],&itemArrayCounts[RESTRICTIONI],
                                       &itemArrayVersions[RESTRICTIONI],maxIndices,
                                       &itemReopenFlags[RESTRICTIONI],&itemCodeFiles[RESTRICTIONI]);
                 }
              }
            itemArrayCounts[METHODI] += (int) theDefgeneric->mcnt;
            itemFiles[METHODI] =
               CloseFileIfNeeded(theEnv,itemFiles[METHODI],&itemArrayCounts[METHODI],
                                 &itemArrayVersions[METHODI],maxIndices,
                                 &itemReopenFlags[METHODI],&itemCodeFiles[METHODI]);
           }
         theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric);
        }

      theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule);
      moduleCount++;
      itemArrayCounts[MODULEI]++;
     }
   CloseDefgenericFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices);
   return(1);

GenericCodeError:
   CloseDefgenericFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices);
   return(0);
  }
Beispiel #28
0
/***********************************************************************
  NAME         : IsMethodApplicable
  DESCRIPTION  : Tests to see if a method satsifies the arguments of a
                   generic function
                 A method is applicable if all its restrictions are
                   satisfied by the corresponding arguments
  INPUTS       : The method address
  RETURNS      : true if method is applicable, false otherwise
  SIDE EFFECTS : Any query functions are evaluated
  NOTES        : Uses globals ProcParamArraySize and ProcParamArray
 ***********************************************************************/
bool IsMethodApplicable(
  void *theEnv,
  DEFMETHOD *meth)
  {
   DATA_OBJECT temp;
   short i,j,k;
   register RESTRICTION *rp;
#if OBJECT_SYSTEM
   void *type;
#else
   int type;
#endif

   if ((ProceduralPrimitiveData(theEnv)->ProcParamArraySize < meth->minRestrictions) ||
       ((ProceduralPrimitiveData(theEnv)->ProcParamArraySize > meth->minRestrictions) && (meth->maxRestrictions != -1)))
     return(false);
   for (i = 0 , k = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++)
     {
      rp = &meth->restrictions[k];
      if (rp->tcnt != 0)
        {
#if OBJECT_SYSTEM
         type = (void *) DetermineRestrictionClass(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]);
         if (type == NULL)
           return(false);
         for (j = 0 ; j < rp->tcnt ; j++)
           {
            if (type == rp->types[j])
              break;
            if (HasSuperclass((DEFCLASS *) type,(DEFCLASS *) rp->types[j]))
              break;
            if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS])
              {
               if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_ADDRESS)
                 break;
              }
            else if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME])
              {
               if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_NAME)
                 break;
              }
            else if (rp->types[j] ==
                (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])
              {
               if ((ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_NAME) ||
                   (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_ADDRESS))
                 break;
              }
           }
#else
         type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type;
         for (j = 0 ; j < rp->tcnt ; j++)
           {
            if (type == ValueToInteger(rp->types[j]))
              break;
            if (SubsumeType(type,ValueToInteger(rp->types[j])))
              break;
           }
#endif
         if (j == rp->tcnt)
           return(false);
        }
      if (rp->query != NULL)
        {
         DefgenericData(theEnv)->GenericCurrentArgument = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i];
         EvaluateExpression(theEnv,rp->query,&temp);
         if ((temp.type != SYMBOL) ? false :
             (temp.value == EnvFalseSymbol(theEnv)))
           return(false);
        }
      if (((int) k) != meth->restrictionCount-1)
        k++;
     }
   return(true);
  }
Beispiel #29
0
/***************************************************
  NAME         : ClearDefgenericsReady
  DESCRIPTION  : Determines if it is safe to
                 remove all defgenerics
                 Assumes *all* constructs will be
                 deleted - only checks to see if
                 any methods are currently
                 executing
  INPUTS       : None
  RETURNS      : TRUE if no methods are
                 executing, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : Used by (clear) and (bload)
 ***************************************************/
globle intBool ClearDefgenericsReady(
  void *theEnv)
  {
   return((DefgenericData(theEnv)->CurrentGeneric != NULL) ? FALSE : TRUE);
  }
Beispiel #30
0
/***********************************************************************
  NAME         : IsMethodApplicable
  DESCRIPTION  : Tests to see if a method satsifies the arguments of a
                   generic function
                 A method is applicable if all its restrictions are
                   satisfied by the corresponding arguments
  INPUTS       : The method address
  RETURNS      : True if method is applicable, false otherwise
  SIDE EFFECTS : Any query functions are evaluated
  NOTES        : Uses globals ProcParamArraySize and ProcParamArray
 ***********************************************************************/
bool IsMethodApplicable(
  Environment *theEnv,
  Defmethod *meth)
  {
   UDFValue temp;
   unsigned int i,j,k;
   RESTRICTION *rp;
#if OBJECT_SYSTEM
   Defclass *type;
#else
   int type;
#endif

   if (((ProceduralPrimitiveData(theEnv)->ProcParamArraySize < meth->minRestrictions) && (meth->minRestrictions != RESTRICTIONS_UNBOUNDED)) ||
       ((ProceduralPrimitiveData(theEnv)->ProcParamArraySize > meth->minRestrictions) && (meth->maxRestrictions != RESTRICTIONS_UNBOUNDED))) // TBD minRestrictions || maxRestrictions
     return false;
   for (i = 0 , k = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++)
     {
      rp = &meth->restrictions[k];
      if (rp->tcnt != 0)
        {
#if OBJECT_SYSTEM
         type = DetermineRestrictionClass(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]);
         if (type == NULL)
           return false;
         for (j = 0 ; j < rp->tcnt ; j++)
           {
            if (type == rp->types[j])
              break;
            if (HasSuperclass(type,(Defclass *) rp->types[j]))
              break;
            if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS_TYPE])
              {
               if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type == INSTANCE_ADDRESS_TYPE)
                 break;
              }
            else if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME_TYPE])
              {
               if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type == INSTANCE_NAME_TYPE)
                 break;
              }
            else if (rp->types[j] ==
                DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME_TYPE]->directSuperclasses.classArray[0])
              {
               if ((ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type == INSTANCE_NAME_TYPE) ||
                   (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type == INSTANCE_ADDRESS_TYPE))
                 break;
              }
           }
#else
         type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type;
         for (j = 0 ; j < rp->tcnt ; j++)
           {
            if (type == ((CLIPSInteger *) (rp->types[j]))->contents)
              break;
            if (SubsumeType(type,((CLIPSInteger *) (rp->types[j]))->contents))
              break;
           }
#endif
         if (j == rp->tcnt)
           return false;
        }
      if (rp->query != NULL)
        {
         DefgenericData(theEnv)->GenericCurrentArgument = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i];
         EvaluateExpression(theEnv,rp->query,&temp);
         if (temp.value == FalseSymbol(theEnv))
           return false;
        }
      if ((k + 1) != meth->restrictionCount)
        k++;
     }
   return true;
  }