Esempio n. 1
0
/***************************************************
  NAME         : EnvGetNextInstanceInClassAndSubclasses
  DESCRIPTION  : Finds next instance of class
                 (or first instance of class) and
                 all of its subclasses
  INPUTS       : 1) Class address (DIRECT POINTER!)
                 2) Instance address
                    (NULL to get first instance)
  RETURNS      : The next or first class instance
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle void *EnvGetNextInstanceInClassAndSubclasses_PY(
  void *theEnv,
  void *cptr,   /* this has changed */
  void *iptr,
  DATA_OBJECT *iterationInfo)
  {
   INSTANCE_TYPE *nextInstance;
   DEFCLASS *theClass;

   theClass = (DEFCLASS *)cptr;

   if (iptr == NULL)
     {
      ClassSubclassAddresses(theEnv,theClass,iterationInfo,TRUE);
      nextInstance = theClass->instanceList;
     }
   else if (((INSTANCE_TYPE *) iptr)->garbage == 1)
     { nextInstance = NULL; }
   else
     { nextInstance = ((INSTANCE_TYPE *) iptr)->nxtClass; }

   while ((nextInstance == NULL) &&
          (GetpDOBegin(iterationInfo) <= GetpDOEnd(iterationInfo)))
     {
      theClass = (struct defclass *) GetMFValue(DOPToPointer(iterationInfo),
                                                GetpDOBegin(iterationInfo));
      SetpDOBegin(iterationInfo,GetpDOBegin(iterationInfo) + 1);
      nextInstance = theClass->instanceList;
     }

   return(nextInstance);
  }
Esempio n. 2
0
globle struct expr *ConvertValueToExpression(
  DATA_OBJECT *theValue)
  {
   long i;
   struct expr *head = NULL, *last = NULL, *newItem;

   if (GetpType(theValue) != MULTIFIELD)
     { return(GenConstant(GetpType(theValue),GetpValue(theValue))); }

   for (i = GetpDOBegin(theValue); i <= GetpDOEnd(theValue); i++)
     {
      newItem = GenConstant(GetMFType(GetpValue(theValue),i),
                        GetMFValue(GetpValue(theValue),i));
      if (last == NULL) head = newItem;
      else last->nextArg = newItem;
      last = newItem;
     }

   if (head == NULL)
     return(GenConstant(FCALL,(void *) FindFunction("create$")));

   return(head);
  }
Esempio n. 3
0
/*************************************************************
  NAME         : FormChain
  DESCRIPTION  : Builds a list of classes to be used in
                   fact queries - uses parse form.
  INPUTS       : 1) Name of calling function for error msgs
                 2) Data object - must be a symbol or a
                      multifield value containing all symbols
                 The symbols must be names of existing templates
  RETURNS      : The query chain, or NULL on errors
  SIDE EFFECTS : Memory allocated for chain
                 Busy count incremented for all templates
  NOTES        : None
 *************************************************************/
static QUERY_TEMPLATE *FormChain(
  void *theEnv,
  char *func,
  DATA_OBJECT *val)
  {
   struct deftemplate *templatePtr;
   QUERY_TEMPLATE *head,*bot,*tmp;
   register long i,end; /* 6.04 Bug Fix */
   char *templateName;
   int count;

   if (val->type == DEFTEMPLATE_PTR)
     {
      IncrementDeftemplateBusyCount(theEnv,(void *) val->value);
      head = get_struct(theEnv,query_template);
      head->templatePtr = (struct deftemplate *) val->value;

      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == SYMBOL)
     {
      /* ===============================================
         Allow instance-set query restrictions to have a
         module specifier as part of the class name,
         but search imported defclasses too if a
         module specifier is not given
         =============================================== */
         
      templatePtr = (struct deftemplate *)
                       FindImportedConstruct(theEnv,"deftemplate",NULL,DOPToString(val),
                                             &count,TRUE,NULL);
      if (templatePtr == NULL)
        {
         CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",DOPToString(val),func);
         return(NULL);
        }
      IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
      head = get_struct(theEnv,query_template);
      head->templatePtr = templatePtr;

      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == MULTIFIELD)
     {
      head = bot = NULL;
      end = GetpDOEnd(val);
      for (i = GetpDOBegin(val) ; i <= end ; i++)
        {
         if (GetMFType(val->value,i) == SYMBOL)
           {
            templateName = ValueToString(GetMFValue(val->value,i));
            
            templatePtr = (struct deftemplate *)
                       FindImportedConstruct(theEnv,"deftemplate",NULL,templateName,
                                             &count,TRUE,NULL);

            if (templatePtr == NULL)
              {
               CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",templateName,func);
               DeleteQueryTemplates(theEnv,head);
               return(NULL);
              }
           }
         else
           {
            DeleteQueryTemplates(theEnv,head);
            return(NULL);
           }
         IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
         tmp = get_struct(theEnv,query_template);
         tmp->templatePtr = templatePtr;

         tmp->chain = NULL;
         tmp->nxt = NULL;
         if (head == NULL)
           head = tmp;
         else
           bot->chain = tmp;
         bot = tmp;
        }
      return(head);
     }
   return(NULL);
  }
Esempio n. 4
0
globle void *ImplodeMultifield(
  void *theEnv,
  DATA_OBJECT *value)
  {
   size_t strsize = 0;
   long i, j;
   const char *tmp_str;
   char *ret_str;
   void *rv;
   struct multifield *theMultifield;
   DATA_OBJECT tempDO;

   /*===================================================*/
   /* Determine the size of the string to be allocated. */
   /*===================================================*/

   theMultifield = (struct multifield *) GetpValue(value);
   for (i = GetpDOBegin(value) ; i <= GetpDOEnd(value) ; i++)
     {
      if (GetMFType(theMultifield,i) == FLOAT)
        {
         tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
         strsize += strlen(tmp_str) + 1;
        }
      else if (GetMFType(theMultifield,i) == INTEGER)
        {
         tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
         strsize += strlen(tmp_str) + 1;
        }
      else if (GetMFType(theMultifield,i) == STRING)
        {
         strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3;
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         while(*tmp_str)
           {
            if (*tmp_str == '"')
              { strsize++; }
            else if (*tmp_str == '\\') /* GDR 111599 #835 */
              { strsize++; }           /* GDR 111599 #835 */
            tmp_str++;
           }
        }
#if OBJECT_SYSTEM
      else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
        { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; }
      else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
        { strsize += strlen(ValueToString(((INSTANCE_TYPE *)
                            GetMFValue(theMultifield,i))->name)) + 3; }
#endif

      else
        { 
         SetType(tempDO,GetMFType(theMultifield,i));
         SetValue(tempDO,GetMFValue(theMultifield,i));
         strsize += strlen(DataObjectToString(theEnv,&tempDO)) + 1; 
        }
     }

   /*=============================================*/
   /* Allocate the string and copy all components */
   /* of the MULTIFIELD variable to it.           */
   /*=============================================*/

   if (strsize == 0) return(EnvAddSymbol(theEnv,""));
   ret_str = (char *) gm2(theEnv,strsize);
   for(j=0, i=GetpDOBegin(value); i <= GetpDOEnd(value) ; i++)
     {
      /*============================*/
      /* Convert numbers to strings */
      /*============================*/

      if (GetMFType(theMultifield,i) == FLOAT)
        {
         tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
        }
      else if (GetMFType(theMultifield,i) == INTEGER)
        {
         tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
        }

      /*=======================================*/
      /* Enclose strings in quotes and preceed */
      /* imbedded quotes with a backslash      */
      /*=======================================*/

      else if (GetMFType(theMultifield,i) == STRING)
        {
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         *(ret_str+j) = '"';
         j++;
         while(*tmp_str)
           {
            if (*tmp_str == '"')
              {
               *(ret_str+j) = '\\';
               j++;
              }
            else if (*tmp_str == '\\') /* GDR 111599 #835 */
              {                        /* GDR 111599 #835 */
               *(ret_str+j) = '\\';    /* GDR 111599 #835 */
               j++;                    /* GDR 111599 #835 */
              }                        /* GDR 111599 #835 */
              
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str+j) = '"';
         j++;
        }
#if OBJECT_SYSTEM
      else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
        {
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         *(ret_str + j++) = '[';
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str + j++) = ']';
        }
      else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
        {
         tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name);
         *(ret_str + j++) = '[';
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str + j++) = ']';
        }
#endif
      else
        {
         SetType(tempDO,GetMFType(theMultifield,i));
         SetValue(tempDO,GetMFValue(theMultifield,i));
         tmp_str = DataObjectToString(theEnv,&tempDO);
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         }
      *(ret_str+j) = ' ';
      j++;
     }
   *(ret_str+j-1) = '\0';

   /*====================*/
   /* Return the string. */
   /*====================*/

   rv = EnvAddSymbol(theEnv,ret_str);
   rm(theEnv,ret_str,strsize);
   return(rv);
  }
Esempio n. 5
0
globle void StoreInMultifield(
  void *theEnv,
  DATA_OBJECT *returnValue,
  EXPRESSION *expptr,
  int garbageSegment)
  {
   DATA_OBJECT val_ptr;
   DATA_OBJECT *val_arr;
   struct multifield *theMultifield;
   struct multifield *orig_ptr;
   long start, end, i,j, k, argCount;
   unsigned long seg_size;

   argCount = CountArguments(expptr);

   /*=========================================*/
   /* If no arguments are given return a NULL */
   /* multifield of length zero.              */
   /*=========================================*/

   if (argCount == 0)
     {
      SetpType(returnValue,MULTIFIELD);
      SetpDOBegin(returnValue,1);
      SetpDOEnd(returnValue,0);
      if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L);
      else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
      SetpValue(returnValue,(void *) theMultifield);
      return;
     }
   else
     {
      /*========================================*/
      /* Get a new segment with length equal to */
      /* the total length of all the arguments. */
      /*========================================*/

      val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount);
      seg_size = 0;
      
      for (i = 1; i <= argCount; i++, expptr = expptr->nextArg)
        {
         EvaluateExpression(theEnv,expptr,&val_ptr);
         if (EvaluationData(theEnv)->EvaluationError)
           {
            SetpType(returnValue,MULTIFIELD);
            SetpDOBegin(returnValue,1);
            SetpDOEnd(returnValue,0);
            if (garbageSegment)
              { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); }
            else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
            SetpValue(returnValue,(void *) theMultifield);
            rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
            return;
           }
         SetpType(val_arr+i-1,GetType(val_ptr));
         if (GetType(val_ptr) == MULTIFIELD)
           {
            SetpValue(val_arr+i-1,GetpValue(&val_ptr));
            start = GetDOBegin(val_ptr);
            end = GetDOEnd(val_ptr);
           }
         else if (GetType(val_ptr) == RVOID)
           {
            SetpValue(val_arr+i-1,GetValue(val_ptr));
            start = 1;
            end = 0;
           }
         else
           {
            SetpValue(val_arr+i-1,GetValue(val_ptr));
            start = end = -1;
           }

         seg_size += (unsigned long) (end - start + 1);
         SetpDOBegin(val_arr+i-1,start);
         SetpDOEnd(val_arr+i-1,end);
        }

      if (garbageSegment)
        { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); }
      else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size);

      /*========================================*/
      /* Copy each argument into new segment.  */
      /*========================================*/

      for (k = 0, j = 1; k < argCount; k++)
        {
         if (GetpType(val_arr+k) == MULTIFIELD)
           {
            start = GetpDOBegin(val_arr+k);
            end = GetpDOEnd(val_arr+k);
            orig_ptr = (struct multifield *) GetpValue(val_arr+k);
            for (i = start; i < end + 1; i++, j++)
              {
               SetMFType(theMultifield,j,(GetMFType(orig_ptr,i)));
               SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i)));
              }
           }
         else if (GetpType(val_arr+k) != RVOID)
           {
            SetMFType(theMultifield,j,(short) (GetpType(val_arr+k)));
            SetMFValue(theMultifield,j,(GetpValue(val_arr+k)));
            j++;
           }
        }

      /*=========================*/
      /* Return the new segment. */
      /*=========================*/

      SetpType(returnValue,MULTIFIELD);
      SetpDOBegin(returnValue,1);
      SetpDOEnd(returnValue,(long) seg_size);
      SetpValue(returnValue,(void *) theMultifield);
      rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
      return;
     }
  }
Esempio n. 6
0
/***********************************************************************
  NAME         : ExpandFuncMultifield
  DESCRIPTION  : Recursively examines an expression and replaces
                   PROC_EXPAND_MULTIFIELD expressions with the expanded
                   evaluation expression of its argument
  INPUTS       : 1) A data object result buffer
                 2) The expression to modify
                 3) The address of the expression, in case it is
                    deleted entirely
                 4) The address of the H/L function expand$
  RETURNS      : Nothing useful
  SIDE EFFECTS : Expressions allocated/deallocated as necessary
                 Evaluations performed
                 On errors, argument expression set to call a function
                   which causes an evaluation error when evaluated
                   a second time by actual caller.
  NOTES        : THIS ROUTINE MODIFIES EXPRESSIONS AT RUNTIME!!  MAKE
                 SURE THAT THE EXPRESSION PASSED IS SAFE TO CHANGE!!
 **********************************************************************/
static void ExpandFuncMultifield(
    void *theEnv,
    DATA_OBJECT *result,
    EXPRESSION *theExp,
    EXPRESSION **sto,
    void *expmult)
{
    EXPRESSION *newexp,*top,*bot;
    register long i; /* 6.04 Bug Fix */

    while (theExp != NULL)
    {
        if (theExp->value == expmult)
        {
            EvaluateExpression(theEnv,theExp->argList,result);
            ReturnExpression(theEnv,theExp->argList);
            if ((EvaluationData(theEnv)->EvaluationError) || (result->type != MULTIFIELD))
            {
                theExp->argList = NULL;
                if ((EvaluationData(theEnv)->EvaluationError == FALSE) && (result->type != MULTIFIELD))
                    ExpectedTypeError2(theEnv,"expand$",1);
                theExp->value = (void *) FindFunction(theEnv,"(set-evaluation-error)");
                EvaluationData(theEnv)->EvaluationError = FALSE;
                EvaluationData(theEnv)->HaltExecution = FALSE;
                return;
            }
            top = bot = NULL;
            for (i = GetpDOBegin(result) ; i <= GetpDOEnd(result) ; i++)
            {
                newexp = get_struct(theEnv,expr);
                newexp->type = GetMFType(result->value,i);
                newexp->value = GetMFValue(result->value,i);
                newexp->argList = NULL;
                newexp->nextArg = NULL;
                if (top == NULL)
                    top = newexp;
                else
                    bot->nextArg = newexp;
                bot = newexp;
            }
            if (top == NULL)
            {
                *sto = theExp->nextArg;
                rtn_struct(theEnv,expr,theExp);
                theExp = *sto;
            }
            else
            {
                bot->nextArg = theExp->nextArg;
                *sto = top;
                rtn_struct(theEnv,expr,theExp);
                sto = &bot->nextArg;
                theExp = bot->nextArg;
            }
        }
        else
        {
            if (theExp->argList != NULL)
                ExpandFuncMultifield(theEnv,result,theExp->argList,&theExp->argList,expmult);
            sto = &theExp->nextArg;
            theExp = theExp->nextArg;
        }
    }
}
Esempio n. 7
0
/*************************************************************
  NAME         : FormChain
  DESCRIPTION  : Builds a list of classes to be used in
                   instance queries - uses parse form.
  INPUTS       : 1) Name of calling function for error msgs
                 2) Data object - must be a symbol or a
                      multifield value containing all symbols
                 The symbols must be names of existing classes
  RETURNS      : The query chain, or NULL on errors
  SIDE EFFECTS : Memory allocated for chain
                 Busy count incremented for all classes
  NOTES        : None
 *************************************************************/
static QUERY_CLASS *FormChain(
  void *theEnv,
  EXEC_STATUS,
  char *func,
  DATA_OBJECT *val)
  {
   DEFCLASS *cls;
   QUERY_CLASS *head,*bot,*tmp;
   register long i,end; /* 6.04 Bug Fix */
   char *className;
   struct defmodule *currentModule;

   currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus));
   if (val->type == DEFCLASS_PTR)
     {
      IncrementDefclassBusyCount(theEnv,execStatus,(void *) val->value);
      head = get_struct(theEnv,execStatus,query_class);
      head->cls = (DEFCLASS *) val->value;
      if (DefclassInScope(theEnv,execStatus,head->cls,currentModule))
        head->theModule = currentModule;
      else
        head->theModule = head->cls->header.whichModule->theModule;
      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == SYMBOL)
     {
      /* ===============================================
         Allow instance-set query restrictions to have a
         module specifier as part of the class name,
         but search imported defclasses too if a
         module specifier is not given
         =============================================== */
      cls = LookupDefclassByMdlOrScope(theEnv,execStatus,DOPToString(val));
      if (cls == NULL)
        {
         ClassExistError(theEnv,execStatus,func,DOPToString(val));
         return(NULL);
        }
      IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls);
      head = get_struct(theEnv,execStatus,query_class);
      head->cls = cls;
      if (DefclassInScope(theEnv,execStatus,head->cls,currentModule))
        head->theModule = currentModule;
      else
        head->theModule = head->cls->header.whichModule->theModule;
      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == MULTIFIELD)
     {
      head = bot = NULL;
      end = GetpDOEnd(val);
      for (i = GetpDOBegin(val) ; i <= end ; i++)
        {
         if (GetMFType(val->value,i) == SYMBOL)
           {
            className = ValueToString(GetMFValue(val->value,i));
            cls = LookupDefclassByMdlOrScope(theEnv,execStatus,className);
            if (cls == NULL)
              {
               ClassExistError(theEnv,execStatus,func,className);
               DeleteQueryClasses(theEnv,execStatus,head);
               return(NULL);
              }
           }
         else
           {
            DeleteQueryClasses(theEnv,execStatus,head);
            return(NULL);
           }
         IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls);
         tmp = get_struct(theEnv,execStatus,query_class);
         tmp->cls = cls;
         if (DefclassInScope(theEnv,execStatus,tmp->cls,currentModule))
           tmp->theModule = currentModule;
         else
           tmp->theModule = tmp->cls->header.whichModule->theModule;
         tmp->chain = NULL;
         tmp->nxt = NULL;
         if (head == NULL)
           head = tmp;
         else
           bot->chain = tmp;
         bot = tmp;
        }
      return(head);
     }
   return(NULL);
  }