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

;;; Reason: Fix code generated by COMPILE-FILE for instance variable references
;;; near the end of a flavor method that references a large number of
;;; constants.  [SPR 10436]


;;;                           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 09/26/89 16:06:23 by GRAY,
;;; while running on Kelvin from band LOD2
;;; With SYSTEM 6.15, VIRTUAL-MEMORY 6.1, 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.2, 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.10, TV 6.15, 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.5,
;;;  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.4, TI-CLOS 6.20, CLEH 6.5, IP 3.48,
;;;  Experimental CLX 6.2, CLUE 6.10, X11M 6.13, Experimental BUG 11.15, Experimental DOCUMENTER 701.0,
;;;   microcode 429, Band Name: 6.0+Scribe,&c,u430 9/6


;;; BUG REPORT NUMBER:  10436.
;;;
;;; PROBLEM:  Bad object code in FEFs for flavor methods compiled to an XLD 
;;;	file when there are many constants referenced and there is an instance 
;;;	variable referenced for the first time near the end of the method.
;;;	The disassembly shows a PUSH-LONG-FEF instruction with a bogus offset.
;;;
;;;	There are actually two problems.  One is that, in the loader, 
;;;	function SYS::FEF-CONVERT-ADDRESSES is incorrectly handling PUSH-LONG-FEF 
;;;	instructions.  That is SPR 10424, which is being fixed by a separate patch.
;;;	The other problem, which is fixed here, is that the compiler is trying to 
;;;	use a PUSH-LONG-FEF to store into an instance variable.
;;;
;;; SOLUTION:
;;;	In COMPILER::P2-DESTINATION, when generating code to store into an
;;;	instance variable using a QUOTE-VECTOR reference, record the SELF-REF
;;;	form in a list in the *CURRENT-COMPILAND* plist.  Then, in
;;;	COMPILER::SCAN-ARGS [during QLAPP pass 1], that list of destination
;;;	SELF-REFs is used as the initial value for QUOTE-LIST.  This causes them
;;;	to be allocated FEF offsets following special variables but before other
;;;	constants so that they are not out of range for a POP or MOVEM
;;;	instruction.

#!C
; From file DEFS.LISP#> SYS6.COMPILER; Kelvin:
#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; DEFS.#"


1(DEFSUBST COMPILAND-INITIAL-QUOTE-LIST (COMPILAND)
  ;; List of items that need to go at the beginning of the FEF constants.
  ;;  9/26/89 DNG - Original - part of fix for SPR 10436.
  (GETF (COMPILAND-PLIST COMPILAND) 'INITIAL-QUOTE-LIST NIL))*
))

#!C
; From file P2FUNS.LISP#> SYS6.COMPILER; Kelvin:
#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; P2FUNS.#"


(DEFUN P2-DESTINATION (FORM)
 ;; 12/26/84 DNG - New function created -- similar to P2-SOURCE, but the
 ;;                form is a variable which will be altered by the instruction.
 ;;  3/29/85 DNG - Add call to SELF-REF-POINTER.
 ;;  9/13/85 DNG - Remove mapping table checking; allow IVAR destination
 ;;                address for release 3.
 ;; 12/22/86 DNG - Fix for LEXICAL-REF re-allocated by EXTEND-LOCAL-VARIABLES.
 ;;  9/29/87 DNG - For Scheme, allow symbol function cell to be used as a destination.
 ;;  5/09/88 DNG - For CLOS, add support for %STANDARD-INSTANCE-REF .
1 ;;  9/26/89 DNG - Collect SELF-REF forms in INITIAL-QUOTE-LIST -- part of fix for SPR 10436.*
  (COND ((ATOM FORM)
	 (IF (NULL FORM)
	     (BARF FORM "Bad destination variable in pass 2" 'BARF)
	   `(SPECIAL ,FORM)))
	((EQ (CAR FORM) 'LOCAL-REF)
	 (LET ((A (VAR-LAP-ADDRESS (SECOND FORM))))
	   (IF (EQ (CAR A) 'LEXICAL-REF) ; variable re-allocated by EXTEND-LOCAL-VARIABLES 
	       (P2-SOURCE A 'D-STORE)
	     A)))
	((AND (EQ (CAR FORM) 'SELF-REF)	   ; flavor instance variable
	      (COMPILING-FOR-V2)
	      IVAR-ADDRESS-ENABLE
	      (<= (OPT-SAFETY OPTIMIZE-SWITCH)
		  (OPT-SPEED OPTIMIZE-SWITCH))
	      (NOT (AND QC-FILE-IN-PROGRESS
			(NOT QC-FILE-LOAD-FLAG)))
	      (LET* ((SRP (SI:FLAVOR-VAR-SELF-REF-INDEX (CDR FORM)))
		     (INDEX (LDB %%SELF-REF-INDEX SRP)))
		(AND (NOT (LDB-TEST %%SELF-REF-MAP-LEADER-FLAG SRP))
		     (< INDEX 32)
		     (IF (LDB-TEST %%SELF-REF-RELOCATE-FLAG SRP)
			 (IF (< INDEX 24)
			     `(SELF-MAP ,INDEX)
			   NIL)
		       `(SELF-UNMAPPED ,INDEX))))))
	((EQ (CAR FORM) 'SELF-REF)
	 1;; Put these at the beginning of the FEF constants area because we can't use *
	 ;; 1PUSH-LONG-FEF to do a store.*
	 1(PUSHNEW FORM (COMPILAND-INITIAL-QUOTE-LIST *CURRENT-COMPILAND*) :TEST #'EQUAL)*
	 `(QUOTE-VECTOR ,FORM))
	((EQ (CAR FORM) '%STANDARD-INSTANCE-REF)
	 (INSTANCE-REF-HANDLER (CDR FORM)))
	((EQ (CAR FORM) 'FUNCTION) ; this is used only by SCHEME:SET!
	 `(QUOTE-VECTOR ,FORM))
	(T (BARF FORM "Bad destination variable in pass 2" 'BARF)) ))
))

#!C
; From file LAP.LISP#> SYS6.COMPILER; Kelvin:
#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; LAP.#"


(DEFUN SCAN-ARGS ()
 ;;  1/08/86 DNG - Use DOLIST instead of DO.
 ;;  4/25/89 DNG - Eliminate use of VAR-EVAL and HAIRY-INIT-FLAG.
1 ;;  9/26/89 DNG - Add initialization of QUOTE-LIST from INITIAL-QUOTE-LIST -- part of fix for SPR 10436.
  (DEBUG-ASSERT (NULL QUOTE-LIST))
  (SETQ QUOTE-LIST (COMPILAND-INITIAL-QUOTE-LIST *CURRENT-COMPILAND*)) ; from P2-DESTINATION
  (SETQ QUOTE-COUNT (SETQ QUOTE-LIST-LENGTH (LENGTH QUOTE-LIST)))*
  (DOLIST (V ALLVARS)
    (CASE (VAR-KIND V)
      (FEF-ARG-REQ (SETQ MAX-ARGS (1+ MAX-ARGS)) (SETQ MIN-ARGS (1+ MIN-ARGS)))
      (FEF-ARG-OPT (SETQ MAX-ARGS (1+ MAX-ARGS)))
      (FEF-ARG-REST (SETQ REST-ARG V)))
    )
  (WHEN (MEMBER '&QUOTE (COMPILAND-ARGLIST *CURRENT-COMPILAND*) :TEST #'EQ)
    (SETQ SM-ARGS-NOT-EVALD T))
  (VALUES))
))