diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2023-01-06 15:31:15 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2023-01-17 17:49:05 +0100 |
| commit | dc0c4ccb1fdfe20a8f924551eef81d92eed4aaa2 (patch) | |
| tree | 80f465e42dad1ca0b3d27c50c8031815e3efed49 | |
| parent | c7f1522c6df880a33c1472d290a3e61cea85be48 (diff) | |
| download | guile-dc0c4ccb1fdfe20a8f924551eef81d92eed4aaa2.tar.gz | |
assembler: Separate effectful part of 'link-procprops'.
* module/system/vm/assembler.scm (link-procprops): Define
'write-procprops!' and use it.
| -rw-r--r-- | module/system/vm/assembler.scm | 40 |
1 files changed, 26 insertions, 14 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 87f9cc2e9..1b0bf5c45 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -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 |