From fb995bea9eaebe4632c7257fab0f99b3b2fc6e97 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 4 Aug 2019 14:11:51 +0200 Subject: [PATCH] Mark ##sys#check-exact as deprecated and replace calls by ##sys#check-fixnum It is usually the wrong thing (most of its callers actually want to check for fixnumness), and its implementation is unsafe, which means it can cause segfaults when passed non-fixnum immediates (as found by Kooda in #1631) --- NEWS | 2 ++ c-platform.scm | 4 +--- chicken.h | 4 ++-- lfa2.scm | 4 ++-- library.scm | 2 +- lolevel.scm | 4 +--- runtime.c | 1 + 7 files changed, 10 insertions(+), 11 deletions(-) diff --git a/NEWS b/NEWS index bfb2536d..9a260df4 100644 --- a/NEWS +++ b/NEWS @@ -16,6 +16,8 @@ - IEEE floating point negative zero is now properly handled: it can be read, written and distinguished by eqv? and equal?, but not = (fixes #1627, thanks to John Cowan). + - ##sys#check-exact and its C implementations C_i_check_exact and + C_i_check_exact_2 have been deprecated (see also #1631). - Core libraries - There is now a srfi-88 module which contains just the three diff --git a/c-platform.scm b/c-platform.scm index f5206e91..2ece051f 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -261,7 +261,7 @@ '(##sys#slot ##sys#setslot ##sys#block-ref ##sys#block-set! ##sys#/-2 ##sys#call-with-current-continuation ##sys#size ##sys#byte ##sys#setbyte ##sys#pointer? ##sys#generic-structure? ##sys#structure? ##sys#check-structure - ##sys#check-exact ##sys#check-number ##sys#check-list ##sys#check-pair ##sys#check-string + ##sys#check-number ##sys#check-list ##sys#check-pair ##sys#check-string ##sys#check-symbol ##sys#check-boolean ##sys#check-locative ##sys#check-port ##sys#check-input-port ##sys#check-output-port ##sys#check-open-port @@ -667,7 +667,6 @@ (rewrite '##sys#vector-length 2 1 "C_i_vector_length" #t) (rewrite 'scheme#string-length 2 1 "C_i_string_length" #t) -(rewrite '##sys#check-exact 2 1 "C_i_check_exact" #t) (rewrite '##sys#check-fixnum 2 1 "C_i_check_fixnum" #t) (rewrite '##sys#check-number 2 1 "C_i_check_number" #t) (rewrite '##sys#check-list 2 1 "C_i_check_list" #t) @@ -680,7 +679,6 @@ (rewrite '##sys#check-vector 2 1 "C_i_check_vector" #t) (rewrite '##sys#check-structure 2 2 "C_i_check_structure" #t) (rewrite '##sys#check-char 2 1 "C_i_check_char" #t) -(rewrite '##sys#check-exact 2 2 "C_i_check_exact_2" #t) (rewrite '##sys#check-fixnum 2 2 "C_i_check_fixnum_2" #t) (rewrite '##sys#check-number 2 2 "C_i_check_number_2" #t) (rewrite '##sys#check-list 2 2 "C_i_check_list_2" #t) diff --git a/chicken.h b/chicken.h index f97d3195..72d5d397 100644 --- a/chicken.h +++ b/chicken.h @@ -1382,7 +1382,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret; #endif #define C_i_check_closure(x) C_i_check_closure_2(x, C_SCHEME_FALSE) -#define C_i_check_exact(x) C_i_check_exact_2(x, C_SCHEME_FALSE) +#define C_i_check_exact(x) C_i_check_exact_2(x, C_SCHEME_FALSE) /* DEPRECATED */ #define C_i_check_fixnum(x) C_i_check_fixnum_2(x, C_SCHEME_FALSE) #define C_i_check_inexact(x) C_i_check_inexact_2(x, C_SCHEME_FALSE) #define C_i_check_number(x) C_i_check_number_2(x, C_SCHEME_FALSE) @@ -2003,7 +2003,7 @@ C_fctexport C_word C_fcall C_i_length(C_word lst) C_regparm; C_fctexport C_word C_fcall C_u_i_length(C_word lst) C_regparm; C_fctexport C_word C_fcall C_i_check_closure_2(C_word x, C_word loc) C_regparm; C_fctexport C_word C_fcall C_i_check_fixnum_2(C_word x, C_word loc) C_regparm; -C_fctexport C_word C_fcall C_i_check_exact_2(C_word x, C_word loc) C_regparm; +C_fctexport C_word C_fcall C_i_check_exact_2(C_word x, C_word loc) C_regparm; /* DEPRECATED */ C_fctexport C_word C_fcall C_i_check_inexact_2(C_word x, C_word loc) C_regparm; C_fctexport C_word C_fcall C_i_check_number_2(C_word x, C_word loc) C_regparm; C_fctexport C_word C_fcall C_i_check_string_2(C_word x, C_word loc) C_regparm; diff --git a/lfa2.scm b/lfa2.scm index f7516658..2556dc53 100644 --- a/lfa2.scm +++ b/lfa2.scm @@ -56,7 +56,7 @@ (define +type-check-map+ '(("C_i_check_closure" procedure) - ("C_i_check_exact" fixnum bignum integer ratnum) + ("C_i_check_exact" fixnum bignum integer ratnum) ;; DEPRECATED ("C_i_check_inexact" float) ; Or an inexact cplxnum... ("C_i_check_number" fixnum integer bignum ratnum float cplxnum number) ("C_i_check_string" string) @@ -71,7 +71,7 @@ ("C_i_check_structure" *struct*) ; special case ("C_i_check_char" char) ("C_i_check_closure_2" procedure) - ("C_i_check_exact_2" fixnum bignum integer ratnum) + ("C_i_check_exact_2" fixnum bignum integer ratnum) ;; DEPRECATED ("C_i_check_inexact_2" float) ; Or an inexact cplxnum... ("C_i_check_number_2" fixnum integer bignum ratnum float cplxnum number) ("C_i_check_string_2" string) diff --git a/library.scm b/library.scm index 8c318093..bc0ef42c 100644 --- a/library.scm +++ b/library.scm @@ -1141,7 +1141,7 @@ EOF (##core#inline "C_i_check_fixnum_2" x (car loc)) (##core#inline "C_i_check_fixnum" x) ) ) -(define (##sys#check-exact x . loc) +(define (##sys#check-exact x . loc) ;; DEPRECATED (if (pair? loc) (##core#inline "C_i_check_exact_2" x (car loc)) (##core#inline "C_i_check_exact" x) ) ) diff --git a/lolevel.scm b/lolevel.scm index bd3aea5a..42d415d7 100644 --- a/lolevel.scm +++ b/lolevel.scm @@ -339,7 +339,7 @@ EOF (define make-pointer-vector (let ((unset (list 'unset))) (lambda (n #!optional (init unset)) - (##sys#check-exact n 'make-pointer-vector) + (##sys#check-fixnum n 'make-pointer-vector) (let* ((words->bytes (foreign-lambda int "C_wordstobytes" int)) (size (words->bytes n)) (buf (##sys#make-blob size))) @@ -384,7 +384,6 @@ EOF (define (pointer-vector-set! pv i ptr) (##sys#check-structure pv 'pointer-vector 'pointer-vector-ref) - (##sys#check-exact i 'pointer-vector-ref) (##sys#check-range i 0 (##sys#slot pv 1)) ; len (when ptr (##sys#check-pointer ptr 'pointer-vector-set!)) (pv-buf-set! (##sys#slot pv 2) i ptr)) @@ -393,7 +392,6 @@ EOF (getter-with-setter (lambda (pv i) (##sys#check-structure pv 'pointer-vector 'pointer-vector-ref) - (##sys#check-exact i 'pointer-vector-ref) (##sys#check-range i 0 (##sys#slot pv 1)) ; len (pv-buf-ref (##sys#slot pv 2) i)) ; buf pointer-vector-set! diff --git a/runtime.c b/runtime.c index 5b4e1277..5e1bb9f1 100644 --- a/runtime.c +++ b/runtime.c @@ -7292,6 +7292,7 @@ C_regparm C_word C_fcall C_i_check_fixnum_2(C_word x, C_word loc) return C_SCHEME_UNDEFINED; } +/* DEPRECATED */ C_regparm C_word C_fcall C_i_check_exact_2(C_word x, C_word loc) { if(C_u_i_exactp(x) == C_SCHEME_FALSE) { -- 2.20.1