;;; -*- Mode:Common-Lisp; Package:COMPILER; Base:10; Patch-file:T; Fonts:(CPTFONT CPTFONTB) -*-

;;; Reason: Fix a bug in SETQ optimization that could cause local variables to share 
;;; storage when they shouldn't.  [SPR 10282]

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 149149, M/S 2151             
;;;   AUSTIN, TEXAS 78714
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 07/18/89 16:45:26 by GRAY,
;;; while running on Kelvin from band LOD2
;;; With SYSTEM 6.13, VIRTUAL-MEMORY 6.1, Inconsistent EH 6.4, MAKE-SYSTEM 6.0, MICRONET 6.0,
;;;  LOCAL-FILE 6.0, BASIC-PATHNAME 6.1, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.1,
;;;  NETWORK-NAMESPACE 6.0, DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.2, MAC-PATHNAME 6.0,
;;;  NETWORK-PATHNAME 6.0, COMPILER 6.9, TV 6.14, DATALINK 6.0, CHAOSNET 6.0, GC 6.3,
;;;  MEMORY-AUX 6.0, NVRAM 6.1, SYSLOG 6.1, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0,
;;;  METER 6.1, ZWEI 6.4, DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1,
;;;  DATALINK-DISPLAYS 6.0, FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1,
;;;  PRINTER-TYPES 6.1, IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.2,
;;;  TELNET 6.0, VT100 6.0, NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.2, Inconsistent TI-CLOS 6.19,
;;;  Inconsistent CLEH 6.5, IP 3.47, Experimental BUG 11.10, Experimental CLX 6.2,
;;;  CLUE 6.5, X11M 6.13, Experimental DOCUMENTER 6.0,  microcode 429, Band Name: 6.0,
;;; Scribe,XNS,&c u429 7/14

;;; BUG REPORT NUMBER:  10282
;;;
;;; PROBLEM:  Incorrect code generated by the compiler; two local variables 
;;;	appear in the same local variable slot even though both are in use at the 
;;;	same time.  For example, in
;;;		(LET (TRIGGER X)
;;;		  (LET ((TEMP (SOMETHING)))
;;;		    (SETQ X TEMP))
;;;		  (LET ((TEMP (SOMETHING-ELSE)))
;;;		    (SETQ TRIGGER TEMP))
;;;		  (LIST (LIST 'TRIGGER TRIGGER)
;;;			(LIST 'X X)))
;;;	the values for X and TRIGGER are both stored in the same local variable 
;;;	slot.  This is a new problem in release 6.0.
;;;
;;; DIAGNOSIS:  This is a problem in the new optimization for optimizing 
;;;	variables that are initialized by SETQ.  What happens in the example above 
;;;	is that X is replaced by the first TEMP and TRIGGER is replaced by the 
;;;	second TEMP and the two variables named TEMP are assigned the same slot 
;;;	because they have the same name and disjoint lifetimes.
;;;
;;; SOLUTION:  Don't replace a variable with its initial value if the scope of 
;;;	the initial value variable is not outside the scope of the variable being 
;;;	assigned.  Thus, in the example above, the scope of TEMP lies inside the 
;;;	scope of X, so X cannot be replaced by TEMP.  
;;;
;;;	This is implemented by a change to COMPILER::MAYBE-PROPAGATE to add a 
;;;	clause comparing the var bits of the two local variables -- a smaller var 
;;;	bit value implies an outer binding level.  The code added is shown in 
;;;	boldface in the patch below.

#!C
; From file P1FUNS.LISP#> COMPILER; MR-X:
#10R COMPILER#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "COMPILER"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: COMPILER; P1FUNS.#"

(DEFUN MAYBE-PROPAGATE (HOME)
  ;; The argument should be a FEF-LOCAL FEF-ARG-INTERNAL-AUX variable.
  ;; If appropriate, enable propagation of the initial value and return true, else returns NIL.
  ;;  5/03/89 DNG - Original version of this function separated from VAR-COMPUTE-INIT .
1  ;;  7/18/89 DNG - When initial value is another local variable, check that 
  ;;*		1its scope is outside that of the variable being initialized.  [SPR 10282]*
  (LET ((INIT-DATA (VAR-INIT-FORM HOME)))
    (WHEN (OR (NULL INIT-DATA)
	      (AND (CONSP INIT-DATA)
		   (OR (MEMBER (FIRST INIT-DATA)
			       '(QUOTE BREAKOFF-FUNCTION) :TEST #'EQ)
		       (AND (EQ (FIRST INIT-DATA) 'FUNCTION)
			    (NOT (COMPILING-SCHEME-P)))
		       (AND (EQ (FIRST INIT-DATA) 'LOCAL-REF)
			    (LET ((V (SECOND INIT-DATA)))
			      ;; Need to make sure that the variable can't be altered
			      ;; by a lexical closure.  [SPR 6881]  This is over-kill,
			      ;; but is necessary because the current bookkeeping
			      ;; doesn't recognize that an arbitrary function call could
			      ;; end up invoking some lexical closure.
			      (AND (NOT (MEMBER 'FEF-ARG-ALTERED-IN-LEXICAL-CLOSURES ; from BREAKOFF
						(VAR-MISC V)))
				   (EQ (VAR-COMPILAND V) *CURRENT-COMPILAND*)))
			    1(< (CDDR INIT-DATA) (CDDR (VAR-LAP-ADDRESS HOME))) ; 7/18/89*
			    ))))
      ;; Record this variable as eligible to have references to it replaced 
      ;;  by the variable's initial value. 
      (SETQ PROPAGATE-VAR-SET (LOGIOR PROPAGATE-VAR-SET (CDDR (VAR-LAP-ADDRESS HOME))))
      (WHEN (EQ (FIRST INIT-DATA) 'LOCAL-REF)
	(SETQ SUBST-VAR-SET (LOGIOR SUBST-VAR-SET (CDDR INIT-DATA))) )
      T)))

))