mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

assembler: Separate effectful part of 'link-dynamic-section'.

Browse source 
* module/system/vm/assembler.scm (link-dynamic-section): Define 'relocs'
once for all.  Define 'write!' and use it.
This commit is contained in:
Ludovic Courtès 2023-01-06 11:26:29 +01:00
parent fc5eae5d01
commit c7f1522c6d
1 changed files with 45 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2314,17 +2314,30 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
(words (if rw (+ words 4) words)) (words (if rw (+ words 4) words))
(words (if rw-init (+ words 2) words)) (words (if rw-init (+ words 2) words))
(words (if frame-maps (+ words 2) words)) (words (if frame-maps (+ words 2) words))
(bv (make-bytevector (* word-size words) 0)) (bv (make-bytevector (* word-size words) 0)))
(set-uword!
(lambda (i uword) (define relocs
(%set-uword! bv (* i word-size) uword endianness))) ;; This must match the 'set-label!' calls below.
(relocs '()) (let ((reloc (lambda (i label)
(set-label! (make-linker-reloc 'reloc-type
(lambda (i label) (* i word-size) 0 label))))
(set! relocs (cons (make-linker-reloc 'reloc-type `(,(reloc 3 '.rtl-text)
(* i word-size) 0 label) ,@(if rw
relocs)) (list (reloc 5 '.data))
(%set-uword! bv (* i word-size) 0 endianness)))) '())
,@(if (and rw rw-init)
(list (reloc 9 rw-init))
'())
,@(if frame-maps
(list (reloc (- words 3) '.guile.frame-maps))
'()))))
(define (write! bv)
(define (set-uword! i uword)
(%set-uword! bv (* i word-size) uword endianness))
(define (set-label! i label)
(%set-uword! bv (* i word-size) 0 endianness))
(set-uword! 0 DT_GUILE_VM_VERSION) (set-uword! 0 DT_GUILE_VM_VERSION)
(set-uword! 1 (logior (ash *bytecode-major-version* 16) (set-uword! 1 (logior (ash *bytecode-major-version* 16)
*bytecode-minor-version*)) *bytecode-minor-version*))
@ -2343,7 +2356,9 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
(set-uword! (- words 4) DT_GUILE_FRAME_MAPS) (set-uword! (- words 4) DT_GUILE_FRAME_MAPS)
(set-label! (- words 3) '.guile.frame-maps)) (set-label! (- words 3) '.guile.frame-maps))
(set-uword! (- words 2) DT_NULL) (set-uword! (- words 2) DT_NULL)
(set-uword! (- words 1) 0) (set-uword! (- words 1) 0))
(write! bv)
(make-object asm '.dynamic bv relocs '() (make-object asm '.dynamic bv relocs '()
#:type SHT_DYNAMIC #:flags SHF_ALLOC))) #:type SHT_DYNAMIC #:flags SHF_ALLOC)))
(case (asm-word-size asm) (case (asm-word-size asm)