mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 16:20:39 +02:00
Code Activity

Allow for contiguous bytevectors to be relocated

Browse source 
* libguile/trace.h (scm_trace_bytevector): Update contents pointer for
contiguous bytevectors.
* module/system/vm/assembler.scm (link-data): Make sure to set the
contiguous flag on serialized bytevectors.
This commit is contained in:
Andy Wingo 2025-07-01 15:14:47 +02:00
parent 77a6914c3a
commit c379fba9a9
2 changed files with 8 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/trace.h
View file

@ -434,8 +434,12 @@ scm_trace_vm_cont (struct scm_vm_cont *c, TRACE_PARAMS)
static inline size_t static inline size_t
scm_trace_bytevector (struct scm_bytevector *x, TRACE_PARAMS) scm_trace_bytevector (struct scm_bytevector *x, TRACE_PARAMS)
{ {
if (x->contents == x->inline_contents) if (scm_bytevector_is_contiguous (x))
{
// Update internal pointer after a move, if needed.
x->contents = x->inline_contents;
return SIZEOF_WITH_TAIL (x, inline_contents, x->length); return SIZEOF_WITH_TAIL (x, inline_contents, x->length);
}
if (trace) if (trace)
{ {

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

@ -1869,6 +1869,7 @@ should be .data or .rodata), and return the resulting linker object.
(define tc7-bytevector #x4d) (define tc7-bytevector #x4d)
(define bytevector-immutable-flag #x80) (define bytevector-immutable-flag #x80)
(define bytevector-contiguous-flag #x100)
(define tc7-array #x5d) (define tc7-array #x5d)
@ -2056,6 +2057,7 @@ should be .data or .rodata), and return the resulting linker object.
((simple-uniform-vector? obj) ((simple-uniform-vector? obj)
(let ((tag (logior tc7-bytevector (let ((tag (logior tc7-bytevector
bytevector-immutable-flag bytevector-immutable-flag
bytevector-contiguous-flag
(ash (array-type-code obj) 16)))) (ash (array-type-code obj) 16))))
(case word-size (case word-size
((4) ((4)