;;;;  -*- Mode:Common-Lisp; Package:COMPILER2; Base:10 -*-

;;;			      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 2909
;;;			      AUSTIN, TEXAS 78769
;;;				    MS 2151
;;;
;;; Copyright (C) 1985-1989 Texas Instruments Incorporated. All rights reserved.
;;; Copyright (C) 1980 Massachusetts Institute of Technology

;;;;   *-----------------------------------------------------------*
;;;;   |          --  TI Explorer Lisp Compiler  --                |
;;;;   |  This file contains definitions for pass 2.		   |
;;;;   *-----------------------------------------------------------*

;;; Revision history:
;;; Feb. 1984 - Version 98 from MIT via LMI.
;;; July '84 through 4/30/85 - TI modifications for Explorer release 1.0.
;;; 06/26/85 - Minor modifications to improve speed of compilation.
;;; 07/10/85 - For release 3, file QCP2 split into P2DEFS, P2FUNS, and P2HAND.
;;; 08/24/85 - Added KEEP-CURRENT-FRAME.
;;; 09/23/85 - Moved inline function ADRREFP to this file.
;;; 12/07/85 - Added new function MAKE-LAP-TAG.
;;;  1/09/86 - Added new variable ENVIRONMENT-DESCRIPTOR-LIST.
;;;  2/01/86 - Moved macro NO-D-RETURN to here.
;;;  3/25/86 - Converted from Zetalisp to Common Lisp.
;;;  8/08/86 - New variable *LEXICAL-REGISTER-LEVELS*.

;;;   ---  Variables  ---

;PDLLVL, on pass 2, is the current level of the PDL above the last local
;(number of temporary slots).  It isn't always updated by things which
;push and pop on a very local basis, but function calls, etc. update it.
;MAXPDLLVL is the largest value ever attained by PDLLVL.
;It goes into the FEF to say how large a stack frame is needed.
;The function MKPDLLVL sets PDLLVL and updates MXPDLLVL if necessary.
;INCPDLLVL increments PDLLVL by one, updating MXPDLLVL.
(PROCLAIM '(SPECIAL PDLLVL MAXPDLLVL))
;NEEDPDL just says we need <n> more words of room on the pdl beyond what is there now.
(DEFMACRO NEEDPDL (N) `(SETQ MAXPDLLVL (MAX MAXPDLLVL (+ PDLLVL ,N))))

;CALL-BLOCK-PDL-LEVELS is a list of the PDLLVL's corresponding to the open
;call blocks.  PDLLVL is pushed on this stack before a call block is pushed
;and popped when one is popped (ie, the D-LAST is compiled).
;This is used so that we can see how many call blocks lie above
;a given old PDLLVL, so that we can compile instructions to pop call blocks
;rather than just pdl words (though this isn't implemented now).
;The reason for that is that if CALL is open-compiled someday then %SPREAD
;will push an unknown number of args on the pdl.  Each %SPREAD will just increment
;the stack by one.  Popping a fixed number of words loses when popping these,
;but it turns out that you never want to pop one of them without also popping
;the call block that contains it.
;So if we compile using popping call blocks, it will work!

;Each element actually is either just a number or
;a list (pdllvl flag tag).  Flag can be either NIL or UNWIND-PROTECT.
(DEFVAR CALL-BLOCK-PDL-LEVELS)

;T on pass 2 if within a catch.  unwind-protects are counted also.
(DEFVAR WITHIN-CATCH)

;DROPTHRU on pass 2 is T if the code now being output can be reached.
;Code which cannot be reached is discarded at a low level.
(DEFVAR DROPTHRU)

;TAGOUT (on pass 2) is true when within a potential loop.
;While TAGOUT is NIL, setting a local variable to NIL can be flushed.
(DEFVAR TAGOUT)

;P2FN on pass 2 is the function we are compiling a call to.
;Pass 2 handler functions are normally passed the arglist and destination
;as arguments, since that makes most of them simpler.
;Those that handle more than one function find the function name in P2FN.
(DEFVAR P2FN)

;BDEST on pass 2 is the branch destination of the current form, or a tag destination.
;See P2BRANCH.
(DEFVAR BDEST)

;M-V-TARGET on pass 2 says whether and how the function call now being compiled
;is supposed to return multiple values.  It is NIL for an ordinary call
;from which only one value is expected.  Other things it can be are
;MULTIPLE-VALUE-LIST, or a number of values to just leave on the stack on return,
;or THROW meaning the values (except for the last one) should be thrown to a tag
;(which is at the top of the stack before execution of this expression)
;or RETURN meaning return the values (except for the last one) from the active frame,
;but do not return control, and leave the last value on the pdl instead.

;In the THROW or RETURN case, the caller still gets one value back on the stack
;just as if he were not asking for multiple values.  However, additional
;values may have been returned via the ADI of some frame, as a side effect.

;See P2MV for more information.
(DEFVAR M-V-TARGET)

(comment ; removed 4/5/89 - DNG
  ;; List of local block offsets for which a STACK-CLOSURE-DISCONNECT should be
  ;; done at the end of the current binding level.  [VM1 only]
  (DEFVAR CLOSURE-DISCONNECT-OFFSETS)
  )

(DEFVAR KEEP-CURRENT-FRAME) ; Tail calls can overlay current frame when this is NIL.

(DEFVAR ENVIRONMENT-DESCRIPTOR-LIST) ; first argument to MAKE-LEXICAL-CLOSURE instruction

;; When not null, the first element of this list is the relative lexical level
;; addressed by the LEX-A register and the second element is the level addressed
;; by the LEX-B register.
(DEFVAR *LEXICAL-REGISTER-LEVELS* NIL)

;;used in CATCH, UNWIND-PROTECT, and POPPDL
(DEFCONSTANT CATCH-BLOCK-SIZE 5)

;;;   ---  Macros, etc.  ---

;; Compile code to compute FORM and leave the result on the PDL.
(DEFSUBST P2PUSH (FORM) (P2 FORM 'D-PDL))

(PROCLAIM '(INLINE ADRREFP))
(DEFUN ADRREFP (EXP) 			       ;PREDICATE T IF CAN BE REF BY ADR ONLY
  (OR (ATOM EXP)
      (MEMBER (CAR EXP) '(LOCAL-REF QUOTE FUNCTION BREAKOFF-FUNCTION SELF-REF)
	      :TEST #'EQ) ))

(DEFMACRO NO-D-RETURN ( &BODY BODY )
  ;; Prevent generating instruction with D-RETURN.
  ;;  8/19/85 - Original version.
  `(LET (( DEST1 DEST ))
     (WHEN (AND (EQ DEST 'D-RETURN)
		(COMPILING-FOR-V2))
       (SETQ DEST 'D-PDL) )
     (PROGN . ,BODY)
     (UNLESS (EQ DEST DEST1)
       (OUTI `(MOVE D-RETURN PDL-POP)) ) ) )

(DEFSUBST MAKE-LAP-TAG () (GENSYM) ) ; construct a unique LAP branch tag

(DEFMACRO OUTM (INSTR)
  "Output a MISC instruction."
  (LET (WD)
    (IF (OR (WHEN-SUPPORTING-CROSS-COMPILATION T)
	    #+compiler:debug T
	    (NOT (QUOTEP INSTR))
	    (NOT (EQ (FIRST (SETQ WD (SECOND INSTR))) 'MISC))
	    (NOT (SYMBOLP (THIRD WD))))
	`(OUTI ,INSTR)
      `(OUTI '(MISC ,(SECOND WD) ,(MISC-LAP-CODE (THIRD WD)) . ,(CDDDR WD)))
      )))