mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

assembler: Separate effectful part of 'link-docstrs'.

Browse source 
* module/system/vm/assembler.scm (link-docstrs): Define
'write-docstrings!' and use it.
This commit is contained in:
Ludovic Courtès 2023-01-06 17:06:47 +01:00
parent 13e2d5b66b
commit d439a3f671
1 changed files with 13 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2684,16 +2684,19 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
(docstrings (find-docstrings)) (docstrings (find-docstrings))
(strtab (make-string-table)) (strtab (make-string-table))
(bv (make-bytevector (* (length docstrings) docstr-size) 0))) (bv (make-bytevector (* (length docstrings) docstr-size) 0)))
(fold (lambda (pair pos) (define (write-docstrings! bv offset)
(match pair (fold (lambda (pair pos)
((pc . string) (match pair
(bytevector-u32-set! bv pos pc endianness) ((pc . string)
(bytevector-u32-set! bv (+ pos 4) (bytevector-u32-set! bv pos pc endianness)
(string-table-intern! strtab string) (bytevector-u32-set! bv (+ pos 4)
endianness) (string-table-intern! strtab string)
(+ pos docstr-size)))) endianness)
0 (+ pos docstr-size))))
docstrings) offset
docstrings))
(write-docstrings! bv 0)
(let ((strtab (make-object asm '.guile.docstrs.strtab (let ((strtab (make-object asm '.guile.docstrs.strtab
(link-string-table! strtab) (link-string-table! strtab)
'() '() '() '()