diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2023-01-06 15:48:50 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2023-01-17 17:49:05 +0100 |
| commit | 13e2d5b66b94d8a9f70937a2889e27d6f4196723 (patch) | |
| tree | 127f2765e48a3f4d296f06e116b2d791947e8ba6 | |
| parent | dc0c4ccb1fdfe20a8f924551eef81d92eed4aaa2 (diff) | |
| download | guile-13e2d5b66b94d8a9f70937a2889e27d6f4196723.tar.gz | |
assembler: Separate effectful part of 'link-frame-maps'.
* module/system/vm/assembler.scm (link-frame-maps)[make-frame-maps]:
Define 'write!' and use it.
| -rw-r--r-- | module/system/vm/assembler.scm | 43 |
1 files changed, 24 insertions, 19 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 1b0bf5c45..872cc31c6 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -2262,25 +2262,30 @@ needed." (header-pos frame-maps-prefix-len) (map-pos (+ header-pos (* count frame-map-header-len))) (bv (make-bytevector (+ map-pos map-len) 0))) - (bytevector-u32-set! bv 4 map-pos endianness) - (let lp ((maps maps) (header-pos header-pos) (map-pos map-pos)) - (match maps - (() - (make-object asm '.guile.frame-maps bv - (list (make-linker-reloc 'abs32/1 0 0 '.rtl-text)) - '() #:type SHT_PROGBITS #:flags SHF_ALLOC)) - (((pos proc-slot . map) . maps) - (bytevector-u32-set! bv header-pos pos endianness) - (bytevector-u32-set! bv (+ header-pos 4) map-pos endianness) - (let write-bytes ((map-pos map-pos) - (map map) - (byte-length (map-byte-length proc-slot))) - (if (zero? byte-length) - (lp maps (+ header-pos frame-map-header-len) map-pos) - (begin - (bytevector-u8-set! bv map-pos (logand map #xff)) - (write-bytes (1+ map-pos) (ash map -8) - (1- byte-length)))))))))) + (define (write! bv) + (bytevector-u32-set! bv 4 map-pos endianness) + (let lp ((maps maps) (header-pos header-pos) (map-pos map-pos)) + (match maps + (() + #t) + (((pos proc-slot . map) . maps) + (bytevector-u32-set! bv header-pos pos endianness) + (bytevector-u32-set! bv (+ header-pos 4) map-pos endianness) + (let write-bytes ((map-pos map-pos) + (map map) + (byte-length (map-byte-length proc-slot))) + (if (zero? byte-length) + (lp maps (+ header-pos frame-map-header-len) map-pos) + (begin + (bytevector-u8-set! bv map-pos (logand map #xff)) + (write-bytes (1+ map-pos) (ash map -8) + (1- byte-length))))))))) + + (write! bv) + (make-object asm '.guile.frame-maps + bv + (list (make-linker-reloc 'abs32/1 0 0 '.rtl-text)) + '() #:type SHT_PROGBITS #:flags SHF_ALLOC))) (match (asm-slot-maps asm) (() #f) (in |