MSP430InstrInfo.td revision bc9d98b52d008d857c7423d7b43fb32022b926a2
1//===- MSP430InstrInfo.td - MSP430 Instruction defs -----------*- tblgen-*-===//
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 MSP430 instructions in TableGen format.
11//
12//===----------------------------------------------------------------------===//
13
14include "MSP430InstrFormats.td"
15
16//===----------------------------------------------------------------------===//
17// Type Constraints.
18//===----------------------------------------------------------------------===//
19class SDTCisI8<int OpNum> : SDTCisVT<OpNum, i8>;
20class SDTCisI16<int OpNum> : SDTCisVT<OpNum, i16>;
21
22//===----------------------------------------------------------------------===//
23// Type Profiles.
24//===----------------------------------------------------------------------===//
25def SDT_MSP430Call         : SDTypeProfile<0, -1, [SDTCisVT<0, iPTR>]>;
26def SDT_MSP430CallSeqStart : SDCallSeqStart<[SDTCisVT<0, i16>]>;
27def SDT_MSP430CallSeqEnd   : SDCallSeqEnd<[SDTCisVT<0, i16>, SDTCisVT<1, i16>]>;
28def SDT_MSP430Wrapper      : SDTypeProfile<1, 1, [SDTCisSameAs<0, 1>, SDTCisPtrTy<0>]>;
29def SDT_MSP430Cmp          : SDTypeProfile<0, 2, [SDTCisSameAs<0, 1>]>;
30def SDT_MSP430BrCC         : SDTypeProfile<0, 2, [SDTCisVT<0, OtherVT>,
31                                                  SDTCisVT<1, i8>]>;
32def SDT_MSP430SelectCC     : SDTypeProfile<1, 3, [SDTCisSameAs<0, 1>, SDTCisSameAs<1, 2>, 
33                                                  SDTCisVT<3, i8>]>;
34def SDT_MSP430Shift        : SDTypeProfile<1, 2, [SDTCisSameAs<0, 1>, SDTCisI8<2>]>;
35
36//===----------------------------------------------------------------------===//
37// MSP430 Specific Node Definitions.
38//===----------------------------------------------------------------------===//
39def MSP430retflag  : SDNode<"MSP430ISD::RET_FLAG", SDTNone,
40                       [SDNPHasChain, SDNPOptInFlag]>;
41def MSP430retiflag : SDNode<"MSP430ISD::RETI_FLAG", SDTNone,
42                       [SDNPHasChain, SDNPOptInFlag]>;
43
44def MSP430rra     : SDNode<"MSP430ISD::RRA", SDTIntUnaryOp, []>;
45def MSP430rla     : SDNode<"MSP430ISD::RLA", SDTIntUnaryOp, []>;
46def MSP430rrc     : SDNode<"MSP430ISD::RRC", SDTIntUnaryOp, []>;
47
48def MSP430call    : SDNode<"MSP430ISD::CALL", SDT_MSP430Call,
49                     [SDNPHasChain, SDNPOutFlag, SDNPOptInFlag]>;
50def MSP430callseq_start :
51                 SDNode<"ISD::CALLSEQ_START", SDT_MSP430CallSeqStart,
52                        [SDNPHasChain, SDNPOutFlag]>;
53def MSP430callseq_end :
54                 SDNode<"ISD::CALLSEQ_END",   SDT_MSP430CallSeqEnd,
55                        [SDNPHasChain, SDNPOptInFlag, SDNPOutFlag]>;
56def MSP430Wrapper : SDNode<"MSP430ISD::Wrapper", SDT_MSP430Wrapper>;
57def MSP430cmp     : SDNode<"MSP430ISD::CMP", SDT_MSP430Cmp, [SDNPOutFlag]>;
58def MSP430brcc    : SDNode<"MSP430ISD::BR_CC", SDT_MSP430BrCC, [SDNPHasChain, SDNPInFlag]>;
59def MSP430selectcc: SDNode<"MSP430ISD::SELECT_CC", SDT_MSP430SelectCC, [SDNPInFlag]>;
60def MSP430shl     : SDNode<"MSP430ISD::SHL", SDT_MSP430Shift, []>;
61def MSP430sra     : SDNode<"MSP430ISD::SRA", SDT_MSP430Shift, []>;
62def MSP430srl     : SDNode<"MSP430ISD::SRL", SDT_MSP430Shift, []>;
63
64//===----------------------------------------------------------------------===//
65// MSP430 Operand Definitions.
66//===----------------------------------------------------------------------===//
67
68// Address operands
69def memsrc : Operand<i16> {
70  let PrintMethod = "printSrcMemOperand";
71  let MIOperandInfo = (ops GR16, i16imm);
72}
73
74def memdst : Operand<i16> {
75  let PrintMethod = "printSrcMemOperand";
76  let MIOperandInfo = (ops GR16, i16imm);
77}
78
79// Branch targets have OtherVT type.
80def brtarget : Operand<OtherVT> {
81  let PrintMethod = "printPCRelImmOperand";
82}
83
84// Operand for printing out a condition code.
85def cc : Operand<i8> {
86  let PrintMethod = "printCCOperand";
87}
88
89//===----------------------------------------------------------------------===//
90// MSP430 Complex Pattern Definitions.
91//===----------------------------------------------------------------------===//
92
93def addr : ComplexPattern<iPTR, 2, "SelectAddr", [], []>;
94
95//===----------------------------------------------------------------------===//
96// Pattern Fragments
97def zextloadi16i8 : PatFrag<(ops node:$ptr), (i16 (zextloadi8 node:$ptr))>;
98def  extloadi16i8 : PatFrag<(ops node:$ptr), (i16 ( extloadi8 node:$ptr))>;
99def and_su : PatFrag<(ops node:$lhs, node:$rhs), (and node:$lhs, node:$rhs), [{
100  return N->hasOneUse();
101}]>;
102//===----------------------------------------------------------------------===//
103// Instruction list..
104
105// ADJCALLSTACKDOWN/UP implicitly use/def SP because they may be expanded into
106// a stack adjustment and the codegen must know that they may modify the stack
107// pointer before prolog-epilog rewriting occurs.
108// Pessimistically assume ADJCALLSTACKDOWN / ADJCALLSTACKUP will become
109// sub / add which can clobber SRW.
110let Defs = [SPW, SRW], Uses = [SPW] in {
111def ADJCALLSTACKDOWN : Pseudo<(outs), (ins i16imm:$amt),
112                              "#ADJCALLSTACKDOWN",
113                              [(MSP430callseq_start timm:$amt)]>;
114def ADJCALLSTACKUP   : Pseudo<(outs), (ins i16imm:$amt1, i16imm:$amt2),
115                              "#ADJCALLSTACKUP",
116                              [(MSP430callseq_end timm:$amt1, timm:$amt2)]>;
117}
118
119let usesCustomInserter = 1 in {
120  def Select8  : Pseudo<(outs GR8:$dst), (ins GR8:$src1, GR8:$src2, i8imm:$cc),
121                        "# Select8 PSEUDO",
122                        [(set GR8:$dst,
123                          (MSP430selectcc GR8:$src1, GR8:$src2, imm:$cc))]>;
124  def Select16 : Pseudo<(outs GR16:$dst), (ins GR16:$src1, GR16:$src2, i8imm:$cc),
125                        "# Select16 PSEUDO",
126                        [(set GR16:$dst,
127                          (MSP430selectcc GR16:$src1, GR16:$src2, imm:$cc))]>;
128  let Defs = [SRW] in {
129  def Shl8     : Pseudo<(outs GR8:$dst), (ins GR8:$src, GR8:$cnt),
130                        "# Shl8 PSEUDO",
131                        [(set GR8:$dst, (MSP430shl GR8:$src, GR8:$cnt))]>;
132  def Shl16    : Pseudo<(outs GR16:$dst), (ins GR16:$src, GR8:$cnt),
133                        "# Shl16 PSEUDO",
134                        [(set GR16:$dst, (MSP430shl GR16:$src, GR8:$cnt))]>;
135  def Sra8     : Pseudo<(outs GR8:$dst), (ins GR8:$src, GR8:$cnt),
136                        "# Sra8 PSEUDO",
137                        [(set GR8:$dst, (MSP430sra GR8:$src, GR8:$cnt))]>;
138  def Sra16    : Pseudo<(outs GR16:$dst), (ins GR16:$src, GR8:$cnt),
139                        "# Sra16 PSEUDO",
140                        [(set GR16:$dst, (MSP430sra GR16:$src, GR8:$cnt))]>;
141  def Srl8     : Pseudo<(outs GR8:$dst), (ins GR8:$src, GR8:$cnt),
142                        "# Srl8 PSEUDO",
143                        [(set GR8:$dst, (MSP430srl GR8:$src, GR8:$cnt))]>;
144  def Srl16    : Pseudo<(outs GR16:$dst), (ins GR16:$src, GR8:$cnt),
145                        "# Srl16 PSEUDO",
146                        [(set GR16:$dst, (MSP430srl GR16:$src, GR8:$cnt))]>;
147
148  }
149}
150
151let neverHasSideEffects = 1 in
152def NOP : Pseudo<(outs), (ins), "nop", []>;
153
154//===----------------------------------------------------------------------===//
155//  Control Flow Instructions...
156//
157
158// FIXME: Provide proper encoding!
159let isReturn = 1, isTerminator = 1, isBarrier = 1 in {
160  def RET  : IForm16<0x0, DstReg, SrcPostInc, Size2Bytes,
161                     (outs), (ins), "ret",  [(MSP430retflag)]>;
162  def RETI : II16r<0x0, (outs), (ins), "reti", [(MSP430retiflag)]>;
163}
164
165let isBranch = 1, isTerminator = 1 in {
166
167// FIXME: expand opcode & cond field for branches!
168
169// Direct branch
170let isBarrier = 1 in {
171  // Short branch
172  def JMP : CJForm<0, 0,
173                   (outs), (ins brtarget:$dst),
174                   "jmp\t$dst",
175                   [(br bb:$dst)]>;
176  // Long branch
177  def B   : I16ri<0,
178                  (outs), (ins brtarget:$dst),
179                  "br\t$dst",
180                  []>;
181}
182
183// Conditional branches
184let Uses = [SRW] in
185  def JCC : CJForm<0, 0,
186                   (outs), (ins brtarget:$dst, cc:$cc),
187                   "j$cc\t$dst",
188                   [(MSP430brcc bb:$dst, imm:$cc)]>;
189} // isBranch, isTerminator
190
191//===----------------------------------------------------------------------===//
192//  Call Instructions...
193//
194let isCall = 1 in
195  // All calls clobber the non-callee saved registers. SPW is marked as
196  // a use to prevent stack-pointer assignments that appear immediately
197  // before calls from potentially appearing dead. Uses for argument
198  // registers are added manually.
199  let Defs = [R12W, R13W, R14W, R15W, SRW],
200      Uses = [SPW] in {
201    def CALLi     : II16i<0x0,
202                          (outs), (ins i16imm:$dst, variable_ops),
203                          "call\t$dst", [(MSP430call imm:$dst)]>;
204    def CALLr     : II16r<0x0,
205                          (outs), (ins GR16:$dst, variable_ops),
206                          "call\t$dst", [(MSP430call GR16:$dst)]>;
207    def CALLm     : II16m<0x0,
208                          (outs), (ins memsrc:$dst, variable_ops),
209                          "call\t${dst:mem}", [(MSP430call (load addr:$dst))]>;
210  }
211
212
213//===----------------------------------------------------------------------===//
214//  Miscellaneous Instructions...
215//
216let Defs = [SPW], Uses = [SPW], neverHasSideEffects=1 in {
217let mayLoad = 1 in
218def POP16r   : IForm16<0x0, DstReg, SrcPostInc, Size2Bytes,
219                       (outs GR16:$reg), (ins), "pop.w\t$reg", []>;
220
221let mayStore = 1 in
222def PUSH16r  : II16r<0x0,
223                     (outs), (ins GR16:$reg), "push.w\t$reg",[]>;
224}
225
226//===----------------------------------------------------------------------===//
227// Move Instructions
228
229// FIXME: Provide proper encoding!
230let neverHasSideEffects = 1 in {
231def MOV8rr  : I8rr<0x0,
232                   (outs GR8:$dst), (ins GR8:$src),
233                   "mov.b\t{$src, $dst}",
234                   []>;
235def MOV16rr : I16rr<0x0,
236                    (outs GR16:$dst), (ins GR16:$src),
237                    "mov.w\t{$src, $dst}",
238                    []>;
239}
240
241// FIXME: Provide proper encoding!
242let isReMaterializable = 1, isAsCheapAsAMove = 1 in {
243def MOV8ri  : I8ri<0x0,
244                   (outs GR8:$dst), (ins i8imm:$src),
245                   "mov.b\t{$src, $dst}",
246                   [(set GR8:$dst, imm:$src)]>;
247def MOV16ri : I16ri<0x0,
248                    (outs GR16:$dst), (ins i16imm:$src),
249                    "mov.w\t{$src, $dst}",
250                    [(set GR16:$dst, imm:$src)]>;
251}
252
253let canFoldAsLoad = 1, isReMaterializable = 1 in {
254def MOV8rm  : I8rm<0x0,
255                   (outs GR8:$dst), (ins memsrc:$src),
256                   "mov.b\t{$src, $dst}",
257                   [(set GR8:$dst, (load addr:$src))]>;
258def MOV16rm : I16rm<0x0,
259                    (outs GR16:$dst), (ins memsrc:$src),
260                    "mov.w\t{$src, $dst}",
261                    [(set GR16:$dst, (load addr:$src))]>;
262}
263
264def MOVZX16rr8 : I8rr<0x0,
265                      (outs GR16:$dst), (ins GR8:$src),
266                      "mov.b\t{$src, $dst}",
267                      [(set GR16:$dst, (zext GR8:$src))]>;
268def MOVZX16rm8 : I8rm<0x0,
269                      (outs GR16:$dst), (ins memsrc:$src),
270                      "mov.b\t{$src, $dst}",
271                      [(set GR16:$dst, (zextloadi16i8 addr:$src))]>;
272
273let mayLoad = 1, hasExtraDefRegAllocReq = 1, Constraints = "$base = $base_wb" in {
274def MOV8rm_POST  : IForm8<0x0, DstReg, SrcPostInc, Size2Bytes,
275                         (outs GR8:$dst, GR16:$base_wb), (ins GR16:$base),
276                         "mov.b\t{@$base+, $dst}", []>;
277def MOV16rm_POST : IForm16<0x0, DstReg, SrcPostInc, Size2Bytes,
278                           (outs GR16:$dst, GR16:$base_wb), (ins GR16:$base),
279                           "mov.w\t{@$base+, $dst}", []>;
280}
281
282// Any instruction that defines a 8-bit result leaves the high half of the
283// register. Truncate can be lowered to EXTRACT_SUBREG, and CopyFromReg may
284// be copying from a truncate, but any other 8-bit operation will zero-extend
285// up to 16 bits.
286def def8 : PatLeaf<(i8 GR8:$src), [{
287  return N->getOpcode() != ISD::TRUNCATE &&
288         N->getOpcode() != TargetOpcode::EXTRACT_SUBREG &&
289         N->getOpcode() != ISD::CopyFromReg;
290}]>;
291
292// In the case of a 8-bit def that is known to implicitly zero-extend,
293// we can use a SUBREG_TO_REG.
294def : Pat<(i16 (zext def8:$src)),
295          (SUBREG_TO_REG (i16 0), GR8:$src, subreg_8bit)>;
296
297def MOV8mi  : I8mi<0x0,
298                   (outs), (ins memdst:$dst, i8imm:$src),
299                   "mov.b\t{$src, $dst}",
300                   [(store (i8 imm:$src), addr:$dst)]>;
301def MOV16mi : I16mi<0x0,
302                    (outs), (ins memdst:$dst, i16imm:$src),
303                    "mov.w\t{$src, $dst}",
304                    [(store (i16 imm:$src), addr:$dst)]>;
305
306def MOV8mr  : I8mr<0x0,
307                   (outs), (ins memdst:$dst, GR8:$src),
308                   "mov.b\t{$src, $dst}",
309                   [(store GR8:$src, addr:$dst)]>;
310def MOV16mr : I16mr<0x0,
311                    (outs), (ins memdst:$dst, GR16:$src),
312                    "mov.w\t{$src, $dst}",
313                    [(store GR16:$src, addr:$dst)]>;
314
315def MOV8mm  : I8mm<0x0,
316                   (outs), (ins memdst:$dst, memsrc:$src),
317                   "mov.b\t{$src, $dst}",
318                   [(store (i8 (load addr:$src)), addr:$dst)]>;
319def MOV16mm : I16mm<0x0,
320                    (outs), (ins memdst:$dst, memsrc:$src),
321                    "mov.w\t{$src, $dst}",
322                    [(store (i16 (load addr:$src)), addr:$dst)]>;
323
324//===----------------------------------------------------------------------===//
325// Arithmetic Instructions
326
327let isTwoAddress = 1 in {
328
329let Defs = [SRW] in {
330
331let isCommutable = 1 in { // X = ADD Y, Z  == X = ADD Z, Y
332
333def ADD8rr  : I8rr<0x0,
334                   (outs GR8:$dst), (ins GR8:$src1, GR8:$src2),
335                   "add.b\t{$src2, $dst}",
336                   [(set GR8:$dst, (add GR8:$src1, GR8:$src2)),
337                    (implicit SRW)]>;
338def ADD16rr : I16rr<0x0,
339                    (outs GR16:$dst), (ins GR16:$src1, GR16:$src2),
340                    "add.w\t{$src2, $dst}",
341                    [(set GR16:$dst, (add GR16:$src1, GR16:$src2)),
342                     (implicit SRW)]>;
343}
344
345def ADD8rm  : I8rm<0x0,
346                   (outs GR8:$dst), (ins GR8:$src1, memsrc:$src2),
347                   "add.b\t{$src2, $dst}",
348                   [(set GR8:$dst, (add GR8:$src1, (load addr:$src2))),
349                    (implicit SRW)]>;
350def ADD16rm : I16rm<0x0,
351                    (outs GR16:$dst), (ins GR16:$src1, memsrc:$src2),
352                    "add.w\t{$src2, $dst}",
353                    [(set GR16:$dst, (add GR16:$src1, (load addr:$src2))),
354                     (implicit SRW)]>;
355
356let mayLoad = 1, hasExtraDefRegAllocReq = 1, 
357Constraints = "$base = $base_wb, $src1 = $dst" in {
358def ADD8rm_POST : IForm8<0x0, DstReg, SrcPostInc, Size2Bytes,
359                         (outs GR8:$dst, GR16:$base_wb),
360                         (ins GR8:$src1, GR16:$base),
361                         "add.b\t{@$base+, $dst}", []>;
362def ADD16rm_POST : IForm16<0x0, DstReg, SrcPostInc, Size2Bytes,
363                           (outs GR16:$dst, GR16:$base_wb),
364                           (ins GR16:$src1, GR16:$base),
365                          "add.w\t{@$base+, $dst}", []>;
366}
367
368
369def ADD8ri  : I8ri<0x0,
370                   (outs GR8:$dst), (ins GR8:$src1, i8imm:$src2),
371                   "add.b\t{$src2, $dst}",
372                   [(set GR8:$dst, (add GR8:$src1, imm:$src2)),
373                    (implicit SRW)]>;
374def ADD16ri : I16ri<0x0,
375                    (outs GR16:$dst), (ins GR16:$src1, i16imm:$src2),
376                    "add.w\t{$src2, $dst}",
377                    [(set GR16:$dst, (add GR16:$src1, imm:$src2)),
378                     (implicit SRW)]>;
379
380let isTwoAddress = 0 in {
381def ADD8mr  : I8mr<0x0,
382                   (outs), (ins memdst:$dst, GR8:$src),
383                   "add.b\t{$src, $dst}",
384                   [(store (add (load addr:$dst), GR8:$src), addr:$dst),
385                    (implicit SRW)]>;
386def ADD16mr : I16mr<0x0,
387                    (outs), (ins memdst:$dst, GR16:$src),
388                    "add.w\t{$src, $dst}",
389                    [(store (add (load addr:$dst), GR16:$src), addr:$dst),
390                     (implicit SRW)]>;
391
392def ADD8mi  : I8mi<0x0,
393                   (outs), (ins memdst:$dst, i8imm:$src),
394                   "add.b\t{$src, $dst}",
395                   [(store (add (load addr:$dst), (i8 imm:$src)), addr:$dst),
396                    (implicit SRW)]>;
397def ADD16mi : I16mi<0x0,
398                    (outs), (ins memdst:$dst, i16imm:$src),
399                    "add.w\t{$src, $dst}",
400                    [(store (add (load addr:$dst), (i16 imm:$src)), addr:$dst),
401                     (implicit SRW)]>;
402
403def ADD8mm  : I8mm<0x0,
404                   (outs), (ins memdst:$dst, memsrc:$src),
405                   "add.b\t{$src, $dst}",
406                   [(store (add (load addr:$dst), 
407                                (i8 (load addr:$src))), addr:$dst),
408                    (implicit SRW)]>;
409def ADD16mm : I16mm<0x0,
410                    (outs), (ins memdst:$dst, memsrc:$src),
411                    "add.w\t{$src, $dst}",
412                    [(store (add (load addr:$dst), 
413                                  (i16 (load addr:$src))), addr:$dst),
414                     (implicit SRW)]>;
415}
416
417let Uses = [SRW] in {
418
419let isCommutable = 1 in { // X = ADDC Y, Z  == X = ADDC Z, Y
420def ADC8rr  : I8rr<0x0,
421                   (outs GR8:$dst), (ins GR8:$src1, GR8:$src2),
422                   "addc.b\t{$src2, $dst}",
423                   [(set GR8:$dst, (adde GR8:$src1, GR8:$src2)),
424                    (implicit SRW)]>;
425def ADC16rr : I16rr<0x0,
426                    (outs GR16:$dst), (ins GR16:$src1, GR16:$src2),
427                    "addc.w\t{$src2, $dst}",
428                    [(set GR16:$dst, (adde GR16:$src1, GR16:$src2)),
429                     (implicit SRW)]>;
430} // isCommutable
431
432def ADC8ri  : I8ri<0x0,
433                   (outs GR8:$dst), (ins GR8:$src1, i8imm:$src2),
434                   "addc.b\t{$src2, $dst}",
435                   [(set GR8:$dst, (adde GR8:$src1, imm:$src2)),
436                    (implicit SRW)]>;
437def ADC16ri : I16ri<0x0,
438                    (outs GR16:$dst), (ins GR16:$src1, i16imm:$src2),
439                    "addc.w\t{$src2, $dst}",
440                    [(set GR16:$dst, (adde GR16:$src1, imm:$src2)),
441                     (implicit SRW)]>;
442
443def ADC8rm  : I8rm<0x0,
444                   (outs GR8:$dst), (ins GR8:$src1, memsrc:$src2),
445                   "addc.b\t{$src2, $dst}",
446                   [(set GR8:$dst, (adde GR8:$src1, (load addr:$src2))),
447                    (implicit SRW)]>;
448def ADC16rm : I16rm<0x0,
449                    (outs GR16:$dst), (ins GR16:$src1, memsrc:$src2),
450                    "addc.w\t{$src2, $dst}",
451                    [(set GR16:$dst, (adde GR16:$src1, (load addr:$src2))),
452                     (implicit SRW)]>;
453
454let isTwoAddress = 0 in {
455def ADC8mr  : I8mr<0x0,
456                   (outs), (ins memdst:$dst, GR8:$src),
457                   "addc.b\t{$src, $dst}",
458                   [(store (adde (load addr:$dst), GR8:$src), addr:$dst),
459                    (implicit SRW)]>;
460def ADC16mr : I16mr<0x0,
461                    (outs), (ins memdst:$dst, GR16:$src),
462                    "addc.w\t{$src, $dst}",
463                    [(store (adde (load addr:$dst), GR16:$src), addr:$dst),
464                     (implicit SRW)]>;
465
466def ADC8mi  : I8mi<0x0,
467                   (outs), (ins memdst:$dst, i8imm:$src),
468                   "addc.b\t{$src, $dst}",
469                   [(store (adde (load addr:$dst), (i8 imm:$src)), addr:$dst),
470                    (implicit SRW)]>;
471def ADC16mi : I16mi<0x0,
472                    (outs), (ins memdst:$dst, i16imm:$src),
473                    "addc.w\t{$src, $dst}",
474                    [(store (adde (load addr:$dst), (i16 imm:$src)), addr:$dst),
475                     (implicit SRW)]>;
476
477def ADC8mm  : I8mm<0x0,
478                   (outs), (ins memdst:$dst, memsrc:$src),
479                   "addc.b\t{$src, $dst}",
480                   [(store (adde (load addr:$dst), 
481                                 (i8 (load addr:$src))), addr:$dst),
482                    (implicit SRW)]>;
483def ADC16mm : I8mm<0x0,
484                   (outs), (ins memdst:$dst, memsrc:$src),
485                   "addc.w\t{$src, $dst}",
486                   [(store (adde (load addr:$dst), 
487                                 (i16 (load addr:$src))), addr:$dst),
488                    (implicit SRW)]>;
489}
490
491} // Uses = [SRW]
492
493let isCommutable = 1 in { // X = AND Y, Z  == X = AND Z, Y
494def AND8rr  : I8rr<0x0,
495                   (outs GR8:$dst), (ins GR8:$src1, GR8:$src2),
496                   "and.b\t{$src2, $dst}",
497                   [(set GR8:$dst, (and GR8:$src1, GR8:$src2)),
498                    (implicit SRW)]>;
499def AND16rr : I16rr<0x0,
500                    (outs GR16:$dst), (ins GR16:$src1, GR16:$src2),
501                    "and.w\t{$src2, $dst}",
502                    [(set GR16:$dst, (and GR16:$src1, GR16:$src2)),
503                     (implicit SRW)]>;
504}
505
506def AND8ri  : I8ri<0x0,
507                   (outs GR8:$dst), (ins GR8:$src1, i8imm:$src2),
508                   "and.b\t{$src2, $dst}",
509                   [(set GR8:$dst, (and GR8:$src1, imm:$src2)),
510                    (implicit SRW)]>;
511def AND16ri : I16ri<0x0,
512                    (outs GR16:$dst), (ins GR16:$src1, i16imm:$src2),
513                    "and.w\t{$src2, $dst}",
514                    [(set GR16:$dst, (and GR16:$src1, imm:$src2)),
515                     (implicit SRW)]>;
516
517def AND8rm  : I8rm<0x0,
518                   (outs GR8:$dst), (ins GR8:$src1, memsrc:$src2),
519                   "and.b\t{$src2, $dst}",
520                   [(set GR8:$dst, (and GR8:$src1, (load addr:$src2))),
521                    (implicit SRW)]>;
522def AND16rm : I16rm<0x0,
523                    (outs GR16:$dst), (ins GR16:$src1, memsrc:$src2),
524                    "and.w\t{$src2, $dst}",
525                    [(set GR16:$dst, (and GR16:$src1, (load addr:$src2))),
526                     (implicit SRW)]>;
527
528let mayLoad = 1, hasExtraDefRegAllocReq = 1, 
529Constraints = "$base = $base_wb, $src1 = $dst" in {
530def AND8rm_POST : IForm8<0x0, DstReg, SrcPostInc, Size2Bytes,
531                         (outs GR8:$dst, GR16:$base_wb),
532                         (ins GR8:$src1, GR16:$base),
533                         "and.b\t{@$base+, $dst}", []>;
534def AND16rm_POST : IForm16<0x0, DstReg, SrcPostInc, Size2Bytes,
535                           (outs GR16:$dst, GR16:$base_wb),
536                           (ins GR16:$src1, GR16:$base),
537                           "and.w\t{@$base+, $dst}", []>;
538}
539
540let isTwoAddress = 0 in {
541def AND8mr  : I8mr<0x0,
542                   (outs), (ins memdst:$dst, GR8:$src),
543                   "and.b\t{$src, $dst}",
544                   [(store (and (load addr:$dst), GR8:$src), addr:$dst),
545                    (implicit SRW)]>;
546def AND16mr : I16mr<0x0,
547                    (outs), (ins memdst:$dst, GR16:$src),
548                    "and.w\t{$src, $dst}",
549                    [(store (and (load addr:$dst), GR16:$src), addr:$dst),
550                     (implicit SRW)]>;
551
552def AND8mi  : I8mi<0x0,
553                   (outs), (ins memdst:$dst, i8imm:$src),
554                   "and.b\t{$src, $dst}",
555                   [(store (and (load addr:$dst), (i8 imm:$src)), addr:$dst),
556                    (implicit SRW)]>;
557def AND16mi : I16mi<0x0,
558                    (outs), (ins memdst:$dst, i16imm:$src),
559                    "and.w\t{$src, $dst}",
560                    [(store (and (load addr:$dst), (i16 imm:$src)), addr:$dst),
561                     (implicit SRW)]>;
562
563def AND8mm  : I8mm<0x0,
564                   (outs), (ins memdst:$dst, memsrc:$src),
565                   "and.b\t{$src, $dst}",
566                   [(store (and (load addr:$dst), 
567                                (i8 (load addr:$src))), addr:$dst),
568                    (implicit SRW)]>;
569def AND16mm : I16mm<0x0,
570                    (outs), (ins memdst:$dst, memsrc:$src),
571                    "and.w\t{$src, $dst}",
572                    [(store (and (load addr:$dst), 
573                                 (i16 (load addr:$src))), addr:$dst),
574                     (implicit SRW)]>;
575}
576
577let isCommutable = 1 in { // X = OR Y, Z  == X = OR Z, Y
578def OR8rr  : I8rr<0x0,
579                  (outs GR8:$dst), (ins GR8:$src1, GR8:$src2),
580                  "bis.b\t{$src2, $dst}",
581                  [(set GR8:$dst, (or GR8:$src1, GR8:$src2))]>;
582def OR16rr : I16rr<0x0,
583                   (outs GR16:$dst), (ins GR16:$src1, GR16:$src2),
584                   "bis.w\t{$src2, $dst}",
585                   [(set GR16:$dst, (or GR16:$src1, GR16:$src2))]>;
586}
587
588def OR8ri  : I8ri<0x0,
589                  (outs GR8:$dst), (ins GR8:$src1, i8imm:$src2),
590                  "bis.b\t{$src2, $dst}",
591                  [(set GR8:$dst, (or GR8:$src1, imm:$src2))]>;
592def OR16ri : I16ri<0x0,
593                   (outs GR16:$dst), (ins GR16:$src1, i16imm:$src2),
594                   "bis.w\t{$src2, $dst}",
595                   [(set GR16:$dst, (or GR16:$src1, imm:$src2))]>;
596
597def OR8rm  : I8rm<0x0,
598                  (outs GR8:$dst), (ins GR8:$src1, memsrc:$src2),
599                  "bis.b\t{$src2, $dst}",
600                  [(set GR8:$dst, (or GR8:$src1, (load addr:$src2)))]>;
601def OR16rm : I16rm<0x0,
602                   (outs GR16:$dst), (ins GR16:$src1, memsrc:$src2),
603                   "bis.w\t{$src2, $dst}",
604                   [(set GR16:$dst, (or GR16:$src1, (load addr:$src2)))]>;
605
606let mayLoad = 1, hasExtraDefRegAllocReq = 1, 
607Constraints = "$base = $base_wb, $src1 = $dst" in {
608def OR8rm_POST : IForm8<0x0, DstReg, SrcPostInc, Size2Bytes,
609                        (outs GR8:$dst, GR16:$base_wb),
610                        (ins GR8:$src1, GR16:$base),
611                        "bis.b\t{@$base+, $dst}", []>;
612def OR16rm_POST : IForm16<0x0, DstReg, SrcPostInc, Size2Bytes,
613                          (outs GR16:$dst, GR16:$base_wb),
614                          (ins GR16:$src1, GR16:$base),
615                          "bis.w\t{@$base+, $dst}", []>;
616}
617
618let isTwoAddress = 0 in {
619def OR8mr  : I8mr<0x0,
620                  (outs), (ins memdst:$dst, GR8:$src),
621                  "bis.b\t{$src, $dst}",
622                  [(store (or (load addr:$dst), GR8:$src), addr:$dst)]>;
623def OR16mr : I16mr<0x0,
624                   (outs), (ins memdst:$dst, GR16:$src),
625                   "bis.w\t{$src, $dst}",
626                   [(store (or (load addr:$dst), GR16:$src), addr:$dst)]>;
627
628def OR8mi  : I8mi<0x0, 
629                  (outs), (ins memdst:$dst, i8imm:$src),
630                  "bis.b\t{$src, $dst}",
631                  [(store (or (load addr:$dst), (i8 imm:$src)), addr:$dst)]>;
632def OR16mi : I16mi<0x0,
633                   (outs), (ins memdst:$dst, i16imm:$src),
634                   "bis.w\t{$src, $dst}",
635                   [(store (or (load addr:$dst), (i16 imm:$src)), addr:$dst)]>;
636
637def OR8mm  : I8mm<0x0,
638                  (outs), (ins memdst:$dst, memsrc:$src),
639                  "bis.b\t{$src, $dst}",
640                  [(store (or (i8 (load addr:$dst)),
641                              (i8 (load addr:$src))), addr:$dst)]>;
642def OR16mm : I16mm<0x0,
643                   (outs), (ins memdst:$dst, memsrc:$src),
644                   "bis.w\t{$src, $dst}",
645                   [(store (or (i16 (load addr:$dst)),
646                               (i16 (load addr:$src))), addr:$dst)]>;
647}
648
649// bic does not modify condition codes
650def BIC8rr :  I8rr<0x0,
651                   (outs GR8:$dst), (ins GR8:$src1, GR8:$src2),
652                   "bic.b\t{$src2, $dst}",
653                   [(set GR8:$dst, (and GR8:$src1, (not GR8:$src2)))]>;
654def BIC16rr : I16rr<0x0,
655                    (outs GR16:$dst), (ins GR16:$src1, GR16:$src2),
656                    "bic.w\t{$src2, $dst}",
657                    [(set GR16:$dst, (and GR16:$src1, (not GR16:$src2)))]>;
658
659def BIC8rm :  I8rm<0x0,
660                   (outs GR8:$dst), (ins GR8:$src1, memsrc:$src2),
661                   "bic.b\t{$src2, $dst}",
662                    [(set GR8:$dst, (and GR8:$src1, (not (i8 (load addr:$src2)))))]>;
663def BIC16rm : I16rm<0x0,
664                    (outs GR16:$dst), (ins GR16:$src1, memsrc:$src2),
665                    "bic.w\t{$src2, $dst}",
666                    [(set GR16:$dst, (and GR16:$src1, (not (i16 (load addr:$src2)))))]>;
667
668let isTwoAddress = 0 in {
669def BIC8mr :  I8mr<0x0,
670                   (outs), (ins memdst:$dst, GR8:$src),
671                   "bic.b\t{$src, $dst}",
672                   [(store (and (load addr:$dst), (not GR8:$src)), addr:$dst)]>;
673def BIC16mr : I16mr<0x0,
674                    (outs), (ins memdst:$dst, GR16:$src),
675                    "bic.w\t{$src, $dst}",
676                    [(store (and (load addr:$dst), (not GR16:$src)), addr:$dst)]>;
677
678def BIC8mm :  I8mm<0x0,
679                   (outs), (ins memdst:$dst, memsrc:$src),
680                   "bic.b\t{$src, $dst}",
681                   [(store (and (load addr:$dst),
682                                (not (i8 (load addr:$src)))), addr:$dst)]>;
683def BIC16mm : I16mm<0x0,
684                    (outs), (ins memdst:$dst, memsrc:$src),
685                    "bic.w\t{$src, $dst}",
686                    [(store (and (load addr:$dst),
687                                 (not (i16 (load addr:$src)))), addr:$dst)]>;
688}
689
690let isCommutable = 1 in { // X = XOR Y, Z  == X = XOR Z, Y
691def XOR8rr  : I8rr<0x0,
692                   (outs GR8:$dst), (ins GR8:$src1, GR8:$src2),
693                   "xor.b\t{$src2, $dst}",
694                   [(set GR8:$dst, (xor GR8:$src1, GR8:$src2)),
695                    (implicit SRW)]>;
696def XOR16rr : I16rr<0x0,
697                    (outs GR16:$dst), (ins GR16:$src1, GR16:$src2),
698                    "xor.w\t{$src2, $dst}",
699                    [(set GR16:$dst, (xor GR16:$src1, GR16:$src2)),
700                     (implicit SRW)]>;
701}
702
703def XOR8ri  : I8ri<0x0,
704                   (outs GR8:$dst), (ins GR8:$src1, i8imm:$src2),
705                   "xor.b\t{$src2, $dst}",
706                   [(set GR8:$dst, (xor GR8:$src1, imm:$src2)),
707                    (implicit SRW)]>;
708def XOR16ri : I16ri<0x0,
709                    (outs GR16:$dst), (ins GR16:$src1, i16imm:$src2),
710                    "xor.w\t{$src2, $dst}",
711                    [(set GR16:$dst, (xor GR16:$src1, imm:$src2)),
712                     (implicit SRW)]>;
713
714def XOR8rm  : I8rm<0x0,
715                   (outs GR8:$dst), (ins GR8:$src1, memsrc:$src2),
716                   "xor.b\t{$src2, $dst}",
717                   [(set GR8:$dst, (xor GR8:$src1, (load addr:$src2))),
718                    (implicit SRW)]>;
719def XOR16rm : I16rm<0x0,
720                    (outs GR16:$dst), (ins GR16:$src1, memsrc:$src2),
721                    "xor.w\t{$src2, $dst}",
722                    [(set GR16:$dst, (xor GR16:$src1, (load addr:$src2))),
723                     (implicit SRW)]>;
724
725let mayLoad = 1, hasExtraDefRegAllocReq = 1, 
726Constraints = "$base = $base_wb, $src1 = $dst" in {
727def XOR8rm_POST : IForm8<0x0, DstReg, SrcPostInc, Size2Bytes,
728                         (outs GR8:$dst, GR16:$base_wb),
729                         (ins GR8:$src1, GR16:$base),
730                         "xor.b\t{@$base+, $dst}", []>;
731def XOR16rm_POST : IForm16<0x0, DstReg, SrcPostInc, Size2Bytes,
732                           (outs GR16:$dst, GR16:$base_wb),
733                           (ins GR16:$src1, GR16:$base),
734                           "xor.w\t{@$base+, $dst}", []>;
735}
736
737let isTwoAddress = 0 in {
738def XOR8mr  : I8mr<0x0,
739                   (outs), (ins memdst:$dst, GR8:$src),
740                   "xor.b\t{$src, $dst}",
741                   [(store (xor (load addr:$dst), GR8:$src), addr:$dst),
742                    (implicit SRW)]>;
743def XOR16mr : I16mr<0x0,
744                    (outs), (ins memdst:$dst, GR16:$src),
745                    "xor.w\t{$src, $dst}",
746                    [(store (xor (load addr:$dst), GR16:$src), addr:$dst),
747                     (implicit SRW)]>;
748
749def XOR8mi  : I8mi<0x0,
750                   (outs), (ins memdst:$dst, i8imm:$src),
751                   "xor.b\t{$src, $dst}",
752                   [(store (xor (load addr:$dst), (i8 imm:$src)), addr:$dst),
753                    (implicit SRW)]>;
754def XOR16mi : I16mi<0x0,
755                    (outs), (ins memdst:$dst, i16imm:$src),
756                    "xor.w\t{$src, $dst}",
757                    [(store (xor (load addr:$dst), (i16 imm:$src)), addr:$dst),
758                     (implicit SRW)]>;
759
760def XOR8mm  : I8mm<0x0,
761                   (outs), (ins memdst:$dst, memsrc:$src),
762                   "xor.b\t{$src, $dst}",
763                   [(store (xor (load addr:$dst), (i8 (load addr:$src))), addr:$dst),
764                    (implicit SRW)]>;
765def XOR16mm : I16mm<0x0,
766                    (outs), (ins memdst:$dst, memsrc:$src),
767                    "xor.w\t{$src, $dst}",
768                    [(store (xor (load addr:$dst), (i16 (load addr:$src))), addr:$dst),
769                     (implicit SRW)]>;
770}
771
772
773def SUB8rr  : I8rr<0x0,
774                   (outs GR8:$dst), (ins GR8:$src1, GR8:$src2),
775                   "sub.b\t{$src2, $dst}",
776                   [(set GR8:$dst, (sub GR8:$src1, GR8:$src2)),
777                    (implicit SRW)]>;
778def SUB16rr : I16rr<0x0,
779                    (outs GR16:$dst), (ins GR16:$src1, GR16:$src2),
780                    "sub.w\t{$src2, $dst}",
781                    [(set GR16:$dst, (sub GR16:$src1, GR16:$src2)),
782                     (implicit SRW)]>;
783
784def SUB8ri  : I8ri<0x0,
785                   (outs GR8:$dst), (ins GR8:$src1, i8imm:$src2),
786                   "sub.b\t{$src2, $dst}",
787                   [(set GR8:$dst, (sub GR8:$src1, imm:$src2)),
788                    (implicit SRW)]>;
789def SUB16ri : I16ri<0x0,
790                    (outs GR16:$dst), (ins GR16:$src1, i16imm:$src2),
791                    "sub.w\t{$src2, $dst}",
792                    [(set GR16:$dst, (sub GR16:$src1, imm:$src2)),
793                     (implicit SRW)]>;
794
795def SUB8rm  : I8rm<0x0,
796                   (outs GR8:$dst), (ins GR8:$src1, memsrc:$src2),
797                   "sub.b\t{$src2, $dst}",
798                   [(set GR8:$dst, (sub GR8:$src1, (load addr:$src2))),
799                    (implicit SRW)]>;
800def SUB16rm : I16rm<0x0,
801                    (outs GR16:$dst), (ins GR16:$src1, memsrc:$src2),
802                    "sub.w\t{$src2, $dst}",
803                    [(set GR16:$dst, (sub GR16:$src1, (load addr:$src2))),
804                     (implicit SRW)]>;
805
806let mayLoad = 1, hasExtraDefRegAllocReq = 1, 
807Constraints = "$base = $base_wb, $src1 = $dst" in {
808def SUB8rm_POST : IForm8<0x0, DstReg, SrcPostInc, Size2Bytes,
809                         (outs GR8:$dst, GR16:$base_wb),
810                         (ins GR8:$src1, GR16:$base),
811                         "sub.b\t{@$base+, $dst}", []>;
812def SUB16rm_POST : IForm16<0x0, DstReg, SrcPostInc, Size2Bytes,
813                          (outs GR16:$dst, GR16:$base_wb),
814                          (ins GR16:$src1, GR16:$base),
815                          "sub.w\t{@$base+, $dst}", []>;
816}
817
818let isTwoAddress = 0 in {
819def SUB8mr  : I8mr<0x0,
820                   (outs), (ins memdst:$dst, GR8:$src),
821                   "sub.b\t{$src, $dst}",
822                   [(store (sub (load addr:$dst), GR8:$src), addr:$dst),
823                    (implicit SRW)]>;
824def SUB16mr : I16mr<0x0,
825                    (outs), (ins memdst:$dst, GR16:$src),
826                    "sub.w\t{$src, $dst}",
827                    [(store (sub (load addr:$dst), GR16:$src), addr:$dst),
828                     (implicit SRW)]>;
829
830def SUB8mi  : I8mi<0x0,
831                   (outs), (ins memdst:$dst, i8imm:$src),
832                   "sub.b\t{$src, $dst}",
833                   [(store (sub (load addr:$dst), (i8 imm:$src)), addr:$dst),
834                    (implicit SRW)]>;
835def SUB16mi : I16mi<0x0,
836                    (outs), (ins memdst:$dst, i16imm:$src),
837                    "sub.w\t{$src, $dst}",
838                    [(store (sub (load addr:$dst), (i16 imm:$src)), addr:$dst),
839                     (implicit SRW)]>;
840
841def SUB8mm  : I8mm<0x0,
842                   (outs), (ins memdst:$dst, memsrc:$src),
843                   "sub.b\t{$src, $dst}",
844                   [(store (sub (load addr:$dst), 
845                                (i8 (load addr:$src))), addr:$dst),
846                    (implicit SRW)]>;
847def SUB16mm : I16mm<0x0,
848                    (outs), (ins memdst:$dst, memsrc:$src),
849                    "sub.w\t{$src, $dst}",
850                    [(store (sub (load addr:$dst), 
851                                 (i16 (load addr:$src))), addr:$dst),
852                     (implicit SRW)]>;
853}
854
855let Uses = [SRW] in {
856def SBC8rr  : I8rr<0x0,
857                   (outs GR8:$dst), (ins GR8:$src1, GR8:$src2),
858                   "subc.b\t{$src2, $dst}",
859                   [(set GR8:$dst, (sube GR8:$src1, GR8:$src2)),
860                    (implicit SRW)]>;
861def SBC16rr : I16rr<0x0,
862                    (outs GR16:$dst), (ins GR16:$src1, GR16:$src2),
863                    "subc.w\t{$src2, $dst}",
864                    [(set GR16:$dst, (sube GR16:$src1, GR16:$src2)),
865                     (implicit SRW)]>;
866
867def SBC8ri  : I8ri<0x0,
868                   (outs GR8:$dst), (ins GR8:$src1, i8imm:$src2),
869                   "subc.b\t{$src2, $dst}",
870                   [(set GR8:$dst, (sube GR8:$src1, imm:$src2)),
871                    (implicit SRW)]>;
872def SBC16ri : I16ri<0x0,
873                    (outs GR16:$dst), (ins GR16:$src1, i16imm:$src2),
874                    "subc.w\t{$src2, $dst}",
875                    [(set GR16:$dst, (sube GR16:$src1, imm:$src2)),
876                     (implicit SRW)]>;
877
878def SBC8rm  : I8rm<0x0,
879                   (outs GR8:$dst), (ins GR8:$src1, memsrc:$src2),
880                   "subc.b\t{$src2, $dst}",
881                   [(set GR8:$dst, (sube GR8:$src1, (load addr:$src2))),
882                    (implicit SRW)]>;
883def SBC16rm : I16rm<0x0,
884                    (outs GR16:$dst), (ins GR16:$src1, memsrc:$src2),
885                    "subc.w\t{$src2, $dst}",
886                    [(set GR16:$dst, (sube GR16:$src1, (load addr:$src2))),
887                     (implicit SRW)]>;
888
889let isTwoAddress = 0 in {
890def SBC8mr  : I8mr<0x0,
891                   (outs), (ins memdst:$dst, GR8:$src),
892                   "subc.b\t{$src, $dst}",
893                  [(store (sube (load addr:$dst), GR8:$src), addr:$dst),
894                   (implicit SRW)]>;
895def SBC16mr : I16mr<0x0,
896                    (outs), (ins memdst:$dst, GR16:$src),
897                    "subc.w\t{$src, $dst}",
898                    [(store (sube (load addr:$dst), GR16:$src), addr:$dst),
899                     (implicit SRW)]>;
900
901def SBC8mi  : I8mi<0x0,
902                   (outs), (ins memdst:$dst, i8imm:$src),
903                   "subc.b\t{$src, $dst}",
904                   [(store (sube (load addr:$dst), (i8 imm:$src)), addr:$dst),
905                    (implicit SRW)]>;
906def SBC16mi : I16mi<0x0,
907                    (outs), (ins memdst:$dst, i16imm:$src),
908                    "subc.w\t{$src, $dst}",
909                    [(store (sube (load addr:$dst), (i16 imm:$src)), addr:$dst),
910                     (implicit SRW)]>;
911
912def SBC8mm  : I8mm<0x0,
913                   (outs), (ins memdst:$dst, memsrc:$src),
914                   "subc.b\t{$src, $dst}",
915                   [(store (sube (load addr:$dst),
916                                 (i8 (load addr:$src))), addr:$dst),
917                    (implicit SRW)]>;
918def SBC16mm : I16mm<0x0,
919                    (outs), (ins memdst:$dst, memsrc:$src),
920                    "subc.w\t{$src, $dst}",
921                    [(store (sube (load addr:$dst),
922                            (i16 (load addr:$src))), addr:$dst),
923                     (implicit SRW)]>;
924}
925
926} // Uses = [SRW]
927
928// FIXME: memory variant!
929def SAR8r1  : II8r<0x0,
930                   (outs GR8:$dst), (ins GR8:$src),
931                   "rra.b\t$dst",
932                   [(set GR8:$dst, (MSP430rra GR8:$src)),
933                    (implicit SRW)]>;
934def SAR16r1 : II16r<0x0,
935                    (outs GR16:$dst), (ins GR16:$src),
936                    "rra.w\t$dst",
937                    [(set GR16:$dst, (MSP430rra GR16:$src)),
938                     (implicit SRW)]>;
939
940def SHL8r1  : I8rr<0x0,
941                   (outs GR8:$dst), (ins GR8:$src),
942                   "rla.b\t$dst",
943                   [(set GR8:$dst, (MSP430rla GR8:$src)),
944                    (implicit SRW)]>;
945def SHL16r1 : I16rr<0x0,
946                    (outs GR16:$dst), (ins GR16:$src),
947                    "rla.w\t$dst",
948                    [(set GR16:$dst, (MSP430rla GR16:$src)),
949                     (implicit SRW)]>;
950
951def SAR8r1c  : Pseudo<(outs GR8:$dst), (ins GR8:$src),
952                      "clrc\n\t"
953                      "rrc.b\t$dst",
954                      [(set GR8:$dst, (MSP430rrc GR8:$src)),
955                       (implicit SRW)]>;
956def SAR16r1c : Pseudo<(outs GR16:$dst), (ins GR16:$src),
957                      "clrc\n\t"
958                      "rrc.w\t$dst",
959                      [(set GR16:$dst, (MSP430rrc GR16:$src)),
960                       (implicit SRW)]>;
961
962// FIXME: Memory sext's ?
963def SEXT16r : II16r<0x0,
964                    (outs GR16:$dst), (ins GR16:$src),
965                    "sxt\t$dst",
966                    [(set GR16:$dst, (sext_inreg GR16:$src, i8)),
967                     (implicit SRW)]>;
968
969} // Defs = [SRW]
970
971def ZEXT16r : I8rr<0x0,
972                   (outs GR16:$dst), (ins GR16:$src),
973                   "mov.b\t{$src, $dst}",
974                   [(set GR16:$dst, (zext (trunc GR16:$src)))]>;
975
976// FIXME: Memory bitswaps?
977def SWPB16r : II16r<0x0,
978                    (outs GR16:$dst), (ins GR16:$src),
979                    "swpb\t$dst",
980                    [(set GR16:$dst, (bswap GR16:$src))]>;
981
982} // isTwoAddress = 1
983
984// Integer comparisons
985let Defs = [SRW] in {
986def CMP8rr  : I8rr<0x0,
987                   (outs), (ins GR8:$src1, GR8:$src2),
988                   "cmp.b\t{$src2, $src1}",
989                   [(MSP430cmp GR8:$src1, GR8:$src2), (implicit SRW)]>;
990def CMP16rr : I16rr<0x0,
991                    (outs), (ins GR16:$src1, GR16:$src2),
992                    "cmp.w\t{$src2, $src1}",
993                    [(MSP430cmp GR16:$src1, GR16:$src2), (implicit SRW)]>;
994
995def CMP8ri  : I8ri<0x0,
996                   (outs), (ins GR8:$src1, i8imm:$src2),
997                   "cmp.b\t{$src2, $src1}",
998                   [(MSP430cmp GR8:$src1, imm:$src2), (implicit SRW)]>;
999def CMP16ri : I16ri<0x0,
1000                    (outs), (ins GR16:$src1, i16imm:$src2),
1001                    "cmp.w\t{$src2, $src1}",
1002                    [(MSP430cmp GR16:$src1, imm:$src2), (implicit SRW)]>;
1003
1004def CMP8mi  : I8mi<0x0,
1005                   (outs), (ins memsrc:$src1, i8imm:$src2),
1006                   "cmp.b\t{$src2, $src1}",
1007                   [(MSP430cmp (load addr:$src1),
1008                               (i8 imm:$src2)), (implicit SRW)]>;
1009def CMP16mi : I16mi<0x0,
1010                    (outs), (ins memsrc:$src1, i16imm:$src2),
1011                    "cmp.w\t{$src2, $src1}",
1012                     [(MSP430cmp (load addr:$src1),
1013                                 (i16 imm:$src2)), (implicit SRW)]>;
1014
1015def CMP8rm  : I8rm<0x0,
1016                   (outs), (ins GR8:$src1, memsrc:$src2),
1017                   "cmp.b\t{$src2, $src1}",
1018                   [(MSP430cmp GR8:$src1, (load addr:$src2)), 
1019                    (implicit SRW)]>;
1020def CMP16rm : I16rm<0x0,
1021                    (outs), (ins GR16:$src1, memsrc:$src2),
1022                    "cmp.w\t{$src2, $src1}",
1023                    [(MSP430cmp GR16:$src1, (load addr:$src2)),
1024                     (implicit SRW)]>;
1025
1026def CMP8mr  : I8mr<0x0,
1027                   (outs), (ins memsrc:$src1, GR8:$src2),
1028                   "cmp.b\t{$src2, $src1}",
1029                   [(MSP430cmp (load addr:$src1), GR8:$src2),
1030                    (implicit SRW)]>;
1031def CMP16mr : I16mr<0x0,
1032                    (outs), (ins memsrc:$src1, GR16:$src2),
1033                    "cmp.w\t{$src2, $src1}",
1034                    [(MSP430cmp (load addr:$src1), GR16:$src2), 
1035                     (implicit SRW)]>;
1036
1037
1038// BIT TESTS, just sets condition codes
1039// Note that the C condition is set differently than when using CMP.
1040let isCommutable = 1 in {
1041def BIT8rr  : I8rr<0x0,
1042                   (outs), (ins GR8:$src1, GR8:$src2),
1043                   "bit.b\t{$src2, $src1}",
1044                   [(MSP430cmp (and_su GR8:$src1, GR8:$src2), 0),
1045                    (implicit SRW)]>;
1046def BIT16rr : I16rr<0x0,
1047                    (outs), (ins GR16:$src1, GR16:$src2),
1048                    "bit.w\t{$src2, $src1}",
1049                    [(MSP430cmp (and_su GR16:$src1, GR16:$src2), 0),
1050                     (implicit SRW)]>;
1051}
1052def BIT8ri  : I8ri<0x0,
1053                   (outs), (ins GR8:$src1, i8imm:$src2),
1054                   "bit.b\t{$src2, $src1}",
1055                   [(MSP430cmp (and_su GR8:$src1, imm:$src2), 0),
1056                    (implicit SRW)]>;
1057def BIT16ri : I16ri<0x0,
1058                    (outs), (ins GR16:$src1, i16imm:$src2),
1059                    "bit.w\t{$src2, $src1}",
1060                    [(MSP430cmp (and_su GR16:$src1, imm:$src2), 0),
1061                     (implicit SRW)]>;
1062
1063def BIT8rm  : I8rm<0x0,
1064                   (outs), (ins GR8:$src1, memdst:$src2),
1065                   "bit.b\t{$src2, $src1}",
1066                   [(MSP430cmp (and_su GR8:$src1,  (load addr:$src2)), 0),
1067                    (implicit SRW)]>;
1068def BIT16rm : I16rm<0x0,
1069                    (outs), (ins GR16:$src1, memdst:$src2),
1070                    "bit.w\t{$src2, $src1}",
1071                    [(MSP430cmp (and_su GR16:$src1,  (load addr:$src2)), 0),
1072                     (implicit SRW)]>;
1073
1074def BIT8mr  : I8mr<0x0,
1075                  (outs), (ins memsrc:$src1, GR8:$src2),
1076                  "bit.b\t{$src2, $src1}",
1077                  [(MSP430cmp (and_su (load addr:$src1), GR8:$src2), 0),
1078                   (implicit SRW)]>;
1079def BIT16mr : I16mr<0x0,
1080                    (outs), (ins memsrc:$src1, GR16:$src2),
1081                    "bit.w\t{$src2, $src1}",
1082                    [(MSP430cmp (and_su (load addr:$src1), GR16:$src2), 0),
1083                     (implicit SRW)]>;
1084
1085def BIT8mi  : I8mi<0x0,
1086                   (outs), (ins memsrc:$src1, i8imm:$src2),
1087                   "bit.b\t{$src2, $src1}",
1088                   [(MSP430cmp (and_su (load addr:$src1), (i8 imm:$src2)), 0),
1089                    (implicit SRW)]>;
1090def BIT16mi : I16mi<0x0,
1091                    (outs), (ins memsrc:$src1, i16imm:$src2),
1092                    "bit.w\t{$src2, $src1}",
1093                    [(MSP430cmp (and_su (load addr:$src1), (i16 imm:$src2)), 0),
1094                     (implicit SRW)]>;
1095
1096def BIT8mm  : I8mm<0x0,
1097                   (outs), (ins memsrc:$src1, memsrc:$src2),
1098                   "bit.b\t{$src2, $src1}",
1099                   [(MSP430cmp (and_su (i8 (load addr:$src1)),
1100                                       (load addr:$src2)),
1101                                 0),
1102                      (implicit SRW)]>;
1103def BIT16mm : I16mm<0x0,
1104                    (outs), (ins memsrc:$src1, memsrc:$src2),
1105                    "bit.w\t{$src2, $src1}",
1106                    [(MSP430cmp (and_su (i16 (load addr:$src1)),
1107                                        (load addr:$src2)),
1108                                 0),
1109                     (implicit SRW)]>;
1110} // Defs = [SRW]
1111
1112//===----------------------------------------------------------------------===//
1113// Non-Instruction Patterns
1114
1115// extload
1116def : Pat<(extloadi16i8 addr:$src), (MOVZX16rm8 addr:$src)>;
1117
1118// anyext
1119def : Pat<(i16 (anyext GR8:$src)),
1120          (SUBREG_TO_REG (i16 0), GR8:$src, subreg_8bit)>;
1121
1122// truncs
1123def : Pat<(i8 (trunc GR16:$src)),
1124          (EXTRACT_SUBREG GR16:$src, subreg_8bit)>;
1125
1126// GlobalAddress, ExternalSymbol
1127def : Pat<(i16 (MSP430Wrapper tglobaladdr:$dst)), (MOV16ri tglobaladdr:$dst)>;
1128def : Pat<(i16 (MSP430Wrapper texternalsym:$dst)), (MOV16ri texternalsym:$dst)>;
1129
1130def : Pat<(add GR16:$src1, (MSP430Wrapper tglobaladdr :$src2)),
1131          (ADD16ri GR16:$src1, tglobaladdr:$src2)>;
1132def : Pat<(add GR16:$src1, (MSP430Wrapper texternalsym:$src2)),
1133          (ADD16ri GR16:$src1, texternalsym:$src2)>;
1134
1135def : Pat<(store (i16 (MSP430Wrapper tglobaladdr:$src)), addr:$dst),
1136          (MOV16mi addr:$dst, tglobaladdr:$src)>;
1137def : Pat<(store (i16 (MSP430Wrapper texternalsym:$src)), addr:$dst),
1138          (MOV16mi addr:$dst, texternalsym:$src)>;
1139
1140// calls
1141def : Pat<(MSP430call (i16 tglobaladdr:$dst)),
1142          (CALLi tglobaladdr:$dst)>;
1143def : Pat<(MSP430call (i16 texternalsym:$dst)),
1144          (CALLi texternalsym:$dst)>;
1145
1146// add and sub always produce carry
1147def : Pat<(addc GR16:$src1, GR16:$src2),
1148          (ADD16rr GR16:$src1, GR16:$src2)>;
1149def : Pat<(addc GR16:$src1, (load addr:$src2)),
1150          (ADD16rm GR16:$src1, addr:$src2)>;
1151def : Pat<(addc GR16:$src1, imm:$src2),
1152          (ADD16ri GR16:$src1, imm:$src2)>;
1153def : Pat<(store (addc (load addr:$dst), GR16:$src), addr:$dst),
1154          (ADD16mr addr:$dst, GR16:$src)>;
1155def : Pat<(store (addc (load addr:$dst), (i16 (load addr:$src))), addr:$dst),
1156          (ADD16mm addr:$dst, addr:$src)>;
1157
1158def : Pat<(addc GR8:$src1, GR8:$src2),
1159          (ADD8rr GR8:$src1, GR8:$src2)>;
1160def : Pat<(addc GR8:$src1, (load addr:$src2)),
1161          (ADD8rm GR8:$src1, addr:$src2)>;
1162def : Pat<(addc GR8:$src1, imm:$src2),
1163          (ADD8ri GR8:$src1, imm:$src2)>;
1164def : Pat<(store (addc (load addr:$dst), GR8:$src), addr:$dst),
1165          (ADD8mr addr:$dst, GR8:$src)>;
1166def : Pat<(store (addc (load addr:$dst), (i8 (load addr:$src))), addr:$dst),
1167          (ADD8mm addr:$dst, addr:$src)>;
1168
1169def : Pat<(subc GR16:$src1, GR16:$src2),
1170          (SUB16rr GR16:$src1, GR16:$src2)>;
1171def : Pat<(subc GR16:$src1, (load addr:$src2)),
1172          (SUB16rm GR16:$src1, addr:$src2)>;
1173def : Pat<(subc GR16:$src1, imm:$src2),
1174          (SUB16ri GR16:$src1, imm:$src2)>;
1175def : Pat<(store (subc (load addr:$dst), GR16:$src), addr:$dst),
1176          (SUB16mr addr:$dst, GR16:$src)>;
1177def : Pat<(store (subc (load addr:$dst), (i16 (load addr:$src))), addr:$dst),
1178          (SUB16mm addr:$dst, addr:$src)>;
1179
1180def : Pat<(subc GR8:$src1, GR8:$src2),
1181          (SUB8rr GR8:$src1, GR8:$src2)>;
1182def : Pat<(subc GR8:$src1, (load addr:$src2)),
1183          (SUB8rm GR8:$src1, addr:$src2)>;
1184def : Pat<(subc GR8:$src1, imm:$src2),
1185          (SUB8ri GR8:$src1, imm:$src2)>;
1186def : Pat<(store (subc (load addr:$dst), GR8:$src), addr:$dst),
1187          (SUB8mr addr:$dst, GR8:$src)>;
1188def : Pat<(store (subc (load addr:$dst), (i8 (load addr:$src))), addr:$dst),
1189          (SUB8mm addr:$dst, addr:$src)>;
1190
1191// peephole patterns
1192def : Pat<(and GR16:$src, 255), (ZEXT16r GR16:$src)>;
1193def : Pat<(MSP430cmp (trunc (and_su GR16:$src1, GR16:$src2)), 0),
1194          (BIT8rr (EXTRACT_SUBREG GR16:$src1, subreg_8bit),
1195                  (EXTRACT_SUBREG GR16:$src2, subreg_8bit))>;
1196