LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760030390. :SYSTEM-TYPE :LOGICAL :VERSION 4. :TYPE "LISP" :NAME "P2DEFS" :DIRECTORY ("REL3-SOURCE" "COMPILER") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758302844. :AUTHOR "REL3" :LENGTH-IN-BYTES 6606. :LENGTH-IN-BLOCKS 7. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ;;;;  -*- 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 (b)(3)(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,1987 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);; 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)))      ))) (funcall replacement form) ))   (when (stringp line-2)     ;; then we did find something to print, so prepend first line and issue warning     (warn 'SUPERSEDED :OBSOLETE   "Function ~S (or at least this usage if it) ~                  has been superseded by Common Lisp;~%  ~A."   function   line-2))) ))  ; end cond      ))   ;when  NIL  )   ;superseded(DEFMACRO MAKE-SUPERSEDED (function replacement)  "Mark FUNCTION (which is not evaluated) as an otherwise valid function that has beensuperseded by a new Common Lisp function.  W