scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added s48_{enter,extract}_unsigned_integer.

This commit is contained in:
mainzelm 2001-04-02 14:55:55 +00:00
parent 0198ddb337
commit 12cb27459f
2 changed files with 61 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
c/external.c
View File

@ -732,6 +732,22 @@ s48_enter_integer(long value)
}
}
s48_value
s48_enter_unsigned_integer(unsigned long value)
{
if (value <= S48_MAX_FIXNUM_VALUE)
return S48_UNSAFE_ENTER_FIXNUM(value);
else {
S48_SHARED_BINDING_CHECK(long_to_bignum_binding);
return s48_call_scheme(S48_SHARED_BINDING_REF(long_to_bignum_binding),
3,
S48_TRUE,
S48_UNSAFE_ENTER_FIXNUM((- value) >> 16),
S48_UNSAFE_ENTER_FIXNUM((- value) & 0xFFFF));
}
}
/*
* If we have a fixnum we just extract it. Bignums require a call back into
* Scheme 48. (BIGNUM-TO-LONG n) returns a vector containing the sign and the
@ -781,6 +797,49 @@ s48_extract_integer(s48_value value)
}
}
unsigned long
s48_extract_unsigned_integer(s48_value value)
{
long temp;
if (S48_FIXNUM_P(value)){
temp = S48_UNSAFE_EXTRACT_FIXNUM(value);
if (temp < 0)
s48_raise_argtype_error(value);
else return (unsigned long) temp;
}
else {
s48_value stuff;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(value);
S48_SHARED_BINDING_CHECK(bignum_to_long_binding);
stuff = s48_call_scheme(S48_SHARED_BINDING_REF(bignum_to_long_binding),
1,
value);
S48_GC_UNPROTECT();
if (stuff == S48_FALSE)
s48_raise_argtype_error(value);
/* The first VECTOR_REF does the type checking for the rest. */
{
long low = S48_UNSAFE_EXTRACT_FIXNUM(S48_VECTOR_REF(stuff, 2));
s48_value boxed_high = S48_UNSAFE_VECTOR_REF(stuff, 1);
long high = S48_UNSAFE_EXTRACT_FIXNUM(boxed_high);
int pos_p = S48_EXTRACT_BOOLEAN(S48_UNSAFE_VECTOR_REF(stuff, 0));
if ((!pos_p) ||
(! S48_FIXNUM_P(boxed_high)) ||
(high > 0xFFFF))
s48_raise_argtype_error(value);
else return (- (((- high) << 16) - low));
}
}
}
/*
* Doubles and characters are straightforward.
*/

2
c/scheme48.h.in
View File

@ -38,6 +38,8 @@ extern s48_value s48_enter_fixnum(long);
extern long s48_extract_fixnum(s48_value);
extern s48_value s48_enter_integer(long);
extern long s48_extract_integer(s48_value);
extern s48_value s48_enter_unsigned_integer(unsigned long);
extern unsigned long s48_extract_unsigned_integer(s48_value);
extern s48_value s48_enter_double(double);
extern double s48_extract_double(s48_value);
extern s48_value s48_cons(s48_value, s48_value);