From 4604ec0214879f2fe9fd24300db5c63bc4e26fbc Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 3 May 1991 12:55:18 +0000 Subject: [PATCH] Changed to ignore SET and TYPE-CHECK-ERROR (in addition to MOVE) when selecting representation. Changed to not print notes about coercions for TYPE-CHECK-ERROR. --- compiler/represent.lisp | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/compiler/represent.lisp b/compiler/represent.lisp index 54c77eb2f..49250fb85 100644 --- a/compiler/represent.lisp +++ b/compiler/represent.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/represent.lisp,v 1.25 1991/05/03 02:05:21 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/represent.lisp,v 1.26 1991/05/03 12:55:18 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -238,6 +238,19 @@ (check-move-function-consistency) +;;;; Representation selection: + +;;; VOPs that we ignore in initial cost computation. We ignore MOVE because +;;; moves will be changed to appropriate representation specific moves, so +;;; looking at the costs of the standard MOVE will just confuse us. We ignore +;;; SET in the hopes that nobody is setting specials inside of loops. We +;;; ignore TYPE-CHECK-ERROR because we don't want the possibility of error to +;;; bias the result. Notes are suppressed for T-C-E as well, since we don't +;;; need to worry about the efficiency of that case. +;;; +(defconstant ignore-cost-vops '(move set type-check-error)) +(defconstant suppress-note-vops '(type-check-error)) + ;;; SELECT-TN-REPRESENTATION -- Internal ;;; ;;; Return the best representation for a normal TN. SCs is a list of the SC @@ -259,7 +272,7 @@ ((null ref)) (let* ((vop (tn-ref-vop ref)) (info (vop-info vop))) - (unless (eq (vop-info-name info) 'move) + (unless (member (vop-info-name info) ignore-cost-vops) (do ((cost (,costs-slot info) (cdr cost)) (op (,ops-slot vop) (tn-ref-across op))) ((null cost) @@ -354,16 +367,18 @@ (*compiler-error-context* op-node)) (cond ((eq (tn-kind op-tn) :constant)) ((policy op-node (<= speed brevity) (<= space brevity))) + ((member (template-name (vop-info op-vop)) suppress-note-vops)) ((null dest-tn) (let* ((op-info (vop-info op-vop)) (op-note (or (template-note op-info) (template-name op-info))) (arg-p (not (tn-ref-write-p op))) (name (get-operand-name op-tn arg-p)) - (pos (1+ (position-in #'tn-ref-across op - (if arg-p - (vop-args op-vop) - (vop-results op-vop)))))) + (pos (1+ (or (position-in #'tn-ref-across op + (if arg-p + (vop-args op-vop) + (vop-results op-vop))) + (error "Couldn't fine op? Bug!"))))) (compiler-note "Doing ~A (cost ~D)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~ The ~:R ~:[result~;argument~] of ~A." -- GitLab