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

Teach the compiler how to coerce (unsigned-)short

Browse source
This commit is contained in:
jjgarcia 2008-08-28 09:13:27 +00:00
parent 5346fd6684
commit e86c6ec83d
2 changed files with 18 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/CHANGELOG
View file

@ -71,6 +71,9 @@ ECL 0.9l-p1:
- PROCLAIM/DECLAIM now understand the abbreviated form of type declarations
user-defined and complex types.
- The compiler did not understand the :UNSIGNED-SHORT/:SHORT FFI types
completely.
;;; Local Variables: ***
;;; mode:text ***
;;; fill-column:79 ***

41
src/cmp/cmpffi.lsp
View file

@ -148,31 +148,22 @@
(wt loc)
(return-from wt-coerce-loc))
(case dest-rep-type
((:int :long :byte :fixnum)
((:byte :unsigned-byte :short :unsigned-short :int :unsigned-int
:long :unsigned-long :fixnum :cl-index)
(case loc-rep-type
((:int :unsigned-int :long :unsigned-long :byte :unsigned-byte :fixnum
:float :double :long-double)
(#1=(:byte :unsigned-byte :short :unsigned-short :int :unsigned-int
:long :unsigned-long :fixnum :cl-index
:float :double :long-double) ; number types
(wt "((" (rep-type-name dest-rep-type) ")" loc ")"))
((:object)
(ensure-valid-object-type dest-type)
(wt (if (or (subtypep (loc-type loc) 'fixnum)
(wt (cond ((or (subtypep (loc-type loc) 'fixnum)
(not (policy-check-all-arguments-p)))
"fix("
"ecl_to_fixnum(")
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 :long-double)
(wt "((" (rep-type-name dest-rep-type) ")" loc ")"))
((:object)
(ensure-valid-object-type dest-type)
(wt (if (or (subtypep (loc-type loc) 'fixnum)
(not (policy-check-all-arguments-p)))
"fix("
"ecl_to_unsigned_integer(")
"fix(")
((member dest-rep-type '(:unsigned-short :unsigned-long :cl-index))
"ecl_to_unsigned_integer(")
(t
"ecl_to_fixnum("))
loc ")"))
(otherwise
(coercion-error))))
@ -187,8 +178,7 @@
(coercion-error))))
((:float :double :long-double)
(case loc-rep-type
((:int :unsigned-int :long :unsigned-long :byte :unsigned-byte :fixnum
:float :double :long-double)
(#1# ; number type
(wt "((" (rep-type-name dest-rep-type) ")" loc ")"))
((:object)
;; We relax the check a bit, because it is valid in C to coerce
@ -203,8 +193,7 @@
(coercion-error))))
((:bool)
(case loc-rep-type
((:int :unsigned-int :long :unsigned-long :byte :unsigned-byte :fixnum
:float :double :long-double :char :unsigned-char :wchar)
(#1# ; number type
(wt "1"))
((:object)
(wt "(" loc ")!=Cnil"))
@ -212,9 +201,9 @@
(coercion-error))))
((:object)
(case loc-rep-type
((:int :long)
((:short :int :long)
(wt "ecl_make_integer(" loc ")"))
((:unsigned-int :unsigned-long)
((:unsigned-short :unsigned-int :unsigned-long)
(wt "ecl_make_unsigned_integer(" loc ")"))
((:byte :unsigned-byte :fixnum)
(wt "MAKE_FIXNUM(" loc ")"))