1//===-- AVRInstrInfo.td - AVR Instruction defs -------------*- tablegen -*-===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8//
9// This file describes the AVR instructions in TableGen format.
10//
11//===----------------------------------------------------------------------===//
12
13include "AVRInstrFormats.td"
14
15//===----------------------------------------------------------------------===//
16// AVR Type Profiles
17//===----------------------------------------------------------------------===//
18
19def SDT_AVRCallSeqStart : SDCallSeqStart<[SDTCisVT<0, i16>, SDTCisVT<1, i16>]>;
20def SDT_AVRCallSeqEnd : SDCallSeqEnd<[SDTCisVT<0, i16>, SDTCisVT<1, i16>]>;
21def SDT_AVRCall : SDTypeProfile<0, -1, [SDTCisVT<0, iPTR>]>;
22def SDT_AVRWrapper : SDTypeProfile<1, 1, [SDTCisSameAs<0, 1>, SDTCisPtrTy<0>]>;
23def SDT_AVRBrcond : SDTypeProfile<0, 2,
24                                  [SDTCisVT<0, OtherVT>, SDTCisVT<1, i8>]>;
25def SDT_AVRCmp : SDTypeProfile<0, 2, [SDTCisSameAs<0, 1>]>;
26def SDT_AVRTst : SDTypeProfile<0, 1, [SDTCisInt<0>]>;
27def SDT_AVRSelectCC : SDTypeProfile<1, 3, [SDTCisSameAs<0, 1>,
28                                    SDTCisSameAs<1, 2>, SDTCisVT<3, i8>]>;
29
30//===----------------------------------------------------------------------===//
31// AVR Specific Node Definitions
32//===----------------------------------------------------------------------===//
33
34def AVRretflag : SDNode<"AVRISD::RET_FLAG", SDTNone,
35                        [SDNPHasChain, SDNPOptInGlue, SDNPVariadic]>;
36def AVRretiflag : SDNode<"AVRISD::RETI_FLAG", SDTNone,
37                         [SDNPHasChain, SDNPOptInGlue, SDNPVariadic]>;
38
39def AVRcallseq_start : SDNode<"ISD::CALLSEQ_START", SDT_AVRCallSeqStart,
40                              [SDNPHasChain, SDNPOutGlue]>;
41def AVRcallseq_end : SDNode<"ISD::CALLSEQ_END", SDT_AVRCallSeqEnd,
42                            [SDNPHasChain, SDNPOptInGlue, SDNPOutGlue]>;
43
44def AVRcall : SDNode<"AVRISD::CALL", SDT_AVRCall,
45                     [SDNPHasChain, SDNPOutGlue, SDNPOptInGlue, SDNPVariadic]>;
46
47def AVRWrapper : SDNode<"AVRISD::WRAPPER", SDT_AVRWrapper>;
48
49def AVRbrcond : SDNode<"AVRISD::BRCOND", SDT_AVRBrcond,
50                       [SDNPHasChain, SDNPInGlue]>;
51def AVRcmp : SDNode<"AVRISD::CMP", SDT_AVRCmp, [SDNPOutGlue]>;
52def AVRcmpc : SDNode<"AVRISD::CMPC", SDT_AVRCmp, [SDNPInGlue, SDNPOutGlue]>;
53def AVRtst : SDNode<"AVRISD::TST", SDT_AVRTst, [SDNPOutGlue]>;
54def AVRselectcc: SDNode<"AVRISD::SELECT_CC", SDT_AVRSelectCC, [SDNPInGlue]>;
55
56// Shift nodes.
57def AVRlsl : SDNode<"AVRISD::LSL", SDTIntUnaryOp>;
58def AVRlsr : SDNode<"AVRISD::LSR", SDTIntUnaryOp>;
59def AVRrol : SDNode<"AVRISD::ROL", SDTIntUnaryOp>;
60def AVRror : SDNode<"AVRISD::ROR", SDTIntUnaryOp>;
61def AVRasr : SDNode<"AVRISD::ASR", SDTIntUnaryOp>;
62
63// Pseudo shift nodes for non-constant shift amounts.
64def AVRlslLoop : SDNode<"AVRISD::LSLLOOP", SDTIntShiftOp>;
65def AVRlsrLoop : SDNode<"AVRISD::LSRLOOP", SDTIntShiftOp>;
66def AVRrolLoop : SDNode<"AVRISD::ROLLOOP", SDTIntShiftOp>;
67def AVRrorLoop : SDNode<"AVRISD::RORLOOP", SDTIntShiftOp>;
68def AVRasrLoop : SDNode<"AVRISD::ASRLOOP", SDTIntShiftOp>;
69
70//===----------------------------------------------------------------------===//
71// AVR Operands, Complex Patterns and Transformations Definitions.
72//===----------------------------------------------------------------------===//
73
74def imm8_neg_XFORM : SDNodeXForm<imm,
75[{
76  return CurDAG->getTargetConstant(-N->getAPIntValue(), SDLoc(N), MVT::i8);
77}]>;
78
79def imm16_neg_XFORM : SDNodeXForm<imm,
80[{
81  return CurDAG->getTargetConstant(-N->getAPIntValue(), SDLoc(N), MVT::i16);
82}]>;
83
84def imm0_63_neg : PatLeaf<(imm),
85[{
86  int64_t val = -N->getSExtValue();
87  return val >= 0 && val < 64;
88}], imm16_neg_XFORM>;
89
90def uimm6 : PatLeaf<(imm), [{ return isUInt<6>(N->getZExtValue()); }]>;
91
92// imm_com8_XFORM - Return the complement of a imm_com8 value
93def imm_com8_XFORM : SDNodeXForm<imm, [{
94  return CurDAG->getTargetConstant(~((uint8_t)N->getZExtValue()), SDLoc(N),
95                                   MVT::i8);
96}]>;
97
98// imm_com8 - Match an immediate that is a complement
99// of a 8-bit immediate.
100// Note: this pattern doesn't require an encoder method and such, as it's
101// only used on aliases (Pat<> and InstAlias<>). The actual encoding
102// is handled by the destination instructions, which use imm_com8.
103def imm_com8_asmoperand : AsmOperandClass { let Name = "ImmCom8"; }
104def imm_com8 : Operand<i8> {
105  let ParserMatchClass = imm_com8_asmoperand;
106}
107
108def ioaddr_XFORM : SDNodeXForm<imm,
109[{
110  return CurDAG->getTargetConstant(uint8_t(N->getZExtValue()) - 0x20, SDLoc(N), MVT::i8);
111}]>;
112
113def iobitpos8_XFORM : SDNodeXForm<imm,
114[{
115  return CurDAG->getTargetConstant(Log2_32(uint8_t(N->getZExtValue())),
116                                   SDLoc(N), MVT::i8);
117}]>;
118
119def iobitposn8_XFORM : SDNodeXForm<imm,
120[{
121  return CurDAG->getTargetConstant(Log2_32(uint8_t(~N->getZExtValue())),
122                                   SDLoc(N), MVT::i8);
123}]>;
124
125def ioaddr8 : PatLeaf<(imm),
126[{
127  uint64_t val = N->getZExtValue();
128  return val >= 0x20 && val < 0x60;
129}], ioaddr_XFORM>;
130
131def lowioaddr8 : PatLeaf<(imm),
132[{
133  uint64_t val = N->getZExtValue();
134  return val >= 0x20 && val < 0x40;
135}], ioaddr_XFORM>;
136
137def ioaddr16 : PatLeaf<(imm),
138[{
139  uint64_t val = N->getZExtValue();
140  return val >= 0x20 && val < 0x5f;
141}], ioaddr_XFORM>;
142
143def iobitpos8 : PatLeaf<(imm),
144[{
145  return isPowerOf2_32(uint8_t(N->getZExtValue()));
146}], iobitpos8_XFORM>;
147
148def iobitposn8 : PatLeaf<(imm),
149[{
150  return isPowerOf2_32(uint8_t(~N->getZExtValue()));
151}], iobitposn8_XFORM>;
152
153def MemriAsmOperand : AsmOperandClass {
154  let Name = "Memri";
155  let ParserMethod = "parseMemriOperand";
156}
157
158/// Address operand for `reg+imm` used by STD and LDD.
159def memri : Operand<iPTR>
160{
161  let MIOperandInfo = (ops PTRDISPREGS, i16imm);
162
163  let PrintMethod = "printMemri";
164  let EncoderMethod = "encodeMemri";
165
166  let ParserMatchClass = MemriAsmOperand;
167}
168
169// Address operand for `SP+imm` used by STD{W}SPQRr
170def memspi : Operand<iPTR>
171{
172  let MIOperandInfo = (ops GPRSP, i16imm);
173}
174
175def relbrtarget_7 : Operand<OtherVT>
176{
177    let PrintMethod   = "printPCRelImm";
178    let EncoderMethod = "encodeRelCondBrTarget<AVR::fixup_7_pcrel>";
179}
180
181def brtarget_13 : Operand<OtherVT>
182{
183    let PrintMethod   = "printPCRelImm";
184    let EncoderMethod = "encodeRelCondBrTarget<AVR::fixup_13_pcrel>";
185}
186
187// The target of a 22 or 16-bit call/jmp instruction.
188def call_target : Operand<iPTR>
189{
190    let EncoderMethod = "encodeCallTarget";
191}
192
193// A 16-bit address (which can lead to an R_AVR_16 relocation).
194def imm16 : Operand<i16>
195{
196    let EncoderMethod = "encodeImm<AVR::fixup_16, 2>";
197}
198
199/// A 6-bit immediate used in the ADIW/SBIW instructions.
200def imm_arith6 : Operand<i16>
201{
202    let EncoderMethod = "encodeImm<AVR::fixup_6_adiw, 0>";
203}
204
205/// An 8-bit immediate inside an instruction with the same format
206/// as the `LDI` instruction (the `FRdK` format).
207def imm_ldi8 : Operand<i8>
208{
209    let EncoderMethod = "encodeImm<AVR::fixup_ldi, 0>";
210}
211
212/// A 5-bit port number used in SBIC and friends (the `FIOBIT` format).
213def imm_port5 : Operand<i8>
214{
215    let EncoderMethod = "encodeImm<AVR::fixup_port5, 0>";
216}
217
218/// A 6-bit port number used in the `IN` instruction and friends (the
219/// `FIORdA` format.
220def imm_port6 : Operand<i8>
221{
222    let EncoderMethod = "encodeImm<AVR::fixup_port6, 0>";
223}
224
225// Addressing mode pattern reg+imm6
226def addr : ComplexPattern<iPTR, 2, "SelectAddr", [], [SDNPWantRoot]>;
227
228// AsmOperand class for a pointer register.
229// Used with the LD/ST family of instructions.
230// See FSTLD in AVRInstrFormats.td
231def PtrRegAsmOperand : AsmOperandClass
232{
233   let Name = "Reg";
234}
235
236// A special operand type for the LD/ST instructions.
237// It converts the pointer register number into a two-bit field used in the
238// instruction.
239def LDSTPtrReg : Operand<i16>
240{
241    let MIOperandInfo = (ops PTRREGS);
242    let EncoderMethod = "encodeLDSTPtrReg";
243
244    let ParserMatchClass = PtrRegAsmOperand;
245}
246
247// A special operand type for the LDD/STD instructions.
248// It behaves identically to the LD/ST version, except restricts
249// the pointer registers to Y and Z.
250def LDDSTDPtrReg : Operand<i16>
251{
252    let MIOperandInfo = (ops PTRDISPREGS);
253    let EncoderMethod = "encodeLDSTPtrReg";
254
255    let ParserMatchClass = PtrRegAsmOperand;
256}
257
258//===----------------------------------------------------------------------===//
259// AVR predicates for subtarget features
260//===----------------------------------------------------------------------===//
261
262def HasSRAM       :    Predicate<"Subtarget->hasSRAM()">,
263                         AssemblerPredicate<"FeatureSRAM">;
264
265def HasJMPCALL    :    Predicate<"Subtarget->hasJMPCALL()">,
266                         AssemblerPredicate<"FeatureJMPCALL">;
267
268def HasIJMPCALL   :    Predicate<"Subtarget->hasIJMPCALL()">,
269                         AssemblerPredicate<"FeatureIJMPCALL">;
270
271def HasEIJMPCALL  :    Predicate<"Subtarget->hasEIJMPCALL()">,
272                         AssemblerPredicate<"FeatureEIJMPCALL">;
273
274def HasADDSUBIW   :    Predicate<"Subtarget->hasADDSUBIW()">,
275                         AssemblerPredicate<"FeatureADDSUBIW">;
276
277def HasSmallStack :    Predicate<"Subtarget->HasSmallStack()">,
278                         AssemblerPredicate<"FeatureSmallStack">;
279
280def HasMOVW       :    Predicate<"Subtarget->hasMOVW()">,
281                         AssemblerPredicate<"FeatureMOVW">;
282
283def HasLPM        :    Predicate<"Subtarget->hasLPM()">,
284                         AssemblerPredicate<"FeatureLPM">;
285
286def HasLPMX       :    Predicate<"Subtarget->hasLPMX()">,
287                         AssemblerPredicate<"FeatureLPMX">;
288
289def HasELPM       :    Predicate<"Subtarget->hasELPM()">,
290                         AssemblerPredicate<"FeatureELPM">;
291
292def HasELPMX      :    Predicate<"Subtarget->hasELPMX()">,
293                         AssemblerPredicate<"FeatureELPMX">;
294
295def HasSPM        :    Predicate<"Subtarget->hasSPM()">,
296                         AssemblerPredicate<"FeatureSPM">;
297
298def HasSPMX       :    Predicate<"Subtarget->hasSPMX()">,
299                         AssemblerPredicate<"FeatureSPMX">;
300
301def HasDES        :    Predicate<"Subtarget->hasDES()">,
302                         AssemblerPredicate<"FeatureDES">;
303
304def SupportsRMW   :    Predicate<"Subtarget->supportsRMW()">,
305                         AssemblerPredicate<"FeatureRMW">;
306
307def SupportsMultiplication : Predicate<"Subtarget->supportsMultiplication()">,
308                               AssemblerPredicate<"FeatureMultiplication">;
309
310def HasBREAK      :    Predicate<"Subtarget->hasBREAK()">,
311                         AssemblerPredicate<"FeatureBREAK">;
312
313def HasTinyEncoding : Predicate<"Subtarget->hasTinyEncoding()">,
314                        AssemblerPredicate<"FeatureTinyEncoding">;
315
316
317// AVR specific condition code. These correspond to AVR_*_COND in
318// AVRInstrInfo.td. They must be kept in synch.
319def AVR_COND_EQ : PatLeaf<(i8 0)>;
320def AVR_COND_NE : PatLeaf<(i8 1)>;
321def AVR_COND_GE : PatLeaf<(i8 2)>;
322def AVR_COND_LT : PatLeaf<(i8 3)>;
323def AVR_COND_SH : PatLeaf<(i8 4)>;
324def AVR_COND_LO : PatLeaf<(i8 5)>;
325def AVR_COND_MI : PatLeaf<(i8 6)>;
326def AVR_COND_PL : PatLeaf<(i8 7)>;
327
328
329//===----------------------------------------------------------------------===//
330//===----------------------------------------------------------------------===//
331// AVR Instruction list
332//===----------------------------------------------------------------------===//
333//===----------------------------------------------------------------------===//
334
335// ADJCALLSTACKDOWN/UP implicitly use/def SP because they may be expanded into
336// a stack adjustment and the codegen must know that they may modify the stack
337// pointer before prolog-epilog rewriting occurs.
338// Pessimistically assume ADJCALLSTACKDOWN / ADJCALLSTACKUP will become
339// sub / add which can clobber SREG.
340let Defs = [SP, SREG],
341Uses = [SP] in
342{
343  def ADJCALLSTACKDOWN : Pseudo<(outs),
344                                (ins i16imm:$amt, i16imm:$amt2),
345                                "#ADJCALLSTACKDOWN",
346                                [(AVRcallseq_start timm:$amt, timm:$amt2)]>;
347
348  // R31R30 is used to update SP, since it is a scratch reg and this instruction
349  // is placed after the function call then R31R30 should be always free.
350  //let Defs = [R31R30],
351  //Uses = [R31R30] in
352  //:TODO: if we enable this, the pseudo is killed because it looks dead
353  def ADJCALLSTACKUP : Pseudo<(outs),
354                              (ins i16imm:$amt1, i16imm:$amt2),
355                              "#ADJCALLSTACKUP",
356                              [(AVRcallseq_end timm:$amt1, timm:$amt2)]>;
357}
358
359//===----------------------------------------------------------------------===//
360// Addition
361//===----------------------------------------------------------------------===//
362let isCommutable = 1,
363Constraints = "$src = $rd",
364Defs = [SREG] in
365{
366  // ADD Rd, Rr
367  // Adds two 8-bit registers.
368  def ADDRdRr : FRdRr<0b0000,
369                      0b11,
370                      (outs GPR8:$rd),
371                      (ins GPR8:$src, GPR8:$rr),
372                      "add\t$rd, $rr",
373                      [(set i8:$rd, (add i8:$src, i8:$rr)),
374                       (implicit SREG)]>;
375
376  // ADDW Rd+1:Rd, Rr+1:Rr
377  // Pseudo instruction to add four 8-bit registers as two 16-bit values.
378  //
379  // Expands to:
380  // add Rd,    Rr
381  // adc Rd+1, Rr+1
382  def ADDWRdRr : Pseudo<(outs DREGS:$rd),
383                        (ins DREGS:$src, DREGS:$rr),
384                        "addw\t$rd, $rr",
385                        [(set i16:$rd, (add i16:$src, i16:$rr)),
386                         (implicit SREG)]>;
387
388  // ADC Rd, Rr
389  // Adds two 8-bit registers with carry.
390  let Uses = [SREG] in
391  def ADCRdRr : FRdRr<0b0001,
392                      0b11,
393                      (outs GPR8:$rd),
394                      (ins GPR8:$src, GPR8:$rr),
395                      "adc\t$rd, $rr",
396                      [(set i8:$rd, (adde i8:$src, i8:$rr)),
397                       (implicit SREG)]>;
398
399  // ADCW Rd+1:Rd, Rr+1:Rr
400  // Pseudo instruction to add four 8-bit registers as two 16-bit values with
401  // carry.
402  //
403  // Expands to:
404  // adc Rd,   Rr
405  // adc Rd+1, Rr+1
406  let Uses = [SREG] in
407  def ADCWRdRr : Pseudo<(outs DREGS:$rd),
408                        (ins DREGS:$src, DREGS:$rr),
409                        "adcw\t$rd, $rr",
410                        [(set i16:$rd, (adde i16:$src, i16:$rr)),
411                         (implicit SREG)]>;
412
413  // AIDW Rd, k
414  // Adds an immediate 6-bit value K to Rd, placing the result in Rd.
415  def ADIWRdK : FWRdK<0b0,
416                      (outs IWREGS:$rd),
417                      (ins IWREGS:$src, imm_arith6:$k),
418                      "adiw\t$rd, $k",
419                      [(set i16:$rd, (add i16:$src, uimm6:$k)),
420                       (implicit SREG)]>,
421                Requires<[HasADDSUBIW]>;
422}
423
424//===----------------------------------------------------------------------===//
425// Subtraction
426//===----------------------------------------------------------------------===//
427let Constraints = "$src = $rd",
428Defs = [SREG] in
429{
430  // SUB Rd, Rr
431  // Subtracts the 8-bit value of Rr from Rd and places the value in Rd.
432  def SUBRdRr : FRdRr<0b0001,
433                      0b10,
434                      (outs GPR8:$rd),
435                      (ins GPR8:$src, GPR8:$rr),
436                      "sub\t$rd, $rr",
437                      [(set i8:$rd, (sub i8:$src, i8:$rr)),
438                       (implicit SREG)]>;
439
440  // SUBW Rd+1:Rd, Rr+1:Rr
441  // Subtracts two 16-bit values and places the result into Rd.
442  //
443  // Expands to:
444  // sub Rd,   Rr
445  // sbc Rd+1, Rr+1
446  def SUBWRdRr : Pseudo<(outs DREGS:$rd),
447                        (ins DREGS:$src, DREGS:$rr),
448                        "subw\t$rd, $rr",
449                        [(set i16:$rd, (sub i16:$src, i16:$rr)),
450                         (implicit SREG)]>;
451
452  def SUBIRdK : FRdK<0b0101,
453                     (outs LD8:$rd),
454                     (ins LD8:$src, imm_ldi8:$k),
455                     "subi\t$rd, $k",
456                     [(set i8:$rd, (sub i8:$src, imm:$k)),
457                      (implicit SREG)]>;
458
459  // SUBIW Rd+1:Rd, K+1:K
460  //
461  // Expands to:
462  // subi Rd,   K
463  // sbci Rd+1, K+1
464  def SUBIWRdK : Pseudo<(outs DLDREGS:$rd),
465                        (ins DLDREGS:$src, i16imm:$rr),
466                        "subiw\t$rd, $rr",
467                        [(set i16:$rd, (sub i16:$src, imm:$rr)),
468                         (implicit SREG)]>;
469
470  def SBIWRdK : FWRdK<0b1,
471                      (outs IWREGS:$rd),
472                      (ins IWREGS:$src, imm_arith6:$k),
473                      "sbiw\t$rd, $k",
474                      [(set i16:$rd, (sub i16:$src, uimm6:$k)),
475                       (implicit SREG)]>,
476                Requires<[HasADDSUBIW]>;
477
478  // Subtract with carry operations which must read the carry flag in SREG.
479  let Uses = [SREG] in
480  {
481    def SBCRdRr : FRdRr<0b0000,
482                        0b10,
483                        (outs GPR8:$rd),
484                        (ins GPR8:$src, GPR8:$rr),
485                        "sbc\t$rd, $rr",
486                        [(set i8:$rd, (sube i8:$src, i8:$rr)),
487                         (implicit SREG)]>;
488
489    // SBCW Rd+1:Rd, Rr+1:Rr
490    //
491    // Expands to:
492    // sbc Rd,   Rr
493    // sbc Rd+1, Rr+1
494    def SBCWRdRr : Pseudo<(outs DREGS:$rd),
495                          (ins DREGS:$src, DREGS:$rr),
496                          "sbcw\t$rd, $rr",
497                          [(set i16:$rd, (sube i16:$src, i16:$rr)),
498                           (implicit SREG)]>;
499
500    def SBCIRdK : FRdK<0b0100,
501                       (outs LD8:$rd),
502                       (ins LD8:$src, imm_ldi8:$k),
503                       "sbci\t$rd, $k",
504                       [(set i8:$rd, (sube i8:$src, imm:$k)),
505                        (implicit SREG)]>;
506
507    // SBCIW Rd+1:Rd, K+1:K
508    // sbci Rd,   K
509    // sbci Rd+1, K+1
510    def SBCIWRdK : Pseudo<(outs DLDREGS:$rd),
511                          (ins DLDREGS:$src, i16imm:$rr),
512                          "sbciw\t$rd, $rr",
513                          [(set i16:$rd, (sube i16:$src, imm:$rr)),
514                           (implicit SREG)]>;
515  }
516}
517
518//===----------------------------------------------------------------------===//
519// Increment and Decrement
520//===----------------------------------------------------------------------===//
521let Constraints = "$src = $rd",
522Defs = [SREG] in
523{
524  def INCRd : FRd<0b1001,
525                  0b0100011,
526                  (outs GPR8:$rd),
527                  (ins GPR8:$src),
528                  "inc\t$rd",
529                  [(set i8:$rd, (add i8:$src, 1)), (implicit SREG)]>;
530
531  def DECRd : FRd<0b1001,
532                  0b0101010,
533                  (outs GPR8:$rd),
534                  (ins GPR8:$src),
535                  "dec\t$rd",
536                  [(set i8:$rd, (add i8:$src, -1)), (implicit SREG)]>;
537}
538
539//===----------------------------------------------------------------------===//
540// Multiplication
541//===----------------------------------------------------------------------===//
542
543let isCommutable = 1,
544Defs = [R1, R0, SREG] in
545{
546  // MUL Rd, Rr
547  // Multiplies Rd by Rr and places the result into R1:R0.
548  let usesCustomInserter = 1 in {
549    def MULRdRr : FRdRr<0b1001, 0b11,
550                        (outs),
551                        (ins GPR8:$lhs, GPR8:$rhs),
552                        "mul\t$lhs, $rhs",
553                        [/*(set R1, R0, (smullohi i8:$lhs, i8:$rhs))*/]>,
554                    Requires<[SupportsMultiplication]>;
555
556    def MULSRdRr : FMUL2RdRr<0,
557                             (outs),
558                             (ins GPR8:$lhs, GPR8:$rhs),
559                             "muls\t$lhs, $rhs",
560                             []>,
561                   Requires<[SupportsMultiplication]>;
562  }
563
564  def MULSURdRr : FMUL2RdRr<1,
565                            (outs),
566                            (ins GPR8:$lhs, GPR8:$rhs),
567                            "mulsu\t$lhs, $rhs",
568                            []>,
569                  Requires<[SupportsMultiplication]>;
570
571  def FMUL : FFMULRdRr<0b01,
572                       (outs),
573                       (ins GPR8:$lhs, GPR8:$rhs),
574                       "fmul\t$lhs, $rhs",
575                       []>,
576             Requires<[SupportsMultiplication]>;
577
578  def FMULS : FFMULRdRr<0b10,
579                        (outs),
580                        (ins GPR8:$lhs, GPR8:$rhs),
581                        "fmuls\t$lhs, $rhs",
582                        []>,
583              Requires<[SupportsMultiplication]>;
584
585  def FMULSU : FFMULRdRr<0b11,
586                         (outs),
587                         (ins GPR8:$lhs, GPR8:$rhs),
588                         "fmulsu\t$lhs, $rhs",
589                         []>,
590               Requires<[SupportsMultiplication]>;
591}
592
593let Defs = [R15, R14, R13, R12, R11, R10, R9,
594            R8, R7, R6, R5, R4, R3, R2, R1, R0] in
595def DESK : FDES<(outs),
596                (ins i8imm:$k),
597                "des\t$k",
598                []>,
599           Requires<[HasDES]>;
600
601//===----------------------------------------------------------------------===//
602// Logic
603//===----------------------------------------------------------------------===//
604let Constraints = "$src = $rd",
605Defs = [SREG] in
606{
607  // Register-Register logic instructions (which have the
608  // property of commutativity).
609  let isCommutable = 1 in
610  {
611    def ANDRdRr : FRdRr<0b0010,
612                        0b00,
613                        (outs GPR8:$rd),
614                        (ins GPR8:$src, GPR8:$rr),
615                        "and\t$rd, $rr",
616                        [(set i8:$rd, (and i8:$src, i8:$rr)),
617                         (implicit SREG)]>;
618
619    // ANDW Rd+1:Rd, Rr+1:Rr
620    //
621    // Expands to:
622    // and Rd,   Rr
623    // and Rd+1, Rr+1
624    def ANDWRdRr : Pseudo<(outs DREGS:$rd),
625                          (ins DREGS:$src, DREGS:$rr),
626                          "andw\t$rd, $rr",
627                          [(set i16:$rd, (and i16:$src, i16:$rr)),
628                           (implicit SREG)]>;
629
630    def ORRdRr : FRdRr<0b0010,
631                       0b10,
632                       (outs GPR8:$rd),
633                       (ins GPR8:$src, GPR8:$rr),
634                       "or\t$rd, $rr",
635                       [(set i8:$rd, (or i8:$src, i8:$rr)),
636                        (implicit SREG)]>;
637
638    // ORW Rd+1:Rd, Rr+1:Rr
639    //
640    // Expands to:
641    // or Rd,   Rr
642    // or Rd+1, Rr+1
643    def ORWRdRr : Pseudo<(outs DREGS:$rd),
644                         (ins DREGS:$src, DREGS:$rr),
645                         "orw\t$rd, $rr",
646                         [(set i16:$rd, (or i16:$src, i16:$rr)),
647                          (implicit SREG)]>;
648
649    def EORRdRr : FRdRr<0b0010,
650                        0b01,
651                        (outs GPR8:$rd),
652                        (ins GPR8:$src, GPR8:$rr),
653                        "eor\t$rd, $rr",
654                        [(set i8:$rd, (xor i8:$src, i8:$rr)),
655                         (implicit SREG)]>;
656
657    // EORW Rd+1:Rd, Rr+1:Rr
658    //
659    // Expands to:
660    // eor Rd,   Rr
661    // eor Rd+1, Rr+1
662    def EORWRdRr : Pseudo<(outs DREGS:$rd),
663                          (ins DREGS:$src, DREGS:$rr),
664                          "eorw\t$rd, $rr",
665                          [(set i16:$rd, (xor i16:$src, i16:$rr)),
666                           (implicit SREG)]>;
667  }
668
669  def ANDIRdK : FRdK<0b0111,
670                     (outs LD8:$rd),
671                     (ins LD8:$src, imm_ldi8:$k),
672                     "andi\t$rd, $k",
673                     [(set i8:$rd, (and i8:$src, imm:$k)),
674                      (implicit SREG)]>;
675
676  // ANDI Rd+1:Rd, K+1:K
677  //
678  // Expands to:
679  // andi Rd,   K
680  // andi Rd+1, K+1
681  def ANDIWRdK : Pseudo<(outs DLDREGS:$rd),
682                        (ins DLDREGS:$src, i16imm:$k),
683                        "andiw\t$rd, $k",
684                        [(set i16:$rd, (and i16:$src, imm:$k)),
685                         (implicit SREG)]>;
686
687  def ORIRdK : FRdK<0b0110,
688                    (outs LD8:$rd),
689                    (ins LD8:$src, imm_ldi8:$k),
690                    "ori\t$rd, $k",
691                    [(set i8:$rd, (or i8:$src, imm:$k)),
692                     (implicit SREG)]>;
693
694  // ORIW Rd+1:Rd, K+1,K
695  //
696  // Expands to:
697  // ori Rd,   K
698  // ori Rd+1, K+1
699  def ORIWRdK : Pseudo<(outs DLDREGS:$rd),
700                       (ins DLDREGS:$src, i16imm:$rr),
701                       "oriw\t$rd, $rr",
702                       [(set i16:$rd, (or i16:$src, imm:$rr)),
703                        (implicit SREG)]>;
704}
705
706//===----------------------------------------------------------------------===//
707// One's/Two's Complement
708//===----------------------------------------------------------------------===//
709let Constraints = "$src = $rd",
710Defs = [SREG] in
711{
712  def COMRd : FRd<0b1001,
713                  0b0100000,
714                  (outs GPR8:$rd),
715                  (ins GPR8:$src),
716                  "com\t$rd",
717                  [(set i8:$rd, (not i8:$src)), (implicit SREG)]>;
718
719  // COMW Rd+1:Rd
720  //
721  // Expands to:
722  // com Rd
723  // com Rd+1
724  def COMWRd : Pseudo<(outs DREGS:$rd),
725                      (ins DREGS:$src),
726                      "comw\t$rd",
727                      [(set i16:$rd, (not i16:$src)), (implicit SREG)]>;
728
729  //:TODO: optimize NEG for wider types
730  def NEGRd : FRd<0b1001,
731                  0b0100001,
732                  (outs GPR8:$rd),
733                  (ins GPR8:$src),
734                  "neg\t$rd",
735                  [(set i8:$rd, (ineg i8:$src)), (implicit SREG)]>;
736}
737
738// TST Rd
739// Test for zero of minus.
740// This operation is identical to a `Rd AND Rd`.
741def : InstAlias<"tst\t$rd", (ANDRdRr GPR8:$rd, GPR8:$rd)>;
742
743// SBR Rd, K
744//
745// Mnemonic alias to 'ORI Rd, K'. Same bit pattern, same operands,
746// same everything.
747def : InstAlias<"sbr\t$rd, $k",
748                (ORIRdK LD8:$rd, imm_ldi8:$k),
749                /* Disable display, so we don't override ORI */ 0>;
750
751//===----------------------------------------------------------------------===//
752// Jump instructions
753//===----------------------------------------------------------------------===//
754let isBarrier = 1,
755isBranch = 1,
756isTerminator = 1 in
757{
758  def RJMPk : FBRk<0,
759                   (outs),
760                   (ins brtarget_13:$target),
761                   "rjmp\t$target",
762                   [(br bb:$target)]>;
763
764  let isIndirectBranch = 1,
765  Uses = [R31R30] in
766  def IJMP : F16<0b1001010000001001,
767                 (outs),
768                 (ins),
769                 "ijmp",
770                 []>,
771             Requires<[HasIJMPCALL]>;
772
773  let isIndirectBranch = 1,
774  Uses = [R31R30] in
775  def EIJMP : F16<0b1001010000011001,
776                  (outs),
777                  (ins),
778                  "eijmp",
779                  []>,
780              Requires<[HasEIJMPCALL]>;
781
782  def JMPk : F32BRk<0b110,
783                    (outs),
784                    (ins call_target:$k),
785                    "jmp\t$k",
786                    []>,
787             Requires<[HasJMPCALL]>;
788}
789
790//===----------------------------------------------------------------------===//
791// Call instructions
792//===----------------------------------------------------------------------===//
793let isCall = 1 in
794{
795  // SP is marked as a use to prevent stack-pointer assignments that appear
796  // immediately before calls from potentially appearing dead.
797  let Uses = [SP] in
798  def RCALLk : FBRk<1,
799                    (outs),
800                    (ins brtarget_13:$target),
801                    "rcall\t$target",
802                    []>;
803
804  // SP is marked as a use to prevent stack-pointer assignments that appear
805  // immediately before calls from potentially appearing dead.
806  let Uses = [SP, R31R30] in
807  def ICALL : F16<0b1001010100001001,
808                  (outs),
809                  (ins variable_ops),
810                  "icall",
811                  []>,
812              Requires<[HasIJMPCALL]>;
813
814  // SP is marked as a use to prevent stack-pointer assignments that appear
815  // immediately before calls from potentially appearing dead.
816  let Uses = [SP, R31R30] in
817  def EICALL : F16<0b1001010100011001,
818                   (outs),
819                   (ins variable_ops),
820                   "eicall",
821                   []>,
822               Requires<[HasEIJMPCALL]>;
823
824  // SP is marked as a use to prevent stack-pointer assignments that appear
825  // immediately before calls from potentially appearing dead.
826  //
827  //:TODO: the imm field can be either 16 or 22 bits in devices with more
828  // than 64k of ROM, fix it once we support the largest devices.
829  let Uses = [SP] in
830  def CALLk : F32BRk<0b111,
831                     (outs),
832                     (ins call_target:$k),
833                     "call\t$k",
834                     [(AVRcall imm:$k)]>,
835              Requires<[HasJMPCALL]>;
836}
837
838//===----------------------------------------------------------------------===//
839// Return instructions.
840//===----------------------------------------------------------------------===//
841let isTerminator = 1,
842isReturn = 1,
843isBarrier = 1 in
844{
845  def RET : F16<0b1001010100001000,
846                (outs),
847                (ins),
848                "ret",
849                [(AVRretflag)]>;
850
851  def RETI : F16<0b1001010100011000,
852                 (outs),
853                 (ins),
854                 "reti",
855                 [(AVRretiflag)]>;
856}
857
858//===----------------------------------------------------------------------===//
859// Compare operations.
860//===----------------------------------------------------------------------===//
861let Defs = [SREG] in
862{
863  // CPSE Rd, Rr
864  // Compare Rd and Rr, skipping the next instruction if they are equal.
865  let isBarrier = 1,
866  isBranch = 1,
867  isTerminator = 1 in
868  def CPSE : FRdRr<0b0001,
869                   0b00,
870                   (outs),
871                   (ins GPR8:$rd, GPR8:$rr),
872                   "cpse\t$rd, $rr",
873                   []>;
874
875  def CPRdRr : FRdRr<0b0001,
876                     0b01,
877                     (outs),
878                     (ins GPR8:$rd, GPR8:$rr),
879                     "cp\t$rd, $rr",
880                     [(AVRcmp i8:$rd, i8:$rr), (implicit SREG)]>;
881
882  // CPW Rd+1:Rd, Rr+1:Rr
883  //
884  // Expands to:
885  // cp  Rd,   Rr
886  // cpc Rd+1, Rr+1
887  def CPWRdRr : Pseudo<(outs),
888                       (ins DREGS:$src, DREGS:$src2),
889                       "cpw\t$src, $src2",
890                       [(AVRcmp i16:$src, i16:$src2), (implicit SREG)]>;
891
892  let Uses = [SREG] in
893  def CPCRdRr : FRdRr<0b0000,
894                      0b01,
895                      (outs),
896                      (ins GPR8:$rd, GPR8:$rr),
897                      "cpc\t$rd, $rr",
898                      [(AVRcmpc i8:$rd, i8:$rr), (implicit SREG)]>;
899
900  // CPCW Rd+1:Rd. Rr+1:Rr
901  //
902  // Expands to:
903  // cpc Rd,   Rr
904  // cpc Rd+1, Rr+1
905  let Uses = [SREG] in
906  def CPCWRdRr : Pseudo<(outs),
907                        (ins DREGS:$src, DREGS:$src2),
908                        "cpcw\t$src, $src2",
909                        [(AVRcmpc i16:$src, i16:$src2), (implicit SREG)]>;
910
911  // CPI Rd, K
912  // Compares a register with an 8 bit immediate.
913  def CPIRdK : FRdK<0b0011,
914                    (outs),
915                    (ins LD8:$rd, imm_ldi8:$k),
916                    "cpi\t$rd, $k",
917                    [(AVRcmp i8:$rd, imm:$k), (implicit SREG)]>;
918}
919
920//===----------------------------------------------------------------------===//
921// Register conditional skipping/branching operations.
922//===----------------------------------------------------------------------===//
923let isBranch = 1,
924isTerminator = 1 in
925{
926  // Conditional skipping on GPR register bits, and
927  // conditional skipping on IO register bits.
928  let isBarrier = 1 in
929  {
930    def SBRCRrB : FRdB<0b10,
931                       (outs),
932                       (ins GPR8:$rr, i8imm:$b),
933                       "sbrc\t$rr, $b",
934                       []>;
935
936    def SBRSRrB : FRdB<0b11,
937                       (outs),
938                       (ins GPR8:$rr, i8imm:$b),
939                       "sbrs\t$rr, $b",
940                       []>;
941
942    def SBICAb : FIOBIT<0b01,
943                        (outs),
944                        (ins imm_port5:$a, i8imm:$b),
945                        "sbic\t$a, $b",
946                        []>;
947
948    def SBISAb : FIOBIT<0b11,
949                        (outs),
950                        (ins imm_port5:$a, i8imm:$b),
951                        "sbis\t$a, $b",
952                        []>;
953  }
954
955  // Relative branches on status flag bits.
956  let Uses = [SREG] in
957  {
958    // BRBS s, k
959    // Branch if `s` flag in status register is set.
960    def BRBSsk : FSK<0,
961                     (outs),
962                     (ins i8imm:$s, relbrtarget_7:$k),
963                     "brbs\t$s, $k",
964                     []>;
965
966    // BRBC s, k
967    // Branch if `s` flag in status register is clear.
968    def BRBCsk : FSK<1,
969                     (outs),
970                     (ins i8imm:$s, relbrtarget_7:$k),
971                     "brbc\t$s, $k",
972                     []>;
973  }
974}
975
976
977// BRCS k
978// Branch if carry flag is set
979def : InstAlias<"brcs\t$k", (BRBSsk 0, relbrtarget_7:$k)>;
980
981// BRCC k
982// Branch if carry flag is clear
983def : InstAlias<"brcc\t$k", (BRBCsk 0, relbrtarget_7:$k)>;
984
985// BRHS k
986// Branch if half carry flag is set
987def : InstAlias<"brhs\t$k", (BRBSsk 5, relbrtarget_7:$k)>;
988
989// BRHC k
990// Branch if half carry flag is clear
991def : InstAlias<"brhc\t$k", (BRBCsk 5, relbrtarget_7:$k)>;
992
993// BRTS k
994// Branch if the T flag is set
995def : InstAlias<"brts\t$k", (BRBSsk 6, relbrtarget_7:$k)>;
996
997// BRTC k
998// Branch if the T flag is clear
999def : InstAlias<"brtc\t$k", (BRBCsk 6, relbrtarget_7:$k)>;
1000
1001// BRVS k
1002// Branch if the overflow flag is set
1003def : InstAlias<"brvs\t$k", (BRBSsk 3, relbrtarget_7:$k)>;
1004
1005// BRVC k
1006// Branch if the overflow flag is clear
1007def : InstAlias<"brvc\t$k", (BRBCsk 3, relbrtarget_7:$k)>;
1008
1009// BRIE k
1010// Branch if the global interrupt flag is enabled
1011def : InstAlias<"brie\t$k", (BRBSsk 7, relbrtarget_7:$k)>;
1012
1013// BRID k
1014// Branch if the global interrupt flag is disabled
1015def : InstAlias<"brid\t$k", (BRBCsk 7, relbrtarget_7:$k)>;
1016
1017//===----------------------------------------------------------------------===//
1018// PC-relative conditional branches
1019//===----------------------------------------------------------------------===//
1020// Based on status register. We cannot simplify these into instruction aliases
1021// because we also need to be able to specify a pattern to match for ISel.
1022let isBranch = 1,
1023isTerminator = 1,
1024Uses = [SREG] in
1025{
1026  def BREQk : FBRsk<0,
1027                    0b001,
1028                    (outs),
1029                    (ins relbrtarget_7:$target),
1030                    "breq\t$target",
1031                    [(AVRbrcond bb:$target, AVR_COND_EQ)]>;
1032
1033  def BRNEk : FBRsk<1,
1034                    0b001,
1035                    (outs),
1036                    (ins relbrtarget_7:$target),
1037                    "brne\t$target",
1038                    [(AVRbrcond bb:$target, AVR_COND_NE)]>;
1039
1040
1041  def BRSHk : FBRsk<1,
1042                    0b000,
1043                    (outs),
1044                    (ins relbrtarget_7:$target),
1045                    "brsh\t$target",
1046                    [(AVRbrcond bb:$target, AVR_COND_SH)]>;
1047
1048  def BRLOk : FBRsk<0,
1049                    0b000,
1050                    (outs),
1051                    (ins relbrtarget_7:$target),
1052                    "brlo\t$target",
1053                    [(AVRbrcond bb:$target, AVR_COND_LO)]>;
1054
1055  def BRMIk : FBRsk<0,
1056                    0b010,
1057                    (outs),
1058                    (ins relbrtarget_7:$target),
1059                    "brmi\t$target",
1060                    [(AVRbrcond bb:$target, AVR_COND_MI)]>;
1061
1062  def BRPLk : FBRsk<1,
1063                    0b010,
1064                    (outs),
1065                    (ins relbrtarget_7:$target),
1066                    "brpl\t$target",
1067                    [(AVRbrcond bb:$target, AVR_COND_PL)]>;
1068
1069  def BRGEk : FBRsk<1,
1070                    0b100,
1071                    (outs),
1072                    (ins relbrtarget_7:$target),
1073                    "brge\t$target",
1074                    [(AVRbrcond bb:$target, AVR_COND_GE)]>;
1075
1076  def BRLTk : FBRsk<0,
1077                    0b100,
1078                    (outs),
1079                    (ins relbrtarget_7:$target),
1080                    "brlt\t$target",
1081                    [(AVRbrcond bb:$target, AVR_COND_LT)]>;
1082}
1083
1084//===----------------------------------------------------------------------===//
1085// Data transfer instructions
1086//===----------------------------------------------------------------------===//
1087// 8 and 16-bit register move instructions.
1088let hasSideEffects = 0 in
1089{
1090  def MOVRdRr : FRdRr<0b0010,
1091                      0b11,
1092                      (outs GPR8:$rd),
1093                      (ins GPR8:$rr),
1094                      "mov\t$rd, $rr",
1095                      []>;
1096
1097  def MOVWRdRr : FMOVWRdRr<(outs DREGS:$dst),
1098                           (ins DREGS:$src),
1099                           "movw\t$dst, $src",
1100                           []>,
1101                 Requires<[HasMOVW]>;
1102}
1103
1104// Load immediate values into registers.
1105let isReMaterializable = 1 in
1106{
1107  def LDIRdK : FRdK<0b1110,
1108                    (outs LD8:$rd),
1109                    (ins imm_ldi8:$k),
1110                    "ldi\t$rd, $k",
1111                    [(set i8:$rd, imm:$k)]>;
1112
1113  // LDIW Rd+1:Rd, K+1:K
1114  //
1115  // Expands to:
1116  // ldi Rd,   K
1117  // ldi Rd+1, K+1
1118  def LDIWRdK : Pseudo<(outs DLDREGS:$dst),
1119                       (ins i16imm:$src),
1120                       "ldiw\t$dst, $src",
1121                       [(set i16:$dst, imm:$src)]>;
1122}
1123
1124// Load from data space into register.
1125let canFoldAsLoad = 1,
1126isReMaterializable = 1 in
1127{
1128  def LDSRdK : F32DM<0b0,
1129                     (outs GPR8:$rd),
1130                     (ins imm16:$k),
1131                     "lds\t$rd, $k",
1132                     [(set i8:$rd, (load imm:$k))]>,
1133               Requires<[HasSRAM]>;
1134
1135  // LDSW Rd+1:Rd, K+1:K
1136  //
1137  // Expands to:
1138  // lds Rd,  (K+1:K)
1139  // lds Rd+1 (K+1:K) + 1
1140  def LDSWRdK : Pseudo<(outs DREGS:$dst),
1141                       (ins i16imm:$src),
1142                       "ldsw\t$dst, $src",
1143                       [(set i16:$dst, (load imm:$src))]>,
1144                Requires<[HasSRAM]>;
1145}
1146
1147// Indirect loads.
1148let canFoldAsLoad = 1,
1149isReMaterializable = 1 in
1150{
1151  def LDRdPtr : FSTLD<0,
1152                      0b00,
1153                      (outs GPR8:$reg),
1154                      (ins LDSTPtrReg:$ptrreg),
1155                      "ld\t$reg, $ptrreg",
1156                      [(set GPR8:$reg, (load i16:$ptrreg))]>,
1157                Requires<[HasSRAM]>;
1158
1159  // LDW Rd+1:Rd, P
1160  //
1161  // Expands to:
1162  // ld  Rd,   P
1163  // ldd Rd+1, P+1
1164  let Constraints = "@earlyclobber $reg" in
1165  def LDWRdPtr : Pseudo<(outs DREGS:$reg),
1166                        (ins PTRDISPREGS:$ptrreg),
1167                        "ldw\t$reg, $ptrreg",
1168                        [(set i16:$reg, (load i16:$ptrreg))]>,
1169                 Requires<[HasSRAM]>;
1170}
1171
1172// Indirect loads (with postincrement or predecrement).
1173let mayLoad = 1,
1174hasSideEffects = 0,
1175Constraints = "$ptrreg = $base_wb,@earlyclobber $reg" in
1176{
1177  def LDRdPtrPi : FSTLD<0,
1178                        0b01,
1179                        (outs GPR8:$reg, PTRREGS:$base_wb),
1180                        (ins LDSTPtrReg:$ptrreg),
1181                        "ld\t$reg, $ptrreg+",
1182                        []>,
1183                  Requires<[HasSRAM]>;
1184
1185  // LDW Rd+1:Rd, P+
1186  // Expands to:
1187  // ld Rd,   P+
1188  // ld Rd+1, P+
1189  def LDWRdPtrPi : Pseudo<(outs DREGS:$reg, PTRREGS:$base_wb),
1190                          (ins PTRREGS:$ptrreg),
1191                          "ldw\t$reg, $ptrreg+",
1192                          []>,
1193                   Requires<[HasSRAM]>;
1194
1195  def LDRdPtrPd : FSTLD<0,
1196                        0b10,
1197                        (outs GPR8:$reg, PTRREGS:$base_wb),
1198                        (ins LDSTPtrReg:$ptrreg),
1199                        "ld\t$reg, -$ptrreg",
1200                        []>,
1201                  Requires<[HasSRAM]>;
1202
1203  // LDW Rd+1:Rd, -P
1204  //
1205  // Expands to:
1206  // ld Rd+1, -P
1207  // ld Rd,   -P
1208  def LDWRdPtrPd : Pseudo<(outs DREGS:$reg, PTRREGS:$base_wb),
1209                          (ins PTRREGS:$ptrreg),
1210                          "ldw\t$reg, -$ptrreg",
1211                          []>,
1212                   Requires<[HasSRAM]>;
1213}
1214
1215// Load indirect with displacement operations.
1216let canFoldAsLoad = 1,
1217isReMaterializable = 1 in
1218{
1219  let Constraints = "@earlyclobber $reg" in
1220  def LDDRdPtrQ : FSTDLDD<0,
1221                          (outs GPR8:$reg),
1222                          (ins memri:$memri),
1223                          "ldd\t$reg, $memri",
1224                          [(set i8:$reg, (load addr:$memri))]>,
1225                  Requires<[HasSRAM]>;
1226
1227  // LDDW Rd+1:Rd, P+q
1228  //
1229  // Expands to:
1230  // ldd Rd,   P+q
1231  // ldd Rd+1, P+q+1
1232  let Constraints = "@earlyclobber $dst" in
1233  def LDDWRdPtrQ : Pseudo<(outs DREGS_WITHOUT_YZ_WORKAROUND:$dst),
1234                          (ins memri:$memri),
1235                          "lddw\t$dst, $memri",
1236                          [(set i16:$dst, (load addr:$memri))]>,
1237                   Requires<[HasSRAM]>;
1238
1239  // An identical pseudo instruction to LDDWRdPtrQ, expect restricted to the Y
1240  // register and without the @earlyclobber flag.
1241  //
1242  // Used to work around a bug caused by the register allocator not
1243  // being able to handle the expansion of a COPY into an machine instruction
1244  // that has an earlyclobber flag. This is because the register allocator will
1245  // try expand a copy from a register slot into an earlyclobber instruction.
1246  // Instructions that are earlyclobber need to be in a dedicated earlyclobber slot.
1247  //
1248  // This pseudo instruction can be used pre-AVR pseudo expansion in order to
1249  // get a frame index load without directly using earlyclobber instructions.
1250  //
1251  // The pseudo expansion pass trivially expands this into LDDWRdPtrQ.
1252  //
1253  // This instruction may be removed once PR13375 is fixed.
1254  let mayLoad = 1,
1255  hasSideEffects = 0 in
1256  def LDDWRdYQ : Pseudo<(outs DREGS:$dst),
1257                        (ins memri:$memri),
1258                        "lddw\t$dst, $memri",
1259                        []>,
1260                 Requires<[HasSRAM]>;
1261}
1262
1263class AtomicLoad<PatFrag Op, RegisterClass DRC,
1264                 RegisterClass PTRRC> :
1265  Pseudo<(outs DRC:$rd), (ins PTRRC:$rr), "atomic_op",
1266         [(set DRC:$rd, (Op i16:$rr))]>;
1267
1268class AtomicStore<PatFrag Op, RegisterClass DRC,
1269                  RegisterClass PTRRC> :
1270  Pseudo<(outs), (ins PTRRC:$rd, DRC:$rr), "atomic_op",
1271         [(Op i16:$rd, DRC:$rr)]>;
1272
1273class AtomicLoadOp<PatFrag Op, RegisterClass DRC,
1274                   RegisterClass PTRRC> :
1275  Pseudo<(outs DRC:$rd), (ins PTRRC:$rr, DRC:$operand),
1276         "atomic_op",
1277         [(set DRC:$rd, (Op i16:$rr, DRC:$operand))]>;
1278
1279// FIXME: I think 16-bit atomic binary ops need to mark
1280// r0 as clobbered.
1281
1282// Atomic instructions
1283// ===================
1284//
1285// These are all expanded by AVRExpandPseudoInsts
1286//
1287// 8-bit operations can use any pointer register because
1288// they are expanded directly into an LD/ST instruction.
1289//
1290// 16-bit operations use 16-bit load/store postincrement instructions,
1291// which require PTRDISPREGS.
1292
1293def AtomicLoad8   : AtomicLoad<atomic_load_8, GPR8, PTRREGS>;
1294def AtomicLoad16  : AtomicLoad<atomic_load_16, DREGS, PTRDISPREGS>;
1295
1296def AtomicStore8  : AtomicStore<atomic_store_8, GPR8, PTRREGS>;
1297def AtomicStore16 : AtomicStore<atomic_store_16, DREGS, PTRDISPREGS>;
1298
1299class AtomicLoadOp8<PatFrag Op> : AtomicLoadOp<Op, GPR8, PTRREGS>;
1300class AtomicLoadOp16<PatFrag Op> : AtomicLoadOp<Op, DREGS, PTRDISPREGS>;
1301
1302def AtomicLoadAdd8  : AtomicLoadOp8<atomic_load_add_8>;
1303def AtomicLoadAdd16 : AtomicLoadOp16<atomic_load_add_16>;
1304def AtomicLoadSub8  : AtomicLoadOp8<atomic_load_sub_8>;
1305def AtomicLoadSub16 : AtomicLoadOp16<atomic_load_sub_16>;
1306def AtomicLoadAnd8  : AtomicLoadOp8<atomic_load_and_8>;
1307def AtomicLoadAnd16 : AtomicLoadOp16<atomic_load_and_16>;
1308def AtomicLoadOr8   : AtomicLoadOp8<atomic_load_or_8>;
1309def AtomicLoadOr16  : AtomicLoadOp16<atomic_load_or_16>;
1310def AtomicLoadXor8  : AtomicLoadOp8<atomic_load_xor_8>;
1311def AtomicLoadXor16 : AtomicLoadOp16<atomic_load_xor_16>;
1312def AtomicFence     : Pseudo<(outs), (ins), "atomic_fence",
1313                             [(atomic_fence imm, imm)]>;
1314
1315// Indirect store from register to data space.
1316def STSKRr : F32DM<0b1,
1317                   (outs),
1318                   (ins imm16:$k, GPR8:$rd),
1319                   "sts\t$k, $rd",
1320                   [(store i8:$rd, imm:$k)]>,
1321             Requires<[HasSRAM]>;
1322
1323// STSW K+1:K, Rr+1:Rr
1324//
1325// Expands to:
1326// sts Rr+1, (K+1:K) + 1
1327// sts Rr,   (K+1:K)
1328def STSWKRr : Pseudo<(outs),
1329                     (ins i16imm:$dst, DREGS:$src),
1330                     "stsw\t$dst, $src",
1331                     [(store i16:$src, imm:$dst)]>,
1332              Requires<[HasSRAM]>;
1333
1334// Indirect stores.
1335// ST P, Rr
1336// Stores the value of Rr into the location addressed by pointer P.
1337def STPtrRr : FSTLD<1,
1338                    0b00,
1339                    (outs),
1340                    (ins LDSTPtrReg:$ptrreg, GPR8:$reg),
1341                    "st\t$ptrreg, $reg",
1342                    [(store GPR8:$reg, i16:$ptrreg)]>,
1343              Requires<[HasSRAM]>;
1344
1345// STW P, Rr+1:Rr
1346// Stores the value of Rr into the location addressed by pointer P.
1347//
1348// Expands to:
1349// st P, Rr
1350// std P+1, Rr+1
1351def STWPtrRr : Pseudo<(outs),
1352                      (ins PTRDISPREGS:$ptrreg, DREGS:$reg),
1353                      "stw\t$ptrreg, $reg",
1354                      [(store i16:$reg, i16:$ptrreg)]>,
1355               Requires<[HasSRAM]>;
1356
1357// Indirect stores (with postincrement or predecrement).
1358let Constraints = "$ptrreg = $base_wb,@earlyclobber $base_wb" in
1359{
1360
1361  // ST P+, Rr
1362  // Stores the value of Rr into the location addressed by pointer P.
1363  // Post increments P.
1364  def STPtrPiRr : FSTLD<1,
1365                        0b01,
1366                        (outs LDSTPtrReg:$base_wb),
1367                        (ins LDSTPtrReg:$ptrreg, GPR8:$reg, i8imm:$offs),
1368                        "st\t$ptrreg+, $reg",
1369                        [(set i16:$base_wb,
1370                         (post_store GPR8:$reg, i16:$ptrreg, imm:$offs))]>,
1371                  Requires<[HasSRAM]>;
1372
1373  // STW P+, Rr+1:Rr
1374  // Stores the value of Rr into the location addressed by pointer P.
1375  // Post increments P.
1376  //
1377  // Expands to:
1378  // st P+, Rr
1379  // st P+, Rr+1
1380  def STWPtrPiRr : Pseudo<(outs PTRREGS:$base_wb),
1381                          (ins PTRREGS:$ptrreg, DREGS:$trh, i8imm:$offs),
1382                          "stw\t$ptrreg+, $trh",
1383                          [(set PTRREGS:$base_wb,
1384                           (post_store DREGS:$trh, PTRREGS:$ptrreg, imm:$offs))]>,
1385                   Requires<[HasSRAM]>;
1386
1387  // ST -P, Rr
1388  // Stores the value of Rr into the location addressed by pointer P.
1389  // Pre decrements P.
1390  def STPtrPdRr : FSTLD<1,
1391                        0b10,
1392                        (outs LDSTPtrReg:$base_wb),
1393                        (ins LDSTPtrReg:$ptrreg, GPR8:$reg, i8imm:$offs),
1394                        "st\t-$ptrreg, $reg",
1395                        [(set i16:$base_wb,
1396                         (pre_store GPR8:$reg, i16:$ptrreg, imm:$offs))]>,
1397                  Requires<[HasSRAM]>;
1398
1399  // STW -P, Rr+1:Rr
1400  // Stores the value of Rr into the location addressed by pointer P.
1401  // Pre decrements P.
1402  //
1403  // Expands to:
1404  // st -P, Rr+1
1405  // st -P, Rr
1406  def STWPtrPdRr : Pseudo<(outs PTRREGS:$base_wb),
1407                          (ins PTRREGS:$ptrreg, DREGS:$reg, i8imm:$offs),
1408                          "stw\t-$ptrreg, $reg",
1409                          [(set PTRREGS:$base_wb,
1410                           (pre_store i16:$reg, i16:$ptrreg, imm:$offs))]>,
1411                   Requires<[HasSRAM]>;
1412}
1413
1414// Store indirect with displacement operations.
1415// STD P+q, Rr
1416// Stores the value of Rr into the location addressed by pointer P with a
1417// displacement of q. Does not modify P.
1418def STDPtrQRr : FSTDLDD<1,
1419                        (outs),
1420                        (ins memri:$memri, GPR8:$reg),
1421                        "std\t$memri, $reg",
1422                        [(store i8:$reg, addr:$memri)]>,
1423                Requires<[HasSRAM]>;
1424
1425// STDW P+q, Rr+1:Rr
1426// Stores the value of Rr into the location addressed by pointer P with a
1427// displacement of q. Does not modify P.
1428//
1429// Expands to:
1430// std P+q,   Rr
1431// std P+q+1, Rr+1
1432def STDWPtrQRr : Pseudo<(outs),
1433                        (ins memri:$memri, DREGS:$src),
1434                        "stdw\t$memri, $src",
1435                        [(store i16:$src, addr:$memri)]>,
1436                 Requires<[HasSRAM]>;
1437
1438
1439// Load program memory operations.
1440let canFoldAsLoad = 1,
1441isReMaterializable = 1,
1442mayLoad = 1,
1443hasSideEffects = 0 in
1444{
1445  let Defs = [R0],
1446      Uses = [R31R30] in
1447  def LPM : F16<0b1001010111001000,
1448                (outs),
1449                (ins),
1450                "lpm",
1451                []>,
1452            Requires<[HasLPM]>;
1453
1454  def LPMRdZ : FLPMX<0,
1455                     0,
1456                     (outs GPR8:$dst),
1457                     (ins ZREG:$z),
1458                     "lpm\t$dst, $z",
1459                     []>,
1460               Requires<[HasLPMX]>;
1461
1462  // Load program memory, while postincrementing the Z register.
1463  let Defs = [R31R30] in
1464  {
1465    def LPMRdZPi : FLPMX<0,
1466                         1,
1467                         (outs GPR8:$dst),
1468                         (ins ZREG:$z),
1469                         "lpm\t$dst, $z+",
1470                         []>,
1471                   Requires<[HasLPMX]>;
1472
1473    def LPMWRdZ : Pseudo<(outs DREGS:$dst),
1474                         (ins ZREG:$z),
1475                         "lpmw\t$dst, $z",
1476                         []>,
1477                  Requires<[HasLPMX]>;
1478
1479    def LPMWRdZPi : Pseudo<(outs DREGS:$dst),
1480                           (ins ZREG:$z),
1481                           "lpmw\t$dst, $z+",
1482                           []>,
1483                    Requires<[HasLPMX]>;
1484  }
1485}
1486
1487// Extended load program memory operations.
1488let mayLoad = 1,
1489hasSideEffects = 0 in
1490{
1491  let Defs = [R0],
1492      Uses = [R31R30] in
1493  def ELPM : F16<0b1001010111011000,
1494                 (outs),
1495                 (ins),
1496                 "elpm",
1497                 []>,
1498             Requires<[HasELPM]>;
1499
1500  def ELPMRdZ : FLPMX<1,
1501                      0,
1502                      (outs GPR8:$dst),
1503                      (ins ZREG:$z),
1504                      "elpm\t$dst, $z",
1505                      []>,
1506                Requires<[HasELPMX]>;
1507
1508  let Defs = [R31R30] in
1509  def ELPMRdZPi : FLPMX<1,
1510                        1,
1511                        (outs GPR8:$dst),
1512                        (ins ZREG: $z),
1513                        "elpm\t$dst, $z+",
1514                        []>,
1515                  Requires<[HasELPMX]>;
1516}
1517
1518// Store program memory operations.
1519let Uses = [R1, R0] in
1520{
1521  let Uses = [R31R30, R1, R0] in
1522  def SPM : F16<0b1001010111101000,
1523                (outs),
1524                (ins),
1525                "spm",
1526                []>,
1527            Requires<[HasSPM]>;
1528
1529  let Defs = [R31R30] in
1530  def SPMZPi : F16<0b1001010111111000,
1531                   (outs),
1532                   (ins ZREG:$z),
1533                   "spm $z+",
1534                   []>,
1535               Requires<[HasSPMX]>;
1536}
1537
1538// Read data from IO location operations.
1539let canFoldAsLoad = 1,
1540isReMaterializable = 1 in
1541{
1542  def INRdA : FIORdA<(outs GPR8:$dst),
1543                     (ins imm_port6:$src),
1544                     "in\t$dst, $src",
1545                     [(set i8:$dst, (load ioaddr8:$src))]>;
1546
1547  def INWRdA : Pseudo<(outs DREGS:$dst),
1548                      (ins imm_port6:$src),
1549                      "inw\t$dst, $src",
1550                      [(set i16:$dst, (load ioaddr16:$src))]>;
1551}
1552
1553// Write data to IO location operations.
1554def OUTARr : FIOARr<(outs),
1555                    (ins imm_port6:$dst, GPR8:$src),
1556                    "out\t$dst, $src",
1557                    [(store i8:$src, ioaddr8:$dst)]>;
1558
1559def OUTWARr : Pseudo<(outs),
1560                     (ins imm_port6:$dst, DREGS:$src),
1561                     "outw\t$dst, $src",
1562                     [(store i16:$src, ioaddr16:$dst)]>;
1563
1564// Stack push/pop operations.
1565let Defs = [SP],
1566Uses = [SP],
1567hasSideEffects = 0 in
1568{
1569  // Stack push operations.
1570  let mayStore = 1 in
1571  {
1572    def PUSHRr : FRd<0b1001,
1573                     0b0011111,
1574                     (outs),
1575                     (ins GPR8:$reg),
1576                     "push\t$reg",
1577                     []>,
1578                 Requires<[HasSRAM]>;
1579
1580    def PUSHWRr : Pseudo<(outs),
1581                         (ins DREGS:$reg),
1582                         "pushw\t$reg",
1583                         []>,
1584                  Requires<[HasSRAM]>;
1585  }
1586
1587  // Stack pop operations.
1588  let mayLoad = 1 in
1589  {
1590    def POPRd : FRd<0b1001,
1591                    0b0001111,
1592                    (outs GPR8:$reg),
1593                    (ins),
1594                    "pop\t$reg",
1595                    []>,
1596                Requires<[HasSRAM]>;
1597
1598    def POPWRd : Pseudo<(outs DREGS:$reg),
1599                        (ins),
1600                        "popw\t$reg",
1601                        []>,
1602                 Requires<[HasSRAM]>;
1603  }
1604}
1605
1606// Read-Write-Modify (RMW) instructions.
1607def XCHZRd : FZRd<0b100,
1608                  (outs GPR8:$rd),
1609                  (ins ZREG:$z),
1610                  "xch\t$z, $rd",
1611                  []>,
1612             Requires<[SupportsRMW]>;
1613
1614def LASZRd : FZRd<0b101,
1615                  (outs GPR8:$rd),
1616                  (ins ZREG:$z),
1617                  "las\t$z, $rd",
1618                  []>,
1619             Requires<[SupportsRMW]>;
1620
1621def LACZRd : FZRd<0b110,
1622                  (outs GPR8:$rd),
1623                  (ins ZREG:$z),
1624                  "lac\t$z, $rd",
1625                  []>,
1626             Requires<[SupportsRMW]>;
1627
1628def LATZRd : FZRd<0b111,
1629                  (outs GPR8:$rd),
1630                  (ins ZREG:$z),
1631                  "lat\t$z, $rd",
1632                  []>,
1633             Requires<[SupportsRMW]>;
1634
1635//===----------------------------------------------------------------------===//
1636// Bit and bit-test instructions
1637//===----------------------------------------------------------------------===//
1638
1639// Bit shift/rotate operations.
1640let Constraints = "$src = $rd",
1641Defs = [SREG] in
1642{
1643  // 8-bit LSL is an alias of ADD Rd, Rd
1644
1645  def LSLWRd : Pseudo<(outs DREGS:$rd),
1646                      (ins DREGS:$src),
1647                      "lslw\t$rd",
1648                      [(set i16:$rd, (AVRlsl i16:$src)), (implicit SREG)]>;
1649
1650  def LSRRd : FRd<0b1001,
1651                  0b0100110,
1652                  (outs GPR8:$rd),
1653                  (ins GPR8:$src),
1654                  "lsr\t$rd",
1655                  [(set i8:$rd, (AVRlsr i8:$src)), (implicit SREG)]>;
1656
1657  def LSRWRd : Pseudo<(outs DREGS:$rd),
1658                      (ins DREGS:$src),
1659                      "lsrw\t$rd",
1660                      [(set i16:$rd, (AVRlsr i16:$src)), (implicit SREG)]>;
1661
1662  def ASRRd : FRd<0b1001,
1663                  0b0100101,
1664                  (outs GPR8:$rd),
1665                  (ins GPR8:$src),
1666                  "asr\t$rd",
1667                  [(set i8:$rd, (AVRasr i8:$src)), (implicit SREG)]>;
1668
1669  def ASRWRd : Pseudo<(outs DREGS:$rd),
1670                      (ins DREGS:$src),
1671                      "asrw\t$rd",
1672                      [(set i16:$rd, (AVRasr i16:$src)), (implicit SREG)]>;
1673
1674  // Bit rotate operations.
1675  let Uses = [SREG] in
1676  {
1677    // 8-bit ROL is an alias of ADC Rd, Rd
1678
1679    def ROLWRd : Pseudo<(outs DREGS:$rd),
1680                        (ins DREGS:$src),
1681                        "rolw\t$rd",
1682                        [(set i16:$rd, (AVRrol i16:$src)), (implicit SREG)]>;
1683
1684    def RORRd : FRd<0b1001,
1685                    0b0100111,
1686                    (outs GPR8:$rd),
1687                    (ins GPR8:$src),
1688                    "ror\t$rd",
1689                    [(set i8:$rd, (AVRror i8:$src)), (implicit SREG)]>;
1690
1691    def RORWRd : Pseudo<(outs DREGS:$rd),
1692                        (ins DREGS:$src),
1693                        "rorw\t$rd",
1694                        [(set i16:$rd, (AVRror i16:$src)), (implicit SREG)]>;
1695  }
1696}
1697
1698// SWAP Rd
1699// Swaps the high and low nibbles in a register.
1700let Constraints = "$src = $rd" in
1701def SWAPRd : FRd<0b1001,
1702                 0b0100010,
1703                 (outs GPR8:$rd),
1704                 (ins GPR8:$src),
1705                 "swap\t$rd",
1706                 [(set i8:$rd, (bswap i8:$src))]>;
1707
1708// IO register bit set/clear operations.
1709//:TODO: add patterns when popcount(imm)==2 to be expanded with 2 sbi/cbi
1710// instead of in+ori+out which requires one more instr.
1711def SBIAb : FIOBIT<0b10,
1712                   (outs),
1713                   (ins imm_port5:$addr, i8imm:$bit),
1714                   "sbi\t$addr, $bit",
1715                   [(store (or (i8 (load lowioaddr8:$addr)), iobitpos8:$bit),
1716                     lowioaddr8:$addr)]>;
1717
1718def CBIAb : FIOBIT<0b00,
1719                   (outs),
1720                   (ins imm_port5:$addr, i8imm:$bit),
1721                   "cbi\t$addr, $bit",
1722                   [(store (and (i8 (load lowioaddr8:$addr)), iobitposn8:$bit),
1723                     lowioaddr8:$addr)]>;
1724
1725// Status register bit load/store operations.
1726let Defs = [SREG] in
1727def BST : FRdB<0b01,
1728               (outs),
1729               (ins GPR8:$rd, i8imm:$b),
1730               "bst\t$rd, $b",
1731               []>;
1732
1733let Uses = [SREG] in
1734def BLD : FRdB<0b00,
1735               (outs),
1736               (ins GPR8:$rd, i8imm:$b),
1737               "bld\t$rd, $b",
1738               []>;
1739
1740def CBR : InstAlias<"cbr\t$rd, $k", (ANDIRdK LD8:$rd, imm_com8:$k), 0>;
1741
1742// CLR Rd
1743// Alias for EOR Rd, Rd
1744// -------------
1745// Clears all bits in a register.
1746def CLR : InstAlias<"clr\t$rd", (EORRdRr GPR8:$rd, GPR8:$rd)>;
1747
1748// LSL Rd
1749// Alias for ADD Rd, Rd
1750// --------------
1751// Logical shift left one bit.
1752def LSL : InstAlias<"lsl\t$rd", (ADDRdRr GPR8:$rd, GPR8:$rd)>;
1753
1754def ROL : InstAlias<"rol\t$rd", (ADCRdRr GPR8:$rd, GPR8:$rd)>;
1755
1756// SER Rd
1757// Alias for LDI Rd, 0xff
1758// ---------
1759// Sets all bits in a register.
1760def : InstAlias<"ser\t$rd", (LDIRdK LD8:$rd, 0xff), 0>;
1761
1762let Defs = [SREG] in
1763def BSETs : FS<0,
1764               (outs),
1765               (ins i8imm:$s),
1766               "bset\t$s",
1767               []>;
1768
1769let Defs = [SREG] in
1770def BCLRs : FS<1,
1771               (outs),
1772               (ins i8imm:$s),
1773               "bclr\t$s",
1774               []>;
1775
1776// Set/clear aliases for the carry (C) status flag (bit 0).
1777def : InstAlias<"sec", (BSETs 0)>;
1778def : InstAlias<"clc", (BCLRs 0)>;
1779
1780// Set/clear aliases for the zero (Z) status flag (bit 1).
1781def : InstAlias<"sez", (BSETs 1)>;
1782def : InstAlias<"clz", (BCLRs 1)>;
1783
1784// Set/clear aliases for the negative (N) status flag (bit 2).
1785def : InstAlias<"sen", (BSETs 2)>;
1786def : InstAlias<"cln", (BCLRs 2)>;
1787
1788// Set/clear aliases for the overflow (V) status flag (bit 3).
1789def : InstAlias<"sev", (BSETs 3)>;
1790def : InstAlias<"clv", (BCLRs 3)>;
1791
1792// Set/clear aliases for the signed (S) status flag (bit 4).
1793def : InstAlias<"ses", (BSETs 4)>;
1794def : InstAlias<"cls", (BCLRs 4)>;
1795
1796// Set/clear aliases for the half-carry (H) status flag (bit 5).
1797def : InstAlias<"seh", (BSETs 5)>;
1798def : InstAlias<"clh", (BCLRs 5)>;
1799
1800// Set/clear aliases for the T status flag (bit 6).
1801def : InstAlias<"set", (BSETs 6)>;
1802def : InstAlias<"clt", (BCLRs 6)>;
1803
1804// Set/clear aliases for the interrupt (I) status flag (bit 7).
1805def : InstAlias<"sei", (BSETs 7)>;
1806def : InstAlias<"cli", (BCLRs 7)>;
1807
1808//===----------------------------------------------------------------------===//
1809// Special/Control instructions
1810//===----------------------------------------------------------------------===//
1811
1812// BREAK
1813// Breakpoint instruction
1814// ---------
1815// <|1001|0101|1001|1000>
1816def BREAK : F16<0b1001010110011000,
1817                (outs),
1818                (ins),
1819                "break",
1820                []>,
1821            Requires<[HasBREAK]>;
1822
1823// NOP
1824// No-operation instruction
1825// ---------
1826// <|0000|0000|0000|0000>
1827def NOP : F16<0b0000000000000000,
1828              (outs),
1829              (ins),
1830              "nop",
1831              []>;
1832
1833// SLEEP
1834// Sleep instruction
1835// ---------
1836// <|1001|0101|1000|1000>
1837def SLEEP : F16<0b1001010110001000,
1838                (outs),
1839                (ins),
1840                "sleep",
1841                []>;
1842
1843// WDR
1844// Watchdog reset
1845// ---------
1846// <|1001|0101|1010|1000>
1847def WDR : F16<0b1001010110101000,
1848              (outs),
1849              (ins),
1850              "wdr",
1851              []>;
1852
1853//===----------------------------------------------------------------------===//
1854// Pseudo instructions for later expansion
1855//===----------------------------------------------------------------------===//
1856
1857//:TODO: Optimize this for wider types AND optimize the following code
1858//       compile int foo(char a, char b, char c, char d) {return d+b;}
1859//       looks like a missed sext_inreg opportunity.
1860def SEXT : ExtensionPseudo<
1861  (outs DREGS:$dst),
1862  (ins GPR8:$src),
1863  "sext\t$dst, $src",
1864  [(set i16:$dst, (sext i8:$src)), (implicit SREG)]
1865>;
1866
1867def ZEXT : ExtensionPseudo<
1868  (outs DREGS:$dst),
1869  (ins GPR8:$src),
1870  "zext\t$dst, $src",
1871  [(set i16:$dst, (zext i8:$src)), (implicit SREG)]
1872>;
1873
1874// This pseudo gets expanded into a movw+adiw thus it clobbers SREG.
1875let Defs = [SREG],
1876    hasSideEffects = 0 in
1877def FRMIDX : Pseudo<(outs DLDREGS:$dst),
1878                    (ins DLDREGS:$src, i16imm:$src2),
1879                    "frmidx\t$dst, $src, $src2",
1880                    []>;
1881
1882// This pseudo is either converted to a regular store or a push which clobbers
1883// SP.
1884def STDSPQRr : StorePseudo<
1885  (outs),
1886  (ins memspi:$dst, GPR8:$src),
1887  "stdstk\t$dst, $src",
1888  [(store i8:$src, addr:$dst)]
1889>;
1890
1891// This pseudo is either converted to a regular store or a push which clobbers
1892// SP.
1893def STDWSPQRr : StorePseudo<
1894  (outs),
1895  (ins memspi:$dst, DREGS:$src),
1896  "stdwstk\t$dst, $src",
1897  [(store i16:$src, addr:$dst)]
1898>;
1899
1900// SP read/write pseudos.
1901let hasSideEffects = 0 in
1902{
1903  let Uses = [SP] in
1904  def SPREAD : Pseudo<
1905    (outs DREGS:$dst),
1906    (ins GPRSP:$src),
1907    "spread\t$dst, $src",
1908    []
1909  >;
1910
1911  let Defs = [SP] in
1912  def SPWRITE : Pseudo<
1913    (outs GPRSP:$dst),
1914    (ins DREGS:$src),
1915    "spwrite\t$dst, $src",
1916    []>;
1917}
1918
1919def Select8 : SelectPseudo<
1920  (outs GPR8:$dst),
1921  (ins GPR8:$src, GPR8:$src2, i8imm:$cc),
1922  "# Select8 PSEUDO",
1923  [(set i8:$dst, (AVRselectcc i8:$src, i8:$src2, imm:$cc))]
1924>;
1925
1926def Select16 : SelectPseudo<
1927  (outs DREGS:$dst),
1928  (ins DREGS:$src, DREGS:$src2, i8imm:$cc),
1929  "# Select16 PSEUDO",
1930  [(set i16:$dst, (AVRselectcc i16:$src, i16:$src2, imm:$cc))]
1931>;
1932
1933def Lsl8 : ShiftPseudo<
1934  (outs GPR8:$dst),
1935  (ins GPR8:$src, GPR8:$cnt),
1936  "# Lsl8 PSEUDO",
1937  [(set i8:$dst, (AVRlslLoop i8:$src, i8:$cnt))]
1938>;
1939
1940def Lsl16 : ShiftPseudo<
1941  (outs DREGS:$dst),
1942  (ins DREGS:$src, GPR8:$cnt),
1943  "# Lsl16 PSEUDO",
1944  [(set i16:$dst, (AVRlslLoop i16:$src, i8:$cnt))]
1945>;
1946
1947def Lsr8 : ShiftPseudo<
1948  (outs GPR8:$dst),
1949  (ins GPR8:$src, GPR8:$cnt),
1950  "# Lsr8 PSEUDO",
1951  [(set i8:$dst, (AVRlsrLoop i8:$src, i8:$cnt))]
1952>;
1953
1954def Lsr16 : ShiftPseudo<
1955  (outs DREGS:$dst),
1956   (ins DREGS:$src, GPR8:$cnt),
1957   "# Lsr16 PSEUDO",
1958   [(set i16:$dst, (AVRlsrLoop i16:$src, i8:$cnt))]
1959>;
1960
1961def Rol8 : ShiftPseudo<
1962  (outs GPR8:$dst),
1963  (ins GPR8:$src, GPR8:$cnt),
1964  "# Rol8 PSEUDO",
1965  [(set i8:$dst, (AVRrolLoop i8:$src, i8:$cnt))]
1966>;
1967
1968def Rol16 : ShiftPseudo<
1969  (outs DREGS:$dst),
1970  (ins DREGS:$src, GPR8:$cnt),
1971  "# Rol16 PSEUDO",
1972  [(set i16:$dst, (AVRrolLoop i16:$src, i8:$cnt))]
1973>;
1974
1975def Ror8 : ShiftPseudo<
1976  (outs GPR8:$dst),
1977  (ins GPR8:$src, GPR8:$cnt),
1978  "# Ror8 PSEUDO",
1979  [(set i8:$dst, (AVRrorLoop i8:$src, i8:$cnt))]
1980>;
1981
1982def Ror16 : ShiftPseudo<
1983  (outs DREGS:$dst),
1984  (ins DREGS:$src, GPR8:$cnt),
1985  "# Ror16 PSEUDO",
1986  [(set i16:$dst, (AVRrorLoop i16:$src, i8:$cnt))]
1987>;
1988
1989def Asr8 : ShiftPseudo<
1990  (outs GPR8:$dst),
1991  (ins GPR8:$src, GPR8:$cnt),
1992  "# Asr8 PSEUDO",
1993  [(set i8:$dst, (AVRasrLoop i8:$src, i8:$cnt))]
1994>;
1995
1996def Asr16 : ShiftPseudo<
1997  (outs DREGS:$dst),
1998   (ins DREGS:$src, GPR8:$cnt),
1999   "# Asr16 PSEUDO",
2000   [(set i16:$dst, (AVRasrLoop i16:$src, i8:$cnt))]
2001>;
2002
2003
2004//===----------------------------------------------------------------------===//
2005// Non-Instruction Patterns
2006//===----------------------------------------------------------------------===//
2007
2008//:TODO: look in x86InstrCompiler.td for odd encoding trick related to
2009// add x, 128 -> sub x, -128. Clang is emitting an eor for this (ldi+eor)
2010
2011// the add instruction always writes the carry flag
2012def : Pat<(addc i8:$src, i8:$src2),
2013          (ADDRdRr i8:$src, i8:$src2)>;
2014def : Pat<(addc DREGS:$src, DREGS:$src2),
2015          (ADDWRdRr DREGS:$src, DREGS:$src2)>;
2016
2017// all sub instruction variants always writes the carry flag
2018def : Pat<(subc i8:$src, i8:$src2),
2019          (SUBRdRr i8:$src, i8:$src2)>;
2020def : Pat<(subc i16:$src, i16:$src2),
2021          (SUBWRdRr i16:$src, i16:$src2)>;
2022def : Pat<(subc i8:$src, imm:$src2),
2023          (SUBIRdK i8:$src, imm:$src2)>;
2024def : Pat<(subc i16:$src, imm:$src2),
2025          (SUBIWRdK i16:$src, imm:$src2)>;
2026
2027// These patterns convert add (x, -imm) to sub (x, imm) since we dont have
2028// any add with imm instructions. Also take care of the adiw/sbiw instructions.
2029def : Pat<(add i16:$src1, imm0_63_neg:$src2),
2030          (SBIWRdK i16:$src1, (imm0_63_neg:$src2))>;
2031def : Pat<(add i16:$src1, imm:$src2),
2032          (SUBIWRdK i16:$src1, (imm16_neg_XFORM imm:$src2))>;
2033def : Pat<(addc i16:$src1, imm:$src2),
2034          (SUBIWRdK i16:$src1, (imm16_neg_XFORM imm:$src2))>;
2035def : Pat<(adde i16:$src1, imm:$src2),
2036          (SBCIWRdK i16:$src1, (imm16_neg_XFORM imm:$src2))>;
2037
2038def : Pat<(add i8:$src1, imm:$src2),
2039          (SUBIRdK i8:$src1, (imm8_neg_XFORM imm:$src2))>;
2040def : Pat<(addc i8:$src1, imm:$src2),
2041          (SUBIRdK i8:$src1, (imm8_neg_XFORM imm:$src2))>;
2042def : Pat<(adde i8:$src1, imm:$src2),
2043          (SBCIRdK i8:$src1, (imm8_neg_XFORM imm:$src2))>;
2044
2045// Calls.
2046def : Pat<(AVRcall (i16 tglobaladdr:$dst)),
2047          (CALLk tglobaladdr:$dst)>;
2048def : Pat<(AVRcall (i16 texternalsym:$dst)),
2049          (CALLk texternalsym:$dst)>;
2050
2051// `anyext`
2052def : Pat<(i16 (anyext i8:$src)),
2053          (INSERT_SUBREG (i16 (IMPLICIT_DEF)), i8:$src, sub_lo)>;
2054
2055// `trunc`
2056def : Pat<(i8 (trunc i16:$src)),
2057          (EXTRACT_SUBREG i16:$src, sub_lo)>;
2058
2059// sext_inreg
2060def : Pat<(sext_inreg i16:$src, i8),
2061          (SEXT (i8 (EXTRACT_SUBREG i16:$src, sub_lo)))>;
2062
2063// GlobalAddress
2064def : Pat<(i16 (AVRWrapper tglobaladdr:$dst)),
2065          (LDIWRdK tglobaladdr:$dst)>;
2066def : Pat<(add i16:$src, (AVRWrapper tglobaladdr:$src2)),
2067          (SUBIWRdK i16:$src, tglobaladdr:$src2)>;
2068def : Pat<(i8 (load (AVRWrapper tglobaladdr:$dst))),
2069          (LDSRdK tglobaladdr:$dst)>;
2070def : Pat<(i16 (load (AVRWrapper tglobaladdr:$dst))),
2071          (LDSWRdK tglobaladdr:$dst)>;
2072def : Pat<(store i8:$src, (i16 (AVRWrapper tglobaladdr:$dst))),
2073          (STSKRr tglobaladdr:$dst, i8:$src)>;
2074def : Pat<(store i16:$src, (i16 (AVRWrapper tglobaladdr:$dst))),
2075          (STSWKRr tglobaladdr:$dst, i16:$src)>;
2076
2077// BlockAddress
2078def : Pat<(i16 (AVRWrapper tblockaddress:$dst)),
2079          (LDIWRdK tblockaddress:$dst)>;
2080
2081// hi-reg truncation : trunc(int16 >> 8)
2082//:FIXME: i think it's better to emit an extract subreg node in the DAG than
2083// all this mess once we get optimal shift code
2084// lol... I think so, too. [@agnat]
2085def : Pat<(i8 (trunc (AVRlsr (AVRlsr (AVRlsr (AVRlsr (AVRlsr (AVRlsr (AVRlsr
2086                     (AVRlsr DREGS:$src)))))))))),
2087          (EXTRACT_SUBREG DREGS:$src, sub_hi)>;
2088
2089// :FIXME: DAGCombiner produces an shl node after legalization from these seq:
2090// BR_JT -> (mul x, 2) -> (shl x, 1)
2091def : Pat<(shl i16:$src1, (i8 1)),
2092          (LSLWRd i16:$src1)>;
2093
2094// Lowering of 'tst' node to 'TST' instruction.
2095// TST is an alias of AND Rd, Rd.
2096def : Pat<(AVRtst i8:$rd),
2097          (ANDRdRr GPR8:$rd, GPR8:$rd)>;
2098
2099// Lowering of 'lsl' node to 'LSL' instruction.
2100// LSL is an alias of 'ADD Rd, Rd'
2101def : Pat<(AVRlsl i8:$rd),
2102          (ADDRdRr GPR8:$rd, GPR8:$rd)>;
2103
2104