mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-17 22:42:25 +02:00
Code Activity

Add new "source" macro instruction; compile-rtl emits it.

Browse source 
* 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:
Andy Wingo 2013-09-30 21:48:07 +02:00
parent 6371e368e6
commit e675e9bd39
2 changed files with 18 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/language/cps/compile-rtl.scm
View file

@ -316,6 +316,8 @@
(((k . _) . _) k) (((k . _) . _) k)
(() #f)))) (() #f))))
(emit-label asm k) (emit-label asm k)
(when src
(emit-source asm src))
(emit-rtl k exp-k exp next-label) (emit-rtl k exp-k exp next-label)
(lp exps)))))) (lp exps))))))
@ -335,6 +337,8 @@
kw)) kw))
(nlocals (lookup-nlocals k allocation))) (nlocals (lookup-nlocals k allocation)))
(emit-label asm k) (emit-label asm k)
(when src
(emit-source asm src))
(emit-begin-kw-arity asm req opt rest kw-indices allow-other-keys? (emit-begin-kw-arity asm req opt rest kw-indices allow-other-keys?
nlocals alternate) nlocals alternate)
(emit-rtl-sequence asm body allocation nlocals cont-table) (emit-rtl-sequence asm body allocation nlocals cont-table)
@ -353,6 +357,8 @@
(match f (match f
(($ $fun meta free ($ $cont k src ($ $kentry self tail clauses))) (($ $fun meta free ($ $cont k src ($ $kentry self tail clauses)))
(emit-begin-program asm k (or meta '())) (emit-begin-program asm k (or meta '()))
(when src
(emit-source asm src))
(emit-fun-clauses clauses) (emit-fun-clauses clauses)
(emit-end-program asm))))) (emit-end-program asm)))))

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

@ -169,7 +169,7 @@
word-size endianness word-size endianness
constants inits constants inits
shstrtab next-section-number shstrtab next-section-number
meta) meta sources)
asm? asm?
;; We write RTL code into what is logically a growable vector, ;; We write RTL code into what is logically a growable vector,
@ -239,7 +239,13 @@
;; A list of <meta>, corresponding to procedure metadata. ;; 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) (define-inlinable (fresh-block)
(make-u32vector *block-size*)) (make-u32vector *block-size*))
@ -254,7 +260,7 @@ target."
word-size endianness word-size endianness
vlist-null '() vlist-null '()
(make-string-table) 1 (make-string-table) 1
'())) '() '()))
(define (intern-section-name! asm string) (define (intern-section-name! asm string)
"Add a string to the section name table (shstrtab)." "Add a string to the section name table (shstrtab)."
@ -726,6 +732,9 @@ returned instead."
(define-macro-assembler (label asm sym) (define-macro-assembler (label asm sym)
(set-asm-labels! asm (acons sym (asm-start asm) (asm-labels asm)))) (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) (define-macro-assembler (cache-current-module! asm module scope)
(let ((mod-label (intern-module-cache-cell asm scope))) (let ((mod-label (intern-module-cache-cell asm scope)))
(emit-static-set! asm module mod-label 0))) (emit-static-set! asm module mod-label 0)))