Skip to content
Snippets Groups Projects
Commit d65d5521 authored by ram's avatar ram
Browse files

Changed the basic numeric equality to be EQL, and changed the numeric

comparison stuff to use the constant arg stuff.
parent da308164
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/arith.lisp,v 1.28 1990/07/03 06:07:15 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/arith.lisp,v 1.29 1990/07/03 17:27:59 ram Exp $
;;; ;;;
;;; This file contains the VM definition arithmetic VOPs for the MIPS. ;;; This file contains the VM definition arithmetic VOPs for the MIPS.
;;; ;;;
...@@ -379,106 +379,74 @@ ...@@ -379,106 +379,74 @@
(:affected) (:affected)
(:policy :fast-safe)) (:policy :fast-safe))
(deftype integer-with-a-bite-out (s bite)
(cond ((eq s '*) 'integer)
((and (integerp s) (> s 1))
(let ((bound (ash 1 (1- s))))
`(integer ,(- bound) ,(- bound bite 1))))
(t
(error "Bad size specified for SIGNED-BYTE type specifier: ~S." s))))
(define-vop (fast-conditional/fixnum fast-conditional) (define-vop (fast-conditional/fixnum fast-conditional)
(:args (x :scs (any-reg)) (:args (x :scs (any-reg))
(y :scs (any-reg))) (y :scs (any-reg)))
(:arg-types tagged-num tagged-num) (:arg-types tagged-num tagged-num)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:note "inline fixnum comparison")) (:note "inline fixnum comparison"))
#+nil
(define-vop (fast-conditional-c/fixnum fast-conditional/fixnum) (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
(:arg-types tagged-num (:constant (signed-byte 14))) (:args (x :scs (any-reg)))
(:arg-types tagged-num (:constant (integer-with-a-bite-out 14 #.(fixnum 1))))
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:info target not-p y)) (:info target not-p y))
(define-vop (fast-conditional/signed fast-conditional) (define-vop (fast-conditional/signed fast-conditional)
(:args (x :scs (signed-reg)) (:args (x :scs (signed-reg))
(y :scs (signed-reg))) (y :scs (signed-reg)))
(:arg-types signed-num signed-num) (:arg-types signed-num signed-num)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:note "inline (signed-byte 32) comparison")) (:note "inline (signed-byte 32) comparison"))
#+nil
(define-vop (fast-conditional-c/signed fast-conditional/signed) (define-vop (fast-conditional-c/signed fast-conditional/signed)
(:arg-types tagged-num (:constant (signed-byte 16))) (:args (x :scs (signed-reg)))
(:arg-types signed-num (:constant (integer-with-a-bite-out 16 1)))
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:info target not-p y)) (:info target not-p y))
(define-vop (fast-conditional/unsigned fast-conditional) (define-vop (fast-conditional/unsigned fast-conditional)
(:args (x :scs (unsigned-reg)) (:args (x :scs (unsigned-reg))
(y :scs (unsigned-reg))) (y :scs (unsigned-reg)))
(:arg-types unsigned-num unsigned-num) (:arg-types unsigned-num unsigned-num)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:note "inline (unsigned-byte 32) comparison")) (:note "inline (unsigned-byte 32) comparison"))
#+nil
(define-vop (fast-conditional-c/unsigned fast-conditional/unsigned) (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
(:arg-types tagged-num (:constant (unsigned-byte 15))) (:args (x :scs (unsigned-reg)))
(:arg-types unsigned-num (:constant (and (integer-with-a-bite-out 16 1)
unsigned-byte)))
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:info target not-p y)) (:info target not-p y))
(defmacro define-conditional-vop (translate &rest generator) (defmacro define-conditional-vop (translate &rest generator)
`(progn `(progn
(define-vop (,(intern (concatenate 'simple-string ,@(mapcar #'(lambda (suffix cost signed)
"FAST-IF-" (unless (and (member suffix '(/fixnum -c/fixnum))
(string translate) (eq translate 'eql))
"/FIXNUM")) `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)"
fast-conditional/fixnum) translate suffix))
(:translate ,translate) ,(intern
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp) (format nil "~:@(FAST-CONDITIONAL~A~)"
(:generator 4 suffix)))
(let ((signed t)) (:translate ,translate)
,@generator))) (:generator ,cost
#+nil (let* ((signed ,signed)
(define-vop (,(intern (concatenate 'simple-string (-c/fixnum ,(eq suffix '-c/fixnum))
"FAST-IF-" (y (if -c/fixnum (fixnum y) y)))
(string translate) ,@generator)))))
"-C/FIXNUM")) '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned)
fast-conditional-c/fixnum) '(3 2 5 4 5 4)
(:translate ,translate) '(t t t t nil nil))))
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:generator 4
(let ((signed t)
(y (fixnum y)))
,@generator)))
(define-vop (,(intern (concatenate 'simple-string
"FAST-IF-"
(string translate)
"/SIGNED"))
fast-conditional/signed)
(:translate ,translate)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:generator 5
(let ((signed t))
,@generator)))
#+nil
(define-vop (,(intern (concatenate 'simple-string
"FAST-IF-"
(string translate)
"-C/SIGNED"))
fast-conditional-c/signed)
(:translate ,translate)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:generator 5
(let ((signed t))
,@generator)))
(define-vop (,(intern (concatenate 'simple-string
"FAST-IF-"
(string translate)
"/UNSIGNED"))
fast-conditional/unsigned)
(:translate ,translate)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:generator 5
(let ((signed nil))
,@generator)))
#+nil
(define-vop (,(intern (concatenate 'simple-string
"FAST-IF-"
(string translate)
"-C/UNSIGNED"))
fast-conditional-c/unsigned)
(:translate ,translate)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:generator 5
(let ((signed nil))
,@generator)))))
(define-conditional-vop < (define-conditional-vop <
(cond ((and signed (eql y 0)) (cond ((and signed (eql y 0))
...@@ -499,6 +467,14 @@ ...@@ -499,6 +467,14 @@
(if not-p (if not-p
(inst blez x target) (inst blez x target)
(inst bgtz x target))) (inst bgtz x target)))
((integerp y)
(let ((y (+ y (if -c/fixnum (fixnum 1) 1))))
(if signed
(inst slt temp x y)
(inst sltu temp x y))
(if not-p
(inst bne temp zero-tn target)
(inst beq temp zero-tn target))))
(t (t
(if signed (if signed
(inst slt temp y x) (inst slt temp y x)
...@@ -508,7 +484,10 @@ ...@@ -508,7 +484,10 @@
(inst bne temp zero-tn target)))) (inst bne temp zero-tn target))))
(inst nop)) (inst nop))
(define-conditional-vop = ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
;;; known fixnum.
(define-conditional-vop eql
(declare (ignore signed)) (declare (ignore signed))
(when (integerp y) (when (integerp y)
(inst li temp y) (inst li temp y)
...@@ -521,6 +500,34 @@ ...@@ -521,6 +500,34 @@
(define-vop (fast-eql/fixnum fast-conditional)
(:args (x :scs (any-reg descriptor-reg))
(y :scs (any-reg)))
(:arg-types * tagged-num)
(:note "inline fixnum comparison")
(:translate eql)
(:generator 2
(if not-p
(inst bne x y target)
(inst beq x y target))
(inst nop)))
(define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
(:args (x :scs (any-reg descriptor-reg)))
(:arg-types * (:constant (signed-byte 14)))
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
(:info target not-p y)
(:translate eql)
(:generator 3
(let ((y (cond ((eql y 0) zero-tn)
(t
(inst li temp (fixnum y))
temp))))
(if not-p
(inst bne x y target)
(inst beq x y target))
(inst nop))))
;;;; 32-bit logical operations ;;;; 32-bit logical operations
...@@ -806,4 +813,3 @@ ...@@ -806,4 +813,3 @@
(define-static-function two-arg-and (x y) :translate logand) (define-static-function two-arg-and (x y) :translate logand)
(define-static-function two-arg-ior (x y) :translate logior) (define-static-function two-arg-ior (x y) :translate logior)
(define-static-function two-arg-xor (x y) :translate logxor) (define-static-function two-arg-xor (x y) :translate logxor)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment