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

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

@ -2314,36 +2314,51 @@ 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)))) '())
(set-uword! 0 DT_GUILE_VM_VERSION) ,@(if (and rw rw-init)
(set-uword! 1 (logior (ash *bytecode-major-version* 16) (list (reloc 9 rw-init))
*bytecode-minor-version*)) '())
(set-uword! 2 DT_GUILE_ENTRY) ,@(if frame-maps
(set-label! 3 '.rtl-text) (list (reloc (- words 3) '.guile.frame-maps))
(when rw '()))))
;; Add roots to GC.
(set-uword! 4 DT_GUILE_GC_ROOT) (define (write! bv)
(set-label! 5 '.data) (define (set-uword! i uword)
(set-uword! 6 DT_GUILE_GC_ROOT_SZ) (%set-uword! bv (* i word-size) uword endianness))
(set-uword! 7 (bytevector-length (linker-object-bv rw))) (define (set-label! i label)
(when rw-init (%set-uword! bv (* i word-size) 0 endianness))
(set-uword! 8 DT_INIT) ; constants
(set-label! 9 rw-init))) (set-uword! 0 DT_GUILE_VM_VERSION)
(when frame-maps (set-uword! 1 (logior (ash *bytecode-major-version* 16)
(set-uword! (- words 4) DT_GUILE_FRAME_MAPS) *bytecode-minor-version*))
(set-label! (- words 3) '.guile.frame-maps)) (set-uword! 2 DT_GUILE_ENTRY)
(set-uword! (- words 2) DT_NULL) (set-label! 3 '.rtl-text)
(set-uword! (- words 1) 0) (when rw
;; Add roots to GC.
(set-uword! 4 DT_GUILE_GC_ROOT)
(set-label! 5 '.data)
(set-uword! 6 DT_GUILE_GC_ROOT_SZ)
(set-uword! 7 (bytevector-length (linker-object-bv rw)))
(when rw-init
(set-uword! 8 DT_INIT) ; constants
(set-label! 9 rw-init)))
(when frame-maps
(set-uword! (- words 4) DT_GUILE_FRAME_MAPS)
(set-label! (- words 3) '.guile.frame-maps))
(set-uword! (- words 2) DT_NULL)
(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)