HCoop
/
bpt
/
guile.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
constant-interning fix
[bpt/guile.git]
/
module
/
system
/
vm
/
assembler.scm
diff --git
a/module/system/vm/assembler.scm
b/module/system/vm/assembler.scm
index
6bc2bcf
..
bb4ddf7
100644
(file)
--- a/
module/system/vm/assembler.scm
+++ b/
module/system/vm/assembler.scm
@@
-325,7
+325,8
@@
constants inits
shstrtab next-section-number
meta sources
constants inits
shstrtab next-section-number
meta sources
- dead-slot-maps)
+ dead-slot-maps
+ to-file?)
asm?
;; We write bytecode into what is logically a growable vector,
asm?
;; We write bytecode into what is logically a growable vector,
@@
-408,13
+409,15
@@
;; DEAD-SLOT-MAP is a bitfield of slots that are dead at call sites,
;; as an integer.
;;
;; DEAD-SLOT-MAP is a bitfield of slots that are dead at call sites,
;; as an integer.
;;
- (dead-slot-maps asm-dead-slot-maps set-asm-dead-slot-maps!))
+ (dead-slot-maps asm-dead-slot-maps set-asm-dead-slot-maps!)
+ (to-file? asm-to-file?))
(define-inline (fresh-block)
(make-u32vector *block-size*))
(define* (make-assembler #:key (word-size (target-word-size))
(define-inline (fresh-block)
(make-u32vector *block-size*))
(define* (make-assembler #:key (word-size (target-word-size))
- (endianness (target-endianness)))
+ (endianness (target-endianness))
+ (to-file? #t))
"Create an assembler for a given target @var{word-size} and
@var{endianness}, falling back to appropriate values for the configured
target."
"Create an assembler for a given target @var{word-size} and
@var{endianness}, falling back to appropriate values for the configured
target."
@@
-423,7
+426,7
@@
target."
word-size endianness
vlist-null '()
(make-string-table) 1
word-size endianness
vlist-null '()
(make-string-table) 1
- '() '() '()))
+ '() '() '()
to-file?
))
(define (intern-section-name! asm string)
"Add a string to the section name table (shstrtab)."
(define (intern-section-name! asm string)
"Add a string to the section name table (shstrtab)."
@@
-873,7
+876,7
@@
table, its existing label is used directly."
((static-procedure? obj)
`((static-patch! ,label 1 ,(static-procedure-code obj))))
((cache-cell? obj) '())
((static-procedure? obj)
`((static-patch! ,label 1 ,(static-procedure-code obj))))
((cache-cell? obj) '())
- ((
symbol? obj
)
+ ((
and (symbol? obj) (symbol-interned? obj)
)
`((make-non-immediate 1 ,(recur (symbol->string obj)))
(string->symbol 1 1)
(static-set! 1 ,label 0)))
`((make-non-immediate 1 ,(recur (symbol->string obj)))
(string->symbol 1 1)
(static-set! 1 ,label 0)))
@@
-906,7
+909,11
@@
table, its existing label is used directly."
((array? obj)
`((static-patch! ,label 1 ,(recur (shared-array-root obj)))))
(else
((array? obj)
`((static-patch! ,label 1 ,(recur (shared-array-root obj)))))
(else
- (error "don't know how to intern" obj))))
+ (if (asm-to-file? asm)
+ (error "don't know how to intern" obj)
+ `((make-short-immediate 1 ,(vlist-length (asm-constants asm)))
+ (vector-ref 1 0 1)
+ (static-set! 1 ,label 0))))))
(cond
((immediate? obj) #f)
((vhash-assoc obj (asm-constants asm)) => cdr)
(cond
((immediate? obj) #f)
((vhash-assoc obj (asm-constants asm)) => cdr)
@@
-1208,7
+1215,10
@@
a procedure to do that and return its label. Otherwise return
(let ((label (gensym "init-constants")))
(emit-text asm
`((begin-program ,label ())
(let ((label (gensym "init-constants")))
(emit-text asm
`((begin-program ,label ())
- (assert-nargs-ee/locals 1 1)
+ ,@(if (asm-to-file? asm)
+ '((assert-nargs-ee/locals 1 1))
+ '((assert-nargs-ee/locals 2 0)
+ (mov 0 1)))
,@(reverse inits)
(load-constant 1 ,*unspecified*)
(return 1)
,@(reverse inits)
(load-constant 1 ,*unspecified*)
(return 1)
@@
-1350,7
+1360,7
@@
should be .data or .rodata), and return the resulting linker object.
(write-constant-reference buf pos elt)
(lp (1+ i)))))))
(write-constant-reference buf pos elt)
(lp (1+ i)))))))
- ((
symbol? obj
)
+ ((
and (symbol? obj) (symbol-interned? obj)
)
(write-immediate asm buf pos #f))
((keyword? obj)
(write-immediate asm buf pos #f))
((keyword? obj)
@@
-1415,7
+1425,9
@@
should be .data or .rodata), and return the resulting linker object.
(lp (+ pos (* 3 word-size)) (cdr bounds) (cdr incs))))))
(else
(lp (+ pos (* 3 word-size)) (cdr bounds) (cdr incs))))))
(else
- (error "unrecognized object" obj))))
+ (if (asm-to-file? asm)
+ (error "unrecognized object" obj)
+ (write-constant-reference buf pos obj)))))
(cond
((vlist-null? data) #f)
(cond
((vlist-null? data) #f)
@@
-2412,4
+2424,7
@@
procedure with label @var{rw-init}. @var{rw-init} may be false. If
The result is a bytevector, by default linked so that read-only and
writable data are on separate pages. Pass @code{#:page-aligned? #f} to
disable this behavior."
The result is a bytevector, by default linked so that read-only and
writable data are on separate pages. Pass @code{#:page-aligned? #f} to
disable this behavior."
- (link-elf (link-objects asm) #:page-aligned? page-aligned?))
+ (define (asm-constant-vector asm)
+ (list->vector (reverse (map car (vlist->list (asm-constants asm))))))
+ (let ((bv (link-elf (link-objects asm) #:page-aligned? page-aligned?)))
+ (cons bv (if (asm-to-file? asm) #f (asm-constant-vector asm)))))