gbx_exec.c

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

            EC = NULL;
            retry = TRUE;
          }
        }
      }
      END_TRY

      #if DEBUG_ERROR
      if (retry)
        printf("retry %p\n", PC);
      #endif
    }
    while (retry);
  }

  if (!keep_ret_value)
    EXEC_release_return_value();

  STACK_pop_frame(&EXEC_current);
  /*PC = save;*/
}


PUBLIC bool EXEC_call_native(void (*exec)(), void *object, TYPE type, VALUE *param)
{
  TYPE save = GAMBAS_ReturnType;
  GAMBAS_Error = FALSE;

  GAMBAS_ReturnType = type;
  TEMP.type = T_NULL;

  /*OBJECT_REF(object, "EXEC_call_native"); N'est plus n�essaire ! */
  (*exec)(object, (void *)param);
  /*OBJECT_UNREF(&object, "EXEC_call_native");*/

  GAMBAS_ReturnType = save;
  return GAMBAS_Error;
}


PUBLIC void EXEC_native(void)
{
  CLASS_DESC_METHOD *desc = EXEC.desc;
  bool drop = EXEC.drop;
  int nparam = EXEC.nparam;
  bool use_stack = EXEC.use_stack;
  void *object = EXEC.object;

  int i; /* ,j */
  VALUE *value;
  TYPE *sign;
  bool error;
  void *free;
  int n;
  VALUE ret;

  /* v�ification des param�res */

  #if DEBUG_STACK
  printf("| >> EXEC_native: %s.%s (%p)\n", EXEC.class->name, desc->name, &desc);
  #endif

  if (nparam < desc->npmin)
    THROW(E_NEPARAM);
  
  if (!desc->npvar)
  {
    if (nparam > desc->npmax)
      THROW(E_TMPARAM);
  
    value = &SP[-nparam];
    sign = desc->signature;
  
    for (i = 0; i < desc->npmin; i++, value++, sign++)
      VALUE_conv(value, *sign);
  
    if (desc->npmin < desc->npmax)
    {
      for (; i < nparam; i++, value++, sign++)
      {
        if (value->type != T_VOID)
          VALUE_conv(value, *sign);
      }
      
      n = desc->npmax - nparam;

      STACK_check(n);
      SP += n;
      nparam = desc->npmax;

      for (; i < nparam; i++, value++)
        value->type = T_VOID;  
    }
  }
  else
  {
    value = &SP[-nparam];
    sign = desc->signature;
  
    for (i = 0; i < desc->npmin; i++, value++, sign++)
      VALUE_conv(value, *sign);
  
    if (desc->npmin < desc->npmax)
    {
      if (nparam < desc->npmax)
      {
        for (; i < nparam; i++, value++, sign++)
        {
          if (value->type != T_VOID)
            VALUE_conv(value, *sign);
        }
  
        n = desc->npmax - nparam;
  
        STACK_check(n);
        SP += n;
        nparam = desc->npmax;
  
        for (; i < nparam; i++, value++)
          value->type = T_VOID;  
      }
      else
      {
        for (; i < desc->npmax; i++, value++, sign++)
        {
          if (value->type != T_VOID)
            VALUE_conv(value, *sign);
        }
      }
    }
  
    if (desc->npmax < nparam)
      EXEC.nparvar = nparam - desc->npmax;
    else
      EXEC.nparvar = 0;
  
    for (; i < nparam; i++, value++)
      VARIANT_undo(value);
  }

  error = EXEC_call_native(desc->exec, object, desc->type, &SP[-nparam]);
  ret = TEMP;

  /* Lib�ation des arguments */

  while (nparam > 0)
  {
    nparam--;
    POP();
  }

  /* Si la description de la fonction se trouve sur la pile */

  if (use_stack)
  {
    SP--;
    free = SP->_function.object;
    SP->type = T_NULL;
  }

  /*
  #if DEBUG_STACK
  else
    printf("** SP != func SP = %p func = %p **\n>", SP, func);
  #endif
  */

  if (!error)
  {
    if (desc->type == T_VOID)
    {
      if (!drop)
      {
        SP->type = T_VOID;
        SP->_void.ptype = T_NULL;
        SP++;
      }
    }
    else
    {
      BORROW(&ret);

      if (drop)
        RELEASE(&ret);
      else
      {
        VALUE_conv(&ret, desc->type);
        *SP = ret;
        SP++;
      }
    }
  }

  if (use_stack)
    OBJECT_UNREF(&free, "EXEC_native (FUNCTION)");

  if (error)
    PROPAGATE();

  #if DEBUG_STACK
  printf("| << EXEC_native: %s (%p)\n", desc->name, &desc);
  #endif
}


PUBLIC void EXEC_object(VALUE *val, CLASS **class, OBJECT **object, boolean *defined)
{
  if (val->type == T_FUNCTION && val->_function.kind == FUNCTION_UNKNOWN)
  {
    EXEC.class = val->_function.class;
    EXEC.object = val->_function.object;
    EXEC.drop = FALSE;
    EXEC.nparam = 0;
    EXEC.native = TRUE;
    EXEC.desc = &EXEC.class->special[SPEC_UNKNOWN]->method;
    EXEC.use_stack = FALSE;
    EXEC.index = val->_function.index;
    EXEC.property = TRUE;

    /*SP--; on ne d�remente pas SP, car on ne sait pas sur quoi pointe val */
    /* => il faut qu'il y ait une place vide dans la pile, sinon crash !*/
    *object = EXEC.object;

    EXEC_native();

    OBJECT_UNREF(object, "EXEC_object (FUNCTION)");

    SP--;
    *val = *SP;
  }

  if (val->type == T_CLASS)
  {
    *class = val->_class.class;
    *object = NULL;
    *defined = TRUE;

    CLASS_load(*class);

    #if 0
    if ((*class)->auto_create)
    {
      *object = CLASS_auto_create(*class); /* object is checked by CLASS_auto_create */
      OBJECT_REF(*object, "EXEC_object");
    }
    #endif
  }
  else
  {
    if (val->type == T_OBJECT)
    {
      *object = val->_object.object;
      *class = OBJECT_class(*object);
      *defined = FALSE;
    }
    else if (TYPE_is_object(val->type))
    {
      *object = val->_object.object;
      *class = val->_object.class;
      *defined = TRUE;
    }
    else if (val->type == T_VARIANT)
    {
      if (val->_variant.vtype == T_OBJECT)
      {
        *object = *((void **)val->_variant.value);
        *class = OBJECT_class(*object);
        *defined = FALSE;
      }
      else if (TYPE_is_object(val->_variant.vtype))
      {
        *object = *((void **)val->_variant.value);
        *class = (CLASS *)val->_variant.vtype;
        *defined = FALSE;
      }
      else
        THROW(E_NOBJECT);
    }
    else
      THROW(E_NOBJECT);

    if (*object == NULL)
      THROW(E_NULL);

    CLASS_load(*class);

    if ((*class)->check(*object))
      THROW(E_IOBJECT);
  }
}


PUBLIC void EXEC_public(CLASS *class, void *object, const char *name, int nparam)
{
  CLASS_DESC *desc;

  desc = CLASS_get_symbol_desc_kind(class, name, (object != NULL) ? CD_METHOD : CD_STATIC_METHOD, 0);

  if (desc == NULL)
    return;

  EXEC.class = desc->method.class;
  EXEC.object = object;
  EXEC.nparam = nparam;
  EXEC.drop = TRUE;

  if (FUNCTION_is_native(&desc->method))
  {
    EXEC.desc = &desc->method;
    EXEC.use_stack = FALSE;
    EXEC_native();
  }
  else
  {
    EXEC.index = (long)desc->method.exec;
    //EXEC.func = &class->load->func[(long)desc->method.exec]
    EXEC_function();
  }
}



PUBLIC boolean EXEC_spec(int special, CLASS *class, void *object, int nparam, boolean drop)
{
  CLASS_DESC *desc = class->special[special];

  if (desc == NULL)
    return TRUE;

  if (CLASS_DESC_get_type(desc) == CD_STATIC_METHOD)
  {
    if (object != NULL)
      return TRUE;
  }
  else
  {
    if (object == NULL)
    {
      if (class->auto_create)
      {
        object = EXEC_auto_create(class);
        OBJECT_UNREF(&object, "EXEC_spec");
      }

      if (object == NULL)
        THROW(E_NOBJECT);
    }
  }

  EXEC.class = desc->method.class;
  EXEC.object = object;
  EXEC.nparam = nparam;
  EXEC.drop = drop;

  if (FUNCTION_is_native(&desc->method))
  {
    EXEC.desc = &desc->method;
    EXEC.use_stack = FALSE;
    EXEC.native = TRUE;
    EXEC_native();
  }
  else
  {
    //EXEC.func = &class->load->func[(long)desc->method.exec]
    EXEC.index = (long)desc->method.exec;
    EXEC.native = FALSE;
    EXEC_function_real(!drop);
  }

  return FALSE;
}


/* PRIVATE void dump(int np) */
/* { */
/*   int i; */
/*  */
/*   for (i = 1; i <= np; i++) */
/*     printf("SP[%d] = %d  ", -i, SP[-i].type); */
/*  */
/*   printf("\n"); */
/* } */
/*  */

/*
  The highest parent method is called first, but get only the parameters
  not consumed by the child methods.
*/

PUBLIC void EXEC_special_inheritance(int special, CLASS *class, OBJECT *object, int nparam, boolean drop)
{
  CLASS *her[MAX_INHERITANCE];
  int npher[MAX_INHERITANCE];
  int nher;
  int i, np;
  CLASS_DESC *desc;

  /*if (class->parent != NULL)
    EXEC_special_inheritance(special, class->parent, object, 0, drop);*/

  nher = CLASS_get_inheritance(class, her);

  for(i = 0, np = 0; i < nher; i++)
  {
    class = her[i];
    npher[i] = np;

    desc = class->special[special];
    if (!desc)
      continue;

    np += desc->method.npmax;
  }

  for(;;)
  {
    nher--;
    if (nher < 0)
      break;
    class = her[nher];

    if (special == SPEC_NEW)
    {
      if (!CLASS_is_native(class))
      {
        EXEC.class = class;
        EXEC.object = object;
        EXEC.index = FUNC_INIT_DYNAMIC;
        //EXEC.func = &class->load->func[FUNC_INIT_DYNAMIC];
        EXEC.native = FALSE;
        EXEC.nparam = 0;

        EXEC_function();
      }
    }

    desc = class->special[special];
    if (!desc)
      continue;

    /*np = Min(nparam, desc->method.npmax);*/

    np = Max(0, nparam - npher[nher]);


    /*
    dup = ((np > 0) && nher > 0);

    if (dup)
    {
      STACK_check(nparam);

      for (i = 0; i < np; i++)
      {
        SP[i] = SP[i - np];
        BORROW(&SP[i]);
      }

      SP += np;

    }
    */

    EXEC_special(special, class, object, np, drop);
    nparam -= np;
  }
}


PUBLIC void EXEC_new(void)
{
  CLASS *class;
  int np;
  boolean event;
  void *object;
  char *name = NULL;
  char *cname = NULL;

  np = *PC & 0xFF;
  event = np & CODE_NEW_EVENT;
  np &= 0x3F;

  /* Instanciation */

  SP -= np;

  if (SP->type == T_CLASS)
  {
    class = SP->_class.class;
  }
  else if (TYPE_is_string(SP->type))
  {
    STRING_copy_from_value_temp(&cname, SP);
    class = CLASS_find(cname);
    RELEASE(SP);
    SP->type = T_NULL;
  }
  else
    THROW(E_TYPE, "String", TYPE_get_name(SP->type));

  SP += np;

  CLASS_load(class);

  if (class->new == NULL)
    THROW(E_CSTATIC, class->name);

  if (event)
  {
    SP--;

    if (!TYPE_is_string(SP->type))
      THROW(E_TYPE, "String", TYPE_get_name(SP->type));

    STRING_copy_from_value_temp(&name, SP);

    STRING_ref(name);
    (*class->new)(&object, class, name, ((OP == NULL) ? (OBJECT *)CP : (OBJECT *)OP));
    STRING_unref(&name);

    RELEASE(SP);

    np -= 2;
  }
  else
  {
    (*class->new)(&object, class, name, ((OP == NULL) ? (OBJECT *)CP : (OBJECT *)OP));
    np--;
  }

  /*OBJECT_REF(object, "EXEC_new");*/

  /* On retourne l'objet cr� */

  TRY
  {  
    EXEC_special_inheritance(SPEC_NEW, class, object, np, TRUE);

    SP--; /* class */

    SP->_object.class = class;
    SP->_object.object = object;
    SP++;
  }
  CATCH
  {
    OBJECT_UNREF(&object, "EXEC_new");
    SP--; /* class */
    SP->type = T_NULL;
    SP++;
    PROPAGATE();
  }
  END_TRY

  /*  PUSH(); */

  /* L'objet a ��cr� avec un nombre de r��ence �al �1.
     On remet ce nombre �0 maintenant que l'objet est pr�.
     Mais on ne le d�ruit pas ! */

  /* OBJECT_UNREF(&object, "EXEC_new"); */
}


PUBLIC void EXEC_class(void)
{
  //fprintf(stderr, ">> EXEC_class: SP = %d  drop = %d\n", SP - (VALUE *)STACK_base, EXEC.drop);

  if (EXEC_special(SPEC_CALL, EXEC.class, EXEC.object, EXEC.nparam, EXEC.drop))
  {
    if (EXEC.nparam < 1)
      THROW(E_NEPARAM);
    else if (EXEC.nparam > 1)
      THROW(E_TMPARAM);

    VALUE_conv(SP - 1, (TYPE)EXEC.class);
  }
  else
  {
    if (RP->type != T_VOID) /* Ceci est fait pour un EXEC_native, mais pas pour un EXEC_function */
    {
      BORROW(RP);
      SP[-1] = *RP; /* On �rase la classe */
      EXEC_release_return_value();
    }
    else
      POP(); /* On enl�e la classe */
  }
  
  //fprintf(stderr, "<< EXEC_class: SP = %d\n\n", SP - (VALUE *)STACK_base);
}


PUBLIC void EXEC_nop(void)
{
  printf("* NOP *\n");
}


PUBLIC void EXEC_ILLEGAL(void)
{
  THROW(E_ILLEGAL);
}


PUBLIC void EXEC_quit(void)
{
  GAMBAS_DoNotRaiseEvent = TRUE;

  HOOK(quit)();

  THROW(E_UNKNOWN);
}


PUBLIC void *EXEC_auto_create(CLASS *class)
{
  void *object;

  object = CLASS_auto_create(class, 0); /* object is checked by CLASS_auto_create */
  OBJECT_REF(object, "EXEC_auto_create");
  return object;
}