Scheme_Object * do_bin_quotient(const char *name, const Scheme_Object *n1, const Scheme_Object *n2, Scheme_Object **bn_rem) { Scheme_Object *q; if (!scheme_is_integer(n1)) { Scheme_Object *a[2]; a[0] = (Scheme_Object *)n1; a[1] = (Scheme_Object *)n2; scheme_wrong_contract(name, "integer?", 0, 2, a); } if (!scheme_is_integer(n2)) { Scheme_Object *a[2]; a[0] = (Scheme_Object *)n1; a[1] = (Scheme_Object *)n2; scheme_wrong_contract(name, "integer?", 1, 2, a); } if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2)) scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO, "%s: undefined for 0", name); if ( #ifdef MZ_USE_SINGLE_FLOATS (SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) || #endif (SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0))) scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO, "%s: undefined for 0.0", name); if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) { /* Beware that most negative fixnum divided by -1 isn't a fixnum: */ return (scheme_make_integer_value(SCHEME_INT_VAL(n1) / SCHEME_INT_VAL(n2))); } if (SCHEME_DBLP(n1) || SCHEME_DBLP(n2)) { Scheme_Object *r; double d, d2; r = scheme_bin_div(n1, n2); /* could be exact 0 ... */ if (SCHEME_DBLP(r)) { d = SCHEME_DBL_VAL(r); if (d > 0) d2 = floor(d); else d2 = ceil(d); if (d2 == d) return r; else return scheme_make_double(d2); } else return r; } #ifdef MZ_USE_SINGLE_FLOATS if (SCHEME_FLTP(n1) || SCHEME_FLTP(n2)) { Scheme_Object *r; float d, d2; r = scheme_bin_div(n1, n2); /* could be exact 0 ... */ if (SCHEME_FLTP(r)) { d = SCHEME_FLT_VAL(r); if (d > 0) d2 = floor(d); else d2 = ceil(d); if (d2 == d) return r; else return scheme_make_float(d2); } else return r; } #endif #if 0 /* I'm pretty sure this isn't needed, but I'm keeping the code just in case... 03/19/2000 */ if (SCHEME_RATIONALP(n1)) wrong_contract(name, "integer?", n1); if (SCHEME_RATIONALP(n2)) wrong_contract(name, "integer?", n2); #endif n1 = scheme_to_bignum(n1); n2 = scheme_to_bignum(n2); scheme_bignum_divide(n1, n2, &q, bn_rem, 1); return q; }
/** * Convert a Scheme object to a GVariant that will serve as one of * the parameters of a call go g_dbus_proxy_call_.... Returns NULL * if it is unable to do the conversion. */ static GVariant * scheme_object_to_parameter (Scheme_Object *obj, gchar *type) { gchar *str; // A temporary string // Special case: Array of bytes if (g_strcmp0 (type, "ay") == 0) { if (SCHEME_BYTE_STRINGP (obj)) { return g_variant_new_fixed_array (G_VARIANT_TYPE_BYTE, SCHEME_BYTE_STR_VAL (obj), SCHEME_BYTE_STRLEN_VAL (obj), sizeof (guchar)); } // if it's a byte string } // array of bytes // Handle normal cases switch (type[0]) { // Arrays case 'a': return scheme_object_to_array (obj, type); // Doubles case 'd': if (SCHEME_DBLP (obj)) return g_variant_new ("d", SCHEME_DBL_VAL (obj)); else if (SCHEME_FLTP (obj)) return g_variant_new ("d", (double) SCHEME_FLT_VAL (obj)); else if (SCHEME_INTP (obj)) return g_variant_new ("d", (double) SCHEME_INT_VAL (obj)); else if (SCHEME_RATIONALP (obj)) return g_variant_new ("d", (double) scheme_rational_to_double (obj)); else return NULL; // 32 bit integers case 'i': if (SCHEME_INTP (obj)) return g_variant_new ("i", (int) SCHEME_INT_VAL (obj)); else if (SCHEME_DBLP (obj)) return g_variant_new ("i", (int) SCHEME_DBL_VAL (obj)); else if (SCHEME_FLTP (obj)) return g_variant_new ("i", (int) SCHEME_FLT_VAL (obj)); else if (SCHEME_RATIONALP (obj)) return g_variant_new ("i", (int) scheme_rational_to_double (obj)); else return NULL; // Strings case 's': str = scheme_object_to_string (obj); if (str == NULL) return NULL; return g_variant_new ("s", str); // 32 bit unsigned integers case 'u': if (SCHEME_INTP (obj)) return g_variant_new ("u", (unsigned int) SCHEME_INT_VAL (obj)); else return NULL; // Everything else is currently unsupported default: return NULL; } // switch } // scheme_object_to_parameter