mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-13 04:42:13 -08:00
Code Issues Projects Releases Packages Wiki Activity

New function for converting objects to unsigned integers

Browse source
This commit is contained in:
jjgarcia 2005-06-03 14:56:15 +00:00
parent 1131407124
commit 49594fdc39
5 changed files with 36 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

1
msvc/ecl-threads.def
View file

@ -159,6 +159,7 @@ EXPORTS
imod
object_to_char
object_to_fixnum
object_to_unsigned_integer
object_to_float
object_to_double
aref_bv

1
msvc/ecl.def
View file

@ -159,6 +159,7 @@ EXPORTS
imod
object_to_char
object_to_fixnum
object_to_unsigned_integer
object_to_float
object_to_double
aref_bv

18
src/c/cmpaux.d
View file

@ -86,6 +86,24 @@ object_to_fixnum(cl_object x)
}
}
cl_index
object_to_unsigned_integer(cl_object x)
{
switch (type_of(x)) {
case t_fixnum:
case t_bignum:
return fixnnint(x);
case t_ratio:
return (cl_index)number_to_double(x);
case t_shortfloat:
return (cl_index)sf(x);
case t_longfloat:
return (cl_index)lf(x);
default:
FEerror("~S cannot be coerced to a C unsigned int.", 1, x);
}
}
float
object_to_float(cl_object x)
{

17
src/cmp/cmpffi.lsp
View file

@ -134,7 +134,7 @@
(wt loc)
(return-from wt-coerce-loc))
(case dest-rep-type
((:int :unsigned-int :long :unsigned-long :byte :unsigned-byte :fixnum)
((:int :long :byte :fixnum)
(case loc-rep-type
((:int :unsigned-int :long :unsigned-long :byte :unsigned-byte :fixnum
:float :double)
@ -145,6 +145,17 @@
loc ")"))
(otherwise
(coercion-error))))
((:unsigned-int :unsigned-long :unsigned-byte)
(case loc-rep-type
((:int :unsigned-int :long :unsigned-long :byte :unsigned-byte :fixnum
:float :double)
(wt "((" (rep-type-name dest-rep-type) ")" loc ")"))
((:object)
(ensure-valid-object-type dest-type)
(wt (if (subtypep (loc-type loc) 'fixnum) "fix(" "object_to_unsigned_integer(")
loc ")"))
(otherwise
(coercion-error))))
((:char :unsigned-char)
(case loc-rep-type
((:char :unsigned-char)
@ -178,8 +189,10 @@
(coercion-error))))
((:object)
(case loc-rep-type
((:int :unsigned-int :long :unsigned-long)
((:int :long)
(wt "make_integer(" loc ")"))
((:unsigned-int :unsigned-long)
(wt "make_unsigned_integer(" loc ")"))
((:byte :unsigned-byte :fixnum)
(wt "MAKE_FIXNUM(" loc ")"))
((:float)

1
src/h/external.h
View file

@ -374,6 +374,7 @@ extern cl_fixnum ifloor(cl_fixnum x, cl_fixnum y);
extern cl_fixnum imod(cl_fixnum x, cl_fixnum y);
extern char object_to_char(cl_object x);
extern cl_fixnum object_to_fixnum(cl_object x);
extern cl_index object_to_unsigned_integer(cl_object x);
extern float object_to_float(cl_object x);
extern double object_to_double(cl_object x);
extern int aref_bv(cl_object x, cl_index index);