~ chicken-core (chicken-5) ed55272409842280910a6d7e46bffc10deb07b69
commit ed55272409842280910a6d7e46bffc10deb07b69
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sat Feb 7 12:52:29 2015 +0100
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun May 31 14:20:00 2015 +0200
Extend srfi-4 with s64vectors and u64vectors, so we have the full SRFI covered.
Update locatives to use exact integers and support 64-bit integers.
diff --git a/c-backend.scm b/c-backend.scm
index ab4d2a25..0ef353b0 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -1193,9 +1193,11 @@
((blob nonnull-blob u8vector nonnull-u8vector) (str "unsigned char *"))
((u16vector nonnull-u16vector) (str "unsigned short *"))
((s8vector nonnull-s8vector) (str "signed char *"))
- ((u32vector nonnull-u32vector) (str "unsigned int *"))
+ ((u32vector nonnull-u32vector) (str "unsigned int *")) ;; C_u32?
+ ((u64vector nonnull-u64vector) (str "C_u64 *"))
((s16vector nonnull-s16vector) (str "short *"))
- ((s32vector nonnull-s32vector) (str "int *"))
+ ((s32vector nonnull-s32vector) (str "int *")) ;; C_s32?
+ ((s64vector nonnull-s64vector) (str "C_s64 *"))
((f32vector nonnull-f32vector) (str "float *"))
((f64vector nonnull-f64vector) (str "double *"))
((pointer-vector nonnull-pointer-vector) (str "void **"))
@@ -1293,12 +1295,16 @@
((nonnull-u16vector) "C_c_u16vector(")
((u32vector) "C_c_u32vector_or_null(")
((nonnull-u32vector) "C_c_u32vector(")
+ ((u64vector) "C_c_u64vector_or_null(")
+ ((nonnull-u64vector) "C_c_u64vector(")
((s8vector) "C_c_s8vector_or_null(")
((nonnull-s8vector) "C_c_s8vector(")
((s16vector) "C_c_s16vector_or_null(")
((nonnull-s16vector) "C_c_s16vector(")
((s32vector) "C_c_s32vector_or_null(")
((nonnull-s32vector) "C_c_s32vector(")
+ ((s64vector) "C_c_s64vector_or_null(")
+ ((nonnull-s64vector) "C_c_s64vector(")
((f32vector) "C_c_f32vector_or_null(")
((nonnull-f32vector) "C_c_f32vector(")
((f64vector) "C_c_f64vector_or_null(")
diff --git a/c-platform.scm b/c-platform.scm
index 1286844b..91f1c0fe 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -151,20 +151,24 @@
atom? print print* error call/cc
blob-size u8vector->blob/shared s8vector->blob/shared u16vector->blob/shared
s16vector->blob/shared u32vector->blob/shared s32vector->blob/shared
+ u64vector->blob/shared s64vector->blob/shared
f32vector->blob/shared f64vector->blob/shared
blob->u8vector/shared blob->s8vector/shared blob->u16vector/shared
blob->s16vector/shared blob->u32vector/shared blob->s32vector/shared
+ blob->u64vector/shared blob->s64vector/shared
blob->f32vector/shared blob->f64vector/shared
block-ref block-set! number-of-slots substring-index substring-index-ci
any? read-string substring=? substring-ci=? blob=? equal=?
alist-ref rassoc make-polar make-rectangular real-part imag-part
string->symbol symbol-append make-record-instance foldl foldr
- u8vector-length s8vector-length u16vector-length s16vector-length u32vector-length
- s32vector-length
+ u8vector-length s8vector-length u16vector-length s16vector-length
+ u32vector-length u64vector-length s32vector-length s64vector-length
f32vector-length f64vector-length setter
- u8vector-ref s8vector-ref u16vector-ref s16vector-ref u32vector-ref s32vector-ref
+ u8vector-ref s8vector-ref u16vector-ref s16vector-ref
+ u32vector-ref s32vector-ref u64vector-ref s64vector-ref
f32vector-ref f64vector-ref f32vector-set! f64vector-set!
- u8vector-set! s8vector-set! u16vector-set! s16vector-set! u32vector-set! s32vector-set!
+ u8vector-set! s8vector-set! u16vector-set! s16vector-set!
+ u32vector-set! s32vector-set! u64vector-set! s64vector-set!
locative-ref locative-set! locative->object locative?
pointer->object flonum? nan? finite? infinite? address->pointer pointer->address
pointer+ pointer=?
@@ -748,6 +752,7 @@
(rewrite 'blob-size 2 1 "C_block_size" #f)
+;; TODO: Move this stuff to types.db
(rewrite 'u8vector-ref 2 2 "C_u_i_u8vector_ref" #f)
(rewrite 's8vector-ref 2 2 "C_u_i_s8vector_ref" #f)
(rewrite 'u16vector-ref 2 2 "C_u_i_u16vector_ref" #f)
@@ -756,15 +761,14 @@
(rewrite 'f32vector-ref 16 2 "C_a_u_i_f32vector_ref" #f words-per-flonum)
(rewrite 'f64vector-ref 16 2 "C_a_u_i_f64vector_ref" #f words-per-flonum)
-(rewrite 'u32vector-ref 22 2 "C_a_u_i_u32vector_ref" #f words-per-flonum "C_u_i_u32vector_ref")
-(rewrite 's32vector-ref 22 2 "C_a_u_i_s32vector_ref" #f words-per-flonum "C_u_i_s32vector_ref")
-
(rewrite 'u8vector-set! 2 3 "C_u_i_u8vector_set" #f)
(rewrite 's8vector-set! 2 3 "C_u_i_s8vector_set" #f)
(rewrite 'u16vector-set! 2 3 "C_u_i_u16vector_set" #f)
(rewrite 's16vector-set! 2 3 "C_u_i_s16vector_set" #f)
(rewrite 'u32vector-set! 2 3 "C_u_i_u32vector_set" #f)
(rewrite 's32vector-set! 2 3 "C_u_i_s32vector_set" #f)
+(rewrite 'u64vector-set! 2 3 "C_u_i_u32vector_set" #f)
+(rewrite 's64vector-set! 2 3 "C_u_i_s32vector_set" #f)
(rewrite 'f32vector-set! 2 3 "C_u_i_f32vector_set" #f)
(rewrite 'f64vector-set! 2 3 "C_u_i_f64vector_set" #f)
@@ -774,6 +778,8 @@
(rewrite 's16vector-length 2 1 "C_u_i_16vector_length" #f)
(rewrite 'u32vector-length 2 1 "C_u_i_32vector_length" #f)
(rewrite 's32vector-length 2 1 "C_u_i_32vector_length" #f)
+(rewrite 'u64vector-length 2 1 "C_u_i_64vector_length" #f)
+(rewrite 's64vector-length 2 1 "C_u_i_64vector_length" #f)
(rewrite 'f32vector-length 2 1 "C_u_i_32vector_length" #f)
(rewrite 'f64vector-length 2 1 "C_u_i_64vector_length" #f)
@@ -785,6 +791,8 @@
(rewrite 's16vector->blob/shared 7 1 "C_slot" 1 #f)
(rewrite 'u32vector->blob/shared 7 1 "C_slot" 1 #f)
(rewrite 's32vector->blob/shared 7 1 "C_slot" 1 #f)
+(rewrite 'u64vector->blob/shared 7 1 "C_slot" 1 #f)
+(rewrite 's64vector->blob/shared 7 1 "C_slot" 1 #f)
(rewrite 'f32vector->blob/shared 7 1 "C_slot" 1 #f)
(rewrite 'f64vector->blob/shared 7 1 "C_slot" 1 #f)
@@ -853,6 +861,8 @@
(s16vector-ref . s16vector-set!)
(u32vector-ref . u32vector-set!)
(s32vector-ref . s32vector-set!)
+ (u64vector-ref . u64vector-set!)
+ (s64vector-ref . s64vector-set!)
(f32vector-ref . f32vector-set!)
(f64vector-ref . f64vector-set!)
(pointer-u8-ref . pointer-u8-set!)
diff --git a/chicken.h b/chicken.h
index ff85bca7..a4b0e811 100644
--- a/chicken.h
+++ b/chicken.h
@@ -556,8 +556,10 @@ static inline int isinf_ld (long double x)
#define C_S16_LOCATIVE 5
#define C_U32_LOCATIVE 6
#define C_S32_LOCATIVE 7
-#define C_F32_LOCATIVE 8
-#define C_F64_LOCATIVE 9
+#define C_U64_LOCATIVE 8
+#define C_S64_LOCATIVE 9
+#define C_F32_LOCATIVE 10
+#define C_F64_LOCATIVE 11
#if defined (__MINGW32__)
# define C_s64 __int64
@@ -1181,6 +1183,10 @@ extern double trunc(double);
#define C_c_u32vector_or_null(x) ((C_u32 *)C_srfi_4_vector_or_null(x))
#define C_c_s32vector(x) ((C_s32 *)C_srfi_4_vector(x))
#define C_c_s32vector_or_null(x) ((C_s32 *)C_srfi_4_vector_or_null(x))
+#define C_c_u64vector(x) ((C_u64 *)C_srfi_4_vector(x))
+#define C_c_u64vector_or_null(x) ((C_u64 *)C_srfi_4_vector_or_null(x))
+#define C_c_s64vector(x) ((C_s64 *)C_srfi_4_vector(x))
+#define C_c_s64vector_or_null(x) ((C_s64 *)C_srfi_4_vector_or_null(x))
#define C_c_f32vector(x) ((float *)C_srfi_4_vector(x))
#define C_c_f32vector_or_null(x) ((float *)C_srfi_4_vector_or_null(x))
#define C_c_f64vector(x) ((double *)C_srfi_4_vector(x))
@@ -1538,6 +1544,8 @@ extern double trunc(double);
#define C_u_i_s16vector_length C_u_i_16vector_length
#define C_u_i_u32vector_length C_u_i_32vector_length
#define C_u_i_s32vector_length C_u_i_32vector_length
+#define C_u_i_u64vector_length C_u_i_64vector_length
+#define C_u_i_s64vector_length C_u_i_64vector_length
#define C_u_i_f32vector_length C_u_i_32vector_length
#define C_u_i_f64vector_length C_u_i_64vector_length
@@ -1553,12 +1561,17 @@ extern double trunc(double);
#define C_a_u_i_u32vector_ref(ptr, c, x, i) C_unsigned_int_to_num(ptr, ((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
#define C_a_u_i_s32vector_ref(ptr, c, x, i) C_int_to_num(ptr, ((C_s32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
+#define C_a_u_i_u64vector_ref(ptr, c, x, i) C_uint64_to_num(ptr, ((C_u64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
+#define C_a_u_i_s64vector_ref(ptr, c, x, i) C_int64_to_num(ptr, ((C_s64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
+
#define C_u_i_u8vector_set(x, i, v) ((((unsigned char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
#define C_u_i_s8vector_set(x, i, v) ((((signed char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
#define C_u_i_u16vector_set(x, i, v) ((((unsigned short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
#define C_u_i_s16vector_set(x, i, v) ((((short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
#define C_u_i_u32vector_set(x, i, v) ((((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_unsigned_int(v)), C_SCHEME_UNDEFINED)
#define C_u_i_s32vector_set(x, i, v) ((((C_s32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_int(v)), C_SCHEME_UNDEFINED)
+#define C_u_i_u64vector_set(x, i, v) ((((C_u64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_uint64(v)), C_SCHEME_UNDEFINED)
+#define C_u_i_s64vector_set(x, i, v) ((((C_s64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_int64(v)), C_SCHEME_UNDEFINED)
#define C_u_i_bit_setp(x, i) C_mk_bool((C_unfix(x) & (1 << C_unfix(i))) != 0)
@@ -1570,6 +1583,10 @@ extern double trunc(double);
C_unsigned_int_to_num(ap, *((C_u32 *)C_block_item(ptr, 0)))
#define C_a_u_i_pointer_s32_ref(ap, n, ptr) \
C_int_to_num(ap, *((C_s32 *)C_block_item(ptr, 0)))
+#define C_a_u_i_pointer_u64_ref(ap, n, ptr) \
+ C_uint64_to_num(ap, *((C_u64 *)C_block_item(ptr, 0)))
+#define C_a_u_i_pointer_s64_ref(ap, n, ptr) \
+ C_int64_to_num(ap, *((C_s64 *)C_block_item(ptr, 0)))
#define C_a_u_i_pointer_f32_ref(ap, n, ptr) C_flonum(ap, *((float *)C_block_item(ptr, 0)))
#define C_a_u_i_pointer_f64_ref(ap, n, ptr) C_flonum(ap, *((double *)C_block_item(ptr, 0)))
#define C_u_i_pointer_u8_set(ptr, x) \
@@ -1584,6 +1601,10 @@ extern double trunc(double);
(*((C_u32 *)C_block_item(ptr, 0)) = C_num_to_unsigned_int(x), C_SCHEME_UNDEFINED)
#define C_u_i_pointer_s32_set(ptr, x) \
(*((C_s32 *)C_block_item(ptr, 0)) = C_num_to_int(x), C_SCHEME_UNDEFINED)
+#define C_u_i_pointer_u64_set(ptr, x) \
+ (*((C_u64 *)C_block_item(ptr, 0)) = C_num_to_uint64(x), C_SCHEME_UNDEFINED)
+#define C_u_i_pointer_s64_set(ptr, x) \
+ (*((C_s64 *)C_block_item(ptr, 0)) = C_num_to_int64(x), C_SCHEME_UNDEFINED)
#define C_u_i_pointer_f32_set(ptr, x) \
(*((float *)C_block_item(ptr, 0)) = C_flonum_magnitude(x), C_SCHEME_UNDEFINED)
#define C_u_i_pointer_f64_set(ptr, x) \
@@ -1628,6 +1649,8 @@ extern double trunc(double);
#define C_ub_i_pointer_s16_ref(p) (*((short *)(p)))
#define C_ub_i_pointer_u32_ref(p) (*((C_u32 *)(p)))
#define C_ub_i_pointer_s32_ref(p) (*((C_s32 *)(p)))
+#define C_ub_i_pointer_u64_ref(p) (*((C_u64 *)(p)))
+#define C_ub_i_pointer_s64_ref(p) (*((C_s64 *)(p)))
#define C_ub_i_pointer_f32_ref(p) (*((float *)(p)))
#define C_ub_i_pointer_f64_ref(p) (*((double *)(p)))
#define C_ub_i_pointer_u8_set(p, n) (*((unsigned char *)(p)) = (n))
@@ -1636,6 +1659,8 @@ extern double trunc(double);
#define C_ub_i_pointer_s16_set(p, n) (*((short *)(p)) = (n))
#define C_ub_i_pointer_u32_set(p, n) (*((C_u32 *)(p)) = (n))
#define C_ub_i_pointer_s32_set(p, n) (*((C_s32 *)(p)) = (n))
+#define C_ub_i_pointer_u64_set(p, n) (*((C_u64 *)(p)) = (n))
+#define C_ub_i_pointer_s64_set(p, n) (*((C_s64 *)(p)) = (n))
#define C_ub_i_pointer_f32_set(p, n) (*((float *)(p)) = (n))
#define C_ub_i_pointer_f64_set(p, n) (*((double *)(p)) = (n))
@@ -1971,6 +1996,8 @@ C_fctexport void C_ccall C_get_memory_info(C_word c, C_word closure, C_word k) C
C_fctexport void C_ccall C_context_switch(C_word c, C_word closure, C_word k, C_word state) C_noret;
C_fctexport void C_ccall C_peek_signed_integer(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret;
C_fctexport void C_ccall C_peek_unsigned_integer(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret;
+C_fctexport void C_ccall C_peek_int64(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret;
+C_fctexport void C_ccall C_peek_uint64(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret;
C_fctexport void C_ccall C_decode_seconds(C_word c, C_word closure, C_word k, C_word secs, C_word mode) C_noret;
C_fctexport void C_ccall C_software_type(C_word c, C_word closure, C_word k) C_noret;
C_fctexport void C_ccall C_machine_type(C_word c, C_word closure, C_word k) C_noret;
diff --git a/csi.scm b/csi.scm
index 8a7fed0b..3ad75c47 100644
--- a/csi.scm
+++ b/csi.scm
@@ -542,6 +542,8 @@ EOF
(s16vector "vector of signed 16-bit words" s16vector-length s16vector-ref)
(u32vector "vector of unsigned 32-bit words" u32vector-length u32vector-ref)
(s32vector "vector of signed 32-bit words" s32vector-length s32vector-ref)
+ (u64vector "vector of unsigned 64-bit words" u64vector-length u64vector-ref)
+ (s64vector "vector of signed 64-bit words" s64vector-length s64vector-ref)
(f32vector "vector of 32-bit floats" f32vector-length f32vector-ref)
(f64vector "vector of 64-bit floats" f64vector-length f64vector-ref) ) )
@@ -685,8 +687,10 @@ EOF
((5) "s16vector")
((6) "u32vector")
((7) "s32vector")
- ((8) "f32vector")
- ((9) "f64vector") ) ) )
+ ((8) "u64vector")
+ ((9) "s64vector")
+ ((10) "f32vector")
+ ((11) "f64vector") ) ) )
((##sys#pointer? x) (fprintf out "machine pointer ~X~%" (##sys#peek-unsigned-integer x 0)))
((##sys#bytevector? x)
(let ([len (##sys#size x)])
diff --git a/library.scm b/library.scm
index 9e94bf32..5e7b9c55 100644
--- a/library.scm
+++ b/library.scm
@@ -5462,7 +5462,7 @@ EOF
(and (##core#inline "C_blockp" x)
(##sys#generic-structure? x)
(memq (##sys#slot x 0)
- '(u8vector u16vector s8vector s16vector u32vector s32vector f32vector f64vector))))
+ '(u8vector u16vector s8vector s16vector u32vector s32vector u64vector s64vector f32vector f64vector))))
(define (##sys#null-pointer)
(let ([ptr (##sys#make-pointer)])
@@ -6100,42 +6100,50 @@ EOF
(##core#inline_allocate ("C_a_i_make_locative" 5) 2 obj index weak?) ]
[(##sys#generic-structure? obj)
(case (##sys#slot obj 0)
- [(u8vector)
+ ((u8vector)
(let ([v (##sys#slot obj 1)])
(##sys#check-range index 0 (##sys#size v) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 2 v index weak?)) ]
- [(s8vector)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 2 v index weak?)) )
+ ((s8vector)
(let ([v (##sys#slot obj 1)])
(##sys#check-range index 0 (##sys#size v) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 3 v index weak?) ) ]
- [(u16vector)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 3 v index weak?) ) )
+ ((u16vector)
(let ([v (##sys#slot obj 1)])
(##sys#check-range index 0 (##sys#size v) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 4 v index weak?) ) ]
- [(s16vector)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 4 v index weak?) ) )
+ ((s16vector)
(let ([v (##sys#slot obj 1)])
(##sys#check-range index 0 (##sys#size v) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 5 v index weak?) ) ]
- [(u32vector)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 5 v index weak?) ) )
+ ((u32vector)
(let ([v (##sys#slot obj 1)])
(##sys#check-range index 0 (##sys#size v) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 6 v index weak?) ) ]
- [(s32vector)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 6 v index weak?) ) )
+ ((s32vector)
(let ([v (##sys#slot obj 1)])
(##sys#check-range index 0 (##sys#size v) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 7 v index weak?) ) ]
- [(f32vector)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 7 v index weak?) ) )
+ ((u64vector)
(let ([v (##sys#slot obj 1)])
(##sys#check-range index 0 (##sys#size v) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 8 v index weak?) ) ]
- [(f64vector)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 8 v index weak?) ) )
+ ((s64vector)
(let ([v (##sys#slot obj 1)])
(##sys#check-range index 0 (##sys#size v) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 9 v index weak?) ) ]
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 9 v index weak?) ) )
+ ((f32vector)
+ (let ([v (##sys#slot obj 1)])
+ (##sys#check-range index 0 (##sys#size v) loc)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 10 v index weak?) ) )
+ ((f64vector)
+ (let ([v (##sys#slot obj 1)])
+ (##sys#check-range index 0 (##sys#size v) loc)
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 11 v index weak?) ) )
;;XXX pointer-vector currently not supported
- [else
+ (else
(##sys#check-range index 0 (fx- (##sys#size obj) 1) loc)
- (##core#inline_allocate ("C_a_i_make_locative" 5) 0 obj (fx+ index 1) weak?) ] ) ]
+ (##core#inline_allocate ("C_a_i_make_locative" 5) 0 obj (fx+ index 1) weak?) ) ) ]
[(string? obj)
(##sys#check-range index 0 (##sys#size obj) loc)
(##core#inline_allocate ("C_a_i_make_locative" 5) 1 obj index weak?) ]
diff --git a/lolevel.import.scm b/lolevel.import.scm
index 122bf74b..0befb469 100644
--- a/lolevel.import.scm
+++ b/lolevel.import.scm
@@ -61,6 +61,8 @@
pointer-s16-set!
pointer-s32-ref
pointer-s32-set!
+ pointer-s64-ref
+ pointer-s64-set!
pointer-s8-ref
pointer-s8-set!
pointer-vector
@@ -73,6 +75,8 @@
pointer-u16-set!
pointer-u32-ref
pointer-u32-set!
+ pointer-u64-ref
+ pointer-u64-set!
pointer-u8-ref
pointer-u8-set!
pointer=?
diff --git a/lolevel.scm b/lolevel.scm
index b638541f..159e2ab6 100644
--- a/lolevel.scm
+++ b/lolevel.scm
@@ -119,17 +119,18 @@ EOF
;;; Move arbitrary blocks of memory around:
(define move-memory!
- (let ([memmove1 (foreign-lambda void "C_memmove_o" c-pointer c-pointer int int int)]
- [memmove2 (foreign-lambda void "C_memmove_o" c-pointer scheme-pointer int int int)]
- [memmove3 (foreign-lambda void "C_memmove_o" scheme-pointer c-pointer int int int)]
- [memmove4 (foreign-lambda void "C_memmove_o" scheme-pointer scheme-pointer int int int)]
- [typerr (lambda (x)
+ (let ((memmove1 (foreign-lambda void "C_memmove_o" c-pointer c-pointer int int int))
+ (memmove2 (foreign-lambda void "C_memmove_o" c-pointer scheme-pointer int int int))
+ (memmove3 (foreign-lambda void "C_memmove_o" scheme-pointer c-pointer int int int))
+ (memmove4 (foreign-lambda void "C_memmove_o" scheme-pointer scheme-pointer int int int))
+ (typerr (lambda (x)
(##sys#error-hook
(foreign-value "C_BAD_ARGUMENT_TYPE_ERROR" int)
- 'move-memory! x))]
- [slot1structs '(mmap
- u8vector u16vector u32vector s8vector s16vector s32vector
- f32vector f64vector)] )
+ 'move-memory! x)))
+ (slot1structs '(mmap
+ u8vector u16vector u32vector u64vector
+ s8vector s16vector s32vector s64vector
+ f32vector f64vector)) )
(lambda (from to #!optional n (foffset 0) (toffset 0))
;
(define (nosizerr)
@@ -283,8 +284,10 @@ EOF
; 5 s16vector (C_S16_LOCATIVE)
; 6 u32vector (C_U32_LOCATIVE)
; 7 s32vector (C_S32_LOCATIVE)
-; 8 f32vector (C_F32_LOCATIVE)
-; 9 f64vector (C_F64_LOCATIVE)
+; 8 u64vector (C_U32_LOCATIVE)
+; 9 s64vector (C_S32_LOCATIVE)
+; 10 f32vector (C_F32_LOCATIVE)
+; 11 f64vector (C_F64_LOCATIVE)
; 3 Object or #f, if weak (C_word)
(define (make-locative obj . index)
@@ -313,6 +316,8 @@ EOF
(define (pointer-s16-set! p n) (##core#inline "C_u_i_pointer_s16_set" p n))
(define (pointer-u32-set! p n) (##core#inline "C_u_i_pointer_u32_set" p n))
(define (pointer-s32-set! p n) (##core#inline "C_u_i_pointer_s32_set" p n))
+(define (pointer-u64-set! p n) (##core#inline "C_u_i_pointer_u64_set" p n))
+(define (pointer-s64-set! p n) (##core#inline "C_u_i_pointer_s64_set" p n))
(define (pointer-f32-set! p n) (##core#inline "C_u_i_pointer_f32_set" p n))
(define (pointer-f64-set! p n) (##core#inline "C_u_i_pointer_f64_set" p n))
@@ -342,16 +347,28 @@ EOF
(define pointer-u32-ref
(getter-with-setter
- (lambda (p) (##core#inline_allocate ("C_a_u_i_pointer_u32_ref" 4) p)) ;XXX hardcoded size
+ (lambda (p) (##core#inline_allocate ("C_a_u_i_pointer_u32_ref" 3) p)) ;XXX hardcoded size
pointer-u32-set!
"(pointer-u32-ref p)"))
(define pointer-s32-ref
(getter-with-setter
- (lambda (p) (##core#inline_allocate ("C_a_u_i_pointer_s32_ref" 4) p)) ;XXX hardcoded size
+ (lambda (p) (##core#inline_allocate ("C_a_u_i_pointer_s32_ref" 3) p)) ;XXX hardcoded size
pointer-s32-set!
"(pointer-s32-ref p)"))
+(define pointer-u64-ref
+ (getter-with-setter
+ (lambda (p) (##core#inline_allocate ("C_a_u_i_pointer_u64_ref" 4) p)) ;XXX hardcoded size
+ pointer-u64-set!
+ "(pointer-u64-ref p)"))
+
+(define pointer-s64-ref
+ (getter-with-setter
+ (lambda (p) (##core#inline_allocate ("C_a_u_i_pointer_s64_ref" 4) p)) ;XXX hardcoded size
+ pointer-s64-set!
+ "(pointer-s64-ref p)"))
+
(define pointer-f32-ref
(getter-with-setter
(lambda (p) (##core#inline_allocate ("C_a_u_i_pointer_f32_ref" 4) p)) ;XXX hardcoded size
diff --git a/manual/Foreign type specifiers b/manual/Foreign type specifiers
index dd4ddabd..ad4048dd 100644
--- a/manual/Foreign type specifiers
+++ b/manual/Foreign type specifiers
@@ -196,17 +196,21 @@ value will raise an exception.
<type>u8vector</type><br>
<type>u16vector</type><br>
<type>u32vector</type><br>
+<type>u64vector</type><br>
<type>s8vector</type><br>
<type>s16vector</type><br>
<type>s32vector</type><br>
+<type>s64vector</type><br>
<type>f32vector</type><br>
<type>f64vector</type><br>
<type>nonnull-u8vector </type><br>
<type>nonnull-u16vector </type><br>
<type>nonnull-u32vector </type><br>
+<type>nonnull-u64vector </type><br>
<type>nonnull-s8vector </type><br>
<type>nonnull-s16vector</type><br>
<type>nonnull-s32vector</type><br>
+<type>nonnull-s64vector</type><br>
<type>nonnull-f32vector</type><br>
<type>nonnull-f64vector</type><br>
@@ -380,6 +384,8 @@ The foreign type {{TYPE}} with an additional {{const}} qualifier.
<tr><td>{{[nonnull-]s16vector}}</td><td>{{short *}}</td></tr>
<tr><td>{{[nonnull-]u32vector}}</td><td>{{uint32_t *}}</td></tr>
<tr><td>{{[nonnull-]s32vector}}</td><td>{{int32_t *}}</td></tr>
+<tr><td>{{[nonnull-]u64vector}}</td><td>{{uint64_t *}}</td></tr>
+<tr><td>{{[nonnull-]s64vector}}</td><td>{{int64_t *}}</td></tr>
<tr><td>{{[nonnull-]f32vector}}</td><td>{{float *}}</td></tr>
<tr><td>{{[nonnull-]f64vector}}</td><td>{{double *}}</td></tr>
<tr><td>{{[nonnull-]c-string}}</td><td>{{char *}}</td></tr>
diff --git a/manual/Types b/manual/Types
index 10a3d18a..0e51139d 100644
--- a/manual/Types
+++ b/manual/Types
@@ -180,6 +180,8 @@ these names directly in type-specifications - {{TYPE}} corresponds to
<tr><td>{{s16vector}}</td><td>SRFI-4 byte vector</td></tr>
<tr><td>{{u32vector}}</td><td>SRFI-4 byte vector</td></tr>
<tr><td>{{s32vector}}</td><td>SRFI-4 byte vector</td></tr>
+<tr><td>{{u64vector}}</td><td>SRFI-4 byte vector</td></tr>
+<tr><td>{{s64vector}}</td><td>SRFI-4 byte vector</td></tr>
<tr><td>{{f32vector}}</td><td>SRFI-4 byte vector</td></tr>
<tr><td>{{f64vector}}</td><td>SRFI-4 byte vector</td></tr>
<tr><td>{{thread}}</td><td>SRFI-18 thread</td></tr>
diff --git a/manual/Unit lolevel b/manual/Unit lolevel
index 7f800066..49b672f7 100644
--- a/manual/Unit lolevel
+++ b/manual/Unit lolevel
@@ -179,6 +179,19 @@ Returns the unsigned 32-bit integer at the address designated by {{POINTER}}.
Returns the signed 32-bit integer at the address designated by {{POINTER}}.
+==== pointer-u64-ref
+
+<procedure>(pointer-u64-ref POINTER)</procedure>
+
+Returns the unsigned 64-bit integer at the address designated by {{POINTER}}.
+
+
+==== pointer-s64-ref
+
+<procedure>(pointer-s64-ref POINTER)</procedure>
+
+Returns the signed 64-bit integer at the address designated by {{POINTER}}.
+
==== pointer-f32-ref
@@ -242,6 +255,22 @@ Stores the unsigned 32-bit integer {{N}} at the address designated by {{POINTER}
Stores the 32-bit integer {{N}} at the address designated by {{POINTER}}.
+==== pointer-u64-set!
+
+<procedure>(pointer-u64-set! POINTER N)</procedure><br>
+<procedure>(set! (pointer-u64-ref POINTER) N)</procedure>
+
+Stores the unsigned 64-bit integer {{N}} at the address designated by {{POINTER}}.
+
+
+==== pointer-s64-set!
+
+<procedure>(pointer-s64-set! POINTER N)</procedure><br>
+<procedure>(set! (pointer-s64-ref POINTER) N)</procedure>
+
+Stores the 64-bit integer {{N}} at the address designated by {{POINTER}}.
+
+
==== pointer-f32-set!
<procedure>(pointer-f32-set! POINTER N)</procedure><br>
diff --git a/manual/Unit srfi-4 b/manual/Unit srfi-4
index 902713a0..0942bb8e 100644
--- a/manual/Unit srfi-4
+++ b/manual/Unit srfi-4
@@ -11,7 +11,6 @@ Homogeneous numeric vector datatypes. Also see the [[http://srfi.schemers.org/s
* Procedures for blob conversion, subvectors and vector I/O are provided.
* SRFI-17 setters for {{XXXvector-ref}} are defined.
* Constructors allow allocating the storage in non garbage collected memory.
-* 64-bit integer vectors ({{u64vector}} and {{s64vector}}) are not supported.
=== Blob conversions
@@ -21,6 +20,8 @@ Homogeneous numeric vector datatypes. Also see the [[http://srfi.schemers.org/s
<procedure>(s16vector->blob S16VECTOR)</procedure><br>
<procedure>(u32vector->blob U32VECTOR)</procedure><br>
<procedure>(s32vector->blob S32VECTOR)</procedure><br>
+<procedure>(u64vector->blob U64VECTOR)</procedure><br>
+<procedure>(s64vector->blob S64VECTOR)</procedure><br>
<procedure>(f32vector->blob F32VECTOR)</procedure><br>
<procedure>(f64vector->blob F64VECTOR)</procedure><br>
<procedure>(u8vector->blob/shared U8VECTOR)</procedure><br>
@@ -29,6 +30,8 @@ Homogeneous numeric vector datatypes. Also see the [[http://srfi.schemers.org/s
<procedure>(s16vector->blob/shared S16VECTOR)</procedure><br>
<procedure>(u32vector->blob/shared U32VECTOR)</procedure><br>
<procedure>(s32vector->blob/shared S32VECTOR)</procedure><br>
+<procedure>(u64vector->blob/shared U64VECTOR)</procedure><br>
+<procedure>(s64vector->blob/shared S64VECTOR)</procedure><br>
<procedure>(f32vector->blob/shared F32VECTOR)</procedure><br>
<procedure>(f64vector->blob/shared F64VECTOR)</procedure><br>
@@ -43,6 +46,8 @@ variants return a blob that shares memory with the contents of the vector.
<procedure>(blob->s16vector BLOB)</procedure><br>
<procedure>(blob->u32vector BLOB)</procedure><br>
<procedure>(blob->s32vector BLOB)</procedure><br>
+<procedure>(blob->u64vector BLOB)</procedure><br>
+<procedure>(blob->s64vector BLOB)</procedure><br>
<procedure>(blob->f32vector BLOB)</procedure><br>
<procedure>(blob->f64vector BLOB)</procedure><br>
<procedure>(blob->u8vector/shared BLOB)</procedure><br>
@@ -51,6 +56,8 @@ variants return a blob that shares memory with the contents of the vector.
<procedure>(blob->s16vector/shared BLOB)</procedure><br>
<procedure>(blob->u32vector/shared BLOB)</procedure><br>
<procedure>(blob->s32vector/shared BLOB)</procedure><br>
+<procedure>(blob->u64vector/shared BLOB)</procedure><br>
+<procedure>(blob->s64vector/shared BLOB)</procedure><br>
<procedure>(blob->f32vector/shared BLOB)</procedure><br>
<procedure>(blob->f64vector/shared BLOB)</procedure><br>
@@ -64,9 +71,11 @@ shares memory with the contents of the blob.
<procedure>(subu8vector U8VECTOR FROM TO)</procedure><br>
<procedure>(subu16vector U16VECTOR FROM TO)</procedure><br>
<procedure>(subu32vector U32VECTOR FROM TO)</procedure><br>
+<procedure>(subu64vector U32VECTOR FROM TO)</procedure><br>
<procedure>(subs8vector S8VECTOR FROM TO)</procedure><br>
<procedure>(subs16vector S16VECTOR FROM TO)</procedure><br>
<procedure>(subs32vector S32VECTOR FROM TO)</procedure><br>
+<procedure>(subs64vector S32VECTOR FROM TO)</procedure><br>
<procedure>(subf32vector F32VECTOR FROM TO)</procedure><br>
<procedure>(subf64vector F64VECTOR FROM TO)</procedure><br>
@@ -121,6 +130,8 @@ called integer vectors):
<tr><td>{{u16vector}}</td><td>unsigned exact integer in the range 0 to (2^16)-1</td></tr>
<tr><td>{{s32vector}}</td><td>signed exact integer in the range -(2^31) to (2^31)-1</td></tr>
<tr><td>{{u32vector}}</td><td>unsigned exact integer in the range 0 to (2^32)-1</td></tr>
+<tr><td>{{s64vector}}</td><td>signed exact integer in the range -(2^31) to (2^31)-1</td></tr>
+<tr><td>{{u64vector}}</td><td>unsigned exact integer in the range 0 to (2^64)-1</td></tr>
<tr><td>{{s64vector}}</td><td>signed exact integer in the range -(2^63) to (2^63)-1</td></tr>
<tr><td>{{u64vector}}</td><td>unsigned exact integer in the range 0 to (2^64)-1</td></tr></table>
@@ -176,6 +187,8 @@ will set {{x}} to the object {{#u8(1 2 3)}}. Since CHICKEN 4.9.0, literal homoge
<procedure>(s16vector? OBJ)</procedure><br>
<procedure>(u32vector? OBJ)</procedure><br>
<procedure>(s32vector? OBJ)</procedure><br>
+<procedure>(u64vector? OBJ)</procedure><br>
+<procedure>(s64vector? OBJ)</procedure><br>
<procedure>(f32vector? OBJ)</procedure><br>
<procedure>(f64vector? OBJ)</procedure><br>
@@ -183,7 +196,7 @@ Return {{#t}} if {{obj}} is an object of the specified type or {{#f}} if not.
<procedure>(number-vector? OBJ)</procedure>
-Return {{#t}} if {{obj}} is a number vector, {{#f}} if not. A "number vector" is any of the homogeneous number vector types defined by SRFI-4, ie it's one of {{u8vector}}, {{s8vector}}, {{u16vector}}, {{s16vector}}, {{u32vector}}, {{s32vector}}, {{f32vector}} or {{f64vector}}).
+Return {{#t}} if {{obj}} is a number vector, {{#f}} if not. A "number vector" is any of the homogeneous number vector types defined by SRFI-4, ie it's one of {{u8vector}}, {{s8vector}}, {{u16vector}}, {{s16vector}}, {{u32vector}}, {{s32vector}}, {{u64vector}}, {{s64vector}}, {{f32vector}} or {{f64vector}}).
=== Constructors
@@ -194,6 +207,8 @@ Return {{#t}} if {{obj}} is a number vector, {{#f}} if not. A "number vector" i
<procedure>(make-s16vector N [S16VALUE NONGC FINALIZE])</procedure><br>
<procedure>(make-u32vector N [U32VALUE NONGC FINALIZE])</procedure><br>
<procedure>(make-s32vector N [S32VALUE NONGC FINALIZE])</procedure><br>
+<procedure>(make-u64vector N [U64VALUE NONGC FINALIZE])</procedure><br>
+<procedure>(make-s64vector N [S64VALUE NONGC FINALIZE])</procedure><br>
<procedure>(make-f32vector N [F32VALUE NONGC FINALIZE])</procedure><br>
<procedure>(make-f64vector N [F64VALUE NONGC FINALIZE])</procedure><br>
@@ -226,6 +241,8 @@ to {{#t}}. Note that the {{FINALIZE}} argument is only used when
<procedure>(s16vector S16VALUE ...)</procedure><br>
<procedure>(u32vector U32VALUE ...)</procedure><br>
<procedure>(s32vector S32VALUE ...)</procedure><br>
+<procedure>(u64vector U64VALUE ...)</procedure><br>
+<procedure>(s64vector S64VALUE ...)</procedure><br>
<procedure>(f32vector F32VALUE ...)</procedure><br>
<procedure>(f64vector F64VALUE ...)</procedure><br>
@@ -240,6 +257,8 @@ type, composed of the arguments.
<procedure>(s16vector-length S16VECTOR)</procedure><br>
<procedure>(u32vector-length U32VECTOR)</procedure><br>
<procedure>(s32vector-length S32VECTOR)</procedure><br>
+<procedure>(u64vector-length U64VECTOR)</procedure><br>
+<procedure>(s64vector-length S64VECTOR)</procedure><br>
<procedure>(f32vector-length F32VECTOR)</procedure><br>
<procedure>(f64vector-length F64VECTOR)</procedure><br>
@@ -253,6 +272,8 @@ Returns the length of the SRFI-4 homogeneous number VECTOR.
<procedure>(s16vector-ref S16VECTOR I)</procedure><br>
<procedure>(u32vector-ref U32VECTOR I)</procedure><br>
<procedure>(s32vector-ref S32VECTOR I)</procedure><br>
+<procedure>(u64vector-ref U64VECTOR I)</procedure><br>
+<procedure>(s64vector-ref S64VECTOR I)</procedure><br>
<procedure>(f32vector-ref F32VECTOR I)</procedure><br>
<procedure>(f64vector-ref F64VECTOR I)</procedure><br>
@@ -268,6 +289,8 @@ than the length of the vector.
<procedure>(s16vector-set! S16VECTOR I S16VALUE)</procedure><br>
<procedure>(u32vector-set! U32VECTOR I U32VALUE)</procedure><br>
<procedure>(s32vector-set! S32VECTOR I S32VALUE)</procedure><br>
+<procedure>(u64vector-set! U64VECTOR I U64VALUE)</procedure><br>
+<procedure>(s64vector-set! S64VECTOR I S64VALUE)</procedure><br>
<procedure>(f32vector-set! F32VECTOR I F32VALUE)</procedure><br>
<procedure>(f64vector-set! F64VECTOR I F64VALUE)</procedure><br>
@@ -290,6 +313,8 @@ procedures. For example, to set the {{i}}th element of SRFI-4
<procedure>(s16vector->list S16VECTOR)</procedure><br>
<procedure>(u32vector->list U32VECTOR)</procedure><br>
<procedure>(s32vector->list S32VECTOR)</procedure><br>
+<procedure>(u64vector->list U64VECTOR)</procedure><br>
+<procedure>(s64vector->list S64VECTOR)</procedure><br>
<procedure>(f32vector->list F32VECTOR)</procedure><br>
<procedure>(f64vector->list F64VECTOR)</procedure><br>
@@ -302,6 +327,8 @@ VECTOR.
<procedure>(list->s16vector S16LIST)</procedure><br>
<procedure>(list->u32vector U32LIST)</procedure><br>
<procedure>(list->s32vector S32LIST)</procedure><br>
+<procedure>(list->u64vector U64LIST)</procedure><br>
+<procedure>(list->s64vector S64LIST)</procedure><br>
<procedure>(list->f32vector F32LIST)</procedure><br>
<procedure>(list->f64vector F64LIST)</procedure><br>
diff --git a/manual/faq b/manual/faq
index 6994639b..c67defe9 100644
--- a/manual/faq
+++ b/manual/faq
@@ -638,6 +638,10 @@ The following extended bindings are handled specially:
{{s32vector-length}}
{{s32vector-ref}}
{{s32vector-set!}}
+{{s64vector->blob/shared}}
+{{s64vector-length}}
+{{s64vector-ref}}
+{{s64vector-set!}}
{{s8vector->blob/shared}}
{{s8vector-length}}
{{s8vector-ref}}
@@ -660,6 +664,10 @@ The following extended bindings are handled specially:
{{u32vector-length}}
{{u32vector-ref}}
{{u32vector-set!}}
+{{u64vector->blob/shared}}
+{{u64vector-length}}
+{{u64vector-ref}}
+{{u64vector-set!}}
{{u8vector->blob/shared}}
{{u8vector-length}}
{{u8vector-ref}}
diff --git a/runtime.c b/runtime.c
index 9a38d6e5..b46a5608 100644
--- a/runtime.c
+++ b/runtime.c
@@ -833,7 +833,7 @@ static C_PTABLE_ENTRY *create_initial_ptable()
{
/* IMPORTANT: hardcoded table size -
this must match the number of C_pte calls + 1 (NULL terminator)! */
- C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 78);
+ C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 80);
int i = 0;
if(pt == NULL)
@@ -890,6 +890,8 @@ static C_PTABLE_ENTRY *create_initial_ptable()
C_pte(C_make_tagged_pointer);
C_pte(C_peek_signed_integer);
C_pte(C_peek_unsigned_integer);
+ C_pte(C_peek_int64);
+ C_pte(C_peek_uint64);
C_pte(C_context_switch);
C_pte(C_register_finalizer);
C_pte(C_locative_ref);
@@ -10383,27 +10385,32 @@ void C_ccall C_context_switch(C_word c, C_word closure, C_word k, C_word state)
void C_ccall C_peek_signed_integer(C_word c, C_word closure, C_word k, C_word v, C_word index)
{
- C_word x = C_block_item(v, C_unfix(index));
- C_alloc_flonum;
-
- if((x & C_INT_SIGN_BIT) != ((x << 1) & C_INT_SIGN_BIT)) {
- C_kontinue_flonum(k, (double)x);
- }
-
- C_kontinue(k, C_fix(x));
+ C_word ab[C_SIZEOF_BIGNUM(1)], *a = ab;
+ C_uword num = ((C_word *)C_data_pointer(v))[ C_unfix(index) ];
+ C_kontinue(k, C_int_to_num(&a, num));
}
void C_ccall C_peek_unsigned_integer(C_word c, C_word closure, C_word k, C_word v, C_word index)
{
- C_word x = C_block_item(v, C_unfix(index));
- C_alloc_flonum;
+ C_word ab[C_SIZEOF_BIGNUM(1)], *a = ab;
+ C_uword num = ((C_word *)C_data_pointer(v))[ C_unfix(index) ];
+ C_kontinue(k, C_unsigned_int_to_num(&a, num));
+}
+
+void C_ccall C_peek_int64(C_word c, C_word closure, C_word k, C_word v, C_word index)
+{
+ C_word ab[C_SIZEOF_BIGNUM(2)], *a = ab;
+ C_s64 num = ((C_s64 *)C_data_pointer(v))[ C_unfix(index) ];
+ C_kontinue(k, C_int64_to_num(&a, num));
+}
- if((x & C_INT_SIGN_BIT) || ((x << 1) & C_INT_SIGN_BIT)) {
- C_kontinue_flonum(k, (double)(C_uword)x);
- }
- C_kontinue(k, C_fix(x));
+void C_ccall C_peek_uint64(C_word c, C_word closure, C_word k, C_word v, C_word index)
+{
+ C_word ab[C_SIZEOF_BIGNUM(2)], *a = ab;
+ C_u64 num = ((C_u64 *)C_data_pointer(v))[ C_unfix(index) ];
+ C_kontinue(k, C_uint64_to_num(&a, num));
}
@@ -10826,6 +10833,8 @@ C_regparm C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_w
case C_U32_LOCATIVE:
case C_F32_LOCATIVE:
case C_S32_LOCATIVE: in *= 4; break;
+ case C_U64_LOCATIVE:
+ case C_S64_LOCATIVE:
case C_F64_LOCATIVE: in *= 8; break;
}
@@ -10882,6 +10891,8 @@ void C_ccall C_locative_ref(C_word c, C_word closure, C_word k, C_word loc)
case C_S16_LOCATIVE: C_kontinue(k, C_fix(*((short *)ptr)));
case C_U32_LOCATIVE: C_peek_unsigned_integer(0, 0, k, (C_word)(ptr - 1), 0);
case C_S32_LOCATIVE: C_peek_signed_integer(0, 0, k, (C_word)(ptr - 1), 0);
+ case C_U64_LOCATIVE: C_peek_uint64(0, 0, k, (C_word)(ptr - 1), 0);
+ case C_S64_LOCATIVE: C_peek_int64(0, 0, k, (C_word)(ptr - 1), 0);
case C_F32_LOCATIVE: C_kontinue_flonum(k, *((float *)ptr));
case C_F64_LOCATIVE: C_kontinue_flonum(k, *((double *)ptr));
default: panic(C_text("bad locative type"));
@@ -10940,19 +10951,33 @@ C_regparm C_word C_fcall C_i_locative_set(C_word loc, C_word x)
break;
case C_U32_LOCATIVE:
- if((x & C_FIXNUM_BIT) == 0 && (C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG))
+ if(!C_truep(C_i_exact_integerp(x)))
barf(C_BAD_ARGUMENT_TYPE_ERROR, "locative-set!", x);
*((C_u32 *)ptr) = C_num_to_unsigned_int(x);
break;
case C_S32_LOCATIVE:
- if((x & C_FIXNUM_BIT) == 0 && (C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG))
+ if(!C_truep(C_i_exact_integerp(x)))
barf(C_BAD_ARGUMENT_TYPE_ERROR, "locative-set!", x);
*((C_s32 *)ptr) = C_num_to_int(x);
break;
+ case C_U64_LOCATIVE:
+ if(!C_truep(C_i_exact_integerp(x)))
+ barf(C_BAD_ARGUMENT_TYPE_ERROR, "locative-set!", x);
+
+ *((C_u64 *)ptr) = C_num_to_uint64(x);
+ break;
+
+ case C_S64_LOCATIVE:
+ if(!C_truep(C_i_exact_integerp(x)))
+ barf(C_BAD_ARGUMENT_TYPE_ERROR, "locative-set!", x);
+
+ *((C_s64 *)ptr) = C_num_to_int64(x);
+ break;
+
case C_F32_LOCATIVE:
if(C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG)
barf(C_BAD_ARGUMENT_TYPE_ERROR, "locative-set!", x);
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 46ed5e80..95184b66 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1969,9 +1969,9 @@
deprecated noreturn values))
t)
((memq t '(u8vector s8vector u16vector s16vector u32vector s32vector
- f32vector f64vector thread queue environment time
- continuation lock mmap condition hash-table
- tcp-listener))
+ u64vector s64vector f32vector f64vector
+ thread queue environment time continuation
+ lock mmap condition hash-table tcp-listener))
`(struct ,t))
((eq? t 'immediate)
'(or eof null fixnum char boolean))
diff --git a/srfi-4.import.scm b/srfi-4.import.scm
index db682f63..59bced1c 100644
--- a/srfi-4.import.scm
+++ b/srfi-4.import.scm
@@ -34,12 +34,16 @@
blob->s16vector/shared
blob->s32vector
blob->s32vector/shared
+ blob->s64vector
+ blob->s64vector/shared
blob->s8vector
blob->s8vector/shared
blob->u16vector
blob->u16vector/shared
blob->u32vector
blob->u32vector/shared
+ blob->u64vector
+ blob->u64vector/shared
blob->u8vector
blob->u8vector/shared
f32vector
@@ -64,17 +68,21 @@
list->f64vector
list->s16vector
list->s32vector
+ list->s64vector
list->s8vector
list->u16vector
list->u32vector
+ list->u64vector
list->u8vector
make-f32vector
make-f64vector
make-s16vector
make-s32vector
+ make-s64vector
make-s8vector
make-u16vector
make-u32vector
+ make-u64vector
make-u8vector
read-u8vector
read-u8vector!
@@ -97,6 +105,15 @@
s32vector-ref
s32vector-set!
s32vector?
+ s64vector
+ s64vector->blob
+ s64vector->blob/shared
+ s64vector->byte-vector
+ s64vector->list
+ s64vector-length
+ s64vector-ref
+ s64vector-set!
+ s64vector?
s8vector
s8vector->blob
s8vector->blob/shared
@@ -110,9 +127,11 @@
subf64vector
subs16vector
subs32vector
+ subs64vector
subs8vector
subu16vector
subu32vector
+ subu64vector
subu8vector
u16vector
u16vector->blob
@@ -132,6 +151,15 @@
u32vector-ref
u32vector-set!
u32vector?
+ u64vector
+ u64vector->blob
+ u64vector->blob/shared
+ u64vector->byte-vector
+ u64vector->list
+ u64vector-length
+ u64vector-ref
+ u64vector-set!
+ u64vector?
u8vector
u8vector->blob
u8vector->blob/shared
diff --git a/srfi-4.scm b/srfi-4.scm
index d00137cf..c4f5f476 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -92,6 +92,14 @@ EOF
(##sys#check-structure x 's32vector 's32vector-length)
(##core#inline "C_u_i_32vector_length" x))
+(define (u64vector-length x)
+ (##sys#check-structure x 'u64vector 'u64vector-length)
+ (##core#inline "C_u_i_64vector_length" x))
+
+(define (s64vector-length x)
+ (##sys#check-structure x 's64vector 's64vector-length)
+ (##core#inline "C_u_i_64vector_length" x))
+
(define (f32vector-length x)
(##sys#check-structure x 'f32vector 'f32vector-length)
(##core#inline "C_u_i_32vector_length" x))
@@ -146,6 +154,20 @@ EOF
(check-range i 0 len 's32vector-set!)
(##core#inline "C_u_i_s32vector_set" x i y)))
+(define (u64vector-set! x i y)
+ (##sys#check-structure x 'u64vector 'u64vector-set!)
+ (let ((len (##core#inline "C_u_i_64vector_length" x)))
+ (check-uint-length y 64 'u64vector-set!)
+ (check-range i 0 len 'u64vector-set!)
+ (##core#inline "C_u_i_u64vector_set" x i y)))
+
+(define (s64vector-set! x i y)
+ (##sys#check-structure x 's64vector 's64vector-set!)
+ (let ((len (##core#inline "C_u_i_64vector_length" x)))
+ (check-int-length y 64 's64vector-set!)
+ (check-range i 0 len 's64vector-set!)
+ (##core#inline "C_u_i_s64vector_set" x i y)))
+
(define (f32vector-set! x i y)
(##sys#check-structure x 'f32vector 'f32vector-set!)
(let ((len (##core#inline "C_u_i_32vector_length" x)))
@@ -216,7 +238,7 @@ EOF
(##sys#check-structure x 'u32vector 'u32vector-ref)
(let ((len (##core#inline "C_u_i_u32vector_length" x)))
(check-range i 0 len 'u32vector-ref)
- (##core#inline_allocate ("C_a_u_i_u32vector_ref" 4) x i)))
+ (##core#inline_allocate ("C_a_u_i_u32vector_ref" 3) x i)))
u32vector-set!
"(u32vector-ref v i)"))
@@ -226,10 +248,30 @@ EOF
(##sys#check-structure x 's32vector 's32vector-ref)
(let ((len (##core#inline "C_u_i_s32vector_length" x)))
(check-range i 0 len 's32vector-ref)
- (##core#inline_allocate ("C_a_u_i_s32vector_ref" 4) x i)))
+ (##core#inline_allocate ("C_a_u_i_s32vector_ref" 3) x i)))
s32vector-set!
"(s32vector-ref v i)"))
+(define u64vector-ref
+ (getter-with-setter
+ (lambda (x i)
+ (##sys#check-structure x 'u64vector 'u64vector-ref)
+ (let ((len (##core#inline "C_u_i_u64vector_length" x)))
+ (check-range i 0 len 'u64vector-ref)
+ (##core#inline_allocate ("C_a_u_i_u64vector_ref" 4) x i)))
+ u64vector-set!
+ "(u64vector-ref v i)"))
+
+(define s64vector-ref
+ (getter-with-setter
+ (lambda (x i)
+ (##sys#check-structure x 's64vector 's64vector-ref)
+ (let ((len (##core#inline "C_u_i_s64vector_length" x)))
+ (check-range i 0 len 's64vector-ref)
+ (##core#inline_allocate ("C_a_u_i_s64vector_ref" 4) x i)))
+ s64vector-set!
+ "(s64vector-ref v i)"))
+
(define f32vector-ref
(getter-with-setter
(lambda (x i)
@@ -343,6 +385,19 @@ EOF
((##core#inline "C_fixnum_greater_or_equal_p" i len) v)
(##core#inline "C_u_i_u32vector_set" v i init) ) ) ) ) ) )
+ (set! make-u64vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+ (##sys#check-fixnum len 'make-u64vector)
+ (let ((v (##sys#make-structure 'u64vector (alloc 'make-u64vector (##core#inline "C_fixnum_shift_left" len 3) ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+ v
+ (begin
+ (check-uint-length init 64 'make-u64vector)
+ (do ((i 0 (##core#inline "C_fixnum_plus" i 1)))
+ ((##core#inline "C_fixnum_greater_or_equal_p" i len) v)
+ (##core#inline "C_u_i_u64vector_set" v i init) ) ) ) ) ) )
+
(set! make-s32vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
(##sys#check-fixnum len 'make-s32vector)
@@ -356,6 +411,19 @@ EOF
((##core#inline "C_fixnum_greater_or_equal_p" i len) v)
(##core#inline "C_u_i_s32vector_set" v i init) ) ) ) ) ) )
+ (set! make-s64vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+ (##sys#check-fixnum len 'make-s64vector)
+ (let ((v (##sys#make-structure 's64vector (alloc 'make-s64vector (##core#inline "C_fixnum_shift_left" len 3) ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+ v
+ (begin
+ (check-int-length init 64 'make-s64vector)
+ (do ((i 0 (##core#inline "C_fixnum_plus" i 1)))
+ ((##core#inline "C_fixnum_greater_or_equal_p" i len) v)
+ (##core#inline "C_u_i_s64vector_set" v i init) ) ) ) ) ) )
+
(set! make-f32vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
(##sys#check-fixnum len 'make-f32vector)
@@ -418,6 +486,8 @@ EOF
(list->NNNvector s16vector)
(list->NNNvector u32vector)
(list->NNNvector s32vector)
+(list->NNNvector u64vector)
+(list->NNNvector s64vector)
(list->NNNvector f32vector)
(list->NNNvector f64vector)
@@ -442,6 +512,12 @@ EOF
(define s32vector
(lambda xs (list->s32vector xs)) )
+(define u64vector
+ (lambda xs (list->u64vector xs)) )
+
+(define s64vector
+ (lambda xs (list->s64vector xs)) )
+
(define f32vector
(lambda xs (list->f32vector xs)) )
@@ -455,7 +531,7 @@ EOF
(er-macro-transformer
(lambda (x r c)
(let* ((tag (##sys#strip-syntax (cadr x)))
- (alloc? (pair? (cddr x)))
+ (alloc (and (pair? (cddr x)) (caddr x)))
(name (string->symbol (string-append (symbol->string tag) "->list"))))
`(define (,name v)
(##sys#check-structure v ',tag ',name)
@@ -464,8 +540,8 @@ EOF
(if (fx>= i len)
'()
(cons
- ,(if alloc?
- `(##core#inline_allocate (,(conc "C_a_u_i_" tag "_ref") 4) v i)
+ ,(if alloc
+ `(##core#inline_allocate (,(conc "C_a_u_i_" tag "_ref") ,alloc) v i)
`(##core#inline ,(conc "C_u_i_" tag "_ref") v i))
(loop (fx+ i 1)) ) ) ) ) ) ) )))
@@ -473,10 +549,13 @@ EOF
(NNNvector->list s8vector)
(NNNvector->list u16vector)
(NNNvector->list s16vector)
-(NNNvector->list u32vector #t)
-(NNNvector->list s32vector #t)
-(NNNvector->list f32vector #t)
-(NNNvector->list f64vector #t)
+;; The alloc amounts here are for 32-bit words; this over-allocates on 64-bits
+(NNNvector->list u32vector 2)
+(NNNvector->list s32vector 2)
+(NNNvector->list u64vector 3)
+(NNNvector->list s64vector 3)
+(NNNvector->list f32vector 4)
+(NNNvector->list f64vector 4)
;;; Predicates:
@@ -487,6 +566,8 @@ EOF
(define (s16vector? x) (##sys#structure? x 's16vector))
(define (u32vector? x) (##sys#structure? x 'u32vector))
(define (s32vector? x) (##sys#structure? x 's32vector))
+(define (u64vector? x) (##sys#structure? x 'u64vector))
+(define (s64vector? x) (##sys#structure? x 's64vector))
(define (f32vector? x) (##sys#structure? x 'f32vector))
(define (f64vector? x) (##sys#structure? x 'f64vector))
@@ -536,6 +617,8 @@ EOF
(define s16vector->blob/shared (pack 's16vector 's16vector->blob/shared))
(define u32vector->blob/shared (pack 'u32vector 'u32vector->blob/shared))
(define s32vector->blob/shared (pack 's32vector 's32vector->blob/shared))
+(define u64vector->blob/shared (pack 'u64vector 'u64vector->blob/shared))
+(define s64vector->blob/shared (pack 's64vector 's64vector->blob/shared))
(define f32vector->blob/shared (pack 'f32vector 'f32vector->blob/shared))
(define f64vector->blob/shared (pack 'f64vector 'f64vector->blob/shared))
@@ -545,6 +628,8 @@ EOF
(define s16vector->blob (pack-copy 's16vector 's16vector->blob))
(define u32vector->blob (pack-copy 'u32vector 'u32vector->blob))
(define s32vector->blob (pack-copy 's32vector 's32vector->blob))
+(define u64vector->blob (pack-copy 'u64vector 'u64vector->blob))
+(define s64vector->blob (pack-copy 's64vector 's64vector->blob))
(define f32vector->blob (pack-copy 'f32vector 'f32vector->blob))
(define f64vector->blob (pack-copy 'f64vector 'f64vector->blob))
@@ -554,6 +639,8 @@ EOF
(define blob->s16vector/shared (unpack 's16vector 2 'blob->s16vector/shared))
(define blob->u32vector/shared (unpack 'u32vector 4 'blob->u32vector/shared))
(define blob->s32vector/shared (unpack 's32vector 4 'blob->s32vector/shared))
+(define blob->u64vector/shared (unpack 'u64vector 4 'blob->u64vector/shared))
+(define blob->s64vector/shared (unpack 's64vector 4 'blob->s64vector/shared))
(define blob->f32vector/shared (unpack 'f32vector 4 'blob->f32vector/shared))
(define blob->f64vector/shared (unpack 'f64vector 8 'blob->f64vector/shared))
@@ -563,6 +650,8 @@ EOF
(define blob->s16vector (unpack-copy 's16vector 2 'blob->s16vector))
(define blob->u32vector (unpack-copy 'u32vector 4 'blob->u32vector))
(define blob->s32vector (unpack-copy 's32vector 4 'blob->s32vector))
+(define blob->u64vector (unpack-copy 'u64vector 4 'blob->u64vector))
+(define blob->s64vector (unpack-copy 's64vector 4 'blob->s64vector))
(define blob->f32vector (unpack-copy 'f32vector 4 'blob->f32vector))
(define blob->f64vector (unpack-copy 'f64vector 8 'blob->f64vector))
@@ -578,6 +667,8 @@ EOF
's16 list->s16vector
'u32 list->u32vector
's32 list->s32vector
+ 'u64 list->u64vector
+ 's64 list->s64vector
'f32 list->f32vector
'f64 list->f64vector) ] )
(lambda (char port)
@@ -602,6 +693,8 @@ EOF
(s16vector s16 ,s16vector->list)
(u32vector u32 ,u32vector->list)
(s32vector s32 ,s32vector->list)
+ (u64vector u64 ,u64vector->list)
+ (s64vector s64 ,s64vector->list)
(f32vector f32 ,f32vector->list)
(f64vector f64 ,f64vector->list) ) ) ) )
(cond (tag
@@ -632,9 +725,11 @@ EOF
(define (subu8vector v from to) (subnvector v 'u8vector 1 from to 'subu8vector))
(define (subu16vector v from to) (subnvector v 'u16vector 2 from to 'subu16vector))
(define (subu32vector v from to) (subnvector v 'u32vector 4 from to 'subu32vector))
+(define (subu64vector v from to) (subnvector v 'u64vector 8 from to 'subu64vector))
(define (subs8vector v from to) (subnvector v 's8vector 1 from to 'subs8vector))
(define (subs16vector v from to) (subnvector v 's16vector 2 from to 'subs16vector))
(define (subs32vector v from to) (subnvector v 's32vector 4 from to 'subs32vector))
+(define (subs64vector v from to) (subnvector v 's64vector 4 from to 'subs64vector))
(define (subf32vector v from to) (subnvector v 'f32vector 4 from to 'subf32vector))
(define (subf64vector v from to) (subnvector v 'f64vector 8 from to 'subf64vector))
diff --git a/support.scm b/support.scm
index 452010ae..b0665584 100644
--- a/support.scm
+++ b/support.scm
@@ -955,6 +955,7 @@
(let ((tmap '((nonnull-u8vector . u8vector) (nonnull-u16vector . u16vector)
(nonnull-s8vector . s8vector) (nonnull-s16vector . s16vector)
(nonnull-u32vector . u32vector) (nonnull-s32vector . s32vector)
+ (nonnull-u64vector . u64vector) (nonnull-s64vector . s64vector)
(nonnull-f32vector . f32vector) (nonnull-f64vector . f64vector))))
(lambda (param type)
(follow-without-loop
@@ -990,7 +991,8 @@
(if unsafe
param
`(##sys#foreign-struct-wrapper-argument 'pointer-vector ,param) ) )
- ((u8vector u16vector s8vector s16vector u32vector s32vector f32vector f64vector)
+ ((u8vector u16vector s8vector s16vector u32vector s32vector
+ u64vector s64vector f32vector f64vector)
(let ((tmp (gensym)))
`(let ((,tmp ,param))
(if ,tmp
@@ -998,7 +1000,10 @@
tmp
`(##sys#foreign-struct-wrapper-argument ',t ,tmp) )
'#f) ) ) )
- ((nonnull-u8vector nonnull-u16vector nonnull-s8vector nonnull-s16vector nonnull-u32vector nonnull-s32vector
+ ((nonnull-u8vector nonnull-u16vector
+ nonnull-s8vector nonnull-s16vector
+ nonnull-u32vector nonnull-s32vector
+ nonnull-u64vector nonnull-s64vector
nonnull-f32vector nonnull-f64vector)
(if unsafe
param
@@ -1231,7 +1236,7 @@
((arg) '(or boolean pointer-vector))
(else 'pointer-vector)))
((nonnull-pointer-vector) 'pointer-vector)
- ((u8vector u16vector s8vector s16vector u32vector s32vector f32vector f64vector)
+ ((u8vector u16vector s8vector s16vector u32vector s32vector u64vector s64vector f32vector f64vector)
(case mode
((arg) `(or boolean (struct ,ft)))
(else `(struct ,ft))))
@@ -1241,6 +1246,8 @@
((nonnull-s16vector) '(struct s16vector))
((nonnull-u32vector) '(struct u32vector))
((nonnull-s32vector) '(struct s32vector))
+ ((nonnull-u64vector) '(struct u64vector))
+ ((nonnull-s64vector) '(struct s64vector))
((nonnull-f32vector) '(struct f32vector))
((nonnull-f64vector) '(struct f64vector))
((integer long size_t integer32 unsigned-integer32 integer64 unsigned-integer64
diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
index 8af17237..6021bcfa 100644
--- a/tests/compiler-tests.scm
+++ b/tests/compiler-tests.scm
@@ -291,15 +291,19 @@
(assert (= 10 (s4v-sum "integer" u8vector '#u8(1 2 3 4))))
(assert (= 10 (s4v-sum "integer" u16vector '#u16(1 2 3 4))))
(assert (= 10 (s4v-sum "integer" u32vector '#u32(1 2 3 4))))
+(assert (= 10 (s4v-sum "integer" s64vector '#s64(1 2 3 4))))
(assert (= 10 (s4v-sum "integer" nonnull-u8vector '#u8(1 2 3 4))))
(assert (= 10 (s4v-sum "integer" nonnull-u16vector '#u16(1 2 3 4))))
(assert (= 10 (s4v-sum "integer" nonnull-u32vector '#u32(1 2 3 4))))
+(assert (= 10 (s4v-sum "integer" nonnull-u64vector '#u64(1 2 3 4))))
(assert (= -10 (s4v-sum "integer" s8vector '#s8(-1 -2 -3 -4))))
(assert (= -10 (s4v-sum "integer" s16vector '#s16(-1 -2 -3 -4))))
(assert (= -10 (s4v-sum "integer" s32vector '#s32(-1 -2 -3 -4))))
+(assert (= -10 (s4v-sum "integer" s64vector '#s64(-1 -2 -3 -4))))
(assert (= -10 (s4v-sum "integer" nonnull-s8vector '#s8(-1 -2 -3 -4))))
(assert (= -10 (s4v-sum "integer" nonnull-s16vector '#s16(-1 -2 -3 -4))))
(assert (= -10 (s4v-sum "integer" nonnull-s32vector '#s32(-1 -2 -3 -4))))
+(assert (= -10 (s4v-sum "integer" nonnull-s64vector '#s64(-1 -2 -3 -4))))
(assert (= 12.0 (s4v-sum "float" f32vector '#f32(1.5 2.5 3.5 4.5))))
(assert (= 12.0 (s4v-sum "float" f64vector '#f64(1.5 2.5 3.5 4.5))))
(assert (= 12.0 (s4v-sum "float" nonnull-f32vector '#f32(1.5 2.5 3.5 4.5))))
diff --git a/tests/lolevel-tests.scm b/tests/lolevel-tests.scm
index d0812fbf..e925104b 100644
--- a/tests/lolevel-tests.scm
+++ b/tests/lolevel-tests.scm
@@ -88,6 +88,10 @@
; pointer-s32-set!
+; pointer-u64-set!
+
+; pointer-s64-set!
+
; pointer-f32-set!
; pointer-f64-set!
@@ -112,6 +116,10 @@
; pointer-s32-ref
+; pointer-u64-ref
+
+; pointer-s64-ref
+
; pointer-f32-ref
; pointer-f64-ref
diff --git a/tests/loopy-loop.scm b/tests/loopy-loop.scm
index fbdb5707..310afcc6 100644
--- a/tests/loopy-loop.scm
+++ b/tests/loopy-loop.scm
@@ -207,6 +207,8 @@
(define-in-indexed in-s16vector in-s16vector-reverse s16vector-length s16vector-ref)
(define-in-indexed in-u32vector in-u32vector-reverse u32vector-length u32vector-ref)
(define-in-indexed in-s32vector in-s32vector-reverse s32vector-length s32vector-ref)
+(define-in-indexed in-u64vector in-u64vector-reverse u64vector-length u64vector-ref)
+(define-in-indexed in-s64vector in-s64vector-reverse s64vector-length s64vector-ref)
(define-in-indexed in-f32vector in-f32vector-reverse f32vector-length f32vector-ref)
(define-in-indexed in-f64vector in-f64vector-reverse f64vector-length f64vector-ref)
diff --git a/tests/srfi-4-tests.scm b/tests/srfi-4-tests.scm
index 7d4eabff..37432a86 100644
--- a/tests/srfi-4-tests.scm
+++ b/tests/srfi-4-tests.scm
@@ -28,9 +28,11 @@
(test1 u8 0 255)
(test1 u16 0 65535)
(test1 u32 0 4294967295)
+(test1 u64 0 18446744073709551615)
(test1 s8 -128 127)
(test1 s16 -32768 32767)
(test1 s32 -2147483648 2147483647)
+(test1 s64 -9223372036854775808 9223372036854775807)
(define-syntax test2
(er-macro-transformer
@@ -61,7 +63,9 @@
(assert (equal? #u16(1 2 3) '#u16(1 2 3)))
(assert (equal? #s16(-1 2 3) '#s16(-1 2 3)))
(assert (equal? #u32(1 2 3) '#u32(1 2 3)))
+(assert (equal? #u64(1 2 3) '#u64(1 2 3)))
(assert (equal? #s32(-1 2 3) '#s32(-1 2 3)))
+(assert (equal? #s64(-1 2 3) '#s64(-1 2 3)))
(assert (equal? #f32(1 2 3) '#f32(1 2 3)))
(assert (equal? #f64(-1 2 3) '#f64(-1 2 3)))
diff --git a/types.db b/types.db
index 334e5cf6..7dd4c69f 100644
--- a/types.db
+++ b/types.db
@@ -1684,7 +1684,7 @@
(object-copy (#(procedure #:clean) object-copy (*) *))
(pointer+ (#(procedure #:clean #:enforce) pointer+ ((or pointer procedure port locative) fixnum) pointer))
-(pointer->address (#(procedure #:clean #:enforce) pointer->address ((or pointer procedure port locative)) number)
+(pointer->address (#(procedure #:clean #:enforce) pointer->address ((or pointer procedure port locative)) integer)
((pointer) (##sys#pointer->address #(1))))
(pointer->object (#(procedure #:clean #:enforce) pointer->object (pointer) *)
@@ -1710,8 +1710,10 @@
(pointer-vector-set! (#(procedure #:clean #:enforce) pointer-vector-set! (pointer-vector fixnum (or pointer false)) undefined))
(pointer-s16-ref (#(procedure #:clean #:enforce) pointer-s16-ref (pointer) fixnum))
(pointer-s16-set! (#(procedure #:clean #:enforce) pointer-s16-set! (pointer fixnum) undefined))
-(pointer-s32-ref (#(procedure #:clean #:enforce) pointer-s32-ref (pointer) number))
-(pointer-s32-set! (#(procedure #:clean #:enforce) pointer-s32-set! (pointer number) undefined))
+(pointer-s32-ref (#(procedure #:clean #:enforce) pointer-s32-ref (pointer) integer))
+(pointer-s32-set! (#(procedure #:clean #:enforce) pointer-s32-set! (pointer integer) undefined))
+(pointer-s64-ref (#(procedure #:clean #:enforce) pointer-s64-ref (pointer) integer))
+(pointer-s64-set! (#(procedure #:clean #:enforce) pointer-s64-set! (pointer integer) undefined))
(pointer-s8-ref (#(procedure #:clean #:enforce) pointer-s8-ref (pointer) fixnum))
(pointer-s8-set! (#(procedure #:clean #:enforce) pointer-s8-set! (pointer fixnum) undefined))
@@ -1720,8 +1722,10 @@
(pointer-u16-ref (#(procedure #:clean #:enforce) pointer-u16-ref (pointer) fixnum))
(pointer-u16-set! (#(procedure #:clean #:enforce) pointer-u16-set! (pointer fixnum) undefined))
-(pointer-u32-ref (#(procedure #:clean #:enforce) pointer-u32-ref (pointer) number))
-(pointer-u32-set! (#(procedure #:clean #:enforce) pointer-u32-set! (pointer number) undefined))
+(pointer-u32-ref (#(procedure #:clean #:enforce) pointer-u32-ref (pointer) integer))
+(pointer-u32-set! (#(procedure #:clean #:enforce) pointer-u32-set! (pointer integer) undefined))
+(pointer-u64-ref (#(procedure #:clean #:enforce) pointer-u64-ref (pointer) integer))
+(pointer-u64-set! (#(procedure #:clean #:enforce) pointer-u64-set! (pointer integer) undefined))
(pointer-u8-ref (#(procedure #:clean #:enforce) pointer-u8-ref (pointer) fixnum))
(pointer-u8-set! (#(procedure #:clean #:enforce) pointer-u8-set! (pointer fixnum) undefined))
@@ -2018,6 +2022,8 @@
(blob->u16vector/shared (#(procedure #:clean #:enforce) blob->u16vector/shared (blob) (struct u16vector)))
(blob->u32vector (#(procedure #:clean #:enforce) blob->u32vector (blob) (struct u32vector)))
(blob->u32vector/shared (#(procedure #:clean #:enforce) blob->u32vector/shared (blob) (struct u32vector)))
+(blob->u64vector (#(procedure #:clean #:enforce) blob->u64vector (blob) (struct u64vector)))
+(blob->u64vector/shared (#(procedure #:clean #:enforce) blob->u64vector/shared (blob) (struct u64vector)))
(blob->u8vector (#(procedure #:clean #:enforce) blob->u8vector (blob) (struct u8vector)))
(blob->u8vector/shared (#(procedure #:clean #:enforce) blob->u8vector/shared (blob) (struct u8vector)))
(f32vector (#(procedure #:clean #:enforce) f32vector (#!rest (or integer float)) (struct f32vector)))
@@ -2053,6 +2059,7 @@
(list->s8vector (#(procedure #:clean #:enforce) list->s8vector ((list-of fixnum)) (struct s8vector)))
(list->u16vector (#(procedure #:clean #:enforce) list->u16vector ((list-of fixnum)) (struct u16vector)))
(list->u32vector (#(procedure #:clean #:enforce) list->u32vector ((list-of integer)) (struct u32vector)))
+(list->u64vector (#(procedure #:clean #:enforce) list->u64vector ((list-of integer)) (struct u64vector)))
(list->u8vector (#(procedure #:clean #:enforce) list->u8vector ((list-of fixnum)) (struct u8vector)))
(make-f32vector (#(procedure #:clean #:enforce) make-f32vector (fixnum #!optional (or integer float false) boolean boolean) (struct f32vector)))
(make-f64vector (#(procedure #:clean #:enforce) make-f64vector (fixnum #!optional (or integer float false) boolean) (struct f64vector)))
@@ -2061,6 +2068,7 @@
(make-s8vector (#(procedure #:clean #:enforce) make-s8vector (fixnum #!optional (or fixnum false) boolean boolean) (struct s8vector)))
(make-u16vector (#(procedure #:clean #:enforce) make-u16vector (fixnum #!optional (or fixnum false) boolean boolean) (struct u16vector)))
(make-u32vector (#(procedure #:clean #:enforce) make-u32vector (fixnum #!optional (or integer false) boolean boolean) (struct u32vector)))
+(make-u64vector (#(procedure #:clean #:enforce) make-u64vector (fixnum #!optional (or integer false) boolean boolean) (struct u64vector)))
(make-u8vector (#(procedure #:clean #:enforce) make-u8vector (fixnum #!optional (or fixnum false) boolean boolean) (struct u8vector)))
(read-u8vector (#(procedure #:enforce) read-u8vector (#!optional fixnum input-port) (struct u8vector)))
(read-u8vector! (#(procedure #:enforce) read-u8vector! ((or fixnum false) (struct u8vector) #!optional input-port fixnum) integer))
@@ -2111,6 +2119,7 @@
(subs8vector (#(procedure #:clean #:enforce) subs8vector ((struct s8vector) fixnum fixnum) (struct s8vector)))
(subu16vector (#(procedure #:clean #:enforce) subu16vector ((struct u16vector) fixnum fixnum) (struct u16vector)))
(subu32vector (#(procedure #:clean #:enforce) subu32vector ((struct u32vector) fixnum fixnum) (struct u32vector)))
+(subu64vector (#(procedure #:clean #:enforce) subu64vector ((struct u64vector) fixnum fixnum) (struct u64vector)))
(subu8vector (#(procedure #:clean #:enforce) subu8vector ((struct u8vector) fixnum fixnum) (struct u8vector)))
(u16vector (#(procedure #:clean #:enforce) u16vector (#!rest fixnum) (struct u16vector)))
(u16vector->blob (#(procedure #:clean #:enforce) u16vector->blob ((struct u16vector)) blob))
@@ -2138,6 +2147,19 @@
(u32vector? (#(procedure #:pure #:predicate (struct u32vector)) u32vector? (*) boolean))
+(u64vector (#(procedure #:clean #:enforce) u64vector (#!rest integer) (struct u64vector)))
+(u64vector->blob (#(procedure #:clean #:enforce) u64vector->blob ((struct u64vector)) blob))
+(u64vector->blob/shared (#(procedure #:clean #:enforce) u64vector->blob/shared ((struct u64vector)) blob))
+(u64vector->list (#(procedure #:clean #:enforce) u64vector->list ((struct u64vector)) (list-of integer)))
+
+(u64vector-length (#(procedure #:clean #:enforce) u64vector-length ((struct u64vector)) fixnum)
+ (((struct u64vector)) (##core#inline "C_u_i_64vector_length" #(1))))
+
+(u64vector-ref (#(procedure #:clean #:enforce) u64vector-ref ((struct u64vector) fixnum) integer))
+(u64vector-set! (#(procedure #:clean #:enforce) u64vector-set! ((struct u64vector) fixnum integer) undefined))
+
+(u64vector? (#(procedure #:pure #:predicate (struct u64vector)) u64vector? (*) boolean))
+
(u8vector (#(procedure #:clean #:enforce) u8vector (#!rest fixnum) (struct u8vector)))
(u8vector->blob (#(procedure #:clean #:enforce) u8vector->blob ((struct u8vector)) blob))
(u8vector->blob/shared (#(procedure #:clean #:enforce) u8vector->blob/shared ((struct u8vector)) blob))
@@ -2153,8 +2175,8 @@
(write-u8vector (#(procedure #:enforce) write-u8vector ((struct u8vector) #!optional output-port fixnum fixnum) undefined))
-(number-vector? (#(procedure #:pure #:predicate (or (struct u8vector) (struct u16vector) (struct s8vector) (struct s16vector) (struct u32vector) (struct s32vector) (struct f32vector) (struct f64vector))) number-vector? (*) boolean))
-(##sys#srfi-4-vector? (#(procedure #:pure #:predicate (or (struct u8vector) (struct u16vector) (struct s8vector) (struct s16vector) (struct u32vector) (struct s32vector) (struct f32vector) (struct f64vector))) ##sys#srfi-4-vector? (*) boolean))
+(number-vector? (#(procedure #:pure #:predicate (or (struct u8vector) (struct u16vector) (struct s8vector) (struct s16vector) (struct u32vector) (struct s32vector) (struct u64vector) (struct s64vector) (struct f32vector) (struct f64vector))) number-vector? (*) boolean))
+(##sys#srfi-4-vector? (#(procedure #:pure #:predicate (or (struct u8vector) (struct u16vector) (struct s8vector) (struct s16vector) (struct u32vector) (struct s32vector) (struct u64vector) (struct s64vector) (struct f32vector) (struct f64vector))) ##sys#srfi-4-vector? (*) boolean))
;; tcp
Trap