mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00
Code Activity

Convert bitvectors to use inline-only word-size units

Browse source 
* libguile/bitvectors.h: Unit of bitvectors is scm_t_bits, not uint32_t.
* libguile/bitvectors.c: Adapt implementation.
(make_bitvector): Malloc pointerless instead, with inline bits.
* libguile/posix.c (scm_setaffinity):
* libguile/bytevectors.c (uniform-array->bytevector): Adapt to unit size
change.
* module/system/vm/assembler.scm (intern-constant, link-data): Adapt to
bitvector representation change.
This commit is contained in:
Andy Wingo 2025-06-03 16:54:19 +02:00
parent 9ff7c0651c
commit d6e59a1d3e
5 changed files with 303 additions and 208 deletions
Download patch file Download diff file Expand all files Collapse all files

51
module/system/vm/assembler.scm
View file

@ -1338,14 +1338,16 @@ table, its existing label is used directly."
(emit-static-set! asm 1 label 0)
1))))
((uniform-vector-backing-store? obj))
((bitvector? obj))
((simple-uniform-vector? obj)
(let ((width (case (array-type obj)
((vu8 u8 s8) 1)
((u16 s16) 2)
;; Bitvectors are addressed in 32-bit units.
;; Bitvectors are addressed in word-sized units.
((b) (asm-word-size asm))
;; Although a complex number is 8 or 16 bytes wide,
;; it should be byteswapped in 4 or 8 byte units.
((u32 s32 f32 c32 b) 4)
((u32 s32 f32 c32) 4)
((u64 s64 f64 c64) 8)
(else
(error "unhandled array type" obj)))))
@ -1899,6 +1901,8 @@ should be .data or .rodata), and return the resulting linker object.
((4) (+ word-size (* 4 3)))
((8) (+ word-size (* 4 4))) ;; One additional uint32_t for padding.
(else (error word-size))))
((bitvector? x)
(* word-size (+ 2 (ceiling/ (bitvector-length x) (* word-size 8)))))
((simple-uniform-vector? x)
(* 4 word-size))
((uniform-vector-backing-store? x)
@ -2025,29 +2029,46 @@ should be .data or .rodata), and return the resulting linker object.
((number? obj)
(write-placeholder asm buf pos))
((simple-uniform-vector? obj)
(let ((tag (if (bitvector? obj)
(logior tc7-bitvector
bitvector-immutable-flag)
(logior tc7-bytevector
bytevector-immutable-flag
(ash (array-type-code obj) 16)))))
((bitvector? obj)
(let ((tag (logior tc7-bitvector
bitvector-immutable-flag))
(bytes (uniform-array->bytevector obj)))
(case word-size
((4)
(bytevector-u32-set! buf pos tag endianness)
(bytevector-u32-set! buf (+ pos 4)
(if (bitvector? obj)
(bitvector-length obj)
(bytevector-length obj))
(bitvector-length obj)
endianness))
((8)
(bytevector-u64-set! buf pos tag endianness)
(bytevector-u64-set! buf (+ pos 8)
(bitvector-length obj)
endianness))
(else (error "bad word size")))
(let ((pos (+ pos (* word-size 2))))
(bytevector-copy! bytes 0 buf pos (bytevector-length bytes))
(unless (eq? endianness (native-endianness))
(case word-size
((4) (byte-swap/4! buf pos (+ pos (bytevector-length bytes))))
((8) (byte-swap/8! buf pos (+ pos (bytevector-length bytes))))
(else (error "bad word size")))))))
((simple-uniform-vector? obj)
(let ((tag (logior tc7-bytevector
bytevector-immutable-flag
(ash (array-type-code obj) 16))))
(case word-size
((4)
(bytevector-u32-set! buf pos tag endianness)
(bytevector-u32-set! buf (+ pos 4)
(bytevector-length obj)
endianness) ; length
(bytevector-u32-set! buf (+ pos 8) 0 endianness) ; pointer
(write-placeholder asm buf (+ pos 12))) ; owner
((8)
(bytevector-u64-set! buf pos tag endianness)
(bytevector-u64-set! buf (+ pos 8)
(if (bitvector? obj)
(bitvector-length obj)
(bytevector-length obj))
(bytevector-length obj)
endianness) ; length
(bytevector-u64-set! buf (+ pos 16) 0 endianness) ; pointer
(write-placeholder asm buf (+ pos 24))) ; owner