From 668c1a4ca89aad16ac083d4493187c015a095969 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sat, 12 Jun 1993 20:35:44 +0000 Subject: [PATCH] Lots of tweeks in order to use NIL and 0 directly from the registers holding them instead of copying them into a new register and then using it. --- compiler/mips/alloc.lisp | 4 ++-- compiler/mips/array.lisp | 5 +++-- compiler/mips/cell.lisp | 12 ++++++------ compiler/mips/insts.lisp | 5 ++++- compiler/mips/memory.lisp | 6 +++--- compiler/mips/move.lisp | 21 +++++++++++++-------- compiler/mips/pred.lisp | 22 +++++----------------- compiler/mips/static-fn.lisp | 4 ++-- 8 files changed, 38 insertions(+), 41 deletions(-) diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp index 8b782f303..94faa47dc 100644 --- a/compiler/mips/alloc.lisp +++ b/compiler/mips/alloc.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.24 1993/05/27 05:00:40 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.25 1993/06/12 20:34:33 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -191,7 +191,7 @@ ;;; The compiler likes to be able to directly make value cells. ;;; (define-vop (make-value-cell) - (:args (value :to :save :scs (descriptor-reg any-reg))) + (:args (value :to :save :scs (descriptor-reg any-reg null zero))) (:temporary (:scs (non-descriptor-reg)) temp) #-gengc (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) (:results (result :scs (descriptor-reg))) diff --git a/compiler/mips/array.lisp b/compiler/mips/array.lisp index d1034be78..224b1a98b 100644 --- a/compiler/mips/array.lisp +++ b/compiler/mips/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.41 1993/05/25 19:07:19 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.42 1993/06/12 20:35:23 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -154,7 +154,8 @@ ); eval-when (compile eval) -(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg) +(def-full-data-vector-frobs simple-vector * + descriptor-reg any-reg null zero) (def-partial-data-vector-frobs simple-string base-char :byte nil base-char-reg) diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp index 3a9131a44..ad556bd89 100644 --- a/compiler/mips/cell.lisp +++ b/compiler/mips/cell.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.73 1993/05/20 13:35:48 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.74 1993/06/12 20:35:26 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -34,7 +34,7 @@ (define-vop (set-slot) (:args (object :scs (descriptor-reg)) - (value :scs (descriptor-reg any-reg))) + (value :scs (descriptor-reg any-reg null zero))) (:info name offset lowtag #+gengc remember) (:ignore name) (:results) @@ -243,7 +243,7 @@ (define-full-setter set-funcallable-instance-info * funcallable-instance-info-offset function-pointer-type - (descriptor-reg any-reg) * %set-funcallable-instance-info) + (descriptor-reg any-reg null zero) * %set-funcallable-instance-info) (define-full-reffer funcallable-instance-info * funcallable-instance-info-offset function-pointer-type @@ -297,7 +297,7 @@ instance-pointer-type (descriptor-reg any-reg) * %instance-ref) (define-full-setter instance-index-set * instance-slots-offset - instance-pointer-type (descriptor-reg any-reg) * %instance-set) + instance-pointer-type (descriptor-reg any-reg null zero) * %instance-set) @@ -307,7 +307,7 @@ (descriptor-reg any-reg) * code-header-ref) (define-full-setter code-header-set * 0 other-pointer-type - (descriptor-reg any-reg) * code-header-set) + (descriptor-reg any-reg null zero) * code-header-set) @@ -345,7 +345,7 @@ (move res arg))) (define-vop (mutator-descriptor-set mutator-ub32-set) - (:args (arg :scs (any-reg descriptor-reg) :target res)) + (:args (arg :scs (any-reg descriptor-reg null zero) :target res)) (:arg-types *) (:results (res :scs (any-reg descriptor-reg))) (:result-types *)) diff --git a/compiler/mips/insts.lisp b/compiler/mips/insts.lisp index 7be547778..86c1e3792 100644 --- a/compiler/mips/insts.lisp +++ b/compiler/mips/insts.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.48 1993/05/21 21:31:18 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.49 1993/06/12 20:35:29 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -56,6 +56,9 @@ (fixup) (tn (ecase (sb-name (sc-sb (tn-sc loc))) + (immediate-constant + ;; Can happen if $ZERO or $NULL are passed in. + nil) (registers (unless (zerop (tn-offset loc)) (tn-offset loc))) diff --git a/compiler/mips/memory.lisp b/compiler/mips/memory.lisp index 04b98b6cf..703ba3441 100644 --- a/compiler/mips/memory.lisp +++ b/compiler/mips/memory.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/memory.lisp,v 1.14 1993/01/13 16:06:43 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/memory.lisp,v 1.15 1993/06/12 20:35:32 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -35,7 +35,7 @@ ;;; (define-vop (cell-set) (:args (object :scs (descriptor-reg)) - (value :scs (descriptor-reg any-reg))) + (value :scs (descriptor-reg any-reg null zero))) (:variant-vars offset lowtag) #+gengc (:info remember) (:policy :fast-safe) @@ -61,7 +61,7 @@ ;;; (define-vop (slot-set) (:args (object :scs (descriptor-reg)) - (value :scs (descriptor-reg any-reg))) + (value :scs (descriptor-reg any-reg null zero))) (:variant-vars base lowtag) (:info offset #+gengc remember) (:generator 4 diff --git a/compiler/mips/move.lisp b/compiler/mips/move.lisp index 15cc0c2d1..8ed2ae71e 100644 --- a/compiler/mips/move.lisp +++ b/compiler/mips/move.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/move.lisp,v 1.33 1993/01/13 16:05:52 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/move.lisp,v 1.34 1993/06/12 20:35:34 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -65,7 +65,7 @@ (loadw y nfp (tn-offset x)))) (define-move-function (store-stack 5) (vop x y) - ((any-reg descriptor-reg) (control-stack)) + ((any-reg descriptor-reg null zero) (control-stack)) (store-stack-tn y x)) (define-move-function (store-number-stack 5) (vop x y) @@ -81,17 +81,22 @@ ;;; (define-vop (move) (:args (x :target y - :scs (any-reg descriptor-reg) + :scs (any-reg descriptor-reg zero null) :load-if (not (location= x y)))) - (:results (y :scs (any-reg descriptor-reg) + (:results (y :scs (any-reg descriptor-reg control-stack) :load-if (not (location= x y)))) (:effects) (:affected) (:generator 0 - (move y x))) + (unless (location= x y) + (sc-case y + ((any-reg descriptor-reg) + (inst move y x)) + (control-stack + (store-stack-tn y x)))))) (define-move-vop move :move - (any-reg descriptor-reg) + (any-reg descriptor-reg zero null) (any-reg descriptor-reg)) ;;; Make Move the check VOP for T so that type check generation doesn't think @@ -105,7 +110,7 @@ ;;; (define-vop (move-argument) (:args (x :target y - :scs (any-reg descriptor-reg)) + :scs (any-reg descriptor-reg null zero)) (fp :scs (any-reg) :load-if (not (sc-is y any-reg descriptor-reg)))) (:results (y)) @@ -117,7 +122,7 @@ (storew x fp (tn-offset y)))))) ;;; (define-move-vop move-argument :move-argument - (any-reg descriptor-reg) + (any-reg descriptor-reg null zero) (any-reg descriptor-reg)) diff --git a/compiler/mips/pred.lisp b/compiler/mips/pred.lisp index 8e5fd56c4..4b0f18ecb 100644 --- a/compiler/mips/pred.lisp +++ b/compiler/mips/pred.lisp @@ -1,4 +1,4 @@ -;;; -*- Package: C; Log: C.Log -*- +;;; -*- Package: MIPS -*- ;;; ;;; ********************************************************************** ;;; This code was written as part of the CMU Common Lisp project at @@ -7,12 +7,10 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/pred.lisp,v 1.6 1991/02/20 15:15:00 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/pred.lisp,v 1.7 1993/06/12 20:35:40 wlott Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/pred.lisp,v 1.6 1991/02/20 15:15:00 ram Exp $ -;;; ;;; This file contains the VM definition of predicate VOPs for the MIPS. ;;; ;;; Written by Rob MacLachlan @@ -37,8 +35,6 @@ ;;;; Conditional VOPs: -;if-true (???), if-eql, ... - (define-vop (if-eq) (:args (x :scs (any-reg descriptor-reg zero null)) (y :scs (any-reg descriptor-reg zero null))) @@ -47,17 +43,9 @@ (:policy :fast-safe) (:translate eq) (:generator 3 - (let ((x-prime (sc-case x - ((any-reg descriptor-reg) x) - (zero zero-tn) - (null null-tn))) - (y-prime (sc-case y - ((any-reg descriptor-reg) y) - (zero zero-tn) - (null null-tn)))) - (if not-p - (inst bne x-prime y-prime target) - (inst beq x-prime y-prime target))) + (if not-p + (inst bne x y target) + (inst beq x y target)) (inst nop))) diff --git a/compiler/mips/static-fn.lisp b/compiler/mips/static-fn.lisp index f00057c8f..f3b5c81aa 100644 --- a/compiler/mips/static-fn.lisp +++ b/compiler/mips/static-fn.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/static-fn.lisp,v 1.19 1993/01/13 16:03:23 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/static-fn.lisp,v 1.20 1993/06/12 20:35:44 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -77,7 +77,7 @@ (let ((arg-name (intern (format nil "ARG-~D" i)))) (arg-names arg-name) (args `(,arg-name - :scs (any-reg descriptor-reg) + :scs (any-reg descriptor-reg null zero) :target ,(nth i (temp-names)))))) `(define-vop (,(static-function-template-name num-args num-results) static-function-template) -- GitLab