mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Effects analysis treats the fixed parts of objects specially

Browse source 
* module/language/cps/effects-analysis.scm (&header): New memory kind,
  for the fixed parts of objects.  Distinguishing init-only memory
  allows us to determine that vector-set! doesn't stomple
  vector-length.
  (annotation->memory-kind*): New helper, mapping references to fixed
  offsets to &header.  Use for scm-ref/immediate et al.
This commit is contained in:
Andy Wingo 2019-12-06 10:19:44 +01:00
parent e63e266105
commit 6c6867d570
1 changed files with 27 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

36
module/language/cps/effects-analysis.scm
View file

@ -64,6 +64,7 @@
&thread
&bytevector
&closure
&header
&object
&field
@ -191,7 +192,12 @@
&bitmask
;; Indicates a dependency on the value of a cache cell.
&cache)
&cache
;; Indicates that an expression depends on a value extracted from the
;; fixed, unchanging part of an object -- for example the length of a
;; vector or the vtable of a struct.
&header)
(define-inlinable (&field kind field)
(ash (logior (ash field &memory-kind-bits) kind) &effect-kind-bits))
@ -344,6 +350,18 @@ the LABELS that are clobbered by the effects of LABEL."
((make-prompt-tag #:optional arg) (&allocate &unknown-memory-kinds)))
;; Generic objects.
(define (annotation->memory-kind* annotation idx)
(match (cons annotation idx)
(('vector . 0) &header)
(('string . (or 0 1 2 3)) &header)
(('stringbuf . (or 0 1)) &header)
(('bytevector . (or 0 1 2 3)) &header)
(('box . 0) &header)
(('closure . (or 0 1)) &header)
(('struct . 0) &header)
(('atomic-box . 0) &header)
(_ (annotation->memory-kind annotation))))
(define (annotation->memory-kind annotation)
(match annotation
('pair &pair)
@ -373,40 +391,40 @@ the LABELS that are clobbered by the effects of LABEL."
((scm-ref obj idx) (&read-object
(annotation->memory-kind param)))
((scm-ref/tag obj) (&read-field
(annotation->memory-kind param) 0))
(annotation->memory-kind* param 0) 0))
((scm-ref/immediate obj) (match param
((ann . idx)
(&read-field
(annotation->memory-kind ann) idx))))
(annotation->memory-kind* ann idx) idx))))
((scm-set! obj idx val) (&write-object
(annotation->memory-kind param)))
((scm-set/tag! obj val) (&write-field
(annotation->memory-kind param) 0))
(annotation->memory-kind* param 0) 0))
((scm-set!/immediate obj val) (match param
((ann . idx)
(&write-field
(annotation->memory-kind ann) idx))))
(annotation->memory-kind* ann idx) idx))))
((word-ref obj idx) (&read-object
(annotation->memory-kind param)))
((word-ref/immediate obj) (match param
((ann . idx)
(&read-field
(annotation->memory-kind ann) idx))))
(annotation->memory-kind* ann idx) idx))))
((word-set! obj idx val) (&read-object
(annotation->memory-kind param)))
((word-set!/immediate obj val) (match param
((ann . idx)
(&write-field
(annotation->memory-kind ann) idx))))
(annotation->memory-kind* ann idx) idx))))
((pointer-ref/immediate obj) (match param
((ann . idx)
(&read-field
(annotation->memory-kind ann) idx))))
(annotation->memory-kind* ann idx) idx))))
((pointer-set!/immediate obj val)
(match param
((ann . idx)
(&write-field
(annotation->memory-kind ann) idx))))
(annotation->memory-kind* ann idx) idx))))
((tail-pointer-ref/immediate obj)))
;; Strings.