This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=e7f2fe1bb77f2949f94a786b38a899644d5800e1 The branch, master has been updated via e7f2fe1bb77f2949f94a786b38a899644d5800e1 (commit) from 3be43fb782957d5916c4ad236533ac29ffe0f1ce (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit e7f2fe1bb77f2949f94a786b38a899644d5800e1 Author: Andy Wingo <[email protected]> Date: Fri May 16 16:17:53 2014 +0200 Redefine memory kind part of effects to be enumeration, not flags * module/language/cps/effects-analysis.scm (define-enumeration): New helper. (&memory-kind-mask): Define as an enumeration, not a bitfield. Add &unknown-memory-kinds. (&all-effects, effect-clobbers?, make-prompt-tag, expression-effects): Adapt. Note that this change requires dce.go and cse.go to be recompiled. ----------------------------------------------------------------------- Summary of changes: module/language/cps/effects-analysis.scm | 46 ++++++++++++++++++++++------- 1 files changed, 35 insertions(+), 11 deletions(-) diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm index 6089dc0..5b85386 100644 --- a/module/language/cps/effects-analysis.scm +++ b/module/language/cps/effects-analysis.scm @@ -95,6 +95,25 @@ (define-syntax all (identifier-syntax (1- (ash 1 count)))) (define-syntax shift (identifier-syntax count))))))))) +(define-syntax define-enumeration + (lambda (x) + (define (count-bits n) + (let lp ((out 1)) + (if (< n (ash 1 (1- out))) + out + (lp (1+ out))))) + (syntax-case x () + ((_ mask shift name ...) + (let* ((len (length #'(name ...))) + (bits (count-bits len))) + (with-syntax (((n ...) (iota len)) + (bits bits)) + #'(begin + (define-syntax name (identifier-syntax n)) + ... + (define-syntax mask (identifier-syntax (1- (ash 1 bits)))) + (define-syntax shift (identifier-syntax bits))))))))) + (define-flags &all-effect-kinds &effect-kind-bits ;; Indicates that an expression may cause a type check. A type check, ;; for the purposes of this analysis, is the possibility of throwing @@ -121,7 +140,10 @@ ;; Indicates that an expression may cause a write to memory. &write) -(define-flags &all-memory-kinds &memory-kind-bits +(define-enumeration &memory-kind-mask &memory-kind-bits + ;; Indicates than an expression may access unknown kinds of memory. + &unknown-memory-kinds + ;; Indicates that an expression depends on the value of a fluid ;; variable, or on the current fluid environment. &fluid @@ -178,7 +200,7 @@ (define-syntax &no-effects (identifier-syntax 0)) (define-syntax &all-effects (identifier-syntax - (logior &all-effect-kinds (&field &all-memory-kinds -1)))) + (logior &all-effect-kinds (&object &unknown-memory-kinds)))) (define-inlinable (constant? effects) (zero? effects)) @@ -193,12 +215,14 @@ "Return true if A clobbers B. This is the case if A is a write, and B is or might be a read or a write to the same location as A." (define (locations-same?) - (and (not (zero? (logand a b (ash &all-memory-kinds &effect-kind-bits)))) - ;; A negative field indicates "the whole object". Non-negative - ;; fields indicate only part of the object. - (or (< a 0) (< b 0) - (= (ash a (- (+ &effect-kind-bits &memory-kind-bits))) - (ash b (- (+ &effect-kind-bits &memory-kind-bits))))))) + (let ((a (ash a (- &effect-kind-bits))) + (b (ash b (- &effect-kind-bits)))) + (or (eqv? &unknown-memory-kinds (logand a &memory-kind-mask)) + (eqv? &unknown-memory-kinds (logand b &memory-kind-mask)) + (and (eqv? (logand a &memory-kind-mask) (logand b &memory-kind-mask)) + ;; A negative field indicates "the whole object". + ;; Non-negative fields indicate only part of the object. + (or (< a 0) (< b 0) (= a b)))))) (and (not (zero? (logand a &write))) (not (zero? (logand b (logior &read &write)))) (locations-same?))) @@ -262,7 +286,7 @@ is or might be a read or a write to the same location as A." ;; Prompts. (define-primitive-effects - ((make-prompt-tag #:optional arg) (&allocate &all-memory-kinds))) + ((make-prompt-tag #:optional arg) (&allocate &unknown-memory-kinds))) ;; Pairs. (define-primitive-effects @@ -416,9 +440,9 @@ is or might be a read or a write to the same location as A." ((or ($ $void) ($ $const) ($ $prim) ($ $values)) &no-effects) (($ $fun) - (&allocate &all-memory-kinds)) + (&allocate &unknown-memory-kinds)) (($ $prompt) - (logior (&write-object &prompt))) + (&write-object &prompt)) ((or ($ $call) ($ $callk)) &all-effects) (($ $primcall name args) hooks/post-receive -- GNU Guile
