1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% File: PVC:386-COMP.SL 4% Title: Compiler patterns for VAX PSL, plus a few cmacro expanders 5% Author: Eric Benson 6% Created: 11 January 1982 7% Modified: 5 June 1984 (Vicki O'Day) 8% Status: Open Source: BSD License 9% Mode: Lisp 10% Package: Compiler 11% 12% (c) Copyright 1982, University of Utah 13% 14% Redistribution and use in source and binary forms, with or without 15% modification, are permitted provided that the following conditions are met: 16% 17% * Redistributions of source code must retain the relevant copyright 18% notice, this list of conditions and the following disclaimer. 19% * Redistributions in binary form must reproduce the above copyright 20% notice, this list of conditions and the following disclaimer in the 21% documentation and/or other materials provided with the distribution. 22% 23% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 24% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 25% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 26% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR 27% CONTRIBUTORS 28% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 29% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 30% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 31% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 32% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 33% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34% POSSIBILITY OF SUCH DAMAGE. 35 36% 37%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 38% 39% Revisions: 40% 41% 17-Aug 1993 (Herbert Melenk) 42% Introduced TVPAT-eq and TVPAT-tag for simple comparisons returning 43% NIL/T. 44% 10-Aug 1993 (Herbert Melenk) 45% Modified MODMEMPAT: update register database when aux register 46% needed. 47% 22 April 1987 (Harold Carr) 48% Moved *lambind, *jumpon, and *foreignlink cmacros (and support) from 49% this file to vax-cmac.sl, where they belong. 50% 5 June 1984 (Vicki O'Day) 51% Incorporated Utah change to make foreign functions be linked 52% through SYMFNC. 53% 18-Jan-84 (Sam Sands) 54% Hacked up so that FIELD will find what constant value it is getting 55% if it is given a register. 56% 12-Jan-84 (Sam Sands) 57% Added patterns 'CARCDRPAT and 'MEMORYPAT; modified MODMEMPAT 58% 06-Dec-83 10:00 (Brian Beach) 59% Translated from Rlisp to Lisp. 60% 61%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 62 63(PUT 'CARCDRPAT 'PATTERN 64 '(NIL NIL 65 ( ANY ('*RETURN (FN A1))))) 66 67(PUT 'MEMORYPAT 'PATTERN 68 '(NIL NIL 69 ((ANY CONST) ('*RETURN (FN A1 A2))) 70 ((REGNP ANY) ('*WPLUS2 A1 A2) ('*SET A1 ('*WPLUS2 A1 A2)) 71 ('*RETURN (FN A1 ('WCONST '0)))) 72 ((ANY REGNP) ('*WPLUS2 A2 A1) ('*SET A2 ('*WPLUS2 A2 A1)) 73 ('*RETURN (FN A2 ('WCONST '0)))) 74 ( ANY ('*LOAD T1 A1) ('*WPLUS2 T1 A2) 75 ('*SET T1 ('*WPLUS2 T1 A2)) 76 ('*RETURN (FN T1 ('WCONST '0)))) 77 )) 78 79 80(commentoutcode 81 82(put 'tvpat 'pattern 83 '(!®mem ('!*destroy dest) 84 ((dest any) (mac l1 a1 a2) ('!*load dest ''nil) 85 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 86 ((any dest) (mac l1 a1 a2) ('!*load dest ''nil) 87 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 88 ((usesdest any) (mac l1 a1 a2) ('!*load dest ''nil) 89 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 90 ((any usesdest) (mac l1 a1 a2) ('!*load dest ''nil) 91 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 92 (any ('!*load dest ''t) (mac l1 a1 a2) 93 ('!*load dest ''nil) ('!*lbl l1)))) 94) 95 96(compiletime (remprop 'nil-t-diff* 'constant!?)) 97(fluid '(nil-t-diff*)) 98(setq nil-t-diff* (difference (id2int nil)(id2int t))) 99(put 'nil-t-diff* 'constant!? t) 100 101(put 'tvpat 'pattern 102 '(!®mem ('!*destroy dest) 103 ((dest any) (mac l1 a1 a2) ('!*load dest ''nil) 104 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 105 ((any dest) (mac l1 a1 a2) ('!*load dest ''nil) 106 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 107 ((usesdest any) (mac l1 a1 a2) ('!*load dest ''nil) 108 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 109 ((any usesdest) (mac l1 a1 a2) ('!*load dest ''nil) 110 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 111 (any ('!*load dest ''t) (mac l1 a1 a2) 112 ('!*wplus2 dest '(wconst nil-t-diff*)) ('!*lbl l1)))) 113 114 115(put 'tvpat1 'pattern 116 '(!®mem ('!*destroy dest) 117 ((dest) (mac l1 a1 p2) ('!*load dest ''nil) ('!*jump l2) 118 ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 119 ((usesdest) (mac l1 a1 p2) ('!*load dest ''nil) 120 ('!*jump l2) ('!*lbl l1) ('!*load dest ''t) ('!*lbl l2)) 121 (any ('!*load dest ''t) (mac l1 a1 p2) 122 ('!*load dest ''nil) ('!*lbl l1)))) 123 124% similar to tvpat for eq/neq tests 125 126(put 'tvpat-eq 'pattern 127 '(!®mem ('!*destroy dest) 128 (any ('*Wcmp a1 a2) 129 ('!*load dest ''t) 130 (&convert-mac l1) 131 ('!*wplus2 dest '(wconst nil-t-diff*)) 132 ('!*lbl l1)))) 133 134% similar to tvpat1 for tag tests 135 136(put 'tvpat-tag 'pattern 137 '(!®mem ('!*destroy dest) 138 (any 139 ('!*load dest a1) 140 ('*wshift dest '-27) 141 ('*wcmp dest p2) 142 ('!*load dest ''t) 143 (&convert-mac l1) 144 ('!*wplus2 dest '(wconst nil-t-diff*)) 145 ('!*lbl l1)))) 146 147 148% transform *JUMPTYPE/*JUMPEQ to JE, *JUMPNOTTYPE/*JUMPNOTEQ to JNE 149 150(put '&convert-mac 'substfn '&convert-mac) 151 152(de &convert-mac(arg args params) 153 (if (or (eq (cadr params) '*JUMPTYPE) 154 (eq (cadr params) '*JUMPEQ)) 155 'je 'jne)) 156 157(put 'tstpat 'pattern 158 '(nil !&fixregtest ((regn any) (mac dest a1 a2)) 159 (any (mac dest a2 a1)))) 160 161(put 'tstpatc 'pattern 162 '(nil !&setregs1 ((regn any) (mac dest a1 a2)) (any (p2 dest a2 a1)))) 163 164(put 'tstpat2 'pattern '(nil !&setregs1 (any (mac dest a1 p2)))) 165 166(put 'setqpat 'pattern 167 '(nil nil ((noval any notanyreg) ('!*store a2 a1)) 168 ((noval dest any) ('!*store a2 dest)) 169 ((noval usesdest any) ('!*load t1 a2) ('!*store t1 a1)) 170 ((noval any any) ('!*load dest a2) ('!*store dest a1)) 171 ((any dest) ('!*store dest a1)) ((dest any) ('!*store a2 dest)) 172 ((usesdest any) ('!*store a2 a1) ('!*store a2 dest)) 173 (any ('!*load dest a2) ('!*store dest a1)))) 174 175(put 'rplacpat 'pattern 176 '(nil nil ((noval any any) ('!*store a2 (mac a1))) 177 ((dest any) ('!*store a2 (mac a1))) 178 ((usesdest any) ('!*store a2 (mac a1)) ('!*load dest a1)) 179 ((any dest) ('!*store a2 (mac a1)) ('!*load dest a1)) 180 ((any usesdest) ('!*store a2 (mac a1)) ('!*load dest a1)) 181 (any ('!*load dest a1) ('!*store a2 (mac dest))))) 182 183(put 'assocpat 'pattern 184 '(nil ('!*set dest (fn a1 a2)) ((dest any) (mac a1 a2)) 185 ((any dest) (mac a2 a1)) 186 ((usesdest usesdest) ('!*load t1 a1) ('!*load dest a2) 187 (mac dest t1)) 188 ((any usesdest) ('!*load dest a2) (mac dest a1)) 189 (any ('!*load dest a1) (mac dest a2)))) 190 191(put 'subpat 'pattern 192 '(nil ('!*set dest (fn a1 a2)) ((dest any) (mac a1 a2)) 193 ((any dest) ('!*wminus dest dest) ('!*wplus2 a2 a1)) 194 ((any usesdest) ('!*load t1 a2) ('!*load dest a1) (mac dest t1)) 195 (any ('!*load dest a1) (mac dest a2)))) 196 197(put 'nonassocpat 'pattern 198 '(nil ('!*set dest (fn a1 a2)) ((dest any) (mac a1 a2)) 199 ((any usesdest) ('!*load t1 a2) ('!*load dest a1) (mac dest t1)) 200 (any ('!*load dest a1) (mac dest a2)))) 201 202(put 'fieldpat 'pattern 203 '(&constfieldargs ('!*set dest (fn a1 a2 a3)) (any (mac dest a1 a2 a3)))) 204 205(de &constfieldargs(args) 206 (cond ((registerp (second args)) 207 (&constfieldargs 208 (list (first args) (&constregval (second args)) (third args)))) 209 ((registerp (third args)) 210 (list (first args) (second args) (&constregval (third args)))) 211 (t args))) 212 213(de &constregval (reg) 214 % Return a constant value known to be in the register, if any, otherwise 215 % just return the register. 216 (for (in value (®val reg)) 217 (do (when (&constp value) 218 (return value))) 219 (returns reg) 220 )) 221 222(put 'putfieldpat 'pattern 223 '(nil nil ((noval any any any any) (mac a1 a2 a3 a4)) 224 (any (mac a1 a2 a3 a4) ('!*store a1 dest)))) 225 226(put 'unarypat 'pattern 227 '(!&noanyreg ('!*set dest (fn a1)) (any (mac dest a1)))) 228 229(put 'modmempat 'pattern '(nil nil 230 ((NOVAL ANY ANY) (mac a1 a2)) 231 (( ANY REGNP) (P2 A2 LA1) 232 ('*STORE A2 A1) 233 ('*RETURN A2)) 234 ( ANY ('*LOAD T2 A2) 235 (P2 T2 LA1) 236 ('!*set t2 (fn a1 a2)) % HM 237 ('*STORE T2 A1) 238 ('*RETURN T2)) 239 )) 240 241(put 'modmempat1 'pattern '(nil nil (any (mac a1 a1)))) 242 243% End of file. 244 245