common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Remove combination-implementation-style on ppc.

Browse source
This commit is contained in:
Stas Boukarev 2024-03-06 17:34:04 +03:00
parent 3b93526f46
commit 9ed74fa10a
4 changed files with 42 additions and 82 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/compiler/ppc/arith.lisp
View file

@ -699,6 +699,17 @@
(- 32 size n-fixnum-tag-bits)
(- 31 n-fixnum-tag-bits)))))))
(deftransform %ldb ((size posn integer) (:or (((constant-arg (integer 1 #.(1- n-word-bits)))
(constant-arg integer)
word) unsigned-byte)
(((constant-arg (integer 1 #.(1- n-word-bits)))
(constant-arg integer)
signed-word) unsigned-byte)) *
:vop t)
(<= (+ (sb-c:lvar-value size)
(sb-c:lvar-value posn))
n-word-bits))
(define-vop (ldb-c/signed)
(:translate %ldb)
(:args (x :scs (signed-reg)))
@ -815,6 +826,10 @@
(:arg-types unsigned-num (:constant (unsigned-byte 16)))
(:info target not-p y))
(deftransform logtest ((x y) (:or ((signed-word signed-word) *)
((word word) *)) * :vop t)
t)
(macrolet ((define-logtest-vops ()
`(progn
,@(loop for suffix in '(/fixnum -c/fixnum
@ -850,6 +865,10 @@
(inst b? (if not-p :eq :ne) target)))))))
(define-logtest-vops))
(deftransform logbitp ((x y) (:or (((constant-arg (mod #.n-word-bits)) signed-word) *)
(((constant-arg (mod #.n-word-bits)) word) *)) * :vop t)
t)
;;; We only handle the constant cases because those are the only ones
;;; guaranteed to make it past COMBINATION-IMPLEMENTATION-STYLE.
;;; --njf, 06-02-2006

41
src/compiler/ppc/vm.lisp
View file

@ -336,45 +336,8 @@
(immediate-constant "Immed"))))
(defun combination-implementation-style (node)
(declare (type sb-c::combination node))
(flet ((valid-funtype (args result)
(sb-c::valid-fun-use node
(sb-c::specifier-type
`(function ,args ,result)))))
(case (sb-c::combination-fun-source-name node)
(logtest
(cond
((or (valid-funtype '(fixnum fixnum) '*)
(valid-funtype '((signed-byte 32) (signed-byte 32)) '*)
(valid-funtype '((unsigned-byte 32) (unsigned-byte 32)) '*))
(values :maybe nil))
(t (values :default nil))))
(logbitp
(cond
((or (valid-funtype '((constant-arg (integer 0 29)) fixnum) '*)
(valid-funtype '((constant-arg (integer 0 31)) (signed-byte 32)) '*)
(valid-funtype '((constant-arg (integer 0 31)) (unsigned-byte 32)) '*))
(values :direct nil))
(t (values :default nil))))
;; FIXME: can handle MIN and MAX here
(%ldb
(flet ((validp (type width)
(and (valid-funtype `((constant-arg (integer 1 29))
(constant-arg (mod ,width))
,type)
'fixnum)
(destructuring-bind (size posn integer)
(sb-c::basic-combination-args node)
(declare (ignore integer))
(<= (+ (sb-c:lvar-value size)
(sb-c:lvar-value posn))
width)))))
(if (or (validp 'fixnum 29)
(validp '(signed-byte 32) 32)
(validp '(unsigned-byte 32) 32))
(values :direct nil)
(values :default nil))))
(t (values :default nil)))))
(declare (ignore node))
(values :default nil))
(defun primitive-type-indirect-cell-type (ptype)
(declare (ignore ptype))

21
src/compiler/ppc64/arith.lisp
View file

@ -470,6 +470,17 @@
(inst popcntd res arg)))
;;;; %LDB
#+nil
(deftransform %ldb ((size posn integer) (:or (((constant-arg (integer 1 #.(1- n-word-bits)))
(constant-arg integer)
word) unsigned-byte)
(((constant-arg (integer 1 #.(1- n-word-bits)))
(constant-arg integer)
signed-word) unsigned-byte)) *
:vop t)
(<= (+ (sb-c:lvar-value size)
(sb-c:lvar-value posn))
n-word-bits))
#+nil
(define-vop (ldb-c/fixnum)
@ -640,6 +651,11 @@
(:arg-types unsigned-num (:constant (unsigned-byte 16)))
(:info target not-p y))
#+nil
(deftransform logtest ((x y) (:or ((signed-word signed-word) *)
((word word) *)) * :vop t)
t)
(macrolet ((define-logtest-vops ()
`(progn
,@(loop for suffix in '(/fixnum -c/fixnum
@ -675,6 +691,11 @@
(inst b? (if not-p :eq :ne) target)))))))
(define-logtest-vops))
#+nil
(deftransform logbitp ((x y) (:or (((constant-arg (mod #.n-word-bits)) signed-word) *)
(((constant-arg (mod #.n-word-bits)) word) *)) * :vop t)
t)
;;; We only handle the constant cases because those are the only ones
;;; guaranteed to make it past COMBINATION-IMPLEMENTATION-STYLE.
;;; --njf, 06-02-2006

43
src/compiler/ppc64/vm.lisp
View file

@ -330,49 +330,6 @@
(declare (type sb-c::combination node) (ignore node))
(values :default nil))
;;; The 32-bit constants below are obviously wrong.
#+nil
(defun combination-implementation-style (node)
(declare (type sb-c::combination node))
(flet ((valid-funtype (args result)
(sb-c::valid-fun-use node
(sb-c::specifier-type
`(function ,args ,result)))))
(case (sb-c::combination-fun-source-name node)
(logtest
(cond
((or (valid-funtype '(fixnum fixnum) '*)
(valid-funtype '((signed-byte 32) (signed-byte 32)) '*)
(valid-funtype '((unsigned-byte 32) (unsigned-byte 32)) '*))
(values :maybe nil))
(t (values :default nil))))
(logbitp
(cond
((or (valid-funtype '((constant-arg (integer 0 29)) fixnum) '*)
(valid-funtype '((constant-arg (integer 0 31)) (signed-byte 32)) '*)
(valid-funtype '((constant-arg (integer 0 31)) (unsigned-byte 32)) '*))
(values :direct nil))
(t (values :default nil))))
;; FIXME: can handle MIN and MAX here
(%ldb
(flet ((validp (type width)
(and (valid-funtype `((constant-arg (integer 1 29))
(constant-arg (mod ,width))
,type)
'fixnum)
(destructuring-bind (size posn integer)
(sb-c::basic-combination-args node)
(declare (ignore integer))
(<= (+ (sb-c:lvar-value size)
(sb-c:lvar-value posn))
width)))))
(if (or (validp 'fixnum 29)
(validp '(signed-byte 32) 32)
(validp '(unsigned-byte 32) 32))
(values :direct nil)
(values :default nil))))
(t (values :default nil)))))
(defun primitive-type-indirect-cell-type (ptype)
(declare (ignore ptype))
nil)