PPCInstrInfo.td revision 3c99602ca87f604080e367838180c3d63f6931f3
1//===-- PPCInstrInfo.td - The PowerPC Instruction Set ------*- tablegen -*-===//
2//
3//                     The LLVM Compiler Infrastructure
4//
5// This file is distributed under the University of Illinois Open Source
6// License. See LICENSE.TXT for details.
7//
8//===----------------------------------------------------------------------===//
9//
10// This file describes the subset of the 32-bit PowerPC instruction set, as used
11// by the PowerPC instruction selector.
12//
13//===----------------------------------------------------------------------===//
14
15include "PPCInstrFormats.td"
16
17//===----------------------------------------------------------------------===//
18// PowerPC specific type constraints.
19//
20def SDT_PPCstfiwx : SDTypeProfile<0, 2, [ // stfiwx
21  SDTCisVT<0, f64>, SDTCisPtrTy<1>
22]>;
23def SDT_PPClfiwx : SDTypeProfile<1, 1, [ // lfiw[az]x
24  SDTCisVT<0, f64>, SDTCisPtrTy<1>
25]>;
26
27def SDT_PPCCallSeqStart : SDCallSeqStart<[ SDTCisVT<0, i32> ]>;
28def SDT_PPCCallSeqEnd   : SDCallSeqEnd<[ SDTCisVT<0, i32>,
29                                         SDTCisVT<1, i32> ]>;
30def SDT_PPCvperm   : SDTypeProfile<1, 3, [
31  SDTCisVT<3, v16i8>, SDTCisSameAs<0, 1>, SDTCisSameAs<0, 2>
32]>;
33
34def SDT_PPCvcmp : SDTypeProfile<1, 3, [
35  SDTCisSameAs<0, 1>, SDTCisSameAs<1, 2>, SDTCisVT<3, i32>
36]>;
37
38def SDT_PPCcondbr : SDTypeProfile<0, 3, [
39  SDTCisVT<0, i32>, SDTCisVT<2, OtherVT>
40]>;
41
42def SDT_PPClbrx : SDTypeProfile<1, 2, [
43  SDTCisInt<0>, SDTCisPtrTy<1>, SDTCisVT<2, OtherVT>
44]>;
45def SDT_PPCstbrx : SDTypeProfile<0, 3, [
46  SDTCisInt<0>, SDTCisPtrTy<1>, SDTCisVT<2, OtherVT>
47]>;
48
49def SDT_PPClarx : SDTypeProfile<1, 1, [
50  SDTCisInt<0>, SDTCisPtrTy<1>
51]>;
52def SDT_PPCstcx : SDTypeProfile<0, 2, [
53  SDTCisInt<0>, SDTCisPtrTy<1>
54]>;
55
56def SDT_PPCTC_ret : SDTypeProfile<0, 2, [
57  SDTCisPtrTy<0>, SDTCisVT<1, i32>
58]>;
59
60
61//===----------------------------------------------------------------------===//
62// PowerPC specific DAG Nodes.
63//
64
65def PPCfre    : SDNode<"PPCISD::FRE",     SDTFPUnaryOp, []>;
66def PPCfrsqrte: SDNode<"PPCISD::FRSQRTE", SDTFPUnaryOp, []>;
67
68def PPCfcfid  : SDNode<"PPCISD::FCFID",   SDTFPUnaryOp, []>;
69def PPCfcfidu : SDNode<"PPCISD::FCFIDU",  SDTFPUnaryOp, []>;
70def PPCfcfids : SDNode<"PPCISD::FCFIDS",  SDTFPRoundOp, []>;
71def PPCfcfidus: SDNode<"PPCISD::FCFIDUS", SDTFPRoundOp, []>;
72def PPCfctidz : SDNode<"PPCISD::FCTIDZ", SDTFPUnaryOp, []>;
73def PPCfctiwz : SDNode<"PPCISD::FCTIWZ", SDTFPUnaryOp, []>;
74def PPCfctiduz: SDNode<"PPCISD::FCTIDUZ",SDTFPUnaryOp, []>;
75def PPCfctiwuz: SDNode<"PPCISD::FCTIWUZ",SDTFPUnaryOp, []>;
76def PPCstfiwx : SDNode<"PPCISD::STFIWX", SDT_PPCstfiwx,
77                       [SDNPHasChain, SDNPMayStore]>;
78def PPClfiwax : SDNode<"PPCISD::LFIWAX", SDT_PPClfiwx,
79                       [SDNPHasChain, SDNPMayLoad]>;
80def PPClfiwzx : SDNode<"PPCISD::LFIWZX", SDT_PPClfiwx,
81                       [SDNPHasChain, SDNPMayLoad]>;
82
83// Extract FPSCR (not modeled at the DAG level).
84def PPCmffs   : SDNode<"PPCISD::MFFS",
85                       SDTypeProfile<1, 0, [SDTCisVT<0, f64>]>, []>;
86
87// Perform FADD in round-to-zero mode.
88def PPCfaddrtz: SDNode<"PPCISD::FADDRTZ", SDTFPBinOp, []>;
89
90
91def PPCfsel   : SDNode<"PPCISD::FSEL",  
92   // Type constraint for fsel.
93   SDTypeProfile<1, 3, [SDTCisSameAs<0, 2>, SDTCisSameAs<0, 3>, 
94                        SDTCisFP<0>, SDTCisVT<1, f64>]>, []>;
95
96def PPChi       : SDNode<"PPCISD::Hi", SDTIntBinOp, []>;
97def PPClo       : SDNode<"PPCISD::Lo", SDTIntBinOp, []>;
98def PPCtoc_entry: SDNode<"PPCISD::TOC_ENTRY", SDTIntBinOp, [SDNPMayLoad]>;
99def PPCvmaddfp  : SDNode<"PPCISD::VMADDFP", SDTFPTernaryOp, []>;
100def PPCvnmsubfp : SDNode<"PPCISD::VNMSUBFP", SDTFPTernaryOp, []>;
101
102def PPCaddisGotTprelHA : SDNode<"PPCISD::ADDIS_GOT_TPREL_HA", SDTIntBinOp>;
103def PPCldGotTprelL : SDNode<"PPCISD::LD_GOT_TPREL_L", SDTIntBinOp,
104                            [SDNPMayLoad]>;
105def PPCaddTls     : SDNode<"PPCISD::ADD_TLS", SDTIntBinOp, []>;
106def PPCaddisTlsgdHA : SDNode<"PPCISD::ADDIS_TLSGD_HA", SDTIntBinOp>;
107def PPCaddiTlsgdL   : SDNode<"PPCISD::ADDI_TLSGD_L", SDTIntBinOp>;
108def PPCgetTlsAddr   : SDNode<"PPCISD::GET_TLS_ADDR", SDTIntBinOp>;
109def PPCaddisTlsldHA : SDNode<"PPCISD::ADDIS_TLSLD_HA", SDTIntBinOp>;
110def PPCaddiTlsldL   : SDNode<"PPCISD::ADDI_TLSLD_L", SDTIntBinOp>;
111def PPCgetTlsldAddr : SDNode<"PPCISD::GET_TLSLD_ADDR", SDTIntBinOp>;
112def PPCaddisDtprelHA : SDNode<"PPCISD::ADDIS_DTPREL_HA", SDTIntBinOp,
113                              [SDNPHasChain]>;
114def PPCaddiDtprelL   : SDNode<"PPCISD::ADDI_DTPREL_L", SDTIntBinOp>;
115
116def PPCvperm    : SDNode<"PPCISD::VPERM", SDT_PPCvperm, []>;
117
118// These nodes represent the 32-bit PPC shifts that operate on 6-bit shift
119// amounts.  These nodes are generated by the multi-precision shift code.
120def PPCsrl        : SDNode<"PPCISD::SRL"       , SDTIntShiftOp>;
121def PPCsra        : SDNode<"PPCISD::SRA"       , SDTIntShiftOp>;
122def PPCshl        : SDNode<"PPCISD::SHL"       , SDTIntShiftOp>;
123
124// These are target-independent nodes, but have target-specific formats.
125def callseq_start : SDNode<"ISD::CALLSEQ_START", SDT_PPCCallSeqStart,
126                           [SDNPHasChain, SDNPOutGlue]>;
127def callseq_end   : SDNode<"ISD::CALLSEQ_END",   SDT_PPCCallSeqEnd,
128                           [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue]>;
129
130def SDT_PPCCall   : SDTypeProfile<0, -1, [SDTCisInt<0>]>;
131def PPCcall  : SDNode<"PPCISD::CALL", SDT_PPCCall,
132                      [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue,
133                       SDNPVariadic]>;
134def PPCcall_nop  : SDNode<"PPCISD::CALL_NOP", SDT_PPCCall,
135                          [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue,
136                           SDNPVariadic]>;
137def PPCload   : SDNode<"PPCISD::LOAD", SDTypeProfile<1, 1, []>,
138                       [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue]>;
139def PPCload_toc : SDNode<"PPCISD::LOAD_TOC", SDTypeProfile<0, 1, []>,
140                          [SDNPHasChain, SDNPSideEffect,
141                           SDNPInGlue, SDNPOutGlue]>;
142def PPCtoc_restore : SDNode<"PPCISD::TOC_RESTORE", SDTypeProfile<0, 0, []>,
143                            [SDNPHasChain, SDNPSideEffect,
144                             SDNPInGlue, SDNPOutGlue]>;
145def PPCmtctr      : SDNode<"PPCISD::MTCTR", SDT_PPCCall,
146                           [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue]>;
147def PPCbctrl : SDNode<"PPCISD::BCTRL", SDTNone,
148                      [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue,
149                       SDNPVariadic]>;
150
151def retflag       : SDNode<"PPCISD::RET_FLAG", SDTNone,
152                           [SDNPHasChain, SDNPOptInGlue, SDNPVariadic]>;
153
154def PPCtc_return : SDNode<"PPCISD::TC_RETURN", SDT_PPCTC_ret,
155                        [SDNPHasChain,  SDNPOptInGlue, SDNPVariadic]>;
156
157def PPCeh_sjlj_setjmp  : SDNode<"PPCISD::EH_SJLJ_SETJMP",
158                                SDTypeProfile<1, 1, [SDTCisInt<0>,
159                                                     SDTCisPtrTy<1>]>,
160                                [SDNPHasChain, SDNPSideEffect]>;
161def PPCeh_sjlj_longjmp : SDNode<"PPCISD::EH_SJLJ_LONGJMP",
162                                SDTypeProfile<0, 1, [SDTCisPtrTy<0>]>,
163                                [SDNPHasChain, SDNPSideEffect]>;
164
165def SDT_PPCsc     : SDTypeProfile<0, 1, [SDTCisInt<0>]>;
166def PPCsc         : SDNode<"PPCISD::SC", SDT_PPCsc,
167                           [SDNPHasChain, SDNPSideEffect]>;
168
169def PPCvcmp       : SDNode<"PPCISD::VCMP" , SDT_PPCvcmp, []>;
170def PPCvcmp_o     : SDNode<"PPCISD::VCMPo", SDT_PPCvcmp, [SDNPOutGlue]>;
171
172def PPCcondbranch : SDNode<"PPCISD::COND_BRANCH", SDT_PPCcondbr,
173                           [SDNPHasChain, SDNPOptInGlue]>;
174
175def PPClbrx       : SDNode<"PPCISD::LBRX", SDT_PPClbrx,
176                           [SDNPHasChain, SDNPMayLoad]>;
177def PPCstbrx      : SDNode<"PPCISD::STBRX", SDT_PPCstbrx,
178                           [SDNPHasChain, SDNPMayStore]>;
179
180// Instructions to set/unset CR bit 6 for SVR4 vararg calls
181def PPCcr6set   : SDNode<"PPCISD::CR6SET", SDTNone,
182                         [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue]>;
183def PPCcr6unset : SDNode<"PPCISD::CR6UNSET", SDTNone,
184                         [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue]>;
185
186// Instructions to support atomic operations
187def PPClarx      : SDNode<"PPCISD::LARX", SDT_PPClarx,
188                          [SDNPHasChain, SDNPMayLoad]>;
189def PPCstcx      : SDNode<"PPCISD::STCX", SDT_PPCstcx,
190                          [SDNPHasChain, SDNPMayStore]>;
191
192// Instructions to support medium and large code model
193def PPCaddisTocHA : SDNode<"PPCISD::ADDIS_TOC_HA", SDTIntBinOp, []>;
194def PPCldTocL     : SDNode<"PPCISD::LD_TOC_L", SDTIntBinOp, [SDNPMayLoad]>;
195def PPCaddiTocL   : SDNode<"PPCISD::ADDI_TOC_L", SDTIntBinOp, []>;
196
197
198// Instructions to support dynamic alloca.
199def SDTDynOp  : SDTypeProfile<1, 2, []>;
200def PPCdynalloc   : SDNode<"PPCISD::DYNALLOC", SDTDynOp, [SDNPHasChain]>;
201
202//===----------------------------------------------------------------------===//
203// PowerPC specific transformation functions and pattern fragments.
204//
205
206def SHL32 : SDNodeXForm<imm, [{
207  // Transformation function: 31 - imm
208  return getI32Imm(31 - N->getZExtValue());
209}]>;
210
211def SRL32 : SDNodeXForm<imm, [{
212  // Transformation function: 32 - imm
213  return N->getZExtValue() ? getI32Imm(32 - N->getZExtValue()) : getI32Imm(0);
214}]>;
215
216def LO16 : SDNodeXForm<imm, [{
217  // Transformation function: get the low 16 bits.
218  return getI32Imm((unsigned short)N->getZExtValue());
219}]>;
220
221def HI16 : SDNodeXForm<imm, [{
222  // Transformation function: shift the immediate value down into the low bits.
223  return getI32Imm((unsigned)N->getZExtValue() >> 16);
224}]>;
225
226def HA16 : SDNodeXForm<imm, [{
227  // Transformation function: shift the immediate value down into the low bits.
228  signed int Val = N->getZExtValue();
229  return getI32Imm((Val - (signed short)Val) >> 16);
230}]>;
231def MB : SDNodeXForm<imm, [{
232  // Transformation function: get the start bit of a mask
233  unsigned mb = 0, me;
234  (void)isRunOfOnes((unsigned)N->getZExtValue(), mb, me);
235  return getI32Imm(mb);
236}]>;
237
238def ME : SDNodeXForm<imm, [{
239  // Transformation function: get the end bit of a mask
240  unsigned mb, me = 0;
241  (void)isRunOfOnes((unsigned)N->getZExtValue(), mb, me);
242  return getI32Imm(me);
243}]>;
244def maskimm32 : PatLeaf<(imm), [{
245  // maskImm predicate - True if immediate is a run of ones.
246  unsigned mb, me;
247  if (N->getValueType(0) == MVT::i32)
248    return isRunOfOnes((unsigned)N->getZExtValue(), mb, me);
249  else
250    return false;
251}]>;
252
253def imm32SExt16  : Operand<i32>, ImmLeaf<i32, [{
254  // imm32SExt16 predicate - True if the i32 immediate fits in a 16-bit
255  // sign extended field.  Used by instructions like 'addi'.
256  return (int32_t)Imm == (short)Imm;
257}]>;
258def imm64SExt16  : Operand<i64>, ImmLeaf<i64, [{
259  // imm64SExt16 predicate - True if the i64 immediate fits in a 16-bit
260  // sign extended field.  Used by instructions like 'addi'.
261  return (int64_t)Imm == (short)Imm;
262}]>;
263def immZExt16  : PatLeaf<(imm), [{
264  // immZExt16 predicate - True if the immediate fits in a 16-bit zero extended
265  // field.  Used by instructions like 'ori'.
266  return (uint64_t)N->getZExtValue() == (unsigned short)N->getZExtValue();
267}], LO16>;
268
269// imm16Shifted* - These match immediates where the low 16-bits are zero.  There
270// are two forms: imm16ShiftedSExt and imm16ShiftedZExt.  These two forms are
271// identical in 32-bit mode, but in 64-bit mode, they return true if the
272// immediate fits into a sign/zero extended 32-bit immediate (with the low bits
273// clear).
274def imm16ShiftedZExt : PatLeaf<(imm), [{
275  // imm16ShiftedZExt predicate - True if only bits in the top 16-bits of the
276  // immediate are set.  Used by instructions like 'xoris'.
277  return (N->getZExtValue() & ~uint64_t(0xFFFF0000)) == 0;
278}], HI16>;
279
280def imm16ShiftedSExt : PatLeaf<(imm), [{
281  // imm16ShiftedSExt predicate - True if only bits in the top 16-bits of the
282  // immediate are set.  Used by instructions like 'addis'.  Identical to 
283  // imm16ShiftedZExt in 32-bit mode.
284  if (N->getZExtValue() & 0xFFFF) return false;
285  if (N->getValueType(0) == MVT::i32)
286    return true;
287  // For 64-bit, make sure it is sext right.
288  return N->getZExtValue() == (uint64_t)(int)N->getZExtValue();
289}], HI16>;
290
291// Some r+i load/store instructions (such as LD, STD, LDU, etc.) that require
292// restricted memrix (4-aligned) constants are alignment sensitive. If these
293// offsets are hidden behind TOC entries than the values of the lower-order
294// bits cannot be checked directly. As a result, we need to also incorporate
295// an alignment check into the relevant patterns.
296
297def aligned4load : PatFrag<(ops node:$ptr), (load node:$ptr), [{
298  return cast<LoadSDNode>(N)->getAlignment() >= 4;
299}]>;
300def aligned4store : PatFrag<(ops node:$val, node:$ptr),
301                            (store node:$val, node:$ptr), [{
302  return cast<StoreSDNode>(N)->getAlignment() >= 4;
303}]>;
304def aligned4sextloadi32 : PatFrag<(ops node:$ptr), (sextloadi32 node:$ptr), [{
305  return cast<LoadSDNode>(N)->getAlignment() >= 4;
306}]>;
307def aligned4pre_store : PatFrag<
308                          (ops node:$val, node:$base, node:$offset),
309                          (pre_store node:$val, node:$base, node:$offset), [{
310  return cast<StoreSDNode>(N)->getAlignment() >= 4;
311}]>;
312
313def unaligned4load : PatFrag<(ops node:$ptr), (load node:$ptr), [{
314  return cast<LoadSDNode>(N)->getAlignment() < 4;
315}]>;
316def unaligned4store : PatFrag<(ops node:$val, node:$ptr),
317                              (store node:$val, node:$ptr), [{
318  return cast<StoreSDNode>(N)->getAlignment() < 4;
319}]>;
320def unaligned4sextloadi32 : PatFrag<(ops node:$ptr), (sextloadi32 node:$ptr), [{
321  return cast<LoadSDNode>(N)->getAlignment() < 4;
322}]>;
323
324//===----------------------------------------------------------------------===//
325// PowerPC Flag Definitions.
326
327class isPPC64 { bit PPC64 = 1; }
328class isDOT   { bit RC = 1; }
329
330class RegConstraint<string C> {
331  string Constraints = C;
332}
333class NoEncode<string E> {
334  string DisableEncoding = E;
335}
336
337
338//===----------------------------------------------------------------------===//
339// PowerPC Operand Definitions.
340
341// In the default PowerPC assembler syntax, registers are specified simply
342// by number, so they cannot be distinguished from immediate values (without
343// looking at the opcode).  This means that the default operand matching logic
344// for the asm parser does not work, and we need to specify custom matchers.
345// Since those can only be specified with RegisterOperand classes and not
346// directly on the RegisterClass, all instructions patterns used by the asm
347// parser need to use a RegisterOperand (instead of a RegisterClass) for
348// all their register operands.
349// For this purpose, we define one RegisterOperand for each RegisterClass,
350// using the same name as the class, just in lower case.
351
352def PPCRegGPRCAsmOperand : AsmOperandClass {
353  let Name = "RegGPRC"; let PredicateMethod = "isRegNumber";
354}
355def gprc : RegisterOperand<GPRC> {
356  let ParserMatchClass = PPCRegGPRCAsmOperand;
357}
358def PPCRegG8RCAsmOperand : AsmOperandClass {
359  let Name = "RegG8RC"; let PredicateMethod = "isRegNumber";
360}
361def g8rc : RegisterOperand<G8RC> {
362  let ParserMatchClass = PPCRegG8RCAsmOperand;
363}
364def PPCRegGPRCNoR0AsmOperand : AsmOperandClass {
365  let Name = "RegGPRCNoR0"; let PredicateMethod = "isRegNumber";
366}
367def gprc_nor0 : RegisterOperand<GPRC_NOR0> {
368  let ParserMatchClass = PPCRegGPRCNoR0AsmOperand;
369}
370def PPCRegG8RCNoX0AsmOperand : AsmOperandClass {
371  let Name = "RegG8RCNoX0"; let PredicateMethod = "isRegNumber";
372}
373def g8rc_nox0 : RegisterOperand<G8RC_NOX0> {
374  let ParserMatchClass = PPCRegG8RCNoX0AsmOperand;
375}
376def PPCRegF8RCAsmOperand : AsmOperandClass {
377  let Name = "RegF8RC"; let PredicateMethod = "isRegNumber";
378}
379def f8rc : RegisterOperand<F8RC> {
380  let ParserMatchClass = PPCRegF8RCAsmOperand;
381}
382def PPCRegF4RCAsmOperand : AsmOperandClass {
383  let Name = "RegF4RC"; let PredicateMethod = "isRegNumber";
384}
385def f4rc : RegisterOperand<F4RC> {
386  let ParserMatchClass = PPCRegF4RCAsmOperand;
387}
388def PPCRegVRRCAsmOperand : AsmOperandClass {
389  let Name = "RegVRRC"; let PredicateMethod = "isRegNumber";
390}
391def vrrc : RegisterOperand<VRRC> {
392  let ParserMatchClass = PPCRegVRRCAsmOperand;
393}
394def PPCRegCRBITRCAsmOperand : AsmOperandClass {
395  let Name = "RegCRBITRC"; let PredicateMethod = "isCRBitNumber";
396}
397def crbitrc : RegisterOperand<CRBITRC> {
398  let ParserMatchClass = PPCRegCRBITRCAsmOperand;
399}
400def PPCRegCRRCAsmOperand : AsmOperandClass {
401  let Name = "RegCRRC"; let PredicateMethod = "isCCRegNumber";
402}
403def crrc : RegisterOperand<CRRC> {
404  let ParserMatchClass = PPCRegCRRCAsmOperand;
405}
406
407def PPCS5ImmAsmOperand : AsmOperandClass {
408  let Name = "S5Imm"; let PredicateMethod = "isS5Imm";
409  let RenderMethod = "addImmOperands";
410}
411def s5imm   : Operand<i32> {
412  let PrintMethod = "printS5ImmOperand";
413  let ParserMatchClass = PPCS5ImmAsmOperand;
414}
415def PPCU5ImmAsmOperand : AsmOperandClass {
416  let Name = "U5Imm"; let PredicateMethod = "isU5Imm";
417  let RenderMethod = "addImmOperands";
418}
419def u5imm   : Operand<i32> {
420  let PrintMethod = "printU5ImmOperand";
421  let ParserMatchClass = PPCU5ImmAsmOperand;
422}
423def PPCU6ImmAsmOperand : AsmOperandClass {
424  let Name = "U6Imm"; let PredicateMethod = "isU6Imm";
425  let RenderMethod = "addImmOperands";
426}
427def u6imm   : Operand<i32> {
428  let PrintMethod = "printU6ImmOperand";
429  let ParserMatchClass = PPCU6ImmAsmOperand;
430}
431def PPCS16ImmAsmOperand : AsmOperandClass {
432  let Name = "S16Imm"; let PredicateMethod = "isS16Imm";
433  let RenderMethod = "addImmOperands";
434}
435def s16imm  : Operand<i32> {
436  let PrintMethod = "printS16ImmOperand";
437  let EncoderMethod = "getImm16Encoding";
438  let ParserMatchClass = PPCS16ImmAsmOperand;
439}
440def PPCU16ImmAsmOperand : AsmOperandClass {
441  let Name = "U16Imm"; let PredicateMethod = "isU16Imm";
442  let RenderMethod = "addImmOperands";
443}
444def u16imm  : Operand<i32> {
445  let PrintMethod = "printU16ImmOperand";
446  let EncoderMethod = "getImm16Encoding";
447  let ParserMatchClass = PPCU16ImmAsmOperand;
448}
449def PPCS17ImmAsmOperand : AsmOperandClass {
450  let Name = "S17Imm"; let PredicateMethod = "isS17Imm";
451  let RenderMethod = "addImmOperands";
452}
453def s17imm  : Operand<i32> {
454  // This operand type is used for addis/lis to allow the assembler parser
455  // to accept immediates in the range -65536..65535 for compatibility with
456  // the GNU assembler.  The operand is treated as 16-bit otherwise.
457  let PrintMethod = "printS16ImmOperand";
458  let EncoderMethod = "getImm16Encoding";
459  let ParserMatchClass = PPCS17ImmAsmOperand;
460}
461def PPCDirectBrAsmOperand : AsmOperandClass {
462  let Name = "DirectBr"; let PredicateMethod = "isDirectBr";
463  let RenderMethod = "addBranchTargetOperands";
464}
465def directbrtarget : Operand<OtherVT> {
466  let PrintMethod = "printBranchOperand";
467  let EncoderMethod = "getDirectBrEncoding";
468  let ParserMatchClass = PPCDirectBrAsmOperand;
469}
470def absdirectbrtarget : Operand<OtherVT> {
471  let PrintMethod = "printAbsBranchOperand";
472  let EncoderMethod = "getAbsDirectBrEncoding";
473  let ParserMatchClass = PPCDirectBrAsmOperand;
474}
475def PPCCondBrAsmOperand : AsmOperandClass {
476  let Name = "CondBr"; let PredicateMethod = "isCondBr";
477  let RenderMethod = "addBranchTargetOperands";
478}
479def condbrtarget : Operand<OtherVT> {
480  let PrintMethod = "printBranchOperand";
481  let EncoderMethod = "getCondBrEncoding";
482  let ParserMatchClass = PPCCondBrAsmOperand;
483}
484def abscondbrtarget : Operand<OtherVT> {
485  let PrintMethod = "printAbsBranchOperand";
486  let EncoderMethod = "getAbsCondBrEncoding";
487  let ParserMatchClass = PPCCondBrAsmOperand;
488}
489def calltarget : Operand<iPTR> {
490  let PrintMethod = "printBranchOperand";
491  let EncoderMethod = "getDirectBrEncoding";
492  let ParserMatchClass = PPCDirectBrAsmOperand;
493}
494def abscalltarget : Operand<iPTR> {
495  let PrintMethod = "printAbsBranchOperand";
496  let EncoderMethod = "getAbsDirectBrEncoding";
497  let ParserMatchClass = PPCDirectBrAsmOperand;
498}
499def PPCCRBitMaskOperand : AsmOperandClass {
500 let Name = "CRBitMask"; let PredicateMethod = "isCRBitMask";
501}
502def crbitm: Operand<i8> {
503  let PrintMethod = "printcrbitm";
504  let EncoderMethod = "get_crbitm_encoding";
505  let ParserMatchClass = PPCCRBitMaskOperand;
506}
507// Address operands
508// A version of ptr_rc which excludes R0 (or X0 in 64-bit mode).
509def PPCRegGxRCNoR0Operand : AsmOperandClass {
510  let Name = "RegGxRCNoR0"; let PredicateMethod = "isRegNumber";
511}
512def ptr_rc_nor0 : Operand<iPTR>, PointerLikeRegClass<1> {
513  let ParserMatchClass = PPCRegGxRCNoR0Operand;
514}
515// A version of ptr_rc usable with the asm parser.
516def PPCRegGxRCOperand : AsmOperandClass {
517  let Name = "RegGxRC"; let PredicateMethod = "isRegNumber";
518}
519def ptr_rc_idx : Operand<iPTR>, PointerLikeRegClass<0> {
520  let ParserMatchClass = PPCRegGxRCOperand;
521}
522
523def PPCDispRIOperand : AsmOperandClass {
524 let Name = "DispRI"; let PredicateMethod = "isS16Imm";
525 let RenderMethod = "addImmOperands";
526}
527def dispRI : Operand<iPTR> {
528  let ParserMatchClass = PPCDispRIOperand;
529}
530def PPCDispRIXOperand : AsmOperandClass {
531 let Name = "DispRIX"; let PredicateMethod = "isS16ImmX4";
532 let RenderMethod = "addImmOperands";
533}
534def dispRIX : Operand<iPTR> {
535  let ParserMatchClass = PPCDispRIXOperand;
536}
537
538def memri : Operand<iPTR> {
539  let PrintMethod = "printMemRegImm";
540  let MIOperandInfo = (ops dispRI:$imm, ptr_rc_nor0:$reg);
541  let EncoderMethod = "getMemRIEncoding";
542}
543def memrr : Operand<iPTR> {
544  let PrintMethod = "printMemRegReg";
545  let MIOperandInfo = (ops ptr_rc_nor0:$ptrreg, ptr_rc_idx:$offreg);
546}
547def memrix : Operand<iPTR> {   // memri where the imm is 4-aligned.
548  let PrintMethod = "printMemRegImm";
549  let MIOperandInfo = (ops dispRIX:$imm, ptr_rc_nor0:$reg);
550  let EncoderMethod = "getMemRIXEncoding";
551}
552
553// A single-register address. This is used with the SjLj
554// pseudo-instructions.
555def memr : Operand<iPTR> {
556  let MIOperandInfo = (ops ptr_rc:$ptrreg);
557}
558
559// PowerPC Predicate operand.
560def pred : Operand<OtherVT> {
561  let PrintMethod = "printPredicateOperand";
562  let MIOperandInfo = (ops i32imm:$bibo, crrc:$reg);
563}
564
565// Define PowerPC specific addressing mode.
566def iaddr  : ComplexPattern<iPTR, 2, "SelectAddrImm",    [], []>;
567def xaddr  : ComplexPattern<iPTR, 2, "SelectAddrIdx",    [], []>;
568def xoaddr : ComplexPattern<iPTR, 2, "SelectAddrIdxOnly",[], []>;
569def ixaddr : ComplexPattern<iPTR, 2, "SelectAddrImmX4",  [], []>; // "std"
570
571// The address in a single register. This is used with the SjLj
572// pseudo-instructions.
573def addr   : ComplexPattern<iPTR, 1, "SelectAddr",[], []>;
574
575/// This is just the offset part of iaddr, used for preinc.
576def iaddroff : ComplexPattern<iPTR, 1, "SelectAddrImmOffs", [], []>;
577
578//===----------------------------------------------------------------------===//
579// PowerPC Instruction Predicate Definitions.
580def In32BitMode  : Predicate<"!PPCSubTarget.isPPC64()">;
581def In64BitMode  : Predicate<"PPCSubTarget.isPPC64()">;
582def IsBookE  : Predicate<"PPCSubTarget.isBookE()">;
583
584//===----------------------------------------------------------------------===//
585// PowerPC Multiclass Definitions.
586
587multiclass XForm_6r<bits<6> opcode, bits<10> xo, dag OOL, dag IOL,
588                    string asmbase, string asmstr, InstrItinClass itin,
589                    list<dag> pattern> {
590  let BaseName = asmbase in {
591    def NAME : XForm_6<opcode, xo, OOL, IOL,
592                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
593                       pattern>, RecFormRel;
594    let Defs = [CR0] in
595    def o    : XForm_6<opcode, xo, OOL, IOL,
596                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
597                       []>, isDOT, RecFormRel;
598  }
599}
600
601multiclass XForm_6rc<bits<6> opcode, bits<10> xo, dag OOL, dag IOL,
602                     string asmbase, string asmstr, InstrItinClass itin,
603                     list<dag> pattern> {
604  let BaseName = asmbase in {
605    let Defs = [CARRY] in
606    def NAME : XForm_6<opcode, xo, OOL, IOL,
607                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
608                       pattern>, RecFormRel;
609    let Defs = [CARRY, CR0] in
610    def o    : XForm_6<opcode, xo, OOL, IOL,
611                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
612                       []>, isDOT, RecFormRel;
613  }
614}
615
616multiclass XForm_10r<bits<6> opcode, bits<10> xo, dag OOL, dag IOL,
617                    string asmbase, string asmstr, InstrItinClass itin,
618                    list<dag> pattern> {
619  let BaseName = asmbase in {
620    def NAME : XForm_10<opcode, xo, OOL, IOL,
621                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
622                       pattern>, RecFormRel;
623    let Defs = [CR0] in
624    def o    : XForm_10<opcode, xo, OOL, IOL,
625                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
626                       []>, isDOT, RecFormRel;
627  }
628}
629
630multiclass XForm_10rc<bits<6> opcode, bits<10> xo, dag OOL, dag IOL,
631                      string asmbase, string asmstr, InstrItinClass itin,
632                      list<dag> pattern> {
633  let BaseName = asmbase in {
634    let Defs = [CARRY] in
635    def NAME : XForm_10<opcode, xo, OOL, IOL,
636                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
637                       pattern>, RecFormRel;
638    let Defs = [CARRY, CR0] in
639    def o    : XForm_10<opcode, xo, OOL, IOL,
640                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
641                       []>, isDOT, RecFormRel;
642  }
643}
644
645multiclass XForm_11r<bits<6> opcode, bits<10> xo, dag OOL, dag IOL,
646                    string asmbase, string asmstr, InstrItinClass itin,
647                    list<dag> pattern> {
648  let BaseName = asmbase in {
649    def NAME : XForm_11<opcode, xo, OOL, IOL,
650                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
651                       pattern>, RecFormRel;
652    let Defs = [CR0] in
653    def o    : XForm_11<opcode, xo, OOL, IOL,
654                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
655                       []>, isDOT, RecFormRel;
656  }
657}
658
659multiclass XOForm_1r<bits<6> opcode, bits<9> xo, bit oe, dag OOL, dag IOL,
660                    string asmbase, string asmstr, InstrItinClass itin,
661                    list<dag> pattern> {
662  let BaseName = asmbase in {
663    def NAME : XOForm_1<opcode, xo, oe, OOL, IOL,
664                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
665                       pattern>, RecFormRel;
666    let Defs = [CR0] in
667    def o    : XOForm_1<opcode, xo, oe, OOL, IOL,
668                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
669                       []>, isDOT, RecFormRel;
670  }
671}
672
673multiclass XOForm_1rc<bits<6> opcode, bits<9> xo, bit oe, dag OOL, dag IOL,
674                      string asmbase, string asmstr, InstrItinClass itin,
675                      list<dag> pattern> {
676  let BaseName = asmbase in {
677    let Defs = [CARRY] in
678    def NAME : XOForm_1<opcode, xo, oe, OOL, IOL,
679                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
680                       pattern>, RecFormRel;
681    let Defs = [CARRY, CR0] in
682    def o    : XOForm_1<opcode, xo, oe, OOL, IOL,
683                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
684                       []>, isDOT, RecFormRel;
685  }
686}
687
688multiclass XOForm_3r<bits<6> opcode, bits<9> xo, bit oe, dag OOL, dag IOL,
689                    string asmbase, string asmstr, InstrItinClass itin,
690                    list<dag> pattern> {
691  let BaseName = asmbase in {
692    def NAME : XOForm_3<opcode, xo, oe, OOL, IOL,
693                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
694                       pattern>, RecFormRel;
695    let Defs = [CR0] in
696    def o    : XOForm_3<opcode, xo, oe, OOL, IOL,
697                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
698                       []>, isDOT, RecFormRel;
699  }
700}
701
702multiclass XOForm_3rc<bits<6> opcode, bits<9> xo, bit oe, dag OOL, dag IOL,
703                      string asmbase, string asmstr, InstrItinClass itin,
704                      list<dag> pattern> {
705  let BaseName = asmbase in {
706    let Defs = [CARRY] in
707    def NAME : XOForm_3<opcode, xo, oe, OOL, IOL,
708                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
709                       pattern>, RecFormRel;
710    let Defs = [CARRY, CR0] in
711    def o    : XOForm_3<opcode, xo, oe, OOL, IOL,
712                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
713                       []>, isDOT, RecFormRel;
714  }
715}
716
717multiclass MForm_2r<bits<6> opcode, dag OOL, dag IOL,
718                    string asmbase, string asmstr, InstrItinClass itin,
719                    list<dag> pattern> {
720  let BaseName = asmbase in {
721    def NAME : MForm_2<opcode, OOL, IOL,
722                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
723                       pattern>, RecFormRel;
724    let Defs = [CR0] in
725    def o    : MForm_2<opcode, OOL, IOL,
726                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
727                       []>, isDOT, RecFormRel;
728  }
729}
730
731multiclass MDForm_1r<bits<6> opcode, bits<3> xo, dag OOL, dag IOL,
732                    string asmbase, string asmstr, InstrItinClass itin,
733                    list<dag> pattern> {
734  let BaseName = asmbase in {
735    def NAME : MDForm_1<opcode, xo, OOL, IOL,
736                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
737                       pattern>, RecFormRel;
738    let Defs = [CR0] in
739    def o    : MDForm_1<opcode, xo, OOL, IOL,
740                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
741                       []>, isDOT, RecFormRel;
742  }
743}
744
745multiclass MDSForm_1r<bits<6> opcode, bits<4> xo, dag OOL, dag IOL,
746                     string asmbase, string asmstr, InstrItinClass itin,
747                     list<dag> pattern> {
748  let BaseName = asmbase in {
749    def NAME : MDSForm_1<opcode, xo, OOL, IOL,
750                        !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
751                        pattern>, RecFormRel;
752    let Defs = [CR0] in
753    def o    : MDSForm_1<opcode, xo, OOL, IOL,
754                        !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
755                        []>, isDOT, RecFormRel;
756  }
757}
758
759multiclass XSForm_1rc<bits<6> opcode, bits<9> xo, dag OOL, dag IOL,
760                      string asmbase, string asmstr, InstrItinClass itin,
761                      list<dag> pattern> {
762  let BaseName = asmbase in {
763    let Defs = [CARRY] in
764    def NAME : XSForm_1<opcode, xo, OOL, IOL,
765                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
766                       pattern>, RecFormRel;
767    let Defs = [CARRY, CR0] in
768    def o    : XSForm_1<opcode, xo, OOL, IOL,
769                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
770                       []>, isDOT, RecFormRel;
771  }
772}
773
774multiclass XForm_26r<bits<6> opcode, bits<10> xo, dag OOL, dag IOL,
775                    string asmbase, string asmstr, InstrItinClass itin,
776                    list<dag> pattern> {
777  let BaseName = asmbase in {
778    def NAME : XForm_26<opcode, xo, OOL, IOL,
779                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
780                       pattern>, RecFormRel;
781    let Defs = [CR1] in
782    def o    : XForm_26<opcode, xo, OOL, IOL,
783                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
784                       []>, isDOT, RecFormRel;
785  }
786}
787
788multiclass AForm_1r<bits<6> opcode, bits<5> xo, dag OOL, dag IOL,
789                    string asmbase, string asmstr, InstrItinClass itin,
790                    list<dag> pattern> {
791  let BaseName = asmbase in {
792    def NAME : AForm_1<opcode, xo, OOL, IOL,
793                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
794                       pattern>, RecFormRel;
795    let Defs = [CR1] in
796    def o    : AForm_1<opcode, xo, OOL, IOL,
797                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
798                       []>, isDOT, RecFormRel;
799  }
800}
801
802multiclass AForm_2r<bits<6> opcode, bits<5> xo, dag OOL, dag IOL,
803                    string asmbase, string asmstr, InstrItinClass itin,
804                    list<dag> pattern> {
805  let BaseName = asmbase in {
806    def NAME : AForm_2<opcode, xo, OOL, IOL,
807                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
808                       pattern>, RecFormRel;
809    let Defs = [CR1] in
810    def o    : AForm_2<opcode, xo, OOL, IOL,
811                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
812                       []>, isDOT, RecFormRel;
813  }
814}
815
816multiclass AForm_3r<bits<6> opcode, bits<5> xo, dag OOL, dag IOL,
817                    string asmbase, string asmstr, InstrItinClass itin,
818                    list<dag> pattern> {
819  let BaseName = asmbase in {
820    def NAME : AForm_3<opcode, xo, OOL, IOL,
821                       !strconcat(asmbase, !strconcat(" ", asmstr)), itin,
822                       pattern>, RecFormRel;
823    let Defs = [CR1] in
824    def o    : AForm_3<opcode, xo, OOL, IOL,
825                       !strconcat(asmbase, !strconcat(". ", asmstr)), itin,
826                       []>, isDOT, RecFormRel;
827  }
828}
829
830//===----------------------------------------------------------------------===//
831// PowerPC Instruction Definitions.
832
833// Pseudo-instructions:
834
835let hasCtrlDep = 1 in {
836let Defs = [R1], Uses = [R1] in {
837def ADJCALLSTACKDOWN : Pseudo<(outs), (ins u16imm:$amt), "#ADJCALLSTACKDOWN $amt",
838                              [(callseq_start timm:$amt)]>;
839def ADJCALLSTACKUP   : Pseudo<(outs), (ins u16imm:$amt1, u16imm:$amt2), "#ADJCALLSTACKUP $amt1 $amt2",
840                              [(callseq_end timm:$amt1, timm:$amt2)]>;
841}
842
843def UPDATE_VRSAVE    : Pseudo<(outs gprc:$rD), (ins gprc:$rS),
844                              "UPDATE_VRSAVE $rD, $rS", []>;
845}
846
847let Defs = [R1], Uses = [R1] in
848def DYNALLOC : Pseudo<(outs gprc:$result), (ins gprc:$negsize, memri:$fpsi), "#DYNALLOC",
849                       [(set i32:$result,
850                             (PPCdynalloc i32:$negsize, iaddr:$fpsi))]>;
851                         
852// SELECT_CC_* - Used to implement the SELECT_CC DAG operation.  Expanded after
853// instruction selection into a branch sequence.
854let usesCustomInserter = 1,    // Expanded after instruction selection.
855    PPC970_Single = 1 in {
856  // Note that SELECT_CC_I4 and SELECT_CC_I8 use the no-r0 register classes
857  // because either operand might become the first operand in an isel, and
858  // that operand cannot be r0.
859  def SELECT_CC_I4 : Pseudo<(outs gprc:$dst), (ins crrc:$cond,
860                              gprc_nor0:$T, gprc_nor0:$F,
861                              i32imm:$BROPC), "#SELECT_CC_I4",
862                              []>;
863  def SELECT_CC_I8 : Pseudo<(outs g8rc:$dst), (ins crrc:$cond,
864                              g8rc_nox0:$T, g8rc_nox0:$F,
865                              i32imm:$BROPC), "#SELECT_CC_I8",
866                              []>;
867  def SELECT_CC_F4  : Pseudo<(outs f4rc:$dst), (ins crrc:$cond, f4rc:$T, f4rc:$F,
868                              i32imm:$BROPC), "#SELECT_CC_F4",
869                              []>;
870  def SELECT_CC_F8  : Pseudo<(outs f8rc:$dst), (ins crrc:$cond, f8rc:$T, f8rc:$F,
871                              i32imm:$BROPC), "#SELECT_CC_F8",
872                              []>;
873  def SELECT_CC_VRRC: Pseudo<(outs vrrc:$dst), (ins crrc:$cond, vrrc:$T, vrrc:$F,
874                              i32imm:$BROPC), "#SELECT_CC_VRRC",
875                              []>;
876}
877
878// SPILL_CR - Indicate that we're dumping the CR register, so we'll need to
879// scavenge a register for it.
880let mayStore = 1 in
881def SPILL_CR : Pseudo<(outs), (ins crrc:$cond, memri:$F),
882                     "#SPILL_CR", []>;
883
884// RESTORE_CR - Indicate that we're restoring the CR register (previously
885// spilled), so we'll need to scavenge a register for it.
886let mayLoad = 1 in
887def RESTORE_CR : Pseudo<(outs crrc:$cond), (ins memri:$F),
888                     "#RESTORE_CR", []>;
889
890let isTerminator = 1, isBarrier = 1, PPC970_Unit = 7 in {
891  let isReturn = 1, Uses = [LR, RM] in
892    def BLR : XLForm_2_ext<19, 16, 20, 0, 0, (outs), (ins), "blr", BrB,
893                           [(retflag)]>;
894  let isBranch = 1, isIndirectBranch = 1, Uses = [CTR] in {
895    def BCTR : XLForm_2_ext<19, 528, 20, 0, 0, (outs), (ins), "bctr", BrB, []>;
896
897    let isCodeGenOnly = 1 in
898    def BCCTR : XLForm_2_br<19, 528, 0, (outs), (ins pred:$cond),
899                            "b${cond:cc}ctr${cond:pm} ${cond:reg}", BrB, []>;
900  }
901}
902
903let Defs = [LR] in
904  def MovePCtoLR : Pseudo<(outs), (ins), "#MovePCtoLR", []>,
905                   PPC970_Unit_BRU;
906
907let isBranch = 1, isTerminator = 1, hasCtrlDep = 1, PPC970_Unit = 7 in {
908  let isBarrier = 1 in {
909  def B   : IForm<18, 0, 0, (outs), (ins directbrtarget:$dst),
910                  "b $dst", BrB,
911                  [(br bb:$dst)]>;
912  def BA  : IForm<18, 1, 0, (outs), (ins absdirectbrtarget:$dst),
913                  "ba $dst", BrB, []>;
914  }
915
916  // BCC represents an arbitrary conditional branch on a predicate.
917  // FIXME: should be able to write a pattern for PPCcondbranch, but can't use
918  // a two-value operand where a dag node expects two operands. :(
919  let isCodeGenOnly = 1 in {
920    def BCC : BForm<16, 0, 0, (outs), (ins pred:$cond, condbrtarget:$dst),
921                    "b${cond:cc}${cond:pm} ${cond:reg}, $dst"
922                    /*[(PPCcondbranch crrc:$crS, imm:$opc, bb:$dst)]*/>;
923    def BCCA : BForm<16, 1, 0, (outs), (ins pred:$cond, abscondbrtarget:$dst),
924                     "b${cond:cc}a${cond:pm} ${cond:reg}, $dst">;
925
926    let isReturn = 1, Uses = [LR, RM] in
927    def BCLR : XLForm_2_br<19, 16, 0, (outs), (ins pred:$cond),
928                           "b${cond:cc}lr${cond:pm} ${cond:reg}", BrB, []>;
929  }
930
931  let isReturn = 1, Defs = [CTR], Uses = [CTR, LR, RM] in {
932   def BDZLR  : XLForm_2_ext<19, 16, 18, 0, 0, (outs), (ins),
933                             "bdzlr", BrB, []>;
934   def BDNZLR : XLForm_2_ext<19, 16, 16, 0, 0, (outs), (ins),
935                             "bdnzlr", BrB, []>;
936   def BDZLRp : XLForm_2_ext<19, 16, 27, 0, 0, (outs), (ins),
937                             "bdzlr+", BrB, []>;
938   def BDNZLRp: XLForm_2_ext<19, 16, 25, 0, 0, (outs), (ins),
939                             "bdnzlr+", BrB, []>;
940   def BDZLRm : XLForm_2_ext<19, 16, 26, 0, 0, (outs), (ins),
941                             "bdzlr-", BrB, []>;
942   def BDNZLRm: XLForm_2_ext<19, 16, 24, 0, 0, (outs), (ins),
943                             "bdnzlr-", BrB, []>;
944  }
945
946  let Defs = [CTR], Uses = [CTR] in {
947    def BDZ  : BForm_1<16, 18, 0, 0, (outs), (ins condbrtarget:$dst),
948                       "bdz $dst">;
949    def BDNZ : BForm_1<16, 16, 0, 0, (outs), (ins condbrtarget:$dst),
950                       "bdnz $dst">;
951    def BDZA  : BForm_1<16, 18, 1, 0, (outs), (ins abscondbrtarget:$dst),
952                        "bdza $dst">;
953    def BDNZA : BForm_1<16, 16, 1, 0, (outs), (ins abscondbrtarget:$dst),
954                        "bdnza $dst">;
955    def BDZp : BForm_1<16, 27, 0, 0, (outs), (ins condbrtarget:$dst),
956                       "bdz+ $dst">;
957    def BDNZp: BForm_1<16, 25, 0, 0, (outs), (ins condbrtarget:$dst),
958                       "bdnz+ $dst">;
959    def BDZAp : BForm_1<16, 27, 1, 0, (outs), (ins abscondbrtarget:$dst),
960                        "bdza+ $dst">;
961    def BDNZAp: BForm_1<16, 25, 1, 0, (outs), (ins abscondbrtarget:$dst),
962                        "bdnza+ $dst">;
963    def BDZm : BForm_1<16, 26, 0, 0, (outs), (ins condbrtarget:$dst),
964                       "bdz- $dst">;
965    def BDNZm: BForm_1<16, 24, 0, 0, (outs), (ins condbrtarget:$dst),
966                       "bdnz- $dst">;
967    def BDZAm : BForm_1<16, 26, 1, 0, (outs), (ins abscondbrtarget:$dst),
968                        "bdza- $dst">;
969    def BDNZAm: BForm_1<16, 24, 1, 0, (outs), (ins abscondbrtarget:$dst),
970                        "bdnza- $dst">;
971  }
972}
973
974// The unconditional BCL used by the SjLj setjmp code.
975let isCall = 1, hasCtrlDep = 1, isCodeGenOnly = 1, PPC970_Unit = 7 in {
976  let Defs = [LR], Uses = [RM] in {
977    def BCLalways  : BForm_2<16, 20, 31, 0, 1, (outs), (ins condbrtarget:$dst),
978                            "bcl 20, 31, $dst">;
979  }
980}
981
982let isCall = 1, PPC970_Unit = 7, Defs = [LR] in {
983  // Convenient aliases for call instructions
984  let Uses = [RM] in {
985    def BL  : IForm<18, 0, 1, (outs), (ins calltarget:$func),
986                    "bl $func", BrB, []>;  // See Pat patterns below.
987    def BLA : IForm<18, 1, 1, (outs), (ins abscalltarget:$func),
988                    "bla $func", BrB, [(PPCcall (i32 imm:$func))]>;
989
990    let isCodeGenOnly = 1 in {
991      def BCCL : BForm<16, 0, 1, (outs), (ins pred:$cond, condbrtarget:$dst),
992                       "b${cond:cc}l${cond:pm} ${cond:reg}, $dst">;
993      def BCCLA : BForm<16, 1, 1, (outs), (ins pred:$cond, abscondbrtarget:$dst),
994                        "b${cond:cc}la${cond:pm} ${cond:reg}, $dst">;
995    }
996  }
997  let Uses = [CTR, RM] in {
998    def BCTRL : XLForm_2_ext<19, 528, 20, 0, 1, (outs), (ins),
999                             "bctrl", BrB, [(PPCbctrl)]>,
1000                Requires<[In32BitMode]>;
1001
1002    let isCodeGenOnly = 1 in
1003    def BCCTRL : XLForm_2_br<19, 528, 1, (outs), (ins pred:$cond),
1004                             "b${cond:cc}ctrl${cond:pm} ${cond:reg}", BrB, []>;
1005  }
1006  let Uses = [LR, RM] in {
1007    def BLRL : XLForm_2_ext<19, 16, 20, 0, 1, (outs), (ins),
1008                            "blrl", BrB, []>;
1009
1010    let isCodeGenOnly = 1 in
1011    def BCLRL : XLForm_2_br<19, 16, 1, (outs), (ins pred:$cond),
1012                            "b${cond:cc}lrl${cond:pm} ${cond:reg}", BrB, []>;
1013  }
1014  let Defs = [CTR], Uses = [CTR, RM] in {
1015    def BDZL  : BForm_1<16, 18, 0, 1, (outs), (ins condbrtarget:$dst),
1016                        "bdzl $dst">;
1017    def BDNZL : BForm_1<16, 16, 0, 1, (outs), (ins condbrtarget:$dst),
1018                        "bdnzl $dst">;
1019    def BDZLA  : BForm_1<16, 18, 1, 1, (outs), (ins abscondbrtarget:$dst),
1020                         "bdzla $dst">;
1021    def BDNZLA : BForm_1<16, 16, 1, 1, (outs), (ins abscondbrtarget:$dst),
1022                         "bdnzla $dst">;
1023    def BDZLp : BForm_1<16, 27, 0, 1, (outs), (ins condbrtarget:$dst),
1024                        "bdzl+ $dst">;
1025    def BDNZLp: BForm_1<16, 25, 0, 1, (outs), (ins condbrtarget:$dst),
1026                        "bdnzl+ $dst">;
1027    def BDZLAp : BForm_1<16, 27, 1, 1, (outs), (ins abscondbrtarget:$dst),
1028                         "bdzla+ $dst">;
1029    def BDNZLAp: BForm_1<16, 25, 1, 1, (outs), (ins abscondbrtarget:$dst),
1030                         "bdnzla+ $dst">;
1031    def BDZLm : BForm_1<16, 26, 0, 1, (outs), (ins condbrtarget:$dst),
1032                        "bdzl- $dst">;
1033    def BDNZLm: BForm_1<16, 24, 0, 1, (outs), (ins condbrtarget:$dst),
1034                        "bdnzl- $dst">;
1035    def BDZLAm : BForm_1<16, 26, 1, 1, (outs), (ins abscondbrtarget:$dst),
1036                         "bdzla- $dst">;
1037    def BDNZLAm: BForm_1<16, 24, 1, 1, (outs), (ins abscondbrtarget:$dst),
1038                         "bdnzla- $dst">;
1039  }
1040  let Defs = [CTR], Uses = [CTR, LR, RM] in {
1041    def BDZLRL  : XLForm_2_ext<19, 16, 18, 0, 1, (outs), (ins),
1042                               "bdzlrl", BrB, []>;
1043    def BDNZLRL : XLForm_2_ext<19, 16, 16, 0, 1, (outs), (ins),
1044                               "bdnzlrl", BrB, []>;
1045    def BDZLRLp : XLForm_2_ext<19, 16, 27, 0, 1, (outs), (ins),
1046                               "bdzlrl+", BrB, []>;
1047    def BDNZLRLp: XLForm_2_ext<19, 16, 25, 0, 1, (outs), (ins),
1048                               "bdnzlrl+", BrB, []>;
1049    def BDZLRLm : XLForm_2_ext<19, 16, 26, 0, 1, (outs), (ins),
1050                               "bdzlrl-", BrB, []>;
1051    def BDNZLRLm: XLForm_2_ext<19, 16, 24, 0, 1, (outs), (ins),
1052                               "bdnzlrl-", BrB, []>;
1053  }
1054}
1055
1056let isCall = 1, isTerminator = 1, isReturn = 1, isBarrier = 1, Uses = [RM] in
1057def TCRETURNdi :Pseudo< (outs),
1058                        (ins calltarget:$dst, i32imm:$offset),
1059                 "#TC_RETURNd $dst $offset",
1060                 []>;
1061
1062
1063let isCall = 1, isTerminator = 1, isReturn = 1, isBarrier = 1, Uses = [RM] in
1064def TCRETURNai :Pseudo<(outs), (ins abscalltarget:$func, i32imm:$offset),
1065                 "#TC_RETURNa $func $offset",
1066                 [(PPCtc_return (i32 imm:$func), imm:$offset)]>;
1067
1068let isCall = 1, isTerminator = 1, isReturn = 1, isBarrier = 1, Uses = [RM] in
1069def TCRETURNri : Pseudo<(outs), (ins CTRRC:$dst, i32imm:$offset),
1070                 "#TC_RETURNr $dst $offset",
1071                 []>;
1072
1073
1074let isCodeGenOnly = 1 in {
1075
1076let isTerminator = 1, isBarrier = 1, PPC970_Unit = 7, isBranch = 1,
1077    isIndirectBranch = 1, isCall = 1, isReturn = 1, Uses = [CTR, RM]  in
1078def TAILBCTR : XLForm_2_ext<19, 528, 20, 0, 0, (outs), (ins), "bctr", BrB, []>,
1079     Requires<[In32BitMode]>;
1080
1081let isBranch = 1, isTerminator = 1, hasCtrlDep = 1, PPC970_Unit = 7,
1082    isBarrier = 1, isCall = 1, isReturn = 1, Uses = [RM] in
1083def TAILB   : IForm<18, 0, 0, (outs), (ins calltarget:$dst),
1084                  "b $dst", BrB,
1085                  []>;
1086
1087let isBranch = 1, isTerminator = 1, hasCtrlDep = 1, PPC970_Unit = 7,
1088    isBarrier = 1, isCall = 1, isReturn = 1, Uses = [RM] in
1089def TAILBA   : IForm<18, 0, 0, (outs), (ins abscalltarget:$dst),
1090                  "ba $dst", BrB,
1091                  []>;
1092
1093}
1094
1095let hasSideEffects = 1, isBarrier = 1, usesCustomInserter = 1 in {
1096  def EH_SjLj_SetJmp32  : Pseudo<(outs gprc:$dst), (ins memr:$buf),
1097                            "#EH_SJLJ_SETJMP32",
1098                            [(set i32:$dst, (PPCeh_sjlj_setjmp addr:$buf))]>,
1099                          Requires<[In32BitMode]>;
1100  let isTerminator = 1 in
1101  def EH_SjLj_LongJmp32 : Pseudo<(outs), (ins memr:$buf),
1102                            "#EH_SJLJ_LONGJMP32",
1103                            [(PPCeh_sjlj_longjmp addr:$buf)]>,
1104                          Requires<[In32BitMode]>;
1105}
1106
1107let isBranch = 1, isTerminator = 1 in {
1108  def EH_SjLj_Setup : Pseudo<(outs), (ins directbrtarget:$dst),
1109                        "#EH_SjLj_Setup\t$dst", []>;
1110}
1111
1112// System call.
1113let PPC970_Unit = 7 in {
1114  def SC     : SCForm<17, 1, (outs), (ins i32imm:$lev),
1115                      "sc $lev", BrB, [(PPCsc (i32 imm:$lev))]>;
1116}
1117
1118// DCB* instructions.
1119def DCBA   : DCB_Form<758, 0, (outs), (ins memrr:$dst),
1120                      "dcba $dst", LdStDCBF, [(int_ppc_dcba xoaddr:$dst)]>,
1121                      PPC970_DGroup_Single;
1122def DCBF   : DCB_Form<86, 0, (outs), (ins memrr:$dst),
1123                      "dcbf $dst", LdStDCBF, [(int_ppc_dcbf xoaddr:$dst)]>,
1124                      PPC970_DGroup_Single;
1125def DCBI   : DCB_Form<470, 0, (outs), (ins memrr:$dst),
1126                      "dcbi $dst", LdStDCBF, [(int_ppc_dcbi xoaddr:$dst)]>,
1127                      PPC970_DGroup_Single;
1128def DCBST  : DCB_Form<54, 0, (outs), (ins memrr:$dst),
1129                      "dcbst $dst", LdStDCBF, [(int_ppc_dcbst xoaddr:$dst)]>,
1130                      PPC970_DGroup_Single;
1131def DCBT   : DCB_Form<278, 0, (outs), (ins memrr:$dst),
1132                      "dcbt $dst", LdStDCBF, [(int_ppc_dcbt xoaddr:$dst)]>,
1133                      PPC970_DGroup_Single;
1134def DCBTST : DCB_Form<246, 0, (outs), (ins memrr:$dst),
1135                      "dcbtst $dst", LdStDCBF, [(int_ppc_dcbtst xoaddr:$dst)]>,
1136                      PPC970_DGroup_Single;
1137def DCBZ   : DCB_Form<1014, 0, (outs), (ins memrr:$dst),
1138                      "dcbz $dst", LdStDCBF, [(int_ppc_dcbz xoaddr:$dst)]>,
1139                      PPC970_DGroup_Single;
1140def DCBZL  : DCB_Form<1014, 1, (outs), (ins memrr:$dst),
1141                      "dcbzl $dst", LdStDCBF, [(int_ppc_dcbzl xoaddr:$dst)]>,
1142                      PPC970_DGroup_Single;
1143
1144def : Pat<(prefetch xoaddr:$dst, (i32 0), imm, (i32 1)),
1145          (DCBT xoaddr:$dst)>;
1146
1147// Atomic operations
1148let usesCustomInserter = 1 in {
1149  let Defs = [CR0] in {
1150    def ATOMIC_LOAD_ADD_I8 : Pseudo<
1151      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_ADD_I8",
1152      [(set i32:$dst, (atomic_load_add_8 xoaddr:$ptr, i32:$incr))]>;
1153    def ATOMIC_LOAD_SUB_I8 : Pseudo<
1154      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_SUB_I8",
1155      [(set i32:$dst, (atomic_load_sub_8 xoaddr:$ptr, i32:$incr))]>;
1156    def ATOMIC_LOAD_AND_I8 : Pseudo<
1157      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_AND_I8",
1158      [(set i32:$dst, (atomic_load_and_8 xoaddr:$ptr, i32:$incr))]>;
1159    def ATOMIC_LOAD_OR_I8 : Pseudo<
1160      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_OR_I8",
1161      [(set i32:$dst, (atomic_load_or_8 xoaddr:$ptr, i32:$incr))]>;
1162    def ATOMIC_LOAD_XOR_I8 : Pseudo<
1163      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "ATOMIC_LOAD_XOR_I8",
1164      [(set i32:$dst, (atomic_load_xor_8 xoaddr:$ptr, i32:$incr))]>;
1165    def ATOMIC_LOAD_NAND_I8 : Pseudo<
1166      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_NAND_I8",
1167      [(set i32:$dst, (atomic_load_nand_8 xoaddr:$ptr, i32:$incr))]>;
1168    def ATOMIC_LOAD_ADD_I16 : Pseudo<
1169      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_ADD_I16",
1170      [(set i32:$dst, (atomic_load_add_16 xoaddr:$ptr, i32:$incr))]>;
1171    def ATOMIC_LOAD_SUB_I16 : Pseudo<
1172      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_SUB_I16",
1173      [(set i32:$dst, (atomic_load_sub_16 xoaddr:$ptr, i32:$incr))]>;
1174    def ATOMIC_LOAD_AND_I16 : Pseudo<
1175      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_AND_I16",
1176      [(set i32:$dst, (atomic_load_and_16 xoaddr:$ptr, i32:$incr))]>;
1177    def ATOMIC_LOAD_OR_I16 : Pseudo<
1178      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_OR_I16",
1179      [(set i32:$dst, (atomic_load_or_16 xoaddr:$ptr, i32:$incr))]>;
1180    def ATOMIC_LOAD_XOR_I16 : Pseudo<
1181      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_XOR_I16",
1182      [(set i32:$dst, (atomic_load_xor_16 xoaddr:$ptr, i32:$incr))]>;
1183    def ATOMIC_LOAD_NAND_I16 : Pseudo<
1184      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_NAND_I16",
1185      [(set i32:$dst, (atomic_load_nand_16 xoaddr:$ptr, i32:$incr))]>;
1186    def ATOMIC_LOAD_ADD_I32 : Pseudo<
1187      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_ADD_I32",
1188      [(set i32:$dst, (atomic_load_add_32 xoaddr:$ptr, i32:$incr))]>;
1189    def ATOMIC_LOAD_SUB_I32 : Pseudo<
1190      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_SUB_I32",
1191      [(set i32:$dst, (atomic_load_sub_32 xoaddr:$ptr, i32:$incr))]>;
1192    def ATOMIC_LOAD_AND_I32 : Pseudo<
1193      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_AND_I32",
1194      [(set i32:$dst, (atomic_load_and_32 xoaddr:$ptr, i32:$incr))]>;
1195    def ATOMIC_LOAD_OR_I32 : Pseudo<
1196      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_OR_I32",
1197      [(set i32:$dst, (atomic_load_or_32 xoaddr:$ptr, i32:$incr))]>;
1198    def ATOMIC_LOAD_XOR_I32 : Pseudo<
1199      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_XOR_I32",
1200      [(set i32:$dst, (atomic_load_xor_32 xoaddr:$ptr, i32:$incr))]>;
1201    def ATOMIC_LOAD_NAND_I32 : Pseudo<
1202      (outs gprc:$dst), (ins memrr:$ptr, gprc:$incr), "#ATOMIC_LOAD_NAND_I32",
1203      [(set i32:$dst, (atomic_load_nand_32 xoaddr:$ptr, i32:$incr))]>;
1204
1205    def ATOMIC_CMP_SWAP_I8 : Pseudo<
1206      (outs gprc:$dst), (ins memrr:$ptr, gprc:$old, gprc:$new), "#ATOMIC_CMP_SWAP_I8",
1207      [(set i32:$dst, (atomic_cmp_swap_8 xoaddr:$ptr, i32:$old, i32:$new))]>;
1208    def ATOMIC_CMP_SWAP_I16 : Pseudo<
1209      (outs gprc:$dst), (ins memrr:$ptr, gprc:$old, gprc:$new), "#ATOMIC_CMP_SWAP_I16 $dst $ptr $old $new",
1210      [(set i32:$dst, (atomic_cmp_swap_16 xoaddr:$ptr, i32:$old, i32:$new))]>;
1211    def ATOMIC_CMP_SWAP_I32 : Pseudo<
1212      (outs gprc:$dst), (ins memrr:$ptr, gprc:$old, gprc:$new), "#ATOMIC_CMP_SWAP_I32 $dst $ptr $old $new",
1213      [(set i32:$dst, (atomic_cmp_swap_32 xoaddr:$ptr, i32:$old, i32:$new))]>;
1214
1215    def ATOMIC_SWAP_I8 : Pseudo<
1216      (outs gprc:$dst), (ins memrr:$ptr, gprc:$new), "#ATOMIC_SWAP_i8",
1217      [(set i32:$dst, (atomic_swap_8 xoaddr:$ptr, i32:$new))]>;
1218    def ATOMIC_SWAP_I16 : Pseudo<
1219      (outs gprc:$dst), (ins memrr:$ptr, gprc:$new), "#ATOMIC_SWAP_I16",
1220      [(set i32:$dst, (atomic_swap_16 xoaddr:$ptr, i32:$new))]>;
1221    def ATOMIC_SWAP_I32 : Pseudo<
1222      (outs gprc:$dst), (ins memrr:$ptr, gprc:$new), "#ATOMIC_SWAP_I32",
1223      [(set i32:$dst, (atomic_swap_32 xoaddr:$ptr, i32:$new))]>;
1224  }
1225}
1226
1227// Instructions to support atomic operations
1228def LWARX : XForm_1<31,  20, (outs gprc:$rD), (ins memrr:$src),
1229                   "lwarx $rD, $src", LdStLWARX,
1230                   [(set i32:$rD, (PPClarx xoaddr:$src))]>;
1231
1232let Defs = [CR0] in
1233def STWCX : XForm_1<31, 150, (outs), (ins gprc:$rS, memrr:$dst),
1234                   "stwcx. $rS, $dst", LdStSTWCX,
1235                   [(PPCstcx i32:$rS, xoaddr:$dst)]>,
1236                   isDOT;
1237
1238let isTerminator = 1, isBarrier = 1, hasCtrlDep = 1 in
1239def TRAP  : XForm_24<31, 4, (outs), (ins), "trap", LdStLoad, [(trap)]>;
1240
1241def TWI : DForm_base<3, (outs), (ins u5imm:$to, gprc:$rA, s16imm:$imm),
1242                     "twi $to, $rA, $imm", IntTrapW, []>;
1243def TW : XForm_1<31, 4, (outs), (ins u5imm:$to, gprc:$rA, gprc:$rB),
1244                 "tw $to, $rA, $rB", IntTrapW, []>;
1245def TDI : DForm_base<2, (outs), (ins u5imm:$to, g8rc:$rA, s16imm:$imm),
1246                     "tdi $to, $rA, $imm", IntTrapD, []>;
1247def TD : XForm_1<31, 68, (outs), (ins u5imm:$to, g8rc:$rA, g8rc:$rB),
1248                 "td $to, $rA, $rB", IntTrapD, []>;
1249
1250//===----------------------------------------------------------------------===//
1251// PPC32 Load Instructions.
1252//
1253
1254// Unindexed (r+i) Loads. 
1255let canFoldAsLoad = 1, PPC970_Unit = 2 in {
1256def LBZ : DForm_1<34, (outs gprc:$rD), (ins memri:$src),
1257                  "lbz $rD, $src", LdStLoad,
1258                  [(set i32:$rD, (zextloadi8 iaddr:$src))]>;
1259def LHA : DForm_1<42, (outs gprc:$rD), (ins memri:$src),
1260                  "lha $rD, $src", LdStLHA,
1261                  [(set i32:$rD, (sextloadi16 iaddr:$src))]>,
1262                  PPC970_DGroup_Cracked;
1263def LHZ : DForm_1<40, (outs gprc:$rD), (ins memri:$src),
1264                  "lhz $rD, $src", LdStLoad,
1265                  [(set i32:$rD, (zextloadi16 iaddr:$src))]>;
1266def LWZ : DForm_1<32, (outs gprc:$rD), (ins memri:$src),
1267                  "lwz $rD, $src", LdStLoad,
1268                  [(set i32:$rD, (load iaddr:$src))]>;
1269
1270def LFS : DForm_1<48, (outs f4rc:$rD), (ins memri:$src),
1271                  "lfs $rD, $src", LdStLFD,
1272                  [(set f32:$rD, (load iaddr:$src))]>;
1273def LFD : DForm_1<50, (outs f8rc:$rD), (ins memri:$src),
1274                  "lfd $rD, $src", LdStLFD,
1275                  [(set f64:$rD, (load iaddr:$src))]>;
1276
1277
1278// Unindexed (r+i) Loads with Update (preinc).
1279let mayLoad = 1, neverHasSideEffects = 1 in {
1280def LBZU : DForm_1<35, (outs gprc:$rD, ptr_rc_nor0:$ea_result), (ins memri:$addr),
1281                   "lbzu $rD, $addr", LdStLoadUpd,
1282                   []>, RegConstraint<"$addr.reg = $ea_result">,
1283                   NoEncode<"$ea_result">;
1284
1285def LHAU : DForm_1<43, (outs gprc:$rD, ptr_rc_nor0:$ea_result), (ins memri:$addr),
1286                   "lhau $rD, $addr", LdStLHAU,
1287                   []>, RegConstraint<"$addr.reg = $ea_result">,
1288                   NoEncode<"$ea_result">;
1289
1290def LHZU : DForm_1<41, (outs gprc:$rD, ptr_rc_nor0:$ea_result), (ins memri:$addr),
1291                   "lhzu $rD, $addr", LdStLoadUpd,
1292                   []>, RegConstraint<"$addr.reg = $ea_result">,
1293                   NoEncode<"$ea_result">;
1294
1295def LWZU : DForm_1<33, (outs gprc:$rD, ptr_rc_nor0:$ea_result), (ins memri:$addr),
1296                   "lwzu $rD, $addr", LdStLoadUpd,
1297                   []>, RegConstraint<"$addr.reg = $ea_result">,
1298                   NoEncode<"$ea_result">;
1299
1300def LFSU : DForm_1<49, (outs f4rc:$rD, ptr_rc_nor0:$ea_result), (ins memri:$addr),
1301                  "lfsu $rD, $addr", LdStLFDU,
1302                  []>, RegConstraint<"$addr.reg = $ea_result">,
1303                   NoEncode<"$ea_result">;
1304
1305def LFDU : DForm_1<51, (outs f8rc:$rD, ptr_rc_nor0:$ea_result), (ins memri:$addr),
1306                  "lfdu $rD, $addr", LdStLFDU,
1307                  []>, RegConstraint<"$addr.reg = $ea_result">,
1308                   NoEncode<"$ea_result">;
1309
1310
1311// Indexed (r+r) Loads with Update (preinc).
1312def LBZUX : XForm_1<31, 119, (outs gprc:$rD, ptr_rc_nor0:$ea_result),
1313                   (ins memrr:$addr),
1314                   "lbzux $rD, $addr", LdStLoadUpd,
1315                   []>, RegConstraint<"$addr.ptrreg = $ea_result">,
1316                   NoEncode<"$ea_result">;
1317
1318def LHAUX : XForm_1<31, 375, (outs gprc:$rD, ptr_rc_nor0:$ea_result),
1319                   (ins memrr:$addr),
1320                   "lhaux $rD, $addr", LdStLHAU,
1321                   []>, RegConstraint<"$addr.ptrreg = $ea_result">,
1322                   NoEncode<"$ea_result">;
1323
1324def LHZUX : XForm_1<31, 311, (outs gprc:$rD, ptr_rc_nor0:$ea_result),
1325                   (ins memrr:$addr),
1326                   "lhzux $rD, $addr", LdStLoadUpd,
1327                   []>, RegConstraint<"$addr.ptrreg = $ea_result">,
1328                   NoEncode<"$ea_result">;
1329
1330def LWZUX : XForm_1<31, 55, (outs gprc:$rD, ptr_rc_nor0:$ea_result),
1331                   (ins memrr:$addr),
1332                   "lwzux $rD, $addr", LdStLoadUpd,
1333                   []>, RegConstraint<"$addr.ptrreg = $ea_result">,
1334                   NoEncode<"$ea_result">;
1335
1336def LFSUX : XForm_1<31, 567, (outs f4rc:$rD, ptr_rc_nor0:$ea_result),
1337                   (ins memrr:$addr),
1338                   "lfsux $rD, $addr", LdStLFDU,
1339                   []>, RegConstraint<"$addr.ptrreg = $ea_result">,
1340                   NoEncode<"$ea_result">;
1341
1342def LFDUX : XForm_1<31, 631, (outs f8rc:$rD, ptr_rc_nor0:$ea_result),
1343                   (ins memrr:$addr),
1344                   "lfdux $rD, $addr", LdStLFDU,
1345                   []>, RegConstraint<"$addr.ptrreg = $ea_result">,
1346                   NoEncode<"$ea_result">;
1347}
1348}
1349
1350// Indexed (r+r) Loads.
1351//
1352let canFoldAsLoad = 1, PPC970_Unit = 2 in {
1353def LBZX : XForm_1<31,  87, (outs gprc:$rD), (ins memrr:$src),
1354                   "lbzx $rD, $src", LdStLoad,
1355                   [(set i32:$rD, (zextloadi8 xaddr:$src))]>;
1356def LHAX : XForm_1<31, 343, (outs gprc:$rD), (ins memrr:$src),
1357                   "lhax $rD, $src", LdStLHA,
1358                   [(set i32:$rD, (sextloadi16 xaddr:$src))]>,
1359                   PPC970_DGroup_Cracked;
1360def LHZX : XForm_1<31, 279, (outs gprc:$rD), (ins memrr:$src),
1361                   "lhzx $rD, $src", LdStLoad,
1362                   [(set i32:$rD, (zextloadi16 xaddr:$src))]>;
1363def LWZX : XForm_1<31,  23, (outs gprc:$rD), (ins memrr:$src),
1364                   "lwzx $rD, $src", LdStLoad,
1365                   [(set i32:$rD, (load xaddr:$src))]>;
1366                   
1367                   
1368def LHBRX : XForm_1<31, 790, (outs gprc:$rD), (ins memrr:$src),
1369                   "lhbrx $rD, $src", LdStLoad,
1370                   [(set i32:$rD, (PPClbrx xoaddr:$src, i16))]>;
1371def LWBRX : XForm_1<31,  534, (outs gprc:$rD), (ins memrr:$src),
1372                   "lwbrx $rD, $src", LdStLoad,
1373                   [(set i32:$rD, (PPClbrx xoaddr:$src, i32))]>;
1374
1375def LFSX   : XForm_25<31, 535, (outs f4rc:$frD), (ins memrr:$src),
1376                      "lfsx $frD, $src", LdStLFD,
1377                      [(set f32:$frD, (load xaddr:$src))]>;
1378def LFDX   : XForm_25<31, 599, (outs f8rc:$frD), (ins memrr:$src),
1379                      "lfdx $frD, $src", LdStLFD,
1380                      [(set f64:$frD, (load xaddr:$src))]>;
1381
1382def LFIWAX : XForm_25<31, 855, (outs f8rc:$frD), (ins memrr:$src),
1383                      "lfiwax $frD, $src", LdStLFD,
1384                      [(set f64:$frD, (PPClfiwax xoaddr:$src))]>;
1385def LFIWZX : XForm_25<31, 887, (outs f8rc:$frD), (ins memrr:$src),
1386                      "lfiwzx $frD, $src", LdStLFD,
1387                      [(set f64:$frD, (PPClfiwzx xoaddr:$src))]>;
1388}
1389
1390// Load Multiple
1391def LMW : DForm_1<46, (outs gprc:$rD), (ins memri:$src),
1392                  "lmw $rD, $src", LdStLMW, []>;
1393
1394//===----------------------------------------------------------------------===//
1395// PPC32 Store Instructions.
1396//
1397
1398// Unindexed (r+i) Stores.
1399let PPC970_Unit = 2 in {
1400def STB  : DForm_1<38, (outs), (ins gprc:$rS, memri:$src),
1401                   "stb $rS, $src", LdStStore,
1402                   [(truncstorei8 i32:$rS, iaddr:$src)]>;
1403def STH  : DForm_1<44, (outs), (ins gprc:$rS, memri:$src),
1404                   "sth $rS, $src", LdStStore,
1405                   [(truncstorei16 i32:$rS, iaddr:$src)]>;
1406def STW  : DForm_1<36, (outs), (ins gprc:$rS, memri:$src),
1407                   "stw $rS, $src", LdStStore,
1408                   [(store i32:$rS, iaddr:$src)]>;
1409def STFS : DForm_1<52, (outs), (ins f4rc:$rS, memri:$dst),
1410                   "stfs $rS, $dst", LdStSTFD,
1411                   [(store f32:$rS, iaddr:$dst)]>;
1412def STFD : DForm_1<54, (outs), (ins f8rc:$rS, memri:$dst),
1413                   "stfd $rS, $dst", LdStSTFD,
1414                   [(store f64:$rS, iaddr:$dst)]>;
1415}
1416
1417// Unindexed (r+i) Stores with Update (preinc).
1418let PPC970_Unit = 2, mayStore = 1 in {
1419def STBU  : DForm_1<39, (outs ptr_rc_nor0:$ea_res), (ins gprc:$rS, memri:$dst),
1420                    "stbu $rS, $dst", LdStStoreUpd, []>,
1421                    RegConstraint<"$dst.reg = $ea_res">, NoEncode<"$ea_res">;
1422def STHU  : DForm_1<45, (outs ptr_rc_nor0:$ea_res), (ins gprc:$rS, memri:$dst),
1423                    "sthu $rS, $dst", LdStStoreUpd, []>,
1424                    RegConstraint<"$dst.reg = $ea_res">, NoEncode<"$ea_res">;
1425def STWU  : DForm_1<37, (outs ptr_rc_nor0:$ea_res), (ins gprc:$rS, memri:$dst),
1426                    "stwu $rS, $dst", LdStStoreUpd, []>,
1427                    RegConstraint<"$dst.reg = $ea_res">, NoEncode<"$ea_res">;
1428def STFSU : DForm_1<53, (outs ptr_rc_nor0:$ea_res), (ins f4rc:$rS, memri:$dst),
1429                    "stfsu $rS, $dst", LdStSTFDU, []>,
1430                    RegConstraint<"$dst.reg = $ea_res">, NoEncode<"$ea_res">;
1431def STFDU : DForm_1<55, (outs ptr_rc_nor0:$ea_res), (ins f8rc:$rS, memri:$dst),
1432                    "stfdu $rS, $dst", LdStSTFDU, []>,
1433                    RegConstraint<"$dst.reg = $ea_res">, NoEncode<"$ea_res">;
1434}
1435
1436// Patterns to match the pre-inc stores.  We can't put the patterns on
1437// the instruction definitions directly as ISel wants the address base
1438// and offset to be separate operands, not a single complex operand.
1439def : Pat<(pre_truncsti8 i32:$rS, iPTR:$ptrreg, iaddroff:$ptroff),
1440          (STBU $rS, iaddroff:$ptroff, $ptrreg)>;
1441def : Pat<(pre_truncsti16 i32:$rS, iPTR:$ptrreg, iaddroff:$ptroff),
1442          (STHU $rS, iaddroff:$ptroff, $ptrreg)>;
1443def : Pat<(pre_store i32:$rS, iPTR:$ptrreg, iaddroff:$ptroff),
1444          (STWU $rS, iaddroff:$ptroff, $ptrreg)>;
1445def : Pat<(pre_store f32:$rS, iPTR:$ptrreg, iaddroff:$ptroff),
1446          (STFSU $rS, iaddroff:$ptroff, $ptrreg)>;
1447def : Pat<(pre_store f64:$rS, iPTR:$ptrreg, iaddroff:$ptroff),
1448          (STFDU $rS, iaddroff:$ptroff, $ptrreg)>;
1449
1450// Indexed (r+r) Stores.
1451let PPC970_Unit = 2 in {
1452def STBX  : XForm_8<31, 215, (outs), (ins gprc:$rS, memrr:$dst),
1453                   "stbx $rS, $dst", LdStStore,
1454                   [(truncstorei8 i32:$rS, xaddr:$dst)]>,
1455                   PPC970_DGroup_Cracked;
1456def STHX  : XForm_8<31, 407, (outs), (ins gprc:$rS, memrr:$dst),
1457                   "sthx $rS, $dst", LdStStore,
1458                   [(truncstorei16 i32:$rS, xaddr:$dst)]>,
1459                   PPC970_DGroup_Cracked;
1460def STWX  : XForm_8<31, 151, (outs), (ins gprc:$rS, memrr:$dst),
1461                   "stwx $rS, $dst", LdStStore,
1462                   [(store i32:$rS, xaddr:$dst)]>,
1463                   PPC970_DGroup_Cracked;
1464 
1465def STHBRX: XForm_8<31, 918, (outs), (ins gprc:$rS, memrr:$dst),
1466                   "sthbrx $rS, $dst", LdStStore,
1467                   [(PPCstbrx i32:$rS, xoaddr:$dst, i16)]>,
1468                   PPC970_DGroup_Cracked;
1469def STWBRX: XForm_8<31, 662, (outs), (ins gprc:$rS, memrr:$dst),
1470                   "stwbrx $rS, $dst", LdStStore,
1471                   [(PPCstbrx i32:$rS, xoaddr:$dst, i32)]>,
1472                   PPC970_DGroup_Cracked;
1473
1474def STFIWX: XForm_28<31, 983, (outs), (ins f8rc:$frS, memrr:$dst),
1475                     "stfiwx $frS, $dst", LdStSTFD,
1476                     [(PPCstfiwx f64:$frS, xoaddr:$dst)]>;
1477                     
1478def STFSX : XForm_28<31, 663, (outs), (ins f4rc:$frS, memrr:$dst),
1479                     "stfsx $frS, $dst", LdStSTFD,
1480                     [(store f32:$frS, xaddr:$dst)]>;
1481def STFDX : XForm_28<31, 727, (outs), (ins f8rc:$frS, memrr:$dst),
1482                     "stfdx $frS, $dst", LdStSTFD,
1483                     [(store f64:$frS, xaddr:$dst)]>;
1484}
1485
1486// Indexed (r+r) Stores with Update (preinc).
1487let PPC970_Unit = 2, mayStore = 1 in {
1488def STBUX : XForm_8<31, 247, (outs ptr_rc_nor0:$ea_res), (ins gprc:$rS, memrr:$dst),
1489                    "stbux $rS, $dst", LdStStoreUpd, []>,
1490                    RegConstraint<"$dst.ptrreg = $ea_res">, NoEncode<"$ea_res">,
1491                    PPC970_DGroup_Cracked;
1492def STHUX : XForm_8<31, 439, (outs ptr_rc_nor0:$ea_res), (ins gprc:$rS, memrr:$dst),
1493                    "sthux $rS, $dst", LdStStoreUpd, []>,
1494                    RegConstraint<"$dst.ptrreg = $ea_res">, NoEncode<"$ea_res">,
1495                    PPC970_DGroup_Cracked;
1496def STWUX : XForm_8<31, 183, (outs ptr_rc_nor0:$ea_res), (ins gprc:$rS, memrr:$dst),
1497                    "stwux $rS, $dst", LdStStoreUpd, []>,
1498                    RegConstraint<"$dst.ptrreg = $ea_res">, NoEncode<"$ea_res">,
1499                    PPC970_DGroup_Cracked;
1500def STFSUX: XForm_8<31, 695, (outs ptr_rc_nor0:$ea_res), (ins f4rc:$rS, memrr:$dst),
1501                    "stfsux $rS, $dst", LdStSTFDU, []>,
1502                    RegConstraint<"$dst.ptrreg = $ea_res">, NoEncode<"$ea_res">,
1503                    PPC970_DGroup_Cracked;
1504def STFDUX: XForm_8<31, 759, (outs ptr_rc_nor0:$ea_res), (ins f8rc:$rS, memrr:$dst),
1505                    "stfdux $rS, $dst", LdStSTFDU, []>,
1506                    RegConstraint<"$dst.ptrreg = $ea_res">, NoEncode<"$ea_res">,
1507                    PPC970_DGroup_Cracked;
1508}
1509
1510// Patterns to match the pre-inc stores.  We can't put the patterns on
1511// the instruction definitions directly as ISel wants the address base
1512// and offset to be separate operands, not a single complex operand.
1513def : Pat<(pre_truncsti8 i32:$rS, iPTR:$ptrreg, iPTR:$ptroff),
1514          (STBUX $rS, $ptrreg, $ptroff)>;
1515def : Pat<(pre_truncsti16 i32:$rS, iPTR:$ptrreg, iPTR:$ptroff),
1516          (STHUX $rS, $ptrreg, $ptroff)>;
1517def : Pat<(pre_store i32:$rS, iPTR:$ptrreg, iPTR:$ptroff),
1518          (STWUX $rS, $ptrreg, $ptroff)>;
1519def : Pat<(pre_store f32:$rS, iPTR:$ptrreg, iPTR:$ptroff),
1520          (STFSUX $rS, $ptrreg, $ptroff)>;
1521def : Pat<(pre_store f64:$rS, iPTR:$ptrreg, iPTR:$ptroff),
1522          (STFDUX $rS, $ptrreg, $ptroff)>;
1523
1524// Store Multiple
1525def STMW : DForm_1<47, (outs), (ins gprc:$rS, memri:$dst),
1526                   "stmw $rS, $dst", LdStLMW, []>;
1527
1528def SYNC : XForm_24_sync<31, 598, (outs), (ins i32imm:$L),
1529                        "sync $L", LdStSync, []>;
1530def : Pat<(int_ppc_sync), (SYNC 0)>;
1531
1532//===----------------------------------------------------------------------===//
1533// PPC32 Arithmetic Instructions.
1534//
1535
1536let PPC970_Unit = 1 in {  // FXU Operations.
1537def ADDI   : DForm_2<14, (outs gprc:$rD), (ins gprc_nor0:$rA, s16imm:$imm),
1538                     "addi $rD, $rA, $imm", IntSimple,
1539                     [(set i32:$rD, (add i32:$rA, imm32SExt16:$imm))]>;
1540let BaseName = "addic" in {
1541let Defs = [CARRY] in
1542def ADDIC  : DForm_2<12, (outs gprc:$rD), (ins gprc:$rA, s16imm:$imm),
1543                     "addic $rD, $rA, $imm", IntGeneral,
1544                     [(set i32:$rD, (addc i32:$rA, imm32SExt16:$imm))]>,
1545                     RecFormRel, PPC970_DGroup_Cracked;
1546let Defs = [CARRY, CR0] in
1547def ADDICo : DForm_2<13, (outs gprc:$rD), (ins gprc:$rA, s16imm:$imm),
1548                     "addic. $rD, $rA, $imm", IntGeneral,
1549                     []>, isDOT, RecFormRel;
1550}
1551def ADDIS  : DForm_2<15, (outs gprc:$rD), (ins gprc_nor0:$rA, s17imm:$imm),
1552                     "addis $rD, $rA, $imm", IntSimple,
1553                     [(set i32:$rD, (add i32:$rA, imm16ShiftedSExt:$imm))]>;
1554let isCodeGenOnly = 1 in
1555def LA     : DForm_2<14, (outs gprc:$rD), (ins gprc_nor0:$rA, s16imm:$sym),
1556                     "la $rD, $sym($rA)", IntGeneral,
1557                     [(set i32:$rD, (add i32:$rA,
1558                                          (PPClo tglobaladdr:$sym, 0)))]>;
1559def MULLI  : DForm_2< 7, (outs gprc:$rD), (ins gprc:$rA, s16imm:$imm),
1560                     "mulli $rD, $rA, $imm", IntMulLI,
1561                     [(set i32:$rD, (mul i32:$rA, imm32SExt16:$imm))]>;
1562let Defs = [CARRY] in
1563def SUBFIC : DForm_2< 8, (outs gprc:$rD), (ins gprc:$rA, s16imm:$imm),
1564                     "subfic $rD, $rA, $imm", IntGeneral,
1565                     [(set i32:$rD, (subc imm32SExt16:$imm, i32:$rA))]>;
1566
1567let isReMaterializable = 1, isAsCheapAsAMove = 1, isMoveImm = 1 in {
1568  def LI  : DForm_2_r0<14, (outs gprc:$rD), (ins s16imm:$imm),
1569                       "li $rD, $imm", IntSimple,
1570                       [(set i32:$rD, imm32SExt16:$imm)]>;
1571  def LIS : DForm_2_r0<15, (outs gprc:$rD), (ins s17imm:$imm),
1572                       "lis $rD, $imm", IntSimple,
1573                       [(set i32:$rD, imm16ShiftedSExt:$imm)]>;
1574}
1575}
1576
1577let PPC970_Unit = 1 in {  // FXU Operations.
1578let Defs = [CR0] in {
1579def ANDIo : DForm_4<28, (outs gprc:$dst), (ins gprc:$src1, u16imm:$src2),
1580                    "andi. $dst, $src1, $src2", IntGeneral,
1581                    [(set i32:$dst, (and i32:$src1, immZExt16:$src2))]>,
1582                    isDOT;
1583def ANDISo : DForm_4<29, (outs gprc:$dst), (ins gprc:$src1, u16imm:$src2),
1584                    "andis. $dst, $src1, $src2", IntGeneral,
1585                    [(set i32:$dst, (and i32:$src1, imm16ShiftedZExt:$src2))]>,
1586                    isDOT;
1587}
1588def ORI   : DForm_4<24, (outs gprc:$dst), (ins gprc:$src1, u16imm:$src2),
1589                    "ori $dst, $src1, $src2", IntSimple,
1590                    [(set i32:$dst, (or i32:$src1, immZExt16:$src2))]>;
1591def ORIS  : DForm_4<25, (outs gprc:$dst), (ins gprc:$src1, u16imm:$src2),
1592                    "oris $dst, $src1, $src2", IntSimple,
1593                    [(set i32:$dst, (or i32:$src1, imm16ShiftedZExt:$src2))]>;
1594def XORI  : DForm_4<26, (outs gprc:$dst), (ins gprc:$src1, u16imm:$src2),
1595                    "xori $dst, $src1, $src2", IntSimple,
1596                    [(set i32:$dst, (xor i32:$src1, immZExt16:$src2))]>;
1597def XORIS : DForm_4<27, (outs gprc:$dst), (ins gprc:$src1, u16imm:$src2),
1598                    "xoris $dst, $src1, $src2", IntSimple,
1599                    [(set i32:$dst, (xor i32:$src1, imm16ShiftedZExt:$src2))]>;
1600def NOP   : DForm_4_zero<24, (outs), (ins), "nop", IntSimple,
1601                         []>;
1602let isCompare = 1, neverHasSideEffects = 1 in {
1603  def CMPWI : DForm_5_ext<11, (outs crrc:$crD), (ins gprc:$rA, s16imm:$imm),
1604                          "cmpwi $crD, $rA, $imm", IntCompare>;
1605  def CMPLWI : DForm_6_ext<10, (outs crrc:$dst), (ins gprc:$src1, u16imm:$src2),
1606                           "cmplwi $dst, $src1, $src2", IntCompare>;
1607}
1608}
1609
1610let PPC970_Unit = 1, neverHasSideEffects = 1 in {  // FXU Operations.
1611defm NAND : XForm_6r<31, 476, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1612                     "nand", "$rA, $rS, $rB", IntSimple,
1613                     [(set i32:$rA, (not (and i32:$rS, i32:$rB)))]>;
1614defm AND  : XForm_6r<31,  28, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1615                     "and", "$rA, $rS, $rB", IntSimple,
1616                     [(set i32:$rA, (and i32:$rS, i32:$rB))]>;
1617defm ANDC : XForm_6r<31,  60, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1618                     "andc", "$rA, $rS, $rB", IntSimple,
1619                     [(set i32:$rA, (and i32:$rS, (not i32:$rB)))]>;
1620defm OR   : XForm_6r<31, 444, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1621                     "or", "$rA, $rS, $rB", IntSimple,
1622                     [(set i32:$rA, (or i32:$rS, i32:$rB))]>;
1623defm NOR  : XForm_6r<31, 124, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1624                     "nor", "$rA, $rS, $rB", IntSimple,
1625                     [(set i32:$rA, (not (or i32:$rS, i32:$rB)))]>;
1626defm ORC  : XForm_6r<31, 412, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1627                     "orc", "$rA, $rS, $rB", IntSimple,
1628                     [(set i32:$rA, (or i32:$rS, (not i32:$rB)))]>;
1629defm EQV  : XForm_6r<31, 284, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1630                     "eqv", "$rA, $rS, $rB", IntSimple,
1631                     [(set i32:$rA, (not (xor i32:$rS, i32:$rB)))]>;
1632defm XOR  : XForm_6r<31, 316, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1633                     "xor", "$rA, $rS, $rB", IntSimple,
1634                     [(set i32:$rA, (xor i32:$rS, i32:$rB))]>;
1635defm SLW  : XForm_6r<31,  24, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1636                     "slw", "$rA, $rS, $rB", IntGeneral,
1637                     [(set i32:$rA, (PPCshl i32:$rS, i32:$rB))]>;
1638defm SRW  : XForm_6r<31, 536, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1639                     "srw", "$rA, $rS, $rB", IntGeneral,
1640                     [(set i32:$rA, (PPCsrl i32:$rS, i32:$rB))]>;
1641defm SRAW : XForm_6rc<31, 792, (outs gprc:$rA), (ins gprc:$rS, gprc:$rB),
1642                      "sraw", "$rA, $rS, $rB", IntShift,
1643                      [(set i32:$rA, (PPCsra i32:$rS, i32:$rB))]>;
1644}
1645
1646let PPC970_Unit = 1 in {  // FXU Operations.
1647let neverHasSideEffects = 1 in {
1648defm SRAWI : XForm_10rc<31, 824, (outs gprc:$rA), (ins gprc:$rS, u5imm:$SH),
1649                        "srawi", "$rA, $rS, $SH", IntShift,
1650                        [(set i32:$rA, (sra i32:$rS, (i32 imm:$SH)))]>;
1651defm CNTLZW : XForm_11r<31,  26, (outs gprc:$rA), (ins gprc:$rS),
1652                        "cntlzw", "$rA, $rS", IntGeneral,
1653                        [(set i32:$rA, (ctlz i32:$rS))]>;
1654defm EXTSB  : XForm_11r<31, 954, (outs gprc:$rA), (ins gprc:$rS),
1655                        "extsb", "$rA, $rS", IntSimple,
1656                        [(set i32:$rA, (sext_inreg i32:$rS, i8))]>;
1657defm EXTSH  : XForm_11r<31, 922, (outs gprc:$rA), (ins gprc:$rS),
1658                        "extsh", "$rA, $rS", IntSimple,
1659                        [(set i32:$rA, (sext_inreg i32:$rS, i16))]>;
1660}
1661let isCompare = 1, neverHasSideEffects = 1 in {
1662  def CMPW   : XForm_16_ext<31, 0, (outs crrc:$crD), (ins gprc:$rA, gprc:$rB),
1663                            "cmpw $crD, $rA, $rB", IntCompare>;
1664  def CMPLW  : XForm_16_ext<31, 32, (outs crrc:$crD), (ins gprc:$rA, gprc:$rB),
1665                            "cmplw $crD, $rA, $rB", IntCompare>;
1666}
1667}
1668let PPC970_Unit = 3 in {  // FPU Operations.
1669//def FCMPO  : XForm_17<63, 32, (outs CRRC:$crD), (ins FPRC:$fA, FPRC:$fB),
1670//                      "fcmpo $crD, $fA, $fB", FPCompare>;
1671let isCompare = 1, neverHasSideEffects = 1 in {
1672  def FCMPUS : XForm_17<63, 0, (outs crrc:$crD), (ins f4rc:$fA, f4rc:$fB),
1673                        "fcmpu $crD, $fA, $fB", FPCompare>;
1674  def FCMPUD : XForm_17<63, 0, (outs crrc:$crD), (ins f8rc:$fA, f8rc:$fB),
1675                        "fcmpu $crD, $fA, $fB", FPCompare>;
1676}
1677
1678let Uses = [RM] in {
1679  let neverHasSideEffects = 1 in {
1680  defm FCTIWZ : XForm_26r<63, 15, (outs f8rc:$frD), (ins f8rc:$frB),
1681                          "fctiwz", "$frD, $frB", FPGeneral,
1682                          [(set f64:$frD, (PPCfctiwz f64:$frB))]>;
1683
1684  defm FRSP   : XForm_26r<63, 12, (outs f4rc:$frD), (ins f8rc:$frB),
1685                          "frsp", "$frD, $frB", FPGeneral,
1686                          [(set f32:$frD, (fround f64:$frB))]>;
1687
1688  // The frin -> nearbyint mapping is valid only in fast-math mode.
1689  let Interpretation64Bit = 1 in
1690  defm FRIND  : XForm_26r<63, 392, (outs f8rc:$frD), (ins f8rc:$frB),
1691                          "frin", "$frD, $frB", FPGeneral,
1692                          [(set f64:$frD, (fnearbyint f64:$frB))]>;
1693  defm FRINS  : XForm_26r<63, 392, (outs f4rc:$frD), (ins f4rc:$frB),
1694                          "frin", "$frD, $frB", FPGeneral,
1695                          [(set f32:$frD, (fnearbyint f32:$frB))]>;
1696  }
1697
1698  // These pseudos expand to rint but also set FE_INEXACT when the result does
1699  // not equal the argument.
1700  let usesCustomInserter = 1, Defs = [RM] in { // FIXME: Model FPSCR!
1701    def FRINDrint : Pseudo<(outs f8rc:$frD), (ins f8rc:$frB),
1702                            "#FRINDrint", [(set f64:$frD, (frint f64:$frB))]>;
1703    def FRINSrint : Pseudo<(outs f4rc:$frD), (ins f4rc:$frB),
1704                            "#FRINSrint", [(set f32:$frD, (frint f32:$frB))]>;
1705  }
1706
1707  let neverHasSideEffects = 1 in {
1708  let Interpretation64Bit = 1 in
1709  defm FRIPD  : XForm_26r<63, 456, (outs f8rc:$frD), (ins f8rc:$frB),
1710                          "frip", "$frD, $frB", FPGeneral,
1711                          [(set f64:$frD, (fceil f64:$frB))]>;
1712  defm FRIPS  : XForm_26r<63, 456, (outs f4rc:$frD), (ins f4rc:$frB),
1713                          "frip", "$frD, $frB", FPGeneral,
1714                          [(set f32:$frD, (fceil f32:$frB))]>;
1715  let Interpretation64Bit = 1 in
1716  defm FRIZD  : XForm_26r<63, 424, (outs f8rc:$frD), (ins f8rc:$frB),
1717                          "friz", "$frD, $frB", FPGeneral,
1718                          [(set f64:$frD, (ftrunc f64:$frB))]>;
1719  defm FRIZS  : XForm_26r<63, 424, (outs f4rc:$frD), (ins f4rc:$frB),
1720                          "friz", "$frD, $frB", FPGeneral,
1721                          [(set f32:$frD, (ftrunc f32:$frB))]>;
1722  let Interpretation64Bit = 1 in
1723  defm FRIMD  : XForm_26r<63, 488, (outs f8rc:$frD), (ins f8rc:$frB),
1724                          "frim", "$frD, $frB", FPGeneral,
1725                          [(set f64:$frD, (ffloor f64:$frB))]>;
1726  defm FRIMS  : XForm_26r<63, 488, (outs f4rc:$frD), (ins f4rc:$frB),
1727                          "frim", "$frD, $frB", FPGeneral,
1728                          [(set f32:$frD, (ffloor f32:$frB))]>;
1729
1730  defm FSQRT  : XForm_26r<63, 22, (outs f8rc:$frD), (ins f8rc:$frB),
1731                          "fsqrt", "$frD, $frB", FPSqrt,
1732                          [(set f64:$frD, (fsqrt f64:$frB))]>;
1733  defm FSQRTS : XForm_26r<59, 22, (outs f4rc:$frD), (ins f4rc:$frB),
1734                          "fsqrts", "$frD, $frB", FPSqrt,
1735                          [(set f32:$frD, (fsqrt f32:$frB))]>;
1736  }
1737  }
1738}
1739
1740/// Note that FMR is defined as pseudo-ops on the PPC970 because they are
1741/// often coalesced away and we don't want the dispatch group builder to think
1742/// that they will fill slots (which could cause the load of a LSU reject to
1743/// sneak into a d-group with a store).
1744let neverHasSideEffects = 1 in
1745defm FMR   : XForm_26r<63, 72, (outs f4rc:$frD), (ins f4rc:$frB),
1746                       "fmr", "$frD, $frB", FPGeneral,
1747                       []>,  // (set f32:$frD, f32:$frB)
1748                       PPC970_Unit_Pseudo;
1749
1750let PPC970_Unit = 3, neverHasSideEffects = 1 in {  // FPU Operations.
1751// These are artificially split into two different forms, for 4/8 byte FP.
1752defm FABSS  : XForm_26r<63, 264, (outs f4rc:$frD), (ins f4rc:$frB),
1753                        "fabs", "$frD, $frB", FPGeneral,
1754                        [(set f32:$frD, (fabs f32:$frB))]>;
1755let Interpretation64Bit = 1 in
1756defm FABSD  : XForm_26r<63, 264, (outs f8rc:$frD), (ins f8rc:$frB),
1757                        "fabs", "$frD, $frB", FPGeneral,
1758                        [(set f64:$frD, (fabs f64:$frB))]>;
1759defm FNABSS : XForm_26r<63, 136, (outs f4rc:$frD), (ins f4rc:$frB),
1760                        "fnabs", "$frD, $frB", FPGeneral,
1761                        [(set f32:$frD, (fneg (fabs f32:$frB)))]>;
1762let Interpretation64Bit = 1 in
1763defm FNABSD : XForm_26r<63, 136, (outs f8rc:$frD), (ins f8rc:$frB),
1764                        "fnabs", "$frD, $frB", FPGeneral,
1765                        [(set f64:$frD, (fneg (fabs f64:$frB)))]>;
1766defm FNEGS  : XForm_26r<63, 40, (outs f4rc:$frD), (ins f4rc:$frB),
1767                        "fneg", "$frD, $frB", FPGeneral,
1768                        [(set f32:$frD, (fneg f32:$frB))]>;
1769let Interpretation64Bit = 1 in
1770defm FNEGD  : XForm_26r<63, 40, (outs f8rc:$frD), (ins f8rc:$frB),
1771                        "fneg", "$frD, $frB", FPGeneral,
1772                        [(set f64:$frD, (fneg f64:$frB))]>;
1773
1774// Reciprocal estimates.
1775defm FRE      : XForm_26r<63, 24, (outs f8rc:$frD), (ins f8rc:$frB),
1776                          "fre", "$frD, $frB", FPGeneral,
1777                          [(set f64:$frD, (PPCfre f64:$frB))]>;
1778defm FRES     : XForm_26r<59, 24, (outs f4rc:$frD), (ins f4rc:$frB),
1779                          "fres", "$frD, $frB", FPGeneral,
1780                          [(set f32:$frD, (PPCfre f32:$frB))]>;
1781defm FRSQRTE  : XForm_26r<63, 26, (outs f8rc:$frD), (ins f8rc:$frB),
1782                          "frsqrte", "$frD, $frB", FPGeneral,
1783                          [(set f64:$frD, (PPCfrsqrte f64:$frB))]>;
1784defm FRSQRTES : XForm_26r<59, 26, (outs f4rc:$frD), (ins f4rc:$frB),
1785                          "frsqrtes", "$frD, $frB", FPGeneral,
1786                          [(set f32:$frD, (PPCfrsqrte f32:$frB))]>;
1787}
1788
1789// XL-Form instructions.  condition register logical ops.
1790//
1791let neverHasSideEffects = 1 in
1792def MCRF   : XLForm_3<19, 0, (outs crrc:$BF), (ins crrc:$BFA),
1793                      "mcrf $BF, $BFA", BrMCR>,
1794             PPC970_DGroup_First, PPC970_Unit_CRU;
1795
1796def CRAND  : XLForm_1<19, 257, (outs crbitrc:$CRD),
1797                               (ins crbitrc:$CRA, crbitrc:$CRB),
1798                      "crand $CRD, $CRA, $CRB", BrCR, []>;
1799
1800def CRNAND : XLForm_1<19, 225, (outs crbitrc:$CRD),
1801                               (ins crbitrc:$CRA, crbitrc:$CRB),
1802                      "crnand $CRD, $CRA, $CRB", BrCR, []>;
1803
1804def CROR   : XLForm_1<19, 449, (outs crbitrc:$CRD),
1805                               (ins crbitrc:$CRA, crbitrc:$CRB),
1806                      "cror $CRD, $CRA, $CRB", BrCR, []>;
1807
1808def CRXOR  : XLForm_1<19, 193, (outs crbitrc:$CRD),
1809                               (ins crbitrc:$CRA, crbitrc:$CRB),
1810                      "crxor $CRD, $CRA, $CRB", BrCR, []>;
1811
1812def CRNOR  : XLForm_1<19, 33, (outs crbitrc:$CRD),
1813                              (ins crbitrc:$CRA, crbitrc:$CRB),
1814                      "crnor $CRD, $CRA, $CRB", BrCR, []>;
1815
1816def CREQV  : XLForm_1<19, 289, (outs crbitrc:$CRD),
1817                               (ins crbitrc:$CRA, crbitrc:$CRB),
1818                      "creqv $CRD, $CRA, $CRB", BrCR, []>;
1819
1820def CRANDC : XLForm_1<19, 129, (outs crbitrc:$CRD),
1821                               (ins crbitrc:$CRA, crbitrc:$CRB),
1822                      "crandc $CRD, $CRA, $CRB", BrCR, []>;
1823
1824def CRORC  : XLForm_1<19, 417, (outs crbitrc:$CRD),
1825                               (ins crbitrc:$CRA, crbitrc:$CRB),
1826                      "crorc $CRD, $CRA, $CRB", BrCR, []>;
1827
1828let isCodeGenOnly = 1 in {
1829def CRSET  : XLForm_1_ext<19, 289, (outs crbitrc:$dst), (ins),
1830              "creqv $dst, $dst, $dst", BrCR,
1831              []>;
1832
1833def CRUNSET: XLForm_1_ext<19, 193, (outs crbitrc:$dst), (ins),
1834              "crxor $dst, $dst, $dst", BrCR,
1835              []>;
1836
1837let Defs = [CR1EQ], CRD = 6 in {
1838def CR6SET  : XLForm_1_ext<19, 289, (outs), (ins),
1839              "creqv 6, 6, 6", BrCR,
1840              [(PPCcr6set)]>;
1841
1842def CR6UNSET: XLForm_1_ext<19, 193, (outs), (ins),
1843              "crxor 6, 6, 6", BrCR,
1844              [(PPCcr6unset)]>;
1845}
1846}
1847
1848// XFX-Form instructions.  Instructions that deal with SPRs.
1849//
1850
1851def MFSPR : XFXForm_1<31, 339, (outs gprc:$RT), (ins i32imm:$SPR),
1852                      "mfspr $RT, $SPR", SprMFSPR>;
1853def MTSPR : XFXForm_1<31, 467, (outs), (ins i32imm:$SPR, gprc:$RT),
1854                      "mtspr $SPR, $RT", SprMTSPR>;
1855
1856let Uses = [CTR] in {
1857def MFCTR : XFXForm_1_ext<31, 339, 9, (outs gprc:$rT), (ins),
1858                          "mfctr $rT", SprMFSPR>,
1859            PPC970_DGroup_First, PPC970_Unit_FXU;
1860}
1861let Defs = [CTR], Pattern = [(PPCmtctr i32:$rS)] in {
1862def MTCTR : XFXForm_7_ext<31, 467, 9, (outs), (ins gprc:$rS),
1863                          "mtctr $rS", SprMTSPR>,
1864            PPC970_DGroup_First, PPC970_Unit_FXU;
1865}
1866let hasSideEffects = 1, isCodeGenOnly = 1, Defs = [CTR] in {
1867let Pattern = [(int_ppc_mtctr i32:$rS)] in
1868def MTCTRloop : XFXForm_7_ext<31, 467, 9, (outs), (ins gprc:$rS),
1869                              "mtctr $rS", SprMTSPR>,
1870                PPC970_DGroup_First, PPC970_Unit_FXU;
1871}
1872
1873let Defs = [LR] in {
1874def MTLR  : XFXForm_7_ext<31, 467, 8, (outs), (ins gprc:$rS),
1875                          "mtlr $rS", SprMTSPR>,
1876            PPC970_DGroup_First, PPC970_Unit_FXU;
1877}
1878let Uses = [LR] in {
1879def MFLR  : XFXForm_1_ext<31, 339, 8, (outs gprc:$rT), (ins),
1880                          "mflr $rT", SprMFSPR>,
1881            PPC970_DGroup_First, PPC970_Unit_FXU;
1882}
1883
1884let isCodeGenOnly = 1 in {
1885  // Move to/from VRSAVE: despite being a SPR, the VRSAVE register is renamed
1886  // like a GPR on the PPC970.  As such, copies in and out have the same
1887  // performance characteristics as an OR instruction.
1888  def MTVRSAVE : XFXForm_7_ext<31, 467, 256, (outs), (ins gprc:$rS),
1889                               "mtspr 256, $rS", IntGeneral>,
1890                 PPC970_DGroup_Single, PPC970_Unit_FXU;
1891  def MFVRSAVE : XFXForm_1_ext<31, 339, 256, (outs gprc:$rT), (ins),
1892                               "mfspr $rT, 256", IntGeneral>,
1893                 PPC970_DGroup_First, PPC970_Unit_FXU;
1894
1895  def MTVRSAVEv : XFXForm_7_ext<31, 467, 256,
1896                                (outs VRSAVERC:$reg), (ins gprc:$rS),
1897                                "mtspr 256, $rS", IntGeneral>,
1898                  PPC970_DGroup_Single, PPC970_Unit_FXU;
1899  def MFVRSAVEv : XFXForm_1_ext<31, 339, 256, (outs gprc:$rT),
1900                                (ins VRSAVERC:$reg),
1901                                "mfspr $rT, 256", IntGeneral>,
1902                  PPC970_DGroup_First, PPC970_Unit_FXU;
1903}
1904
1905// SPILL_VRSAVE - Indicate that we're dumping the VRSAVE register,
1906// so we'll need to scavenge a register for it.
1907let mayStore = 1 in
1908def SPILL_VRSAVE : Pseudo<(outs), (ins VRSAVERC:$vrsave, memri:$F),
1909                     "#SPILL_VRSAVE", []>;
1910
1911// RESTORE_VRSAVE - Indicate that we're restoring the VRSAVE register (previously
1912// spilled), so we'll need to scavenge a register for it.
1913let mayLoad = 1 in
1914def RESTORE_VRSAVE : Pseudo<(outs VRSAVERC:$vrsave), (ins memri:$F),
1915                     "#RESTORE_VRSAVE", []>;
1916
1917let neverHasSideEffects = 1 in {
1918def MTOCRF: XFXForm_5a<31, 144, (outs crbitm:$FXM), (ins gprc:$ST),
1919                       "mtocrf $FXM, $ST", BrMCRX>,
1920            PPC970_DGroup_First, PPC970_Unit_CRU;
1921
1922def MTCRF : XFXForm_5<31, 144, (outs), (ins i32imm:$FXM, gprc:$rS),
1923                      "mtcrf $FXM, $rS", BrMCRX>,
1924            PPC970_MicroCode, PPC970_Unit_CRU;
1925
1926def MFOCRF: XFXForm_5a<31, 19, (outs gprc:$rT), (ins crbitm:$FXM),
1927                       "mfocrf $rT, $FXM", SprMFCR>,
1928            PPC970_DGroup_First, PPC970_Unit_CRU;
1929
1930def MFCR : XFXForm_3<31, 19, (outs gprc:$rT), (ins),
1931                     "mfcr $rT", SprMFCR>,
1932                     PPC970_MicroCode, PPC970_Unit_CRU;
1933} // neverHasSideEffects = 1
1934
1935// Pseudo instruction to perform FADD in round-to-zero mode.
1936let usesCustomInserter = 1, Uses = [RM] in {
1937  def FADDrtz: Pseudo<(outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRB), "",
1938                      [(set f64:$FRT, (PPCfaddrtz f64:$FRA, f64:$FRB))]>;
1939}
1940
1941// The above pseudo gets expanded to make use of the following instructions
1942// to manipulate FPSCR.  Note that FPSCR is not modeled at the DAG level.
1943let Uses = [RM], Defs = [RM] in { 
1944  def MTFSB0 : XForm_43<63, 70, (outs), (ins u5imm:$FM),
1945                        "mtfsb0 $FM", IntMTFSB0, []>,
1946               PPC970_DGroup_Single, PPC970_Unit_FPU;
1947  def MTFSB1 : XForm_43<63, 38, (outs), (ins u5imm:$FM),
1948                        "mtfsb1 $FM", IntMTFSB0, []>,
1949               PPC970_DGroup_Single, PPC970_Unit_FPU;
1950  def MTFSF  : XFLForm<63, 711, (outs), (ins i32imm:$FM, f8rc:$rT),
1951                       "mtfsf $FM, $rT", IntMTFSB0, []>,
1952               PPC970_DGroup_Single, PPC970_Unit_FPU;
1953}
1954let Uses = [RM] in {
1955  def MFFS   : XForm_42<63, 583, (outs f8rc:$rT), (ins),
1956                         "mffs $rT", IntMFFS,
1957                         [(set f64:$rT, (PPCmffs))]>,
1958               PPC970_DGroup_Single, PPC970_Unit_FPU;
1959}
1960
1961
1962let PPC970_Unit = 1, neverHasSideEffects = 1 in {  // FXU Operations.
1963// XO-Form instructions.  Arithmetic instructions that can set overflow bit
1964//
1965defm ADD4  : XOForm_1r<31, 266, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1966                       "add", "$rT, $rA, $rB", IntSimple,
1967                       [(set i32:$rT, (add i32:$rA, i32:$rB))]>;
1968defm ADDC  : XOForm_1rc<31, 10, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1969                        "addc", "$rT, $rA, $rB", IntGeneral,
1970                        [(set i32:$rT, (addc i32:$rA, i32:$rB))]>,
1971                        PPC970_DGroup_Cracked;
1972defm DIVW  : XOForm_1r<31, 491, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1973                       "divw", "$rT, $rA, $rB", IntDivW,
1974                       [(set i32:$rT, (sdiv i32:$rA, i32:$rB))]>,
1975                       PPC970_DGroup_First, PPC970_DGroup_Cracked;
1976defm DIVWU : XOForm_1r<31, 459, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1977                       "divwu", "$rT, $rA, $rB", IntDivW,
1978                       [(set i32:$rT, (udiv i32:$rA, i32:$rB))]>,
1979                       PPC970_DGroup_First, PPC970_DGroup_Cracked;
1980defm MULHW : XOForm_1r<31, 75, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1981                       "mulhw", "$rT, $rA, $rB", IntMulHW,
1982                       [(set i32:$rT, (mulhs i32:$rA, i32:$rB))]>;
1983defm MULHWU : XOForm_1r<31, 11, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1984                       "mulhwu", "$rT, $rA, $rB", IntMulHWU,
1985                       [(set i32:$rT, (mulhu i32:$rA, i32:$rB))]>;
1986defm MULLW : XOForm_1r<31, 235, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1987                       "mullw", "$rT, $rA, $rB", IntMulHW,
1988                       [(set i32:$rT, (mul i32:$rA, i32:$rB))]>;
1989defm SUBF  : XOForm_1r<31, 40, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1990                       "subf", "$rT, $rA, $rB", IntGeneral,
1991                       [(set i32:$rT, (sub i32:$rB, i32:$rA))]>;
1992defm SUBFC : XOForm_1rc<31, 8, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
1993                        "subfc", "$rT, $rA, $rB", IntGeneral,
1994                        [(set i32:$rT, (subc i32:$rB, i32:$rA))]>,
1995                        PPC970_DGroup_Cracked;
1996defm NEG    : XOForm_3r<31, 104, 0, (outs gprc:$rT), (ins gprc:$rA),
1997                        "neg", "$rT, $rA", IntSimple,
1998                        [(set i32:$rT, (ineg i32:$rA))]>;
1999let Uses = [CARRY] in {
2000defm ADDE  : XOForm_1rc<31, 138, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
2001                        "adde", "$rT, $rA, $rB", IntGeneral,
2002                        [(set i32:$rT, (adde i32:$rA, i32:$rB))]>;
2003defm ADDME  : XOForm_3rc<31, 234, 0, (outs gprc:$rT), (ins gprc:$rA),
2004                         "addme", "$rT, $rA", IntGeneral,
2005                         [(set i32:$rT, (adde i32:$rA, -1))]>;
2006defm ADDZE  : XOForm_3rc<31, 202, 0, (outs gprc:$rT), (ins gprc:$rA),
2007                         "addze", "$rT, $rA", IntGeneral,
2008                         [(set i32:$rT, (adde i32:$rA, 0))]>;
2009defm SUBFE : XOForm_1rc<31, 136, 0, (outs gprc:$rT), (ins gprc:$rA, gprc:$rB),
2010                        "subfe", "$rT, $rA, $rB", IntGeneral,
2011                        [(set i32:$rT, (sube i32:$rB, i32:$rA))]>;
2012defm SUBFME : XOForm_3rc<31, 232, 0, (outs gprc:$rT), (ins gprc:$rA),
2013                         "subfme", "$rT, $rA", IntGeneral,
2014                         [(set i32:$rT, (sube -1, i32:$rA))]>;
2015defm SUBFZE : XOForm_3rc<31, 200, 0, (outs gprc:$rT), (ins gprc:$rA),
2016                         "subfze", "$rT, $rA", IntGeneral,
2017                         [(set i32:$rT, (sube 0, i32:$rA))]>;
2018}
2019}
2020
2021// A-Form instructions.  Most of the instructions executed in the FPU are of
2022// this type.
2023//
2024let PPC970_Unit = 3, neverHasSideEffects = 1 in {  // FPU Operations.
2025let Uses = [RM] in {
2026  defm FMADD : AForm_1r<63, 29, 
2027                      (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRC, f8rc:$FRB),
2028                      "fmadd", "$FRT, $FRA, $FRC, $FRB", FPFused,
2029                      [(set f64:$FRT, (fma f64:$FRA, f64:$FRC, f64:$FRB))]>;
2030  defm FMADDS : AForm_1r<59, 29,
2031                      (outs f4rc:$FRT), (ins f4rc:$FRA, f4rc:$FRC, f4rc:$FRB),
2032                      "fmadds", "$FRT, $FRA, $FRC, $FRB", FPGeneral,
2033                      [(set f32:$FRT, (fma f32:$FRA, f32:$FRC, f32:$FRB))]>;
2034  defm FMSUB : AForm_1r<63, 28,
2035                      (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRC, f8rc:$FRB),
2036                      "fmsub", "$FRT, $FRA, $FRC, $FRB", FPFused,
2037                      [(set f64:$FRT,
2038                            (fma f64:$FRA, f64:$FRC, (fneg f64:$FRB)))]>;
2039  defm FMSUBS : AForm_1r<59, 28,
2040                      (outs f4rc:$FRT), (ins f4rc:$FRA, f4rc:$FRC, f4rc:$FRB),
2041                      "fmsubs", "$FRT, $FRA, $FRC, $FRB", FPGeneral,
2042                      [(set f32:$FRT,
2043                            (fma f32:$FRA, f32:$FRC, (fneg f32:$FRB)))]>;
2044  defm FNMADD : AForm_1r<63, 31,
2045                      (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRC, f8rc:$FRB),
2046                      "fnmadd", "$FRT, $FRA, $FRC, $FRB", FPFused,
2047                      [(set f64:$FRT,
2048                            (fneg (fma f64:$FRA, f64:$FRC, f64:$FRB)))]>;
2049  defm FNMADDS : AForm_1r<59, 31,
2050                      (outs f4rc:$FRT), (ins f4rc:$FRA, f4rc:$FRC, f4rc:$FRB),
2051                      "fnmadds", "$FRT, $FRA, $FRC, $FRB", FPGeneral,
2052                      [(set f32:$FRT,
2053                            (fneg (fma f32:$FRA, f32:$FRC, f32:$FRB)))]>;
2054  defm FNMSUB : AForm_1r<63, 30,
2055                      (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRC, f8rc:$FRB),
2056                      "fnmsub", "$FRT, $FRA, $FRC, $FRB", FPFused,
2057                      [(set f64:$FRT, (fneg (fma f64:$FRA, f64:$FRC,
2058                                                 (fneg f64:$FRB))))]>;
2059  defm FNMSUBS : AForm_1r<59, 30,
2060                      (outs f4rc:$FRT), (ins f4rc:$FRA, f4rc:$FRC, f4rc:$FRB),
2061                      "fnmsubs", "$FRT, $FRA, $FRC, $FRB", FPGeneral,
2062                      [(set f32:$FRT, (fneg (fma f32:$FRA, f32:$FRC,
2063                                                 (fneg f32:$FRB))))]>;
2064}
2065// FSEL is artificially split into 4 and 8-byte forms for the result.  To avoid
2066// having 4 of these, force the comparison to always be an 8-byte double (code
2067// should use an FMRSD if the input comparison value really wants to be a float)
2068// and 4/8 byte forms for the result and operand type..
2069let Interpretation64Bit = 1 in
2070defm FSELD : AForm_1r<63, 23,
2071                      (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRC, f8rc:$FRB),
2072                      "fsel", "$FRT, $FRA, $FRC, $FRB", FPGeneral,
2073                      [(set f64:$FRT, (PPCfsel f64:$FRA, f64:$FRC, f64:$FRB))]>;
2074defm FSELS : AForm_1r<63, 23,
2075                      (outs f4rc:$FRT), (ins f8rc:$FRA, f4rc:$FRC, f4rc:$FRB),
2076                      "fsel", "$FRT, $FRA, $FRC, $FRB", FPGeneral,
2077                      [(set f32:$FRT, (PPCfsel f64:$FRA, f32:$FRC, f32:$FRB))]>;
2078let Uses = [RM] in {
2079  defm FADD  : AForm_2r<63, 21,
2080                        (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRB),
2081                        "fadd", "$FRT, $FRA, $FRB", FPAddSub,
2082                        [(set f64:$FRT, (fadd f64:$FRA, f64:$FRB))]>;
2083  defm FADDS : AForm_2r<59, 21,
2084                        (outs f4rc:$FRT), (ins f4rc:$FRA, f4rc:$FRB),
2085                        "fadds", "$FRT, $FRA, $FRB", FPGeneral,
2086                        [(set f32:$FRT, (fadd f32:$FRA, f32:$FRB))]>;
2087  defm FDIV  : AForm_2r<63, 18,
2088                        (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRB),
2089                        "fdiv", "$FRT, $FRA, $FRB", FPDivD,
2090                        [(set f64:$FRT, (fdiv f64:$FRA, f64:$FRB))]>;
2091  defm FDIVS : AForm_2r<59, 18,
2092                        (outs f4rc:$FRT), (ins f4rc:$FRA, f4rc:$FRB),
2093                        "fdivs", "$FRT, $FRA, $FRB", FPDivS,
2094                        [(set f32:$FRT, (fdiv f32:$FRA, f32:$FRB))]>;
2095  defm FMUL  : AForm_3r<63, 25,
2096                        (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRC),
2097                        "fmul", "$FRT, $FRA, $FRC", FPFused,
2098                        [(set f64:$FRT, (fmul f64:$FRA, f64:$FRC))]>;
2099  defm FMULS : AForm_3r<59, 25,
2100                        (outs f4rc:$FRT), (ins f4rc:$FRA, f4rc:$FRC),
2101                        "fmuls", "$FRT, $FRA, $FRC", FPGeneral,
2102                        [(set f32:$FRT, (fmul f32:$FRA, f32:$FRC))]>;
2103  defm FSUB  : AForm_2r<63, 20,
2104                        (outs f8rc:$FRT), (ins f8rc:$FRA, f8rc:$FRB),
2105                        "fsub", "$FRT, $FRA, $FRB", FPAddSub,
2106                        [(set f64:$FRT, (fsub f64:$FRA, f64:$FRB))]>;
2107  defm FSUBS : AForm_2r<59, 20,
2108                        (outs f4rc:$FRT), (ins f4rc:$FRA, f4rc:$FRB),
2109                        "fsubs", "$FRT, $FRA, $FRB", FPGeneral,
2110                        [(set f32:$FRT, (fsub f32:$FRA, f32:$FRB))]>;
2111  }
2112}
2113
2114let neverHasSideEffects = 1 in {
2115let PPC970_Unit = 1 in {  // FXU Operations.
2116  let isSelect = 1 in
2117  def ISEL  : AForm_4<31, 15,
2118                     (outs gprc:$rT), (ins gprc_nor0:$rA, gprc:$rB, crbitrc:$cond),
2119                     "isel $rT, $rA, $rB, $cond", IntGeneral,
2120                     []>;
2121}
2122
2123let PPC970_Unit = 1 in {  // FXU Operations.
2124// M-Form instructions.  rotate and mask instructions.
2125//
2126let isCommutable = 1 in {
2127// RLWIMI can be commuted if the rotate amount is zero.
2128defm RLWIMI : MForm_2r<20, (outs gprc:$rA),
2129                       (ins gprc:$rSi, gprc:$rS, u5imm:$SH, u5imm:$MB,
2130                       u5imm:$ME), "rlwimi", "$rA, $rS, $SH, $MB, $ME", IntRotate,
2131                       []>, PPC970_DGroup_Cracked, RegConstraint<"$rSi = $rA">,
2132                       NoEncode<"$rSi">;
2133}
2134let BaseName = "rlwinm" in {
2135def RLWINM : MForm_2<21,
2136                     (outs gprc:$rA), (ins gprc:$rS, u5imm:$SH, u5imm:$MB, u5imm:$ME),
2137                     "rlwinm $rA, $rS, $SH, $MB, $ME", IntGeneral,
2138                     []>, RecFormRel;
2139let Defs = [CR0] in
2140def RLWINMo : MForm_2<21,
2141                      (outs gprc:$rA), (ins gprc:$rS, u5imm:$SH, u5imm:$MB, u5imm:$ME),
2142                      "rlwinm. $rA, $rS, $SH, $MB, $ME", IntGeneral,
2143                      []>, isDOT, RecFormRel, PPC970_DGroup_Cracked;
2144}
2145defm RLWNM  : MForm_2r<23, (outs gprc:$rA),
2146                       (ins gprc:$rS, gprc:$rB, u5imm:$MB, u5imm:$ME),
2147                       "rlwnm", "$rA, $rS, $rB, $MB, $ME", IntGeneral,
2148                       []>;
2149}
2150} // neverHasSideEffects = 1
2151
2152//===----------------------------------------------------------------------===//
2153// PowerPC Instruction Patterns
2154//
2155
2156// Arbitrary immediate support.  Implement in terms of LIS/ORI.
2157def : Pat<(i32 imm:$imm),
2158          (ORI (LIS (HI16 imm:$imm)), (LO16 imm:$imm))>;
2159
2160// Implement the 'not' operation with the NOR instruction.
2161def NOT : Pat<(not i32:$in),
2162              (NOR $in, $in)>;
2163
2164// ADD an arbitrary immediate.
2165def : Pat<(add i32:$in, imm:$imm),
2166          (ADDIS (ADDI $in, (LO16 imm:$imm)), (HA16 imm:$imm))>;
2167// OR an arbitrary immediate.
2168def : Pat<(or i32:$in, imm:$imm),
2169          (ORIS (ORI $in, (LO16 imm:$imm)), (HI16 imm:$imm))>;
2170// XOR an arbitrary immediate.
2171def : Pat<(xor i32:$in, imm:$imm),
2172          (XORIS (XORI $in, (LO16 imm:$imm)), (HI16 imm:$imm))>;
2173// SUBFIC
2174def : Pat<(sub imm32SExt16:$imm, i32:$in),
2175          (SUBFIC $in, imm:$imm)>;
2176
2177// SHL/SRL
2178def : Pat<(shl i32:$in, (i32 imm:$imm)),
2179          (RLWINM $in, imm:$imm, 0, (SHL32 imm:$imm))>;
2180def : Pat<(srl i32:$in, (i32 imm:$imm)),
2181          (RLWINM $in, (SRL32 imm:$imm), imm:$imm, 31)>;
2182
2183// ROTL
2184def : Pat<(rotl i32:$in, i32:$sh),
2185          (RLWNM $in, $sh, 0, 31)>;
2186def : Pat<(rotl i32:$in, (i32 imm:$imm)),
2187          (RLWINM $in, imm:$imm, 0, 31)>;
2188
2189// RLWNM
2190def : Pat<(and (rotl i32:$in, i32:$sh), maskimm32:$imm),
2191          (RLWNM $in, $sh, (MB maskimm32:$imm), (ME maskimm32:$imm))>;
2192
2193// Calls
2194def : Pat<(PPCcall (i32 tglobaladdr:$dst)),
2195          (BL tglobaladdr:$dst)>;
2196def : Pat<(PPCcall (i32 texternalsym:$dst)),
2197          (BL texternalsym:$dst)>;
2198
2199
2200def : Pat<(PPCtc_return (i32 tglobaladdr:$dst),  imm:$imm),
2201          (TCRETURNdi tglobaladdr:$dst, imm:$imm)>;
2202
2203def : Pat<(PPCtc_return (i32 texternalsym:$dst), imm:$imm),
2204          (TCRETURNdi texternalsym:$dst, imm:$imm)>;
2205
2206def : Pat<(PPCtc_return CTRRC:$dst, imm:$imm),
2207          (TCRETURNri CTRRC:$dst, imm:$imm)>;
2208
2209
2210
2211// Hi and Lo for Darwin Global Addresses.
2212def : Pat<(PPChi tglobaladdr:$in, 0), (LIS tglobaladdr:$in)>;
2213def : Pat<(PPClo tglobaladdr:$in, 0), (LI tglobaladdr:$in)>;
2214def : Pat<(PPChi tconstpool:$in, 0), (LIS tconstpool:$in)>;
2215def : Pat<(PPClo tconstpool:$in, 0), (LI tconstpool:$in)>;
2216def : Pat<(PPChi tjumptable:$in, 0), (LIS tjumptable:$in)>;
2217def : Pat<(PPClo tjumptable:$in, 0), (LI tjumptable:$in)>;
2218def : Pat<(PPChi tblockaddress:$in, 0), (LIS tblockaddress:$in)>;
2219def : Pat<(PPClo tblockaddress:$in, 0), (LI tblockaddress:$in)>;
2220def : Pat<(PPChi tglobaltlsaddr:$g, i32:$in),
2221          (ADDIS $in, tglobaltlsaddr:$g)>;
2222def : Pat<(PPClo tglobaltlsaddr:$g, i32:$in),
2223          (ADDI $in, tglobaltlsaddr:$g)>;
2224def : Pat<(add i32:$in, (PPChi tglobaladdr:$g, 0)),
2225          (ADDIS $in, tglobaladdr:$g)>;
2226def : Pat<(add i32:$in, (PPChi tconstpool:$g, 0)),
2227          (ADDIS $in, tconstpool:$g)>;
2228def : Pat<(add i32:$in, (PPChi tjumptable:$g, 0)),
2229          (ADDIS $in, tjumptable:$g)>;
2230def : Pat<(add i32:$in, (PPChi tblockaddress:$g, 0)),
2231          (ADDIS $in, tblockaddress:$g)>;
2232
2233// Standard shifts.  These are represented separately from the real shifts above
2234// so that we can distinguish between shifts that allow 5-bit and 6-bit shift
2235// amounts.
2236def : Pat<(sra i32:$rS, i32:$rB),
2237          (SRAW $rS, $rB)>;
2238def : Pat<(srl i32:$rS, i32:$rB),
2239          (SRW $rS, $rB)>;
2240def : Pat<(shl i32:$rS, i32:$rB),
2241          (SLW $rS, $rB)>;
2242
2243def : Pat<(zextloadi1 iaddr:$src),
2244          (LBZ iaddr:$src)>;
2245def : Pat<(zextloadi1 xaddr:$src),
2246          (LBZX xaddr:$src)>;
2247def : Pat<(extloadi1 iaddr:$src),
2248          (LBZ iaddr:$src)>;
2249def : Pat<(extloadi1 xaddr:$src),
2250          (LBZX xaddr:$src)>;
2251def : Pat<(extloadi8 iaddr:$src),
2252          (LBZ iaddr:$src)>;
2253def : Pat<(extloadi8 xaddr:$src),
2254          (LBZX xaddr:$src)>;
2255def : Pat<(extloadi16 iaddr:$src),
2256          (LHZ iaddr:$src)>;
2257def : Pat<(extloadi16 xaddr:$src),
2258          (LHZX xaddr:$src)>;
2259def : Pat<(f64 (extloadf32 iaddr:$src)),
2260          (COPY_TO_REGCLASS (LFS iaddr:$src), F8RC)>;
2261def : Pat<(f64 (extloadf32 xaddr:$src)),
2262          (COPY_TO_REGCLASS (LFSX xaddr:$src), F8RC)>;
2263
2264def : Pat<(f64 (fextend f32:$src)),
2265          (COPY_TO_REGCLASS $src, F8RC)>;
2266
2267def : Pat<(atomic_fence (imm), (imm)), (SYNC 0)>;
2268
2269// Additional FNMSUB patterns: -a*c + b == -(a*c - b)
2270def : Pat<(fma (fneg f64:$A), f64:$C, f64:$B),
2271          (FNMSUB $A, $C, $B)>;
2272def : Pat<(fma f64:$A, (fneg f64:$C), f64:$B),
2273          (FNMSUB $A, $C, $B)>;
2274def : Pat<(fma (fneg f32:$A), f32:$C, f32:$B),
2275          (FNMSUBS $A, $C, $B)>;
2276def : Pat<(fma f32:$A, (fneg f32:$C), f32:$B),
2277          (FNMSUBS $A, $C, $B)>;
2278
2279include "PPCInstrAltivec.td"
2280include "PPCInstr64Bit.td"
2281
2282
2283//===----------------------------------------------------------------------===//
2284// PowerPC Instructions used for assembler/disassembler only
2285//
2286
2287def ISYNC : XLForm_2_ext<19, 150, 0, 0, 0, (outs), (ins),
2288                         "isync", SprISYNC, []>;
2289
2290def ICBI : XForm_1a<31, 982, (outs), (ins memrr:$src),
2291                    "icbi $src", LdStICBI, []>;
2292
2293def EIEIO : XForm_24_eieio<31, 854, (outs), (ins),
2294                           "eieio", LdStLoad, []>;
2295
2296def WAIT : XForm_24_sync<31, 62, (outs), (ins i32imm:$L),
2297                         "wait $L", LdStLoad, []>;
2298
2299//===----------------------------------------------------------------------===//
2300// PowerPC Assembler Instruction Aliases
2301//
2302
2303// Pseudo-instructions for alternate assembly syntax (never used by codegen).
2304// These are aliases that require C++ handling to convert to the target
2305// instruction, while InstAliases can be handled directly by tblgen.
2306class PPCAsmPseudo<string asm, dag iops>
2307  : Instruction {
2308  let Namespace = "PPC";
2309  bit PPC64 = 0;  // Default value, override with isPPC64
2310
2311  let OutOperandList = (outs);
2312  let InOperandList = iops;
2313  let Pattern = [];
2314  let AsmString = asm;
2315  let isAsmParserOnly = 1;
2316  let isPseudo = 1;
2317}
2318
2319def : InstAlias<"sc", (SC 0)>;
2320
2321def : InstAlias<"sync", (SYNC 0)>;
2322def : InstAlias<"msync", (SYNC 0)>;
2323def : InstAlias<"lwsync", (SYNC 1)>;
2324def : InstAlias<"ptesync", (SYNC 2)>;
2325
2326def : InstAlias<"wait", (WAIT 0)>;
2327def : InstAlias<"waitrsv", (WAIT 1)>;
2328def : InstAlias<"waitimpl", (WAIT 2)>;
2329
2330def : InstAlias<"crset $bx", (CREQV crbitrc:$bx, crbitrc:$bx, crbitrc:$bx)>;
2331def : InstAlias<"crclr $bx", (CRXOR crbitrc:$bx, crbitrc:$bx, crbitrc:$bx)>;
2332def : InstAlias<"crmove $bx, $by", (CROR crbitrc:$bx, crbitrc:$by, crbitrc:$by)>;
2333def : InstAlias<"crnot $bx, $by", (CRNOR crbitrc:$bx, crbitrc:$by, crbitrc:$by)>;
2334
2335def : InstAlias<"mtxer $Rx", (MTSPR 1, gprc:$Rx)>;
2336def : InstAlias<"mfxer $Rx", (MFSPR gprc:$Rx, 1)>;
2337
2338def : InstAlias<"xnop", (XORI R0, R0, 0)>;
2339
2340def : InstAlias<"mr $rA, $rB", (OR8 g8rc:$rA, g8rc:$rB, g8rc:$rB)>;
2341def : InstAlias<"mr. $rA, $rB", (OR8o g8rc:$rA, g8rc:$rB, g8rc:$rB)>;
2342
2343def : InstAlias<"not $rA, $rB", (NOR8 g8rc:$rA, g8rc:$rB, g8rc:$rB)>;
2344def : InstAlias<"not. $rA, $rB", (NOR8o g8rc:$rA, g8rc:$rB, g8rc:$rB)>;
2345
2346def : InstAlias<"mtcr $rA", (MTCRF8 255, g8rc:$rA)>;
2347
2348def LAx : PPCAsmPseudo<"la $rA, $addr", (ins gprc:$rA, memri:$addr)>;
2349
2350def SUBI : PPCAsmPseudo<"subi $rA, $rB, $imm",
2351                        (ins gprc:$rA, gprc:$rB, s16imm:$imm)>;
2352def SUBIS : PPCAsmPseudo<"subis $rA, $rB, $imm",
2353                         (ins gprc:$rA, gprc:$rB, s16imm:$imm)>;
2354def SUBIC : PPCAsmPseudo<"subic $rA, $rB, $imm",
2355                         (ins gprc:$rA, gprc:$rB, s16imm:$imm)>;
2356def SUBICo : PPCAsmPseudo<"subic. $rA, $rB, $imm",
2357                          (ins gprc:$rA, gprc:$rB, s16imm:$imm)>;
2358
2359def : InstAlias<"sub $rA, $rB, $rC", (SUBF8 g8rc:$rA, g8rc:$rC, g8rc:$rB)>;
2360def : InstAlias<"sub. $rA, $rB, $rC", (SUBF8o g8rc:$rA, g8rc:$rC, g8rc:$rB)>;
2361def : InstAlias<"subc $rA, $rB, $rC", (SUBFC8 g8rc:$rA, g8rc:$rC, g8rc:$rB)>;
2362def : InstAlias<"subc. $rA, $rB, $rC", (SUBFC8o g8rc:$rA, g8rc:$rC, g8rc:$rB)>;
2363
2364def EXTLWI : PPCAsmPseudo<"extlwi $rA, $rS, $n, $b",
2365                          (ins gprc:$rA, gprc:$rS, u5imm:$n, u5imm:$b)>;
2366def EXTLWIo : PPCAsmPseudo<"extlwi. $rA, $rS, $n, $b",
2367                           (ins gprc:$rA, gprc:$rS, u5imm:$n, u5imm:$b)>;
2368def EXTRWI : PPCAsmPseudo<"extrwi $rA, $rS, $n, $b",
2369                          (ins gprc:$rA, gprc:$rS, u5imm:$n, u5imm:$b)>;
2370def EXTRWIo : PPCAsmPseudo<"extrwi. $rA, $rS, $n, $b",
2371                           (ins gprc:$rA, gprc:$rS, u5imm:$n, u5imm:$b)>;
2372def INSLWI : PPCAsmPseudo<"inslwi $rA, $rS, $n, $b",
2373                          (ins gprc:$rA, gprc:$rS, u5imm:$n, u5imm:$b)>;
2374def INSLWIo : PPCAsmPseudo<"inslwi. $rA, $rS, $n, $b",
2375                           (ins gprc:$rA, gprc:$rS, u5imm:$n, u5imm:$b)>;
2376def INSRWI : PPCAsmPseudo<"insrwi $rA, $rS, $n, $b",
2377                          (ins gprc:$rA, gprc:$rS, u5imm:$n, u5imm:$b)>;
2378def INSRWIo : PPCAsmPseudo<"insrwi. $rA, $rS, $n, $b",
2379                           (ins gprc:$rA, gprc:$rS, u5imm:$n, u5imm:$b)>;
2380def ROTRWI : PPCAsmPseudo<"rotrwi $rA, $rS, $n",
2381                          (ins gprc:$rA, gprc:$rS, u5imm:$n)>;
2382def ROTRWIo : PPCAsmPseudo<"rotrwi. $rA, $rS, $n",
2383                           (ins gprc:$rA, gprc:$rS, u5imm:$n)>;
2384def SLWI : PPCAsmPseudo<"slwi $rA, $rS, $n",
2385                        (ins gprc:$rA, gprc:$rS, u5imm:$n)>;
2386def SLWIo : PPCAsmPseudo<"slwi. $rA, $rS, $n",
2387                         (ins gprc:$rA, gprc:$rS, u5imm:$n)>;
2388def SRWI : PPCAsmPseudo<"srwi $rA, $rS, $n",
2389                        (ins gprc:$rA, gprc:$rS, u5imm:$n)>;
2390def SRWIo : PPCAsmPseudo<"srwi. $rA, $rS, $n",
2391                         (ins gprc:$rA, gprc:$rS, u5imm:$n)>;
2392def CLRRWI : PPCAsmPseudo<"clrrwi $rA, $rS, $n",
2393                          (ins gprc:$rA, gprc:$rS, u5imm:$n)>;
2394def CLRRWIo : PPCAsmPseudo<"clrrwi. $rA, $rS, $n",
2395                           (ins gprc:$rA, gprc:$rS, u5imm:$n)>;
2396def CLRLSLWI : PPCAsmPseudo<"clrlslwi $rA, $rS, $b, $n",
2397                            (ins gprc:$rA, gprc:$rS, u5imm:$b, u5imm:$n)>;
2398def CLRLSLWIo : PPCAsmPseudo<"clrlslwi. $rA, $rS, $b, $n",
2399                             (ins gprc:$rA, gprc:$rS, u5imm:$b, u5imm:$n)>;
2400
2401def : InstAlias<"rotlwi $rA, $rS, $n", (RLWINM gprc:$rA, gprc:$rS, u5imm:$n, 0, 31)>;
2402def : InstAlias<"rotlwi. $rA, $rS, $n", (RLWINMo gprc:$rA, gprc:$rS, u5imm:$n, 0, 31)>;
2403def : InstAlias<"rotlw $rA, $rS, $rB", (RLWNM gprc:$rA, gprc:$rS, gprc:$rB, 0, 31)>;
2404def : InstAlias<"rotlw. $rA, $rS, $rB", (RLWNMo gprc:$rA, gprc:$rS, gprc:$rB, 0, 31)>;
2405def : InstAlias<"clrlwi $rA, $rS, $n", (RLWINM gprc:$rA, gprc:$rS, 0, u5imm:$n, 31)>;
2406def : InstAlias<"clrlwi. $rA, $rS, $n", (RLWINMo gprc:$rA, gprc:$rS, 0, u5imm:$n, 31)>;
2407
2408def EXTLDI : PPCAsmPseudo<"extldi $rA, $rS, $n, $b",
2409                          (ins g8rc:$rA, g8rc:$rS, u6imm:$n, u6imm:$b)>;
2410def EXTLDIo : PPCAsmPseudo<"extldi. $rA, $rS, $n, $b",
2411                           (ins g8rc:$rA, g8rc:$rS, u6imm:$n, u6imm:$b)>;
2412def EXTRDI : PPCAsmPseudo<"extrdi $rA, $rS, $n, $b",
2413                          (ins g8rc:$rA, g8rc:$rS, u6imm:$n, u6imm:$b)>;
2414def EXTRDIo : PPCAsmPseudo<"extrdi. $rA, $rS, $n, $b",
2415                           (ins g8rc:$rA, g8rc:$rS, u6imm:$n, u6imm:$b)>;
2416def INSRDI : PPCAsmPseudo<"insrdi $rA, $rS, $n, $b",
2417                          (ins g8rc:$rA, g8rc:$rS, u6imm:$n, u6imm:$b)>;
2418def INSRDIo : PPCAsmPseudo<"insrdi. $rA, $rS, $n, $b",
2419                           (ins g8rc:$rA, g8rc:$rS, u6imm:$n, u6imm:$b)>;
2420def ROTRDI : PPCAsmPseudo<"rotrdi $rA, $rS, $n",
2421                          (ins g8rc:$rA, g8rc:$rS, u6imm:$n)>;
2422def ROTRDIo : PPCAsmPseudo<"rotrdi. $rA, $rS, $n",
2423                           (ins g8rc:$rA, g8rc:$rS, u6imm:$n)>;
2424def SLDI : PPCAsmPseudo<"sldi $rA, $rS, $n",
2425                        (ins g8rc:$rA, g8rc:$rS, u6imm:$n)>;
2426def SLDIo : PPCAsmPseudo<"sldi. $rA, $rS, $n",
2427                         (ins g8rc:$rA, g8rc:$rS, u6imm:$n)>;
2428def SRDI : PPCAsmPseudo<"srdi $rA, $rS, $n",
2429                        (ins g8rc:$rA, g8rc:$rS, u6imm:$n)>;
2430def SRDIo : PPCAsmPseudo<"srdi. $rA, $rS, $n",
2431                         (ins g8rc:$rA, g8rc:$rS, u6imm:$n)>;
2432def CLRRDI : PPCAsmPseudo<"clrrdi $rA, $rS, $n",
2433                          (ins g8rc:$rA, g8rc:$rS, u6imm:$n)>;
2434def CLRRDIo : PPCAsmPseudo<"clrrdi. $rA, $rS, $n",
2435                           (ins g8rc:$rA, g8rc:$rS, u6imm:$n)>;
2436def CLRLSLDI : PPCAsmPseudo<"clrlsldi $rA, $rS, $b, $n",
2437                            (ins g8rc:$rA, g8rc:$rS, u6imm:$b, u6imm:$n)>;
2438def CLRLSLDIo : PPCAsmPseudo<"clrlsldi. $rA, $rS, $b, $n",
2439                             (ins g8rc:$rA, g8rc:$rS, u6imm:$b, u6imm:$n)>;
2440
2441def : InstAlias<"rotldi $rA, $rS, $n", (RLDICL g8rc:$rA, g8rc:$rS, u6imm:$n, 0)>;
2442def : InstAlias<"rotldi. $rA, $rS, $n", (RLDICLo g8rc:$rA, g8rc:$rS, u6imm:$n, 0)>;
2443def : InstAlias<"rotld $rA, $rS, $rB", (RLDCL g8rc:$rA, g8rc:$rS, gprc:$rB, 0)>;
2444def : InstAlias<"rotld. $rA, $rS, $rB", (RLDCLo g8rc:$rA, g8rc:$rS, gprc:$rB, 0)>;
2445def : InstAlias<"clrldi $rA, $rS, $n", (RLDICL g8rc:$rA, g8rc:$rS, 0, u6imm:$n)>;
2446def : InstAlias<"clrldi. $rA, $rS, $n", (RLDICLo g8rc:$rA, g8rc:$rS, 0, u6imm:$n)>;
2447
2448// These generic branch instruction forms are used for the assembler parser only.
2449// Defs and Uses are conservative, since we don't know the BO value.
2450let PPC970_Unit = 7 in {
2451  let Defs = [CTR], Uses = [CTR, RM] in {
2452    def gBC : BForm_3<16, 0, 0, (outs),
2453                      (ins u5imm:$bo, crbitrc:$bi, condbrtarget:$dst),
2454                      "bc $bo, $bi, $dst">;
2455    def gBCA : BForm_3<16, 1, 0, (outs),
2456                       (ins u5imm:$bo, crbitrc:$bi, abscondbrtarget:$dst),
2457                       "bca $bo, $bi, $dst">;
2458  }
2459  let Defs = [LR, CTR], Uses = [CTR, RM] in {
2460    def gBCL : BForm_3<16, 0, 1, (outs),
2461                       (ins u5imm:$bo, crbitrc:$bi, condbrtarget:$dst),
2462                       "bcl $bo, $bi, $dst">;
2463    def gBCLA : BForm_3<16, 1, 1, (outs),
2464                        (ins u5imm:$bo, crbitrc:$bi, abscondbrtarget:$dst),
2465                        "bcla $bo, $bi, $dst">;
2466  }
2467  let Defs = [CTR], Uses = [CTR, LR, RM] in
2468    def gBCLR : XLForm_2<19, 16, 0, (outs),
2469                         (ins u5imm:$bo, crbitrc:$bi, i32imm:$bh),
2470                         "bclr $bo, $bi, $bh", BrB, []>;
2471  let Defs = [LR, CTR], Uses = [CTR, LR, RM] in
2472    def gBCLRL : XLForm_2<19, 16, 1, (outs),
2473                          (ins u5imm:$bo, crbitrc:$bi, i32imm:$bh),
2474                          "bclrl $bo, $bi, $bh", BrB, []>;
2475  let Defs = [CTR], Uses = [CTR, LR, RM] in
2476    def gBCCTR : XLForm_2<19, 528, 0, (outs),
2477                          (ins u5imm:$bo, crbitrc:$bi, i32imm:$bh),
2478                          "bcctr $bo, $bi, $bh", BrB, []>;
2479  let Defs = [LR, CTR], Uses = [CTR, LR, RM] in
2480    def gBCCTRL : XLForm_2<19, 528, 1, (outs),
2481                           (ins u5imm:$bo, crbitrc:$bi, i32imm:$bh),
2482                           "bcctrl $bo, $bi, $bh", BrB, []>;
2483}
2484def : InstAlias<"bclr $bo, $bi", (gBCLR u5imm:$bo, crbitrc:$bi, 0)>;
2485def : InstAlias<"bclrl $bo, $bi", (gBCLRL u5imm:$bo, crbitrc:$bi, 0)>;
2486def : InstAlias<"bcctr $bo, $bi", (gBCCTR u5imm:$bo, crbitrc:$bi, 0)>;
2487def : InstAlias<"bcctrl $bo, $bi", (gBCCTRL u5imm:$bo, crbitrc:$bi, 0)>;
2488
2489multiclass BranchSimpleMnemonic1<string name, string pm, int bo> {
2490  def : InstAlias<"b"#name#pm#" $bi, $dst", (gBC bo, crbitrc:$bi, condbrtarget:$dst)>;
2491  def : InstAlias<"b"#name#"a"#pm#" $bi, $dst", (gBCA bo, crbitrc:$bi, abscondbrtarget:$dst)>;
2492  def : InstAlias<"b"#name#"lr"#pm#" $bi", (gBCLR bo, crbitrc:$bi, 0)>;
2493  def : InstAlias<"b"#name#"l"#pm#" $bi, $dst", (gBCL bo, crbitrc:$bi, condbrtarget:$dst)>;
2494  def : InstAlias<"b"#name#"la"#pm#" $bi, $dst", (gBCLA bo, crbitrc:$bi, abscondbrtarget:$dst)>;
2495  def : InstAlias<"b"#name#"lrl"#pm#" $bi", (gBCLRL bo, crbitrc:$bi, 0)>;
2496}
2497multiclass BranchSimpleMnemonic2<string name, string pm, int bo>
2498  : BranchSimpleMnemonic1<name, pm, bo> {
2499  def : InstAlias<"b"#name#"ctr"#pm#" $bi", (gBCCTR bo, crbitrc:$bi, 0)>;
2500  def : InstAlias<"b"#name#"ctrl"#pm#" $bi", (gBCCTRL bo, crbitrc:$bi, 0)>;
2501}
2502defm : BranchSimpleMnemonic2<"t", "", 12>;
2503defm : BranchSimpleMnemonic2<"f", "", 4>;
2504defm : BranchSimpleMnemonic2<"t", "-", 14>;
2505defm : BranchSimpleMnemonic2<"f", "-", 6>;
2506defm : BranchSimpleMnemonic2<"t", "+", 15>;
2507defm : BranchSimpleMnemonic2<"f", "+", 7>;
2508defm : BranchSimpleMnemonic1<"dnzt", "", 8>;
2509defm : BranchSimpleMnemonic1<"dnzf", "", 0>;
2510defm : BranchSimpleMnemonic1<"dzt", "", 10>;
2511defm : BranchSimpleMnemonic1<"dzf", "", 2>;
2512
2513multiclass BranchExtendedMnemonicPM<string name, string pm, int bibo> {
2514  def : InstAlias<"b"#name#pm#" $cc, $dst",
2515                  (BCC bibo, crrc:$cc, condbrtarget:$dst)>;
2516  def : InstAlias<"b"#name#pm#" $dst",
2517                  (BCC bibo, CR0, condbrtarget:$dst)>;
2518
2519  def : InstAlias<"b"#name#"a"#pm#" $cc, $dst",
2520                  (BCCA bibo, crrc:$cc, abscondbrtarget:$dst)>;
2521  def : InstAlias<"b"#name#"a"#pm#" $dst",
2522                  (BCCA bibo, CR0, abscondbrtarget:$dst)>;
2523
2524  def : InstAlias<"b"#name#"lr"#pm#" $cc",
2525                  (BCLR bibo, crrc:$cc)>;
2526  def : InstAlias<"b"#name#"lr"#pm,
2527                  (BCLR bibo, CR0)>;
2528
2529  def : InstAlias<"b"#name#"ctr"#pm#" $cc",
2530                  (BCCTR bibo, crrc:$cc)>;
2531  def : InstAlias<"b"#name#"ctr"#pm,
2532                  (BCCTR bibo, CR0)>;
2533
2534  def : InstAlias<"b"#name#"l"#pm#" $cc, $dst",
2535                  (BCCL bibo, crrc:$cc, condbrtarget:$dst)>;
2536  def : InstAlias<"b"#name#"l"#pm#" $dst",
2537                  (BCCL bibo, CR0, condbrtarget:$dst)>;
2538
2539  def : InstAlias<"b"#name#"la"#pm#" $cc, $dst",
2540                  (BCCLA bibo, crrc:$cc, abscondbrtarget:$dst)>;
2541  def : InstAlias<"b"#name#"la"#pm#" $dst",
2542                  (BCCLA bibo, CR0, abscondbrtarget:$dst)>;
2543
2544  def : InstAlias<"b"#name#"lrl"#pm#" $cc",
2545                  (BCLRL bibo, crrc:$cc)>;
2546  def : InstAlias<"b"#name#"lrl"#pm,
2547                  (BCLRL bibo, CR0)>;
2548
2549  def : InstAlias<"b"#name#"ctrl"#pm#" $cc",
2550                  (BCCTRL bibo, crrc:$cc)>;
2551  def : InstAlias<"b"#name#"ctrl"#pm,
2552                  (BCCTRL bibo, CR0)>;
2553}
2554multiclass BranchExtendedMnemonic<string name, int bibo> {
2555  defm : BranchExtendedMnemonicPM<name, "", bibo>;
2556  defm : BranchExtendedMnemonicPM<name, "-", !add(bibo, 2)>;
2557  defm : BranchExtendedMnemonicPM<name, "+", !add(bibo, 3)>;
2558}
2559defm : BranchExtendedMnemonic<"lt", 12>;
2560defm : BranchExtendedMnemonic<"gt", 44>;
2561defm : BranchExtendedMnemonic<"eq", 76>;
2562defm : BranchExtendedMnemonic<"un", 108>;
2563defm : BranchExtendedMnemonic<"so", 108>;
2564defm : BranchExtendedMnemonic<"ge", 4>;
2565defm : BranchExtendedMnemonic<"nl", 4>;
2566defm : BranchExtendedMnemonic<"le", 36>;
2567defm : BranchExtendedMnemonic<"ng", 36>;
2568defm : BranchExtendedMnemonic<"ne", 68>;
2569defm : BranchExtendedMnemonic<"nu", 100>;
2570defm : BranchExtendedMnemonic<"ns", 100>;
2571
2572def : InstAlias<"cmpwi $rA, $imm", (CMPWI CR0, gprc:$rA, s16imm:$imm)>;
2573def : InstAlias<"cmpw $rA, $rB", (CMPW CR0, gprc:$rA, gprc:$rB)>;
2574def : InstAlias<"cmplwi $rA, $imm", (CMPLWI CR0, gprc:$rA, u16imm:$imm)>;
2575def : InstAlias<"cmplw $rA, $rB", (CMPLW CR0, gprc:$rA, gprc:$rB)>;
2576def : InstAlias<"cmpdi $rA, $imm", (CMPDI CR0, g8rc:$rA, s16imm:$imm)>;
2577def : InstAlias<"cmpd $rA, $rB", (CMPD CR0, g8rc:$rA, g8rc:$rB)>;
2578def : InstAlias<"cmpldi $rA, $imm", (CMPLDI CR0, g8rc:$rA, u16imm:$imm)>;
2579def : InstAlias<"cmpld $rA, $rB", (CMPLD CR0, g8rc:$rA, g8rc:$rB)>;
2580
2581multiclass TrapExtendedMnemonic<string name, int to> {
2582  def : InstAlias<"td"#name#"i $rA, $imm", (TDI to, g8rc:$rA, s16imm:$imm)>;
2583  def : InstAlias<"td"#name#" $rA, $rB", (TD to, g8rc:$rA, g8rc:$rB)>;
2584  def : InstAlias<"tw"#name#"i $rA, $imm", (TWI to, gprc:$rA, s16imm:$imm)>;
2585  def : InstAlias<"tw"#name#" $rA, $rB", (TW to, gprc:$rA, gprc:$rB)>;
2586}
2587defm : TrapExtendedMnemonic<"lt", 16>;
2588defm : TrapExtendedMnemonic<"le", 20>;
2589defm : TrapExtendedMnemonic<"eq", 4>;
2590defm : TrapExtendedMnemonic<"ge", 12>;
2591defm : TrapExtendedMnemonic<"gt", 8>;
2592defm : TrapExtendedMnemonic<"nl", 12>;
2593defm : TrapExtendedMnemonic<"ne", 24>;
2594defm : TrapExtendedMnemonic<"ng", 20>;
2595defm : TrapExtendedMnemonic<"llt", 2>;
2596defm : TrapExtendedMnemonic<"lle", 6>;
2597defm : TrapExtendedMnemonic<"lge", 5>;
2598defm : TrapExtendedMnemonic<"lgt", 1>;
2599defm : TrapExtendedMnemonic<"lnl", 5>;
2600defm : TrapExtendedMnemonic<"lng", 6>;
2601defm : TrapExtendedMnemonic<"u", 31>;
2602
2603