diff --git a/module/language/cps/compile-rtl.scm b/module/language/cps/compile-rtl.scm index b1267385c..0fe321691 100644 --- a/module/language/cps/compile-rtl.scm +++ b/module/language/cps/compile-rtl.scm @@ -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))))) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 26dc3457b..4ce64cf61 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -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 , 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)))