From d65d552144ddc22b498ea53eb030c9fea101b63d Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 3 Jul 1990 17:27:59 +0000 Subject: [PATCH] Changed the basic numeric equality to be EQL, and changed the numeric comparison stuff to use the constant arg stuff. --- compiler/mips/arith.lisp | 152 ++++++++++++++++++++------------------- 1 file changed, 79 insertions(+), 73 deletions(-) diff --git a/compiler/mips/arith.lisp b/compiler/mips/arith.lisp index 0b0ec1b81..68857938b 100644 --- a/compiler/mips/arith.lisp +++ b/compiler/mips/arith.lisp @@ -7,7 +7,7 @@ ;;; 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. ;;; @@ -379,106 +379,74 @@ (:affected) (: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) (:args (x :scs (any-reg)) (y :scs (any-reg))) (:arg-types tagged-num tagged-num) + (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp) (:note "inline fixnum comparison")) -#+nil (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)) (define-vop (fast-conditional/signed fast-conditional) (:args (x :scs (signed-reg)) (y :scs (signed-reg))) (:arg-types signed-num signed-num) + (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp) (:note "inline (signed-byte 32) comparison")) -#+nil (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)) (define-vop (fast-conditional/unsigned fast-conditional) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg))) (:arg-types unsigned-num unsigned-num) + (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp) (:note "inline (unsigned-byte 32) comparison")) -#+nil (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)) (defmacro define-conditional-vop (translate &rest generator) `(progn - (define-vop (,(intern (concatenate 'simple-string - "FAST-IF-" - (string translate) - "/FIXNUM")) - fast-conditional/fixnum) - (:translate ,translate) - (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp) - (:generator 4 - (let ((signed t)) - ,@generator))) - #+nil - (define-vop (,(intern (concatenate 'simple-string - "FAST-IF-" - (string translate) - "-C/FIXNUM")) - fast-conditional-c/fixnum) - (:translate ,translate) - (: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))))) + ,@(mapcar #'(lambda (suffix cost signed) + (unless (and (member suffix '(/fixnum -c/fixnum)) + (eq translate 'eql)) + `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" + translate suffix)) + ,(intern + (format nil "~:@(FAST-CONDITIONAL~A~)" + suffix))) + (:translate ,translate) + (:generator ,cost + (let* ((signed ,signed) + (-c/fixnum ,(eq suffix '-c/fixnum)) + (y (if -c/fixnum (fixnum y) y))) + ,@generator))))) + '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) + '(3 2 5 4 5 4) + '(t t t t nil nil)))) (define-conditional-vop < (cond ((and signed (eql y 0)) @@ -499,6 +467,14 @@ (if not-p (inst blez 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 (if signed (inst slt temp y x) @@ -508,7 +484,10 @@ (inst bne temp zero-tn target)))) (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)) (when (integerp y) (inst li temp y) @@ -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 @@ -806,4 +813,3 @@ (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-xor (x y) :translate logxor) - -- GitLab