diff options
author | Andy Wingo <wingo@pobox.com> | 2017-03-24 11:17:26 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2017-03-28 19:23:13 +0200 |
commit | 64c5cc58fced3092f17639bbbddb46c1bae974c8 (patch) | |
tree | 72f711f25e72b08b72ff81dae17e50c9810f1081 /module/system/vm/assembler.scm | |
parent | 6ba3f35f261293492206892c40b4cd7d29e372f8 (diff) | |
download | guile-64c5cc58fced3092f17639bbbddb46c1bae974c8.tar.gz |
Add disjoint syntax object type
* libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES):
(DOT_X_FILES, DOT_DOC_FILES, noinst_HEADERS): Add syntax.c and
syntax.h.
* libguile/evalext.c (scm_self_evaluating_p):
* libguile/goops.c (class_syntax, scm_class_of, scm_goops_early_init):
* libguile/init.c (scm_init_guile):
* libguile/print.c (iprin1):
* libguile/tags.h (scm_tc7_syntax):
* module/oop/goops.scm (<syntax>):
* module/system/base/types.scm (%tc7-syntax, cell->object):
* module/system/vm/disassembler.scm (code-annotation): Wire up the new
data type.
* libguile/syntax.c:
* libguile/syntax.h: New files.
* module/ice-9/boot-9.scm: Move new definitions to (system syntax
internal).
* module/system/syntax.scm (print-syntax): New helper.
* module/system/vm/assembler.scm (statically-allocatable?)
(intern-constant, link-data): Arrange to be able to write syntax
objects into images.
* module/language/cps/types.scm (&syntax): New type. Remove
&hash-table; it was never detected, an internal binding, and we need
the bit to avoid going into bignum territory.
Diffstat (limited to 'module/system/vm/assembler.scm')
-rw-r--r-- | module/system/vm/assembler.scm | 24 |
1 files changed, 23 insertions, 1 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 9ac3fa62a..56c33be81 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -47,6 +47,7 @@ #:use-module (system vm dwarf) #:use-module (system vm elf) #:use-module (system vm linker) + #:use-module (system syntax internal) #:use-module (language bytecode) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) @@ -1017,7 +1018,8 @@ immediate, and @code{#f} otherwise." "Return @code{#t} if a non-immediate constant can be allocated statically, and @code{#f} if it would need some kind of runtime allocation." - (or (pair? x) (string? x) (stringbuf? x) (static-procedure? x) (array? x))) + (or (pair? x) (string? x) (stringbuf? x) (static-procedure? x) + (array? x) (syntax? x))) (define (intern-constant asm obj) "Add an object to the constant table, and return a label that can be @@ -1045,6 +1047,10 @@ table, its existing label is used directly." (append-reverse (field label (1+ i) (vector-ref obj i)) inits)) (reverse inits)))) + ((syntax? obj) + (append (field label 1 (syntax-expression obj)) + (field label 2 (syntax-wrap obj)) + (field label 3 (syntax-module obj)))) ((stringbuf? obj) '()) ((static-procedure? obj) `((static-patch! ,label 1 ,(static-procedure-code obj)))) @@ -1181,6 +1187,7 @@ returned instead." ;(define-tc7-macro-assembler br-if-dynamic-state 45) ;(define-tc7-macro-assembler br-if-frame 47) (define-tc7-macro-assembler br-if-keyword #x35) +;(define-tc7-macro-assembler br-if-syntax #x3d) ;(define-tc7-macro-assembler br-if-vm 55) ;(define-tc7-macro-assembler br-if-vm-cont 71) ;(define-tc7-macro-assembler br-if-rtl-program 69) @@ -1391,6 +1398,7 @@ should be .data or .rodata), and return the resulting linker object. (define tc7-narrow-stringbuf tc7-stringbuf) (define tc7-wide-stringbuf (+ tc7-stringbuf stringbuf-wide-flag)) (define tc7-ro-string (+ 21 #x200)) + (define tc7-syntax #x3d) (define tc7-program 69) (define tc7-bytevector 77) (define tc7-bitvector 95) @@ -1415,6 +1423,8 @@ should be .data or .rodata), and return the resulting linker object. (* 2 word-size)) ((simple-vector? x) (* (1+ (vector-length x)) word-size)) + ((syntax? x) + (* 4 word-size)) ((simple-uniform-vector? x) (* 4 word-size)) ((uniform-vector-backing-store? x) @@ -1519,6 +1529,18 @@ should be .data or .rodata), and return the resulting linker object. ((keyword? obj) (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"))) + (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))) + ((number? obj) (write-placeholder asm buf pos)) |