Beispiel #1
0
SCM
gfec_apply(SCM proc, SCM arglist, gfec_error_handler error_handler)
{
    SCM result = SCM_UNDEFINED;
    SCM func = scm_c_eval_string("gnc:apply-with-error-handling");
    if (scm_is_procedure(func))
    {
        char *err_msg = NULL;
        SCM call_result, error;
        call_result = scm_call_2 (func, proc, arglist);

        error = scm_list_ref (call_result, scm_from_uint (1));
        if (scm_is_true (error))
            err_msg = gnc_scm_to_utf8_string (error);
        else
            result = scm_list_ref (call_result, scm_from_uint (0));

        if (err_msg != NULL)
        {
            if (error_handler)
                error_handler (err_msg);

            free(err_msg);
        }
    }

    return result;
}
Beispiel #2
0
SCM
gfec_eval_string(const char *str, gfec_error_handler error_handler)
{
    SCM result = SCM_UNDEFINED;
    SCM func = scm_c_eval_string("gnc:eval-string-with-error-handling");
    if (scm_is_procedure(func))
    {
        char *err_msg = NULL;
        SCM call_result, error = SCM_UNDEFINED;
        call_result = scm_call_1 (func, scm_from_utf8_string (str));

        error = scm_list_ref (call_result, scm_from_uint (1));
        if (scm_is_true (error))
            err_msg = gnc_scm_to_utf8_string (error);
        else
            result = scm_list_ref (call_result, scm_from_uint (0));

        if (err_msg != NULL)
        {
            if (error_handler)
                error_handler (err_msg);

            free(err_msg);
        }
    }

    return result;
}
Beispiel #3
0
static const scm_t_uint32*
get_subr_stub_code (unsigned int nreq, unsigned int nopt, unsigned int rest)
{
  if (SCM_UNLIKELY (rest > 1 || nreq + nopt + rest > 10))
    scm_out_of_range ("make-subr", scm_from_uint (nreq + nopt + rest));
      
  return SUBR_STUB_CODE (nreq, nopt, rest);
}
static SCM
gdbscm_memory_port_write_buffer_size (SCM port)
{
  ioscm_memory_port *iomem;

  SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
		   memory_port_desc_name);

  iomem = (ioscm_memory_port *) SCM_STREAM (port);
  return scm_from_uint (iomem->write_buf_size);
}
Beispiel #5
0
SCM
gfec_eval_string(const char *str, gfec_error_handler error_handler)
{
    SCM result = SCM_UNDEFINED;
    SCM func = scm_c_eval_string("gnc:eval-string-with-error-handling");
    if (scm_is_procedure(func))
    {
        char *err_msg = NULL;
        SCM call_result, error = SCM_UNDEFINED;
	/* Deal with the possibility that scm_from_utf8_string will
	 * throw, falling back to scm_from_locale_string. If that fails, log a
	 * warning and punt.
	 */
	SCM scm_string = scm_internal_catch(SCM_BOOL_T,
					    gfec_string_from_utf8, (void*)str,
					    gfec_string_inner_handler,
					    (void*)str);
	if (!scm_string)
	{
	    error_handler("Contents could not be interpreted as UTF-8 or the current locale/codepage.");
	    return result;
	}
        call_result = scm_call_1 (func, scm_string);

        error = scm_list_ref (call_result, scm_from_uint (1));
        if (scm_is_true (error))
            err_msg = gnc_scm_to_utf8_string (error);
        else
            result = scm_list_ref (call_result, scm_from_uint (0));

        if (err_msg != NULL)
        {
            if (error_handler)
                error_handler (err_msg);

            free(err_msg);
        }
    }

    return result;
}
Beispiel #6
0
SCM scm_from_ip_addr_number(struct ip_addr const *ip)
{
    if (ip->family == AF_INET) {
        return scm_from_uint32(ntohl(ip->u.v4.s_addr));
    } else {
        uint32_t w4, w3, w2, w1;
        memcpy(&w4, ((char *)ip->u.v6.s6_addr)+0*sizeof(w4), sizeof(w4));
        memcpy(&w3, ((char *)ip->u.v6.s6_addr)+1*sizeof(w4), sizeof(w3));
        memcpy(&w2, ((char *)ip->u.v6.s6_addr)+2*sizeof(w4), sizeof(w2));
        memcpy(&w1, ((char *)ip->u.v6.s6_addr)+3*sizeof(w4), sizeof(w1));
        uint64_t hi = ((uint64_t)ntohl(w4) << 32ULL) | ntohl(w3);
        uint64_t lo = ((uint64_t)ntohl(w2) << 32ULL) | ntohl(w1);
        return scm_logior(scm_ash(scm_from_uint64(hi), scm_from_uint(64)), scm_from_uint64(lo));
    }
}
Beispiel #7
0
static SCM g_get_duplicogram(void)
{
    SCM lst = SCM_EOL;
    uint64_t const nb_pkts = nb_nodups + nb_dups;

    scm_dynwind_begin(0);
    mutex_lock(&dup_lock);
    scm_dynwind_unwind_handler(pthread_mutex_unlock_, &dup_lock.mutex, SCM_F_WIND_EXPLICITLY);

    unsigned dt = bucket_width/2;
    for (unsigned x = 0; x < nb_buckets; x++, dt += bucket_width) {
        lst = scm_cons(
                scm_cons(scm_from_uint(dt),
                         scm_from_double(nb_pkts > 0 ? (double)dups[x] / nb_pkts : 0.)),
                lst);
    }

    dup_reset_locked();
    scm_dynwind_end();

    return lst;
}
Beispiel #8
0
static SCM
pascm_param_value (enum var_types type, void *var,
		   int arg_pos, const char *func_name)
{
  /* Note: We *could* support var_integer here in case someone is trying to get
     the value of a Python-created parameter (which is the only place that
     still supports var_integer).  To further discourage its use we do not.  */

  switch (type)
    {
    case var_string:
    case var_string_noescape:
    case var_optional_filename:
    case var_filename:
    case var_enum:
      {
	const char *str = *(char **) var;

	if (str == NULL)
	  str = "";
	return gdbscm_scm_from_host_string (str, strlen (str));
      }

    case var_boolean:
      {
	if (* (int *) var)
	  return SCM_BOOL_T;
	else
	  return SCM_BOOL_F;
      }

    case var_auto_boolean:
      {
	enum auto_boolean ab = * (enum auto_boolean *) var;

	if (ab == AUTO_BOOLEAN_TRUE)
	  return SCM_BOOL_T;
	else if (ab == AUTO_BOOLEAN_FALSE)
	  return SCM_BOOL_F;
	else
	  return auto_keyword;
      }

    case var_zuinteger_unlimited:
      if (* (int *) var == -1)
	return unlimited_keyword;
      gdb_assert (* (int *) var >= 0);
      /* Fall through.  */
    case var_zinteger:
      return scm_from_int (* (int *) var);

    case var_uinteger:
      if (* (unsigned int *) var == UINT_MAX)
	return unlimited_keyword;
      /* Fall through.  */
    case var_zuinteger:
      return scm_from_uint (* (unsigned int *) var);

    default:
      break;
    }

  return gdbscm_make_out_of_range_error (func_name, arg_pos,
					 scm_from_int (type),
					 _("program error: unhandled type"));
}