mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-17 22:42:25 +02:00
Add new "source" macro instruction; compile-rtl emits it.
* module/system/vm/assembler.scm (<asm>): Add "sources" field. (make-assembler): Adapt to make-asm change. (source): New macro assembler. * module/language/cps/compile-rtl.scm (emit-rtl-sequence): (compile-fun): Emit source instructions as appropriate.
This commit is contained in:
parent
6371e368e6
commit
e675e9bd39
2 changed files with 18 additions and 3 deletions
|
@ -316,6 +316,8 @@
|
|||
(((k . _) . _) k)
|
||||
(() #f))))
|
||||
(emit-label asm k)
|
||||
(when src
|
||||
(emit-source asm src))
|
||||
(emit-rtl k exp-k exp next-label)
|
||||
(lp exps))))))
|
||||
|
||||
|
@ -335,6 +337,8 @@
|
|||
kw))
|
||||
(nlocals (lookup-nlocals k allocation)))
|
||||
(emit-label asm k)
|
||||
(when src
|
||||
(emit-source asm src))
|
||||
(emit-begin-kw-arity asm req opt rest kw-indices allow-other-keys?
|
||||
nlocals alternate)
|
||||
(emit-rtl-sequence asm body allocation nlocals cont-table)
|
||||
|
@ -353,6 +357,8 @@
|
|||
(match f
|
||||
(($ $fun meta free ($ $cont k src ($ $kentry self tail clauses)))
|
||||
(emit-begin-program asm k (or meta '()))
|
||||
(when src
|
||||
(emit-source asm src))
|
||||
(emit-fun-clauses clauses)
|
||||
(emit-end-program asm)))))
|
||||
|
||||
|
|
|
@ -169,7 +169,7 @@
|
|||
word-size endianness
|
||||
constants inits
|
||||
shstrtab next-section-number
|
||||
meta)
|
||||
meta sources)
|
||||
asm?
|
||||
|
||||
;; We write RTL code into what is logically a growable vector,
|
||||
|
@ -239,7 +239,13 @@
|
|||
|
||||
;; A list of <meta>, corresponding to procedure metadata.
|
||||
;;
|
||||
(meta asm-meta set-asm-meta!))
|
||||
(meta asm-meta set-asm-meta!)
|
||||
|
||||
;; A list of (pos . source) pairs, indicating source information. POS
|
||||
;; is relative to the beginning of the text section, and SOURCE is in
|
||||
;; the same format that source-properties returns.
|
||||
;;
|
||||
(sources asm-sources set-asm-sources!))
|
||||
|
||||
(define-inlinable (fresh-block)
|
||||
(make-u32vector *block-size*))
|
||||
|
@ -254,7 +260,7 @@ target."
|
|||
word-size endianness
|
||||
vlist-null '()
|
||||
(make-string-table) 1
|
||||
'()))
|
||||
'() '()))
|
||||
|
||||
(define (intern-section-name! asm string)
|
||||
"Add a string to the section name table (shstrtab)."
|
||||
|
@ -726,6 +732,9 @@ returned instead."
|
|||
(define-macro-assembler (label asm sym)
|
||||
(set-asm-labels! asm (acons sym (asm-start asm) (asm-labels asm))))
|
||||
|
||||
(define-macro-assembler (source asm source)
|
||||
(set-asm-sources! asm (acons (asm-start asm) source (asm-sources asm))))
|
||||
|
||||
(define-macro-assembler (cache-current-module! asm module scope)
|
||||
(let ((mod-label (intern-module-cache-cell asm scope)))
|
||||
(emit-static-set! asm module mod-label 0)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue