diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/boot-9.scm | 1 | ||||
-rw-r--r-- | module/ice-9/psyntax-pp.scm | 7 | ||||
-rw-r--r-- | module/ice-9/psyntax.scm | 14 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 21 |
4 files changed, 22 insertions, 21 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 89595f3f7..67d84ae52 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -379,7 +379,6 @@ If returning early, return the return value of F." (define syntax-violation #f) (define datum->syntax #f) (define syntax->datum #f) -(define syntax-source #f) (define identifier? #f) (define generate-temporaries #f) (define bound-identifier=? #f) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 95758255a..3732d5ac1 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -236,8 +236,10 @@ (make-letrec src in-order? ids vars val-exps body-exp))))) (source-annotation (lambda (x) - (let ((props (source-properties (if (syntax? x) (syntax-expression x) x)))) - (and (pair? props) props)))) + (if (syntax? x) + (syntax-source x) + (let ((props (source-properties x))) + (and (pair? props) props))))) (extend-env (lambda (labels bindings r) (if (null? labels) @@ -2416,7 +2418,6 @@ (lambda (id datum) (make-syntax datum (syntax-wrap id) (syntax-module id)))) (set! syntax->datum (lambda (x) (strip x '(())))) - (set! syntax-source (lambda (x) (source-annotation x))) (set! generate-temporaries (lambda (ls) (let ((x ls)) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index b11771aa0..6867eb933 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -1,6 +1,6 @@ ;;;; -*-scheme-*- ;;;; -;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010-2020 +;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010-2021 ;;;; Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -454,11 +454,10 @@ (define source-annotation (lambda (x) - (let ((props (source-properties - (if (syntax? x) - (syntax-expression x) - x)))) - (and (pair? props) props)))) + (if (syntax? x) + (syntax-source x) + (let ((props (source-properties x))) + (and (pair? props) props))))) (define-syntax-rule (arg-check pred? e who) (let ((x e)) @@ -2769,9 +2768,6 @@ (lambda (x) (strip x empty-wrap))) - (set! syntax-source - (lambda (x) (source-annotation x))) - (set! generate-temporaries (lambda (ls) (arg-check list? ls 'generate-temporaries) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 8599aa005..5be16f6a8 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -1,6 +1,6 @@ ;;; Guile bytecode assembler -;;; Copyright (C) 2001, 2009-2020 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009-2021 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -1272,7 +1272,8 @@ table, its existing label is used directly." ((syntax? obj) (append (field label 1 (syntax-expression obj)) (field label 2 (syntax-wrap obj)) - (field label 3 (syntax-module obj)))) + (field label 3 (syntax-module obj)) + (field label 4 (syntax-source obj)))) ((stringbuf? obj) '()) ((static-procedure? obj) `((static-patch! ,label 1 ,(static-procedure-code obj)))) @@ -1772,6 +1773,7 @@ should be .data or .rodata), and return the resulting linker object. (define stringbuf-wide-flag #x400) (define tc7-syntax #x3d) + (define syntax-has-source-flag #x100) (define tc7-program #x45) @@ -1804,7 +1806,7 @@ should be .data or .rodata), and return the resulting linker object. ((simple-vector? x) (* (1+ (vector-length x)) word-size)) ((syntax? x) - (* 4 word-size)) + (* 5 word-size)) ((jit-data? x) (case word-size ((4) (+ word-size (* 4 3))) @@ -1920,16 +1922,19 @@ should be .data or .rodata), and return the resulting linker object. (write-placeholder asm buf pos)) ((syntax? obj) - (case word-size - ((4) (bytevector-u32-set! buf pos tc7-syntax endianness)) - ((8) (bytevector-u64-set! buf pos tc7-syntax endianness)) - (else (error "bad word size"))) + (let ((tag (logior tc7-syntax syntax-has-source-flag))) + (case word-size + ((4) (bytevector-u32-set! buf pos tag endianness)) + ((8) (bytevector-u64-set! buf pos tag endianness)) + (else (error "bad word size")))) (write-constant-reference buf (+ pos (* 1 word-size)) (syntax-expression obj)) (write-constant-reference buf (+ pos (* 2 word-size)) (syntax-wrap obj)) (write-constant-reference buf (+ pos (* 3 word-size)) - (syntax-module obj))) + (syntax-module obj)) + (write-constant-reference buf (+ pos (* 4 word-size)) + (syntax-source obj))) ((number? obj) (write-placeholder asm buf pos)) |