1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00

Compiler emits br-if-logtest

* module/language/cps/compile-bytecode.scm (compile-fun):
* module/language/cps/primitives.scm (*branching-primcall-arities*):
* module/language/cps/type-fold.scm (logtest):
* module/language/cps/types.scm (logtest):
* module/system/vm/assembler.scm (system):
* module/system/vm/disassembler.scm (compute-labels): Add backend
  support for the logtest instruction.
This commit is contained in:
Andy Wingo 2014-07-03 15:03:40 +02:00
parent 8c6206f319
commit d613ccaaa0
6 changed files with 21 additions and 19 deletions

View file

@ -438,7 +438,8 @@
(($ $primcall '<= (a b)) (binary emit-br-if-<= a b))
(($ $primcall '= (a b)) (binary emit-br-if-= a b))
(($ $primcall '>= (a b)) (binary emit-br-if-<= b a))
(($ $primcall '> (a b)) (binary emit-br-if-< b a))))
(($ $primcall '> (a b)) (binary emit-br-if-< b a))
(($ $primcall 'logtest (a b)) (binary emit-br-if-logtest a b))))
(define (compile-trunc label k exp nreq rest-var nlocals)
(define (do-call proc args emit-call)

View file

@ -86,7 +86,8 @@
(< . (1 . 2))
(> . (1 . 2))
(<= . (1 . 2))
(>= . (1 . 2))))
(>= . (1 . 2))
(logtest . (1 . 2))))
(define (compute-prim-instructions)
(let ((table (make-hash-table)))

View file

@ -123,6 +123,19 @@
((= <= <) (values #t #f))
(else (values #f #f))))
(define-binary-branch-folder (logtest type0 min0 max0 type1 min1 max1)
(define (logand-min a b)
(if (< a b 0)
(min a b)
0))
(define (logand-max a b)
(if (< a b 0)
0
(max a b)))
(if (and (= min0 max0) (= min1 max1) (eqv? type0 type1 &exact-integer))
(values #t (logtest min0 min1))
(values #f #f)))
(define (compute-folded fun dfg min-label min-var)
(define (scalar-value type val)
(cond

View file

@ -1013,23 +1013,9 @@ minimum, and maximum."
(- -1 (&min a))))
(define-simple-type-checker (logtest &exact-integer &exact-integer))
(define-type-inferrer (logtest a b result)
(define (logand-min a b)
(if (< a b 0)
(min a b)
0))
(define (logand-max a b)
(if (< a b 0)
0
(max a b)))
(define-predicate-inferrer (logtest a b true?)
(restrict! a &exact-integer -inf.0 +inf.0)
(restrict! b &exact-integer -inf.0 +inf.0)
(let ((min (logand-min (&min a) (&min b)))
(max (logand-max (&max a) (&max b))))
(if (and (= min max) (not (inf? min)))
(let ((res (if (zero? min) 0 1)))
(define! result &boolean res res))
(define! result &exact-integer 0 1))))
(restrict! b &exact-integer -inf.0 +inf.0))
(define-simple-type-checker (logbit? (&exact-integer 0 +inf.0) &exact-integer))
(define-type-inferrer (logbit? a b result)

View file

@ -95,6 +95,7 @@
(emit-br-if-=* . emit-br-if-=)
(emit-br-if-<* . emit-br-if-<)
(emit-br-if-<=* . emit-br-if-<=)
(emit-br-if-logtest* . emit-br-if-logtest)
(emit-mov* . emit-mov)
(emit-box* . emit-box)
(emit-box-ref* . emit-box-ref)

View file

@ -296,7 +296,7 @@ address of that offset."
br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt
br-if-true br-if-null br-if-nil br-if-pair br-if-struct
br-if-char br-if-tc7 br-if-eq br-if-eqv br-if-equal
br-if-= br-if-< br-if-<= br-if-> br-if->=)
br-if-= br-if-< br-if-<= br-if-> br-if->= br-if-logtest)
(match arg
((_ ... target)
(add-label! (+ offset target) "L"))))