From ed1bdcb0fe9ffd5479adca39d7830ea34632def6 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Tue, 27 Apr 2010 13:05:49 +0200 Subject: [PATCH] Use C code to guess the alignment of different types. --- src/CHANGELOG | 3 + src/c/ffi.d | 125 +++++++++++++++++++----------------------- src/c/symbols_list.h | 1 + src/c/symbols_list2.h | 1 + src/h/external.h | 1 + src/lsp/ffi.lsp | 23 ++++---- 6 files changed, 73 insertions(+), 81 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index f6001d826..538718519 100755 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -14,6 +14,9 @@ ECL 10.4.2: - EXT:MAKE-FOREIGN-DATA-FROM-ARRAY now supports all unboxed types. + - ECL did not properly compute the alignment of foreign types in structures. + This is now done using standard C constructs in a portable and robust way. + * Visible changes: - "fasb" is now a valid FASL file type, accepted by ECL even in absence of diff --git a/src/c/ffi.d b/src/c/ffi.d index ed8609faf..83f1e0e1b 100644 --- a/src/c/ffi.d +++ b/src/c/ffi.d @@ -61,43 +61,58 @@ static const cl_object ecl_aet_to_ffi_table[aet_bc+1] = { @':char' /* aet_bc */ }; -static const cl_object ecl_foreign_type_table[] = { - @':char', - @':unsigned-char', - @':byte', - @':unsigned-byte', - @':short', - @':unsigned-short', - @':int', - @':unsigned-int', - @':long', - @':unsigned-long', +#define ALIGNMENT(type) \ + (long)(((struct { char a; type b[1]; } *)0)->b) +#define FFI_DESC(symbol,type) \ + {symbol, sizeof(type), ALIGNMENT(type)} + +static const struct{ + cl_object name; + cl_index size; + cl_index alignment; +} ecl_foreign_type_table[] = { + FFI_DESC(@':char', char), + FFI_DESC(@':unsigned-char', unsigned char), + FFI_DESC(@':byte', ecl_int8_t), + FFI_DESC(@':unsigned-byte', ecl_uint8_t), + FFI_DESC(@':short', short), + FFI_DESC(@':unsigned-short', unsigned short), + FFI_DESC(@':int', int), + FFI_DESC(@':unsigned-int', unsigned int), + FFI_DESC(@':long', long), + FFI_DESC(@':unsigned-long', unsigned long), #ifdef ecl_uint8_t - @':int8-t', - @':uint8-t', + FFI_DESC(@':int8-t', ecl_int8_t), + FFI_DESC(@':uint8-t', ecl_uint8_t), #endif #ifdef ecl_uint16_t - @':int16-t', - @':uint16-t', + FFI_DESC(@':int16-t', ecl_int16_t), + FFI_DESC(@':uint16-t', ecl_uint16_t), #endif #ifdef ecl_uint32_t - @':int32-t', - @':uint32-t', + FFI_DESC(@':int32-t', ecl_int32_t), + FFI_DESC(@':uint32-t', ecl_uint32_t), #endif #ifdef ecl_uint64_t - @':int64-t', - @':uint64-t', + FFI_DESC(@':int64-t', ecl_int64_t), + FFI_DESC(@':uint64-t', ecl_uint64_t), #endif #ifdef ecl_long_long_t - @':long-long', - @':unsigned-long-long', + FFI_DESC(@':long-long', long long), + FFI_DESC(@':unsigned-long-long', unsigned long long), #endif - @':pointer-void', - @':cstring', - @':object', - @':float', - @':double', - @':void' + FFI_DESC(@':pointer-void', void *), + FFI_DESC(@':cstring', char *), + FFI_DESC(@':object', cl_object), + FFI_DESC(@':float', float), + FFI_DESC(@':double', double), + {@':void', 0, 0} +}; + +static const int foreign_type_alignment[] = { + ALIGNMENT(char), + ALIGNMENT(unsigned char), + ALIGNMENT(int) }; #ifdef ECL_DYNAMIC_FFI @@ -107,45 +122,6 @@ static const cl_object ecl_foreign_cc_table[] = { }; #endif -static unsigned int ecl_foreign_type_size[] = { - sizeof(char), - sizeof(unsigned char), - sizeof(int8_t), - sizeof(uint8_t), - sizeof(short), - sizeof(unsigned short), - sizeof(int), - sizeof(unsigned int), - sizeof(long), - sizeof(unsigned long), -#ifdef ecl_uint8_t - sizeof(ecl_int8_t), - sizeof(ecl_uint8_t), -#endif -#ifdef ecl_uint16_t - sizeof(ecl_int16_t), - sizeof(ecl_uint16_t), -#endif -#ifdef ecl_uint32_t - sizeof(ecl_int32_t), - sizeof(ecl_uint32_t), -#endif -#ifdef ecl_uint64_t - sizeof(ecl_int64_t), - sizeof(ecl_uint64_t), -#endif -#ifdef ecl_long_long_t - sizeof(long long), - sizeof(unsigned long long), -#endif - sizeof(void *), - sizeof(char *), - sizeof(cl_object), - sizeof(float), - sizeof(double), - 0 -}; - #ifdef HAVE_LIBFFI static struct { const cl_object symbol; @@ -416,7 +392,7 @@ foreign_type_code(cl_object type) { int i; for (i = 0; i <= ECL_FFI_VOID; i++) { - if (type == ecl_foreign_type_table[i]) + if (type == ecl_foreign_type_table[i].name) return i; } return -1; @@ -629,7 +605,8 @@ si_foreign_data_ref_elt(cl_object f, cl_object andx, cl_object type) cl_index ndx = fixnnint(andx); cl_index limit = f->foreign.size; enum ecl_ffi_tag tag = ecl_foreign_type_code(type); - if (ecl_unlikely(ndx >= limit || (ndx + ecl_foreign_type_size[tag] > limit))) { + if (ecl_unlikely(ndx >= limit || + (ndx + ecl_foreign_type_table[tag].size > limit))) { FEerror("Out of bounds reference into foreign data type ~A.", 1, f); } if (ecl_unlikely(type_of(f) != t_foreign)) { @@ -645,7 +622,8 @@ si_foreign_data_set_elt(cl_object f, cl_object andx, cl_object type, cl_object v cl_index ndx = fixnnint(andx); cl_index limit = f->foreign.size; enum ecl_ffi_tag tag = ecl_foreign_type_code(type); - if (ecl_unlikely(ndx >= limit || ndx + ecl_foreign_type_size[tag] > limit)) { + if (ecl_unlikely(ndx >= limit || + ndx + ecl_foreign_type_table[tag].size > limit)) { FEerror("Out of bounds reference into foreign data type ~A.", 1, f); } if (ecl_unlikely(type_of(f) != t_foreign)) { @@ -660,7 +638,14 @@ cl_object si_size_of_foreign_elt_type(cl_object type) { enum ecl_ffi_tag tag = ecl_foreign_type_code(type); - @(return MAKE_FIXNUM(ecl_foreign_type_size[tag])) + @(return MAKE_FIXNUM(ecl_foreign_type_table[tag].size)) +} + +cl_object +si_alignment_of_foreign_elt_type(cl_object type) +{ + enum ecl_ffi_tag tag = ecl_foreign_type_code(type); + @(return MAKE_FIXNUM(ecl_foreign_type_table[tag].alignment)) } cl_object diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 1fb22664d..3cd184bee 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1415,6 +1415,7 @@ cl_symbols[] = { {SYS_ "LOAD-FOREIGN-MODULE", SI_ORDINARY, si_load_foreign_module, 1, OBJNULL}, {SYS_ "NULL-POINTER-P", SI_ORDINARY, si_null_pointer_p, 1, OBJNULL}, {SYS_ "SIZE-OF-FOREIGN-ELT-TYPE", SI_ORDINARY, si_size_of_foreign_elt_type, 1, OBJNULL}, +{SYS_ "ALIGNMENT-OF-FOREIGN-ELT-TYPE", SI_ORDINARY, si_alignment_of_foreign_elt_type, 1, OBJNULL}, {KEY_ "BYTE", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "CHAR", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "CSTRING", KEYWORD, NULL, -1, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 46d9f890f..743356e25 100755 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1415,6 +1415,7 @@ cl_symbols[] = { {SYS_ "LOAD-FOREIGN-MODULE","si_load_foreign_module"}, {SYS_ "NULL-POINTER-P","si_null_pointer_p"}, {SYS_ "SIZE-OF-FOREIGN-ELT-TYPE","si_size_of_foreign_elt_type"}, +{SYS_ "ALIGNMENT-OF-FOREIGN-ELT-TYPE","si_alignment_of_foreign_elt_type"}, {KEY_ "BYTE",NULL}, {KEY_ "CHAR",NULL}, {KEY_ "CSTRING",NULL}, diff --git a/src/h/external.h b/src/h/external.h index 915f1e23b..e13e19706 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -605,6 +605,7 @@ extern ECL_API cl_object si_free_foreign_data(cl_object x); extern ECL_API cl_object si_make_foreign_data_from_array(cl_object x); extern ECL_API cl_object si_null_pointer_p(cl_object f); extern ECL_API cl_object si_size_of_foreign_elt_type(cl_object tag); +extern ECL_API cl_object si_alignment_of_foreign_elt_type(cl_object tag); extern ECL_API cl_object si_load_foreign_module(cl_object module); extern ECL_API cl_object si_find_foreign_symbol(cl_object var, cl_object module, cl_object type, cl_object size); extern ECL_API cl_object si_call_cfun(cl_narg, cl_object fun, cl_object return_type, cl_object arg_types, cl_object args, ...); diff --git a/src/lsp/ffi.lsp b/src/lsp/ffi.lsp index 1a3074a21..330aeac1f 100644 --- a/src/lsp/ffi.lsp +++ b/src/lsp/ffi.lsp @@ -87,14 +87,15 @@ (unless type (error "Incomplete or unknown foreign type ~A" name)) (cond ((symbolp type) - (setf size (si::size-of-foreign-elt-type type))) + (setf size (si:size-of-foreign-elt-type type) + align (si:alignment-of-foreign-elt-type type))) ((atom type) (error "~A is not a valid foreign type identifier" name)) ((eq (setf name (first type)) :struct) - (setf size (slot-position type nil)) - (setf align (apply #'max (mapcar #'(lambda (field) + (setf size (slot-position type nil) + align (apply #'max (mapcar #'(lambda (field) (multiple-value-bind (field-size field-align) - (size-of-foreign-type (second field)) + (size-of-foreign-type (second field)) field-align)) (rest type)))) (%align-data size align)) @@ -103,8 +104,8 @@ (error "Incomplete foreign type: ~S" type)) (multiple-value-bind (elt-size elt-align) (size-of-foreign-type (second type)) - (setf size (* size elt-size)) - (setf align elt-align))) + (setf size (* size elt-size) + align elt-align))) ((eq name :union) (dolist (field (rest type)) (multiple-value-bind (field-size field-align) @@ -114,14 +115,14 @@ (when (or (null align) (> field-align align)) (setf align field-align))))) ((eq name '*) - (setf size (si::size-of-foreign-elt-type :pointer-void))) + (setf size (si:size-of-foreign-elt-type :pointer-void) + align (si:alignment-of-foreign-elt-type :pointer-void))) ((eq name 'quote) - (size-of-foreign-type (second type))) + (return-from size-of-foreign-type + (size-of-foreign-type (second type)))) (t (error "~A does not denote a foreign type" name))) - (unless align - (setf align size)) - (values size align))) + (values size (or align 0)))) (defun allocate-foreign-object (type &optional (size 0 size-flag)) (declare (fixnum size))