Exemple #1
0
/***************************************************************************
  NAME         : GetQueryInstanceSlot
  DESCRIPTION  : Internal function for referring to slots of instances in
                    instance array on instance-queries
  INPUTS       : The caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Caller's result buffer set appropriately
  NOTES        : H/L Syntax : ((query-instance-slot) <index> <slot-name>)
 **************************************************************************/
globle void GetQueryInstanceSlot(
  void *theEnv,
  DATA_OBJECT *result)
  {
   INSTANCE_TYPE *ins;
   INSTANCE_SLOT *sp;
   DATA_OBJECT temp;
   QUERY_CORE *core;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);

   core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
   ins = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
   EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1(theEnv,"get",1,"symbol");
      EnvSetEvaluationError(theEnv,TRUE);
      return;
     }
   sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(theEnv,ValueToString(temp.value),"instance-set query");
      return;
     }
   result->type = (unsigned short) sp->type;
   result->value = sp->value;
   if (sp->type == MULTIFIELD)
     {
      result->begin = 0;
      SetpDOEnd(result,GetInstanceSlotLength(sp));
     }
  }
Exemple #2
0
/***************************************************************************
  NAME         : GetQueryInstanceSlot
  DESCRIPTION  : Internal function for referring to slots of instances in
                    instance array on instance-queries
  INPUTS       : The caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Caller's result buffer set appropriately
  NOTES        : H/L Syntax : ((query-instance-slot) <index> <slot-name>)
 **************************************************************************/
globle void GetQueryInstanceSlot(
  DATA_OBJECT *result)
  {
   INSTANCE_TYPE *ins;
   INSTANCE_SLOT *sp;
   DATA_OBJECT temp;
   QUERY_CORE *core;

   result->type = SYMBOL;
   result->value = FalseSymbol;

   core = FindQueryCore(DOPToInteger(GetFirstArgument()));
   ins = core->solns[DOPToInteger(GetFirstArgument()->nextArg)];
   EvaluateExpression(GetFirstArgument()->nextArg->nextArg,&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1("get",1,"symbol");
      SetEvaluationError(TRUE);
      return;
     }
   sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(ValueToString(temp.value),"instance-set query");
      return;
     }
   result->type = sp->type;
   result->value = sp->value;
   if (sp->type == MULTIFIELD)
     {
      result->begin = 0;
      result->end = GetInstanceSlotLength(sp) - 1;
     }
  }
Exemple #3
0
/***********************************************************
  NAME         : DynamicHandlerPutSlot
  DESCRIPTION  : Directly puts a slot's value
                 (uses dynamic binding to lookup slot)
  INPUTS       : Data obejct buffer for holding slot value
  RETURNS      : Nothing useful
  SIDE EFFECTS : Slot modified - and caller's buffer set
                 to value (or symbol FALSE on errors)
  NOTES        : H/L Syntax: (put <slot> <value>*)
 ***********************************************************/
globle void DynamicHandlerPutSlot(
  DATA_OBJECT *theResult)
  {
   INSTANCE_SLOT *sp;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;

   theResult->type = SYMBOL;
   theResult->value = FalseSymbol;
   if (CheckCurrentMessage("dynamic-put",TRUE) == FALSE)
     return;
   EvaluateExpression(GetFirstArgument(),&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1("dynamic-put",1,"symbol");
      SetEvaluationError(TRUE);
      return;
     }
   ins = GetActiveInstance();
   sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(ValueToString(temp.value),"dynamic-put");
      return;
     }
   if ((sp->desc->noWrite == 0) ? FALSE :
       ((sp->desc->initializeOnly == 0) || (!ins->initializeInProgress)))
     {
      SlotAccessViolationError(ValueToString(sp->desc->slotName->name),
                               TRUE,(void *) ins);
      SetEvaluationError(TRUE);
      return;
     }
   if ((sp->desc->publicVisibility == 0) &&
       (CurrentCore->hnd->cls != sp->desc->cls))
     {
      SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls);
      SetEvaluationError(TRUE);
      return;
     }
   if (GetFirstArgument()->nextArg)
     {
      if (EvaluateAndStoreInDataObject((int) sp->desc->multiple,
                        GetFirstArgument()->nextArg,&temp) == FALSE)
        return;
     }
   else
     {
      SetpDOBegin(&temp,1);
      SetpDOEnd(&temp,0);
      SetpType(&temp,MULTIFIELD);
      SetpValue(&temp,NoParamValue);
     }
   PutSlotValue(ins,sp,&temp,theResult,NULL);
  }
Exemple #4
0
/*****************************************************
  NAME         : DynamicHandlerGetSlot
  DESCRIPTION  : Directly references a slot's value
                 (uses dynamic binding to lookup slot)
  INPUTS       : The caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Caller's result buffer set
  NOTES        : H/L Syntax: (get <slot>)
 *****************************************************/
globle void DynamicHandlerGetSlot(
  DATA_OBJECT *result)
  {
   INSTANCE_SLOT *sp;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;

   result->type = SYMBOL;
   result->value = FalseSymbol;
   if (CheckCurrentMessage("dynamic-get",TRUE) == FALSE)
     return;
   EvaluateExpression(GetFirstArgument(),&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1("dynamic-get",1,"symbol");
      SetEvaluationError(TRUE);
      return;
     }
   ins = GetActiveInstance();
   sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(ValueToString(temp.value),"dynamic-get");
      return;
     }
   if ((sp->desc->publicVisibility == 0) &&
       (CurrentCore->hnd->cls != sp->desc->cls))
     {
      SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls);
      SetEvaluationError(TRUE);
      return;
     }
   result->type = sp->type;
   result->value = sp->value;
   if (sp->type == MULTIFIELD)
     {
      result->begin = 0;
      result->end = GetInstanceSlotLength(sp) - 1;
     }
  }
/*********************************************************************
  NAME         : CheckMultifieldSlotModify
  DESCRIPTION  : For the functions slot-replace$, insert, & delete
                    as well as direct-slot-replace$, insert, & delete
                    this function gets the slot, index, and optional
                    field-value for these functions
  INPUTS       : 1) A code indicating the type of operation
                      INSERT    (0) : Requires one index
                      REPLACE   (1) : Requires two indices
                      DELETE_OP (2) : Requires two indices
                 2) Function name-string
                 3) Instance address
                 4) Argument expression chain
                 5) Caller's buffer for index (or beginning of range)
                 6) Caller's buffer for end of range
                     (can be NULL for INSERT)
                 7) Caller's new-field value buffer
                     (can be NULL for DELETE_OP)
  RETURNS      : The address of the instance-slot,
                    NULL on errors
  SIDE EFFECTS : Caller's index buffer set
                 Caller's new-field value buffer set (if not NULL)
                   Will allocate an ephemeral segment to store more
                     than 1 new field value
                 EvaluationError set on errors
  NOTES        : Assume the argument chain is at least 2
                   expressions deep - slot, index, and optional values
 *********************************************************************/
static INSTANCE_SLOT *CheckMultifieldSlotModify(
  void *theEnv,
  int code,
  char *func,
  INSTANCE_TYPE *ins,
  EXPRESSION *args,
  int *rb,
  int *re,
  DATA_OBJECT *newval)
  {
   DATA_OBJECT temp;
   INSTANCE_SLOT *sp;
   int start;

   start = (args == GetFirstArgument()) ? 1 : 2;
   EvaluationData(theEnv)->EvaluationError = FALSE;
   EvaluateExpression(theEnv,args,&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1(theEnv,func,start,"symbol");
      SetEvaluationError(theEnv,TRUE);
      return(NULL);
     }
   sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(theEnv,ValueToString(temp.value),func);
      return(NULL);
     }
   if (sp->desc->multiple == 0)
     {
      PrintErrorID(theEnv,"INSMULT",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Function ");
      EnvPrintRouter(theEnv,WERROR,func);
      EnvPrintRouter(theEnv,WERROR," cannot be used on single-field slot ");
      EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
      EnvPrintRouter(theEnv,WERROR," in instance ");
      EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
      EnvPrintRouter(theEnv,WERROR,".\n");
      SetEvaluationError(theEnv,TRUE);
      return(NULL);
     }
   EvaluateExpression(theEnv,args->nextArg,&temp);
   if (temp.type != INTEGER)
     {
      ExpectedTypeError1(theEnv,func,start+1,"integer");
      SetEvaluationError(theEnv,TRUE);
      return(NULL);
     }
   args = args->nextArg->nextArg;
   *rb = ValueToInteger(temp.value);
   if ((code == REPLACE) || (code == DELETE_OP))
     {
      EvaluateExpression(theEnv,args,&temp);
      if (temp.type != INTEGER)
        {
         ExpectedTypeError1(theEnv,func,start+2,"integer");
         SetEvaluationError(theEnv,TRUE);
         return(NULL);
        }
      *re = ValueToInteger(temp.value);
      args = args->nextArg;
     }
   if ((code == INSERT) || (code == REPLACE))
     {
      if (EvaluateAndStoreInDataObject(theEnv,1,args,newval) == FALSE)
        return(NULL);
     }
   return(sp);
  }