[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 41/41: Assembler has a single growable vector
From: |
Andy Wingo |
Subject: |
[Guile-commits] 41/41: Assembler has a single growable vector |
Date: |
Wed, 02 Dec 2015 08:07:01 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 246887171c436f7276464f4c84e19a21194050a2
Author: Andy Wingo <address@hidden>
Date: Tue Dec 1 18:38:02 2015 +0100
Assembler has a single growable vector
* module/system/vm/assembler.scm (<asm>): Instead of writing words into
a list of fixed-size buffers, use a growable vector.
(expand, emit): Instead of assuming that there is enough space for
only one word, check that there is space for the entire instruction at
the beginning.
---
module/system/vm/assembler.scm | 84 ++++++++++++++-------------------------
1 files changed, 30 insertions(+), 54 deletions(-)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index e5f464b..ff7e53c 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -363,9 +363,6 @@
(high-pc arity-high-pc set-arity-high-pc!)
(definitions arity-definitions set-arity-definitions!))
-(eval-when (expand)
- (define-syntax *block-size* (identifier-syntax 32)))
-
;;; An assembler collects all of the words emitted during assembly, and
;;; also maintains ancillary information such as the constant table, a
;;; relocation list, and so on.
@@ -375,7 +372,7 @@
;;; the bytevector as a whole instead of conditionalizing each access.
;;;
(define-record-type <asm>
- (make-asm cur idx start prev written
+ (make-asm buf pos start
labels relocs
word-size endianness
constants inits
@@ -386,10 +383,10 @@
;; We write bytecode into what is logically a growable vector,
;; implemented as a list of blocks. asm-cur is the current block, and
- ;; asm-idx is the current index into that block, in 32-bit units.
+ ;; asm-pos is the current index into that block, in 32-bit units.
;;
- (cur asm-cur set-asm-cur!)
- (idx asm-idx set-asm-idx!)
+ (buf asm-buf set-asm-buf!)
+ (pos asm-pos set-asm-pos!)
;; asm-start is an absolute position, indicating the offset of the
;; beginning of an instruction (in u32 units). It is updated after
@@ -401,15 +398,6 @@
;;
(start asm-start set-asm-start!)
- ;; The list of previously written blocks.
- ;;
- (prev asm-prev set-asm-prev!)
-
- ;; The number of u32 words written in asm-prev, which is the same as
- ;; the offset of the current block.
- ;;
- (written asm-written set-asm-written!)
-
;; An alist of symbol -> position pairs, indicating the labels defined
;; in this compilation unit.
;;
@@ -465,15 +453,12 @@
;;
(slot-maps asm-slot-maps set-asm-slot-maps!))
-(define-inline (fresh-block)
- (make-u32vector *block-size*))
-
(define* (make-assembler #:key (word-size (target-word-size))
(endianness (target-endianness)))
"Create an assembler for a given target @var{word-size} and
@var{endianness}, falling back to appropriate values for the configured
target."
- (make-asm (fresh-block) 0 0 '() 0
+ (make-asm (make-u32vector 1000) 0 0
(make-hash-table) '()
word-size endianness
vlist-null '()
@@ -484,28 +469,20 @@ target."
"Add a string to the section name table (shstrtab)."
(string-table-intern! (asm-shstrtab asm) string))
-(define-inline (asm-pos asm)
- "The offset of the next word to be written into the code buffer, in
-32-bit units."
- (+ (asm-idx asm) (asm-written asm)))
-
-(define (allocate-new-block asm)
- "Close off the current block, and arrange for the next word to be
-written to a fresh block."
- (let ((new (fresh-block)))
- (set-asm-prev! asm (cons (asm-cur asm) (asm-prev asm)))
- (set-asm-written! asm (asm-pos asm))
- (set-asm-cur! asm new)
- (set-asm-idx! asm 0)))
+(define (grow-buffer! asm)
+ "Grow the code buffer of the asm."
+ (let* ((buf (asm-buf asm))
+ (len (bytevector-length buf))
+ (new (make-u32vector (ash len -1) 0)))
+ (bytevector-copy! buf 0 new 0 len)
+ (set-asm-buf! asm new)
+ #f))
(define-inline (emit asm u32)
"Emit one 32-bit word into the instruction stream. Assumes that there
-is space for the word, and ensures that there is space for the next
-word."
- (u32-set! (asm-cur asm) (asm-idx asm) u32)
- (set-asm-idx! asm (1+ (asm-idx asm)))
- (if (= (asm-idx asm) *block-size*)
- (allocate-new-block asm)))
+is space for the word."
+ (u32-set! (asm-buf asm) (asm-pos asm) u32)
+ (set-asm-pos! asm (1+ (asm-pos asm))))
(define-inline (make-reloc type label base word)
"Make an internal relocation of type @var{type} referencing symbol
@@ -674,7 +651,12 @@ later by the linker."
(map (lambda (word) (pack-tail-word #'asm word))
(syntax->datum #'(word* ...)))))
#'(lambda (asm formal0 ... formal* ... ...)
- (unless (asm? asm) (error "not an asm"))
+ (let lp ()
+ (let ((words (length '(word0 word* ...))))
+ (unless (<= (* 4 (+ (asm-pos asm) words))
+ (bytevector-length (asm-buf asm)))
+ (grow-buffer! asm)
+ (lp))))
code0 ...
code* ... ...
(reset-asm-start! asm))))))))
@@ -1630,20 +1612,14 @@ The offsets are expected to be expressed in words."
"Link the .rtl-text section, swapping the endianness of the bytes if
needed."
(let ((buf (make-u32vector (asm-pos asm))))
- (let lp ((pos 0) (prev (reverse (asm-prev asm))))
- (if (null? prev)
- (let ((byte-size (* (asm-idx asm) 4)))
- (bytevector-copy! (asm-cur asm) 0 buf pos byte-size)
- (unless (eq? (asm-endianness asm) (native-endianness))
- (swap-bytes! buf))
- (make-object asm '.rtl-text
- buf
- (process-relocs buf (asm-relocs asm)
- (asm-labels asm))
- (process-labels (asm-labels asm))))
- (let ((len (* *block-size* 4)))
- (bytevector-copy! (car prev) 0 buf pos len)
- (lp (+ pos len) (cdr prev)))))))
+ (bytevector-copy! (asm-buf asm) 0 buf 0 (bytevector-length buf))
+ (unless (eq? (asm-endianness asm) (native-endianness))
+ (swap-bytes! buf))
+ (make-object asm '.rtl-text
+ buf
+ (process-relocs buf (asm-relocs asm)
+ (asm-labels asm))
+ (process-labels (asm-labels asm)))))
- [Guile-commits] 35/41: Add current-thread VM op, (continued)
- [Guile-commits] 35/41: Add current-thread VM op, Andy Wingo, 2015/12/02
- [Guile-commits] 27/41: Better range inference for indexes of vector-ref, string-ref et al, Andy Wingo, 2015/12/02
- [Guile-commits] 29/41: Remove add1 and sub1, Andy Wingo, 2015/12/02
- [Guile-commits] 30/41: Add tagged and untagged arithmetic ops with immediate operands, Andy Wingo, 2015/12/02
- [Guile-commits] 32/41: Add support for unboxed s64 values, Andy Wingo, 2015/12/02
- [Guile-commits] 39/41: Specialize u64 bit operations, Andy Wingo, 2015/12/02
- [Guile-commits] 31/41: New instructions load-f64, load-u64, Andy Wingo, 2015/12/02
- [Guile-commits] 36/41: Add logsub op., Andy Wingo, 2015/12/02
- [Guile-commits] 40/41: More efficient assembler instructions, Andy Wingo, 2015/12/02
- [Guile-commits] 33/41: Untag values and indexes for all bytevector instructions, Andy Wingo, 2015/12/02
- [Guile-commits] 41/41: Assembler has a single growable vector,
Andy Wingo <=
- [Guile-commits] 38/41: Add untagged bitwise operations, Andy Wingo, 2015/12/02
- [Guile-commits] 34/41: Unbox indexes of vectors, strings, and structs, Andy Wingo, 2015/12/02