Hi everyone,

the attached patch addresses the issue explained in
https://bugs.call-cc.org/ticket/1216 as well as similar ones I found by
sifting through the whole of types.db, though I can't guarantee that any
other instances slipped my attention, of course.

The only one I'm a bit unhappy about is `move-memory!' as I couldn't
find a safe inline version of it. Does anyone have a clue whether there
is such a thing already?

Moritz
From c40e4f11abb29c6f2451656a3c09ea3272c5ddb8 Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp <moritz.heidk...@bevuta.com>
Date: Sat, 5 Sep 2015 00:24:32 +0200
Subject: [PATCH] Fix unsafe specializations in types.db

This patch fixes some specializations in types.db which could lead to
unsafe code. In all cases, the specialized versions did not only elide
runtime type checks but also range checks for their arguments. For
example, `string-ref' could have been specialized so that it would allow
for an index pointing past the end of the string to be passed.

Fixes #1216.
---
 types.db | 20 ++++----------------
 1 file changed, 4 insertions(+), 16 deletions(-)

diff --git a/types.db b/types.db
index b79020c..4058872 100644
--- a/types.db
+++ b/types.db
@@ -551,10 +551,10 @@
 	       ((string) (##sys#size #(1))))
 
 (string-ref (#(procedure #:clean #:enforce) string-ref (string fixnum) char)
-	    ((string fixnum) (##core#inline "C_subchar" #(1) #(2))))
+	    ((string fixnum) (##core#inline "C_i_string_ref" #(1) #(2))))
 
 (string-set! (#(procedure #:enforce) string-set! (string fixnum char) undefined)
-	     ((string fixnum char) (##core#inline "C_setsubchar" #(1) #(2) #(3))))
+	     ((string fixnum char) (##core#inline "C_i_string_set" #(1) #(2) #(3))))
 
 (string-append (#(procedure #:clean #:enforce) string-append (#!rest string) string)
 	       ((string string) (##sys#string-append #(1) #(2))))
@@ -731,7 +731,7 @@
 (arithmetic-shift (#(procedure #:clean #:enforce) arithmetic-shift (number number) number))
 
 (bit-set? (#(procedure #:clean #:enforce) bit-set? (number fixnum) boolean)
-	  ((fixnum fixnum) (##core#inline "C_u_i_bit_setp" #(1) #(2))))
+	  ((fixnum fixnum) (##core#inline "C_i_bit_setp" #(1) #(2))))
 
 (bitwise-and (#(procedure #:clean #:enforce) bitwise-and (#!rest number) number)
 	     ((fixnum fixnum) (fixnum)
@@ -1488,19 +1488,7 @@
 (make-record-instance (#(procedure #:clean) make-record-instance (symbol #!rest) *))
 (make-weak-locative (#(procedure #:clean #:enforce) make-weak-locative (* #!optional fixnum) locative))
 
-(move-memory! (#(procedure #:enforce) move-memory! (* * #!optional fixnum fixnum fixnum) *)
-	      ((pointer pointer fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
-	      ((pointer pointer fixnum fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
-	      ((pointer pointer fixnum fixnum fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4)))
-	      ((locative locative fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
-	      ((locative locative fixnum fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
-	      ((locative locative fixnum fixnum fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4))))
+(move-memory! (#(procedure #:enforce) move-memory! (* * #!optional fixnum fixnum fixnum) *))
 
 (mutate-procedure!
  (#(procedure #:enforce) mutate-procedure! (procedure (procedure (procedure) . *)) procedure))
-- 
2.4.6

Attachment: signature.asc
Description: PGP signature

_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to