~ 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