LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760030351. :SYSTEM-TYPE :LOGICAL :VERSION 4. :TYPE "LISP" :NAME "MACLISP" :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 2758302631. :AUTHOR "REL3" :LENGTH-IN-BYTES 7708. :LENGTH-IN-BLOCKS 8. :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) 1980 Massachusetts Institute of Technology; Copyright (C) 1984,1987 Texas Instruments Incorporated. All rights reserved.;;;;   *-----------------------------------------------------------*;;;;   |           --  TI Explorer Lisp Compiler  --               |;;;;   |  This file contains portions of the compiler that are     |;;;;   |  concerned with supporting compatibility with MacLisp.    |;;;;   |  This file does not need to be loaded unless MacLisp      |;;;;   |  support is needed.   |;;;;   *-----------------------------------------------------------*;;;  7/26/85 DNG - File QCOPT split into files P1OPT, P1STYLE, and MACLISP.;;;  8/17/85 DNG - Include *LEXPR, *EXPR, and *FEXPR.;;;  4/06/86 DNG - Converted from Zetalisp to Common Lisp.;;;  5/10/86 DNG - Moved handling of MacLisp CATCH and THROW to here.(DEFUN *LEXPR (&QUOTE &REST L)  (DOLIST (X L)    (COMPILATION-DEFINE X)    (SETF (GET X 'ARGDESC)  '((#o1005 (FEF-ARG-OPT FEF-QT-EVAL))))))(DEFUN *EXPR (&QUOTE &REST L)  (DOLIST (X L)    (COMPILATION-DEFINE X)    (SETF (GET X 'ARGDESC)  '((#o1005 (FEF-ARG-OPT FEF-QT-EVAL))))))(DEFUN *FEXPR (&QUOTE &REST L)  (DOLIST (X L)    (COMPILATION-DEFINE X)    (SETF (GET X 'ARGDESC)  '((#o1005 (FEF-ARG-OPT FEF-QT-QT))))));; 5/10/86 DNG - Moved SUBSTITUTE-FUNCTION-NAME to file P1OPT.;;;   MacLisp floating point arithmetic(ADD-OPTIMIZER +$ SUBSTITUTE-FUNCTION-NAME)(ADD-OPTIMIZER -$ SUBSTITUTE-FUNCTION-NAME)(ADD-OPTIMIZER *$ SUBSTITUTE-FUNCTION-NAME)(ADD-OPTIMIZER /$ SUBSTITUTE-FUNCTION-NAME)(ADD-OPTIMIZER 1+$ SUBSTITUTE-FUNCTION-NAME)(ADD-OPTIMIZER 1-$ SUBSTITUTE-FUNCTION-NAME);;; modify signp to be (AND (NUMBERP <form>) (<op> <form>)) if form is an atom;;; and therefore can't have side effects(ADD-OPTIMIZER SIGNP SIGNP-EXPAND)(DEFUN SIGNP-EXPAND (X)  (LET ((OP (CADR X))(OPND (CADDR X)))     (COND ((ATOM OPND)(SIGNP-OPTIMIZE OP OPND));IF ATOM, OPTIMIZE IT   (T X))))(DEFUN SIGNP-OPTIMIZE (OPERATION OPERAND)  (PROG (NEW-FORM NOTP)    (SETQ NEW-FORM  (LIST (COND ((STRING-EQUAL OPERATION 'E) 'ZEROP)      ((STRING-EQUAL OPERATION 'N) (SETQ NOTP T) 'ZEROP)      ((STRING-EQUAL OPERATION 'L) 'MINUSP)      ((STRING-EQUAL OPERATION 'GE) (SETQ NOTP T) 'MINUSP)      ((STRING-EQUAL OPERATION 'G) 'PLUSP)      ((STRING-EQUAL OPERATION 'LE) (SETQ NOTP T) 'PLUSP)      (T       (WARN 'BAD-SIGNP ':IMPOSSIBLE     "~S is not a valid SIGNP condition." OPERATION)       'PROGN))OPERAND))    (AND NOTP (SETQ NEW-FORM (LIST 'NOT NEW-FORM)))   (RETURN `(AND (NUMBERP ,OPERAND) ,NEW-FORM))));;; Convert catches and throws(ADD-OPTIMIZER #!Z CATCH CATCH-*CATCH)(DEFUN CATCH-*CATCH (FORM)  ;; 10/11/86 DNG - Modified to permit using the same symbol for Common Lisp and Zetalisp CATCH.  (IF (AND (<= (LENGTH FORM) 3)   (CONSP (SECOND FORM))   (ATOM (THIRD FORM))   (OR (NOT COMPILING-COMMON-LISP)       (NOT (EQ #!C 'CATCH #!Z 'CATCH))))      ;; Looks like an old MacLisp catch; convert it.      `(*CATCH ',(THIRD FORM) ,(SECOND FORM))    ;; Else assume Common Lisp catch.    (IF (EQ #!C 'CATCH #!Z 'CATCH)FORM      `(*CATCH . ,(REST FORM)))))(ADD-OPTIMIZER #!Z THROW THROW-*THROW)(DEFUN THROW-*THROW (FORM)  ;; 10/11/86 DNG - Modified to permit using the same symbol for Common Lisp and Zetalisp THROW.  (IF (AND (<= (LENGTH FORM) 3)   (CONSP (SECOND FORM))   (ATOM (THIRD FORM))   (OR (NOT COMPILING-COMMON-LISP)       (NOT (EQ #!C 'THROW #!Z 'THROW))))      ;; Looks like an old MacLisp throw; convert it.      `(*THROW ',(THIRD FORM) ,(SECOND FORM))    ;; Else assume Common Lisp throw.    (IF (EQ #!C 'THROW #!Z 'THROW)FORM      `(*THROW . ,(REST FORM)))));;;   Style-checkers for things that don't work in Maclisp.(DEFUN NOT-MACLISP (FORM)    (AND RUN-IN-MACLISP-SWITCH (WARN 'NOT-IN-MACLISP ':MACLISP       "~S is not implemented in Maclisp." (CAR FORM))));These symbols don't exist in Maclisp, though they could, but they are likely losers.(ADD-STYLE-CHECKER LISTP NOT-MACLISP)(ADD-STYLE-CHECKER NLISTP NOT-MACLISP)(ADD-STYLE-CHECKER NSYMBOLP NOT-MACLISP);These functions can't be added to Maclisp by a user.(ADD-STYLE-CHECKER INTERN-LOCAL NOT-MACLISP)(ADD-STYLE-CHECKER INTERN-SOFT NOT-MACLISP)(ADD-STYLE-CHECKER INTERN-LOCAL-SOFT NOT-MACLISP)(ADD-STYLE-CHECKER MAKE-ARRAY NOT-MACLISP)(ADD-STYLE-CHECKER G-L-P NOT-MACLISP)(ADD-STYLE-CHECKER ARRAY-LEADER NOT-MACLISP)(ADD-STYLE-CHECKER STORE-ARRAY-LEADER NOT-MACLISP)(ADD-STYLE-CHECKER MULTIPLE-VALUE NOT-MACLISP)(ADD-STYLE-CHECKER MULTIPLE-VALUE-LIST NOT-MACLISP)(ADD-STYLE-CHECKER DO-NAMED NOT-MACLISP)(ADD-STYLE-CHECKER BLOCK    NOT-MACLISP)(ADD-STYLE-CHECKER TAGBODY  NOT-MACLISP)(ADD-STYLE-CHECKER RETURN-FROM NOT-MACLISP)(ADD-STYLE-CHECKER RETURN-LIST NOT-MACLISP)(ADD-STYLE-CHECKER BIND NOT-MACLISP)(ADD-STYLE-CHECKER COMPILER-LET NOT-MACLISP)(ADD-STYLE-CHECKER LOCAL-DECLARE NOT-MACLISP)(ADD-STYLE-CHECKER CONS-IN-AREA NOT-MACLISP)(ADD-STYLE-CHECKER LIST-IN-AREA NOT-MACLISP)(ADD-STYLE-CHECKER NCONS-IN-AREA NOT-MACLISP)(ADD-STYLE-CHECKER VARIABLE-LOCATION NOT-MACLISP)(ADD-STYLE-CHECKER VARIABLE-BOUNDP NOT-MACLISP)(ADD-STYLE-CHECKER VALUE-CELL-LOCATION NOT-MACLISP)(ADD-STYLE-CHECKER CAR-LOCATION NOT-MACLISP)(ADD-STYLE-CHECKER PROPERTY-CELL-LOCATION NOT-MACLISP)(ADD-STYLE-CHECKER FUNCTION-CELL-LOCATION NOT-MACLISP)(ADD-STYLE-CHECKER FSET NOT-MACLISP)(ADD-STYLE-CHECKER FBOUNDP NOT-MACLISP)(ADD-STYLE-CHECKER FSYMEVAL NOT-MACLISP)(ADD-STYLE-CHECKER SYMBOL-FUNCTION NOT-MACLISP)(ADD-STYLE-CHECKER CLOSURE NOT-MACLISP);Return with more than one argument won't work in Maclisp.(ADD-STYLE-CHECKER RETURN RETURN-STYLE)(DEFUN RETURN-STYLE (FORM)    (AND RUN-IN-MACLISP-SWITCH (CDDR FORM) (WARN 'NOT-IN-MACLISP ':MACLISP       "Returning multiple values doesn't work in Maclisp")));Named PROGs don't work in Maclisp.  PROG variables can't be initialized.;Also, lots of tags and things like a GO to a RETURN are ugly.(ADD-STYLE-CHECKER PROG PROG-STYLE)(DEFUN PROG-STYLE (FORM)    (PROG (PROGNAME)  (AND (ATOM (CADR FORM))       (CADR FORM)       (PROGN (SETQ PROGNAME (CADR FORM))      (SETQ FORM (CDR FORM))))  (COND (RUN-IN-MACLISP-SWITCH (AND PROGNAME (NEQ PROGNAME T)      (WARN 'NOT-IN-MACLISP ':MACLISP    "The PROG name ~S is used; PROG names won't work in Maclisp."    PROGNAME)) (DOLIST (VAR (CADR FORM))   (OR (ATOM VAR)       (RETURN (WARN 'NOT-IN-MACLISP ':MACLISP       "The PROG variable ~S is initialized; this won't work in Maclisp."       (CAR VAR)))))))));; Check a LAMBDA for things that aren't allowed in Maclisp.;; Called only if RUN-IN-MACLISP-SWITCH is set.(DEFUN LAMBDA-STYLE (LAMBDA-EXP)  (DO ((VARLIST (CADR LAMBDA-EXP) (CDR VARLIST)) (KWDBARF)) ((NULL VARLIST))    (COND ((ATOM (CAR VARLIST))   (AND (NOT KWDBARF)(MEMBER (CAR VARLIST) LAMBDA-LIST-KEYWORDS :TEST #'EQ)(SETQ KWDBARF T)(WARN 'NOT-IN-MACLISP ':MACLISP      "Lambda-list keywords such as ~S don't work in Maclisp."      (CAR VARLIST))))  (T (WARN 'NOT-IN-MACLISP ':MACLISP   "The lambda-variable ~S is initialized; this won't work in Maclisp."   (CAAR VARLIST))))))bol)         A fwding ptr to the fn cell is stored;                 (BREAKOFF-FUNCTION name)  The name is stored,;                                           but the offset of this q is put into;                                           the INTERNAL-FEF-OFFSETS debugging info item.;                                           When (:INTERNAL thisfn n) is defined,;                                           its definition replaces the name.;                 (SELF-REF flavor var