On Wed, May 18, 2016 at 09:25:08PM +0200, Kooda wrote: > Hi, > > I was browsing bugs.call-cc.org and found this low hanging bug so I gave it a > shot. > I hope I didn’t mess up too much.
Hi Kooda! Many thanks for picking up the pace again. This is the ideal first commit for master after we branched off I think. I made small changes to your version: - Added a NEWS entry to point out that C_locative_ref is deprecated - Added /* DEPRECATED */ to the C_locative_ref entry in create_initial_ptable(), so we don't forget to remove it there once we remove the obsolete function. Attached is a signed-off copy, plus a port to CHICKEN 5, which is a bit hairier than you'd think because needs to handle bignums. Those can be returned when accessing locatives into {s,u}32vectors and there are now also the new {s,u}64vectors which obviously may return bignums too. Plus, the locatives procedures have moved to their own module (chicken.locative), which means it moved around in the file *and* has a prefix in types.db now. Merge conflicts galore ;) Small nitpick: As I also mentioned on IRC, patches for CHICKEN core should go to chicken-hackers, not chicken-users, so I'm CCing this mail to both lists. Cheers, Peter
From 21fa434e0a8a5ba530fc4dca05c0a0d23410ee2a Mon Sep 17 00:00:00 2001 From: Kooda <ko...@upyum.com> Date: Wed, 18 May 2016 10:48:58 +0200 Subject: [PATCH] Make locative-ref inlineable (ticket #1260) - Deprecate C_locative_ref - Add C_a_i_locative_ref - Add a compiler rewrite for locative-ref - Add a specialization for locative-ref on locatives Signed-off-by: Peter Bex <pe...@more-magic.net> --- NEWS | 6 ++++++ c-platform.scm | 2 +- chicken.h | 3 ++- lolevel.scm | 3 ++- runtime.c | 29 +++++++++++++++++++++++++++-- types.db | 4 +++- 6 files changed, 41 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index e4388e3..5bcd5ce 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,9 @@ +4.12.0 + +- Runtime system: + - C_locative_ref has been deprecated in favor of C_a_i_locative_ref, + which is faster because it is inlined (#1260, thanks to Kooda). + 4.11.0 - Security fixes diff --git a/c-platform.scm b/c-platform.scm index b2f6629..3e7548b 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -533,7 +533,6 @@ (rewrite 'call-with-values 13 2 "C_call_with_values" #t) (rewrite '##sys#call-with-values 13 2 "C_u_call_with_values" #f) (rewrite '##sys#call-with-values 13 2 "C_call_with_values" #t) -(rewrite 'locative-ref 13 1 "C_locative_ref" #t) (rewrite '##sys#continuation-graft 13 2 "C_continuation_graft" #t) (rewrite 'caar 2 1 "C_u_i_caar" #f) @@ -874,6 +873,7 @@ (rewrite 'address->pointer 16 1 "C_a_i_address_to_pointer" #f 2) (rewrite 'pointer->address 16 1 "C_a_i_pointer_to_address" #f words-per-flonum) (rewrite 'pointer+ 16 2 "C_a_u_i_pointer_inc" #f 2) +(rewrite 'locative-ref 16 1 "C_a_i_locative_ref" #t words-per-flonum) (rewrite 'pointer-u8-ref 2 1 "C_u_i_pointer_u8_ref" #f) (rewrite 'pointer-s8-ref 2 1 "C_u_i_pointer_s8_ref" #f) diff --git a/chicken.h b/chicken.h index 160d40d..3f00956 100644 --- a/chicken.h +++ b/chicken.h @@ -1831,7 +1831,7 @@ C_fctexport C_cpsproc(C_register_finalizer) C_noret; C_fctexport C_cpsproc(C_set_dlopen_flags) C_noret; C_fctexport C_cpsproc(C_dload) C_noret; C_fctexport C_cpsproc(C_become) C_noret; -C_fctexport C_cpsproc(C_locative_ref) C_noret; +C_fctexport C_cpsproc(C_locative_ref) C_noret; /* DEPRECATED */ C_fctexport C_cpsproc(C_call_with_cthulhu) C_noret; C_fctexport C_cpsproc(C_copy_closure) C_noret; C_fctexport C_cpsproc(C_dump_heap_state) C_noret; @@ -1923,6 +1923,7 @@ C_fctexport C_word C_fcall C_i_char_greaterp(C_word x, C_word y) C_regparm; C_fctexport C_word C_fcall C_i_char_lessp(C_word x, C_word y) C_regparm; C_fctexport C_word C_fcall C_i_char_greater_or_equal_p(C_word x, C_word y) C_regparm; C_fctexport C_word C_fcall C_i_char_less_or_equal_p(C_word x, C_word y) C_regparm; +C_fctexport C_word C_fcall C_a_i_locative_ref(C_word **a, int c, C_word loc) C_regparm; C_fctexport C_word C_fcall C_i_locative_set(C_word loc, C_word x) C_regparm; C_fctexport C_word C_fcall C_i_locative_to_object(C_word loc) C_regparm; C_fctexport C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_word object, C_word index, C_word weak) C_regparm; diff --git a/lolevel.scm b/lolevel.scm index 7a1724f..1ac2eed 100644 --- a/lolevel.scm +++ b/lolevel.scm @@ -298,7 +298,8 @@ EOF (define locative-ref (getter-with-setter - (##core#primitive "C_locative_ref") + (lambda (loc) + (##core#inline_allocate ("C_a_i_locative_ref" 4) loc)) locative-set! "(locative-ref loc)")) diff --git a/runtime.c b/runtime.c index 113e26d..cdaaa0e 100644 --- a/runtime.c +++ b/runtime.c @@ -895,7 +895,7 @@ static C_PTABLE_ENTRY *create_initial_ptable() C_pte(C_peek_unsigned_integer); C_pte(C_context_switch); C_pte(C_register_finalizer); - C_pte(C_locative_ref); + C_pte(C_locative_ref); /* OBSOLETE */ C_pte(C_copy_closure); C_pte(C_dump_heap_state); C_pte(C_filter_heap_objects); @@ -8780,7 +8780,7 @@ C_regparm C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_w return (C_word)loc; } - +/* DEPRECATED */ void C_ccall C_locative_ref(C_word c, C_word *av) { C_word @@ -8816,6 +8816,31 @@ void C_ccall C_locative_ref(C_word c, C_word *av) } } +C_regparm C_word C_fcall C_a_i_locative_ref(C_word **a, int c, C_word loc) +{ + C_word *ptr; + + if(C_immediatep(loc) || C_block_header(loc) != C_LOCATIVE_TAG) + barf(C_BAD_ARGUMENT_TYPE_ERROR, "locative-ref", loc); + + ptr = (C_word *)C_block_item(loc, 0); + + if(ptr == NULL) barf(C_LOST_LOCATIVE_ERROR, "locative-ref", loc); + + switch(C_unfix(C_block_item(loc, 2))) { + case C_SLOT_LOCATIVE: return *ptr; + case C_CHAR_LOCATIVE: return C_make_character(*((char *)ptr)); + case C_U8_LOCATIVE: return C_fix(*((unsigned char *)ptr)); + case C_S8_LOCATIVE: return C_fix(*((char *)ptr)); + case C_U16_LOCATIVE: return C_fix(*((unsigned short *)ptr)); + case C_S16_LOCATIVE: return C_fix(*((short *)ptr)); + case C_U32_LOCATIVE: return C_unsigned_int_to_num(a, *((C_u32 *)ptr)); + case C_S32_LOCATIVE: return C_int_to_num(a, *((C_s32 *)ptr)); + case C_F32_LOCATIVE: return C_flonum(a, *((float *)ptr)); + case C_F64_LOCATIVE: return C_flonum(a, *((double *)ptr)); + default: panic(C_text("bad locative type")); + } +} C_regparm C_word C_fcall C_i_locative_set(C_word loc, C_word x) { diff --git a/types.db b/types.db index b4a3887..b1165c0 100644 --- a/types.db +++ b/types.db @@ -1502,7 +1502,9 @@ (extended-procedure? (#(procedure #:clean) extended-procedure (*) boolean)) (free (#(procedure #:clean #:enforce) free (pointer) undefined)) (locative->object (#(procedure #:clean #:enforce) locative->object (locative) *)) -(locative-ref (#(procedure #:clean #:enforce) locative-ref (locative) *)) +(locative-ref (#(procedure #:clean #:enforce) locative-ref (locative) *) + ((locative) + (##core#inline_allocate ("C_a_i_locative_ref" 4) #(1)))) (locative-set! (#(procedure #:enforce) locative-set! (locative *) *)) (locative? (#(procedure #:pure #:predicate locative) locative? (*) boolean)) (make-locative (#(procedure #:clean #:enforce) make-locative (* #!optional fixnum) locative)) -- 2.1.4
From 4103f6e42506c680aa2d31edb9cb011a23f932b2 Mon Sep 17 00:00:00 2001 From: Kooda <ko...@upyum.com> Date: Wed, 18 May 2016 10:48:58 +0200 Subject: [PATCH] Make locative-ref inlineable (ticket #1260) - Deprecate C_locative_ref - Add C_a_i_locative_ref - Add a compiler rewrite for locative-ref - Add a specialization for locative-ref on locatives Signed-off-by: Peter Bex <pe...@more-magic.net> Conflicts: NEWS c-platform.scm lolevel.scm types.db --- NEWS | 6 ++++++ c-platform.scm | 2 +- chicken.h | 3 ++- lolevel.scm | 3 ++- runtime.c | 31 +++++++++++++++++++++++++++++-- types.db | 4 +++- 6 files changed, 43 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index a1e54e6..0538c94 100644 --- a/NEWS +++ b/NEWS @@ -37,6 +37,12 @@ - Removed support for (define-syntax (foo e r c) ...), which was undocumented and not officially supported anyway. +4.12.0 + +- Runtime system: + - C_locative_ref has been deprecated in favor of C_a_i_locative_ref, + which is faster because it is inlined (#1260, thanks to Kooda). + 4.11.0 - Security fixes diff --git a/c-platform.scm b/c-platform.scm index 8cb1fa5..9d596dc 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -430,7 +430,6 @@ (rewrite 'call-with-values 13 2 "C_call_with_values" #t) (rewrite '##sys#call-with-values 13 2 "C_u_call_with_values" #f) (rewrite '##sys#call-with-values 13 2 "C_call_with_values" #t) -(rewrite 'chicken.locative#locative-ref 13 1 "C_locative_ref" #t) (rewrite 'chicken.continuation#continuation-graft 13 2 "C_continuation_graft" #t) (rewrite 'caar 2 1 "C_u_i_caar" #f) @@ -749,6 +748,7 @@ (rewrite 'chicken.lolevel#address->pointer 16 1 "C_a_i_address_to_pointer" #f 2) (rewrite 'chicken.lolevel#pointer->address 16 1 "C_a_i_pointer_to_address" #f words-per-flonum) (rewrite 'chicken.lolevel#pointer+ 16 2 "C_a_u_i_pointer_inc" #f 2) +(rewrite 'chicken.locative#locative-ref 16 1 "C_a_i_locative_ref" #t 6) (rewrite 'chicken.lolevel#pointer-u8-ref 2 1 "C_u_i_pointer_u8_ref" #f) (rewrite 'chicken.lolevel#pointer-s8-ref 2 1 "C_u_i_pointer_s8_ref" #f) diff --git a/chicken.h b/chicken.h index 0bfd5fd..6d29f70 100644 --- a/chicken.h +++ b/chicken.h @@ -1967,7 +1967,7 @@ C_fctexport C_cpsproc(C_register_finalizer) C_noret; C_fctexport C_cpsproc(C_set_dlopen_flags) C_noret; C_fctexport C_cpsproc(C_dload) C_noret; C_fctexport C_cpsproc(C_become) C_noret; -C_fctexport C_cpsproc(C_locative_ref) C_noret; +C_fctexport C_cpsproc(C_locative_ref) C_noret; /* DEPRECATED */ C_fctexport C_cpsproc(C_call_with_cthulhu) C_noret; C_fctexport C_cpsproc(C_copy_closure) C_noret; C_fctexport C_cpsproc(C_dump_heap_state) C_noret; @@ -2086,6 +2086,7 @@ C_fctexport C_word C_fcall C_i_char_greaterp(C_word x, C_word y) C_regparm; C_fctexport C_word C_fcall C_i_char_lessp(C_word x, C_word y) C_regparm; C_fctexport C_word C_fcall C_i_char_greater_or_equal_p(C_word x, C_word y) C_regparm; C_fctexport C_word C_fcall C_i_char_less_or_equal_p(C_word x, C_word y) C_regparm; +C_fctexport C_word C_fcall C_a_i_locative_ref(C_word **a, int c, C_word loc) C_regparm; C_fctexport C_word C_fcall C_i_locative_set(C_word loc, C_word x) C_regparm; C_fctexport C_word C_fcall C_i_locative_to_object(C_word loc) C_regparm; C_fctexport C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_word object, C_word index, C_word weak) C_regparm; diff --git a/lolevel.scm b/lolevel.scm index e10b446..d226166 100644 --- a/lolevel.scm +++ b/lolevel.scm @@ -589,7 +589,8 @@ EOF (define locative-ref (getter-with-setter - (##core#primitive "C_locative_ref") + (lambda (loc) + (##core#inline_allocate ("C_a_i_locative_ref" 6) loc)) locative-set! "(locative-ref loc)")) diff --git a/runtime.c b/runtime.c index 58706e7..dee13bc 100644 --- a/runtime.c +++ b/runtime.c @@ -972,7 +972,7 @@ static C_PTABLE_ENTRY *create_initial_ptable() C_pte(C_peek_uint64); C_pte(C_context_switch); C_pte(C_register_finalizer); - C_pte(C_locative_ref); + C_pte(C_locative_ref); /* OBSOLETE */ C_pte(C_copy_closure); C_pte(C_dump_heap_state); C_pte(C_filter_heap_objects); @@ -12376,7 +12376,7 @@ C_regparm C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_w return (C_word)loc; } - +/* DEPRECATED */ void C_ccall C_locative_ref(C_word c, C_word *av) { C_word @@ -12419,6 +12419,33 @@ void C_ccall C_locative_ref(C_word c, C_word *av) } } +C_regparm C_word C_fcall C_a_i_locative_ref(C_word **a, int c, C_word loc) +{ + C_word *ptr; + + if(C_immediatep(loc) || C_block_header(loc) != C_LOCATIVE_TAG) + barf(C_BAD_ARGUMENT_TYPE_ERROR, "locative-ref", loc); + + ptr = (C_word *)C_block_item(loc, 0); + + if(ptr == NULL) barf(C_LOST_LOCATIVE_ERROR, "locative-ref", loc); + + switch(C_unfix(C_block_item(loc, 2))) { + case C_SLOT_LOCATIVE: return *ptr; + case C_CHAR_LOCATIVE: return C_make_character(*((char *)ptr)); + case C_U8_LOCATIVE: return C_fix(*((unsigned char *)ptr)); + case C_S8_LOCATIVE: return C_fix(*((char *)ptr)); + case C_U16_LOCATIVE: return C_fix(*((unsigned short *)ptr)); + case C_S16_LOCATIVE: return C_fix(*((short *)ptr)); + case C_U32_LOCATIVE: return C_unsigned_int_to_num(a, *((C_u32 *)ptr)); + case C_S32_LOCATIVE: return C_int_to_num(a, *((C_s32 *)ptr)); + case C_U64_LOCATIVE: return C_uint64_to_num(a, *((C_u64 *)ptr)); + case C_S64_LOCATIVE: return C_int64_to_num(a, *((C_s64 *)ptr)); + case C_F32_LOCATIVE: return C_flonum(a, *((float *)ptr)); + case C_F64_LOCATIVE: return C_flonum(a, *((double *)ptr)); + default: panic(C_text("bad locative type")); + } +} C_regparm C_word C_fcall C_i_locative_set(C_word loc, C_word x) { diff --git a/types.db b/types.db index 35df230..76c7fc3 100644 --- a/types.db +++ b/types.db @@ -1827,7 +1827,9 @@ ;; locative (chicken.locative#locative->object (#(procedure #:clean #:enforce) chicken.locative#locative->object (locative) *)) -(chicken.locative#locative-ref (#(procedure #:clean #:enforce) chicken.locative#locative-ref (locative) *)) +(chicken.locative#locative-ref (#(procedure #:clean #:enforce) chicken.locative#locative-ref (locative) *) + ((locative) + (##core#inline_allocate ("C_a_i_locative_ref" 6) #(1)))) (chicken.locative#locative-set! (#(procedure #:enforce) chicken.locative#locative-set! (locative *) *)) (chicken.locative#locative? (#(procedure #:pure #:predicate locative) chicken.locative#locative? (*) boolean)) (chicken.locative#make-locative (#(procedure #:clean #:enforce) chicken.locative#make-locative (* #!optional fixnum) locative)) -- 2.1.4
signature.asc
Description: Digital signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers