;;; -*- Mode: Common-Lisp; Package: compiler; Base: 10.; Patch-File: T -*- ;;; Reason: Modified peep-one-stop to not optimize test-memq because it was leaving garbage on the stack. [11119] ;;; 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, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Patch file for COMPILER version 6.15 ;;; Written 05/24/90 15:07:17 by BERGER, ;;; while running on Pasteur from band LOD2 ;;; With SYSTEM 6.35, VIRTUAL-MEMORY 6.3, EH 6.8, MAKE-SYSTEM 6.3, MICRONET 6.0, LOCAL-FILE 6.2, ;;; BASIC-PATHNAME 6.5, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8, NETWORK-NAMESPACE 6.1, ;;; DISK-IO 6.3, DISK-LABEL 6.0, BASIC-FILE 6.13, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2, ;;; COMPILER 6.14, TV 6.25, DATALINK 6.0, CHAOSNET 6.8, GC 6.4, MEMORY-AUX 6.0, NVRAM 6.3, ;;; SYSLOG 6.2, STREAMER-TAPE 6.6, UCL 6.0, INPUT-EDITOR 6.0, METER 6.2, ZWEI 6.17, ;;; DEBUG-TOOLS 6.4, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.6, MAC-PRINTER-TYPES 6.2, PRINTER-TYPES 6.2, ;;; IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.8, TELNET 6.1, VT100 6.0, ;;; NAMESPACE-EDITOR 6.5, PROFILE 6.3, VISIDOC 6.7, TI-CLOS 6.47, CLEH 6.5, IP 3.62, ;;; Experimental CLX 6.11, CLUE 6.104, X11M 6.24, Experimental BUG 11.19, microcode 648, ;;; Band Name: rel6.0 1/23 #!C ; From file PEEP.LISP#> COMPILER; sys: #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; PEEP.#" (DEFUN PEEP-ONE-SPOT (INDEX) ;; 7/10/85 - Change ATOMIND -> ATOM, NILIND -> NULL; ;; avoid calling the MEMBER function. ;; 7/26/85 - Use REVERSE-SUBTRACT instruction; eliminate unneeded NOT D-INDS. ;; 8/22/85 - Recognize release 3 instruction (AUX POPPDL count). ;; 8/24/85 - Use new function peep-move-const. ;; 9/06/85 - Don't skip over (no-drop-through) when comparing instruction ;; sequences for cross-jumping. ;; 10/23/85 - Change names ADD-IMMEDIATE etc. to ADD-IMMED etc. ;; 1/29/86 - POPPDL instruction renamed to POP-PDL. ;; 4/26/86 DNG - Recognize EQL and EQUAL as commutative instructions. ;; 4/28/86 CLM - Optimization to reduce two identical consecutive returns ;; down to one instruction was sending PEEP-PREVIOUS-INSN-INDEX- ;; REDO-TAGS an instruction index rather than the instruction itself. ;; 5/15/86 CLM - Add in optimization to use the EQ-T misc-op; BRANCH-NOT-NOT opti- ;; mization changed to no longer work on the NOT misc-op. ;; 5/29/86 CLM - Add optimization to delete an UNBIND before a RETURN where possible. ;; 7/10/86 CLM - Update for changes made to certain defops; along with *dif, *logand, ;; etc., now checks for "-", logand, etc. ;; 9/05/86 CLM - Modify the TWO-IDENTICAL-RETURNS optimization so that it works for ;; the RETURN instruction as well as for the aux-op returns. ;; 10/01/86 DNG - Fix to not use immediate instructions for values less than -255. ;; 10/20/86 CLM - Added a number of other optimizations. ;; 11/04/86 CLM - Fixed MATCHING-CODE-PRECEDES-BRANCH-AND-TARGET opt. to handle special ;; case where TARGET was the first instruction. ;; 01/15/87 CLM - Fixed BRANCH-OR-POP-TESTING-CONSTANT opt. to not be invoked for the ;; Store instructions (e.g. SET-NIL). ;; 01/20/87 CLM - Added optimizer to combine consecutive UNBIND-1 instructions. ;; 1/22/87 DNG - Modified UNBIND-1 combination to limit count to 63. ;; 08/03/87 CLM - Make BRANCH-TO-SET-INDS-ALREADY-SET not apply when the ;; instruction following the target instruction is a branch to ;; to the same destination as the original branch. This prevents ;; PEEP from going into an infinite loop in certain cases, and ;; it prevents PEEP from generating infinite loops in other cases. ;; Also fix the BRANCH-TESTING-CONSTANT optimization to not be applied ;; if the user has somehow created a branch-on-zerop and the argument ;; to ZEROP is not a number. (SPRs 5732 and 5860) ;; 09/24/87 CLM - Fix TWO-BRANCHES-SAME-IND opt to set new unconditional branch's POP ;; value to NIL [SPR 6277]. QB2 was barfing because (branch always nil T) ;; is invalid; it should be (branch always nil NIL). ;; 04/11/88 CLM - Added two new optimizations TEST-THEN-BRANCH-ON-SAME-CONDITION and ;; TEST-THEN-BRANCH. ;; 05/17/88 CLM - Fix for the TEST-THEN-BRANCH optimization; added call to PEEP-INDICATORS- ;; USED-P to prevent optimization if it would break the branch instruction. (PROG (X X-PTR Y Z Z-PTR TAG-SKIPPED-FLAG Y-JUST-SETS-INDS Y-BRANCH-TARGET-INDEX YCOUNT ZCOUNT (POP-PDL-MAX (IF (COMPILING-FOR-V2) POPPDL-MAX-V2 POPPDL-MAX))) (IF-DEBUG (INCF PEEP-ONE-SPOT)) (SETQ Y (AREF PEEP-CODE-ARRAY INDEX)) (UNLESS (CONSP Y) (RETURN (1+ INDEX))) (WHEN (EQ (CAR Y) 'COMMENT) (SETF (AREF PEEP-CODE-ARRAY INDEX) NIL) (RETURN (1+ INDEX))) Y-RELOADED-RELOAD-Z (SETQ TAG-SKIPPED-FLAG NIL) (SETQ Z-PTR (1+ INDEX)) RELOAD-Z ;; Find next non-deleted object (instruction or tag). (DO ((LENGTH (ARRAY-ACTIVE-LENGTH PEEP-CODE-ARRAY))) (()) (WHEN (>= Z-PTR LENGTH) (RETURN (SETQ TAG-SKIPPED-FLAG T))) (WHEN (SETQ Z (AREF PEEP-CODE-ARRAY Z-PTR)) (COND ((ATOM Z) (SETQ TAG-SKIPPED-FLAG T)) ((MEMBER (CAR Z) '(RESTART-TAG PARAM) :TEST #'EQ) (SETQ TAG-SKIPPED-FLAG T)) ((EQ (CAR Z) 'COMMENT)) ;; Note: NO-DROP-THROUGH is allowed for z so that it will become the ;; first instruction the next time PEEP-ONE-SPOT is called ;; instead of being skipped over. (T (RETURN)))) (INCF Z-PTR)) Y-RELOADED ;; There are a few optimizations that can go on even across a tag. ;; They are the ones that can delete the first insn, not the second. ;; Specifically, delete the first instruction ;; if all it does is set the indicators ;; but what follows does not use them. (SETQ Y-JUST-SETS-INDS NIL X NIL) (AND (OR (AND (MEMBER (CAR Y) '(MOVE CAR CDR CADR CDDR CAAR CDAR) :TEST #'EQ) (NEQ (CADDR Y) 'PDL-POP) (MEMBER (CADR Y) '(D-INDS 0 D-IGNORE) :TEST #'EQ)) (AND (EQ (FIRST Y) 'MISC) (MEMBER (THIRD Y) '(FALSE TRUE) :TEST #'EQ) (MEMBER (SECOND Y) '(D-INDS D-IGNORE) :TEST #'EQ)) (EQUAL Y '(MOVE D-PDL PDL-POP)) (MEMBER (CAR Y) ;; DAB 05-10-90 removed TEST-MEMQ from list below because tyest-memq take two arg from stack. '(TEST-CAR TEST-CDR TEST-CADR TEST-CDDR TEST-CAAR) :TEST #'EQ)) (SETQ Y-JUST-SETS-INDS T) (NOT (PEEP-INDICATORS-USED-P Z-PTR T)) (PROGN (PEEP-TRACE SET-INDS-NOT-USED) (GO DELETE-Y))) ;;Added 4/11/88. note: there should be a way of combining these two. ;; (MOVE D-INDS 'NIL) --> (BRANCH ALWAYS NIL NIL TAG2) ;; TAG1 TAG1 ;; (BRANCH NULL TRUE NIL TAG2) --> (BRANCH NULL TRUE NIL TAG2) ;; (WHEN (AND (EQUAL Y '(MOVE D-INDS (QUOTE-VECTOR (QUOTE NIL)))) (EQ (CAR Z) 'BRANCH) (EQ (SECOND Z) 'NULL) (EQ (THIRD Z) 'TRUE) ) (SETQ Y `(BRANCH ALWAYS NIL NIL ,(FIFTH Z))) (SETF (AREF PEEP-CODE-ARRAY INDEX) Y) (PEEP-CREATE-TAG-REF (FIFTH Y)) (PEEP-PREVIOUS-INSN-INDEX-REDO-TAGS INDEX Y) (PEEP-TRACE TEST-THEN-BRANCH-ON-SAME-CONDITION) (GO Y-RELOADED)) (WHEN (AND (EQUAL Y '(MOVE D-INDS (QUOTE-VECTOR (QUOTE NIL)))) (EQ (CAR Z) 'BRANCH) (EQ (SECOND Z) 'NULL) (EQ (THIRD Z) 'FALSE) ) (LET ((NTAG (PEEP-UPDATING-INDEX INDEX (PEEP-FIND-OR-INSERT-TAG (1+ Z-PTR))))) (SETQ Y `(BRANCH ALWAYS NIL NIL ,NTAG)) (SETF (AREF PEEP-CODE-ARRAY INDEX) Y) (PEEP-CREATE-TAG-REF NTAG) (PEEP-PREVIOUS-INSN-INDEX-REDO-TAGS INDEX Y) (PEEP-TRACE TEST-THEN-BRANCH-ON-SAME-CONDITION) (GO Y-RELOADED))) (WHEN (EQ (CAR Y) 'BRANCH) ;; Conditional branch followed by unconditional branch to same place. (AND (EQ (CAR Z) 'BRANCH) (EQ (CADR Z) 'ALWAYS) (NOT (FOURTH Y)) (NOT (FOURTH Z)) (EQ (FIFTH Y) (FIFTH Z)) (NEQ (SECOND Y) 'PUSHJ) (PROGN (PEEP-TRACE TWO-BRANCHES-TO-SAME-PLACE) (GO DELETE-Y))) (LET ((Y-TARGET-TAG-INDEX (PEEP-TAG-INDEX (FIFTH Y)))) ;; Branch to .+1, and not popping. (WHEN (AND (EQ INDEX (SETQ Y-BRANCH-TARGET-INDEX (PEEP-PREVIOUS-INSN-INDEX-SKIPPING-TAGS Y-TARGET-TAG-INDEX))) (NULL (FOURTH Y)) (NEQ (SECOND Y) 'PUSHJ)) (PEEP-TRACE BRANCH-.+1) (GO DELETE-Y)) (WHEN (EQ (CADR Y) 'ALWAYS) ;; See if the code before the branch target ;; matches the code before the branch. (DO ((PREV-PTR (PEEP-PREVIOUS-INSN-INDEX INDEX) (PEEP-PREVIOUS-INSN-INDEX PREV-PTR)) (TARGET-PTR (PEEP-PREVIOUS-INSN-INDEX-SKIPPING-TAGS Y-TARGET-TAG-INDEX T) (PEEP-PREVIOUS-INSN-INDEX-SKIPPING-TAGS TARGET-PTR T)) (PREV-MATCH INDEX PREV-PTR) (TARGET-MATCH NIL TARGET-PTR)) ((OR (NULL PREV-PTR) (NULL TARGET-PTR) (EQUAL (AREF PEEP-CODE-ARRAY PREV-PTR) '(NO-DROP-THROUGH)) (NOT (EQUAL (AREF PEEP-CODE-ARRAY PREV-PTR) (AREF PEEP-CODE-ARRAY TARGET-PTR)))) (UNLESS (= INDEX PREV-MATCH) (SETQ X (AREF PEEP-CODE-ARRAY PREV-MATCH)) (PEEP-TRACE MATCHING-CODE-PRECEDES-BRANCH-AND-TARGET (AREF PEEP-CODE-ARRAY (PEEP-NEXT-INSN-INDEX-SKIPPING-TAGS Y-TARGET-TAG-INDEX))) (LET ((OINSN (AREF PEEP-CODE-ARRAY PREV-MATCH))) (WHEN (EQ (CAR OINSN) 'BRANCH) (PEEP-DELETE-TAG-REF (FIFTH OINSN)))) (LET ((NTAG (PEEP-UPDATING-INDEX PREV-MATCH (PEEP-UPDATING-INDEX INDEX (PEEP-FIND-OR-INSERT-TAG TARGET-MATCH))))) (SETF (AREF PEEP-CODE-ARRAY PREV-MATCH) `(BRANCH ALWAYS NIL NIL ,NTAG)) (PEEP-CREATE-TAG-REF NTAG)) ;; Start deleting this branch ;; so that peep-locally doesn't do this optimization again. (SETF (AREF PEEP-CODE-ARRAY INDEX) NIL) ;; Perhaps this new branch insn causes optimizations ;; in branches branching to tags that precede it. (PEEP-PREVIOUS-INSN-INDEX-REDO-TAGS PREV-MATCH (AREF PEEP-CODE-ARRAY PREV-MATCH)) ;;clm 10/17/86 11/04/86 fixed for a certain case - this needs cleaning ;;inserting a new tag may have produced conditions for further opt's. (WHEN (PEEP-PREVIOUS-INSN-OR-TAG-INDEX TARGET-MATCH) (UNLESS (PEEP-PREVIOUS-INSN-INDEX TARGET-MATCH) (PEEP-PREVIOUS-INSN-INDEX-REDO-TAGS (PEEP-PREVIOUS-INSN-OR-TAG-INDEX TARGET-MATCH) (AREF PEEP-CODE-ARRAY (PEEP-PREVIOUS-INSN-OR-TAG-INDEX TARGET-MATCH) )) )) (PEEP-LOCALLY (1+ PREV-MATCH)) (PEEP-LOCALLY PREV-MATCH) ;; Finish deleting this branch. (GO DELETE-Y))))) ;; Various other optimizations of branch insns ;; that involve looking at the insn following the target tag. (LET (TARGET TARGET-PTR X-PTR) (SETQ TARGET-PTR (LOOP FOR TP FROM (1+ Y-TARGET-TAG-INDEX) BELOW (ARRAY-ACTIVE-LENGTH PEEP-CODE-ARRAY) DO (COND ((PEEP-BRANCH-TAG-P (SETQ TARGET (AREF PEEP-CODE-ARRAY TP))) ;; when two or more adjacent tags, branch to the ;; last one so that equivalent branches will look ;; the same for cross-jumping. (PEEP-DELETE-TAG-REF (FIFTH Y)) (SETF (FIFTH Y) TARGET) (PEEP-CREATE-TAG-REF TARGET)) ((PEEP-INSTRUCTION-P TARGET) (RETURN TP))) FINALLY NIL)) (IF (NULL TARGET-PTR) ;; A branch beyond the end of the function can occur following a ;; move to D-LAST which completes a call with destination of ;; D-RETURN. The branch will never be taken, so delete it. (PROGN (PEEP-DELETE-TAG-REF (FIFTH Y)) (SETF (AREF PEEP-CODE-ARRAY INDEX) (SETQ Y '(NO-DROP-THROUGH))) (INCF PEEP-INSNS-SAVED) (GO Y-RELOADED)) (COND ((AND (EQ (CAR TARGET) 'BRANCH) (NEQ (CADR TARGET) 'PUSHJ) (NEQ TARGET Y) ;degenerate case of branch to self ) (COND ((OR (EQ (CADR TARGET) 'ALWAYS) (AND (EQ (CADR TARGET) (CADR Y)) (EQ (CADDR TARGET) (CADDR Y)))) ;; Target of branch is an unconditional branch ;; or a branch testing the same indicator with the same sense. (PEEP-TRACE BRANCH-TO-BRANCH TARGET) (LET ((OTAG (FIFTH Y))) (SETF (FIFTH Y) (FIFTH TARGET)) (PEEP-CREATE-TAG-REF (FIFTH Y)) (PEEP-DELETE-TAG-REF OTAG)) (PEEP-LOCALLY INDEX) (GO Y-RELOADED)) ((AND (EQ (CADR TARGET) (CADR Y)) (NOT (FOURTH TARGET))) ;;Branch to another branch on same indicator ;;but opposite sense (and not popping). ;;The other branch will never branch if reached from here, ;;so branch to a new tag following it. (PEEP-TRACE BRANCH-TO-BRANCH-NOT-TAKEN TARGET) (PEEP-UPDATING-INDEX INDEX (PEEP-CHANGE-BRANCH-TO-INDEX Y (1+ TARGET-PTR))) (GO Y-RELOADED-RELOAD-Z)) ((AND (EQ (CADR Y) 'ALWAYS) (NULL (FOURTH TARGET)) (EQ INDEX (PEEP-PREVIOUS-INSN-INDEX-SKIPPING-TAGS (PEEP-TAG-INDEX (FIFTH TARGET))))) ;; branch [branch .+1] turns into ;; a branch on the opposite condition, to one after that branch. (PEEP-TRACE BRANCH-TO-BRANCH-BACK TARGET) (SETF (CADR Y) (CADR TARGET)) (SETF (CADDR Y) (OTHER (CADDR TARGET))) (PEEP-CAN-DROP-THROUGH (1+ INDEX)) (PEEP-UPDATING-INDEX INDEX (PEEP-CHANGE-BRANCH-TO-INDEX Y (1+ TARGET-PTR))) (GO Y-RELOADED-RELOAD-Z)))) ;end target branch not pushj ((AND (EQ (CADR Y) 'ALWAYS) (OR (AND (EQ (CADR TARGET) 'D-RETURN) (MEMBER (CAR TARGET) (IF (COMPILING-FOR-V2) '(MOVE CAR CDR CAAR CADR CDAR CDDR MISC FALSE TRUE CALL0 CALL) '(MOVE CAR CDR CAAR CADR CDAR CDDR MISC FALSE TRUE CALL0)) :TEST #'EQ)) ;; clm 3/10/86 (AND (EQ (CAR TARGET) 'AUX) (MEMBER (CADR TARGET) '(RETURN-N RETURN-T RETURN-NIL RETURN-LIST RETURN-PRED RETURN-NOT-INDS return-0) :TEST #'EQ)))) ;; Unconditional branch to a single instruction that returns. (PEEP-TRACE BRANCH-TO-RETURN TARGET) (LET ((OY Y)) (SETQ Y (COPY-LIST TARGET)) (SETF (AREF PEEP-CODE-ARRAY INDEX) Y) (PEEP-DELETE-TAG-REF (FIFTH OY))) ;;adding CALL to the above list may make other opt's possible. ;;clm 10/17/86 (PEEP-LOCALLY INDEX) (GO Y-RELOADED)) ((AND (OR (EQ (CADR TARGET) 'D-INDS) (EQ (GET (CAR TARGET) 'DEST) 'D-INDS)) (SETQ X-PTR (PEEP-PREVIOUS-INSN-INDEX INDEX)) (SETQ X (AREF PEEP-CODE-ARRAY X-PTR)) (EQUAL (CADDR TARGET) (CADDR X)) (NOT (MEMBER (CADR X) '(D-LAST D-RETURN) :TEST #'EQ)) (OR (AND (MEMBER (CAR X) SET-INDS-FROM-SOURCE-INSNS :TEST #'EQ) (EQ (CAR TARGET) 'MOVE)) (AND (MEMBER (CAR X) '(CAR CDR CAAR CADR CDAR CDDR) :TEST #'EQ) (EQ (CAR X) (CAR TARGET))) (AND (EQ (GET (CAR X) 'DEST) 'D-INDS) (EQ (CAR X) (CAR TARGET)))) ;;If the instruction following the target instruction ;;is a branch to the same destination as the branch in y, ;;then don't do this optimization. This prevents PEEP ;;from going into an infinited loop. The problem is that ;;the branch-to-branch optimization will undo this one, but ;;leave the code set up to satisfy the conditions for this ;;opt. Then this opt sets up the code to satisfy the b-to-b ;;opt again, and so FOREVER. ;;This also prevents PEEP from generating a branch back to itself. (LET ((NEXT-INSN (AREF PEEP-CODE-ARRAY (PEEP-NEXT-INSN-INDEX-SKIPPING-TAGS TARGET-PTR)))) (NOT (AND (EQ (CAR NEXT-INSN) 'BRANCH) (EQ (FIFTH NEXT-INSN) (FIFTH Y)))) )) ;; Branch to an insn that just sets the inds ;; to what they already were. (PEEP-TRACE BRANCH-TO-SET-INDS-ALREADY-SET TARGET) (PEEP-UPDATING-INDEX INDEX (PEEP-CHANGE-BRANCH-TO-INDEX Y (1+ TARGET-PTR))) (GO Y-RELOADED-RELOAD-Z) ) ) ;cond )) )) ; end of (when (eq (car y) 'branch)... (COND ((OR (EQ (FIRST Y) 'NO-DROP-THROUGH) (AND (EQ (FIRST Y) 'BRANCH) (EQ (SECOND Y) 'ALWAYS))) ;; See if the code before another dead end ;; matches the code before this dead end. (LET ((BEFORE-INDEX (IF (EQ (FIRST Y) 'BRANCH) INDEX (PEEP-PREVIOUS-INSN-INDEX INDEX)))) (UNLESS (NULL BEFORE-INDEX) (DOLIST (OTHER-INDEX PEEP-DEAD-ENDS) (WHEN (/= BEFORE-INDEX OTHER-INDEX) (DO ((PREV-PTR BEFORE-INDEX (PEEP-PREVIOUS-INSN-INDEX PREV-PTR)) (TARGET-PTR OTHER-INDEX (PEEP-PREVIOUS-INSN-INDEX-SKIPPING-TAGS TARGET-PTR T)) (PREV-MATCH NIL PREV-PTR) (TARGET-MATCH NIL TARGET-PTR) (MATCH-COUNT 0 (1+ MATCH-COUNT))) ;; until ((OR (NULL PREV-PTR) (NULL TARGET-PTR) (NOT (EQUAL (AREF PEEP-CODE-ARRAY PREV-PTR) (AREF PEEP-CODE-ARRAY TARGET-PTR)))) ;; finally (UNLESS (< MATCH-COUNT 3) ;; This optimization saves space but increases ;; execution time by one additional branch instruction. ;; Therefore, do it only if at least 2 instructions ;; can be removed. (SETQ X (AREF PEEP-CODE-ARRAY PREV-MATCH)) (PEEP-TRACE MATCHING-CODE-PRECEDES-DEAD-ENDS) (WHEN (EQ (FIRST X) 'BRANCH) (PEEP-DELETE-TAG-REF (FIFTH X))) (SETQ PEEP-DEAD-ENDS (DELETE BEFORE-INDEX (THE LIST PEEP-DEAD-ENDS) :COUNT 1 :TEST #'EQ)) (LET ((NTAG (PEEP-UPDATING-INDEX PREV-MATCH (PEEP-FIND-OR-INSERT-TAG TARGET-MATCH)))) (SETQ Y `(BRANCH ALWAYS NIL NIL ,NTAG)) (SETQ INDEX PREV-MATCH) (SETF (AREF PEEP-CODE-ARRAY PREV-MATCH) Y) (PEEP-CREATE-TAG-REF NTAG)) ;; Perhaps this new branch insn causes optimizations ;; in branches branching to tags that precede it. (PEEP-PREVIOUS-INSN-INDEX-REDO-TAGS PREV-MATCH Y) ;; Now go delete newly dead code following new branch (GO Y-RELOADED-RELOAD-Z) ))) )) ; end of dolist (PUSH BEFORE-INDEX PEEP-DEAD-ENDS) ))) ;;Delete the first of two adjacent identical return instructions. ((OR (AND (EQ (CAR Y) 'AUX) (MEMBER (CADR Y) '(RETURN-N RETURN-T RETURN-NIL RETURN-LIST return-0 RETURN-PRED RETURN-NOT-INDS) :TEST #'EQ)) (AND (EQ (CAR Y) 'MOVE) (EQ (CADR Y) 'D-RETURN))) (LET ((BEFORE-INDEX (PEEP-PREVIOUS-INSN-INDEX-SKIPPING-TAGS INDEX))) (AND BEFORE-INDEX (EQUAL (AREF PEEP-CODE-ARRAY BEFORE-INDEX) Y) (PROGN (PEEP-TRACE TWO-IDENTICAL-RETURNS) (SETF (AREF PEEP-CODE-ARRAY BEFORE-INDEX) NIL) (PEEP-PREVIOUS-INSN-INDEX-REDO-TAGS BEFORE-INDEX Y) (GO Y-RELOADED-RELOAD-Z) ) ) ) ) ) ; end cond (LET (IMMED-INST NUM) (WHEN (AND (EQUAL (SECOND Y) 0) (EQ (CAR-SAFE (THIRD Y)) 'QUOTE-VECTOR) (SETQ IMMED-INST (CDR (ASSOC (FIRST Y) '((*PLUS . ADD-IMMED) (*DIF . SUBTRACT-IMMED) (EQ . EQ-IMMED) (INTERNAL-= . =-IMMED) (INTERNAL-< . <-IMMED) (INTERNAL-> . >-IMMED) (= . =-IMMED) (< . <-IMMED) (> . >-IMMED) (+ . ADD-IMMED) (- . SUBTRACT-IMMED)) :TEST #'EQ))) (INSTRUCTION-EXISTS-P 'ADD-IMMED) (FIXNUMP (SETQ NUM (QUOTE-NUMBER (SECOND (THIRD Y))))) (<= -255 NUM 255)) ;; (*PLUS 0 (QUOTE-VECTOR (QUOTE n))) ==> (ADD-IMMED n) (WHEN (AND (MEMBER (FIRST Y) '(*DIF -) :TEST #'EQ) (NOT (INSTRUCTION-EXISTS-P 'SUBTRACT-IMMED))) (SETQ IMMED-INST 'ADD-IMMED NUM (- NUM))) (SETF Y (LIST IMMED-INST (LOGAND NUM 511))) (SETF (AREF PEEP-CODE-ARRAY INDEX) Y) (PEEP-TRACE IMMED-INSN) (GO Y-RELOADED-RELOAD-Z))) ;; The rest can happen only if no tag intervenes. (WHEN TAG-SKIPPED-FLAG (RETURN Z-PTR)) ;; Ok, we have instructions in Y and Z. (COND ;;When a MOVEM is followed by a return that pops, ;;delete the MOVEM, unless Safety is more important. ;;This may not be general enough ((AND (EQUAL Z '(MOVE D-RETURN PDL-POP)) (EQ (CAR Y) 'MOVEM) (MEMBER (CAR-SAFE (THIRD Y)) '(ARG LOCBLOCK) :TEST #'EQ)) (UNLESS (> (OPT-SAFETY OPTIMIZE-SWITCH) (OPT-SPEED-OR-SPACE OPTIMIZE-SWITCH)) (PEEP-TRACE MOVEM-BEFORE-RETURN) (GO DELETE-Y))) ((EQUAL Y '(NO-DROP-THROUGH)) ;; Delete dead code following a (NO-DROP-THROUGH) (WHEN (PEEP-INSTRUCTION-P Z) (PEEP-TRACE DEAD-CODE)) (GO DELETE-Z)) ;;Delete dead code after a return ((AND (OR (AND (EQ (CADR Y) 'D-RETURN) (MEMBER (CAR Y) (IF (COMPILING-FOR-V2) '(MOVE CAR CDR CAAR CADR CDAR CDDR MISC FALSE TRUE CALL0 CALL) '(MOVE CAR CDR CAAR CADR CDAR CDDR MISC FALSE TRUE CALL0)) :TEST #'EQ)) (AND (EQ (CAR Y) 'AUX) (MEMBER (CADR Y) '(RETURN-N RETURN-T RETURN-NIL RETURN-LIST RETURN-0 RETURN-PRED RETURN-NOT-INDS) :TEST #'EQ)) ) (PEEP-INSTRUCTION-P Z)) (PEEP-TRACE DEAD-CODE) (GO DELETE-Z)) ((AND (EQ (CAR Y) 'BRANCH) ;; clm 3/11/86 (NOT (EQ (CADR Y) 'PUSHJ))) (COND ((EQ (CADR Y) 'ALWAYS) (WHEN (PEEP-INSTRUCTION-P Z) (PEEP-TRACE DEAD-CODE)) (GO DELETE-Z)) ((AND (EQ Y-BRANCH-TARGET-INDEX Z-PTR) (NOT (FOURTH Y)) (EQ (CAR Z) 'BRANCH) (EQ (CADR Z) 'ALWAYS)) ;; branch .+2 followed by unconditional branch. (PEEP-TRACE BRANCH-ACROSS-BRANCH) (SETF (CADDR Y) (OTHER (CADDR Y))) (LET ((OTAG (FIFTH Y))) (SETF (FIFTH Y) (FIFTH Z)) (SETF (FIFTH Z) OTAG) (GO DELETE-Z)))) (COND ((AND (EQ (CAR Z) 'BRANCH) (NOT (FOURTH Y)) (EQ (CADR Y) (CADR Z))) ;; Two branches in a row testing the same indicator. (PEEP-TRACE TWO-BRANCHES-SAME-IND) (IF (EQ (CADDR Y) (CADDR Z)) ;; same sense => just delete the second one. (GO DELETE-Z) ;; opposite sense => second one is really unconditional. (PROGN (SETF (CADR Z) 'ALWAYS) (SETF (CADDR Z) NIL) ;;make sure POP value is seet to nil (SETF (CADDDR Z) NIL)))) ;; Branch followed by move. See if move is to d-inds and is superfluous ((EQ (CAR Z) 'MOVE) (AND (SETQ X-PTR (PEEP-PREVIOUS-INSN-INDEX INDEX)) (SETQ X (AREF PEEP-CODE-ARRAY X-PTR)) (MEMBER (CAR X) SET-INDS-FROM-SOURCE-INSNS :TEST #'EQ) (EQUAL (CADDR X) (CADDR Z)) (OR (AND (EQ (CADR Z) 'D-PDL) ;; Can optimize branch push ;; only if the branch is a branch-or-pop. ;; and the previous insn is also a push or a movem. (OR (EQUAL X Z) (EQ (CAR X) 'MOVEM)) (FOURTH Y)) (AND (MEMBER (CADR Z) '(D-IGNORE D-INDS 0) :TEST #'EQ) (NOT (MEMBER (CADR X) '(D-RETURN D-LAST) :TEST #'EQ)))) (PROGN (PEEP-TRACE MOVE-BRANCH-MOVE) (WHEN (EQ (CADR Z) 'D-PDL) (SETF (FOURTH Y) NIL)) (GO DELETE-Z)))))) ((AND (EQ (CAR Z) 'BRANCH) (NOT (EQ (CADR Z) 'PUSHJ))) ;; check for MOVE D-INDS constant followed by branches. ;; Decide where the branching will stop ;; and make one branch straight there. ;; Then back to Y-RELOADED which may delete the MOVE. ;; Note: we know that the indicators will get used, ;; for otherwise the MOVE would already have been deleted, above. (LET ((QUOTE-FORM (PEEP-MOVE-CONST Y 'D-INDS))) (UNLESS (NULL QUOTE-FORM) (LET ((INDS-USED (PEEP-INDICATORS-USED-P Z-PTR NIL))) (UNLESS (NULL INDS-USED) (PEEP-TRACE BRANCH-TESTING-CONSTANT) (LET* ((FINAL-BRANCH (AREF PEEP-CODE-ARRAY INDS-USED)) (INDICATOR (SECOND FINAL-BRANCH)) (OTAG (FIFTH Z)) (SENSE (THIRD FINAL-BRANCH))) (UNLESS (OR (AND (EQ (CADR Z) 'ALWAYS) (EQ (FIFTH Z) (FIFTH FINAL-BRANCH))) (AND (EQ INDICATOR 'ZEROP) (NOT (NUMBERP (SECOND QUOTE-FORM))))) (COND ((EQ (CASE SENSE (TRUE T) (FALSE NIL)) (FUNCALL INDICATOR (SECOND QUOTE-FORM))) ;; The final branch will go. (SETF (FIFTH Z) (FIFTH FINAL-BRANCH))) (T ;; The final branch will not branch. (WHEN (FOURTH FINAL-BRANCH) ;; Can't skip over a branch that pops. (RETURN Z-PTR)) (PEEP-UPDATING-INDEX INDEX (SETF (FIFTH Z) (PEEP-FIND-OR-INSERT-TAG (1+ INDS-USED)))))) (SETF (CADR Z) 'ALWAYS) (SETF (CADDR Z) NIL) (PEEP-CREATE-TAG-REF (FIFTH Z)) (PEEP-DELETE-TAG-REF OTAG) (GO Y-RELOADED-RELOAD-Z))))))) ;; Check for push followed by branch-or-pop that will never branch. (LET (QUOTE-FORM) (WHEN (AND (FOURTH Z) ;Must be branch-or-pop (SETQ QUOTE-FORM (PEEP-MOVE-CONST Y 'D-PDL)) ;; Test that branch will not occur. (NEQ (CASE (THIRD Z) (TRUE T) (FALSE NIL)) (FUNCALL (SECOND Z) (SECOND QUOTE-FORM))) (EQ (SECOND Y) 'D-PDL)) (PEEP-TRACE BRANCH-OR-POP-TESTING-CONSTANT) ;; Change the push to a d-inds, and delete the branch. (SETF (AREF PEEP-CODE-ARRAY INDEX) (SETQ Y (LIST* (CAR Y) 'D-INDS (CDDR Y)))) (GO DELETE-Z))) ;;this optimization is causing problems when compiling for ;;"explorer" (WHEN (AND (EQ (FIRST Y) 'MISC) (EQ (SECOND Y) 'D-INDS) (EQL (THIRD Y) (MISC-LAP-CODE 'NOT-INDICATORS)) (EQ (SECOND Z) 'NULL) (NOT (PEEP-INDICATORS-USED-P (PEEP-TAG-INDEX (FIFTH Z)) T))) ;;(misc d-inds not-indicators) ;; (BRANCH NULL TRUE pop tag) ==> (BRANCH NULL FALSE pop tag) (SETF (THIRD Z) (OTHER (THIRD Z))) (PEEP-TRACE BRANCH-NOT-NOT) (GO DELETE-Y)) ;;clm 10/21/86 ;; (SET-T 0 PDL-PUSH) \ (SET-T 0 LOCAL-X) ;; (BRANCH ALWAYS * * TAG) \ __ (BRANCH ALWAYS * * TAG2) ;; TAG / TAG ;; (POP 0 LOCAL-X) / (POP ---) ;; TAG2 (WHEN (AND (EQ (CADR Z) 'ALWAYS) (MEMBER (CAR Y) '(SET-T SET-NIL SET-ZERO) :TEST #'EQ) (EQ (THIRD Y) 'PDL-PUSH)) (LET* ((TARGET-INSN-INDEX (PEEP-NEXT-INSN-INDEX-SKIPPING-TAGS (PEEP-TAG-INDEX (FIFTH Z)))) (TARGET-INSN (IF TARGET-INSN-INDEX (AREF PEEP-CODE-ARRAY TARGET-INSN-INDEX) NIL))) (WHEN (AND TARGET-INSN-INDEX (EQ (CAR TARGET-INSN) 'POP)) (SETF (AREF PEEP-CODE-ARRAY INDEX) `(,(FIRST Y) ,(SECOND Y) ,(THIRD TARGET-INSN))) (SETF (FIFTH Z) (PEEP-FIND-OR-INSERT-TAG (1+ TARGET-INSN-INDEX))) (PEEP-CREATE-TAG-REF (FIFTH Z))) ) ) ;;;Added 4/11/88 ;;; (PUSH x) ---\ (TEST x) ;;; (MISC TEST cond) -----> (BRANCH-NOT-cond) ;;; (BRANCH NULL ...) ---/ ;;; (LET (TEMP-INSN BRANCH-CONDITION (MISC-OP (THIRD Y)) (DEST 'D-INDS) ) (WHEN (AND (EQ (FIRST Y) 'MISC) (EQ (SECOND Y) 'D-INDS) (SETQ BRANCH-CONDITION (COND ((EQL (MISC-LAP-CODE 'ZEROP) MISC-OP) 'ZEROP) ((EQL (MISC-LAP-CODE 'ATOM) MISC-OP) 'ATOM) ((EQL (MISC-LAP-CODE 'SYMBOLP) MISC-OP) 'SYMBOLP))) (SETQ X-PTR (PEEP-PREVIOUS-INSN-INDEX INDEX)) (SETQ X (AREF PEEP-CODE-ARRAY X-PTR)) (EQ (SECOND Z) 'NULL) (NOT (PEEP-INDICATORS-USED-P (PEEP-TAG-INDEX (FIFTH Z)) T)) (SETQ TEMP-INSN (IF (EQ (CAR X) 'MOVE) (AND (EQ (SECOND X) 'D-PDL) (CAR X)) (PROGN (SETQ DEST 0) (CADR (ASSOC (CAR X) '((PUSH TEST) (PUSH-CAR TEST-CAR) (PUSH-CDR TEST-CDR) (PUSH-CADR TEST-CADR) (PUSH-CDDR TEST-CDDR) (PUSH-CAAR TEST-CAAR))))))) ) (SETF (AREF PEEP-CODE-ARRAY X-PTR) `(,TEMP-INSN ,DEST ,(THIRD X))) (SETF (SECOND Z) BRANCH-CONDITION) (SETF (THIRD Z) (OTHER (THIRD Z))) (PEEP-TRACE TEST-THEN-BRANCH ) (GO DELETE-Y) ) ) ) ; end (EQ (CAR Z) 'BRANCH) ;;new optimization for deleting an unbind before a return ;;the return will take care of the unbindings ((AND (EQ (CAR Y) 'AUX) (EQ (CADR Y) 'UNBIND-1) (OR (AND (EQ (CADR Z) 'D-RETURN) (MEMBER (CAR Z) '(MOVE CAR CDR CAAR CADR CDAR CDDR MISC FALSE TRUE) :TEST #'EQ) (NOT (EQ (CAR-SAFE (THIRD Z)) 'SPECIAL)) ) (AND (EQ (CAR Z) 'AUX) (MEMBER (CADR Z) '(RETURN-N RETURN-T RETURN-NIL RETURN-LIST RETURN-0 RETURN-PRED RETURN-NOT-INDS) :TEST #'EQ))) ) (PEEP-TRACE UNBIND-FOLLOWED-BY-RETURN) (GO DELETE-Y) ) ((EQ (CAR Z) 'POP) ;; PUSH 0, PUSH NIL or PUSH T followed by POP. (LET ((QUOTE-FORM (PEEP-MOVE-CONST Y 'D-PDL))) (WHEN (AND (NOT (NULL QUOTE-FORM)) (MEMBER (SECOND QUOTE-FORM) '(0 NIL T) :TEST #'EQ) (OR (NEQ (SECOND QUOTE-FORM) 'T) (INSTRUCTION-EXISTS-P 'SET-T))) (PEEP-TRACE PUSH-NIL-OR-0-THEN-POP) (SETF (AREF PEEP-CODE-ARRAY INDEX) (SETQ Y (LIST (CASE (SECOND QUOTE-FORM) (NIL 'SET-NIL) (0 'SET-ZERO) (T 'SET-T)) 0 (CADDR Z)))) (GO DELETE-Z)))) ((AND (SETQ ZCOUNT (PEEP-POP-COUNT Z)) (< ZCOUNT POP-PDL-MAX) (SETQ YCOUNT (PEEP-POP-COUNT Y))) ;; Two insns in a row that just pop something(s) from the pdl. (PEEP-TRACE TWO-POPS) (LET ((TOTAL-POPS (+ YCOUNT ZCOUNT))) (COND ((<= TOTAL-POPS POP-PDL-MAX) (SETF (AREF PEEP-CODE-ARRAY INDEX) (SETQ Y (MAKE-AUX 'POP-PDL TOTAL-POPS))) (GO DELETE-Z)) (T (SETF (AREF PEEP-CODE-ARRAY INDEX) (SETQ Y (MAKE-AUX 'POP-PDL POP-PDL-MAX))) (SETF (AREF PEEP-CODE-ARRAY Z-PTR) (SETQ Z (MAKE-AUX 'POP-PDL (- TOTAL-POPS POP-PDL-MAX)))) (RETURN Z-PTR))))) ;;this goes with the two-push-nils test below ((AND (EQUAL Z '(SET-NIL 0 PDL-PUSH)) (EQUAL Y '(SET-NIL 0 PDL-PUSH))) (PROGN (LET ((PEEP-NUMBER-OF-OPTIMIZATIONS PEEP-NUMBER-OF-OPTIMIZATIONS)) (PEEP-TRACE TWO-PUSH-NILS)) (RETURN Z-PTR))) ((EQ (CAR Z) 'MOVE) (WHEN (AND (EQ (CAR Y) 'MOVE) (EQ (CADR Y) 'D-PDL) (EQ (CADDR Z) 'PDL-POP)) ;; Push followed by move from pdl. ;; Transfer the destination into the push, ;; then the pop is not needed. (PEEP-TRACE PUSH-THEN-MOVE-FROM-PDL) (SETF (CADR Y) (CADR Z)) (GO DELETE-Z)) (IF-DEBUG (AND (EQUAL Z '(MOVE D-PDL (QUOTE-VECTOR (QUOTE NIL)))) (EQUAL Y '(MOVE D-PDL (QUOTE-VECTOR (QUOTE NIL)))) (PROGN (LET ((PEEP-NUMBER-OF-OPTIMIZATIONS PEEP-NUMBER-OF-OPTIMIZATIONS)) (PEEP-TRACE TWO-PUSH-NILS)) (RETURN Z-PTR)))) (WHEN (EQUAL (CADDR Y) (CADDR Z)) (COND ((AND (EQ (CADR Z) 'D-INDS) (NOT (MEMBER (CADR Y) '(D-LAST D-RETURN) :TEST #'EQ)) (MEMBER (CAR Y) SET-INDS-FROM-SOURCE-INSNS :TEST #'EQ)) ;; Delete MOVE D-INDS X after something that stores or fetches X. (PEEP-TRACE SET-INDS-ALREADY-SET) (GO DELETE-Z)) ((AND (EQ (CADR Z) 'D-PDL) (EQ (CAR Y) 'POP)) ;; Turn POP X ? MOVE D-PDL X into MOVEM X (PEEP-TRACE POP-THEN-PUSH) (RPLACA Y 'MOVEM) (GO DELETE-Z)) ((AND (EQ (CADR Z) 'D-RETURN) (EQ (CAR Y) 'POP) (MEMBER (CAR-SAFE (THIRD Z)) '(ARG LOCBLOCK) :TEST #'EQ) (> (OPT-SPEED-OR-SPACE OPTIMIZE-SWITCH) (OPT-SAFETY OPTIMIZE-SWITCH))) ;; Turn POP X , MOVE D-RETURN X into MOVE D-RETURN PDL-POP (PEEP-TRACE POP-BEFORE-RETURN) (SETF (THIRD Z) 'PDL-POP) (GO DELETE-Y))))) ((AND (EQ (FIRST Y) 'MOVE) (EQ (SECOND Y) 'D-PDL) (EQUAL (SECOND Z) 0) (OR (MEMBER (FIRST Z) '(*PLUS + *TIMES * *LOGAND LOGAND *LOGIOR LOGIOR *LOGXOR LOGXOR INTERNAL-= EQ EQL EQUAL) :TEST #'EQ) (AND (MEMBER (FIRST Z) '(*DIF - REVERSE-SUBTRACT) :TEST #'EQ) (INSTRUCTION-EXISTS-P 'REVERSE-SUBTRACT))) ;; commutative operation; possible to exchange operands ) (LET (NUM) (COND ((AND (SETQ X-PTR (PEEP-PREVIOUS-INSN-INDEX INDEX)) (SETQ X (AREF PEEP-CODE-ARRAY X-PTR)) (EQ (FIRST X) 'POP) (EQUAL (THIRD X) (THIRD Z))) ;; (POP 0 a) \ / (MOVEM 0 a) ;; (MOVE D-PDL b) > ==> < ;; (*PLUS 0 a) / \ (*PLUS 0 b) (PEEP-TRACE SWAP-COMMUTATIVE) (SETF (THIRD Z) (THIRD Y)) (SETF (THIRD Y) (THIRD X)) (PEEP-QUEUE X-PTR)) ; go back to change POP to MOVEM ((AND (EQ (CAR-SAFE (THIRD Z)) 'QUOTE-VECTOR) (QUOTEP (SETQ NUM (SECOND (THIRD Z)))) (FIXNUMP (SETQ NUM (SECOND NUM))) (<= NUM 511) (OR (<= 0 NUM) (AND (<= -511 NUM) (INSTRUCTION-EXISTS-P 'PUSH-NEG-NUMBER)))) ;; (MOVE D-PDL b) > ==> < (PUSH-NUMBER n) ;; (*PLUS 0 'n) / \ (*PLUS 0 b) (PEEP-TRACE SWAP-COMMUTATIVE) (SETF (THIRD Z) (THIRD Y)) (SETF (AREF PEEP-CODE-ARRAY INDEX) (IF (< NUM 0) `(PUSH-NEG-NUMBER ,(- 0 NUM)) `(PUSH-NUMBER ,NUM)))) ((AND (MISC-OP-EVAL 'EQ-T) (EQ (CAR-SAFE (THIRD Z)) 'QUOTE-VECTOR) (QUOTEP (SETQ NUM (SECOND (THIRD Z)))) (eq (SETQ NUM (SECOND NUM)) t) ) ;;use the new eq-t misc-op (PEEP-TRACE EQ-T) (SETF (AREF PEEP-CODE-ARRAY Z-PTR) `(MISC D-INDS ,(MISC-LAP-CODE 'EQ-T)))) (T (RETURN Z-PTR))) (COND ((MEMBER (FIRST Z) '(*DIF -) :TEST #'EQ) (SETF (FIRST Z) 'REVERSE-SUBTRACT)) ((EQ (FIRST Z) 'REVERSE-SUBTRACT) (SETF (FIRST Z) '-))) (RETURN Z-PTR))) ;;convert call-n's to specific call-#'s when the number is low enough ((AND (EQ (FIRST Z) 'CALL-N) (EQ (FIRST Y) 'PUSH-NUMBER) (< (SECOND Y) 7)) ;the max is call-6 (PEEP-TRACE CALL-N-TO-CALL) (SETF (FIRST Z) 'CALL) (RPLACD (LAST Z) (CDR Y)) (GO DELETE-Y)) ;; (MOVE D-PDL function) ;; (CALL DEST PDL-POP ...) ==> (CALL DEST function ...) ((AND (EQ (FIRST Z) 'CALL) (EQ (THIRD Z) 'PDL-POP) (EQ (FIRST Y) 'MOVE) (EQ (SECOND Y) 'D-PDL)) (PEEP-TRACE PUSH-THEN-CALL) (SETF (THIRD Z) (THIRD Y)) (GO DELETE-Y)) ;;delete first of two (AUX LEXICAL-UNSHARE-ALL) ((AND (EQUAL Y '(AUX LEXICAL-UNSHARE-ALL)) (EQUAL Z '(AUX LEXICAL-UNSHARE-ALL))) (PEEP-TRACE TWO-LEXICAL-UNSHARE-ALL) (GO DELETE-Y)) ;;combine UNBIND's ((AND (EQ (SECOND Y) 'UNBIND-1) (EQ (SECOND Z) 'UNBIND-1)) (LET ((NUM (+ (THIRD Y) (THIRD Z) 1))) ;plus 1 for each unbind, minus 1 for the new unbind (WHEN (< NUM #o77) (SETF (THIRD Z) NUM) (GO DELETE-Y)))) ;;clm 2/2/88 ;; (MISC TEST NOT-INDICATORS) ----> (AUX RETURN-PRED) ;; (AUX RETURN-NOT-INDS) ((AND (EQ (FIRST Y) 'MISC) (EQ (SECOND Y) 'D-INDS) (EQL (THIRD Y) (MISC-LAP-CODE 'NOT-INDICATORS)) (equal z '(aux return-not-inds))) (setf (second z) 'return-pred) (go delete-y)) ) ;end of COND (RETURN Z-PTR) DELETE-Z (OR (MEMBER (CAR Z) '(NO-DROP-THROUGH COMMENT) :TEST #'EQ) (INCF PEEP-INSNS-SAVED)) (SETF (AREF PEEP-CODE-ARRAY Z-PTR) NIL) (WHEN (EQ (CAR Z) 'BRANCH) (PEEP-CAN-DROP-THROUGH (1+ Z-PTR)) (PEEP-DELETE-TAG-REF (FIFTH Z))) (INCF Z-PTR) ;; If the previous instruction was a NO-DROP-THROUGH ;; we may have turned the branch before it into a branch to .+1. Check for that. (WHEN (OR (EQ (CAR Y) 'NO-DROP-THROUGH) (AND (EQ (FIRST Y) 'BRANCH) (EQ (SECOND Y) 'ALWAYS))) (PEEP-LOCALLY INDEX)) (GO RELOAD-Z) DELETE-Y (SETF (AREF PEEP-CODE-ARRAY INDEX) NIL) (WHEN (EQ (CAR Y) 'BRANCH) (PEEP-CAN-DROP-THROUGH (1+ INDEX)) (PEEP-DELETE-TAG-REF (FIFTH Y))) (INCF PEEP-INSNS-SAVED) (MULTIPLE-VALUE-BIND (I F) (PEEP-PREVIOUS-INSN-INDEX-REDO-TAGS INDEX Z) (SETQ INDEX I) (SETQ TAG-SKIPPED-FLAG (OR F TAG-SKIPPED-FLAG))) (UNLESS INDEX (RETURN Z-PTR)) (SETQ Y (AREF PEEP-CODE-ARRAY INDEX)) ;; If we delete the insn following an unconditional branch, ;; we may have created a branch to .+2 before it, ;; so scan there. (WHEN (AND (EQ (CAR Y) 'BRANCH) (EQ (CADR Y) 'ALWAYS)) (PEEP-LOCALLY INDEX)) (SETQ PEEP-QUEUE (DELETE Y (THE LIST PEEP-QUEUE) :TEST #'EQ)) (GO Y-RELOADED-RELOAD-Z))) ))