~ chicken-core (chicken-5) d15fc586510da712f86ed5d67f79c312f37659c9


commit d15fc586510da712f86ed5d67f79c312f37659c9
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Mar 2 12:56:57 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Mar 2 12:56:57 2010 +0100

    resurected pointer-offset, added unboxing for null-pointer?

diff --git a/chicken.h b/chicken.h
index bc45b15e..314203b5 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1120,7 +1120,7 @@ extern double trunc(double);
 #define C_fetch_byte(x, p)              (((unsigned C_byte *)((C_SCHEME_BLOCK *)(x))->data)[ p ])
 #define C_poke_integer(x, i, n)         (C_set_block_item(x, C_unfix(i), C_num_to_int(n)), C_SCHEME_UNDEFINED)
 #define C_pointer_to_block(p, x)        (C_set_block_item(p, 0, (C_word)C_data_pointer(x)), C_SCHEME_UNDEFINED)
-#define C_null_pointerp(x)              C_mk_bool((void *)C_u_i_car(x) == NULL)
+#define C_null_pointerp(x)              C_mk_bool((void *)C_block_item(x, 0) == NULL)
 #define C_update_pointer(p, ptr)        (C_set_block_item(ptr, 0, C_num_to_unsigned_int(p)), C_SCHEME_UNDEFINED)
 #define C_copy_pointer(from, to)        (C_set_block_item(to, 0, C_u_i_car(from)), C_SCHEME_UNDEFINED)
 #define C_pointer_to_object(ptr)        C_block_item(ptr, 0)
@@ -1352,6 +1352,7 @@ extern double trunc(double);
 
 #define C_ub_i_pointer_inc(p, n)        ((void *)((unsigned char *)(p) + (n)))
 #define C_ub_i_pointer_eqp(p1, p2)      ((p1) == (p2))
+#define C_ub_i_null_pointerp(p)         ((p) == NULL)
 
 #define C_ub_i_pointer_u8_ref(p)        (*((unsigned char *)(p)))
 #define C_ub_i_pointer_s8_ref(p)        (*((char *)(p)))
diff --git a/lolevel.import.scm b/lolevel.import.scm
index d27a356d..16380043 100644
--- a/lolevel.import.scm
+++ b/lolevel.import.scm
@@ -62,6 +62,7 @@
    object-unevict
    pointer->address
    pointer-like?
+   pointer-offset			; DEPRECATED
    pointer->object
    pointer-f32-ref
    pointer-f32-set!
diff --git a/lolevel.scm b/lolevel.scm
index 521a6356..b41eb3fa 100644
--- a/lolevel.scm
+++ b/lolevel.scm
@@ -268,7 +268,7 @@ EOF
 
 (define (null-pointer? ptr)
   (##sys#check-special ptr 'null-pointer?)
-  (eq? 0 (##sys#pointer->address ptr) ) )
+  (##core#inline "C_null_pointerp" ptr))
 
 (define (object->pointer x)
   (and (##core#inline "C_blockp" x)
@@ -287,6 +287,8 @@ EOF
   (foreign-lambda* nonnull-c-pointer ([c-pointer ptr] [integer off])
     "return((unsigned char *)ptr + off);") )
 
+(define pointer-offset pointer+)	; DEPRECATED
+
 (define align-to-word
   (let ([align (foreign-lambda integer "C_align" integer)])
     (lambda (x)
diff --git a/manual/Using the compiler b/manual/Using the compiler
index d5129e7a..f85c4fbd 100644
--- a/manual/Using the compiler	
+++ b/manual/Using the compiler	
@@ -201,7 +201,7 @@ Possible options are:
 
 ; -to-stdout : Write compiled code to standard output instead of creating a {{.c}} file.
 
-; -unboxing : try to use unboxed temporaries for numerical operations.
+; -unboxing : try to use unboxed temporaries for numerical operations. This optimization is only effective in unsafe mode.
 
 ; -unit NAME : Compile this file as a library unit. Equivalent to {{-prelude "(declare (unit NAME))"}}
 
diff --git a/types.db b/types.db
index 54e7a960..22db47cb 100644
--- a/types.db
+++ b/types.db
@@ -602,6 +602,7 @@
 (pointer-f32-set! (procedure pointer-f32-set! (pointer number) undefined))
 (pointer-f64-ref (procedure pointer-f64-ref (pointer) number))
 (pointer-f64-set! (procedure pointer-f64-set! (pointer number) undefined))
+(pointer-offset deprecated)
 (pointer+ (procedure pointer+ (pointer fixnum) pointer))
 (pointer-s16-ref (procedure pointer-s16-ref (pointer) fixnum))
 (pointer-s16-set! (procedure pointer-s16-set! (pointer fixnum) undefined))
diff --git a/unboxing.scm b/unboxing.scm
index 4efe84b8..9e4d1dd2 100644
--- a/unboxing.scm
+++ b/unboxing.scm
@@ -443,4 +443,5 @@
   (C_u_i_pointer_s32_set (pointer fixnum) fixnum "C_ub_i_pointer_s32_ref")
   (C_u_i_pointer_f32_set (pointer flonum) flonum "C_ub_i_pointer_f32_ref")
   (C_u_i_pointer_f64_set (pointer flonum) flonum "C_ub_i_pointer_f64_ref")
+  (C_null_pointerp (pointer) bool "C_ub_i_null_pointerp")
   )
Trap