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

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

Browse source 
* module/system/vm/assembler.scm (link-procprops): Define
'write-procprops!' and use it.
This commit is contained in:
Ludovic Courtès 2023-01-06 15:31:15 +01:00
parent c7f1522c6d
commit dc0c4ccb1f
1 changed files with 26 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2744,20 +2744,32 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
(let* ((endianness (asm-endianness asm))
(procprops (find-procprops))
(bv (make-bytevector (* (length procprops) procprops-size) 0)))
(let lp ((procprops procprops) (pos 0) (relocs '()))
(match procprops
(()
(make-object asm '.guile.procprops
bv
relocs '()
#:type SHT_PROGBITS #:flags 0))
(((pc . props) . procprops)
(bytevector-u32-set! bv pos pc endianness)
(lp procprops
(+ pos procprops-size)
(cons (make-linker-reloc 'abs32/1 (+ pos 4) 0
(intern-constant asm props))
relocs)))))))
(define (write-procprops! bv offset)
(let lp ((procprops procprops) (pos offset))
(match procprops
(()
#t)
(((pc . props) . procprops)
(bytevector-u32-set! bv pos pc endianness)
(lp procprops (+ pos procprops-size))))))
(define relocs
(let lp ((procprops procprops) (pos 0) (relocs '()))
(match procprops
(()
relocs)
(((pc . props) . procprops)
(lp procprops
(+ pos procprops-size)
(cons (make-linker-reloc 'abs32/1 (+ pos 4) 0
(intern-constant asm props))
relocs))))))
(write-procprops! bv 0)
(make-object asm '.guile.procprops
bv
relocs '()
#:type SHT_PROGBITS #:flags 0)))
;;;
;;; The DWARF .debug_info, .debug_abbrev, .debug_str, and .debug_loc