Re: [Chicken-users] [PATCH] (low priority) Make locative-ref inlineable (ticket #1260)

2016-05-19 Thread Peter Bex 
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 
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 
---
 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); /*

[Chicken-users] [PATCH] (low priority) Make locative-ref inlineable (ticket #1260)

2016-05-18 Thread Kooda 
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.

>From fcba39930dcb56cc16500531fa37cf0fe0a4aaef Mon Sep 17 00:00:00 2001
From: Kooda 
Date: Wed, 18 May 2016 10:48:58 +0200
Subject: [PATCH] Make locative-ref inlineable (ticket #1260)

- Deprecate C_localtive_ref
- Add C_a_i_locative_ref
- Add a compiler rewrite for locative-ref
- Add a specialization for locative-ref on locatives
---
 c-platform.scm |  2 +-
 chicken.h  |  3 ++-
 lolevel.scm|  3 ++-
 runtime.c  | 27 ++-
 types.db   |  4 +++-
 5 files changed, 34 insertions(+), 5 deletions(-)

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..c61d5d2 100644
--- a/runtime.c
+++ b/runtime.c
@@ -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