~ 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