~ chicken-core (chicken-5) 289254d054a72aa4365f8fab3d6f22492227a2aa


commit 289254d054a72aa4365f8fab3d6f22492227a2aa
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Fri May 19 15:49:59 2017 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Thu May 25 10:35:32 2017 +1200

    Ensure some functions marked OBSOLETE are really unused
    
    These were supposed to have been removed before, but they were still
    used in the compiler.
    
    C_u_i_positivep and C_u_i_evenp, as well as C_u_i_evenp and C_u_i_oddp
    are supposed to be unsafe faster variants of their C_i_-prefixed
    brethren, but because the type analysis is more complicated now that
    we have more than 2 numeric types, the additional error check is not
    worthwhile to leave off.
    
    C_i_foreign_integer_argumentp and ##sys#foreign-integer-argument
    (which is its Scheme procedure) were still used by the "enum" foreign
    type specifier.  This has now been replaced by a ranged integer check.
    According to the C spec, enums are represented exactly as integers, so
    we just use the same range as integers.  The test suite was lacking a
    test for the enum foreign type, so this patch adds that as well.
    
    Finally, the rewrites for C_i_zerop and C_u_i_zerop were the wrong way
    around.  Our rewrites are applied in order, and a safe rewrite is
    always allowed, so it would never get to the unsafe rewrite.  We fix
    this by swapping them.  Now, the unsafe rewrite is considered first,
    and if we're in safe mode, we reject it and try the safe one instead.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/c-platform.scm b/c-platform.scm
index 46beaa8e..c46aae61 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -596,16 +596,14 @@
 (rewrite 'chicken.flonum#fpgcd 16 2 "C_a_i_flonum_gcd" #f words-per-flonum)
 
 (rewrite 'zero? 5 "C_eqp" 0 'fixnum)
-(rewrite 'zero? 2 1 "C_i_zerop" #t)
 (rewrite 'zero? 2 1 "C_u_i_zerop" #f)
+(rewrite 'zero? 2 1 "C_i_zerop" #t)
 (rewrite 'positive? 5 "C_fixnum_greaterp" 0 'fixnum)
 (rewrite 'positive? 5 "C_flonum_greaterp" 0 'flonum)
 (rewrite 'positive? 2 1 "C_i_positivep" #t)
-(rewrite 'positive? 2 1 "C_u_i_positivep" #f)
 (rewrite 'negative? 5 "C_fixnum_lessp" 0 'fixnum)
 (rewrite 'negative? 5 "C_flonum_lessp" 0 'flonum)
 (rewrite 'negative? 2 1 "C_i_negativep" #t)
-(rewrite 'negative? 2 1 "C_u_i_negativep" #f)
 
 (rewrite 'vector-length 6 "C_fix" "C_header_size" #f)
 (rewrite 'string-length 6 "C_fix" "C_header_size" #f)
@@ -707,8 +705,8 @@
 (rewrite 'odd? 14 'fixnum 1 "C_i_fixnumoddp" "C_i_fixnumoddp")
 (rewrite 'remainder 14 'fixnum 2 "C_fixnum_modulo" "C_fixnum_modulo")
 
-(rewrite 'even? 17 1 "C_i_evenp" "C_u_i_evenp")
-(rewrite 'odd? 17 1 "C_i_oddp" "C_u_i_oddp")
+(rewrite 'even? 17 1 "C_i_evenp")
+(rewrite 'odd? 17 1 "C_i_oddp")
 
 (rewrite 'chicken.fixnum#fxodd? 2 1 "C_i_fixnumoddp" #t)
 (rewrite 'chicken.fixnum#fxeven? 2 1 "C_i_fixnumevenp" #t)
diff --git a/library.scm b/library.scm
index 06726d5a..e8afbc39 100644
--- a/library.scm
+++ b/library.scm
@@ -5012,7 +5012,7 @@ EOF
 (define (##sys#foreign-pointer-argument x) (##core#inline "C_i_foreign_pointer_argumentp" x))
 (define (##sys#foreign-tagged-pointer-argument x tx) (##core#inline "C_i_foreign_tagged_pointer_argumentp" x tx))
 
-;; OBSOLETE (but still used by "enum"
+;; OBSOLETE
 (define (##sys#foreign-integer-argument x) (##core#inline "C_i_foreign_integer_argumentp" x))
 
 (define (##sys#foreign-ranged-integer-argument obj size)
diff --git a/support.scm b/support.scm
index 731c484c..29e867e2 100644
--- a/support.scm
+++ b/support.scm
@@ -1102,7 +1102,11 @@
 			`(slot-ref ,param 'this) )
 		       ((const) (repeat (cadr t)))
 		       ((enum)
-			(if unsafe param `(##sys#foreign-integer-argument ,param)))
+			(if unsafe
+			    param
+			    `(##sys#foreign-ranged-integer-argument
+			      ;; enums are integer size, according to the C standard.
+			      ,param (foreign-value "sizeof(int) * CHAR_BIT" int))))
 		       ((nonnull-pointer nonnull-c-pointer)
 			`(##sys#foreign-pointer-argument ,param) )
 		       (else param) ) )
diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
index a744449c..9d92afc6 100644
--- a/tests/compiler-tests.scm
+++ b/tests/compiler-tests.scm
@@ -107,6 +107,8 @@
 ;; Type specifiers and variable names in foreign-lambda in macros
 ;; are incorrectly renamed in modules, too.
 (foreign-declare "void foo(void *abc) { printf(\"hi\\n\"); }")
+;; This is silly but at least it ensures we can represent enum values
+(foreign-declare "enum intlimits {min=INT_MIN, zero=0, max=INT_MAX};")
 
 (module foo ()
   (import chicken scheme foreign) ; "chicken" includes an export for "void"
@@ -344,6 +346,10 @@
 (test-ffi-type-limits
  integer signed (foreign-value "sizeof(int) * CHAR_BIT" int))
 
+(test-ffi-type-limits
+ (enum intlimits) signed
+ (foreign-value "sizeof(enum intlimits) * CHAR_BIT" int))
+
 (test-ffi-type-limits
  unsigned-long unsigned
  (foreign-value "sizeof(unsigned long) * CHAR_BIT" int))
Trap