Exemplo n.º 1
0
static SCM pg_cmd_tuples(SCM res) {
	struct pg_res *pgr;
	SCM out;
	scm_assert_smob_type(pg_res_tag, res);
	pgr = (struct pg_res *)SCM_SMOB_DATA(res);
	out = scm_from_signed_integer(pgr->cmd_tuples);
	scm_remember_upto_here_2(res, out);
	return out;
	}
Exemplo n.º 2
0
static void
test_scm_local_eval ()
{
  SCM result;

  scm_c_use_module ("ice-9 local-eval");
  result = scm_local_eval
    (scm_list_3 (scm_from_latin1_symbol ("+"),
                 scm_from_latin1_symbol ("x"),
                 scm_from_latin1_symbol ("y")),
     scm_c_eval_string ("(let ((x 1) (y 2)) (the-environment))"));
     
  assert (scm_is_true (scm_equal_p (result,
                                    scm_from_signed_integer (3))));
}
Exemplo n.º 3
0
static SCM
_wrap_fact (SCM s_0)
{
#define FUNC_NAME "fact"
  int arg1 ;
  SCM gswig_result;
  SWIGUNUSED int gswig_list_p = 0;
  int result;
  
  {
    arg1 = (int) scm_to_int(s_0);
  }
  result = (int)fact(arg1);
  {
    gswig_result = scm_from_signed_integer(result);
  }
  
  return gswig_result;
#undef FUNC_NAME
}
Exemplo n.º 4
0
static SCM pg_decode(char *string, int dtype) {
	switch (dtype) {
		case 701:
		case 1700:
		case 700:
			return scm_from_double(atof(string));
		case 20:
		case 21:
		case 23:
			return scm_from_signed_integer(atoi(string));
		case 1114:
		case 1184:
		case 1082:
			return decode_timestamp(string);
		case 16:
		case 1000:
			return (string[0] == 't' ? SCM_BOOL_T : SCM_BOOL_F);
		}
	return safe_from_utf8(string);
	}
Exemplo n.º 5
0
static SCM pg_format_sql(SCM conn, SCM obj) {
	struct pg_conn *pgc;
	SCM out;
	if (SCM_SMOB_PREDICATE(time_tag, obj)) {
		out = format_time(obj, c2s("'%Y-%m-%d %H:%M:%S'"));
		}
	else if (scm_boolean_p(obj) == SCM_BOOL_T) {
		if (scm_is_true(obj)) out = c2s("'t'");
		else out = c2s("'f'");
		}
	else if (scm_is_number(obj)) {
		out = scm_number_to_string(obj,
			scm_from_signed_integer(10));
		}
	else if (scm_is_symbol(obj)) {
		out = pg_format_sql(conn, scm_symbol_to_string(obj));
		}
	else if (scm_is_string(obj)) {
		if (scm_string_null_p(obj) == SCM_BOOL_T) out = c2s("NULL");
		else {
			char *src = scm_to_utf8_string(obj);
			scm_assert_smob_type(pg_conn_tag, conn);
			pgc = (struct pg_conn *)SCM_SMOB_DATA(conn);
			scm_lock_mutex(pgc->mutex);
			char *sql = PQescapeLiteral(pgc->conn,
					src, strlen(src));
			out = safe_from_utf8(sql);
			scm_unlock_mutex(pgc->mutex);
			free(src);
			PQfreemem(sql);
			}
		}
	else if (scm_is_null(obj)) out = c2s("NULL");
	else out = c2s("NULL");
	scm_remember_upto_here_1(out);
	scm_remember_upto_here_2(conn, obj);
	return out;
	}
Exemplo n.º 6
0
static SCM
_wrap_mod (SCM s_0, SCM s_1)
{
#define FUNC_NAME "mod"
  int arg1 ;
  int arg2 ;
  SCM gswig_result;
  SWIGUNUSED int gswig_list_p = 0;
  int result;
  
  {
    arg1 = (int) scm_to_int(s_0);
  }
  {
    arg2 = (int) scm_to_int(s_1);
  }
  result = (int)mod(arg1,arg2);
  {
    gswig_result = scm_from_signed_integer(result);
  }
  
  return gswig_result;
#undef FUNC_NAME
}
Exemplo n.º 7
0
TYPE
SCM_TO_TYPE_PROTO (SCM val)
{
  if (SCM_I_INUMP (val))
    {
      scm_t_signed_bits n = SCM_I_INUM (val);
#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SIZEOF_SCM_T_BITS
      return n;
#else
      if (n >= TYPE_MIN && n <= TYPE_MAX)
	return n;
      else
	{
	  goto out_of_range;
	}
#endif
    }
  else if (SCM_BIGP (val))
    {
      if (TYPE_MIN >= SCM_MOST_NEGATIVE_FIXNUM
	  && TYPE_MAX <= SCM_MOST_POSITIVE_FIXNUM)
	goto out_of_range;
      else if (TYPE_MIN >= LONG_MIN && TYPE_MAX <= LONG_MAX)
	{
	  if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val)))
	    {
	      long n = mpz_get_si (SCM_I_BIG_MPZ (val));
#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
	      return n;
#else
	      if (n >= TYPE_MIN && n <= TYPE_MAX)
		return n;
	      else
		goto out_of_range;
#endif
	    } 
	  else
	    goto out_of_range;
	}
      else
	{
	  scm_t_intmax n;
	  size_t count;

	  if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
	      > CHAR_BIT*sizeof (scm_t_uintmax))
	    goto out_of_range;
	  
	  mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
		      SCM_I_BIG_MPZ (val));

	  if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0)
	    {
	      if (n < 0)
		goto out_of_range;
	    }
	  else
	    {
	      n = -n;
	      if (n >= 0)
		goto out_of_range;
	    }

	  if (n >= TYPE_MIN && n <= TYPE_MAX)
	    return n;
	  else
	    {
	    out_of_range:
	      scm_i_range_error (val,
				 scm_from_signed_integer (TYPE_MIN),
				 scm_from_signed_integer (TYPE_MAX));
	      return 0;
	    }
	}
    }
  else
    {
      scm_wrong_type_arg_msg (NULL, 0, val, "exact integer");
      return 0;
    }
}
Exemplo n.º 8
0
Arquivo: scheme.c Projeto: nizmic/nwm
static SCM scm_client_y(SCM client_smob)
{
    client_t *client = (client_t *)SCM_SMOB_DATA(client_smob);
    return scm_from_signed_integer(client->rect.y);
}