1;;- Machine description for ARM for GNU compiler
2;;  Copyright (C) 1991-2015 Free Software Foundation, Inc.
3;;  Contributed by Pieter `Tiggr' Schoenmakers (rcpieter@win.tue.nl)
4;;  and Martin Simmons (@harleqn.co.uk).
5;;  More major hacks by Richard Earnshaw (rearnsha@arm.com).
6
7;; This file is part of GCC.
8
9;; GCC is free software; you can redistribute it and/or modify it
10;; under the terms of the GNU General Public License as published
11;; by the Free Software Foundation; either version 3, or (at your
12;; option) any later version.
13
14;; GCC is distributed in the hope that it will be useful, but WITHOUT
15;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
16;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
17;; License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GCC; see the file COPYING3.  If not see
21;; <http://www.gnu.org/licenses/>.
22
23;;- See file "rtl.def" for documentation on define_insn, match_*, et. al.
24
25
26;;---------------------------------------------------------------------------
27;; Constants
28
29;; Register numbers -- All machine registers should be defined here
30(define_constants
31  [(R0_REGNUM         0)	; First CORE register
32   (R1_REGNUM	      1)	; Second CORE register
33   (IP_REGNUM	     12)	; Scratch register
34   (SP_REGNUM	     13)	; Stack pointer
35   (LR_REGNUM        14)	; Return address register
36   (PC_REGNUM	     15)	; Program counter
37   (LAST_ARM_REGNUM  15)	;
38   (CC_REGNUM       100)	; Condition code pseudo register
39   (VFPCC_REGNUM    101)	; VFP Condition code pseudo register
40  ]
41)
42;; 3rd operand to select_dominance_cc_mode
43(define_constants
44  [(DOM_CC_X_AND_Y  0)
45   (DOM_CC_NX_OR_Y  1)
46   (DOM_CC_X_OR_Y   2)
47  ]
48)
49;; conditional compare combination
50(define_constants
51  [(CMP_CMP 0)
52   (CMN_CMP 1)
53   (CMP_CMN 2)
54   (CMN_CMN 3)
55   (NUM_OF_COND_CMP 4)
56  ]
57)
58
59
60;;---------------------------------------------------------------------------
61;; Attributes
62
63;; Processor type.  This is created automatically from arm-cores.def.
64(include "arm-tune.md")
65
66;; Instruction classification types
67(include "types.md")
68
69; IS_THUMB is set to 'yes' when we are generating Thumb code, and 'no' when
70; generating ARM code.  This is used to control the length of some insn
71; patterns that share the same RTL in both ARM and Thumb code.
72(define_attr "is_thumb" "no,yes" (const (symbol_ref "thumb_code")))
73
74; IS_ARCH6 is set to 'yes' when we are generating code form ARMv6.
75(define_attr "is_arch6" "no,yes" (const (symbol_ref "arm_arch6")))
76
77; IS_THUMB1 is set to 'yes' iff we are generating Thumb-1 code.
78(define_attr "is_thumb1" "no,yes" (const (symbol_ref "thumb1_code")))
79
80; We use this attribute to disable alternatives that can produce 32-bit
81; instructions inside an IT-block in Thumb2 state.  ARMv8 deprecates IT blocks
82; that contain 32-bit instructions.
83(define_attr "enabled_for_depr_it" "no,yes" (const_string "yes"))
84
85; This attribute is used to disable a predicated alternative when we have
86; arm_restrict_it.
87(define_attr "predicable_short_it" "no,yes" (const_string "yes"))
88
89;; Operand number of an input operand that is shifted.  Zero if the
90;; given instruction does not shift one of its input operands.
91(define_attr "shift" "" (const_int 0))
92
93;; [For compatibility with AArch64 in pipeline models]
94;; Attribute that specifies whether or not the instruction touches fp
95;; registers.
96(define_attr "fp" "no,yes" (const_string "no"))
97
98; Floating Point Unit.  If we only have floating point emulation, then there
99; is no point in scheduling the floating point insns.  (Well, for best
100; performance we should try and group them together).
101(define_attr "fpu" "none,vfp"
102  (const (symbol_ref "arm_fpu_attr")))
103
104(define_attr "predicated" "yes,no" (const_string "no"))
105
106; LENGTH of an instruction (in bytes)
107(define_attr "length" ""
108  (const_int 4))
109
110; The architecture which supports the instruction (or alternative).
111; This can be "a" for ARM, "t" for either of the Thumbs, "32" for
112; TARGET_32BIT, "t1" or "t2" to specify a specific Thumb mode.  "v6"
113; for ARM or Thumb-2 with arm_arch6, and nov6 for ARM without
114; arm_arch6.  "v6t2" for Thumb-2 with arm_arch6.  This attribute is
115; used to compute attribute "enabled", use type "any" to enable an
116; alternative in all cases.
117(define_attr "arch" "any,a,t,32,t1,t2,v6,nov6,v6t2,neon_for_64bits,avoid_neon_for_64bits,iwmmxt,iwmmxt2,armv6_or_vfpv3"
118  (const_string "any"))
119
120(define_attr "arch_enabled" "no,yes"
121  (cond [(eq_attr "arch" "any")
122	 (const_string "yes")
123
124	 (and (eq_attr "arch" "a")
125	      (match_test "TARGET_ARM"))
126	 (const_string "yes")
127
128	 (and (eq_attr "arch" "t")
129	      (match_test "TARGET_THUMB"))
130	 (const_string "yes")
131
132	 (and (eq_attr "arch" "t1")
133	      (match_test "TARGET_THUMB1"))
134	 (const_string "yes")
135
136	 (and (eq_attr "arch" "t2")
137	      (match_test "TARGET_THUMB2"))
138	 (const_string "yes")
139
140	 (and (eq_attr "arch" "32")
141	      (match_test "TARGET_32BIT"))
142	 (const_string "yes")
143
144	 (and (eq_attr "arch" "v6")
145	      (match_test "TARGET_32BIT && arm_arch6"))
146	 (const_string "yes")
147
148	 (and (eq_attr "arch" "nov6")
149	      (match_test "TARGET_32BIT && !arm_arch6"))
150	 (const_string "yes")
151
152	 (and (eq_attr "arch" "v6t2")
153	      (match_test "TARGET_32BIT && arm_arch6 && arm_arch_thumb2"))
154	 (const_string "yes")
155
156	 (and (eq_attr "arch" "avoid_neon_for_64bits")
157	      (match_test "TARGET_NEON")
158	      (not (match_test "TARGET_PREFER_NEON_64BITS")))
159	 (const_string "yes")
160
161	 (and (eq_attr "arch" "neon_for_64bits")
162	      (match_test "TARGET_NEON")
163	      (match_test "TARGET_PREFER_NEON_64BITS"))
164	 (const_string "yes")
165
166	 (and (eq_attr "arch" "iwmmxt2")
167	      (match_test "TARGET_REALLY_IWMMXT2"))
168	 (const_string "yes")
169
170	 (and (eq_attr "arch" "armv6_or_vfpv3")
171	      (match_test "arm_arch6 || TARGET_VFP3"))
172	 (const_string "yes")
173	]
174
175	(const_string "no")))
176
177(define_attr "opt" "any,speed,size"
178  (const_string "any"))
179
180(define_attr "opt_enabled" "no,yes"
181  (cond [(eq_attr "opt" "any")
182         (const_string "yes")
183
184	 (and (eq_attr "opt" "speed")
185	      (match_test "optimize_function_for_speed_p (cfun)"))
186	 (const_string "yes")
187
188	 (and (eq_attr "opt" "size")
189	      (match_test "optimize_function_for_size_p (cfun)"))
190	 (const_string "yes")]
191	(const_string "no")))
192
193(define_attr "use_literal_pool" "no,yes"
194   (cond [(and (eq_attr "type" "f_loads,f_loadd")
195	       (match_test "CONSTANT_P (operands[1])"))
196	  (const_string "yes")]
197	 (const_string "no")))
198
199; Enable all alternatives that are both arch_enabled and insn_enabled.
200; FIXME:: opt_enabled has been temporarily removed till the time we have
201; an attribute that allows the use of such alternatives.
202; This depends on caching of speed_p, size_p on a per
203; alternative basis. The problem is that the enabled attribute
204; cannot depend on any state that is not cached or is not constant
205; for a compilation unit. We probably need a generic "hot/cold"
206; alternative which if implemented can help with this. We disable this
207; until such a time as this is implemented and / or the improvements or
208; regressions with removing this attribute are double checked.
209; See ashldi3_neon and <shift>di3_neon in neon.md.
210
211 (define_attr "enabled" "no,yes"
212   (cond [(and (eq_attr "predicable_short_it" "no")
213	       (and (eq_attr "predicated" "yes")
214	            (match_test "arm_restrict_it")))
215	  (const_string "no")
216
217	  (and (eq_attr "enabled_for_depr_it" "no")
218	       (match_test "arm_restrict_it"))
219	  (const_string "no")
220
221	  (and (eq_attr "use_literal_pool" "yes")
222	       (match_test "arm_disable_literal_pool"))
223	  (const_string "no")
224
225	  (eq_attr "arch_enabled" "no")
226	  (const_string "no")]
227	 (const_string "yes")))
228
229; POOL_RANGE is how far away from a constant pool entry that this insn
230; can be placed.  If the distance is zero, then this insn will never
231; reference the pool.
232; Note that for Thumb constant pools the PC value is rounded down to the
233; nearest multiple of four.  Therefore, THUMB2_POOL_RANGE (and POOL_RANGE for
234; Thumb insns) should be set to <max_range> - 2.
235; NEG_POOL_RANGE is nonzero for insns that can reference a constant pool entry
236; before its address.  It is set to <max_range> - (8 + <data_size>).
237(define_attr "arm_pool_range" "" (const_int 0))
238(define_attr "thumb2_pool_range" "" (const_int 0))
239(define_attr "arm_neg_pool_range" "" (const_int 0))
240(define_attr "thumb2_neg_pool_range" "" (const_int 0))
241
242(define_attr "pool_range" ""
243  (cond [(eq_attr "is_thumb" "yes") (attr "thumb2_pool_range")]
244	(attr "arm_pool_range")))
245(define_attr "neg_pool_range" ""
246  (cond [(eq_attr "is_thumb" "yes") (attr "thumb2_neg_pool_range")]
247	(attr "arm_neg_pool_range")))
248
249; An assembler sequence may clobber the condition codes without us knowing.
250; If such an insn references the pool, then we have no way of knowing how,
251; so use the most conservative value for pool_range.
252(define_asm_attributes
253 [(set_attr "conds" "clob")
254  (set_attr "length" "4")
255  (set_attr "pool_range" "250")])
256
257; Load scheduling, set from the arm_ld_sched variable
258; initialized by arm_option_override()
259(define_attr "ldsched" "no,yes" (const (symbol_ref "arm_ld_sched")))
260
261; condition codes: this one is used by final_prescan_insn to speed up
262; conditionalizing instructions.  It saves having to scan the rtl to see if
263; it uses or alters the condition codes.
264; 
265; USE means that the condition codes are used by the insn in the process of
266;   outputting code, this means (at present) that we can't use the insn in
267;   inlined branches
268;
269; SET means that the purpose of the insn is to set the condition codes in a
270;   well defined manner.
271;
272; CLOB means that the condition codes are altered in an undefined manner, if
273;   they are altered at all
274;
275; UNCONDITIONAL means the instruction can not be conditionally executed and
276;   that the instruction does not use or alter the condition codes.
277;
278; NOCOND means that the instruction does not use or alter the condition
279;   codes but can be converted into a conditionally exectuted instruction.
280
281(define_attr "conds" "use,set,clob,unconditional,nocond"
282	(if_then_else
283	 (ior (eq_attr "is_thumb1" "yes")
284	      (eq_attr "type" "call"))
285	 (const_string "clob")
286	 (if_then_else (eq_attr "is_neon_type" "no")
287	 (const_string "nocond")
288	 (const_string "unconditional"))))
289
290; Predicable means that the insn can be conditionally executed based on
291; an automatically added predicate (additional patterns are generated by 
292; gen...).  We default to 'no' because no Thumb patterns match this rule
293; and not all ARM patterns do.
294(define_attr "predicable" "no,yes" (const_string "no"))
295
296; Only model the write buffer for ARM6 and ARM7.  Earlier processors don't
297; have one.  Later ones, such as StrongARM, have write-back caches, so don't
298; suffer blockages enough to warrant modelling this (and it can adversely
299; affect the schedule).
300(define_attr "model_wbuf" "no,yes" (const (symbol_ref "arm_tune_wbuf")))
301
302; WRITE_CONFLICT implies that a read following an unrelated write is likely
303; to stall the processor.  Used with model_wbuf above.
304(define_attr "write_conflict" "no,yes"
305  (if_then_else (eq_attr "type"
306		 "block,call,load1")
307		(const_string "yes")
308		(const_string "no")))
309
310; Classify the insns into those that take one cycle and those that take more
311; than one on the main cpu execution unit.
312(define_attr "core_cycles" "single,multi"
313  (if_then_else (eq_attr "type"
314    "adc_imm, adc_reg, adcs_imm, adcs_reg, adr, alu_ext, alu_imm, alu_sreg,\
315    alu_shift_imm, alu_shift_reg, alu_dsp_reg, alus_ext, alus_imm, alus_sreg,\
316    alus_shift_imm, alus_shift_reg, bfm, csel, rev, logic_imm, logic_reg,\
317    logic_shift_imm, logic_shift_reg, logics_imm, logics_reg,\
318    logics_shift_imm, logics_shift_reg, extend, shift_imm, float, fcsel,\
319    wmmx_wor, wmmx_wxor, wmmx_wand, wmmx_wandn, wmmx_wmov, wmmx_tmcrr,\
320    wmmx_tmrrc, wmmx_wldr, wmmx_wstr, wmmx_tmcr, wmmx_tmrc, wmmx_wadd,\
321    wmmx_wsub, wmmx_wmul, wmmx_wmac, wmmx_wavg2, wmmx_tinsr, wmmx_textrm,\
322    wmmx_wshufh, wmmx_wcmpeq, wmmx_wcmpgt, wmmx_wmax, wmmx_wmin, wmmx_wpack,\
323    wmmx_wunpckih, wmmx_wunpckil, wmmx_wunpckeh, wmmx_wunpckel, wmmx_wror,\
324    wmmx_wsra, wmmx_wsrl, wmmx_wsll, wmmx_wmadd, wmmx_tmia, wmmx_tmiaph,\
325    wmmx_tmiaxy, wmmx_tbcst, wmmx_tmovmsk, wmmx_wacc, wmmx_waligni,\
326    wmmx_walignr, wmmx_tandc, wmmx_textrc, wmmx_torc, wmmx_torvsc, wmmx_wsad,\
327    wmmx_wabs, wmmx_wabsdiff, wmmx_waddsubhx, wmmx_wsubaddhx, wmmx_wavg4,\
328    wmmx_wmulw, wmmx_wqmulm, wmmx_wqmulwm, wmmx_waddbhus, wmmx_wqmiaxy,\
329    wmmx_wmiaxy, wmmx_wmiawxy, wmmx_wmerge")
330		(const_string "single")
331	        (const_string "multi")))
332
333;; FAR_JUMP is "yes" if a BL instruction is used to generate a branch to a
334;; distant label.  Only applicable to Thumb code.
335(define_attr "far_jump" "yes,no" (const_string "no"))
336
337
338;; The number of machine instructions this pattern expands to.
339;; Used for Thumb-2 conditional execution.
340(define_attr "ce_count" "" (const_int 1))
341
342;;---------------------------------------------------------------------------
343;; Unspecs
344
345(include "unspecs.md")
346
347;;---------------------------------------------------------------------------
348;; Mode iterators
349
350(include "iterators.md")
351
352;;---------------------------------------------------------------------------
353;; Predicates
354
355(include "predicates.md")
356(include "constraints.md")
357
358;;---------------------------------------------------------------------------
359;; Pipeline descriptions
360
361(define_attr "tune_cortexr4" "yes,no"
362  (const (if_then_else
363	  (eq_attr "tune" "cortexr4,cortexr4f,cortexr5")
364	  (const_string "yes")
365	  (const_string "no"))))
366
367;; True if the generic scheduling description should be used.
368
369(define_attr "generic_sched" "yes,no"
370  (const (if_then_else
371          (ior (eq_attr "tune" "fa526,fa626,fa606te,fa626te,fmp626,fa726te,\
372                                arm926ejs,arm1020e,arm1026ejs,arm1136js,\
373                                arm1136jfs,cortexa5,cortexa7,cortexa8,\
374                                cortexa9,cortexa12,cortexa15,cortexa17,\
375                                cortexa53,cortexa57,cortexm4,cortexm7,\
376				marvell_pj4,xgene1")
377	       (eq_attr "tune_cortexr4" "yes"))
378          (const_string "no")
379          (const_string "yes"))))
380
381(define_attr "generic_vfp" "yes,no"
382  (const (if_then_else
383	  (and (eq_attr "fpu" "vfp")
384	       (eq_attr "tune" "!arm1020e,arm1022e,cortexa5,cortexa7,\
385                                cortexa8,cortexa9,cortexa53,cortexm4,\
386                                cortexm7,marvell_pj4,xgene1")
387	       (eq_attr "tune_cortexr4" "no"))
388	  (const_string "yes")
389	  (const_string "no"))))
390
391(include "marvell-f-iwmmxt.md")
392(include "arm-generic.md")
393(include "arm926ejs.md")
394(include "arm1020e.md")
395(include "arm1026ejs.md")
396(include "arm1136jfs.md")
397(include "fa526.md")
398(include "fa606te.md")
399(include "fa626te.md")
400(include "fmp626.md")
401(include "fa726te.md")
402(include "cortex-a5.md")
403(include "cortex-a7.md")
404(include "cortex-a8.md")
405(include "cortex-a9.md")
406(include "cortex-a15.md")
407(include "cortex-a17.md")
408(include "cortex-a53.md")
409(include "cortex-a57.md")
410(include "cortex-r4.md")
411(include "cortex-r4f.md")
412(include "cortex-m7.md")
413(include "cortex-m4.md")
414(include "cortex-m4-fpu.md")
415(include "vfp11.md")
416(include "marvell-pj4.md")
417(include "xgene1.md")
418
419
420;;---------------------------------------------------------------------------
421;; Insn patterns
422;;
423;; Addition insns.
424
425;; Note: For DImode insns, there is normally no reason why operands should
426;; not be in the same register, what we don't want is for something being
427;; written to partially overlap something that is an input.
428
429(define_expand "adddi3"
430 [(parallel
431   [(set (match_operand:DI           0 "s_register_operand" "")
432	  (plus:DI (match_operand:DI 1 "s_register_operand" "")
433	           (match_operand:DI 2 "arm_adddi_operand"  "")))
434    (clobber (reg:CC CC_REGNUM))])]
435  "TARGET_EITHER"
436  "
437  if (TARGET_THUMB1)
438    {
439      if (!REG_P (operands[1]))
440        operands[1] = force_reg (DImode, operands[1]);
441      if (!REG_P (operands[2]))
442        operands[2] = force_reg (DImode, operands[2]);
443     }
444  "
445)
446
447(define_insn_and_split "*arm_adddi3"
448  [(set (match_operand:DI          0 "s_register_operand" "=&r,&r,&r,&r,&r")
449	(plus:DI (match_operand:DI 1 "s_register_operand" "%0, 0, r, 0, r")
450		 (match_operand:DI 2 "arm_adddi_operand"  "r,  0, r, Dd, Dd")))
451   (clobber (reg:CC CC_REGNUM))]
452  "TARGET_32BIT && !TARGET_NEON"
453  "#"
454  "TARGET_32BIT && reload_completed
455   && ! (TARGET_NEON && IS_VFP_REGNUM (REGNO (operands[0])))"
456  [(parallel [(set (reg:CC_C CC_REGNUM)
457		   (compare:CC_C (plus:SI (match_dup 1) (match_dup 2))
458				 (match_dup 1)))
459	      (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2)))])
460   (set (match_dup 3) (plus:SI (plus:SI (match_dup 4) (match_dup 5))
461			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
462  "
463  {
464    operands[3] = gen_highpart (SImode, operands[0]);
465    operands[0] = gen_lowpart (SImode, operands[0]);
466    operands[4] = gen_highpart (SImode, operands[1]);
467    operands[1] = gen_lowpart (SImode, operands[1]);
468    operands[5] = gen_highpart_mode (SImode, DImode, operands[2]);
469    operands[2] = gen_lowpart (SImode, operands[2]);
470  }"
471  [(set_attr "conds" "clob")
472   (set_attr "length" "8")
473   (set_attr "type" "multiple")]
474)
475
476(define_insn_and_split "*adddi_sesidi_di"
477  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
478	(plus:DI (sign_extend:DI
479		  (match_operand:SI 2 "s_register_operand" "r,r"))
480		 (match_operand:DI 1 "s_register_operand" "0,r")))
481   (clobber (reg:CC CC_REGNUM))]
482  "TARGET_32BIT"
483  "#"
484  "TARGET_32BIT && reload_completed"
485  [(parallel [(set (reg:CC_C CC_REGNUM)
486		   (compare:CC_C (plus:SI (match_dup 1) (match_dup 2))
487				 (match_dup 1)))
488	      (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2)))])
489   (set (match_dup 3) (plus:SI (plus:SI (ashiftrt:SI (match_dup 2)
490						     (const_int 31))
491					(match_dup 4))
492			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
493  "
494  {
495    operands[3] = gen_highpart (SImode, operands[0]);
496    operands[0] = gen_lowpart (SImode, operands[0]);
497    operands[4] = gen_highpart (SImode, operands[1]);
498    operands[1] = gen_lowpart (SImode, operands[1]);
499    operands[2] = gen_lowpart (SImode, operands[2]);
500  }"
501  [(set_attr "conds" "clob")
502   (set_attr "length" "8")
503   (set_attr "type" "multiple")]
504)
505
506(define_insn_and_split "*adddi_zesidi_di"
507  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
508	(plus:DI (zero_extend:DI
509		  (match_operand:SI 2 "s_register_operand" "r,r"))
510		 (match_operand:DI 1 "s_register_operand" "0,r")))
511   (clobber (reg:CC CC_REGNUM))]
512  "TARGET_32BIT"
513  "#"
514  "TARGET_32BIT && reload_completed"
515  [(parallel [(set (reg:CC_C CC_REGNUM)
516		   (compare:CC_C (plus:SI (match_dup 1) (match_dup 2))
517				 (match_dup 1)))
518	      (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2)))])
519   (set (match_dup 3) (plus:SI (plus:SI (match_dup 4) (const_int 0))
520			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
521  "
522  {
523    operands[3] = gen_highpart (SImode, operands[0]);
524    operands[0] = gen_lowpart (SImode, operands[0]);
525    operands[4] = gen_highpart (SImode, operands[1]);
526    operands[1] = gen_lowpart (SImode, operands[1]);
527    operands[2] = gen_lowpart (SImode, operands[2]);
528  }"
529  [(set_attr "conds" "clob")
530   (set_attr "length" "8")
531   (set_attr "type" "multiple")]
532)
533
534(define_expand "addsi3"
535  [(set (match_operand:SI          0 "s_register_operand" "")
536	(plus:SI (match_operand:SI 1 "s_register_operand" "")
537		 (match_operand:SI 2 "reg_or_int_operand" "")))]
538  "TARGET_EITHER"
539  "
540  if (TARGET_32BIT && CONST_INT_P (operands[2]))
541    {
542      arm_split_constant (PLUS, SImode, NULL_RTX,
543	                  INTVAL (operands[2]), operands[0], operands[1],
544			  optimize && can_create_pseudo_p ());
545      DONE;
546    }
547  "
548)
549
550; If there is a scratch available, this will be faster than synthesizing the
551; addition.
552(define_peephole2
553  [(match_scratch:SI 3 "r")
554   (set (match_operand:SI          0 "arm_general_register_operand" "")
555	(plus:SI (match_operand:SI 1 "arm_general_register_operand" "")
556		 (match_operand:SI 2 "const_int_operand"  "")))]
557  "TARGET_32BIT &&
558   !(const_ok_for_arm (INTVAL (operands[2]))
559     || const_ok_for_arm (-INTVAL (operands[2])))
560    && const_ok_for_arm (~INTVAL (operands[2]))"
561  [(set (match_dup 3) (match_dup 2))
562   (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 3)))]
563  ""
564)
565
566;; The r/r/k alternative is required when reloading the address
567;;  (plus (reg rN) (reg sp)) into (reg rN).  In this case reload will
568;; put the duplicated register first, and not try the commutative version.
569(define_insn_and_split "*arm_addsi3"
570  [(set (match_operand:SI          0 "s_register_operand" "=rk,l,l ,l ,r ,k ,r,r ,k ,r ,k,k,r ,k ,r")
571        (plus:SI (match_operand:SI 1 "s_register_operand" "%0 ,l,0 ,l ,rk,k ,r,rk,k ,rk,k,r,rk,k ,rk")
572                 (match_operand:SI 2 "reg_or_int_operand" "rk ,l,Py,Pd,rI,rI,k,Pj,Pj,L ,L,L,PJ,PJ,?n")))]
573  "TARGET_32BIT"
574  "@
575   add%?\\t%0, %0, %2
576   add%?\\t%0, %1, %2
577   add%?\\t%0, %1, %2
578   add%?\\t%0, %1, %2
579   add%?\\t%0, %1, %2
580   add%?\\t%0, %1, %2
581   add%?\\t%0, %2, %1
582   addw%?\\t%0, %1, %2
583   addw%?\\t%0, %1, %2
584   sub%?\\t%0, %1, #%n2
585   sub%?\\t%0, %1, #%n2
586   sub%?\\t%0, %1, #%n2
587   subw%?\\t%0, %1, #%n2
588   subw%?\\t%0, %1, #%n2
589   #"
590  "TARGET_32BIT
591   && CONST_INT_P (operands[2])
592   && !const_ok_for_op (INTVAL (operands[2]), PLUS)
593   && (reload_completed || !arm_eliminable_register (operands[1]))"
594  [(clobber (const_int 0))]
595  "
596  arm_split_constant (PLUS, SImode, curr_insn,
597	              INTVAL (operands[2]), operands[0],
598		      operands[1], 0);
599  DONE;
600  "
601  [(set_attr "length" "2,4,4,4,4,4,4,4,4,4,4,4,4,4,16")
602   (set_attr "predicable" "yes")
603   (set_attr "predicable_short_it" "yes,yes,yes,yes,no,no,no,no,no,no,no,no,no,no,no")
604   (set_attr "arch" "t2,t2,t2,t2,*,*,*,t2,t2,*,*,a,t2,t2,*")
605   (set (attr "type") (if_then_else (match_operand 2 "const_int_operand" "")
606		      (const_string "alu_imm")
607		      (const_string "alu_sreg")))
608 ]
609)
610
611(define_insn "addsi3_compare0"
612  [(set (reg:CC_NOOV CC_REGNUM)
613	(compare:CC_NOOV
614	 (plus:SI (match_operand:SI 1 "s_register_operand" "r, r,r")
615		  (match_operand:SI 2 "arm_add_operand"    "I,L,r"))
616	 (const_int 0)))
617   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
618	(plus:SI (match_dup 1) (match_dup 2)))]
619  "TARGET_ARM"
620  "@
621   add%.\\t%0, %1, %2
622   sub%.\\t%0, %1, #%n2
623   add%.\\t%0, %1, %2"
624  [(set_attr "conds" "set")
625   (set_attr "type" "alus_imm,alus_imm,alus_sreg")]
626)
627
628(define_insn "*addsi3_compare0_scratch"
629  [(set (reg:CC_NOOV CC_REGNUM)
630	(compare:CC_NOOV
631	 (plus:SI (match_operand:SI 0 "s_register_operand" "r, r, r")
632		  (match_operand:SI 1 "arm_add_operand"    "I,L, r"))
633	 (const_int 0)))]
634  "TARGET_ARM"
635  "@
636   cmn%?\\t%0, %1
637   cmp%?\\t%0, #%n1
638   cmn%?\\t%0, %1"
639  [(set_attr "conds" "set")
640   (set_attr "predicable" "yes")
641   (set_attr "type" "alus_imm,alus_imm,alus_sreg")]
642)
643
644(define_insn "*compare_negsi_si"
645  [(set (reg:CC_Z CC_REGNUM)
646	(compare:CC_Z
647	 (neg:SI (match_operand:SI 0 "s_register_operand" "l,r"))
648	 (match_operand:SI 1 "s_register_operand" "l,r")))]
649  "TARGET_32BIT"
650  "cmn%?\\t%1, %0"
651  [(set_attr "conds" "set")
652   (set_attr "predicable" "yes")
653   (set_attr "arch" "t2,*")
654   (set_attr "length" "2,4")
655   (set_attr "predicable_short_it" "yes,no")
656   (set_attr "type" "alus_sreg")]
657)
658
659;; This is the canonicalization of addsi3_compare0_for_combiner when the
660;; addend is a constant.
661(define_insn "cmpsi2_addneg"
662  [(set (reg:CC CC_REGNUM)
663	(compare:CC
664	 (match_operand:SI 1 "s_register_operand" "r,r")
665	 (match_operand:SI 2 "arm_addimm_operand" "L,I")))
666   (set (match_operand:SI 0 "s_register_operand" "=r,r")
667	(plus:SI (match_dup 1)
668		 (match_operand:SI 3 "arm_addimm_operand" "I,L")))]
669  "TARGET_32BIT && INTVAL (operands[2]) == -INTVAL (operands[3])"
670  "@
671   add%.\\t%0, %1, %3
672   sub%.\\t%0, %1, #%n3"
673  [(set_attr "conds" "set")
674   (set_attr "type" "alus_sreg")]
675)
676
677;; Convert the sequence
678;;  sub  rd, rn, #1
679;;  cmn  rd, #1	(equivalent to cmp rd, #-1)
680;;  bne  dest
681;; into
682;;  subs rd, rn, #1
683;;  bcs  dest	((unsigned)rn >= 1)
684;; similarly for the beq variant using bcc.
685;; This is a common looping idiom (while (n--))
686(define_peephole2
687  [(set (match_operand:SI 0 "arm_general_register_operand" "")
688	(plus:SI (match_operand:SI 1 "arm_general_register_operand" "")
689		 (const_int -1)))
690   (set (match_operand 2 "cc_register" "")
691	(compare (match_dup 0) (const_int -1)))
692   (set (pc)
693	(if_then_else (match_operator 3 "equality_operator"
694		       [(match_dup 2) (const_int 0)])
695		      (match_operand 4 "" "")
696		      (match_operand 5 "" "")))]
697  "TARGET_32BIT && peep2_reg_dead_p (3, operands[2])"
698  [(parallel[
699    (set (match_dup 2)
700	 (compare:CC
701	  (match_dup 1) (const_int 1)))
702    (set (match_dup 0) (plus:SI (match_dup 1) (const_int -1)))])
703   (set (pc)
704	(if_then_else (match_op_dup 3 [(match_dup 2) (const_int 0)])
705		      (match_dup 4)
706		      (match_dup 5)))]
707  "operands[2] = gen_rtx_REG (CCmode, CC_REGNUM);
708   operands[3] = gen_rtx_fmt_ee ((GET_CODE (operands[3]) == NE
709				  ? GEU : LTU),
710				 VOIDmode, 
711				 operands[2], const0_rtx);"
712)
713
714;; The next four insns work because they compare the result with one of
715;; the operands, and we know that the use of the condition code is
716;; either GEU or LTU, so we can use the carry flag from the addition
717;; instead of doing the compare a second time.
718(define_insn "*addsi3_compare_op1"
719  [(set (reg:CC_C CC_REGNUM)
720	(compare:CC_C
721	 (plus:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
722		  (match_operand:SI 2 "arm_add_operand" "I,L,r"))
723	 (match_dup 1)))
724   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
725	(plus:SI (match_dup 1) (match_dup 2)))]
726  "TARGET_32BIT"
727  "@
728   add%.\\t%0, %1, %2
729   sub%.\\t%0, %1, #%n2
730   add%.\\t%0, %1, %2"
731  [(set_attr "conds" "set")
732   (set_attr "type"  "alus_imm,alus_imm,alus_sreg")]
733)
734
735(define_insn "*addsi3_compare_op2"
736  [(set (reg:CC_C CC_REGNUM)
737	(compare:CC_C
738	 (plus:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
739		  (match_operand:SI 2 "arm_add_operand" "I,L,r"))
740	 (match_dup 2)))
741   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
742	(plus:SI (match_dup 1) (match_dup 2)))]
743  "TARGET_32BIT"
744  "@
745   add%.\\t%0, %1, %2
746   add%.\\t%0, %1, %2
747   sub%.\\t%0, %1, #%n2"
748  [(set_attr "conds" "set")
749   (set_attr "type" "alus_imm,alus_imm,alus_sreg")]
750)
751
752(define_insn "*compare_addsi2_op0"
753  [(set (reg:CC_C CC_REGNUM)
754        (compare:CC_C
755          (plus:SI (match_operand:SI 0 "s_register_operand" "l,l,r,r,r")
756                   (match_operand:SI 1 "arm_add_operand" "Pv,l,I,L,r"))
757          (match_dup 0)))]
758  "TARGET_32BIT"
759  "@
760   cmp%?\\t%0, #%n1
761   cmn%?\\t%0, %1
762   cmn%?\\t%0, %1
763   cmp%?\\t%0, #%n1
764   cmn%?\\t%0, %1"
765  [(set_attr "conds" "set")
766   (set_attr "predicable" "yes")
767   (set_attr "arch" "t2,t2,*,*,*")
768   (set_attr "predicable_short_it" "yes,yes,no,no,no")
769   (set_attr "length" "2,2,4,4,4")
770   (set_attr "type" "alus_imm,alus_sreg,alus_imm,alus_imm,alus_sreg")]
771)
772
773(define_insn "*compare_addsi2_op1"
774  [(set (reg:CC_C CC_REGNUM)
775        (compare:CC_C
776          (plus:SI (match_operand:SI 0 "s_register_operand" "l,l,r,r,r")
777                   (match_operand:SI 1 "arm_add_operand" "Pv,l,I,L,r"))
778          (match_dup 1)))]
779  "TARGET_32BIT"
780  "@
781   cmp%?\\t%0, #%n1
782   cmn%?\\t%0, %1
783   cmn%?\\t%0, %1
784   cmp%?\\t%0, #%n1
785   cmn%?\\t%0, %1"
786  [(set_attr "conds" "set")
787   (set_attr "predicable" "yes")
788   (set_attr "arch" "t2,t2,*,*,*")
789   (set_attr "predicable_short_it" "yes,yes,no,no,no")
790   (set_attr "length" "2,2,4,4,4")
791   (set_attr "type" "alus_imm,alus_sreg,alus_imm,alus_imm,alus_sreg")]
792 )
793
794(define_insn "*addsi3_carryin_<optab>"
795  [(set (match_operand:SI 0 "s_register_operand" "=l,r,r")
796        (plus:SI (plus:SI (match_operand:SI 1 "s_register_operand" "%l,r,r")
797                          (match_operand:SI 2 "arm_not_operand" "0,rI,K"))
798                 (LTUGEU:SI (reg:<cnb> CC_REGNUM) (const_int 0))))]
799  "TARGET_32BIT"
800  "@
801   adc%?\\t%0, %1, %2
802   adc%?\\t%0, %1, %2
803   sbc%?\\t%0, %1, #%B2"
804  [(set_attr "conds" "use")
805   (set_attr "predicable" "yes")
806   (set_attr "arch" "t2,*,*")
807   (set_attr "length" "4")
808   (set_attr "predicable_short_it" "yes,no,no")
809   (set_attr "type" "adc_reg,adc_reg,adc_imm")]
810)
811
812(define_insn "*addsi3_carryin_alt2_<optab>"
813  [(set (match_operand:SI 0 "s_register_operand" "=l,r,r")
814        (plus:SI (plus:SI (LTUGEU:SI (reg:<cnb> CC_REGNUM) (const_int 0))
815                          (match_operand:SI 1 "s_register_operand" "%l,r,r"))
816                 (match_operand:SI 2 "arm_rhs_operand" "l,rI,K")))]
817  "TARGET_32BIT"
818  "@
819   adc%?\\t%0, %1, %2
820   adc%?\\t%0, %1, %2
821   sbc%?\\t%0, %1, #%B2"
822  [(set_attr "conds" "use")
823   (set_attr "predicable" "yes")
824   (set_attr "arch" "t2,*,*")
825   (set_attr "length" "4")
826   (set_attr "predicable_short_it" "yes,no,no")
827   (set_attr "type" "adc_reg,adc_reg,adc_imm")]
828)
829
830(define_insn "*addsi3_carryin_shift_<optab>"
831  [(set (match_operand:SI 0 "s_register_operand" "=r")
832	(plus:SI (plus:SI
833		  (match_operator:SI 2 "shift_operator"
834		    [(match_operand:SI 3 "s_register_operand" "r")
835		     (match_operand:SI 4 "reg_or_int_operand" "rM")])
836		  (match_operand:SI 1 "s_register_operand" "r"))
837		 (LTUGEU:SI (reg:<cnb> CC_REGNUM) (const_int 0))))]
838  "TARGET_32BIT"
839  "adc%?\\t%0, %1, %3%S2"
840  [(set_attr "conds" "use")
841   (set_attr "predicable" "yes")
842   (set_attr "predicable_short_it" "no")
843   (set (attr "type") (if_then_else (match_operand 4 "const_int_operand" "")
844		      (const_string "alu_shift_imm")
845		      (const_string "alu_shift_reg")))]
846)
847
848(define_insn "*addsi3_carryin_clobercc_<optab>"
849  [(set (match_operand:SI 0 "s_register_operand" "=r")
850	(plus:SI (plus:SI (match_operand:SI 1 "s_register_operand" "%r")
851			  (match_operand:SI 2 "arm_rhs_operand" "rI"))
852		 (LTUGEU:SI (reg:<cnb> CC_REGNUM) (const_int 0))))
853   (clobber (reg:CC CC_REGNUM))]
854   "TARGET_32BIT"
855   "adc%.\\t%0, %1, %2"
856   [(set_attr "conds" "set")
857    (set_attr "type" "adcs_reg")]
858)
859
860(define_insn "*subsi3_carryin"
861  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
862        (minus:SI (minus:SI (match_operand:SI 1 "reg_or_int_operand" "r,I")
863                            (match_operand:SI 2 "s_register_operand" "r,r"))
864                  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
865  "TARGET_32BIT"
866  "@
867   sbc%?\\t%0, %1, %2
868   rsc%?\\t%0, %2, %1"
869  [(set_attr "conds" "use")
870   (set_attr "arch" "*,a")
871   (set_attr "predicable" "yes")
872   (set_attr "predicable_short_it" "no")
873   (set_attr "type" "adc_reg,adc_imm")]
874)
875
876(define_insn "*subsi3_carryin_const"
877  [(set (match_operand:SI 0 "s_register_operand" "=r")
878        (minus:SI (plus:SI (match_operand:SI 1 "reg_or_int_operand" "r")
879                           (match_operand:SI 2 "arm_not_operand" "K"))
880                  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
881  "TARGET_32BIT"
882  "sbc\\t%0, %1, #%B2"
883  [(set_attr "conds" "use")
884   (set_attr "type" "adc_imm")]
885)
886
887(define_insn "*subsi3_carryin_compare"
888  [(set (reg:CC CC_REGNUM)
889        (compare:CC (match_operand:SI 1 "s_register_operand" "r")
890                    (match_operand:SI 2 "s_register_operand" "r")))
891   (set (match_operand:SI 0 "s_register_operand" "=r")
892        (minus:SI (minus:SI (match_dup 1)
893                            (match_dup 2))
894                  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
895  "TARGET_32BIT"
896  "sbcs\\t%0, %1, %2"
897  [(set_attr "conds" "set")
898   (set_attr "type" "adcs_reg")]
899)
900
901(define_insn "*subsi3_carryin_compare_const"
902  [(set (reg:CC CC_REGNUM)
903        (compare:CC (match_operand:SI 1 "reg_or_int_operand" "r")
904                    (match_operand:SI 2 "arm_not_operand" "K")))
905   (set (match_operand:SI 0 "s_register_operand" "=r")
906        (minus:SI (plus:SI (match_dup 1)
907                           (match_dup 2))
908                  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
909  "TARGET_32BIT"
910  "sbcs\\t%0, %1, #%B2"
911  [(set_attr "conds" "set")
912   (set_attr "type" "adcs_imm")]
913)
914
915(define_insn "*subsi3_carryin_shift"
916  [(set (match_operand:SI 0 "s_register_operand" "=r")
917	(minus:SI (minus:SI
918		  (match_operand:SI 1 "s_register_operand" "r")
919                  (match_operator:SI 2 "shift_operator"
920                   [(match_operand:SI 3 "s_register_operand" "r")
921                    (match_operand:SI 4 "reg_or_int_operand" "rM")]))
922                 (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
923  "TARGET_32BIT"
924  "sbc%?\\t%0, %1, %3%S2"
925  [(set_attr "conds" "use")
926   (set_attr "predicable" "yes")
927   (set (attr "type") (if_then_else (match_operand 4 "const_int_operand" "")
928		      (const_string "alu_shift_imm")
929                     (const_string "alu_shift_reg")))]
930)
931
932(define_insn "*rsbsi3_carryin_shift"
933  [(set (match_operand:SI 0 "s_register_operand" "=r")
934	(minus:SI (minus:SI
935                  (match_operator:SI 2 "shift_operator"
936                   [(match_operand:SI 3 "s_register_operand" "r")
937                    (match_operand:SI 4 "reg_or_int_operand" "rM")])
938		   (match_operand:SI 1 "s_register_operand" "r"))
939                 (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
940  "TARGET_ARM"
941  "rsc%?\\t%0, %1, %3%S2"
942  [(set_attr "conds" "use")
943   (set_attr "predicable" "yes")
944   (set (attr "type") (if_then_else (match_operand 4 "const_int_operand" "")
945		      (const_string "alu_shift_imm")
946		      (const_string "alu_shift_reg")))]
947)
948
949; transform ((x << y) - 1) to ~(~(x-1) << y)  Where X is a constant.
950(define_split
951  [(set (match_operand:SI 0 "s_register_operand" "")
952	(plus:SI (ashift:SI (match_operand:SI 1 "const_int_operand" "")
953			    (match_operand:SI 2 "s_register_operand" ""))
954		 (const_int -1)))
955   (clobber (match_operand:SI 3 "s_register_operand" ""))]
956  "TARGET_32BIT"
957  [(set (match_dup 3) (match_dup 1))
958   (set (match_dup 0) (not:SI (ashift:SI (match_dup 3) (match_dup 2))))]
959  "
960  operands[1] = GEN_INT (~(INTVAL (operands[1]) - 1));
961")
962
963(define_expand "addsf3"
964  [(set (match_operand:SF          0 "s_register_operand" "")
965	(plus:SF (match_operand:SF 1 "s_register_operand" "")
966		 (match_operand:SF 2 "s_register_operand" "")))]
967  "TARGET_32BIT && TARGET_HARD_FLOAT"
968  "
969")
970
971(define_expand "adddf3"
972  [(set (match_operand:DF          0 "s_register_operand" "")
973	(plus:DF (match_operand:DF 1 "s_register_operand" "")
974		 (match_operand:DF 2 "s_register_operand" "")))]
975  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
976  "
977")
978
979(define_expand "subdi3"
980 [(parallel
981   [(set (match_operand:DI            0 "s_register_operand" "")
982	  (minus:DI (match_operand:DI 1 "s_register_operand" "")
983	            (match_operand:DI 2 "s_register_operand" "")))
984    (clobber (reg:CC CC_REGNUM))])]
985  "TARGET_EITHER"
986  "
987  if (TARGET_THUMB1)
988    {
989      if (!REG_P (operands[1]))
990        operands[1] = force_reg (DImode, operands[1]);
991      if (!REG_P (operands[2]))
992        operands[2] = force_reg (DImode, operands[2]);
993     }	
994  "
995)
996
997(define_insn_and_split "*arm_subdi3"
998  [(set (match_operand:DI           0 "s_register_operand" "=&r,&r,&r")
999	(minus:DI (match_operand:DI 1 "s_register_operand" "0,r,0")
1000		  (match_operand:DI 2 "s_register_operand" "r,0,0")))
1001   (clobber (reg:CC CC_REGNUM))]
1002  "TARGET_32BIT && !TARGET_NEON"
1003  "#"  ; "subs\\t%Q0, %Q1, %Q2\;sbc\\t%R0, %R1, %R2"
1004  "&& reload_completed"
1005  [(parallel [(set (reg:CC CC_REGNUM)
1006		   (compare:CC (match_dup 1) (match_dup 2)))
1007	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1008   (set (match_dup 3) (minus:SI (minus:SI (match_dup 4) (match_dup 5))
1009			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1010  {
1011    operands[3] = gen_highpart (SImode, operands[0]);
1012    operands[0] = gen_lowpart (SImode, operands[0]);
1013    operands[4] = gen_highpart (SImode, operands[1]);
1014    operands[1] = gen_lowpart (SImode, operands[1]);
1015    operands[5] = gen_highpart (SImode, operands[2]);
1016    operands[2] = gen_lowpart (SImode, operands[2]);
1017   }
1018  [(set_attr "conds" "clob")
1019   (set_attr "length" "8")
1020   (set_attr "type" "multiple")]
1021)
1022
1023(define_insn_and_split "*subdi_di_zesidi"
1024  [(set (match_operand:DI           0 "s_register_operand" "=&r,&r")
1025	(minus:DI (match_operand:DI 1 "s_register_operand"  "0,r")
1026		  (zero_extend:DI
1027		   (match_operand:SI 2 "s_register_operand"  "r,r"))))
1028   (clobber (reg:CC CC_REGNUM))]
1029  "TARGET_32BIT"
1030  "#"   ; "subs\\t%Q0, %Q1, %2\;sbc\\t%R0, %R1, #0"
1031  "&& reload_completed"
1032  [(parallel [(set (reg:CC CC_REGNUM)
1033		   (compare:CC (match_dup 1) (match_dup 2)))
1034	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1035   (set (match_dup 3) (minus:SI (plus:SI (match_dup 4) (match_dup 5))
1036                                (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1037  {
1038    operands[3] = gen_highpart (SImode, operands[0]);
1039    operands[0] = gen_lowpart (SImode, operands[0]);
1040    operands[4] = gen_highpart (SImode, operands[1]);
1041    operands[1] = gen_lowpart (SImode, operands[1]);
1042    operands[5] = GEN_INT (~0);
1043   }
1044  [(set_attr "conds" "clob")
1045   (set_attr "length" "8")
1046   (set_attr "type" "multiple")]
1047)
1048
1049(define_insn_and_split "*subdi_di_sesidi"
1050  [(set (match_operand:DI            0 "s_register_operand" "=&r,&r")
1051	(minus:DI (match_operand:DI  1 "s_register_operand"  "0,r")
1052		  (sign_extend:DI
1053		   (match_operand:SI 2 "s_register_operand"  "r,r"))))
1054   (clobber (reg:CC CC_REGNUM))]
1055  "TARGET_32BIT"
1056  "#"   ; "subs\\t%Q0, %Q1, %2\;sbc\\t%R0, %R1, %2, asr #31"
1057  "&& reload_completed"
1058  [(parallel [(set (reg:CC CC_REGNUM)
1059		   (compare:CC (match_dup 1) (match_dup 2)))
1060	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1061   (set (match_dup 3) (minus:SI (minus:SI (match_dup 4)
1062                                         (ashiftrt:SI (match_dup 2)
1063                                                      (const_int 31)))
1064                                (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1065  {
1066    operands[3] = gen_highpart (SImode, operands[0]);
1067    operands[0] = gen_lowpart (SImode, operands[0]);
1068    operands[4] = gen_highpart (SImode, operands[1]);
1069    operands[1] = gen_lowpart (SImode, operands[1]);
1070  }
1071  [(set_attr "conds" "clob")
1072   (set_attr "length" "8")
1073   (set_attr "type" "multiple")]
1074)
1075
1076(define_insn_and_split "*subdi_zesidi_di"
1077  [(set (match_operand:DI            0 "s_register_operand" "=&r,&r")
1078	(minus:DI (zero_extend:DI
1079		   (match_operand:SI 2 "s_register_operand"  "r,r"))
1080		  (match_operand:DI  1 "s_register_operand" "0,r")))
1081   (clobber (reg:CC CC_REGNUM))]
1082  "TARGET_ARM"
1083  "#"   ; "rsbs\\t%Q0, %Q1, %2\;rsc\\t%R0, %R1, #0"
1084        ; is equivalent to:
1085        ; "subs\\t%Q0, %2, %Q1\;rsc\\t%R0, %R1, #0"
1086  "&& reload_completed"
1087  [(parallel [(set (reg:CC CC_REGNUM)
1088		   (compare:CC (match_dup 2) (match_dup 1)))
1089	      (set (match_dup 0) (minus:SI (match_dup 2) (match_dup 1)))])
1090   (set (match_dup 3) (minus:SI (minus:SI (const_int 0) (match_dup 4))
1091			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1092  {
1093    operands[3] = gen_highpart (SImode, operands[0]);
1094    operands[0] = gen_lowpart (SImode, operands[0]);
1095    operands[4] = gen_highpart (SImode, operands[1]);
1096    operands[1] = gen_lowpart (SImode, operands[1]);
1097  }
1098  [(set_attr "conds" "clob")
1099   (set_attr "length" "8")
1100   (set_attr "type" "multiple")]
1101)
1102
1103(define_insn_and_split "*subdi_sesidi_di"
1104  [(set (match_operand:DI            0 "s_register_operand" "=&r,&r")
1105	(minus:DI (sign_extend:DI
1106		   (match_operand:SI 2 "s_register_operand"   "r,r"))
1107		  (match_operand:DI  1 "s_register_operand"  "0,r")))
1108   (clobber (reg:CC CC_REGNUM))]
1109  "TARGET_ARM"
1110  "#"   ; "rsbs\\t%Q0, %Q1, %2\;rsc\\t%R0, %R1, %2, asr #31"
1111        ; is equivalent to:
1112        ; "subs\\t%Q0, %2, %Q1\;rsc\\t%R0, %R1, %2, asr #31"
1113  "&& reload_completed"
1114  [(parallel [(set (reg:CC CC_REGNUM)
1115		   (compare:CC (match_dup 2) (match_dup 1)))
1116	      (set (match_dup 0) (minus:SI (match_dup 2) (match_dup 1)))])
1117   (set (match_dup 3) (minus:SI (minus:SI
1118                                (ashiftrt:SI (match_dup 2)
1119                                             (const_int 31))
1120                                (match_dup 4))
1121			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1122  {
1123    operands[3] = gen_highpart (SImode, operands[0]);
1124    operands[0] = gen_lowpart (SImode, operands[0]);
1125    operands[4] = gen_highpart (SImode, operands[1]);
1126    operands[1] = gen_lowpart (SImode, operands[1]);
1127  }
1128  [(set_attr "conds" "clob")
1129   (set_attr "length" "8")
1130   (set_attr "type" "multiple")]
1131)
1132
1133(define_insn_and_split "*subdi_zesidi_zesidi"
1134  [(set (match_operand:DI            0 "s_register_operand" "=r")
1135	(minus:DI (zero_extend:DI
1136		   (match_operand:SI 1 "s_register_operand"  "r"))
1137		  (zero_extend:DI
1138		   (match_operand:SI 2 "s_register_operand"  "r"))))
1139   (clobber (reg:CC CC_REGNUM))]
1140  "TARGET_32BIT"
1141  "#"   ; "subs\\t%Q0, %1, %2\;sbc\\t%R0, %1, %1"
1142  "&& reload_completed"
1143  [(parallel [(set (reg:CC CC_REGNUM)
1144		   (compare:CC (match_dup 1) (match_dup 2)))
1145	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1146   (set (match_dup 3) (minus:SI (minus:SI (match_dup 1) (match_dup 1))
1147			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1148  {
1149       operands[3] = gen_highpart (SImode, operands[0]);
1150       operands[0] = gen_lowpart (SImode, operands[0]);
1151  }
1152  [(set_attr "conds" "clob")
1153   (set_attr "length" "8")
1154   (set_attr "type" "multiple")]
1155)
1156
1157(define_expand "subsi3"
1158  [(set (match_operand:SI           0 "s_register_operand" "")
1159	(minus:SI (match_operand:SI 1 "reg_or_int_operand" "")
1160		  (match_operand:SI 2 "s_register_operand" "")))]
1161  "TARGET_EITHER"
1162  "
1163  if (CONST_INT_P (operands[1]))
1164    {
1165      if (TARGET_32BIT)
1166        {
1167          arm_split_constant (MINUS, SImode, NULL_RTX,
1168	                      INTVAL (operands[1]), operands[0],
1169	  		      operands[2], optimize && can_create_pseudo_p ());
1170          DONE;
1171	}
1172      else /* TARGET_THUMB1 */
1173        operands[1] = force_reg (SImode, operands[1]);
1174    }
1175  "
1176)
1177
1178; ??? Check Thumb-2 split length
1179(define_insn_and_split "*arm_subsi3_insn"
1180  [(set (match_operand:SI           0 "s_register_operand" "=l,l ,l ,l ,r ,r,r,rk,r")
1181	(minus:SI (match_operand:SI 1 "reg_or_int_operand" "l ,0 ,l ,Pz,rI,r,r,k ,?n")
1182		  (match_operand:SI 2 "reg_or_int_operand" "l ,Py,Pd,l ,r ,I,r,r ,r")))]
1183  "TARGET_32BIT"
1184  "@
1185   sub%?\\t%0, %1, %2
1186   sub%?\\t%0, %2
1187   sub%?\\t%0, %1, %2
1188   rsb%?\\t%0, %2, %1
1189   rsb%?\\t%0, %2, %1
1190   sub%?\\t%0, %1, %2
1191   sub%?\\t%0, %1, %2
1192   sub%?\\t%0, %1, %2
1193   #"
1194  "&& (CONST_INT_P (operands[1])
1195       && !const_ok_for_arm (INTVAL (operands[1])))"
1196  [(clobber (const_int 0))]
1197  "
1198  arm_split_constant (MINUS, SImode, curr_insn,
1199                      INTVAL (operands[1]), operands[0], operands[2], 0);
1200  DONE;
1201  "
1202  [(set_attr "length" "4,4,4,4,4,4,4,4,16")
1203   (set_attr "arch" "t2,t2,t2,t2,*,*,*,*,*")
1204   (set_attr "predicable" "yes")
1205   (set_attr "predicable_short_it" "yes,yes,yes,yes,no,no,no,no,no")
1206   (set_attr "type" "alu_sreg,alu_sreg,alu_sreg,alu_sreg,alu_imm,alu_imm,alu_sreg,alu_sreg,multiple")]
1207)
1208
1209(define_peephole2
1210  [(match_scratch:SI 3 "r")
1211   (set (match_operand:SI 0 "arm_general_register_operand" "")
1212	(minus:SI (match_operand:SI 1 "const_int_operand" "")
1213		  (match_operand:SI 2 "arm_general_register_operand" "")))]
1214  "TARGET_32BIT
1215   && !const_ok_for_arm (INTVAL (operands[1]))
1216   && const_ok_for_arm (~INTVAL (operands[1]))"
1217  [(set (match_dup 3) (match_dup 1))
1218   (set (match_dup 0) (minus:SI (match_dup 3) (match_dup 2)))]
1219  ""
1220)
1221
1222(define_insn "*subsi3_compare0"
1223  [(set (reg:CC_NOOV CC_REGNUM)
1224	(compare:CC_NOOV
1225	 (minus:SI (match_operand:SI 1 "arm_rhs_operand" "r,r,I")
1226		   (match_operand:SI 2 "arm_rhs_operand" "I,r,r"))
1227	 (const_int 0)))
1228   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
1229	(minus:SI (match_dup 1) (match_dup 2)))]
1230  "TARGET_32BIT"
1231  "@
1232   sub%.\\t%0, %1, %2
1233   sub%.\\t%0, %1, %2
1234   rsb%.\\t%0, %2, %1"
1235  [(set_attr "conds" "set")
1236   (set_attr "type"  "alus_imm,alus_sreg,alus_sreg")]
1237)
1238
1239(define_insn "subsi3_compare"
1240  [(set (reg:CC CC_REGNUM)
1241	(compare:CC (match_operand:SI 1 "arm_rhs_operand" "r,r,I")
1242		    (match_operand:SI 2 "arm_rhs_operand" "I,r,r")))
1243   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
1244	(minus:SI (match_dup 1) (match_dup 2)))]
1245  "TARGET_32BIT"
1246  "@
1247   sub%.\\t%0, %1, %2
1248   sub%.\\t%0, %1, %2
1249   rsb%.\\t%0, %2, %1"
1250  [(set_attr "conds" "set")
1251   (set_attr "type" "alus_imm,alus_sreg,alus_sreg")]
1252)
1253
1254(define_expand "subsf3"
1255  [(set (match_operand:SF           0 "s_register_operand" "")
1256	(minus:SF (match_operand:SF 1 "s_register_operand" "")
1257		  (match_operand:SF 2 "s_register_operand" "")))]
1258  "TARGET_32BIT && TARGET_HARD_FLOAT"
1259  "
1260")
1261
1262(define_expand "subdf3"
1263  [(set (match_operand:DF           0 "s_register_operand" "")
1264	(minus:DF (match_operand:DF 1 "s_register_operand" "")
1265		  (match_operand:DF 2 "s_register_operand" "")))]
1266  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
1267  "
1268")
1269
1270
1271;; Multiplication insns
1272
1273(define_expand "mulhi3"
1274  [(set (match_operand:HI 0 "s_register_operand" "")
1275	(mult:HI (match_operand:HI 1 "s_register_operand" "")
1276		 (match_operand:HI 2 "s_register_operand" "")))]
1277  "TARGET_DSP_MULTIPLY"
1278  "
1279  {
1280    rtx result = gen_reg_rtx (SImode);
1281    emit_insn (gen_mulhisi3 (result, operands[1], operands[2]));
1282    emit_move_insn (operands[0], gen_lowpart (HImode, result));
1283    DONE;
1284  }"
1285)
1286
1287(define_expand "mulsi3"
1288  [(set (match_operand:SI          0 "s_register_operand" "")
1289	(mult:SI (match_operand:SI 2 "s_register_operand" "")
1290		 (match_operand:SI 1 "s_register_operand" "")))]
1291  "TARGET_EITHER"
1292  ""
1293)
1294
1295;; Use `&' and then `0' to prevent the operands 0 and 1 being the same
1296(define_insn "*arm_mulsi3"
1297  [(set (match_operand:SI          0 "s_register_operand" "=&r,&r")
1298	(mult:SI (match_operand:SI 2 "s_register_operand" "r,r")
1299		 (match_operand:SI 1 "s_register_operand" "%0,r")))]
1300  "TARGET_32BIT && !arm_arch6"
1301  "mul%?\\t%0, %2, %1"
1302  [(set_attr "type" "mul")
1303   (set_attr "predicable" "yes")]
1304)
1305
1306(define_insn "*arm_mulsi3_v6"
1307  [(set (match_operand:SI          0 "s_register_operand" "=l,l,r")
1308	(mult:SI (match_operand:SI 1 "s_register_operand" "0,l,r")
1309		 (match_operand:SI 2 "s_register_operand" "l,0,r")))]
1310  "TARGET_32BIT && arm_arch6"
1311  "mul%?\\t%0, %1, %2"
1312  [(set_attr "type" "mul")
1313   (set_attr "predicable" "yes")
1314   (set_attr "arch" "t2,t2,*")
1315   (set_attr "length" "4")
1316   (set_attr "predicable_short_it" "yes,yes,no")]
1317)
1318
1319(define_insn "*mulsi3_compare0"
1320  [(set (reg:CC_NOOV CC_REGNUM)
1321	(compare:CC_NOOV (mult:SI
1322			  (match_operand:SI 2 "s_register_operand" "r,r")
1323			  (match_operand:SI 1 "s_register_operand" "%0,r"))
1324			 (const_int 0)))
1325   (set (match_operand:SI 0 "s_register_operand" "=&r,&r")
1326	(mult:SI (match_dup 2) (match_dup 1)))]
1327  "TARGET_ARM && !arm_arch6"
1328  "mul%.\\t%0, %2, %1"
1329  [(set_attr "conds" "set")
1330   (set_attr "type" "muls")]
1331)
1332
1333(define_insn "*mulsi3_compare0_v6"
1334  [(set (reg:CC_NOOV CC_REGNUM)
1335	(compare:CC_NOOV (mult:SI
1336			  (match_operand:SI 2 "s_register_operand" "r")
1337			  (match_operand:SI 1 "s_register_operand" "r"))
1338			 (const_int 0)))
1339   (set (match_operand:SI 0 "s_register_operand" "=r")
1340	(mult:SI (match_dup 2) (match_dup 1)))]
1341  "TARGET_ARM && arm_arch6 && optimize_size"
1342  "mul%.\\t%0, %2, %1"
1343  [(set_attr "conds" "set")
1344   (set_attr "type" "muls")]
1345)
1346
1347(define_insn "*mulsi_compare0_scratch"
1348  [(set (reg:CC_NOOV CC_REGNUM)
1349	(compare:CC_NOOV (mult:SI
1350			  (match_operand:SI 2 "s_register_operand" "r,r")
1351			  (match_operand:SI 1 "s_register_operand" "%0,r"))
1352			 (const_int 0)))
1353   (clobber (match_scratch:SI 0 "=&r,&r"))]
1354  "TARGET_ARM && !arm_arch6"
1355  "mul%.\\t%0, %2, %1"
1356  [(set_attr "conds" "set")
1357   (set_attr "type" "muls")]
1358)
1359
1360(define_insn "*mulsi_compare0_scratch_v6"
1361  [(set (reg:CC_NOOV CC_REGNUM)
1362	(compare:CC_NOOV (mult:SI
1363			  (match_operand:SI 2 "s_register_operand" "r")
1364			  (match_operand:SI 1 "s_register_operand" "r"))
1365			 (const_int 0)))
1366   (clobber (match_scratch:SI 0 "=r"))]
1367  "TARGET_ARM && arm_arch6 && optimize_size"
1368  "mul%.\\t%0, %2, %1"
1369  [(set_attr "conds" "set")
1370   (set_attr "type" "muls")]
1371)
1372
1373;; Unnamed templates to match MLA instruction.
1374
1375(define_insn "*mulsi3addsi"
1376  [(set (match_operand:SI 0 "s_register_operand" "=&r,&r,&r,&r")
1377	(plus:SI
1378	  (mult:SI (match_operand:SI 2 "s_register_operand" "r,r,r,r")
1379		   (match_operand:SI 1 "s_register_operand" "%0,r,0,r"))
1380	  (match_operand:SI 3 "s_register_operand" "r,r,0,0")))]
1381  "TARGET_32BIT && !arm_arch6"
1382  "mla%?\\t%0, %2, %1, %3"
1383  [(set_attr "type" "mla")
1384   (set_attr "predicable" "yes")]
1385)
1386
1387(define_insn "*mulsi3addsi_v6"
1388  [(set (match_operand:SI 0 "s_register_operand" "=r")
1389	(plus:SI
1390	  (mult:SI (match_operand:SI 2 "s_register_operand" "r")
1391		   (match_operand:SI 1 "s_register_operand" "r"))
1392	  (match_operand:SI 3 "s_register_operand" "r")))]
1393  "TARGET_32BIT && arm_arch6"
1394  "mla%?\\t%0, %2, %1, %3"
1395  [(set_attr "type" "mla")
1396   (set_attr "predicable" "yes")
1397   (set_attr "predicable_short_it" "no")]
1398)
1399
1400(define_insn "*mulsi3addsi_compare0"
1401  [(set (reg:CC_NOOV CC_REGNUM)
1402	(compare:CC_NOOV
1403	 (plus:SI (mult:SI
1404		   (match_operand:SI 2 "s_register_operand" "r,r,r,r")
1405		   (match_operand:SI 1 "s_register_operand" "%0,r,0,r"))
1406		  (match_operand:SI 3 "s_register_operand" "r,r,0,0"))
1407	 (const_int 0)))
1408   (set (match_operand:SI 0 "s_register_operand" "=&r,&r,&r,&r")
1409	(plus:SI (mult:SI (match_dup 2) (match_dup 1))
1410		 (match_dup 3)))]
1411  "TARGET_ARM && arm_arch6"
1412  "mla%.\\t%0, %2, %1, %3"
1413  [(set_attr "conds" "set")
1414   (set_attr "type" "mlas")]
1415)
1416
1417(define_insn "*mulsi3addsi_compare0_v6"
1418  [(set (reg:CC_NOOV CC_REGNUM)
1419	(compare:CC_NOOV
1420	 (plus:SI (mult:SI
1421		   (match_operand:SI 2 "s_register_operand" "r")
1422		   (match_operand:SI 1 "s_register_operand" "r"))
1423		  (match_operand:SI 3 "s_register_operand" "r"))
1424	 (const_int 0)))
1425   (set (match_operand:SI 0 "s_register_operand" "=r")
1426	(plus:SI (mult:SI (match_dup 2) (match_dup 1))
1427		 (match_dup 3)))]
1428  "TARGET_ARM && arm_arch6 && optimize_size"
1429  "mla%.\\t%0, %2, %1, %3"
1430  [(set_attr "conds" "set")
1431   (set_attr "type" "mlas")]
1432)
1433
1434(define_insn "*mulsi3addsi_compare0_scratch"
1435  [(set (reg:CC_NOOV CC_REGNUM)
1436	(compare:CC_NOOV
1437	 (plus:SI (mult:SI
1438		   (match_operand:SI 2 "s_register_operand" "r,r,r,r")
1439		   (match_operand:SI 1 "s_register_operand" "%0,r,0,r"))
1440		  (match_operand:SI 3 "s_register_operand" "?r,r,0,0"))
1441	 (const_int 0)))
1442   (clobber (match_scratch:SI 0 "=&r,&r,&r,&r"))]
1443  "TARGET_ARM && !arm_arch6"
1444  "mla%.\\t%0, %2, %1, %3"
1445  [(set_attr "conds" "set")
1446   (set_attr "type" "mlas")]
1447)
1448
1449(define_insn "*mulsi3addsi_compare0_scratch_v6"
1450  [(set (reg:CC_NOOV CC_REGNUM)
1451	(compare:CC_NOOV
1452	 (plus:SI (mult:SI
1453		   (match_operand:SI 2 "s_register_operand" "r")
1454		   (match_operand:SI 1 "s_register_operand" "r"))
1455		  (match_operand:SI 3 "s_register_operand" "r"))
1456	 (const_int 0)))
1457   (clobber (match_scratch:SI 0 "=r"))]
1458  "TARGET_ARM && arm_arch6 && optimize_size"
1459  "mla%.\\t%0, %2, %1, %3"
1460  [(set_attr "conds" "set")
1461   (set_attr "type" "mlas")]
1462)
1463
1464(define_insn "*mulsi3subsi"
1465  [(set (match_operand:SI 0 "s_register_operand" "=r")
1466	(minus:SI
1467	  (match_operand:SI 3 "s_register_operand" "r")
1468	  (mult:SI (match_operand:SI 2 "s_register_operand" "r")
1469		   (match_operand:SI 1 "s_register_operand" "r"))))]
1470  "TARGET_32BIT && arm_arch_thumb2"
1471  "mls%?\\t%0, %2, %1, %3"
1472  [(set_attr "type" "mla")
1473   (set_attr "predicable" "yes")
1474   (set_attr "predicable_short_it" "no")]
1475)
1476
1477(define_expand "maddsidi4"
1478  [(set (match_operand:DI 0 "s_register_operand" "")
1479	(plus:DI
1480	 (mult:DI
1481	  (sign_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1482	  (sign_extend:DI (match_operand:SI 2 "s_register_operand" "")))
1483	 (match_operand:DI 3 "s_register_operand" "")))]
1484  "TARGET_32BIT && arm_arch3m"
1485  "")
1486
1487(define_insn "*mulsidi3adddi"
1488  [(set (match_operand:DI 0 "s_register_operand" "=&r")
1489	(plus:DI
1490	 (mult:DI
1491	  (sign_extend:DI (match_operand:SI 2 "s_register_operand" "%r"))
1492	  (sign_extend:DI (match_operand:SI 3 "s_register_operand" "r")))
1493	 (match_operand:DI 1 "s_register_operand" "0")))]
1494  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1495  "smlal%?\\t%Q0, %R0, %3, %2"
1496  [(set_attr "type" "smlal")
1497   (set_attr "predicable" "yes")]
1498)
1499
1500(define_insn "*mulsidi3adddi_v6"
1501  [(set (match_operand:DI 0 "s_register_operand" "=r")
1502	(plus:DI
1503	 (mult:DI
1504	  (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r"))
1505	  (sign_extend:DI (match_operand:SI 3 "s_register_operand" "r")))
1506	 (match_operand:DI 1 "s_register_operand" "0")))]
1507  "TARGET_32BIT && arm_arch6"
1508  "smlal%?\\t%Q0, %R0, %3, %2"
1509  [(set_attr "type" "smlal")
1510   (set_attr "predicable" "yes")
1511   (set_attr "predicable_short_it" "no")]
1512)
1513
1514;; 32x32->64 widening multiply.
1515;; As with mulsi3, the only difference between the v3-5 and v6+
1516;; versions of these patterns is the requirement that the output not
1517;; overlap the inputs, but that still means we have to have a named
1518;; expander and two different starred insns.
1519
1520(define_expand "mulsidi3"
1521  [(set (match_operand:DI 0 "s_register_operand" "")
1522	(mult:DI
1523	 (sign_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1524	 (sign_extend:DI (match_operand:SI 2 "s_register_operand" ""))))]
1525  "TARGET_32BIT && arm_arch3m"
1526  ""
1527)
1528
1529(define_insn "*mulsidi3_nov6"
1530  [(set (match_operand:DI 0 "s_register_operand" "=&r")
1531	(mult:DI
1532	 (sign_extend:DI (match_operand:SI 1 "s_register_operand" "%r"))
1533	 (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r"))))]
1534  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1535  "smull%?\\t%Q0, %R0, %1, %2"
1536  [(set_attr "type" "smull")
1537   (set_attr "predicable" "yes")]
1538)
1539
1540(define_insn "*mulsidi3_v6"
1541  [(set (match_operand:DI 0 "s_register_operand" "=r")
1542	(mult:DI
1543	 (sign_extend:DI (match_operand:SI 1 "s_register_operand" "r"))
1544	 (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r"))))]
1545  "TARGET_32BIT && arm_arch6"
1546  "smull%?\\t%Q0, %R0, %1, %2"
1547  [(set_attr "type" "smull")
1548   (set_attr "predicable" "yes")
1549   (set_attr "predicable_short_it" "no")]
1550)
1551
1552(define_expand "umulsidi3"
1553  [(set (match_operand:DI 0 "s_register_operand" "")
1554	(mult:DI
1555	 (zero_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1556	 (zero_extend:DI (match_operand:SI 2 "s_register_operand" ""))))]
1557  "TARGET_32BIT && arm_arch3m"
1558  ""
1559)
1560
1561(define_insn "*umulsidi3_nov6"
1562  [(set (match_operand:DI 0 "s_register_operand" "=&r")
1563	(mult:DI
1564	 (zero_extend:DI (match_operand:SI 1 "s_register_operand" "%r"))
1565	 (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r"))))]
1566  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1567  "umull%?\\t%Q0, %R0, %1, %2"
1568  [(set_attr "type" "umull")
1569   (set_attr "predicable" "yes")]
1570)
1571
1572(define_insn "*umulsidi3_v6"
1573  [(set (match_operand:DI 0 "s_register_operand" "=r")
1574	(mult:DI
1575	 (zero_extend:DI (match_operand:SI 1 "s_register_operand" "r"))
1576	 (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r"))))]
1577  "TARGET_32BIT && arm_arch6"
1578  "umull%?\\t%Q0, %R0, %1, %2"
1579  [(set_attr "type" "umull")
1580   (set_attr "predicable" "yes")
1581   (set_attr "predicable_short_it" "no")]
1582)
1583
1584(define_expand "umaddsidi4"
1585  [(set (match_operand:DI 0 "s_register_operand" "")
1586	(plus:DI
1587	 (mult:DI
1588	  (zero_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1589	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" "")))
1590	 (match_operand:DI 3 "s_register_operand" "")))]
1591  "TARGET_32BIT && arm_arch3m"
1592  "")
1593
1594(define_insn "*umulsidi3adddi"
1595  [(set (match_operand:DI 0 "s_register_operand" "=&r")
1596	(plus:DI
1597	 (mult:DI
1598	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" "%r"))
1599	  (zero_extend:DI (match_operand:SI 3 "s_register_operand" "r")))
1600	 (match_operand:DI 1 "s_register_operand" "0")))]
1601  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1602  "umlal%?\\t%Q0, %R0, %3, %2"
1603  [(set_attr "type" "umlal")
1604   (set_attr "predicable" "yes")]
1605)
1606
1607(define_insn "*umulsidi3adddi_v6"
1608  [(set (match_operand:DI 0 "s_register_operand" "=r")
1609	(plus:DI
1610	 (mult:DI
1611	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r"))
1612	  (zero_extend:DI (match_operand:SI 3 "s_register_operand" "r")))
1613	 (match_operand:DI 1 "s_register_operand" "0")))]
1614  "TARGET_32BIT && arm_arch6"
1615  "umlal%?\\t%Q0, %R0, %3, %2"
1616  [(set_attr "type" "umlal")
1617   (set_attr "predicable" "yes")
1618   (set_attr "predicable_short_it" "no")]
1619)
1620
1621(define_expand "smulsi3_highpart"
1622  [(parallel
1623    [(set (match_operand:SI 0 "s_register_operand" "")
1624	  (truncate:SI
1625	   (lshiftrt:DI
1626	    (mult:DI
1627	     (sign_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1628	     (sign_extend:DI (match_operand:SI 2 "s_register_operand" "")))
1629	    (const_int 32))))
1630     (clobber (match_scratch:SI 3 ""))])]
1631  "TARGET_32BIT && arm_arch3m"
1632  ""
1633)
1634
1635(define_insn "*smulsi3_highpart_nov6"
1636  [(set (match_operand:SI 0 "s_register_operand" "=&r,&r")
1637	(truncate:SI
1638	 (lshiftrt:DI
1639	  (mult:DI
1640	   (sign_extend:DI (match_operand:SI 1 "s_register_operand" "%0,r"))
1641	   (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r,r")))
1642	  (const_int 32))))
1643   (clobber (match_scratch:SI 3 "=&r,&r"))]
1644  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1645  "smull%?\\t%3, %0, %2, %1"
1646  [(set_attr "type" "smull")
1647   (set_attr "predicable" "yes")]
1648)
1649
1650(define_insn "*smulsi3_highpart_v6"
1651  [(set (match_operand:SI 0 "s_register_operand" "=r")
1652	(truncate:SI
1653	 (lshiftrt:DI
1654	  (mult:DI
1655	   (sign_extend:DI (match_operand:SI 1 "s_register_operand" "r"))
1656	   (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r")))
1657	  (const_int 32))))
1658   (clobber (match_scratch:SI 3 "=r"))]
1659  "TARGET_32BIT && arm_arch6"
1660  "smull%?\\t%3, %0, %2, %1"
1661  [(set_attr "type" "smull")
1662   (set_attr "predicable" "yes")
1663   (set_attr "predicable_short_it" "no")]
1664)
1665
1666(define_expand "umulsi3_highpart"
1667  [(parallel
1668    [(set (match_operand:SI 0 "s_register_operand" "")
1669	  (truncate:SI
1670	   (lshiftrt:DI
1671	    (mult:DI
1672	     (zero_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1673	      (zero_extend:DI (match_operand:SI 2 "s_register_operand" "")))
1674	    (const_int 32))))
1675     (clobber (match_scratch:SI 3 ""))])]
1676  "TARGET_32BIT && arm_arch3m"
1677  ""
1678)
1679
1680(define_insn "*umulsi3_highpart_nov6"
1681  [(set (match_operand:SI 0 "s_register_operand" "=&r,&r")
1682	(truncate:SI
1683	 (lshiftrt:DI
1684	  (mult:DI
1685	   (zero_extend:DI (match_operand:SI 1 "s_register_operand" "%0,r"))
1686	   (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r,r")))
1687	  (const_int 32))))
1688   (clobber (match_scratch:SI 3 "=&r,&r"))]
1689  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1690  "umull%?\\t%3, %0, %2, %1"
1691  [(set_attr "type" "umull")
1692   (set_attr "predicable" "yes")]
1693)
1694
1695(define_insn "*umulsi3_highpart_v6"
1696  [(set (match_operand:SI 0 "s_register_operand" "=r")
1697	(truncate:SI
1698	 (lshiftrt:DI
1699	  (mult:DI
1700	   (zero_extend:DI (match_operand:SI 1 "s_register_operand" "r"))
1701	   (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r")))
1702	  (const_int 32))))
1703   (clobber (match_scratch:SI 3 "=r"))]
1704  "TARGET_32BIT && arm_arch6"
1705  "umull%?\\t%3, %0, %2, %1"
1706  [(set_attr "type" "umull")
1707   (set_attr "predicable" "yes")
1708   (set_attr "predicable_short_it" "no")]
1709)
1710
1711(define_insn "mulhisi3"
1712  [(set (match_operand:SI 0 "s_register_operand" "=r")
1713	(mult:SI (sign_extend:SI
1714		  (match_operand:HI 1 "s_register_operand" "%r"))
1715		 (sign_extend:SI
1716		  (match_operand:HI 2 "s_register_operand" "r"))))]
1717  "TARGET_DSP_MULTIPLY"
1718  "smulbb%?\\t%0, %1, %2"
1719  [(set_attr "type" "smulxy")
1720   (set_attr "predicable" "yes")]
1721)
1722
1723(define_insn "*mulhisi3tb"
1724  [(set (match_operand:SI 0 "s_register_operand" "=r")
1725	(mult:SI (ashiftrt:SI
1726		  (match_operand:SI 1 "s_register_operand" "r")
1727		  (const_int 16))
1728		 (sign_extend:SI
1729		  (match_operand:HI 2 "s_register_operand" "r"))))]
1730  "TARGET_DSP_MULTIPLY"
1731  "smultb%?\\t%0, %1, %2"
1732  [(set_attr "type" "smulxy")
1733   (set_attr "predicable" "yes")
1734   (set_attr "predicable_short_it" "no")]
1735)
1736
1737(define_insn "*mulhisi3bt"
1738  [(set (match_operand:SI 0 "s_register_operand" "=r")
1739	(mult:SI (sign_extend:SI
1740		  (match_operand:HI 1 "s_register_operand" "r"))
1741		 (ashiftrt:SI
1742		  (match_operand:SI 2 "s_register_operand" "r")
1743		  (const_int 16))))]
1744  "TARGET_DSP_MULTIPLY"
1745  "smulbt%?\\t%0, %1, %2"
1746  [(set_attr "type" "smulxy")
1747   (set_attr "predicable" "yes")
1748   (set_attr "predicable_short_it" "no")]
1749)
1750
1751(define_insn "*mulhisi3tt"
1752  [(set (match_operand:SI 0 "s_register_operand" "=r")
1753	(mult:SI (ashiftrt:SI
1754		  (match_operand:SI 1 "s_register_operand" "r")
1755		  (const_int 16))
1756		 (ashiftrt:SI
1757		  (match_operand:SI 2 "s_register_operand" "r")
1758		  (const_int 16))))]
1759  "TARGET_DSP_MULTIPLY"
1760  "smultt%?\\t%0, %1, %2"
1761  [(set_attr "type" "smulxy")
1762   (set_attr "predicable" "yes")
1763   (set_attr "predicable_short_it" "no")]
1764)
1765
1766(define_insn "maddhisi4"
1767  [(set (match_operand:SI 0 "s_register_operand" "=r")
1768	(plus:SI (mult:SI (sign_extend:SI
1769			   (match_operand:HI 1 "s_register_operand" "r"))
1770			  (sign_extend:SI
1771			   (match_operand:HI 2 "s_register_operand" "r")))
1772		 (match_operand:SI 3 "s_register_operand" "r")))]
1773  "TARGET_DSP_MULTIPLY"
1774  "smlabb%?\\t%0, %1, %2, %3"
1775  [(set_attr "type" "smlaxy")
1776   (set_attr "predicable" "yes")
1777   (set_attr "predicable_short_it" "no")]
1778)
1779
1780;; Note: there is no maddhisi4ibt because this one is canonical form
1781(define_insn "*maddhisi4tb"
1782  [(set (match_operand:SI 0 "s_register_operand" "=r")
1783	(plus:SI (mult:SI (ashiftrt:SI
1784			   (match_operand:SI 1 "s_register_operand" "r")
1785			   (const_int 16))
1786			  (sign_extend:SI
1787			   (match_operand:HI 2 "s_register_operand" "r")))
1788		 (match_operand:SI 3 "s_register_operand" "r")))]
1789  "TARGET_DSP_MULTIPLY"
1790  "smlatb%?\\t%0, %1, %2, %3"
1791  [(set_attr "type" "smlaxy")
1792   (set_attr "predicable" "yes")
1793   (set_attr "predicable_short_it" "no")]
1794)
1795
1796(define_insn "*maddhisi4tt"
1797  [(set (match_operand:SI 0 "s_register_operand" "=r")
1798	(plus:SI (mult:SI (ashiftrt:SI
1799			   (match_operand:SI 1 "s_register_operand" "r")
1800			   (const_int 16))
1801			  (ashiftrt:SI
1802			   (match_operand:SI 2 "s_register_operand" "r")
1803			   (const_int 16)))
1804		 (match_operand:SI 3 "s_register_operand" "r")))]
1805  "TARGET_DSP_MULTIPLY"
1806  "smlatt%?\\t%0, %1, %2, %3"
1807  [(set_attr "type" "smlaxy")
1808   (set_attr "predicable" "yes")
1809   (set_attr "predicable_short_it" "no")]
1810)
1811
1812(define_insn "maddhidi4"
1813  [(set (match_operand:DI 0 "s_register_operand" "=r")
1814	(plus:DI
1815	  (mult:DI (sign_extend:DI
1816		    (match_operand:HI 1 "s_register_operand" "r"))
1817		   (sign_extend:DI
1818		    (match_operand:HI 2 "s_register_operand" "r")))
1819	  (match_operand:DI 3 "s_register_operand" "0")))]
1820  "TARGET_DSP_MULTIPLY"
1821  "smlalbb%?\\t%Q0, %R0, %1, %2"
1822  [(set_attr "type" "smlalxy")
1823   (set_attr "predicable" "yes")
1824   (set_attr "predicable_short_it" "no")])
1825
1826;; Note: there is no maddhidi4ibt because this one is canonical form
1827(define_insn "*maddhidi4tb"
1828  [(set (match_operand:DI 0 "s_register_operand" "=r")
1829	(plus:DI
1830	  (mult:DI (sign_extend:DI
1831		    (ashiftrt:SI
1832		     (match_operand:SI 1 "s_register_operand" "r")
1833		     (const_int 16)))
1834		   (sign_extend:DI
1835		    (match_operand:HI 2 "s_register_operand" "r")))
1836	  (match_operand:DI 3 "s_register_operand" "0")))]
1837  "TARGET_DSP_MULTIPLY"
1838  "smlaltb%?\\t%Q0, %R0, %1, %2"
1839  [(set_attr "type" "smlalxy")
1840   (set_attr "predicable" "yes")
1841   (set_attr "predicable_short_it" "no")])
1842
1843(define_insn "*maddhidi4tt"
1844  [(set (match_operand:DI 0 "s_register_operand" "=r")
1845	(plus:DI
1846	  (mult:DI (sign_extend:DI
1847		    (ashiftrt:SI
1848		     (match_operand:SI 1 "s_register_operand" "r")
1849		     (const_int 16)))
1850		   (sign_extend:DI
1851		    (ashiftrt:SI
1852		     (match_operand:SI 2 "s_register_operand" "r")
1853		     (const_int 16))))
1854	  (match_operand:DI 3 "s_register_operand" "0")))]
1855  "TARGET_DSP_MULTIPLY"
1856  "smlaltt%?\\t%Q0, %R0, %1, %2"
1857  [(set_attr "type" "smlalxy")
1858   (set_attr "predicable" "yes")
1859   (set_attr "predicable_short_it" "no")])
1860
1861(define_expand "mulsf3"
1862  [(set (match_operand:SF          0 "s_register_operand" "")
1863	(mult:SF (match_operand:SF 1 "s_register_operand" "")
1864		 (match_operand:SF 2 "s_register_operand" "")))]
1865  "TARGET_32BIT && TARGET_HARD_FLOAT"
1866  "
1867")
1868
1869(define_expand "muldf3"
1870  [(set (match_operand:DF          0 "s_register_operand" "")
1871	(mult:DF (match_operand:DF 1 "s_register_operand" "")
1872		 (match_operand:DF 2 "s_register_operand" "")))]
1873  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
1874  "
1875")
1876
1877;; Division insns
1878
1879(define_expand "divsf3"
1880  [(set (match_operand:SF 0 "s_register_operand" "")
1881	(div:SF (match_operand:SF 1 "s_register_operand" "")
1882		(match_operand:SF 2 "s_register_operand" "")))]
1883  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP"
1884  "")
1885
1886(define_expand "divdf3"
1887  [(set (match_operand:DF 0 "s_register_operand" "")
1888	(div:DF (match_operand:DF 1 "s_register_operand" "")
1889		(match_operand:DF 2 "s_register_operand" "")))]
1890  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP_DOUBLE"
1891  "")
1892
1893;; Boolean and,ior,xor insns
1894
1895;; Split up double word logical operations
1896
1897;; Split up simple DImode logical operations.  Simply perform the logical
1898;; operation on the upper and lower halves of the registers.
1899(define_split
1900  [(set (match_operand:DI 0 "s_register_operand" "")
1901	(match_operator:DI 6 "logical_binary_operator"
1902	  [(match_operand:DI 1 "s_register_operand" "")
1903	   (match_operand:DI 2 "s_register_operand" "")]))]
1904  "TARGET_32BIT && reload_completed
1905   && ! (TARGET_NEON && IS_VFP_REGNUM (REGNO (operands[0])))
1906   && ! IS_IWMMXT_REGNUM (REGNO (operands[0]))"
1907  [(set (match_dup 0) (match_op_dup:SI 6 [(match_dup 1) (match_dup 2)]))
1908   (set (match_dup 3) (match_op_dup:SI 6 [(match_dup 4) (match_dup 5)]))]
1909  "
1910  {
1911    operands[3] = gen_highpart (SImode, operands[0]);
1912    operands[0] = gen_lowpart (SImode, operands[0]);
1913    operands[4] = gen_highpart (SImode, operands[1]);
1914    operands[1] = gen_lowpart (SImode, operands[1]);
1915    operands[5] = gen_highpart (SImode, operands[2]);
1916    operands[2] = gen_lowpart (SImode, operands[2]);
1917  }"
1918)
1919
1920(define_split
1921  [(set (match_operand:DI 0 "s_register_operand" "")
1922	(match_operator:DI 6 "logical_binary_operator"
1923	  [(sign_extend:DI (match_operand:SI 2 "s_register_operand" ""))
1924	   (match_operand:DI 1 "s_register_operand" "")]))]
1925  "TARGET_32BIT && reload_completed"
1926  [(set (match_dup 0) (match_op_dup:SI 6 [(match_dup 1) (match_dup 2)]))
1927   (set (match_dup 3) (match_op_dup:SI 6
1928			[(ashiftrt:SI (match_dup 2) (const_int 31))
1929			 (match_dup 4)]))]
1930  "
1931  {
1932    operands[3] = gen_highpart (SImode, operands[0]);
1933    operands[0] = gen_lowpart (SImode, operands[0]);
1934    operands[4] = gen_highpart (SImode, operands[1]);
1935    operands[1] = gen_lowpart (SImode, operands[1]);
1936    operands[5] = gen_highpart (SImode, operands[2]);
1937    operands[2] = gen_lowpart (SImode, operands[2]);
1938  }"
1939)
1940
1941;; The zero extend of operand 2 means we can just copy the high part of
1942;; operand1 into operand0.
1943(define_split
1944  [(set (match_operand:DI 0 "s_register_operand" "")
1945	(ior:DI
1946	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" ""))
1947	  (match_operand:DI 1 "s_register_operand" "")))]
1948  "TARGET_32BIT && operands[0] != operands[1] && reload_completed"
1949  [(set (match_dup 0) (ior:SI (match_dup 1) (match_dup 2)))
1950   (set (match_dup 3) (match_dup 4))]
1951  "
1952  {
1953    operands[4] = gen_highpart (SImode, operands[1]);
1954    operands[3] = gen_highpart (SImode, operands[0]);
1955    operands[0] = gen_lowpart (SImode, operands[0]);
1956    operands[1] = gen_lowpart (SImode, operands[1]);
1957  }"
1958)
1959
1960;; The zero extend of operand 2 means we can just copy the high part of
1961;; operand1 into operand0.
1962(define_split
1963  [(set (match_operand:DI 0 "s_register_operand" "")
1964	(xor:DI
1965	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" ""))
1966	  (match_operand:DI 1 "s_register_operand" "")))]
1967  "TARGET_32BIT && operands[0] != operands[1] && reload_completed"
1968  [(set (match_dup 0) (xor:SI (match_dup 1) (match_dup 2)))
1969   (set (match_dup 3) (match_dup 4))]
1970  "
1971  {
1972    operands[4] = gen_highpart (SImode, operands[1]);
1973    operands[3] = gen_highpart (SImode, operands[0]);
1974    operands[0] = gen_lowpart (SImode, operands[0]);
1975    operands[1] = gen_lowpart (SImode, operands[1]);
1976  }"
1977)
1978
1979(define_expand "anddi3"
1980  [(set (match_operand:DI         0 "s_register_operand" "")
1981	(and:DI (match_operand:DI 1 "s_register_operand" "")
1982		(match_operand:DI 2 "neon_inv_logic_op2" "")))]
1983  "TARGET_32BIT"
1984  ""
1985)
1986
1987(define_insn_and_split "*anddi3_insn"
1988  [(set (match_operand:DI         0 "s_register_operand"     "=w,w ,&r,&r,&r,&r,?w,?w")
1989        (and:DI (match_operand:DI 1 "s_register_operand"     "%w,0 ,0 ,r ,0 ,r ,w ,0")
1990                (match_operand:DI 2 "arm_anddi_operand_neon" "w ,DL,r ,r ,De,De,w ,DL")))]
1991  "TARGET_32BIT && !TARGET_IWMMXT"
1992{
1993  switch (which_alternative)
1994    {
1995    case 0: /* fall through */
1996    case 6: return "vand\t%P0, %P1, %P2";
1997    case 1: /* fall through */
1998    case 7: return neon_output_logic_immediate ("vand", &operands[2],
1999                    DImode, 1, VALID_NEON_QREG_MODE (DImode));
2000    case 2:
2001    case 3:
2002    case 4:
2003    case 5: /* fall through */
2004      return "#";
2005    default: gcc_unreachable ();
2006    }
2007}
2008  "TARGET_32BIT && !TARGET_IWMMXT && reload_completed
2009   && !(IS_VFP_REGNUM (REGNO (operands[0])))"
2010  [(set (match_dup 3) (match_dup 4))
2011   (set (match_dup 5) (match_dup 6))]
2012  "
2013  {
2014    operands[3] = gen_lowpart (SImode, operands[0]);
2015    operands[5] = gen_highpart (SImode, operands[0]);
2016
2017    operands[4] = simplify_gen_binary (AND, SImode,
2018                                           gen_lowpart (SImode, operands[1]),
2019                                           gen_lowpart (SImode, operands[2]));
2020    operands[6] = simplify_gen_binary (AND, SImode,
2021                                           gen_highpart (SImode, operands[1]),
2022                                           gen_highpart_mode (SImode, DImode, operands[2]));
2023
2024  }"
2025  [(set_attr "type" "neon_logic,neon_logic,multiple,multiple,\
2026                     multiple,multiple,neon_logic,neon_logic")
2027   (set_attr "arch" "neon_for_64bits,neon_for_64bits,*,*,*,*,
2028                     avoid_neon_for_64bits,avoid_neon_for_64bits")
2029   (set_attr "length" "*,*,8,8,8,8,*,*")
2030  ]
2031)
2032
2033(define_insn_and_split "*anddi_zesidi_di"
2034  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2035	(and:DI (zero_extend:DI
2036		 (match_operand:SI 2 "s_register_operand" "r,r"))
2037		(match_operand:DI 1 "s_register_operand" "0,r")))]
2038  "TARGET_32BIT"
2039  "#"
2040  "TARGET_32BIT && reload_completed"
2041  ; The zero extend of operand 2 clears the high word of the output
2042  ; operand.
2043  [(set (match_dup 0) (and:SI (match_dup 1) (match_dup 2)))
2044   (set (match_dup 3) (const_int 0))]
2045  "
2046  {
2047    operands[3] = gen_highpart (SImode, operands[0]);
2048    operands[0] = gen_lowpart (SImode, operands[0]);
2049    operands[1] = gen_lowpart (SImode, operands[1]);
2050  }"
2051  [(set_attr "length" "8")
2052   (set_attr "type" "multiple")]
2053)
2054
2055(define_insn "*anddi_sesdi_di"
2056  [(set (match_operand:DI          0 "s_register_operand" "=&r,&r")
2057	(and:DI (sign_extend:DI
2058		 (match_operand:SI 2 "s_register_operand" "r,r"))
2059		(match_operand:DI  1 "s_register_operand" "0,r")))]
2060  "TARGET_32BIT"
2061  "#"
2062  [(set_attr "length" "8")
2063   (set_attr "type" "multiple")]
2064)
2065
2066(define_expand "andsi3"
2067  [(set (match_operand:SI         0 "s_register_operand" "")
2068	(and:SI (match_operand:SI 1 "s_register_operand" "")
2069		(match_operand:SI 2 "reg_or_int_operand" "")))]
2070  "TARGET_EITHER"
2071  "
2072  if (TARGET_32BIT)
2073    {
2074      if (CONST_INT_P (operands[2]))
2075        {
2076	  if (INTVAL (operands[2]) == 255 && arm_arch6)
2077	    {
2078	      operands[1] = convert_to_mode (QImode, operands[1], 1);
2079	      emit_insn (gen_thumb2_zero_extendqisi2_v6 (operands[0],
2080							 operands[1]));
2081	    }
2082	  else
2083	    arm_split_constant (AND, SImode, NULL_RTX,
2084				INTVAL (operands[2]), operands[0],
2085				operands[1],
2086				optimize && can_create_pseudo_p ());
2087
2088          DONE;
2089        }
2090    }
2091  else /* TARGET_THUMB1 */
2092    {
2093      if (!CONST_INT_P (operands[2]))
2094        {
2095          rtx tmp = force_reg (SImode, operands[2]);
2096	  if (rtx_equal_p (operands[0], operands[1]))
2097	    operands[2] = tmp;
2098	  else
2099	    {
2100              operands[2] = operands[1];
2101              operands[1] = tmp;
2102	    }
2103        }
2104      else
2105        {
2106          int i;
2107	  
2108          if (((unsigned HOST_WIDE_INT) ~INTVAL (operands[2])) < 256)
2109  	    {
2110	      operands[2] = force_reg (SImode,
2111				       GEN_INT (~INTVAL (operands[2])));
2112	      
2113	      emit_insn (gen_thumb1_bicsi3 (operands[0], operands[2], operands[1]));
2114	      
2115	      DONE;
2116	    }
2117
2118          for (i = 9; i <= 31; i++)
2119	    {
2120	      if ((((HOST_WIDE_INT) 1) << i) - 1 == INTVAL (operands[2]))
2121	        {
2122	          emit_insn (gen_extzv (operands[0], operands[1], GEN_INT (i),
2123			 	        const0_rtx));
2124	          DONE;
2125	        }
2126	      else if ((((HOST_WIDE_INT) 1) << i) - 1
2127		       == ~INTVAL (operands[2]))
2128	        {
2129	          rtx shift = GEN_INT (i);
2130	          rtx reg = gen_reg_rtx (SImode);
2131		
2132	          emit_insn (gen_lshrsi3 (reg, operands[1], shift));
2133	          emit_insn (gen_ashlsi3 (operands[0], reg, shift));
2134		  
2135	          DONE;
2136	        }
2137	    }
2138
2139          operands[2] = force_reg (SImode, operands[2]);
2140        }
2141    }
2142  "
2143)
2144
2145; ??? Check split length for Thumb-2
2146(define_insn_and_split "*arm_andsi3_insn"
2147  [(set (match_operand:SI         0 "s_register_operand" "=r,l,r,r,r")
2148	(and:SI (match_operand:SI 1 "s_register_operand" "%r,0,r,r,r")
2149		(match_operand:SI 2 "reg_or_int_operand" "I,l,K,r,?n")))]
2150  "TARGET_32BIT"
2151  "@
2152   and%?\\t%0, %1, %2
2153   and%?\\t%0, %1, %2
2154   bic%?\\t%0, %1, #%B2
2155   and%?\\t%0, %1, %2
2156   #"
2157  "TARGET_32BIT
2158   && CONST_INT_P (operands[2])
2159   && !(const_ok_for_arm (INTVAL (operands[2]))
2160	|| const_ok_for_arm (~INTVAL (operands[2])))"
2161  [(clobber (const_int 0))]
2162  "
2163  arm_split_constant  (AND, SImode, curr_insn, 
2164	               INTVAL (operands[2]), operands[0], operands[1], 0);
2165  DONE;
2166  "
2167  [(set_attr "length" "4,4,4,4,16")
2168   (set_attr "predicable" "yes")
2169   (set_attr "predicable_short_it" "no,yes,no,no,no")
2170   (set_attr "type" "logic_imm,logic_imm,logic_reg,logic_reg,logic_imm")]
2171)
2172
2173(define_insn "*andsi3_compare0"
2174  [(set (reg:CC_NOOV CC_REGNUM)
2175	(compare:CC_NOOV
2176	 (and:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
2177		 (match_operand:SI 2 "arm_not_operand" "I,K,r"))
2178	 (const_int 0)))
2179   (set (match_operand:SI          0 "s_register_operand" "=r,r,r")
2180	(and:SI (match_dup 1) (match_dup 2)))]
2181  "TARGET_32BIT"
2182  "@
2183   and%.\\t%0, %1, %2
2184   bic%.\\t%0, %1, #%B2
2185   and%.\\t%0, %1, %2"
2186  [(set_attr "conds" "set")
2187   (set_attr "type" "logics_imm,logics_imm,logics_reg")]
2188)
2189
2190(define_insn "*andsi3_compare0_scratch"
2191  [(set (reg:CC_NOOV CC_REGNUM)
2192	(compare:CC_NOOV
2193	 (and:SI (match_operand:SI 0 "s_register_operand" "r,r,r")
2194		 (match_operand:SI 1 "arm_not_operand" "I,K,r"))
2195	 (const_int 0)))
2196   (clobber (match_scratch:SI 2 "=X,r,X"))]
2197  "TARGET_32BIT"
2198  "@
2199   tst%?\\t%0, %1
2200   bic%.\\t%2, %0, #%B1
2201   tst%?\\t%0, %1"
2202  [(set_attr "conds" "set")
2203   (set_attr "type"  "logics_imm,logics_imm,logics_reg")]
2204)
2205
2206(define_insn "*zeroextractsi_compare0_scratch"
2207  [(set (reg:CC_NOOV CC_REGNUM)
2208	(compare:CC_NOOV (zero_extract:SI
2209			  (match_operand:SI 0 "s_register_operand" "r")
2210			  (match_operand 1 "const_int_operand" "n")
2211			  (match_operand 2 "const_int_operand" "n"))
2212			 (const_int 0)))]
2213  "TARGET_32BIT
2214  && (INTVAL (operands[2]) >= 0 && INTVAL (operands[2]) < 32
2215      && INTVAL (operands[1]) > 0 
2216      && INTVAL (operands[1]) + (INTVAL (operands[2]) & 1) <= 8
2217      && INTVAL (operands[1]) + INTVAL (operands[2]) <= 32)"
2218  "*
2219  operands[1] = GEN_INT (((1 << INTVAL (operands[1])) - 1)
2220			 << INTVAL (operands[2]));
2221  output_asm_insn (\"tst%?\\t%0, %1\", operands);
2222  return \"\";
2223  "
2224  [(set_attr "conds" "set")
2225   (set_attr "predicable" "yes")
2226   (set_attr "predicable_short_it" "no")
2227   (set_attr "type" "logics_imm")]
2228)
2229
2230(define_insn_and_split "*ne_zeroextractsi"
2231  [(set (match_operand:SI 0 "s_register_operand" "=r")
2232	(ne:SI (zero_extract:SI
2233		(match_operand:SI 1 "s_register_operand" "r")
2234		(match_operand:SI 2 "const_int_operand" "n")
2235		(match_operand:SI 3 "const_int_operand" "n"))
2236	       (const_int 0)))
2237   (clobber (reg:CC CC_REGNUM))]
2238  "TARGET_32BIT
2239   && (INTVAL (operands[3]) >= 0 && INTVAL (operands[3]) < 32
2240       && INTVAL (operands[2]) > 0 
2241       && INTVAL (operands[2]) + (INTVAL (operands[3]) & 1) <= 8
2242       && INTVAL (operands[2]) + INTVAL (operands[3]) <= 32)"
2243  "#"
2244  "TARGET_32BIT
2245   && (INTVAL (operands[3]) >= 0 && INTVAL (operands[3]) < 32
2246       && INTVAL (operands[2]) > 0 
2247       && INTVAL (operands[2]) + (INTVAL (operands[3]) & 1) <= 8
2248       && INTVAL (operands[2]) + INTVAL (operands[3]) <= 32)"
2249  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
2250		   (compare:CC_NOOV (and:SI (match_dup 1) (match_dup 2))
2251				    (const_int 0)))
2252	      (set (match_dup 0) (and:SI (match_dup 1) (match_dup 2)))])
2253   (set (match_dup 0)
2254	(if_then_else:SI (eq (reg:CC_NOOV CC_REGNUM) (const_int 0))
2255			 (match_dup 0) (const_int 1)))]
2256  "
2257  operands[2] = GEN_INT (((1 << INTVAL (operands[2])) - 1)
2258			 << INTVAL (operands[3])); 
2259  "
2260  [(set_attr "conds" "clob")
2261   (set (attr "length")
2262	(if_then_else (eq_attr "is_thumb" "yes")
2263		      (const_int 12)
2264		      (const_int 8)))
2265   (set_attr "type" "multiple")]
2266)
2267
2268(define_insn_and_split "*ne_zeroextractsi_shifted"
2269  [(set (match_operand:SI 0 "s_register_operand" "=r")
2270	(ne:SI (zero_extract:SI
2271		(match_operand:SI 1 "s_register_operand" "r")
2272		(match_operand:SI 2 "const_int_operand" "n")
2273		(const_int 0))
2274	       (const_int 0)))
2275   (clobber (reg:CC CC_REGNUM))]
2276  "TARGET_ARM"
2277  "#"
2278  "TARGET_ARM"
2279  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
2280		   (compare:CC_NOOV (ashift:SI (match_dup 1) (match_dup 2))
2281				    (const_int 0)))
2282	      (set (match_dup 0) (ashift:SI (match_dup 1) (match_dup 2)))])
2283   (set (match_dup 0)
2284	(if_then_else:SI (eq (reg:CC_NOOV CC_REGNUM) (const_int 0))
2285			 (match_dup 0) (const_int 1)))]
2286  "
2287  operands[2] = GEN_INT (32 - INTVAL (operands[2]));
2288  "
2289  [(set_attr "conds" "clob")
2290   (set_attr "length" "8")
2291   (set_attr "type" "multiple")]
2292)
2293
2294(define_insn_and_split "*ite_ne_zeroextractsi"
2295  [(set (match_operand:SI 0 "s_register_operand" "=r")
2296	(if_then_else:SI (ne (zero_extract:SI
2297			      (match_operand:SI 1 "s_register_operand" "r")
2298			      (match_operand:SI 2 "const_int_operand" "n")
2299			      (match_operand:SI 3 "const_int_operand" "n"))
2300			     (const_int 0))
2301			 (match_operand:SI 4 "arm_not_operand" "rIK")
2302			 (const_int 0)))
2303   (clobber (reg:CC CC_REGNUM))]
2304  "TARGET_ARM
2305   && (INTVAL (operands[3]) >= 0 && INTVAL (operands[3]) < 32
2306       && INTVAL (operands[2]) > 0 
2307       && INTVAL (operands[2]) + (INTVAL (operands[3]) & 1) <= 8
2308       && INTVAL (operands[2]) + INTVAL (operands[3]) <= 32)
2309   && !reg_overlap_mentioned_p (operands[0], operands[4])"
2310  "#"
2311  "TARGET_ARM
2312   && (INTVAL (operands[3]) >= 0 && INTVAL (operands[3]) < 32
2313       && INTVAL (operands[2]) > 0 
2314       && INTVAL (operands[2]) + (INTVAL (operands[3]) & 1) <= 8
2315       && INTVAL (operands[2]) + INTVAL (operands[3]) <= 32)
2316   && !reg_overlap_mentioned_p (operands[0], operands[4])"
2317  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
2318		   (compare:CC_NOOV (and:SI (match_dup 1) (match_dup 2))
2319				    (const_int 0)))
2320	      (set (match_dup 0) (and:SI (match_dup 1) (match_dup 2)))])
2321   (set (match_dup 0)
2322	(if_then_else:SI (eq (reg:CC_NOOV CC_REGNUM) (const_int 0))
2323			 (match_dup 0) (match_dup 4)))]
2324  "
2325  operands[2] = GEN_INT (((1 << INTVAL (operands[2])) - 1)
2326			 << INTVAL (operands[3])); 
2327  "
2328  [(set_attr "conds" "clob")
2329   (set_attr "length" "8")
2330   (set_attr "type" "multiple")]
2331)
2332
2333(define_insn_and_split "*ite_ne_zeroextractsi_shifted"
2334  [(set (match_operand:SI 0 "s_register_operand" "=r")
2335	(if_then_else:SI (ne (zero_extract:SI
2336			      (match_operand:SI 1 "s_register_operand" "r")
2337			      (match_operand:SI 2 "const_int_operand" "n")
2338			      (const_int 0))
2339			     (const_int 0))
2340			 (match_operand:SI 3 "arm_not_operand" "rIK")
2341			 (const_int 0)))
2342   (clobber (reg:CC CC_REGNUM))]
2343  "TARGET_ARM && !reg_overlap_mentioned_p (operands[0], operands[3])"
2344  "#"
2345  "TARGET_ARM && !reg_overlap_mentioned_p (operands[0], operands[3])"
2346  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
2347		   (compare:CC_NOOV (ashift:SI (match_dup 1) (match_dup 2))
2348				    (const_int 0)))
2349	      (set (match_dup 0) (ashift:SI (match_dup 1) (match_dup 2)))])
2350   (set (match_dup 0)
2351	(if_then_else:SI (eq (reg:CC_NOOV CC_REGNUM) (const_int 0))
2352			 (match_dup 0) (match_dup 3)))]
2353  "
2354  operands[2] = GEN_INT (32 - INTVAL (operands[2]));
2355  "
2356  [(set_attr "conds" "clob")
2357   (set_attr "length" "8")
2358   (set_attr "type" "multiple")]
2359)
2360
2361;; ??? Use Thumb-2 has bitfield insert/extract instructions.
2362(define_split
2363  [(set (match_operand:SI 0 "s_register_operand" "")
2364	(match_operator:SI 1 "shiftable_operator"
2365	 [(zero_extract:SI (match_operand:SI 2 "s_register_operand" "")
2366			   (match_operand:SI 3 "const_int_operand" "")
2367			   (match_operand:SI 4 "const_int_operand" ""))
2368	  (match_operand:SI 5 "s_register_operand" "")]))
2369   (clobber (match_operand:SI 6 "s_register_operand" ""))]
2370  "TARGET_ARM"
2371  [(set (match_dup 6) (ashift:SI (match_dup 2) (match_dup 3)))
2372   (set (match_dup 0)
2373	(match_op_dup 1
2374	 [(lshiftrt:SI (match_dup 6) (match_dup 4))
2375	  (match_dup 5)]))]
2376  "{
2377     HOST_WIDE_INT temp = INTVAL (operands[3]);
2378
2379     operands[3] = GEN_INT (32 - temp - INTVAL (operands[4]));
2380     operands[4] = GEN_INT (32 - temp);
2381   }"
2382)
2383  
2384(define_split
2385  [(set (match_operand:SI 0 "s_register_operand" "")
2386	(match_operator:SI 1 "shiftable_operator"
2387	 [(sign_extract:SI (match_operand:SI 2 "s_register_operand" "")
2388			   (match_operand:SI 3 "const_int_operand" "")
2389			   (match_operand:SI 4 "const_int_operand" ""))
2390	  (match_operand:SI 5 "s_register_operand" "")]))
2391   (clobber (match_operand:SI 6 "s_register_operand" ""))]
2392  "TARGET_ARM"
2393  [(set (match_dup 6) (ashift:SI (match_dup 2) (match_dup 3)))
2394   (set (match_dup 0)
2395	(match_op_dup 1
2396	 [(ashiftrt:SI (match_dup 6) (match_dup 4))
2397	  (match_dup 5)]))]
2398  "{
2399     HOST_WIDE_INT temp = INTVAL (operands[3]);
2400
2401     operands[3] = GEN_INT (32 - temp - INTVAL (operands[4]));
2402     operands[4] = GEN_INT (32 - temp);
2403   }"
2404)
2405  
2406;;; ??? This pattern is bogus.  If operand3 has bits outside the range
2407;;; represented by the bitfield, then this will produce incorrect results.
2408;;; Somewhere, the value needs to be truncated.  On targets like the m68k,
2409;;; which have a real bit-field insert instruction, the truncation happens
2410;;; in the bit-field insert instruction itself.  Since arm does not have a
2411;;; bit-field insert instruction, we would have to emit code here to truncate
2412;;; the value before we insert.  This loses some of the advantage of having
2413;;; this insv pattern, so this pattern needs to be reevalutated.
2414
2415(define_expand "insv"
2416  [(set (zero_extract (match_operand 0 "nonimmediate_operand" "")
2417                      (match_operand 1 "general_operand" "")
2418                      (match_operand 2 "general_operand" ""))
2419        (match_operand 3 "reg_or_int_operand" ""))]
2420  "TARGET_ARM || arm_arch_thumb2"
2421  "
2422  {
2423    int start_bit = INTVAL (operands[2]);
2424    int width = INTVAL (operands[1]);
2425    HOST_WIDE_INT mask = (((HOST_WIDE_INT)1) << width) - 1;
2426    rtx target, subtarget;
2427
2428    if (arm_arch_thumb2)
2429      {
2430        if (unaligned_access && MEM_P (operands[0])
2431	    && s_register_operand (operands[3], GET_MODE (operands[3]))
2432	    && (width == 16 || width == 32) && (start_bit % BITS_PER_UNIT) == 0)
2433	  {
2434	    rtx base_addr;
2435
2436	    if (BYTES_BIG_ENDIAN)
2437	      start_bit = GET_MODE_BITSIZE (GET_MODE (operands[3])) - width
2438			  - start_bit;
2439
2440	    if (width == 32)
2441	      {
2442	        base_addr = adjust_address (operands[0], SImode,
2443					    start_bit / BITS_PER_UNIT);
2444		emit_insn (gen_unaligned_storesi (base_addr, operands[3]));
2445	      }
2446	    else
2447	      {
2448	        rtx tmp = gen_reg_rtx (HImode);
2449
2450	        base_addr = adjust_address (operands[0], HImode,
2451					    start_bit / BITS_PER_UNIT);
2452		emit_move_insn (tmp, gen_lowpart (HImode, operands[3]));
2453		emit_insn (gen_unaligned_storehi (base_addr, tmp));
2454	      }
2455	    DONE;
2456	  }
2457	else if (s_register_operand (operands[0], GET_MODE (operands[0])))
2458	  {
2459	    bool use_bfi = TRUE;
2460
2461	    if (CONST_INT_P (operands[3]))
2462	      {
2463		HOST_WIDE_INT val = INTVAL (operands[3]) & mask;
2464
2465		if (val == 0)
2466		  {
2467		    emit_insn (gen_insv_zero (operands[0], operands[1],
2468					      operands[2]));
2469		    DONE;
2470		  }
2471
2472		/* See if the set can be done with a single orr instruction.  */
2473		if (val == mask && const_ok_for_arm (val << start_bit))
2474		  use_bfi = FALSE;
2475	      }
2476
2477	    if (use_bfi)
2478	      {
2479		if (!REG_P (operands[3]))
2480		  operands[3] = force_reg (SImode, operands[3]);
2481
2482		emit_insn (gen_insv_t2 (operands[0], operands[1], operands[2],
2483					operands[3]));
2484		DONE;
2485	      }
2486	  }
2487	else
2488	  FAIL;
2489      }
2490
2491    if (!s_register_operand (operands[0], GET_MODE (operands[0])))
2492      FAIL;
2493
2494    target = copy_rtx (operands[0]);
2495    /* Avoid using a subreg as a subtarget, and avoid writing a paradoxical 
2496       subreg as the final target.  */
2497    if (GET_CODE (target) == SUBREG)
2498      {
2499	subtarget = gen_reg_rtx (SImode);
2500	if (GET_MODE_SIZE (GET_MODE (SUBREG_REG (target)))
2501	    < GET_MODE_SIZE (SImode))
2502	  target = SUBREG_REG (target);
2503      }
2504    else
2505      subtarget = target;    
2506
2507    if (CONST_INT_P (operands[3]))
2508      {
2509	/* Since we are inserting a known constant, we may be able to
2510	   reduce the number of bits that we have to clear so that
2511	   the mask becomes simple.  */
2512	/* ??? This code does not check to see if the new mask is actually
2513	   simpler.  It may not be.  */
2514	rtx op1 = gen_reg_rtx (SImode);
2515	/* ??? Truncate operand3 to fit in the bitfield.  See comment before
2516	   start of this pattern.  */
2517	HOST_WIDE_INT op3_value = mask & INTVAL (operands[3]);
2518	HOST_WIDE_INT mask2 = ((mask & ~op3_value) << start_bit);
2519
2520	emit_insn (gen_andsi3 (op1, operands[0],
2521			       gen_int_mode (~mask2, SImode)));
2522	emit_insn (gen_iorsi3 (subtarget, op1,
2523			       gen_int_mode (op3_value << start_bit, SImode)));
2524      }
2525    else if (start_bit == 0
2526	     && !(const_ok_for_arm (mask)
2527		  || const_ok_for_arm (~mask)))
2528      {
2529	/* A Trick, since we are setting the bottom bits in the word,
2530	   we can shift operand[3] up, operand[0] down, OR them together
2531	   and rotate the result back again.  This takes 3 insns, and
2532	   the third might be mergeable into another op.  */
2533	/* The shift up copes with the possibility that operand[3] is
2534           wider than the bitfield.  */
2535	rtx op0 = gen_reg_rtx (SImode);
2536	rtx op1 = gen_reg_rtx (SImode);
2537
2538	emit_insn (gen_ashlsi3 (op0, operands[3], GEN_INT (32 - width)));
2539	emit_insn (gen_lshrsi3 (op1, operands[0], operands[1]));
2540	emit_insn (gen_iorsi3  (op1, op1, op0));
2541	emit_insn (gen_rotlsi3 (subtarget, op1, operands[1]));
2542      }
2543    else if ((width + start_bit == 32)
2544	     && !(const_ok_for_arm (mask)
2545		  || const_ok_for_arm (~mask)))
2546      {
2547	/* Similar trick, but slightly less efficient.  */
2548
2549	rtx op0 = gen_reg_rtx (SImode);
2550	rtx op1 = gen_reg_rtx (SImode);
2551
2552	emit_insn (gen_ashlsi3 (op0, operands[3], GEN_INT (32 - width)));
2553	emit_insn (gen_ashlsi3 (op1, operands[0], operands[1]));
2554	emit_insn (gen_lshrsi3 (op1, op1, operands[1]));
2555	emit_insn (gen_iorsi3 (subtarget, op1, op0));
2556      }
2557    else
2558      {
2559	rtx op0 = gen_int_mode (mask, SImode);
2560	rtx op1 = gen_reg_rtx (SImode);
2561	rtx op2 = gen_reg_rtx (SImode);
2562
2563	if (!(const_ok_for_arm (mask) || const_ok_for_arm (~mask)))
2564	  {
2565	    rtx tmp = gen_reg_rtx (SImode);
2566
2567	    emit_insn (gen_movsi (tmp, op0));
2568	    op0 = tmp;
2569	  }
2570
2571	/* Mask out any bits in operand[3] that are not needed.  */
2572	   emit_insn (gen_andsi3 (op1, operands[3], op0));
2573
2574	if (CONST_INT_P (op0)
2575	    && (const_ok_for_arm (mask << start_bit)
2576		|| const_ok_for_arm (~(mask << start_bit))))
2577	  {
2578	    op0 = gen_int_mode (~(mask << start_bit), SImode);
2579	    emit_insn (gen_andsi3 (op2, operands[0], op0));
2580	  }
2581	else
2582	  {
2583	    if (CONST_INT_P (op0))
2584	      {
2585		rtx tmp = gen_reg_rtx (SImode);
2586
2587		emit_insn (gen_movsi (tmp, op0));
2588		op0 = tmp;
2589	      }
2590
2591	    if (start_bit != 0)
2592	      emit_insn (gen_ashlsi3 (op0, op0, operands[2]));
2593	    
2594	    emit_insn (gen_andsi_notsi_si (op2, operands[0], op0));
2595	  }
2596
2597	if (start_bit != 0)
2598          emit_insn (gen_ashlsi3 (op1, op1, operands[2]));
2599
2600	emit_insn (gen_iorsi3 (subtarget, op1, op2));
2601      }
2602
2603    if (subtarget != target)
2604      {
2605	/* If TARGET is still a SUBREG, then it must be wider than a word,
2606	   so we must be careful only to set the subword we were asked to.  */
2607	if (GET_CODE (target) == SUBREG)
2608	  emit_move_insn (target, subtarget);
2609	else
2610	  emit_move_insn (target, gen_lowpart (GET_MODE (target), subtarget));
2611      }
2612
2613    DONE;
2614  }"
2615)
2616
2617(define_insn "insv_zero"
2618  [(set (zero_extract:SI (match_operand:SI 0 "s_register_operand" "+r")
2619                         (match_operand:SI 1 "const_int_M_operand" "M")
2620                         (match_operand:SI 2 "const_int_M_operand" "M"))
2621        (const_int 0))]
2622  "arm_arch_thumb2"
2623  "bfc%?\t%0, %2, %1"
2624  [(set_attr "length" "4")
2625   (set_attr "predicable" "yes")
2626   (set_attr "predicable_short_it" "no")
2627   (set_attr "type" "bfm")]
2628)
2629
2630(define_insn "insv_t2"
2631  [(set (zero_extract:SI (match_operand:SI 0 "s_register_operand" "+r")
2632                         (match_operand:SI 1 "const_int_M_operand" "M")
2633                         (match_operand:SI 2 "const_int_M_operand" "M"))
2634        (match_operand:SI 3 "s_register_operand" "r"))]
2635  "arm_arch_thumb2"
2636  "bfi%?\t%0, %3, %2, %1"
2637  [(set_attr "length" "4")
2638   (set_attr "predicable" "yes")
2639   (set_attr "predicable_short_it" "no")
2640   (set_attr "type" "bfm")]
2641)
2642
2643; constants for op 2 will never be given to these patterns.
2644(define_insn_and_split "*anddi_notdi_di"
2645  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2646	(and:DI (not:DI (match_operand:DI 1 "s_register_operand" "0,r"))
2647		(match_operand:DI 2 "s_register_operand" "r,0")))]
2648  "TARGET_32BIT"
2649  "#"
2650  "TARGET_32BIT && reload_completed
2651   && ! (TARGET_NEON && IS_VFP_REGNUM (REGNO (operands[0])))
2652   && ! IS_IWMMXT_REGNUM (REGNO (operands[0]))"
2653  [(set (match_dup 0) (and:SI (not:SI (match_dup 1)) (match_dup 2)))
2654   (set (match_dup 3) (and:SI (not:SI (match_dup 4)) (match_dup 5)))]
2655  "
2656  {
2657    operands[3] = gen_highpart (SImode, operands[0]);
2658    operands[0] = gen_lowpart (SImode, operands[0]);
2659    operands[4] = gen_highpart (SImode, operands[1]);
2660    operands[1] = gen_lowpart (SImode, operands[1]);
2661    operands[5] = gen_highpart (SImode, operands[2]);
2662    operands[2] = gen_lowpart (SImode, operands[2]);
2663  }"
2664  [(set_attr "length" "8")
2665   (set_attr "predicable" "yes")
2666   (set_attr "type" "multiple")]
2667)
2668
2669(define_insn_and_split "*anddi_notzesidi_di"
2670  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2671	(and:DI (not:DI (zero_extend:DI
2672			 (match_operand:SI 2 "s_register_operand" "r,r")))
2673		(match_operand:DI 1 "s_register_operand" "0,?r")))]
2674  "TARGET_32BIT"
2675  "@
2676   bic%?\\t%Q0, %Q1, %2
2677   #"
2678  ; (not (zero_extend ...)) allows us to just copy the high word from
2679  ; operand1 to operand0.
2680  "TARGET_32BIT
2681   && reload_completed
2682   && operands[0] != operands[1]"
2683  [(set (match_dup 0) (and:SI (not:SI (match_dup 2)) (match_dup 1)))
2684   (set (match_dup 3) (match_dup 4))]
2685  "
2686  {
2687    operands[3] = gen_highpart (SImode, operands[0]);
2688    operands[0] = gen_lowpart (SImode, operands[0]);
2689    operands[4] = gen_highpart (SImode, operands[1]);
2690    operands[1] = gen_lowpart (SImode, operands[1]);
2691  }"
2692  [(set_attr "length" "4,8")
2693   (set_attr "predicable" "yes")
2694   (set_attr "predicable_short_it" "no")
2695   (set_attr "type" "multiple")]
2696)
2697
2698(define_insn_and_split "*anddi_notdi_zesidi"
2699  [(set (match_operand:DI 0 "s_register_operand" "=r")
2700        (and:DI (not:DI (match_operand:DI 2 "s_register_operand" "r"))
2701                (zero_extend:DI
2702                 (match_operand:SI 1 "s_register_operand" "r"))))]
2703  "TARGET_32BIT"
2704  "#"
2705  "TARGET_32BIT && reload_completed"
2706  [(set (match_dup 0) (and:SI (not:SI (match_dup 2)) (match_dup 1)))
2707   (set (match_dup 3) (const_int 0))]
2708  "
2709  {
2710    operands[3] = gen_highpart (SImode, operands[0]);
2711    operands[0] = gen_lowpart (SImode, operands[0]);
2712    operands[2] = gen_lowpart (SImode, operands[2]);
2713  }"
2714  [(set_attr "length" "8")
2715   (set_attr "predicable" "yes")
2716   (set_attr "predicable_short_it" "no")
2717   (set_attr "type" "multiple")]
2718)
2719
2720(define_insn_and_split "*anddi_notsesidi_di"
2721  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2722	(and:DI (not:DI (sign_extend:DI
2723			 (match_operand:SI 2 "s_register_operand" "r,r")))
2724		(match_operand:DI 1 "s_register_operand" "0,r")))]
2725  "TARGET_32BIT"
2726  "#"
2727  "TARGET_32BIT && reload_completed"
2728  [(set (match_dup 0) (and:SI (not:SI (match_dup 2)) (match_dup 1)))
2729   (set (match_dup 3) (and:SI (not:SI
2730				(ashiftrt:SI (match_dup 2) (const_int 31)))
2731			       (match_dup 4)))]
2732  "
2733  {
2734    operands[3] = gen_highpart (SImode, operands[0]);
2735    operands[0] = gen_lowpart (SImode, operands[0]);
2736    operands[4] = gen_highpart (SImode, operands[1]);
2737    operands[1] = gen_lowpart (SImode, operands[1]);
2738  }"
2739  [(set_attr "length" "8")
2740   (set_attr "predicable" "yes")
2741   (set_attr "predicable_short_it" "no")
2742   (set_attr "type" "multiple")]
2743)
2744
2745(define_insn "andsi_notsi_si"
2746  [(set (match_operand:SI 0 "s_register_operand" "=r")
2747	(and:SI (not:SI (match_operand:SI 2 "s_register_operand" "r"))
2748		(match_operand:SI 1 "s_register_operand" "r")))]
2749  "TARGET_32BIT"
2750  "bic%?\\t%0, %1, %2"
2751  [(set_attr "predicable" "yes")
2752   (set_attr "predicable_short_it" "no")
2753   (set_attr "type" "logic_reg")]
2754)
2755
2756(define_insn "andsi_not_shiftsi_si"
2757  [(set (match_operand:SI 0 "s_register_operand" "=r")
2758	(and:SI (not:SI (match_operator:SI 4 "shift_operator"
2759			 [(match_operand:SI 2 "s_register_operand" "r")
2760			  (match_operand:SI 3 "arm_rhs_operand" "rM")]))
2761		(match_operand:SI 1 "s_register_operand" "r")))]
2762  "TARGET_ARM"
2763  "bic%?\\t%0, %1, %2%S4"
2764  [(set_attr "predicable" "yes")
2765   (set_attr "shift" "2")
2766   (set (attr "type") (if_then_else (match_operand 3 "const_int_operand" "")
2767		      (const_string "logic_shift_imm")
2768		      (const_string "logic_shift_reg")))]
2769)
2770
2771(define_insn "*andsi_notsi_si_compare0"
2772  [(set (reg:CC_NOOV CC_REGNUM)
2773	(compare:CC_NOOV
2774	 (and:SI (not:SI (match_operand:SI 2 "s_register_operand" "r"))
2775		 (match_operand:SI 1 "s_register_operand" "r"))
2776	 (const_int 0)))
2777   (set (match_operand:SI 0 "s_register_operand" "=r")
2778	(and:SI (not:SI (match_dup 2)) (match_dup 1)))]
2779  "TARGET_32BIT"
2780  "bic%.\\t%0, %1, %2"
2781  [(set_attr "conds" "set")
2782   (set_attr "type" "logics_shift_reg")]
2783)
2784
2785(define_insn "*andsi_notsi_si_compare0_scratch"
2786  [(set (reg:CC_NOOV CC_REGNUM)
2787	(compare:CC_NOOV
2788	 (and:SI (not:SI (match_operand:SI 2 "s_register_operand" "r"))
2789		 (match_operand:SI 1 "s_register_operand" "r"))
2790	 (const_int 0)))
2791   (clobber (match_scratch:SI 0 "=r"))]
2792  "TARGET_32BIT"
2793  "bic%.\\t%0, %1, %2"
2794  [(set_attr "conds" "set")
2795   (set_attr "type" "logics_shift_reg")]
2796)
2797
2798(define_expand "iordi3"
2799  [(set (match_operand:DI         0 "s_register_operand" "")
2800	(ior:DI (match_operand:DI 1 "s_register_operand" "")
2801		(match_operand:DI 2 "neon_logic_op2" "")))]
2802  "TARGET_32BIT"
2803  ""
2804)
2805
2806(define_insn_and_split "*iordi3_insn"
2807  [(set (match_operand:DI         0 "s_register_operand"     "=w,w ,&r,&r,&r,&r,?w,?w")
2808	(ior:DI (match_operand:DI 1 "s_register_operand"     "%w,0 ,0 ,r ,0 ,r ,w ,0")
2809		(match_operand:DI 2 "arm_iordi_operand_neon" "w ,Dl,r ,r ,Df,Df,w ,Dl")))]
2810  "TARGET_32BIT && !TARGET_IWMMXT"
2811  {
2812  switch (which_alternative)
2813    {
2814    case 0: /* fall through */
2815    case 6: return "vorr\t%P0, %P1, %P2";
2816    case 1: /* fall through */
2817    case 7: return neon_output_logic_immediate ("vorr", &operands[2],
2818		     DImode, 0, VALID_NEON_QREG_MODE (DImode));
2819    case 2:
2820    case 3:
2821    case 4:
2822    case 5:
2823      return "#";
2824    default: gcc_unreachable ();
2825    }
2826  }
2827  "TARGET_32BIT && !TARGET_IWMMXT && reload_completed
2828   && !(IS_VFP_REGNUM (REGNO (operands[0])))"
2829  [(set (match_dup 3) (match_dup 4))
2830   (set (match_dup 5) (match_dup 6))]
2831  "
2832  {
2833    operands[3] = gen_lowpart (SImode, operands[0]);
2834    operands[5] = gen_highpart (SImode, operands[0]);
2835
2836    operands[4] = simplify_gen_binary (IOR, SImode,
2837                                           gen_lowpart (SImode, operands[1]),
2838                                           gen_lowpart (SImode, operands[2]));
2839    operands[6] = simplify_gen_binary (IOR, SImode,
2840                                           gen_highpart (SImode, operands[1]),
2841                                           gen_highpart_mode (SImode, DImode, operands[2]));
2842
2843  }"
2844  [(set_attr "type" "neon_logic,neon_logic,multiple,multiple,multiple,\
2845                     multiple,neon_logic,neon_logic")
2846   (set_attr "length" "*,*,8,8,8,8,*,*")
2847   (set_attr "arch" "neon_for_64bits,neon_for_64bits,*,*,*,*,avoid_neon_for_64bits,avoid_neon_for_64bits")]
2848)
2849
2850(define_insn "*iordi_zesidi_di"
2851  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2852	(ior:DI (zero_extend:DI
2853		 (match_operand:SI 2 "s_register_operand" "r,r"))
2854		(match_operand:DI 1 "s_register_operand" "0,?r")))]
2855  "TARGET_32BIT"
2856  "@
2857   orr%?\\t%Q0, %Q1, %2
2858   #"
2859  [(set_attr "length" "4,8")
2860   (set_attr "predicable" "yes")
2861   (set_attr "predicable_short_it" "no")
2862   (set_attr "type" "logic_reg,multiple")]
2863)
2864
2865(define_insn "*iordi_sesidi_di"
2866  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2867	(ior:DI (sign_extend:DI
2868		 (match_operand:SI 2 "s_register_operand" "r,r"))
2869		(match_operand:DI 1 "s_register_operand" "0,r")))]
2870  "TARGET_32BIT"
2871  "#"
2872  [(set_attr "length" "8")
2873   (set_attr "predicable" "yes")
2874   (set_attr "type" "multiple")]
2875)
2876
2877(define_expand "iorsi3"
2878  [(set (match_operand:SI         0 "s_register_operand" "")
2879	(ior:SI (match_operand:SI 1 "s_register_operand" "")
2880		(match_operand:SI 2 "reg_or_int_operand" "")))]
2881  "TARGET_EITHER"
2882  "
2883  if (CONST_INT_P (operands[2]))
2884    {
2885      if (TARGET_32BIT)
2886        {
2887          arm_split_constant (IOR, SImode, NULL_RTX,
2888	                      INTVAL (operands[2]), operands[0], operands[1],
2889			      optimize && can_create_pseudo_p ());
2890          DONE;
2891	}
2892      else /* TARGET_THUMB1 */
2893        {
2894          rtx tmp = force_reg (SImode, operands[2]);
2895	  if (rtx_equal_p (operands[0], operands[1]))
2896	    operands[2] = tmp;
2897	  else
2898	    {
2899              operands[2] = operands[1];
2900              operands[1] = tmp;
2901	    }
2902        }
2903    }
2904  "
2905)
2906
2907(define_insn_and_split "*iorsi3_insn"
2908  [(set (match_operand:SI 0 "s_register_operand" "=r,l,r,r,r")
2909	(ior:SI (match_operand:SI 1 "s_register_operand" "%r,0,r,r,r")
2910		(match_operand:SI 2 "reg_or_int_operand" "I,l,K,r,?n")))]
2911  "TARGET_32BIT"
2912  "@
2913   orr%?\\t%0, %1, %2
2914   orr%?\\t%0, %1, %2
2915   orn%?\\t%0, %1, #%B2
2916   orr%?\\t%0, %1, %2
2917   #"
2918  "TARGET_32BIT
2919   && CONST_INT_P (operands[2])
2920   && !(const_ok_for_arm (INTVAL (operands[2]))
2921        || (TARGET_THUMB2 && const_ok_for_arm (~INTVAL (operands[2]))))"
2922  [(clobber (const_int 0))]
2923{
2924  arm_split_constant (IOR, SImode, curr_insn,
2925                      INTVAL (operands[2]), operands[0], operands[1], 0);
2926  DONE;
2927}
2928  [(set_attr "length" "4,4,4,4,16")
2929   (set_attr "arch" "32,t2,t2,32,32")
2930   (set_attr "predicable" "yes")
2931   (set_attr "predicable_short_it" "no,yes,no,no,no")
2932   (set_attr "type" "logic_imm,logic_reg,logic_imm,logic_reg,logic_reg")]
2933)
2934
2935(define_peephole2
2936  [(match_scratch:SI 3 "r")
2937   (set (match_operand:SI 0 "arm_general_register_operand" "")
2938	(ior:SI (match_operand:SI 1 "arm_general_register_operand" "")
2939		(match_operand:SI 2 "const_int_operand" "")))]
2940  "TARGET_ARM
2941   && !const_ok_for_arm (INTVAL (operands[2]))
2942   && const_ok_for_arm (~INTVAL (operands[2]))"
2943  [(set (match_dup 3) (match_dup 2))
2944   (set (match_dup 0) (ior:SI (match_dup 1) (match_dup 3)))]
2945  ""
2946)
2947
2948(define_insn "*iorsi3_compare0"
2949  [(set (reg:CC_NOOV CC_REGNUM)
2950	(compare:CC_NOOV (ior:SI (match_operand:SI 1 "s_register_operand" "%r,r")
2951				 (match_operand:SI 2 "arm_rhs_operand" "I,r"))
2952			 (const_int 0)))
2953   (set (match_operand:SI 0 "s_register_operand" "=r,r")
2954	(ior:SI (match_dup 1) (match_dup 2)))]
2955  "TARGET_32BIT"
2956  "orr%.\\t%0, %1, %2"
2957  [(set_attr "conds" "set")
2958   (set_attr "type" "logics_imm,logics_reg")]
2959)
2960
2961(define_insn "*iorsi3_compare0_scratch"
2962  [(set (reg:CC_NOOV CC_REGNUM)
2963	(compare:CC_NOOV (ior:SI (match_operand:SI 1 "s_register_operand" "%r,r")
2964				 (match_operand:SI 2 "arm_rhs_operand" "I,r"))
2965			 (const_int 0)))
2966   (clobber (match_scratch:SI 0 "=r,r"))]
2967  "TARGET_32BIT"
2968  "orr%.\\t%0, %1, %2"
2969  [(set_attr "conds" "set")
2970   (set_attr "type" "logics_imm,logics_reg")]
2971)
2972
2973(define_expand "xordi3"
2974  [(set (match_operand:DI         0 "s_register_operand" "")
2975	(xor:DI (match_operand:DI 1 "s_register_operand" "")
2976		(match_operand:DI 2 "arm_xordi_operand" "")))]
2977  "TARGET_32BIT"
2978  ""
2979)
2980
2981(define_insn_and_split "*xordi3_insn"
2982  [(set (match_operand:DI         0 "s_register_operand" "=w,&r,&r,&r,&r,?w")
2983	(xor:DI (match_operand:DI 1 "s_register_operand" "%w ,0,r ,0 ,r ,w")
2984		(match_operand:DI 2 "arm_xordi_operand"  "w ,r ,r ,Dg,Dg,w")))]
2985  "TARGET_32BIT && !TARGET_IWMMXT"
2986{
2987  switch (which_alternative)
2988    {
2989    case 1:
2990    case 2:
2991    case 3:
2992    case 4:  /* fall through */
2993      return "#";
2994    case 0: /* fall through */
2995    case 5: return "veor\t%P0, %P1, %P2";
2996    default: gcc_unreachable ();
2997    }
2998}
2999  "TARGET_32BIT && !TARGET_IWMMXT && reload_completed
3000   && !(IS_VFP_REGNUM (REGNO (operands[0])))"
3001  [(set (match_dup 3) (match_dup 4))
3002   (set (match_dup 5) (match_dup 6))]
3003  "
3004  {
3005    operands[3] = gen_lowpart (SImode, operands[0]);
3006    operands[5] = gen_highpart (SImode, operands[0]);
3007
3008    operands[4] = simplify_gen_binary (XOR, SImode,
3009                                           gen_lowpart (SImode, operands[1]),
3010                                           gen_lowpart (SImode, operands[2]));
3011    operands[6] = simplify_gen_binary (XOR, SImode,
3012                                           gen_highpart (SImode, operands[1]),
3013                                           gen_highpart_mode (SImode, DImode, operands[2]));
3014
3015  }"
3016  [(set_attr "length" "*,8,8,8,8,*")
3017   (set_attr "type" "neon_logic,multiple,multiple,multiple,multiple,neon_logic")
3018   (set_attr "arch" "neon_for_64bits,*,*,*,*,avoid_neon_for_64bits")]
3019)
3020
3021(define_insn "*xordi_zesidi_di"
3022  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
3023	(xor:DI (zero_extend:DI
3024		 (match_operand:SI 2 "s_register_operand" "r,r"))
3025		(match_operand:DI 1 "s_register_operand" "0,?r")))]
3026  "TARGET_32BIT"
3027  "@
3028   eor%?\\t%Q0, %Q1, %2
3029   #"
3030  [(set_attr "length" "4,8")
3031   (set_attr "predicable" "yes")
3032   (set_attr "predicable_short_it" "no")
3033   (set_attr "type" "logic_reg")]
3034)
3035
3036(define_insn "*xordi_sesidi_di"
3037  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
3038	(xor:DI (sign_extend:DI
3039		 (match_operand:SI 2 "s_register_operand" "r,r"))
3040		(match_operand:DI 1 "s_register_operand" "0,r")))]
3041  "TARGET_32BIT"
3042  "#"
3043  [(set_attr "length" "8")
3044   (set_attr "predicable" "yes")
3045   (set_attr "type" "multiple")]
3046)
3047
3048(define_expand "xorsi3"
3049  [(set (match_operand:SI         0 "s_register_operand" "")
3050	(xor:SI (match_operand:SI 1 "s_register_operand" "")
3051		(match_operand:SI 2 "reg_or_int_operand" "")))]
3052  "TARGET_EITHER"
3053  "if (CONST_INT_P (operands[2]))
3054    {
3055      if (TARGET_32BIT)
3056        {
3057          arm_split_constant (XOR, SImode, NULL_RTX,
3058	                      INTVAL (operands[2]), operands[0], operands[1],
3059			      optimize && can_create_pseudo_p ());
3060          DONE;
3061	}
3062      else /* TARGET_THUMB1 */
3063        {
3064          rtx tmp = force_reg (SImode, operands[2]);
3065	  if (rtx_equal_p (operands[0], operands[1]))
3066	    operands[2] = tmp;
3067	  else
3068	    {
3069              operands[2] = operands[1];
3070              operands[1] = tmp;
3071	    }
3072        }
3073    }"
3074)
3075
3076(define_insn_and_split "*arm_xorsi3"
3077  [(set (match_operand:SI         0 "s_register_operand" "=r,l,r,r")
3078	(xor:SI (match_operand:SI 1 "s_register_operand" "%r,0,r,r")
3079		(match_operand:SI 2 "reg_or_int_operand" "I,l,r,?n")))]
3080  "TARGET_32BIT"
3081  "@
3082   eor%?\\t%0, %1, %2
3083   eor%?\\t%0, %1, %2
3084   eor%?\\t%0, %1, %2
3085   #"
3086  "TARGET_32BIT
3087   && CONST_INT_P (operands[2])
3088   && !const_ok_for_arm (INTVAL (operands[2]))"
3089  [(clobber (const_int 0))]
3090{
3091  arm_split_constant (XOR, SImode, curr_insn,
3092                      INTVAL (operands[2]), operands[0], operands[1], 0);
3093  DONE;
3094}
3095  [(set_attr "length" "4,4,4,16")
3096   (set_attr "predicable" "yes")
3097   (set_attr "predicable_short_it" "no,yes,no,no")
3098   (set_attr "type"  "logic_imm,logic_reg,logic_reg,multiple")]
3099)
3100
3101(define_insn "*xorsi3_compare0"
3102  [(set (reg:CC_NOOV CC_REGNUM)
3103	(compare:CC_NOOV (xor:SI (match_operand:SI 1 "s_register_operand" "r,r")
3104				 (match_operand:SI 2 "arm_rhs_operand" "I,r"))
3105			 (const_int 0)))
3106   (set (match_operand:SI 0 "s_register_operand" "=r,r")
3107	(xor:SI (match_dup 1) (match_dup 2)))]
3108  "TARGET_32BIT"
3109  "eor%.\\t%0, %1, %2"
3110  [(set_attr "conds" "set")
3111   (set_attr "type" "logics_imm,logics_reg")]
3112)
3113
3114(define_insn "*xorsi3_compare0_scratch"
3115  [(set (reg:CC_NOOV CC_REGNUM)
3116	(compare:CC_NOOV (xor:SI (match_operand:SI 0 "s_register_operand" "r,r")
3117				 (match_operand:SI 1 "arm_rhs_operand" "I,r"))
3118			 (const_int 0)))]
3119  "TARGET_32BIT"
3120  "teq%?\\t%0, %1"
3121  [(set_attr "conds" "set")
3122   (set_attr "type" "logics_imm,logics_reg")]
3123)
3124
3125; By splitting (IOR (AND (NOT A) (NOT B)) C) as D = AND (IOR A B) (NOT C), 
3126; (NOT D) we can sometimes merge the final NOT into one of the following
3127; insns.
3128
3129(define_split
3130  [(set (match_operand:SI 0 "s_register_operand" "")
3131	(ior:SI (and:SI (not:SI (match_operand:SI 1 "s_register_operand" ""))
3132			(not:SI (match_operand:SI 2 "arm_rhs_operand" "")))
3133		(match_operand:SI 3 "arm_rhs_operand" "")))
3134   (clobber (match_operand:SI 4 "s_register_operand" ""))]
3135  "TARGET_32BIT"
3136  [(set (match_dup 4) (and:SI (ior:SI (match_dup 1) (match_dup 2))
3137			      (not:SI (match_dup 3))))
3138   (set (match_dup 0) (not:SI (match_dup 4)))]
3139  ""
3140)
3141
3142(define_insn_and_split "*andsi_iorsi3_notsi"
3143  [(set (match_operand:SI 0 "s_register_operand" "=&r,&r,&r")
3144	(and:SI (ior:SI (match_operand:SI 1 "s_register_operand" "%0,r,r")
3145			(match_operand:SI 2 "arm_rhs_operand" "rI,0,rI"))
3146		(not:SI (match_operand:SI 3 "arm_rhs_operand" "rI,rI,rI"))))]
3147  "TARGET_32BIT"
3148  "#"   ; "orr%?\\t%0, %1, %2\;bic%?\\t%0, %0, %3"
3149  "&& reload_completed"
3150  [(set (match_dup 0) (ior:SI (match_dup 1) (match_dup 2)))
3151   (set (match_dup 0) (and:SI (match_dup 4) (match_dup 5)))]
3152  {
3153     /* If operands[3] is a constant make sure to fold the NOT into it
3154	to avoid creating a NOT of a CONST_INT.  */
3155    rtx not_rtx = simplify_gen_unary (NOT, SImode, operands[3], SImode);
3156    if (CONST_INT_P (not_rtx))
3157      {
3158	operands[4] = operands[0];
3159	operands[5] = not_rtx;
3160      }
3161    else
3162      {
3163	operands[5] = operands[0];
3164	operands[4] = not_rtx;
3165      }
3166  }
3167  [(set_attr "length" "8")
3168   (set_attr "ce_count" "2")
3169   (set_attr "predicable" "yes")
3170   (set_attr "predicable_short_it" "no")
3171   (set_attr "type" "multiple")]
3172)
3173
3174; ??? Are these four splitters still beneficial when the Thumb-2 bitfield
3175; insns are available?
3176(define_split
3177  [(set (match_operand:SI 0 "s_register_operand" "")
3178	(match_operator:SI 1 "logical_binary_operator"
3179	 [(zero_extract:SI (match_operand:SI 2 "s_register_operand" "")
3180			   (match_operand:SI 3 "const_int_operand" "")
3181			   (match_operand:SI 4 "const_int_operand" ""))
3182	  (match_operator:SI 9 "logical_binary_operator"
3183	   [(lshiftrt:SI (match_operand:SI 5 "s_register_operand" "")
3184			 (match_operand:SI 6 "const_int_operand" ""))
3185	    (match_operand:SI 7 "s_register_operand" "")])]))
3186   (clobber (match_operand:SI 8 "s_register_operand" ""))]
3187  "TARGET_32BIT
3188   && GET_CODE (operands[1]) == GET_CODE (operands[9])
3189   && INTVAL (operands[3]) == 32 - INTVAL (operands[6])"
3190  [(set (match_dup 8)
3191	(match_op_dup 1
3192	 [(ashift:SI (match_dup 2) (match_dup 4))
3193	  (match_dup 5)]))
3194   (set (match_dup 0)
3195	(match_op_dup 1
3196	 [(lshiftrt:SI (match_dup 8) (match_dup 6))
3197	  (match_dup 7)]))]
3198  "
3199  operands[4] = GEN_INT (32 - (INTVAL (operands[3]) + INTVAL (operands[4])));
3200")
3201
3202(define_split
3203  [(set (match_operand:SI 0 "s_register_operand" "")
3204	(match_operator:SI 1 "logical_binary_operator"
3205	 [(match_operator:SI 9 "logical_binary_operator"
3206	   [(lshiftrt:SI (match_operand:SI 5 "s_register_operand" "")
3207			 (match_operand:SI 6 "const_int_operand" ""))
3208	    (match_operand:SI 7 "s_register_operand" "")])
3209	  (zero_extract:SI (match_operand:SI 2 "s_register_operand" "")
3210			   (match_operand:SI 3 "const_int_operand" "")
3211			   (match_operand:SI 4 "const_int_operand" ""))]))
3212   (clobber (match_operand:SI 8 "s_register_operand" ""))]
3213  "TARGET_32BIT
3214   && GET_CODE (operands[1]) == GET_CODE (operands[9])
3215   && INTVAL (operands[3]) == 32 - INTVAL (operands[6])"
3216  [(set (match_dup 8)
3217	(match_op_dup 1
3218	 [(ashift:SI (match_dup 2) (match_dup 4))
3219	  (match_dup 5)]))
3220   (set (match_dup 0)
3221	(match_op_dup 1
3222	 [(lshiftrt:SI (match_dup 8) (match_dup 6))
3223	  (match_dup 7)]))]
3224  "
3225  operands[4] = GEN_INT (32 - (INTVAL (operands[3]) + INTVAL (operands[4])));
3226")
3227
3228(define_split
3229  [(set (match_operand:SI 0 "s_register_operand" "")
3230	(match_operator:SI 1 "logical_binary_operator"
3231	 [(sign_extract:SI (match_operand:SI 2 "s_register_operand" "")
3232			   (match_operand:SI 3 "const_int_operand" "")
3233			   (match_operand:SI 4 "const_int_operand" ""))
3234	  (match_operator:SI 9 "logical_binary_operator"
3235	   [(ashiftrt:SI (match_operand:SI 5 "s_register_operand" "")
3236			 (match_operand:SI 6 "const_int_operand" ""))
3237	    (match_operand:SI 7 "s_register_operand" "")])]))
3238   (clobber (match_operand:SI 8 "s_register_operand" ""))]
3239  "TARGET_32BIT
3240   && GET_CODE (operands[1]) == GET_CODE (operands[9])
3241   && INTVAL (operands[3]) == 32 - INTVAL (operands[6])"
3242  [(set (match_dup 8)
3243	(match_op_dup 1
3244	 [(ashift:SI (match_dup 2) (match_dup 4))
3245	  (match_dup 5)]))
3246   (set (match_dup 0)
3247	(match_op_dup 1
3248	 [(ashiftrt:SI (match_dup 8) (match_dup 6))
3249	  (match_dup 7)]))]
3250  "
3251  operands[4] = GEN_INT (32 - (INTVAL (operands[3]) + INTVAL (operands[4])));
3252")
3253
3254(define_split
3255  [(set (match_operand:SI 0 "s_register_operand" "")
3256	(match_operator:SI 1 "logical_binary_operator"
3257	 [(match_operator:SI 9 "logical_binary_operator"
3258	   [(ashiftrt:SI (match_operand:SI 5 "s_register_operand" "")
3259			 (match_operand:SI 6 "const_int_operand" ""))
3260	    (match_operand:SI 7 "s_register_operand" "")])
3261	  (sign_extract:SI (match_operand:SI 2 "s_register_operand" "")
3262			   (match_operand:SI 3 "const_int_operand" "")
3263			   (match_operand:SI 4 "const_int_operand" ""))]))
3264   (clobber (match_operand:SI 8 "s_register_operand" ""))]
3265  "TARGET_32BIT
3266   && GET_CODE (operands[1]) == GET_CODE (operands[9])
3267   && INTVAL (operands[3]) == 32 - INTVAL (operands[6])"
3268  [(set (match_dup 8)
3269	(match_op_dup 1
3270	 [(ashift:SI (match_dup 2) (match_dup 4))
3271	  (match_dup 5)]))
3272   (set (match_dup 0)
3273	(match_op_dup 1
3274	 [(ashiftrt:SI (match_dup 8) (match_dup 6))
3275	  (match_dup 7)]))]
3276  "
3277  operands[4] = GEN_INT (32 - (INTVAL (operands[3]) + INTVAL (operands[4])));
3278")
3279
3280
3281;; Minimum and maximum insns
3282
3283(define_expand "smaxsi3"
3284  [(parallel [
3285    (set (match_operand:SI 0 "s_register_operand" "")
3286	 (smax:SI (match_operand:SI 1 "s_register_operand" "")
3287		  (match_operand:SI 2 "arm_rhs_operand" "")))
3288    (clobber (reg:CC CC_REGNUM))])]
3289  "TARGET_32BIT"
3290  "
3291  if (operands[2] == const0_rtx || operands[2] == constm1_rtx)
3292    {
3293      /* No need for a clobber of the condition code register here.  */
3294      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
3295			      gen_rtx_SMAX (SImode, operands[1],
3296					    operands[2])));
3297      DONE;
3298    }
3299")
3300
3301(define_insn "*smax_0"
3302  [(set (match_operand:SI 0 "s_register_operand" "=r")
3303	(smax:SI (match_operand:SI 1 "s_register_operand" "r")
3304		 (const_int 0)))]
3305  "TARGET_32BIT"
3306  "bic%?\\t%0, %1, %1, asr #31"
3307  [(set_attr "predicable" "yes")
3308   (set_attr "predicable_short_it" "no")
3309   (set_attr "type" "logic_shift_reg")]
3310)
3311
3312(define_insn "*smax_m1"
3313  [(set (match_operand:SI 0 "s_register_operand" "=r")
3314	(smax:SI (match_operand:SI 1 "s_register_operand" "r")
3315		 (const_int -1)))]
3316  "TARGET_32BIT"
3317  "orr%?\\t%0, %1, %1, asr #31"
3318  [(set_attr "predicable" "yes")
3319   (set_attr "predicable_short_it" "no")
3320   (set_attr "type" "logic_shift_reg")]
3321)
3322
3323(define_insn_and_split "*arm_smax_insn"
3324  [(set (match_operand:SI          0 "s_register_operand" "=r,r")
3325	(smax:SI (match_operand:SI 1 "s_register_operand"  "%0,?r")
3326		 (match_operand:SI 2 "arm_rhs_operand"    "rI,rI")))
3327   (clobber (reg:CC CC_REGNUM))]
3328  "TARGET_ARM"
3329  "#"
3330   ; cmp\\t%1, %2\;movlt\\t%0, %2
3331   ; cmp\\t%1, %2\;movge\\t%0, %1\;movlt\\t%0, %2"
3332  "TARGET_ARM"
3333  [(set (reg:CC CC_REGNUM)
3334        (compare:CC (match_dup 1) (match_dup 2)))
3335   (set (match_dup 0)
3336        (if_then_else:SI (ge:SI (reg:CC CC_REGNUM) (const_int 0))
3337                         (match_dup 1)
3338                         (match_dup 2)))]
3339  ""
3340  [(set_attr "conds" "clob")
3341   (set_attr "length" "8,12")
3342   (set_attr "type" "multiple")]
3343)
3344
3345(define_expand "sminsi3"
3346  [(parallel [
3347    (set (match_operand:SI 0 "s_register_operand" "")
3348	 (smin:SI (match_operand:SI 1 "s_register_operand" "")
3349		  (match_operand:SI 2 "arm_rhs_operand" "")))
3350    (clobber (reg:CC CC_REGNUM))])]
3351  "TARGET_32BIT"
3352  "
3353  if (operands[2] == const0_rtx)
3354    {
3355      /* No need for a clobber of the condition code register here.  */
3356      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
3357			      gen_rtx_SMIN (SImode, operands[1],
3358					    operands[2])));
3359      DONE;
3360    }
3361")
3362
3363(define_insn "*smin_0"
3364  [(set (match_operand:SI 0 "s_register_operand" "=r")
3365	(smin:SI (match_operand:SI 1 "s_register_operand" "r")
3366		 (const_int 0)))]
3367  "TARGET_32BIT"
3368  "and%?\\t%0, %1, %1, asr #31"
3369  [(set_attr "predicable" "yes")
3370   (set_attr "predicable_short_it" "no")
3371   (set_attr "type" "logic_shift_reg")]
3372)
3373
3374(define_insn_and_split "*arm_smin_insn"
3375  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
3376	(smin:SI (match_operand:SI 1 "s_register_operand" "%0,?r")
3377		 (match_operand:SI 2 "arm_rhs_operand" "rI,rI")))
3378   (clobber (reg:CC CC_REGNUM))]
3379  "TARGET_ARM"
3380  "#"
3381    ; cmp\\t%1, %2\;movge\\t%0, %2
3382    ; cmp\\t%1, %2\;movlt\\t%0, %1\;movge\\t%0, %2"
3383  "TARGET_ARM"
3384  [(set (reg:CC CC_REGNUM)
3385        (compare:CC (match_dup 1) (match_dup 2)))
3386   (set (match_dup 0)
3387        (if_then_else:SI (lt:SI (reg:CC CC_REGNUM) (const_int 0))
3388                         (match_dup 1)
3389                         (match_dup 2)))]
3390  ""
3391  [(set_attr "conds" "clob")
3392   (set_attr "length" "8,12")
3393   (set_attr "type" "multiple,multiple")]
3394)
3395
3396(define_expand "umaxsi3"
3397  [(parallel [
3398    (set (match_operand:SI 0 "s_register_operand" "")
3399	 (umax:SI (match_operand:SI 1 "s_register_operand" "")
3400		  (match_operand:SI 2 "arm_rhs_operand" "")))
3401    (clobber (reg:CC CC_REGNUM))])]
3402  "TARGET_32BIT"
3403  ""
3404)
3405
3406(define_insn_and_split "*arm_umaxsi3"
3407  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
3408	(umax:SI (match_operand:SI 1 "s_register_operand" "0,r,?r")
3409		 (match_operand:SI 2 "arm_rhs_operand" "rI,0,rI")))
3410   (clobber (reg:CC CC_REGNUM))]
3411  "TARGET_ARM"
3412  "#"
3413    ; cmp\\t%1, %2\;movcc\\t%0, %2
3414    ; cmp\\t%1, %2\;movcs\\t%0, %1
3415    ; cmp\\t%1, %2\;movcs\\t%0, %1\;movcc\\t%0, %2"
3416  "TARGET_ARM"
3417  [(set (reg:CC CC_REGNUM)
3418        (compare:CC (match_dup 1) (match_dup 2)))
3419   (set (match_dup 0)
3420        (if_then_else:SI (geu:SI (reg:CC CC_REGNUM) (const_int 0))
3421                         (match_dup 1)
3422                         (match_dup 2)))]
3423  ""
3424  [(set_attr "conds" "clob")
3425   (set_attr "length" "8,8,12")
3426   (set_attr "type" "store1")]
3427)
3428
3429(define_expand "uminsi3"
3430  [(parallel [
3431    (set (match_operand:SI 0 "s_register_operand" "")
3432	 (umin:SI (match_operand:SI 1 "s_register_operand" "")
3433		  (match_operand:SI 2 "arm_rhs_operand" "")))
3434    (clobber (reg:CC CC_REGNUM))])]
3435  "TARGET_32BIT"
3436  ""
3437)
3438
3439(define_insn_and_split "*arm_uminsi3"
3440  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
3441	(umin:SI (match_operand:SI 1 "s_register_operand" "0,r,?r")
3442		 (match_operand:SI 2 "arm_rhs_operand" "rI,0,rI")))
3443   (clobber (reg:CC CC_REGNUM))]
3444  "TARGET_ARM"
3445  "#"
3446   ; cmp\\t%1, %2\;movcs\\t%0, %2
3447   ; cmp\\t%1, %2\;movcc\\t%0, %1
3448   ; cmp\\t%1, %2\;movcc\\t%0, %1\;movcs\\t%0, %2"
3449  "TARGET_ARM"
3450  [(set (reg:CC CC_REGNUM)
3451        (compare:CC (match_dup 1) (match_dup 2)))
3452   (set (match_dup 0)
3453        (if_then_else:SI (ltu:SI (reg:CC CC_REGNUM) (const_int 0))
3454                         (match_dup 1)
3455                         (match_dup 2)))]
3456  ""
3457  [(set_attr "conds" "clob")
3458   (set_attr "length" "8,8,12")
3459   (set_attr "type" "store1")]
3460)
3461
3462(define_insn "*store_minmaxsi"
3463  [(set (match_operand:SI 0 "memory_operand" "=m")
3464	(match_operator:SI 3 "minmax_operator"
3465	 [(match_operand:SI 1 "s_register_operand" "r")
3466	  (match_operand:SI 2 "s_register_operand" "r")]))
3467   (clobber (reg:CC CC_REGNUM))]
3468  "TARGET_32BIT && optimize_function_for_size_p (cfun) && !arm_restrict_it"
3469  "*
3470  operands[3] = gen_rtx_fmt_ee (minmax_code (operands[3]), SImode,
3471				operands[1], operands[2]);
3472  output_asm_insn (\"cmp\\t%1, %2\", operands);
3473  if (TARGET_THUMB2)
3474    output_asm_insn (\"ite\t%d3\", operands);
3475  output_asm_insn (\"str%d3\\t%1, %0\", operands);
3476  output_asm_insn (\"str%D3\\t%2, %0\", operands);
3477  return \"\";
3478  "
3479  [(set_attr "conds" "clob")
3480   (set (attr "length")
3481	(if_then_else (eq_attr "is_thumb" "yes")
3482		      (const_int 14)
3483		      (const_int 12)))
3484   (set_attr "type" "store1")]
3485)
3486
3487; Reject the frame pointer in operand[1], since reloading this after
3488; it has been eliminated can cause carnage.
3489(define_insn "*minmax_arithsi"
3490  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
3491	(match_operator:SI 4 "shiftable_operator"
3492	 [(match_operator:SI 5 "minmax_operator"
3493	   [(match_operand:SI 2 "s_register_operand" "r,r")
3494	    (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])
3495	  (match_operand:SI 1 "s_register_operand" "0,?r")]))
3496   (clobber (reg:CC CC_REGNUM))]
3497  "TARGET_32BIT && !arm_eliminable_register (operands[1]) && !arm_restrict_it"
3498  "*
3499  {
3500    enum rtx_code code = GET_CODE (operands[4]);
3501    bool need_else;
3502
3503    if (which_alternative != 0 || operands[3] != const0_rtx
3504        || (code != PLUS && code != IOR && code != XOR))
3505      need_else = true;
3506    else
3507      need_else = false;
3508
3509    operands[5] = gen_rtx_fmt_ee (minmax_code (operands[5]), SImode,
3510				  operands[2], operands[3]);
3511    output_asm_insn (\"cmp\\t%2, %3\", operands);
3512    if (TARGET_THUMB2)
3513      {
3514	if (need_else)
3515	  output_asm_insn (\"ite\\t%d5\", operands);
3516	else
3517	  output_asm_insn (\"it\\t%d5\", operands);
3518      }
3519    output_asm_insn (\"%i4%d5\\t%0, %1, %2\", operands);
3520    if (need_else)
3521      output_asm_insn (\"%i4%D5\\t%0, %1, %3\", operands);
3522    return \"\";
3523  }"
3524  [(set_attr "conds" "clob")
3525   (set (attr "length")
3526	(if_then_else (eq_attr "is_thumb" "yes")
3527		      (const_int 14)
3528		      (const_int 12)))
3529   (set_attr "type" "multiple")]
3530)
3531
3532; Reject the frame pointer in operand[1], since reloading this after
3533; it has been eliminated can cause carnage.
3534(define_insn_and_split "*minmax_arithsi_non_canon"
3535  [(set (match_operand:SI 0 "s_register_operand" "=Ts,Ts")
3536	(minus:SI
3537	 (match_operand:SI 1 "s_register_operand" "0,?Ts")
3538	  (match_operator:SI 4 "minmax_operator"
3539	   [(match_operand:SI 2 "s_register_operand" "Ts,Ts")
3540	    (match_operand:SI 3 "arm_rhs_operand" "TsI,TsI")])))
3541   (clobber (reg:CC CC_REGNUM))]
3542  "TARGET_32BIT && !arm_eliminable_register (operands[1])
3543   && !(arm_restrict_it && CONST_INT_P (operands[3]))"
3544  "#"
3545  "TARGET_32BIT && !arm_eliminable_register (operands[1]) && reload_completed"
3546  [(set (reg:CC CC_REGNUM)
3547        (compare:CC (match_dup 2) (match_dup 3)))
3548
3549   (cond_exec (match_op_dup 4 [(reg:CC CC_REGNUM) (const_int 0)])
3550              (set (match_dup 0)
3551                   (minus:SI (match_dup 1)
3552                             (match_dup 2))))
3553   (cond_exec (match_op_dup 5 [(reg:CC CC_REGNUM) (const_int 0)])
3554              (set (match_dup 0)
3555                   (match_dup 6)))]
3556  {
3557  machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
3558                                           operands[2], operands[3]);
3559  enum rtx_code rc = minmax_code (operands[4]);
3560  operands[4] = gen_rtx_fmt_ee (rc, VOIDmode,
3561                                operands[2], operands[3]);
3562
3563  if (mode == CCFPmode || mode == CCFPEmode)
3564    rc = reverse_condition_maybe_unordered (rc);
3565  else
3566    rc = reverse_condition (rc);
3567  operands[5] = gen_rtx_fmt_ee (rc, SImode, operands[2], operands[3]);
3568  if (CONST_INT_P (operands[3]))
3569    operands[6] = plus_constant (SImode, operands[1], -INTVAL (operands[3]));
3570  else
3571    operands[6] = gen_rtx_MINUS (SImode, operands[1], operands[3]);
3572  }
3573  [(set_attr "conds" "clob")
3574   (set (attr "length")
3575	(if_then_else (eq_attr "is_thumb" "yes")
3576		      (const_int 14)
3577		      (const_int 12)))
3578   (set_attr "type" "multiple")]
3579)
3580
3581(define_code_iterator SAT [smin smax])
3582(define_code_iterator SATrev [smin smax])
3583(define_code_attr SATlo [(smin "1") (smax "2")])
3584(define_code_attr SAThi [(smin "2") (smax "1")])
3585
3586(define_insn "*satsi_<SAT:code>"
3587  [(set (match_operand:SI 0 "s_register_operand" "=r")
3588        (SAT:SI (SATrev:SI (match_operand:SI 3 "s_register_operand" "r")
3589                           (match_operand:SI 1 "const_int_operand" "i"))
3590                (match_operand:SI 2 "const_int_operand" "i")))]
3591  "TARGET_32BIT && arm_arch6 && <SAT:CODE> != <SATrev:CODE>
3592   && arm_sat_operator_match (operands[<SAT:SATlo>], operands[<SAT:SAThi>], NULL, NULL)"
3593{
3594  int mask;
3595  bool signed_sat;
3596  if (!arm_sat_operator_match (operands[<SAT:SATlo>], operands[<SAT:SAThi>],
3597                               &mask, &signed_sat))
3598    gcc_unreachable ();
3599
3600  operands[1] = GEN_INT (mask);
3601  if (signed_sat)
3602    return "ssat%?\t%0, %1, %3";
3603  else
3604    return "usat%?\t%0, %1, %3";
3605}
3606  [(set_attr "predicable" "yes")
3607   (set_attr "predicable_short_it" "no")
3608   (set_attr "type" "alus_imm")]
3609)
3610
3611(define_insn "*satsi_<SAT:code>_shift"
3612  [(set (match_operand:SI 0 "s_register_operand" "=r")
3613        (SAT:SI (SATrev:SI (match_operator:SI 3 "sat_shift_operator"
3614                             [(match_operand:SI 4 "s_register_operand" "r")
3615                              (match_operand:SI 5 "const_int_operand" "i")])
3616                           (match_operand:SI 1 "const_int_operand" "i"))
3617                (match_operand:SI 2 "const_int_operand" "i")))]
3618  "TARGET_32BIT && arm_arch6 && <SAT:CODE> != <SATrev:CODE>
3619   && arm_sat_operator_match (operands[<SAT:SATlo>], operands[<SAT:SAThi>], NULL, NULL)"
3620{
3621  int mask;
3622  bool signed_sat;
3623  if (!arm_sat_operator_match (operands[<SAT:SATlo>], operands[<SAT:SAThi>],
3624                               &mask, &signed_sat))
3625    gcc_unreachable ();
3626
3627  operands[1] = GEN_INT (mask);
3628  if (signed_sat)
3629    return "ssat%?\t%0, %1, %4%S3";
3630  else
3631    return "usat%?\t%0, %1, %4%S3";
3632}
3633  [(set_attr "predicable" "yes")
3634   (set_attr "predicable_short_it" "no")
3635   (set_attr "shift" "3")
3636   (set_attr "type" "logic_shift_reg")])
3637
3638;; Shift and rotation insns
3639
3640(define_expand "ashldi3"
3641  [(set (match_operand:DI            0 "s_register_operand" "")
3642        (ashift:DI (match_operand:DI 1 "s_register_operand" "")
3643                   (match_operand:SI 2 "general_operand" "")))]
3644  "TARGET_32BIT"
3645  "
3646  if (TARGET_NEON)
3647    {
3648      /* Delay the decision whether to use NEON or core-regs until
3649	 register allocation.  */
3650      emit_insn (gen_ashldi3_neon (operands[0], operands[1], operands[2]));
3651      DONE;
3652    }
3653  else
3654    {
3655      /* Only the NEON case can handle in-memory shift counts.  */
3656      if (!reg_or_int_operand (operands[2], SImode))
3657        operands[2] = force_reg (SImode, operands[2]);
3658    }
3659
3660  if (!CONST_INT_P (operands[2]) && TARGET_REALLY_IWMMXT)
3661    ; /* No special preparation statements; expand pattern as above.  */
3662  else
3663    {
3664      rtx scratch1, scratch2;
3665
3666      if (CONST_INT_P (operands[2])
3667	  && (HOST_WIDE_INT) INTVAL (operands[2]) == 1)
3668        {
3669          emit_insn (gen_arm_ashldi3_1bit (operands[0], operands[1]));
3670          DONE;
3671        }
3672
3673      /* Ideally we should use iwmmxt here if we could know that operands[1]
3674         ends up already living in an iwmmxt register. Otherwise it's
3675         cheaper to have the alternate code being generated than moving
3676         values to iwmmxt regs and back.  */
3677
3678      /* If we're optimizing for size, we prefer the libgcc calls.  */
3679      if (optimize_function_for_size_p (cfun))
3680	FAIL;
3681
3682      /* Expand operation using core-registers.
3683	 'FAIL' would achieve the same thing, but this is a bit smarter.  */
3684      scratch1 = gen_reg_rtx (SImode);
3685      scratch2 = gen_reg_rtx (SImode);
3686      arm_emit_coreregs_64bit_shift (ASHIFT, operands[0], operands[1],
3687				     operands[2], scratch1, scratch2);
3688      DONE;
3689    }
3690  "
3691)
3692
3693(define_insn "arm_ashldi3_1bit"
3694  [(set (match_operand:DI            0 "s_register_operand" "=r,&r")
3695        (ashift:DI (match_operand:DI 1 "s_register_operand" "0,r")
3696                   (const_int 1)))
3697   (clobber (reg:CC CC_REGNUM))]
3698  "TARGET_32BIT"
3699  "movs\\t%Q0, %Q1, asl #1\;adc\\t%R0, %R1, %R1"
3700  [(set_attr "conds" "clob")
3701   (set_attr "length" "8")
3702   (set_attr "type" "multiple")]
3703)
3704
3705(define_expand "ashlsi3"
3706  [(set (match_operand:SI            0 "s_register_operand" "")
3707	(ashift:SI (match_operand:SI 1 "s_register_operand" "")
3708		   (match_operand:SI 2 "arm_rhs_operand" "")))]
3709  "TARGET_EITHER"
3710  "
3711  if (CONST_INT_P (operands[2])
3712      && ((unsigned HOST_WIDE_INT) INTVAL (operands[2])) > 31)
3713    {
3714      emit_insn (gen_movsi (operands[0], const0_rtx));
3715      DONE;
3716    }
3717  "
3718)
3719
3720(define_expand "ashrdi3"
3721  [(set (match_operand:DI              0 "s_register_operand" "")
3722        (ashiftrt:DI (match_operand:DI 1 "s_register_operand" "")
3723                     (match_operand:SI 2 "reg_or_int_operand" "")))]
3724  "TARGET_32BIT"
3725  "
3726  if (TARGET_NEON)
3727    {
3728      /* Delay the decision whether to use NEON or core-regs until
3729	 register allocation.  */
3730      emit_insn (gen_ashrdi3_neon (operands[0], operands[1], operands[2]));
3731      DONE;
3732    }
3733
3734  if (!CONST_INT_P (operands[2]) && TARGET_REALLY_IWMMXT)
3735    ; /* No special preparation statements; expand pattern as above.  */
3736  else
3737    {
3738      rtx scratch1, scratch2;
3739
3740      if (CONST_INT_P (operands[2])
3741	  && (HOST_WIDE_INT) INTVAL (operands[2]) == 1)
3742        {
3743          emit_insn (gen_arm_ashrdi3_1bit (operands[0], operands[1]));
3744          DONE;
3745        }
3746
3747      /* Ideally we should use iwmmxt here if we could know that operands[1]
3748         ends up already living in an iwmmxt register. Otherwise it's
3749         cheaper to have the alternate code being generated than moving
3750         values to iwmmxt regs and back.  */
3751
3752      /* If we're optimizing for size, we prefer the libgcc calls.  */
3753      if (optimize_function_for_size_p (cfun))
3754	FAIL;
3755
3756      /* Expand operation using core-registers.
3757	 'FAIL' would achieve the same thing, but this is a bit smarter.  */
3758      scratch1 = gen_reg_rtx (SImode);
3759      scratch2 = gen_reg_rtx (SImode);
3760      arm_emit_coreregs_64bit_shift (ASHIFTRT, operands[0], operands[1],
3761				     operands[2], scratch1, scratch2);
3762      DONE;
3763    }
3764  "
3765)
3766
3767(define_insn "arm_ashrdi3_1bit"
3768  [(set (match_operand:DI              0 "s_register_operand" "=r,&r")
3769        (ashiftrt:DI (match_operand:DI 1 "s_register_operand" "0,r")
3770                     (const_int 1)))
3771   (clobber (reg:CC CC_REGNUM))]
3772  "TARGET_32BIT"
3773  "movs\\t%R0, %R1, asr #1\;mov\\t%Q0, %Q1, rrx"
3774  [(set_attr "conds" "clob")
3775   (set_attr "length" "8")
3776   (set_attr "type" "multiple")]
3777)
3778
3779(define_expand "ashrsi3"
3780  [(set (match_operand:SI              0 "s_register_operand" "")
3781	(ashiftrt:SI (match_operand:SI 1 "s_register_operand" "")
3782		     (match_operand:SI 2 "arm_rhs_operand" "")))]
3783  "TARGET_EITHER"
3784  "
3785  if (CONST_INT_P (operands[2])
3786      && ((unsigned HOST_WIDE_INT) INTVAL (operands[2])) > 31)
3787    operands[2] = GEN_INT (31);
3788  "
3789)
3790
3791(define_expand "lshrdi3"
3792  [(set (match_operand:DI              0 "s_register_operand" "")
3793        (lshiftrt:DI (match_operand:DI 1 "s_register_operand" "")
3794                     (match_operand:SI 2 "reg_or_int_operand" "")))]
3795  "TARGET_32BIT"
3796  "
3797  if (TARGET_NEON)
3798    {
3799      /* Delay the decision whether to use NEON or core-regs until
3800	 register allocation.  */
3801      emit_insn (gen_lshrdi3_neon (operands[0], operands[1], operands[2]));
3802      DONE;
3803    }
3804
3805  if (!CONST_INT_P (operands[2]) && TARGET_REALLY_IWMMXT)
3806    ; /* No special preparation statements; expand pattern as above.  */
3807  else
3808    {
3809      rtx scratch1, scratch2;
3810
3811      if (CONST_INT_P (operands[2])
3812	  && (HOST_WIDE_INT) INTVAL (operands[2]) == 1)
3813        {
3814          emit_insn (gen_arm_lshrdi3_1bit (operands[0], operands[1]));
3815          DONE;
3816        }
3817
3818      /* Ideally we should use iwmmxt here if we could know that operands[1]
3819         ends up already living in an iwmmxt register. Otherwise it's
3820         cheaper to have the alternate code being generated than moving
3821         values to iwmmxt regs and back.  */
3822
3823      /* If we're optimizing for size, we prefer the libgcc calls.  */
3824      if (optimize_function_for_size_p (cfun))
3825	FAIL;
3826
3827      /* Expand operation using core-registers.
3828	 'FAIL' would achieve the same thing, but this is a bit smarter.  */
3829      scratch1 = gen_reg_rtx (SImode);
3830      scratch2 = gen_reg_rtx (SImode);
3831      arm_emit_coreregs_64bit_shift (LSHIFTRT, operands[0], operands[1],
3832				     operands[2], scratch1, scratch2);
3833      DONE;
3834    }
3835  "
3836)
3837
3838(define_insn "arm_lshrdi3_1bit"
3839  [(set (match_operand:DI              0 "s_register_operand" "=r,&r")
3840        (lshiftrt:DI (match_operand:DI 1 "s_register_operand" "0,r")
3841                     (const_int 1)))
3842   (clobber (reg:CC CC_REGNUM))]
3843  "TARGET_32BIT"
3844  "movs\\t%R0, %R1, lsr #1\;mov\\t%Q0, %Q1, rrx"
3845  [(set_attr "conds" "clob")
3846   (set_attr "length" "8")
3847   (set_attr "type" "multiple")]
3848)
3849
3850(define_expand "lshrsi3"
3851  [(set (match_operand:SI              0 "s_register_operand" "")
3852	(lshiftrt:SI (match_operand:SI 1 "s_register_operand" "")
3853		     (match_operand:SI 2 "arm_rhs_operand" "")))]
3854  "TARGET_EITHER"
3855  "
3856  if (CONST_INT_P (operands[2])
3857      && ((unsigned HOST_WIDE_INT) INTVAL (operands[2])) > 31)
3858    {
3859      emit_insn (gen_movsi (operands[0], const0_rtx));
3860      DONE;
3861    }
3862  "
3863)
3864
3865(define_expand "rotlsi3"
3866  [(set (match_operand:SI              0 "s_register_operand" "")
3867	(rotatert:SI (match_operand:SI 1 "s_register_operand" "")
3868		     (match_operand:SI 2 "reg_or_int_operand" "")))]
3869  "TARGET_32BIT"
3870  "
3871  if (CONST_INT_P (operands[2]))
3872    operands[2] = GEN_INT ((32 - INTVAL (operands[2])) % 32);
3873  else
3874    {
3875      rtx reg = gen_reg_rtx (SImode);
3876      emit_insn (gen_subsi3 (reg, GEN_INT (32), operands[2]));
3877      operands[2] = reg;
3878    }
3879  "
3880)
3881
3882(define_expand "rotrsi3"
3883  [(set (match_operand:SI              0 "s_register_operand" "")
3884	(rotatert:SI (match_operand:SI 1 "s_register_operand" "")
3885		     (match_operand:SI 2 "arm_rhs_operand" "")))]
3886  "TARGET_EITHER"
3887  "
3888  if (TARGET_32BIT)
3889    {
3890      if (CONST_INT_P (operands[2])
3891          && ((unsigned HOST_WIDE_INT) INTVAL (operands[2])) > 31)
3892        operands[2] = GEN_INT (INTVAL (operands[2]) % 32);
3893    }
3894  else /* TARGET_THUMB1 */
3895    {
3896      if (CONST_INT_P (operands [2]))
3897        operands [2] = force_reg (SImode, operands[2]);
3898    }
3899  "
3900)
3901
3902(define_insn "*arm_shiftsi3"
3903  [(set (match_operand:SI   0 "s_register_operand" "=l,l,r,r")
3904	(match_operator:SI  3 "shift_operator"
3905	 [(match_operand:SI 1 "s_register_operand"  "0,l,r,r")
3906	  (match_operand:SI 2 "reg_or_int_operand" "l,M,M,r")]))]
3907  "TARGET_32BIT"
3908  "* return arm_output_shift(operands, 0);"
3909  [(set_attr "predicable" "yes")
3910   (set_attr "arch" "t2,t2,*,*")
3911   (set_attr "predicable_short_it" "yes,yes,no,no")
3912   (set_attr "length" "4")
3913   (set_attr "shift" "1")
3914   (set_attr "type" "alu_shift_reg,alu_shift_imm,alu_shift_imm,alu_shift_reg")]
3915)
3916
3917(define_insn "*shiftsi3_compare0"
3918  [(set (reg:CC_NOOV CC_REGNUM)
3919	(compare:CC_NOOV (match_operator:SI 3 "shift_operator"
3920			  [(match_operand:SI 1 "s_register_operand" "r,r")
3921			   (match_operand:SI 2 "arm_rhs_operand" "M,r")])
3922			 (const_int 0)))
3923   (set (match_operand:SI 0 "s_register_operand" "=r,r")
3924	(match_op_dup 3 [(match_dup 1) (match_dup 2)]))]
3925  "TARGET_32BIT"
3926  "* return arm_output_shift(operands, 1);"
3927  [(set_attr "conds" "set")
3928   (set_attr "shift" "1")
3929   (set_attr "type" "alus_shift_imm,alus_shift_reg")]
3930)
3931
3932(define_insn "*shiftsi3_compare0_scratch"
3933  [(set (reg:CC_NOOV CC_REGNUM)
3934	(compare:CC_NOOV (match_operator:SI 3 "shift_operator"
3935			  [(match_operand:SI 1 "s_register_operand" "r,r")
3936			   (match_operand:SI 2 "arm_rhs_operand" "M,r")])
3937			 (const_int 0)))
3938   (clobber (match_scratch:SI 0 "=r,r"))]
3939  "TARGET_32BIT"
3940  "* return arm_output_shift(operands, 1);"
3941  [(set_attr "conds" "set")
3942   (set_attr "shift" "1")
3943   (set_attr "type" "shift_imm,shift_reg")]
3944)
3945
3946(define_insn "*not_shiftsi"
3947  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
3948	(not:SI (match_operator:SI 3 "shift_operator"
3949		 [(match_operand:SI 1 "s_register_operand" "r,r")
3950		  (match_operand:SI 2 "shift_amount_operand" "M,rM")])))]
3951  "TARGET_32BIT"
3952  "mvn%?\\t%0, %1%S3"
3953  [(set_attr "predicable" "yes")
3954   (set_attr "predicable_short_it" "no")
3955   (set_attr "shift" "1")
3956   (set_attr "arch" "32,a")
3957   (set_attr "type" "mvn_shift,mvn_shift_reg")])
3958
3959(define_insn "*not_shiftsi_compare0"
3960  [(set (reg:CC_NOOV CC_REGNUM)
3961	(compare:CC_NOOV
3962	 (not:SI (match_operator:SI 3 "shift_operator"
3963		  [(match_operand:SI 1 "s_register_operand" "r,r")
3964		   (match_operand:SI 2 "shift_amount_operand" "M,rM")]))
3965	 (const_int 0)))
3966   (set (match_operand:SI 0 "s_register_operand" "=r,r")
3967	(not:SI (match_op_dup 3 [(match_dup 1) (match_dup 2)])))]
3968  "TARGET_32BIT"
3969  "mvn%.\\t%0, %1%S3"
3970  [(set_attr "conds" "set")
3971   (set_attr "shift" "1")
3972   (set_attr "arch" "32,a")
3973   (set_attr "type" "mvn_shift,mvn_shift_reg")])
3974
3975(define_insn "*not_shiftsi_compare0_scratch"
3976  [(set (reg:CC_NOOV CC_REGNUM)
3977	(compare:CC_NOOV
3978	 (not:SI (match_operator:SI 3 "shift_operator"
3979		  [(match_operand:SI 1 "s_register_operand" "r,r")
3980		   (match_operand:SI 2 "shift_amount_operand" "M,rM")]))
3981	 (const_int 0)))
3982   (clobber (match_scratch:SI 0 "=r,r"))]
3983  "TARGET_32BIT"
3984  "mvn%.\\t%0, %1%S3"
3985  [(set_attr "conds" "set")
3986   (set_attr "shift" "1")
3987   (set_attr "arch" "32,a")
3988   (set_attr "type" "mvn_shift,mvn_shift_reg")])
3989
3990;; We don't really have extzv, but defining this using shifts helps
3991;; to reduce register pressure later on.
3992
3993(define_expand "extzv"
3994  [(set (match_operand 0 "s_register_operand" "")
3995	(zero_extract (match_operand 1 "nonimmediate_operand" "")
3996		      (match_operand 2 "const_int_operand" "")
3997		      (match_operand 3 "const_int_operand" "")))]
3998  "TARGET_THUMB1 || arm_arch_thumb2"
3999  "
4000  {
4001    HOST_WIDE_INT lshift = 32 - INTVAL (operands[2]) - INTVAL (operands[3]);
4002    HOST_WIDE_INT rshift = 32 - INTVAL (operands[2]);
4003    
4004    if (arm_arch_thumb2)
4005      {
4006	HOST_WIDE_INT width = INTVAL (operands[2]);
4007	HOST_WIDE_INT bitpos = INTVAL (operands[3]);
4008
4009	if (unaligned_access && MEM_P (operands[1])
4010	    && (width == 16 || width == 32) && (bitpos % BITS_PER_UNIT) == 0)
4011	  {
4012	    rtx base_addr;
4013
4014	    if (BYTES_BIG_ENDIAN)
4015	      bitpos = GET_MODE_BITSIZE (GET_MODE (operands[0])) - width
4016		       - bitpos;
4017
4018	    if (width == 32)
4019              {
4020		base_addr = adjust_address (operands[1], SImode,
4021					    bitpos / BITS_PER_UNIT);
4022		emit_insn (gen_unaligned_loadsi (operands[0], base_addr));
4023              }
4024	    else
4025              {
4026		rtx dest = operands[0];
4027		rtx tmp = gen_reg_rtx (SImode);
4028
4029		/* We may get a paradoxical subreg here.  Strip it off.  */
4030		if (GET_CODE (dest) == SUBREG
4031		    && GET_MODE (dest) == SImode
4032		    && GET_MODE (SUBREG_REG (dest)) == HImode)
4033		  dest = SUBREG_REG (dest);
4034
4035		if (GET_MODE_BITSIZE (GET_MODE (dest)) != width)
4036		  FAIL;
4037
4038		base_addr = adjust_address (operands[1], HImode,
4039					    bitpos / BITS_PER_UNIT);
4040		emit_insn (gen_unaligned_loadhiu (tmp, base_addr));
4041		emit_move_insn (gen_lowpart (SImode, dest), tmp);
4042	      }
4043	    DONE;
4044	  }
4045	else if (s_register_operand (operands[1], GET_MODE (operands[1])))
4046	  {
4047	    emit_insn (gen_extzv_t2 (operands[0], operands[1], operands[2],
4048				     operands[3]));
4049	    DONE;
4050	  }
4051	else
4052	  FAIL;
4053      }
4054    
4055    if (!s_register_operand (operands[1], GET_MODE (operands[1])))
4056      FAIL;
4057
4058    operands[3] = GEN_INT (rshift);
4059    
4060    if (lshift == 0)
4061      {
4062        emit_insn (gen_lshrsi3 (operands[0], operands[1], operands[3]));
4063        DONE;
4064      }
4065      
4066    emit_insn (gen_extzv_t1 (operands[0], operands[1], GEN_INT (lshift),
4067			     operands[3], gen_reg_rtx (SImode)));
4068    DONE;
4069  }"
4070)
4071
4072;; Helper for extzv, for the Thumb-1 register-shifts case.
4073
4074(define_expand "extzv_t1"
4075  [(set (match_operand:SI 4 "s_register_operand" "")
4076	(ashift:SI (match_operand:SI 1 "nonimmediate_operand" "")
4077		   (match_operand:SI 2 "const_int_operand" "")))
4078   (set (match_operand:SI 0 "s_register_operand" "")
4079	(lshiftrt:SI (match_dup 4)
4080		     (match_operand:SI 3 "const_int_operand" "")))]
4081  "TARGET_THUMB1"
4082  "")
4083
4084(define_expand "extv"
4085  [(set (match_operand 0 "s_register_operand" "")
4086	(sign_extract (match_operand 1 "nonimmediate_operand" "")
4087		      (match_operand 2 "const_int_operand" "")
4088		      (match_operand 3 "const_int_operand" "")))]
4089  "arm_arch_thumb2"
4090{
4091  HOST_WIDE_INT width = INTVAL (operands[2]);
4092  HOST_WIDE_INT bitpos = INTVAL (operands[3]);
4093
4094  if (unaligned_access && MEM_P (operands[1]) && (width == 16 || width == 32)
4095      && (bitpos % BITS_PER_UNIT)  == 0)
4096    {
4097      rtx base_addr;
4098      
4099      if (BYTES_BIG_ENDIAN)
4100	bitpos = GET_MODE_BITSIZE (GET_MODE (operands[0])) - width - bitpos;
4101      
4102      if (width == 32)
4103        {
4104	  base_addr = adjust_address (operands[1], SImode,
4105				      bitpos / BITS_PER_UNIT);
4106	  emit_insn (gen_unaligned_loadsi (operands[0], base_addr));
4107        }
4108      else
4109        {
4110	  rtx dest = operands[0];
4111	  rtx tmp = gen_reg_rtx (SImode);
4112	  
4113	  /* We may get a paradoxical subreg here.  Strip it off.  */
4114	  if (GET_CODE (dest) == SUBREG
4115	      && GET_MODE (dest) == SImode
4116	      && GET_MODE (SUBREG_REG (dest)) == HImode)
4117	    dest = SUBREG_REG (dest);
4118	  
4119	  if (GET_MODE_BITSIZE (GET_MODE (dest)) != width)
4120	    FAIL;
4121	  
4122	  base_addr = adjust_address (operands[1], HImode,
4123				      bitpos / BITS_PER_UNIT);
4124	  emit_insn (gen_unaligned_loadhis (tmp, base_addr));
4125	  emit_move_insn (gen_lowpart (SImode, dest), tmp);
4126	}
4127
4128      DONE;
4129    }
4130  else if (!s_register_operand (operands[1], GET_MODE (operands[1])))
4131    FAIL;
4132  else if (GET_MODE (operands[0]) == SImode
4133	   && GET_MODE (operands[1]) == SImode)
4134    {
4135      emit_insn (gen_extv_regsi (operands[0], operands[1], operands[2],
4136				 operands[3]));
4137      DONE;
4138    }
4139
4140  FAIL;
4141})
4142
4143; Helper to expand register forms of extv with the proper modes.
4144
4145(define_expand "extv_regsi"
4146  [(set (match_operand:SI 0 "s_register_operand" "")
4147	(sign_extract:SI (match_operand:SI 1 "s_register_operand" "")
4148			 (match_operand 2 "const_int_operand" "")
4149			 (match_operand 3 "const_int_operand" "")))]
4150  ""
4151{
4152})
4153
4154; ARMv6+ unaligned load/store instructions (used for packed structure accesses).
4155
4156(define_insn "unaligned_loadsi"
4157  [(set (match_operand:SI 0 "s_register_operand" "=l,r")
4158	(unspec:SI [(match_operand:SI 1 "memory_operand" "Uw,m")]
4159		   UNSPEC_UNALIGNED_LOAD))]
4160  "unaligned_access && TARGET_32BIT"
4161  "ldr%?\t%0, %1\t@ unaligned"
4162  [(set_attr "arch" "t2,any")
4163   (set_attr "length" "2,4")
4164   (set_attr "predicable" "yes")
4165   (set_attr "predicable_short_it" "yes,no")
4166   (set_attr "type" "load1")])
4167
4168(define_insn "unaligned_loadhis"
4169  [(set (match_operand:SI 0 "s_register_operand" "=l,r")
4170	(sign_extend:SI
4171	  (unspec:HI [(match_operand:HI 1 "memory_operand" "Uw,Uh")]
4172		     UNSPEC_UNALIGNED_LOAD)))]
4173  "unaligned_access && TARGET_32BIT"
4174  "ldr%(sh%)\t%0, %1\t@ unaligned"
4175  [(set_attr "arch" "t2,any")
4176   (set_attr "length" "2,4")
4177   (set_attr "predicable" "yes")
4178   (set_attr "predicable_short_it" "yes,no")
4179   (set_attr "type" "load_byte")])
4180
4181(define_insn "unaligned_loadhiu"
4182  [(set (match_operand:SI 0 "s_register_operand" "=l,r")
4183	(zero_extend:SI
4184	  (unspec:HI [(match_operand:HI 1 "memory_operand" "Uw,m")]
4185		     UNSPEC_UNALIGNED_LOAD)))]
4186  "unaligned_access && TARGET_32BIT"
4187  "ldr%(h%)\t%0, %1\t@ unaligned"
4188  [(set_attr "arch" "t2,any")
4189   (set_attr "length" "2,4")
4190   (set_attr "predicable" "yes")
4191   (set_attr "predicable_short_it" "yes,no")
4192   (set_attr "type" "load_byte")])
4193
4194(define_insn "unaligned_storesi"
4195  [(set (match_operand:SI 0 "memory_operand" "=Uw,m")
4196	(unspec:SI [(match_operand:SI 1 "s_register_operand" "l,r")]
4197		   UNSPEC_UNALIGNED_STORE))]
4198  "unaligned_access && TARGET_32BIT"
4199  "str%?\t%1, %0\t@ unaligned"
4200  [(set_attr "arch" "t2,any")
4201   (set_attr "length" "2,4")
4202   (set_attr "predicable" "yes")
4203   (set_attr "predicable_short_it" "yes,no")
4204   (set_attr "type" "store1")])
4205
4206(define_insn "unaligned_storehi"
4207  [(set (match_operand:HI 0 "memory_operand" "=Uw,m")
4208	(unspec:HI [(match_operand:HI 1 "s_register_operand" "l,r")]
4209		   UNSPEC_UNALIGNED_STORE))]
4210  "unaligned_access && TARGET_32BIT"
4211  "str%(h%)\t%1, %0\t@ unaligned"
4212  [(set_attr "arch" "t2,any")
4213   (set_attr "length" "2,4")
4214   (set_attr "predicable" "yes")
4215   (set_attr "predicable_short_it" "yes,no")
4216   (set_attr "type" "store1")])
4217
4218;; Unaligned double-word load and store.
4219;; Split after reload into two unaligned single-word accesses.
4220;; It prevents lower_subreg from splitting some other aligned
4221;; double-word accesses too early. Used for internal memcpy.
4222
4223(define_insn_and_split "unaligned_loaddi"
4224  [(set (match_operand:DI 0 "s_register_operand" "=l,r")
4225	(unspec:DI [(match_operand:DI 1 "memory_operand" "o,o")]
4226		   UNSPEC_UNALIGNED_LOAD))]
4227  "unaligned_access && TARGET_32BIT"
4228  "#"
4229  "&& reload_completed"
4230  [(set (match_dup 0) (unspec:SI [(match_dup 1)] UNSPEC_UNALIGNED_LOAD))
4231   (set (match_dup 2) (unspec:SI [(match_dup 3)] UNSPEC_UNALIGNED_LOAD))]
4232  {
4233    operands[2] = gen_highpart (SImode, operands[0]);
4234    operands[0] = gen_lowpart (SImode, operands[0]);
4235    operands[3] = gen_highpart (SImode, operands[1]);
4236    operands[1] = gen_lowpart (SImode, operands[1]);
4237
4238    /* If the first destination register overlaps with the base address,
4239       swap the order in which the loads are emitted.  */
4240    if (reg_overlap_mentioned_p (operands[0], operands[1]))
4241      {
4242        std::swap (operands[1], operands[3]);
4243        std::swap (operands[0], operands[2]);
4244      }
4245  }
4246  [(set_attr "arch" "t2,any")
4247   (set_attr "length" "4,8")
4248   (set_attr "predicable" "yes")
4249   (set_attr "type" "load2")])
4250
4251(define_insn_and_split "unaligned_storedi"
4252  [(set (match_operand:DI 0 "memory_operand" "=o,o")
4253	(unspec:DI [(match_operand:DI 1 "s_register_operand" "l,r")]
4254		   UNSPEC_UNALIGNED_STORE))]
4255  "unaligned_access && TARGET_32BIT"
4256  "#"
4257  "&& reload_completed"
4258  [(set (match_dup 0) (unspec:SI [(match_dup 1)] UNSPEC_UNALIGNED_STORE))
4259   (set (match_dup 2) (unspec:SI [(match_dup 3)] UNSPEC_UNALIGNED_STORE))]
4260  {
4261    operands[2] = gen_highpart (SImode, operands[0]);
4262    operands[0] = gen_lowpart (SImode, operands[0]);
4263    operands[3] = gen_highpart (SImode, operands[1]);
4264    operands[1] = gen_lowpart (SImode, operands[1]);
4265  }
4266  [(set_attr "arch" "t2,any")
4267   (set_attr "length" "4,8")
4268   (set_attr "predicable" "yes")
4269   (set_attr "type" "store2")])
4270
4271
4272(define_insn "*extv_reg"
4273  [(set (match_operand:SI 0 "s_register_operand" "=r")
4274	(sign_extract:SI (match_operand:SI 1 "s_register_operand" "r")
4275                         (match_operand:SI 2 "const_int_M_operand" "M")
4276                         (match_operand:SI 3 "const_int_M_operand" "M")))]
4277  "arm_arch_thumb2"
4278  "sbfx%?\t%0, %1, %3, %2"
4279  [(set_attr "length" "4")
4280   (set_attr "predicable" "yes")
4281   (set_attr "predicable_short_it" "no")
4282   (set_attr "type" "bfm")]
4283)
4284
4285(define_insn "extzv_t2"
4286  [(set (match_operand:SI 0 "s_register_operand" "=r")
4287	(zero_extract:SI (match_operand:SI 1 "s_register_operand" "r")
4288                         (match_operand:SI 2 "const_int_M_operand" "M")
4289                         (match_operand:SI 3 "const_int_M_operand" "M")))]
4290  "arm_arch_thumb2"
4291  "ubfx%?\t%0, %1, %3, %2"
4292  [(set_attr "length" "4")
4293   (set_attr "predicable" "yes")
4294   (set_attr "predicable_short_it" "no")
4295   (set_attr "type" "bfm")]
4296)
4297
4298
4299;; Division instructions
4300(define_insn "divsi3"
4301  [(set (match_operand:SI	  0 "s_register_operand" "=r")
4302	(div:SI (match_operand:SI 1 "s_register_operand"  "r")
4303		(match_operand:SI 2 "s_register_operand"  "r")))]
4304  "TARGET_IDIV"
4305  "sdiv%?\t%0, %1, %2"
4306  [(set_attr "predicable" "yes")
4307   (set_attr "predicable_short_it" "no")
4308   (set_attr "type" "sdiv")]
4309)
4310
4311(define_insn "udivsi3"
4312  [(set (match_operand:SI	   0 "s_register_operand" "=r")
4313	(udiv:SI (match_operand:SI 1 "s_register_operand"  "r")
4314		 (match_operand:SI 2 "s_register_operand"  "r")))]
4315  "TARGET_IDIV"
4316  "udiv%?\t%0, %1, %2"
4317  [(set_attr "predicable" "yes")
4318   (set_attr "predicable_short_it" "no")
4319   (set_attr "type" "udiv")]
4320)
4321
4322
4323;; Unary arithmetic insns
4324
4325(define_expand "negdi2"
4326 [(parallel
4327   [(set (match_operand:DI 0 "s_register_operand" "")
4328	 (neg:DI (match_operand:DI 1 "s_register_operand" "")))
4329    (clobber (reg:CC CC_REGNUM))])]
4330  "TARGET_EITHER"
4331  {
4332    if (TARGET_NEON)
4333      {
4334        emit_insn (gen_negdi2_neon (operands[0], operands[1]));
4335	DONE;
4336      }
4337  }
4338)
4339
4340;; The constraints here are to prevent a *partial* overlap (where %Q0 == %R1).
4341;; The first alternative allows the common case of a *full* overlap.
4342(define_insn_and_split "*arm_negdi2"
4343  [(set (match_operand:DI         0 "s_register_operand" "=r,&r")
4344	(neg:DI (match_operand:DI 1 "s_register_operand"  "0,r")))
4345   (clobber (reg:CC CC_REGNUM))]
4346  "TARGET_ARM"
4347  "#"   ; "rsbs\\t%Q0, %Q1, #0\;rsc\\t%R0, %R1, #0"
4348  "&& reload_completed"
4349  [(parallel [(set (reg:CC CC_REGNUM)
4350		   (compare:CC (const_int 0) (match_dup 1)))
4351	      (set (match_dup 0) (minus:SI (const_int 0) (match_dup 1)))])
4352   (set (match_dup 2) (minus:SI (minus:SI (const_int 0) (match_dup 3))
4353                                (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
4354  {
4355    operands[2] = gen_highpart (SImode, operands[0]);
4356    operands[0] = gen_lowpart (SImode, operands[0]);
4357    operands[3] = gen_highpart (SImode, operands[1]);
4358    operands[1] = gen_lowpart (SImode, operands[1]);
4359  }
4360  [(set_attr "conds" "clob")
4361   (set_attr "length" "8")
4362   (set_attr "type" "multiple")]
4363)
4364
4365(define_expand "negsi2"
4366  [(set (match_operand:SI         0 "s_register_operand" "")
4367	(neg:SI (match_operand:SI 1 "s_register_operand" "")))]
4368  "TARGET_EITHER"
4369  ""
4370)
4371
4372(define_insn "*arm_negsi2"
4373  [(set (match_operand:SI         0 "s_register_operand" "=l,r")
4374	(neg:SI (match_operand:SI 1 "s_register_operand" "l,r")))]
4375  "TARGET_32BIT"
4376  "rsb%?\\t%0, %1, #0"
4377  [(set_attr "predicable" "yes")
4378   (set_attr "predicable_short_it" "yes,no")
4379   (set_attr "arch" "t2,*")
4380   (set_attr "length" "4")
4381   (set_attr "type" "alu_sreg")]
4382)
4383
4384(define_expand "negsf2"
4385  [(set (match_operand:SF         0 "s_register_operand" "")
4386	(neg:SF (match_operand:SF 1 "s_register_operand" "")))]
4387  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP"
4388  ""
4389)
4390
4391(define_expand "negdf2"
4392  [(set (match_operand:DF         0 "s_register_operand" "")
4393	(neg:DF (match_operand:DF 1 "s_register_operand" "")))]
4394  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP_DOUBLE"
4395  "")
4396
4397(define_insn_and_split "*zextendsidi_negsi"
4398  [(set (match_operand:DI 0 "s_register_operand" "=r")
4399        (zero_extend:DI (neg:SI (match_operand:SI 1 "s_register_operand" "r"))))]
4400   "TARGET_32BIT"
4401   "#"
4402   ""
4403   [(set (match_dup 2)
4404         (neg:SI (match_dup 1)))
4405    (set (match_dup 3)
4406         (const_int 0))]
4407   {
4408      operands[2] = gen_lowpart (SImode, operands[0]);
4409      operands[3] = gen_highpart (SImode, operands[0]);
4410   }
4411 [(set_attr "length" "8")
4412  (set_attr "type" "multiple")]
4413)
4414
4415;; Negate an extended 32-bit value.
4416(define_insn_and_split "*negdi_extendsidi"
4417  [(set (match_operand:DI 0 "s_register_operand" "=l,r")
4418	(neg:DI (sign_extend:DI
4419		 (match_operand:SI 1 "s_register_operand" "l,r"))))
4420   (clobber (reg:CC CC_REGNUM))]
4421  "TARGET_32BIT"
4422  "#"
4423  "&& reload_completed"
4424  [(const_int 0)]
4425  {
4426    rtx low = gen_lowpart (SImode, operands[0]);
4427    rtx high = gen_highpart (SImode, operands[0]);
4428
4429    if (reg_overlap_mentioned_p (low, operands[1]))
4430      {
4431	/* Input overlaps the low word of the output.  Use:
4432		asr	Rhi, Rin, #31
4433		rsbs	Rlo, Rin, #0
4434		rsc	Rhi, Rhi, #0 (thumb2: sbc Rhi, Rhi, Rhi, lsl #1).  */
4435	rtx cc_reg = gen_rtx_REG (CC_Cmode, CC_REGNUM);
4436
4437	emit_insn (gen_rtx_SET (VOIDmode, high,
4438				gen_rtx_ASHIFTRT (SImode, operands[1],
4439						  GEN_INT (31))));
4440
4441	emit_insn (gen_subsi3_compare (low, const0_rtx, operands[1]));
4442	if (TARGET_ARM)
4443	  emit_insn (gen_rtx_SET (VOIDmode, high,
4444				  gen_rtx_MINUS (SImode,
4445						 gen_rtx_MINUS (SImode,
4446								const0_rtx,
4447								high),
4448						 gen_rtx_LTU (SImode,
4449							      cc_reg,
4450							      const0_rtx))));
4451	else
4452	  {
4453	    rtx two_x = gen_rtx_ASHIFT (SImode, high, GEN_INT (1));
4454	    emit_insn (gen_rtx_SET (VOIDmode, high,
4455				    gen_rtx_MINUS (SImode,
4456						   gen_rtx_MINUS (SImode,
4457								  high,
4458								  two_x),
4459						   gen_rtx_LTU (SImode,
4460								cc_reg,
4461								const0_rtx))));
4462	  }
4463      }
4464    else
4465      {
4466	/* No overlap, or overlap on high word.  Use:
4467		rsb	Rlo, Rin, #0
4468		bic	Rhi, Rlo, Rin
4469		asr	Rhi, Rhi, #31
4470	   Flags not needed for this sequence.  */
4471	emit_insn (gen_rtx_SET (VOIDmode, low,
4472				gen_rtx_NEG (SImode, operands[1])));
4473	emit_insn (gen_rtx_SET (VOIDmode, high,
4474				gen_rtx_AND (SImode,
4475					     gen_rtx_NOT (SImode, operands[1]),
4476					     low)));
4477	emit_insn (gen_rtx_SET (VOIDmode, high,
4478				gen_rtx_ASHIFTRT (SImode, high,
4479						  GEN_INT (31))));
4480      }
4481    DONE;
4482  }
4483  [(set_attr "length" "12")
4484   (set_attr "arch" "t2,*")
4485   (set_attr "type" "multiple")]
4486)
4487
4488(define_insn_and_split "*negdi_zero_extendsidi"
4489  [(set (match_operand:DI 0 "s_register_operand" "=r,&r")
4490	(neg:DI (zero_extend:DI (match_operand:SI 1 "s_register_operand" "0,r"))))
4491   (clobber (reg:CC CC_REGNUM))]
4492  "TARGET_32BIT"
4493  "#" ; "rsbs\\t%Q0, %1, #0\;sbc\\t%R0,%R0,%R0"
4494      ;; Don't care what register is input to sbc,
4495      ;; since we just just need to propagate the carry.
4496  "&& reload_completed"
4497  [(parallel [(set (reg:CC CC_REGNUM)
4498                   (compare:CC (const_int 0) (match_dup 1)))
4499              (set (match_dup 0) (minus:SI (const_int 0) (match_dup 1)))])
4500   (set (match_dup 2) (minus:SI (minus:SI (match_dup 2) (match_dup 2))
4501                                (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
4502  {
4503    operands[2] = gen_highpart (SImode, operands[0]);
4504    operands[0] = gen_lowpart (SImode, operands[0]);
4505  }
4506  [(set_attr "conds" "clob")
4507   (set_attr "length" "8")
4508   (set_attr "type" "multiple")]   ;; length in thumb is 4
4509)
4510
4511;; abssi2 doesn't really clobber the condition codes if a different register
4512;; is being set.  To keep things simple, assume during rtl manipulations that
4513;; it does, but tell the final scan operator the truth.  Similarly for
4514;; (neg (abs...))
4515
4516(define_expand "abssi2"
4517  [(parallel
4518    [(set (match_operand:SI         0 "s_register_operand" "")
4519	  (abs:SI (match_operand:SI 1 "s_register_operand" "")))
4520     (clobber (match_dup 2))])]
4521  "TARGET_EITHER"
4522  "
4523  if (TARGET_THUMB1)
4524    operands[2] = gen_rtx_SCRATCH (SImode);
4525  else
4526    operands[2] = gen_rtx_REG (CCmode, CC_REGNUM);
4527")
4528
4529(define_insn_and_split "*arm_abssi2"
4530  [(set (match_operand:SI 0 "s_register_operand" "=r,&r")
4531	(abs:SI (match_operand:SI 1 "s_register_operand" "0,r")))
4532   (clobber (reg:CC CC_REGNUM))]
4533  "TARGET_ARM"
4534  "#"
4535  "&& reload_completed"
4536  [(const_int 0)]
4537  {
4538   /* if (which_alternative == 0) */
4539   if (REGNO(operands[0]) == REGNO(operands[1]))
4540     {
4541      /* Emit the pattern:
4542         cmp\\t%0, #0\;rsblt\\t%0, %0, #0
4543         [(set (reg:CC CC_REGNUM)
4544               (compare:CC (match_dup 0) (const_int 0)))
4545          (cond_exec (lt:CC (reg:CC CC_REGNUM) (const_int 0))
4546                     (set (match_dup 0) (minus:SI (const_int 0) (match_dup 1))))]
4547      */
4548      emit_insn (gen_rtx_SET (VOIDmode,
4549                              gen_rtx_REG (CCmode, CC_REGNUM),
4550                              gen_rtx_COMPARE (CCmode, operands[0], const0_rtx)));
4551      emit_insn (gen_rtx_COND_EXEC (VOIDmode,
4552                                    (gen_rtx_LT (SImode,
4553                                                 gen_rtx_REG (CCmode, CC_REGNUM),
4554                                                 const0_rtx)),
4555                                    (gen_rtx_SET (VOIDmode,
4556                                                  operands[0],
4557                                                  (gen_rtx_MINUS (SImode,
4558                                                                  const0_rtx,
4559                                                                  operands[1]))))));
4560      DONE;
4561     }
4562   else
4563     {
4564      /* Emit the pattern:
4565         alt1: eor%?\\t%0, %1, %1, asr #31\;sub%?\\t%0, %0, %1, asr #31
4566         [(set (match_dup 0)
4567               (xor:SI (match_dup 1)
4568                       (ashiftrt:SI (match_dup 1) (const_int 31))))
4569          (set (match_dup 0)
4570               (minus:SI (match_dup 0)
4571                      (ashiftrt:SI (match_dup 1) (const_int 31))))]
4572      */
4573      emit_insn (gen_rtx_SET (VOIDmode,
4574                              operands[0],
4575                              gen_rtx_XOR (SImode,
4576                                           gen_rtx_ASHIFTRT (SImode,
4577                                                             operands[1],
4578                                                             GEN_INT (31)),
4579                                           operands[1])));
4580      emit_insn (gen_rtx_SET (VOIDmode,
4581                              operands[0],
4582                              gen_rtx_MINUS (SImode,
4583                                             operands[0],
4584                                             gen_rtx_ASHIFTRT (SImode,
4585                                                               operands[1],
4586                                                               GEN_INT (31)))));
4587      DONE;
4588     }
4589  }
4590  [(set_attr "conds" "clob,*")
4591   (set_attr "shift" "1")
4592   (set_attr "predicable" "no, yes")
4593   (set_attr "length" "8")
4594   (set_attr "type" "multiple")]
4595)
4596
4597(define_insn_and_split "*arm_neg_abssi2"
4598  [(set (match_operand:SI 0 "s_register_operand" "=r,&r")
4599	(neg:SI (abs:SI (match_operand:SI 1 "s_register_operand" "0,r"))))
4600   (clobber (reg:CC CC_REGNUM))]
4601  "TARGET_ARM"
4602  "#"
4603  "&& reload_completed"
4604  [(const_int 0)]
4605  {
4606   /* if (which_alternative == 0) */
4607   if (REGNO (operands[0]) == REGNO (operands[1]))
4608     {
4609      /* Emit the pattern:
4610         cmp\\t%0, #0\;rsbgt\\t%0, %0, #0
4611      */
4612      emit_insn (gen_rtx_SET (VOIDmode,
4613                              gen_rtx_REG (CCmode, CC_REGNUM),
4614                              gen_rtx_COMPARE (CCmode, operands[0], const0_rtx)));
4615      emit_insn (gen_rtx_COND_EXEC (VOIDmode,
4616                                    gen_rtx_GT (SImode,
4617                                                gen_rtx_REG (CCmode, CC_REGNUM),
4618                                                const0_rtx),
4619                                    gen_rtx_SET (VOIDmode,
4620                                                 operands[0],
4621                                                 (gen_rtx_MINUS (SImode,
4622                                                                 const0_rtx,
4623                                                                 operands[1])))));
4624     }
4625   else
4626     {
4627      /* Emit the pattern:
4628         eor%?\\t%0, %1, %1, asr #31\;rsb%?\\t%0, %0, %1, asr #31
4629      */
4630      emit_insn (gen_rtx_SET (VOIDmode,
4631                              operands[0],
4632                              gen_rtx_XOR (SImode,
4633                                           gen_rtx_ASHIFTRT (SImode,
4634                                                             operands[1],
4635                                                             GEN_INT (31)),
4636                                           operands[1])));
4637      emit_insn (gen_rtx_SET (VOIDmode,
4638                              operands[0],
4639                              gen_rtx_MINUS (SImode,
4640                                             gen_rtx_ASHIFTRT (SImode,
4641                                                               operands[1],
4642                                                               GEN_INT (31)),
4643                                             operands[0])));
4644     }
4645   DONE;
4646  }
4647  [(set_attr "conds" "clob,*")
4648   (set_attr "shift" "1")
4649   (set_attr "predicable" "no, yes")
4650   (set_attr "length" "8")
4651   (set_attr "type" "multiple")]
4652)
4653
4654(define_expand "abssf2"
4655  [(set (match_operand:SF         0 "s_register_operand" "")
4656	(abs:SF (match_operand:SF 1 "s_register_operand" "")))]
4657  "TARGET_32BIT && TARGET_HARD_FLOAT"
4658  "")
4659
4660(define_expand "absdf2"
4661  [(set (match_operand:DF         0 "s_register_operand" "")
4662	(abs:DF (match_operand:DF 1 "s_register_operand" "")))]
4663  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
4664  "")
4665
4666(define_expand "sqrtsf2"
4667  [(set (match_operand:SF 0 "s_register_operand" "")
4668	(sqrt:SF (match_operand:SF 1 "s_register_operand" "")))]
4669  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP"
4670  "")
4671
4672(define_expand "sqrtdf2"
4673  [(set (match_operand:DF 0 "s_register_operand" "")
4674	(sqrt:DF (match_operand:DF 1 "s_register_operand" "")))]
4675  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP_DOUBLE"
4676  "")
4677
4678(define_insn_and_split "one_cmpldi2"
4679  [(set (match_operand:DI 0 "s_register_operand"	 "=w,&r,&r,?w")
4680	(not:DI (match_operand:DI 1 "s_register_operand" " w, 0, r, w")))]
4681  "TARGET_32BIT"
4682  "@
4683   vmvn\t%P0, %P1
4684   #
4685   #
4686   vmvn\t%P0, %P1"
4687  "TARGET_32BIT && reload_completed
4688   && arm_general_register_operand (operands[0], DImode)"
4689  [(set (match_dup 0) (not:SI (match_dup 1)))
4690   (set (match_dup 2) (not:SI (match_dup 3)))]
4691  "
4692  {
4693    operands[2] = gen_highpart (SImode, operands[0]);
4694    operands[0] = gen_lowpart (SImode, operands[0]);
4695    operands[3] = gen_highpart (SImode, operands[1]);
4696    operands[1] = gen_lowpart (SImode, operands[1]);
4697  }"
4698  [(set_attr "length" "*,8,8,*")
4699   (set_attr "predicable" "no,yes,yes,no")
4700   (set_attr "type" "neon_move,multiple,multiple,neon_move")
4701   (set_attr "arch" "neon_for_64bits,*,*,avoid_neon_for_64bits")]
4702)
4703
4704(define_expand "one_cmplsi2"
4705  [(set (match_operand:SI         0 "s_register_operand" "")
4706	(not:SI (match_operand:SI 1 "s_register_operand" "")))]
4707  "TARGET_EITHER"
4708  ""
4709)
4710
4711(define_insn "*arm_one_cmplsi2"
4712  [(set (match_operand:SI         0 "s_register_operand" "=l,r")
4713	(not:SI (match_operand:SI 1 "s_register_operand"  "l,r")))]
4714  "TARGET_32BIT"
4715  "mvn%?\\t%0, %1"
4716  [(set_attr "predicable" "yes")
4717   (set_attr "predicable_short_it" "yes,no")
4718   (set_attr "arch" "t2,*")
4719   (set_attr "length" "4")
4720   (set_attr "type" "mvn_reg")]
4721)
4722
4723(define_insn "*notsi_compare0"
4724  [(set (reg:CC_NOOV CC_REGNUM)
4725	(compare:CC_NOOV (not:SI (match_operand:SI 1 "s_register_operand" "r"))
4726			 (const_int 0)))
4727   (set (match_operand:SI 0 "s_register_operand" "=r")
4728	(not:SI (match_dup 1)))]
4729  "TARGET_32BIT"
4730  "mvn%.\\t%0, %1"
4731  [(set_attr "conds" "set")
4732   (set_attr "type" "mvn_reg")]
4733)
4734
4735(define_insn "*notsi_compare0_scratch"
4736  [(set (reg:CC_NOOV CC_REGNUM)
4737	(compare:CC_NOOV (not:SI (match_operand:SI 1 "s_register_operand" "r"))
4738			 (const_int 0)))
4739   (clobber (match_scratch:SI 0 "=r"))]
4740  "TARGET_32BIT"
4741  "mvn%.\\t%0, %1"
4742  [(set_attr "conds" "set")
4743   (set_attr "type" "mvn_reg")]
4744)
4745
4746;; Fixed <--> Floating conversion insns
4747
4748(define_expand "floatsihf2"
4749  [(set (match_operand:HF           0 "general_operand" "")
4750	(float:HF (match_operand:SI 1 "general_operand" "")))]
4751  "TARGET_EITHER"
4752  "
4753  {
4754    rtx op1 = gen_reg_rtx (SFmode);
4755    expand_float (op1, operands[1], 0);
4756    op1 = convert_to_mode (HFmode, op1, 0);
4757    emit_move_insn (operands[0], op1);
4758    DONE;
4759  }"
4760)
4761
4762(define_expand "floatdihf2"
4763  [(set (match_operand:HF           0 "general_operand" "")
4764	(float:HF (match_operand:DI 1 "general_operand" "")))]
4765  "TARGET_EITHER"
4766  "
4767  {
4768    rtx op1 = gen_reg_rtx (SFmode);
4769    expand_float (op1, operands[1], 0);
4770    op1 = convert_to_mode (HFmode, op1, 0);
4771    emit_move_insn (operands[0], op1);
4772    DONE;
4773  }"
4774)
4775
4776(define_expand "floatsisf2"
4777  [(set (match_operand:SF           0 "s_register_operand" "")
4778	(float:SF (match_operand:SI 1 "s_register_operand" "")))]
4779  "TARGET_32BIT && TARGET_HARD_FLOAT"
4780  "
4781")
4782
4783(define_expand "floatsidf2"
4784  [(set (match_operand:DF           0 "s_register_operand" "")
4785	(float:DF (match_operand:SI 1 "s_register_operand" "")))]
4786  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
4787  "
4788")
4789
4790(define_expand "fix_trunchfsi2"
4791  [(set (match_operand:SI         0 "general_operand" "")
4792	(fix:SI (fix:HF (match_operand:HF 1 "general_operand"  ""))))]
4793  "TARGET_EITHER"
4794  "
4795  {
4796    rtx op1 = convert_to_mode (SFmode, operands[1], 0);
4797    expand_fix (operands[0], op1, 0);
4798    DONE;
4799  }"
4800)
4801
4802(define_expand "fix_trunchfdi2"
4803  [(set (match_operand:DI         0 "general_operand" "")
4804	(fix:DI (fix:HF (match_operand:HF 1 "general_operand"  ""))))]
4805  "TARGET_EITHER"
4806  "
4807  {
4808    rtx op1 = convert_to_mode (SFmode, operands[1], 0);
4809    expand_fix (operands[0], op1, 0);
4810    DONE;
4811  }"
4812)
4813
4814(define_expand "fix_truncsfsi2"
4815  [(set (match_operand:SI         0 "s_register_operand" "")
4816	(fix:SI (fix:SF (match_operand:SF 1 "s_register_operand"  ""))))]
4817  "TARGET_32BIT && TARGET_HARD_FLOAT"
4818  "
4819")
4820
4821(define_expand "fix_truncdfsi2"
4822  [(set (match_operand:SI         0 "s_register_operand" "")
4823	(fix:SI (fix:DF (match_operand:DF 1 "s_register_operand"  ""))))]
4824  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
4825  "
4826")
4827
4828;; Truncation insns
4829
4830(define_expand "truncdfsf2"
4831  [(set (match_operand:SF  0 "s_register_operand" "")
4832	(float_truncate:SF
4833 	 (match_operand:DF 1 "s_register_operand" "")))]
4834  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
4835  ""
4836)
4837
4838/* DFmode -> HFmode conversions have to go through SFmode.  */
4839(define_expand "truncdfhf2"
4840  [(set (match_operand:HF  0 "general_operand" "")
4841	(float_truncate:HF
4842 	 (match_operand:DF 1 "general_operand" "")))]
4843  "TARGET_EITHER"
4844  "
4845  {
4846    rtx op1;
4847    op1 = convert_to_mode (SFmode, operands[1], 0);
4848    op1 = convert_to_mode (HFmode, op1, 0);
4849    emit_move_insn (operands[0], op1);
4850    DONE;
4851  }"
4852)
4853
4854;; Zero and sign extension instructions.
4855
4856(define_insn "zero_extend<mode>di2"
4857  [(set (match_operand:DI 0 "s_register_operand" "=w,r,?r,w")
4858        (zero_extend:DI (match_operand:QHSI 1 "<qhs_zextenddi_op>"
4859					    "<qhs_zextenddi_cstr>")))]
4860  "TARGET_32BIT <qhs_zextenddi_cond>"
4861  "#"
4862  [(set_attr "length" "8,4,8,8")
4863   (set_attr "arch" "neon_for_64bits,*,*,avoid_neon_for_64bits")
4864   (set_attr "ce_count" "2")
4865   (set_attr "predicable" "yes")
4866   (set_attr "type" "multiple,mov_reg,multiple,multiple")]
4867)
4868
4869(define_insn "extend<mode>di2"
4870  [(set (match_operand:DI 0 "s_register_operand" "=w,r,?r,?r,w")
4871        (sign_extend:DI (match_operand:QHSI 1 "<qhs_extenddi_op>"
4872					    "<qhs_extenddi_cstr>")))]
4873  "TARGET_32BIT <qhs_sextenddi_cond>"
4874  "#"
4875  [(set_attr "length" "8,4,8,8,8")
4876   (set_attr "ce_count" "2")
4877   (set_attr "shift" "1")
4878   (set_attr "predicable" "yes")
4879   (set_attr "arch" "neon_for_64bits,*,a,t,avoid_neon_for_64bits")
4880   (set_attr "type" "multiple,mov_reg,multiple,multiple,multiple")]
4881)
4882
4883;; Splits for all extensions to DImode
4884(define_split
4885  [(set (match_operand:DI 0 "s_register_operand" "")
4886        (zero_extend:DI (match_operand 1 "nonimmediate_operand" "")))]
4887  "TARGET_32BIT && reload_completed && !IS_VFP_REGNUM (REGNO (operands[0]))"
4888  [(set (match_dup 0) (match_dup 1))]
4889{
4890  rtx lo_part = gen_lowpart (SImode, operands[0]);
4891  machine_mode src_mode = GET_MODE (operands[1]);
4892
4893  if (REG_P (operands[0])
4894      && !reg_overlap_mentioned_p (operands[0], operands[1]))
4895    emit_clobber (operands[0]);
4896  if (!REG_P (lo_part) || src_mode != SImode
4897      || !rtx_equal_p (lo_part, operands[1]))
4898    {
4899      if (src_mode == SImode)
4900        emit_move_insn (lo_part, operands[1]);
4901      else
4902        emit_insn (gen_rtx_SET (VOIDmode, lo_part,
4903				gen_rtx_ZERO_EXTEND (SImode, operands[1])));
4904      operands[1] = lo_part;
4905    }
4906  operands[0] = gen_highpart (SImode, operands[0]);
4907  operands[1] = const0_rtx;
4908})
4909
4910(define_split
4911  [(set (match_operand:DI 0 "s_register_operand" "")
4912        (sign_extend:DI (match_operand 1 "nonimmediate_operand" "")))]
4913  "TARGET_32BIT && reload_completed && !IS_VFP_REGNUM (REGNO (operands[0]))"
4914  [(set (match_dup 0) (ashiftrt:SI (match_dup 1) (const_int 31)))]
4915{
4916  rtx lo_part = gen_lowpart (SImode, operands[0]);
4917  machine_mode src_mode = GET_MODE (operands[1]);
4918
4919  if (REG_P (operands[0])
4920      && !reg_overlap_mentioned_p (operands[0], operands[1]))
4921    emit_clobber (operands[0]);
4922
4923  if (!REG_P (lo_part) || src_mode != SImode
4924      || !rtx_equal_p (lo_part, operands[1]))
4925    {
4926      if (src_mode == SImode)
4927        emit_move_insn (lo_part, operands[1]);
4928      else
4929        emit_insn (gen_rtx_SET (VOIDmode, lo_part,
4930				gen_rtx_SIGN_EXTEND (SImode, operands[1])));
4931      operands[1] = lo_part;
4932    }
4933  operands[0] = gen_highpart (SImode, operands[0]);
4934})
4935
4936(define_expand "zero_extendhisi2"
4937  [(set (match_operand:SI 0 "s_register_operand" "")
4938	(zero_extend:SI (match_operand:HI 1 "nonimmediate_operand" "")))]
4939  "TARGET_EITHER"
4940{
4941  if (TARGET_ARM && !arm_arch4 && MEM_P (operands[1]))
4942    {
4943      emit_insn (gen_movhi_bytes (operands[0], operands[1]));
4944      DONE;
4945    }
4946  if (!arm_arch6 && !MEM_P (operands[1]))
4947    {
4948      rtx t = gen_lowpart (SImode, operands[1]);
4949      rtx tmp = gen_reg_rtx (SImode);
4950      emit_insn (gen_ashlsi3 (tmp, t, GEN_INT (16)));
4951      emit_insn (gen_lshrsi3 (operands[0], tmp, GEN_INT (16)));
4952      DONE;
4953    }
4954})
4955
4956(define_split
4957  [(set (match_operand:SI 0 "s_register_operand" "")
4958	(zero_extend:SI (match_operand:HI 1 "s_register_operand" "")))]
4959  "!TARGET_THUMB2 && !arm_arch6"
4960  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 16)))
4961   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 16)))]
4962{
4963  operands[2] = gen_lowpart (SImode, operands[1]);
4964})
4965
4966(define_insn "*arm_zero_extendhisi2"
4967  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
4968	(zero_extend:SI (match_operand:HI 1 "nonimmediate_operand" "r,m")))]
4969  "TARGET_ARM && arm_arch4 && !arm_arch6"
4970  "@
4971   #
4972   ldr%(h%)\\t%0, %1"
4973  [(set_attr "type" "alu_shift_reg,load_byte")
4974   (set_attr "predicable" "yes")]
4975)
4976
4977(define_insn "*arm_zero_extendhisi2_v6"
4978  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
4979	(zero_extend:SI (match_operand:HI 1 "nonimmediate_operand" "r,Uh")))]
4980  "TARGET_ARM && arm_arch6"
4981  "@
4982   uxth%?\\t%0, %1
4983   ldr%(h%)\\t%0, %1"
4984  [(set_attr "predicable" "yes")
4985   (set_attr "type" "extend,load_byte")]
4986)
4987
4988(define_insn "*arm_zero_extendhisi2addsi"
4989  [(set (match_operand:SI 0 "s_register_operand" "=r")
4990	(plus:SI (zero_extend:SI (match_operand:HI 1 "s_register_operand" "r"))
4991		 (match_operand:SI 2 "s_register_operand" "r")))]
4992  "TARGET_INT_SIMD"
4993  "uxtah%?\\t%0, %2, %1"
4994  [(set_attr "type" "alu_shift_reg")
4995   (set_attr "predicable" "yes")
4996   (set_attr "predicable_short_it" "no")]
4997)
4998
4999(define_expand "zero_extendqisi2"
5000  [(set (match_operand:SI 0 "s_register_operand" "")
5001	(zero_extend:SI (match_operand:QI 1 "nonimmediate_operand" "")))]
5002  "TARGET_EITHER"
5003{
5004  if (TARGET_ARM && !arm_arch6 && !MEM_P (operands[1]))
5005    {
5006      emit_insn (gen_andsi3 (operands[0],
5007			     gen_lowpart (SImode, operands[1]),
5008					  GEN_INT (255)));
5009      DONE;
5010    }
5011  if (!arm_arch6 && !MEM_P (operands[1]))
5012    {
5013      rtx t = gen_lowpart (SImode, operands[1]);
5014      rtx tmp = gen_reg_rtx (SImode);
5015      emit_insn (gen_ashlsi3 (tmp, t, GEN_INT (24)));
5016      emit_insn (gen_lshrsi3 (operands[0], tmp, GEN_INT (24)));
5017      DONE;
5018    }
5019})
5020
5021(define_split
5022  [(set (match_operand:SI 0 "s_register_operand" "")
5023	(zero_extend:SI (match_operand:QI 1 "s_register_operand" "")))]
5024  "!arm_arch6"
5025  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 24)))
5026   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 24)))]
5027{
5028  operands[2] = simplify_gen_subreg (SImode, operands[1], QImode, 0);
5029  if (TARGET_ARM)
5030    {
5031      emit_insn (gen_andsi3 (operands[0], operands[2], GEN_INT (255)));
5032      DONE;
5033    }
5034})
5035
5036(define_insn "*arm_zero_extendqisi2"
5037  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5038	(zero_extend:SI (match_operand:QI 1 "nonimmediate_operand" "r,m")))]
5039  "TARGET_ARM && !arm_arch6"
5040  "@
5041   #
5042   ldr%(b%)\\t%0, %1\\t%@ zero_extendqisi2"
5043  [(set_attr "length" "8,4")
5044   (set_attr "type" "alu_shift_reg,load_byte")
5045   (set_attr "predicable" "yes")]
5046)
5047
5048(define_insn "*arm_zero_extendqisi2_v6"
5049  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5050	(zero_extend:SI (match_operand:QI 1 "nonimmediate_operand" "r,Uh")))]
5051  "TARGET_ARM && arm_arch6"
5052  "@
5053   uxtb%(%)\\t%0, %1
5054   ldr%(b%)\\t%0, %1\\t%@ zero_extendqisi2"
5055  [(set_attr "type" "extend,load_byte")
5056   (set_attr "predicable" "yes")]
5057)
5058
5059(define_insn "*arm_zero_extendqisi2addsi"
5060  [(set (match_operand:SI 0 "s_register_operand" "=r")
5061	(plus:SI (zero_extend:SI (match_operand:QI 1 "s_register_operand" "r"))
5062		 (match_operand:SI 2 "s_register_operand" "r")))]
5063  "TARGET_INT_SIMD"
5064  "uxtab%?\\t%0, %2, %1"
5065  [(set_attr "predicable" "yes")
5066   (set_attr "predicable_short_it" "no")
5067   (set_attr "type" "alu_shift_reg")]
5068)
5069
5070(define_split
5071  [(set (match_operand:SI 0 "s_register_operand" "")
5072	(zero_extend:SI (subreg:QI (match_operand:SI 1 "" "") 0)))
5073   (clobber (match_operand:SI 2 "s_register_operand" ""))]
5074  "TARGET_32BIT && (!MEM_P (operands[1])) && ! BYTES_BIG_ENDIAN"
5075  [(set (match_dup 2) (match_dup 1))
5076   (set (match_dup 0) (and:SI (match_dup 2) (const_int 255)))]
5077  ""
5078)
5079
5080(define_split
5081  [(set (match_operand:SI 0 "s_register_operand" "")
5082	(zero_extend:SI (subreg:QI (match_operand:SI 1 "" "") 3)))
5083   (clobber (match_operand:SI 2 "s_register_operand" ""))]
5084  "TARGET_32BIT && (!MEM_P (operands[1])) && BYTES_BIG_ENDIAN"
5085  [(set (match_dup 2) (match_dup 1))
5086   (set (match_dup 0) (and:SI (match_dup 2) (const_int 255)))]
5087  ""
5088)
5089
5090
5091(define_split
5092  [(set (match_operand:SI 0 "s_register_operand" "")
5093	(ior_xor:SI (and:SI (ashift:SI
5094			     (match_operand:SI 1 "s_register_operand" "")
5095			     (match_operand:SI 2 "const_int_operand" ""))
5096			    (match_operand:SI 3 "const_int_operand" ""))
5097		    (zero_extend:SI
5098		     (match_operator 5 "subreg_lowpart_operator"
5099		      [(match_operand:SI 4 "s_register_operand" "")]))))]
5100  "TARGET_32BIT
5101   && ((unsigned HOST_WIDE_INT) INTVAL (operands[3])
5102       == (GET_MODE_MASK (GET_MODE (operands[5]))
5103           & (GET_MODE_MASK (GET_MODE (operands[5]))
5104	      << (INTVAL (operands[2])))))"
5105  [(set (match_dup 0) (ior_xor:SI (ashift:SI (match_dup 1) (match_dup 2))
5106				  (match_dup 4)))
5107   (set (match_dup 0) (zero_extend:SI (match_dup 5)))]
5108  "operands[5] = gen_lowpart (GET_MODE (operands[5]), operands[0]);"
5109)
5110
5111(define_insn "*compareqi_eq0"
5112  [(set (reg:CC_Z CC_REGNUM)
5113	(compare:CC_Z (match_operand:QI 0 "s_register_operand" "r")
5114			 (const_int 0)))]
5115  "TARGET_32BIT"
5116  "tst%?\\t%0, #255"
5117  [(set_attr "conds" "set")
5118   (set_attr "predicable" "yes")
5119   (set_attr "predicable_short_it" "no")
5120   (set_attr "type" "logic_imm")]
5121)
5122
5123(define_expand "extendhisi2"
5124  [(set (match_operand:SI 0 "s_register_operand" "")
5125	(sign_extend:SI (match_operand:HI 1 "nonimmediate_operand" "")))]
5126  "TARGET_EITHER"
5127{
5128  if (TARGET_THUMB1)
5129    {
5130      emit_insn (gen_thumb1_extendhisi2 (operands[0], operands[1]));
5131      DONE;
5132    }
5133  if (MEM_P (operands[1]) && TARGET_ARM && !arm_arch4)
5134    {
5135      emit_insn (gen_extendhisi2_mem (operands[0], operands[1]));
5136      DONE;
5137    }
5138
5139  if (!arm_arch6 && !MEM_P (operands[1]))
5140    {
5141      rtx t = gen_lowpart (SImode, operands[1]);
5142      rtx tmp = gen_reg_rtx (SImode);
5143      emit_insn (gen_ashlsi3 (tmp, t, GEN_INT (16)));
5144      emit_insn (gen_ashrsi3 (operands[0], tmp, GEN_INT (16)));
5145      DONE;
5146    }
5147})
5148
5149(define_split
5150  [(parallel
5151    [(set (match_operand:SI 0 "register_operand" "")
5152	  (sign_extend:SI (match_operand:HI 1 "register_operand" "")))
5153     (clobber (match_scratch:SI 2 ""))])]
5154  "!arm_arch6"
5155  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 16)))
5156   (set (match_dup 0) (ashiftrt:SI (match_dup 0) (const_int 16)))]
5157{
5158  operands[2] = simplify_gen_subreg (SImode, operands[1], HImode, 0);
5159})
5160
5161;; This pattern will only be used when ldsh is not available
5162(define_expand "extendhisi2_mem"
5163  [(set (match_dup 2) (zero_extend:SI (match_operand:HI 1 "" "")))
5164   (set (match_dup 3)
5165	(zero_extend:SI (match_dup 7)))
5166   (set (match_dup 6) (ashift:SI (match_dup 4) (const_int 24)))
5167   (set (match_operand:SI 0 "" "")
5168	(ior:SI (ashiftrt:SI (match_dup 6) (const_int 16)) (match_dup 5)))]
5169  "TARGET_ARM"
5170  "
5171  {
5172    rtx mem1, mem2;
5173    rtx addr = copy_to_mode_reg (SImode, XEXP (operands[1], 0));
5174
5175    mem1 = change_address (operands[1], QImode, addr);
5176    mem2 = change_address (operands[1], QImode,
5177			   plus_constant (Pmode, addr, 1));
5178    operands[0] = gen_lowpart (SImode, operands[0]);
5179    operands[1] = mem1;
5180    operands[2] = gen_reg_rtx (SImode);
5181    operands[3] = gen_reg_rtx (SImode);
5182    operands[6] = gen_reg_rtx (SImode);
5183    operands[7] = mem2;
5184
5185    if (BYTES_BIG_ENDIAN)
5186      {
5187	operands[4] = operands[2];
5188	operands[5] = operands[3];
5189      }
5190    else
5191      {
5192	operands[4] = operands[3];
5193	operands[5] = operands[2];
5194      }
5195  }"
5196)
5197
5198(define_split
5199  [(set (match_operand:SI 0 "register_operand" "")
5200	(sign_extend:SI (match_operand:HI 1 "register_operand" "")))]
5201  "!arm_arch6"
5202  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 16)))
5203   (set (match_dup 0) (ashiftrt:SI (match_dup 0) (const_int 16)))]
5204{
5205  operands[2] = simplify_gen_subreg (SImode, operands[1], HImode, 0);
5206})
5207
5208(define_insn "*arm_extendhisi2"
5209  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5210	(sign_extend:SI (match_operand:HI 1 "nonimmediate_operand" "r,Uh")))]
5211  "TARGET_ARM && arm_arch4 && !arm_arch6"
5212  "@
5213   #
5214   ldr%(sh%)\\t%0, %1"
5215  [(set_attr "length" "8,4")
5216   (set_attr "type" "alu_shift_reg,load_byte")
5217   (set_attr "predicable" "yes")]
5218)
5219
5220;; ??? Check Thumb-2 pool range
5221(define_insn "*arm_extendhisi2_v6"
5222  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5223	(sign_extend:SI (match_operand:HI 1 "nonimmediate_operand" "r,Uh")))]
5224  "TARGET_32BIT && arm_arch6"
5225  "@
5226   sxth%?\\t%0, %1
5227   ldr%(sh%)\\t%0, %1"
5228  [(set_attr "type" "extend,load_byte")
5229   (set_attr "predicable" "yes")
5230   (set_attr "predicable_short_it" "no")]
5231)
5232
5233(define_insn "*arm_extendhisi2addsi"
5234  [(set (match_operand:SI 0 "s_register_operand" "=r")
5235	(plus:SI (sign_extend:SI (match_operand:HI 1 "s_register_operand" "r"))
5236		 (match_operand:SI 2 "s_register_operand" "r")))]
5237  "TARGET_INT_SIMD"
5238  "sxtah%?\\t%0, %2, %1"
5239  [(set_attr "type" "alu_shift_reg")]
5240)
5241
5242(define_expand "extendqihi2"
5243  [(set (match_dup 2)
5244	(ashift:SI (match_operand:QI 1 "arm_reg_or_extendqisi_mem_op" "")
5245		   (const_int 24)))
5246   (set (match_operand:HI 0 "s_register_operand" "")
5247	(ashiftrt:SI (match_dup 2)
5248		     (const_int 24)))]
5249  "TARGET_ARM"
5250  "
5251  {
5252    if (arm_arch4 && MEM_P (operands[1]))
5253      {
5254	emit_insn (gen_rtx_SET (VOIDmode,
5255				operands[0],
5256				gen_rtx_SIGN_EXTEND (HImode, operands[1])));
5257	DONE;
5258      }
5259    if (!s_register_operand (operands[1], QImode))
5260      operands[1] = copy_to_mode_reg (QImode, operands[1]);
5261    operands[0] = gen_lowpart (SImode, operands[0]);
5262    operands[1] = gen_lowpart (SImode, operands[1]);
5263    operands[2] = gen_reg_rtx (SImode);
5264  }"
5265)
5266
5267(define_insn "*arm_extendqihi_insn"
5268  [(set (match_operand:HI 0 "s_register_operand" "=r")
5269	(sign_extend:HI (match_operand:QI 1 "arm_extendqisi_mem_op" "Uq")))]
5270  "TARGET_ARM && arm_arch4"
5271  "ldr%(sb%)\\t%0, %1"
5272  [(set_attr "type" "load_byte")
5273   (set_attr "predicable" "yes")]
5274)
5275
5276(define_expand "extendqisi2"
5277  [(set (match_operand:SI 0 "s_register_operand" "")
5278	(sign_extend:SI (match_operand:QI 1 "arm_reg_or_extendqisi_mem_op" "")))]
5279  "TARGET_EITHER"
5280{
5281  if (!arm_arch4 && MEM_P (operands[1]))
5282    operands[1] = copy_to_mode_reg (QImode, operands[1]);
5283
5284  if (!arm_arch6 && !MEM_P (operands[1]))
5285    {
5286      rtx t = gen_lowpart (SImode, operands[1]);
5287      rtx tmp = gen_reg_rtx (SImode);
5288      emit_insn (gen_ashlsi3 (tmp, t, GEN_INT (24)));
5289      emit_insn (gen_ashrsi3 (operands[0], tmp, GEN_INT (24)));
5290      DONE;
5291    }
5292})
5293
5294(define_split
5295  [(set (match_operand:SI 0 "register_operand" "")
5296	(sign_extend:SI (match_operand:QI 1 "register_operand" "")))]
5297  "!arm_arch6"
5298  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 24)))
5299   (set (match_dup 0) (ashiftrt:SI (match_dup 0) (const_int 24)))]
5300{
5301  operands[2] = simplify_gen_subreg (SImode, operands[1], QImode, 0);
5302})
5303
5304(define_insn "*arm_extendqisi"
5305  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5306	(sign_extend:SI (match_operand:QI 1 "arm_reg_or_extendqisi_mem_op" "r,Uq")))]
5307  "TARGET_ARM && arm_arch4 && !arm_arch6"
5308  "@
5309   #
5310   ldr%(sb%)\\t%0, %1"
5311  [(set_attr "length" "8,4")
5312   (set_attr "type" "alu_shift_reg,load_byte")
5313   (set_attr "predicable" "yes")]
5314)
5315
5316(define_insn "*arm_extendqisi_v6"
5317  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5318	(sign_extend:SI
5319	 (match_operand:QI 1 "arm_reg_or_extendqisi_mem_op" "r,Uq")))]
5320  "TARGET_ARM && arm_arch6"
5321  "@
5322   sxtb%?\\t%0, %1
5323   ldr%(sb%)\\t%0, %1"
5324  [(set_attr "type" "extend,load_byte")
5325   (set_attr "predicable" "yes")]
5326)
5327
5328(define_insn "*arm_extendqisi2addsi"
5329  [(set (match_operand:SI 0 "s_register_operand" "=r")
5330	(plus:SI (sign_extend:SI (match_operand:QI 1 "s_register_operand" "r"))
5331		 (match_operand:SI 2 "s_register_operand" "r")))]
5332  "TARGET_INT_SIMD"
5333  "sxtab%?\\t%0, %2, %1"
5334  [(set_attr "type" "alu_shift_reg")
5335   (set_attr "predicable" "yes")
5336   (set_attr "predicable_short_it" "no")]
5337)
5338
5339(define_expand "extendsfdf2"
5340  [(set (match_operand:DF                  0 "s_register_operand" "")
5341	(float_extend:DF (match_operand:SF 1 "s_register_operand"  "")))]
5342  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
5343  ""
5344)
5345
5346/* HFmode -> DFmode conversions have to go through SFmode.  */
5347(define_expand "extendhfdf2"
5348  [(set (match_operand:DF                  0 "general_operand" "")
5349	(float_extend:DF (match_operand:HF 1 "general_operand"  "")))]
5350  "TARGET_EITHER"
5351  "
5352  {
5353    rtx op1;
5354    op1 = convert_to_mode (SFmode, operands[1], 0);
5355    op1 = convert_to_mode (DFmode, op1, 0);
5356    emit_insn (gen_movdf (operands[0], op1));
5357    DONE;
5358  }"
5359)
5360
5361;; Move insns (including loads and stores)
5362
5363;; XXX Just some ideas about movti.
5364;; I don't think these are a good idea on the arm, there just aren't enough
5365;; registers
5366;;(define_expand "loadti"
5367;;  [(set (match_operand:TI 0 "s_register_operand" "")
5368;;	(mem:TI (match_operand:SI 1 "address_operand" "")))]
5369;;  "" "")
5370
5371;;(define_expand "storeti"
5372;;  [(set (mem:TI (match_operand:TI 0 "address_operand" ""))
5373;;	(match_operand:TI 1 "s_register_operand" ""))]
5374;;  "" "")
5375
5376;;(define_expand "movti"
5377;;  [(set (match_operand:TI 0 "general_operand" "")
5378;;	(match_operand:TI 1 "general_operand" ""))]
5379;;  ""
5380;;  "
5381;;{
5382;;  rtx insn;
5383;;
5384;;  if (MEM_P (operands[0]) && MEM_P (operands[1]))
5385;;    operands[1] = copy_to_reg (operands[1]);
5386;;  if (MEM_P (operands[0]))
5387;;    insn = gen_storeti (XEXP (operands[0], 0), operands[1]);
5388;;  else if (MEM_P (operands[1]))
5389;;    insn = gen_loadti (operands[0], XEXP (operands[1], 0));
5390;;  else
5391;;    FAIL;
5392;;
5393;;  emit_insn (insn);
5394;;  DONE;
5395;;}")
5396
5397;; Recognize garbage generated above.
5398
5399;;(define_insn ""
5400;;  [(set (match_operand:TI 0 "general_operand" "=r,r,r,<,>,m")
5401;;	(match_operand:TI 1 "general_operand" "<,>,m,r,r,r"))]
5402;;  ""
5403;;  "*
5404;;  {
5405;;    register mem = (which_alternative < 3);
5406;;    register const char *template;
5407;;
5408;;    operands[mem] = XEXP (operands[mem], 0);
5409;;    switch (which_alternative)
5410;;      {
5411;;      case 0: template = \"ldmdb\\t%1!, %M0\"; break;
5412;;      case 1: template = \"ldmia\\t%1!, %M0\"; break;
5413;;      case 2: template = \"ldmia\\t%1, %M0\"; break;
5414;;      case 3: template = \"stmdb\\t%0!, %M1\"; break;
5415;;      case 4: template = \"stmia\\t%0!, %M1\"; break;
5416;;      case 5: template = \"stmia\\t%0, %M1\"; break;
5417;;      }
5418;;    output_asm_insn (template, operands);
5419;;    return \"\";
5420;;  }")
5421
5422(define_expand "movdi"
5423  [(set (match_operand:DI 0 "general_operand" "")
5424	(match_operand:DI 1 "general_operand" ""))]
5425  "TARGET_EITHER"
5426  "
5427  if (can_create_pseudo_p ())
5428    {
5429      if (!REG_P (operands[0]))
5430	operands[1] = force_reg (DImode, operands[1]);
5431    }
5432  if (REG_P (operands[0]) && REGNO (operands[0]) <= LAST_ARM_REGNUM
5433      && !HARD_REGNO_MODE_OK (REGNO (operands[0]), DImode))
5434    {
5435      /* Avoid LDRD's into an odd-numbered register pair in ARM state
5436	 when expanding function calls.  */
5437      gcc_assert (can_create_pseudo_p ());
5438      if (MEM_P (operands[1]) && MEM_VOLATILE_P (operands[1]))
5439	{
5440	  /* Perform load into legal reg pair first, then move.  */
5441	  rtx reg = gen_reg_rtx (DImode);
5442	  emit_insn (gen_movdi (reg, operands[1]));
5443	  operands[1] = reg;
5444	}
5445      emit_move_insn (gen_lowpart (SImode, operands[0]),
5446		      gen_lowpart (SImode, operands[1]));
5447      emit_move_insn (gen_highpart (SImode, operands[0]),
5448		      gen_highpart (SImode, operands[1]));
5449      DONE;
5450    }
5451  else if (REG_P (operands[1]) && REGNO (operands[1]) <= LAST_ARM_REGNUM
5452	   && !HARD_REGNO_MODE_OK (REGNO (operands[1]), DImode))
5453    {
5454      /* Avoid STRD's from an odd-numbered register pair in ARM state
5455	 when expanding function prologue.  */
5456      gcc_assert (can_create_pseudo_p ());
5457      rtx split_dest = (MEM_P (operands[0]) && MEM_VOLATILE_P (operands[0]))
5458		       ? gen_reg_rtx (DImode)
5459		       : operands[0];
5460      emit_move_insn (gen_lowpart (SImode, split_dest),
5461		      gen_lowpart (SImode, operands[1]));
5462      emit_move_insn (gen_highpart (SImode, split_dest),
5463		      gen_highpart (SImode, operands[1]));
5464      if (split_dest != operands[0])
5465	emit_insn (gen_movdi (operands[0], split_dest));
5466      DONE;
5467    }
5468  "
5469)
5470
5471(define_insn "*arm_movdi"
5472  [(set (match_operand:DI 0 "nonimmediate_di_operand" "=r, r, r, q, m")
5473	(match_operand:DI 1 "di_operand"              "rDa,Db,Dc,mi,q"))]
5474  "TARGET_32BIT
5475   && !(TARGET_HARD_FLOAT && TARGET_VFP)
5476   && !TARGET_IWMMXT
5477   && (   register_operand (operands[0], DImode)
5478       || register_operand (operands[1], DImode))"
5479  "*
5480  switch (which_alternative)
5481    {
5482    case 0:
5483    case 1:
5484    case 2:
5485      return \"#\";
5486    default:
5487      return output_move_double (operands, true, NULL);
5488    }
5489  "
5490  [(set_attr "length" "8,12,16,8,8")
5491   (set_attr "type" "multiple,multiple,multiple,load2,store2")
5492   (set_attr "arm_pool_range" "*,*,*,1020,*")
5493   (set_attr "arm_neg_pool_range" "*,*,*,1004,*")
5494   (set_attr "thumb2_pool_range" "*,*,*,4094,*")
5495   (set_attr "thumb2_neg_pool_range" "*,*,*,0,*")]
5496)
5497
5498(define_split
5499  [(set (match_operand:ANY64 0 "arm_general_register_operand" "")
5500	(match_operand:ANY64 1 "immediate_operand" ""))]
5501  "TARGET_32BIT
5502   && reload_completed
5503   && (arm_const_double_inline_cost (operands[1])
5504       <= arm_max_const_double_inline_cost ())"
5505  [(const_int 0)]
5506  "
5507  arm_split_constant (SET, SImode, curr_insn,
5508		      INTVAL (gen_lowpart (SImode, operands[1])),
5509		      gen_lowpart (SImode, operands[0]), NULL_RTX, 0);
5510  arm_split_constant (SET, SImode, curr_insn,
5511		      INTVAL (gen_highpart_mode (SImode,
5512						 GET_MODE (operands[0]),
5513						 operands[1])),
5514		      gen_highpart (SImode, operands[0]), NULL_RTX, 0);
5515  DONE;
5516  "
5517)
5518
5519; If optimizing for size, or if we have load delay slots, then 
5520; we want to split the constant into two separate operations. 
5521; In both cases this may split a trivial part into a single data op
5522; leaving a single complex constant to load.  We can also get longer
5523; offsets in a LDR which means we get better chances of sharing the pool
5524; entries.  Finally, we can normally do a better job of scheduling
5525; LDR instructions than we can with LDM.
5526; This pattern will only match if the one above did not.
5527(define_split
5528  [(set (match_operand:ANY64 0 "arm_general_register_operand" "")
5529	(match_operand:ANY64 1 "const_double_operand" ""))]
5530  "TARGET_ARM && reload_completed
5531   && arm_const_double_by_parts (operands[1])"
5532  [(set (match_dup 0) (match_dup 1))
5533   (set (match_dup 2) (match_dup 3))]
5534  "
5535  operands[2] = gen_highpart (SImode, operands[0]);
5536  operands[3] = gen_highpart_mode (SImode, GET_MODE (operands[0]),
5537				   operands[1]);
5538  operands[0] = gen_lowpart (SImode, operands[0]);
5539  operands[1] = gen_lowpart (SImode, operands[1]);
5540  "
5541)
5542
5543(define_split
5544  [(set (match_operand:ANY64 0 "arm_general_register_operand" "")
5545	(match_operand:ANY64 1 "arm_general_register_operand" ""))]
5546  "TARGET_EITHER && reload_completed"
5547  [(set (match_dup 0) (match_dup 1))
5548   (set (match_dup 2) (match_dup 3))]
5549  "
5550  operands[2] = gen_highpart (SImode, operands[0]);
5551  operands[3] = gen_highpart (SImode, operands[1]);
5552  operands[0] = gen_lowpart (SImode, operands[0]);
5553  operands[1] = gen_lowpart (SImode, operands[1]);
5554
5555  /* Handle a partial overlap.  */
5556  if (rtx_equal_p (operands[0], operands[3]))
5557    {
5558      rtx tmp0 = operands[0];
5559      rtx tmp1 = operands[1];
5560
5561      operands[0] = operands[2];
5562      operands[1] = operands[3];
5563      operands[2] = tmp0;
5564      operands[3] = tmp1;
5565    }
5566  "
5567)
5568
5569;; We can't actually do base+index doubleword loads if the index and
5570;; destination overlap.  Split here so that we at least have chance to
5571;; schedule.
5572(define_split
5573  [(set (match_operand:DI 0 "s_register_operand" "")
5574	(mem:DI (plus:SI (match_operand:SI 1 "s_register_operand" "")
5575			 (match_operand:SI 2 "s_register_operand" ""))))]
5576  "TARGET_LDRD
5577  && reg_overlap_mentioned_p (operands[0], operands[1])
5578  && reg_overlap_mentioned_p (operands[0], operands[2])"
5579  [(set (match_dup 4)
5580	(plus:SI (match_dup 1)
5581		 (match_dup 2)))
5582   (set (match_dup 0)
5583	(mem:DI (match_dup 4)))]
5584  "
5585  operands[4] = gen_rtx_REG (SImode, REGNO(operands[0]));
5586  "
5587)
5588
5589(define_expand "movsi"
5590  [(set (match_operand:SI 0 "general_operand" "")
5591        (match_operand:SI 1 "general_operand" ""))]
5592  "TARGET_EITHER"
5593  "
5594  {
5595  rtx base, offset, tmp;
5596
5597  if (TARGET_32BIT)
5598    {
5599      /* Everything except mem = const or mem = mem can be done easily.  */
5600      if (MEM_P (operands[0]))
5601        operands[1] = force_reg (SImode, operands[1]);
5602      if (arm_general_register_operand (operands[0], SImode)
5603	  && CONST_INT_P (operands[1])
5604          && !(const_ok_for_arm (INTVAL (operands[1]))
5605               || const_ok_for_arm (~INTVAL (operands[1]))))
5606        {
5607           arm_split_constant (SET, SImode, NULL_RTX,
5608	                       INTVAL (operands[1]), operands[0], NULL_RTX,
5609			       optimize && can_create_pseudo_p ());
5610          DONE;
5611        }
5612    }
5613  else /* TARGET_THUMB1...  */
5614    {
5615      if (can_create_pseudo_p ())
5616        {
5617          if (!REG_P (operands[0]))
5618	    operands[1] = force_reg (SImode, operands[1]);
5619        }
5620    }
5621
5622  if (ARM_OFFSETS_MUST_BE_WITHIN_SECTIONS_P)
5623    {
5624      split_const (operands[1], &base, &offset);
5625      if (GET_CODE (base) == SYMBOL_REF
5626	  && !offset_within_block_p (base, INTVAL (offset)))
5627	{
5628	  tmp = can_create_pseudo_p () ? gen_reg_rtx (SImode) : operands[0];
5629	  emit_move_insn (tmp, base);
5630	  emit_insn (gen_addsi3 (operands[0], tmp, offset));
5631	  DONE;
5632	}
5633    }
5634
5635  /* Recognize the case where operand[1] is a reference to thread-local
5636     data and load its address to a register.  */
5637  if (arm_tls_referenced_p (operands[1]))
5638    {
5639      rtx tmp = operands[1];
5640      rtx addend = NULL;
5641
5642      if (GET_CODE (tmp) == CONST && GET_CODE (XEXP (tmp, 0)) == PLUS)
5643        {
5644          addend = XEXP (XEXP (tmp, 0), 1);
5645          tmp = XEXP (XEXP (tmp, 0), 0);
5646        }
5647
5648      gcc_assert (GET_CODE (tmp) == SYMBOL_REF);
5649      gcc_assert (SYMBOL_REF_TLS_MODEL (tmp) != 0);
5650
5651      tmp = legitimize_tls_address (tmp,
5652				    !can_create_pseudo_p () ? operands[0] : 0);
5653      if (addend)
5654        {
5655          tmp = gen_rtx_PLUS (SImode, tmp, addend);
5656          tmp = force_operand (tmp, operands[0]);
5657        }
5658      operands[1] = tmp;
5659    }
5660  else if (flag_pic
5661	   && (CONSTANT_P (operands[1])
5662	       || symbol_mentioned_p (operands[1])
5663	       || label_mentioned_p (operands[1])))
5664      operands[1] = legitimize_pic_address (operands[1], SImode,
5665					    (!can_create_pseudo_p ()
5666					     ? operands[0]
5667					     : 0));
5668  }
5669  "
5670)
5671
5672;; The ARM LO_SUM and HIGH are backwards - HIGH sets the low bits, and
5673;; LO_SUM adds in the high bits.  Fortunately these are opaque operations
5674;; so this does not matter.
5675(define_insn "*arm_movt"
5676  [(set (match_operand:SI 0 "nonimmediate_operand" "=r")
5677	(lo_sum:SI (match_operand:SI 1 "nonimmediate_operand" "0")
5678		   (match_operand:SI 2 "general_operand"      "i")))]
5679  "arm_arch_thumb2 && arm_valid_symbolic_address_p (operands[2])"
5680  "movt%?\t%0, #:upper16:%c2"
5681  [(set_attr "predicable" "yes")
5682   (set_attr "predicable_short_it" "no")
5683   (set_attr "length" "4")
5684   (set_attr "type" "mov_imm")]
5685)
5686
5687(define_insn "*arm_movsi_insn"
5688  [(set (match_operand:SI 0 "nonimmediate_operand" "=rk,r,r,r,rk,m")
5689	(match_operand:SI 1 "general_operand"      "rk, I,K,j,mi,rk"))]
5690  "TARGET_ARM && ! TARGET_IWMMXT
5691   && !(TARGET_HARD_FLOAT && TARGET_VFP)
5692   && (   register_operand (operands[0], SImode)
5693       || register_operand (operands[1], SImode))"
5694  "@
5695   mov%?\\t%0, %1
5696   mov%?\\t%0, %1
5697   mvn%?\\t%0, #%B1
5698   movw%?\\t%0, %1
5699   ldr%?\\t%0, %1
5700   str%?\\t%1, %0"
5701  [(set_attr "type" "mov_reg,mov_imm,mvn_imm,mov_imm,load1,store1")
5702   (set_attr "predicable" "yes")
5703   (set_attr "pool_range" "*,*,*,*,4096,*")
5704   (set_attr "neg_pool_range" "*,*,*,*,4084,*")]
5705)
5706
5707(define_split
5708  [(set (match_operand:SI 0 "arm_general_register_operand" "")
5709	(match_operand:SI 1 "const_int_operand" ""))]
5710  "TARGET_32BIT
5711  && (!(const_ok_for_arm (INTVAL (operands[1]))
5712        || const_ok_for_arm (~INTVAL (operands[1]))))"
5713  [(clobber (const_int 0))]
5714  "
5715  arm_split_constant (SET, SImode, NULL_RTX, 
5716                      INTVAL (operands[1]), operands[0], NULL_RTX, 0);
5717  DONE;
5718  "
5719)
5720
5721;; A normal way to do (symbol + offset) requires three instructions at least
5722;; (depends on how big the offset is) as below:
5723;; movw r0, #:lower16:g
5724;; movw r0, #:upper16:g
5725;; adds r0, #4
5726;;
5727;; A better way would be:
5728;; movw r0, #:lower16:g+4
5729;; movw r0, #:upper16:g+4
5730;;
5731;; The limitation of this way is that the length of offset should be a 16-bit
5732;; signed value, because current assembler only supports REL type relocation for
5733;; such case.  If the more powerful RELA type is supported in future, we should
5734;; update this pattern to go with better way.
5735(define_split
5736  [(set (match_operand:SI 0 "arm_general_register_operand" "")
5737	(const:SI (plus:SI (match_operand:SI 1 "general_operand" "")
5738			   (match_operand:SI 2 "const_int_operand" ""))))]
5739  "TARGET_THUMB2
5740   && arm_disable_literal_pool
5741   && reload_completed
5742   && GET_CODE (operands[1]) == SYMBOL_REF"
5743  [(clobber (const_int 0))]
5744  "
5745    int offset = INTVAL (operands[2]);
5746
5747    if (offset < -0x8000 || offset > 0x7fff)
5748      {
5749	arm_emit_movpair (operands[0], operands[1]);
5750	emit_insn (gen_rtx_SET (SImode, operands[0],
5751				gen_rtx_PLUS (SImode, operands[0], operands[2])));
5752      }
5753    else
5754      {
5755	rtx op = gen_rtx_CONST (SImode,
5756				gen_rtx_PLUS (SImode, operands[1], operands[2]));
5757	arm_emit_movpair (operands[0], op);
5758      }
5759  "
5760)
5761
5762;; Split symbol_refs at the later stage (after cprop), instead of generating
5763;; movt/movw pair directly at expand.  Otherwise corresponding high_sum
5764;; and lo_sum would be merged back into memory load at cprop.  However,
5765;; if the default is to prefer movt/movw rather than a load from the constant
5766;; pool, the performance is better.
5767(define_split
5768  [(set (match_operand:SI 0 "arm_general_register_operand" "")
5769       (match_operand:SI 1 "general_operand" ""))]
5770  "TARGET_32BIT
5771   && TARGET_USE_MOVT && GET_CODE (operands[1]) == SYMBOL_REF
5772   && !flag_pic && !target_word_relocations
5773   && !arm_tls_referenced_p (operands[1])"
5774  [(clobber (const_int 0))]
5775{
5776  arm_emit_movpair (operands[0], operands[1]);
5777  DONE;
5778})
5779
5780;; When generating pic, we need to load the symbol offset into a register.
5781;; So that the optimizer does not confuse this with a normal symbol load
5782;; we use an unspec.  The offset will be loaded from a constant pool entry,
5783;; since that is the only type of relocation we can use.
5784
5785;; Wrap calculation of the whole PIC address in a single pattern for the
5786;; benefit of optimizers, particularly, PRE and HOIST.  Calculation of
5787;; a PIC address involves two loads from memory, so we want to CSE it
5788;; as often as possible.
5789;; This pattern will be split into one of the pic_load_addr_* patterns
5790;; and a move after GCSE optimizations.
5791;;
5792;; Note: Update arm.c: legitimize_pic_address() when changing this pattern.
5793(define_expand "calculate_pic_address"
5794  [(set (match_operand:SI 0 "register_operand" "")
5795	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "")
5796			 (unspec:SI [(match_operand:SI 2 "" "")]
5797				    UNSPEC_PIC_SYM))))]
5798  "flag_pic"
5799)
5800
5801;; Split calculate_pic_address into pic_load_addr_* and a move.
5802(define_split
5803  [(set (match_operand:SI 0 "register_operand" "")
5804	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "")
5805			 (unspec:SI [(match_operand:SI 2 "" "")]
5806				    UNSPEC_PIC_SYM))))]
5807  "flag_pic"
5808  [(set (match_dup 3) (unspec:SI [(match_dup 2)] UNSPEC_PIC_SYM))
5809   (set (match_dup 0) (mem:SI (plus:SI (match_dup 1) (match_dup 3))))]
5810  "operands[3] = can_create_pseudo_p () ? gen_reg_rtx (SImode) : operands[0];"
5811)
5812
5813;; operand1 is the memory address to go into 
5814;; pic_load_addr_32bit.
5815;; operand2 is the PIC label to be emitted 
5816;; from pic_add_dot_plus_eight.
5817;; We do this to allow hoisting of the entire insn.
5818(define_insn_and_split "pic_load_addr_unified"
5819  [(set (match_operand:SI 0 "s_register_operand" "=r,r,l")
5820	(unspec:SI [(match_operand:SI 1 "" "mX,mX,mX") 
5821		    (match_operand:SI 2 "" "")] 
5822		    UNSPEC_PIC_UNIFIED))]
5823 "flag_pic"
5824 "#"
5825 "&& reload_completed"
5826 [(set (match_dup 0) (unspec:SI [(match_dup 1)] UNSPEC_PIC_SYM))
5827  (set (match_dup 0) (unspec:SI [(match_dup 0) (match_dup 3)
5828       		     		 (match_dup 2)] UNSPEC_PIC_BASE))]
5829 "operands[3] = TARGET_THUMB ? GEN_INT (4) : GEN_INT (8);"
5830 [(set_attr "type" "load1,load1,load1")
5831  (set_attr "pool_range" "4096,4094,1022")
5832  (set_attr "neg_pool_range" "4084,0,0")
5833  (set_attr "arch"  "a,t2,t1")    
5834  (set_attr "length" "8,6,4")]
5835)
5836
5837;; The rather odd constraints on the following are to force reload to leave
5838;; the insn alone, and to force the minipool generation pass to then move
5839;; the GOT symbol to memory.
5840
5841(define_insn "pic_load_addr_32bit"
5842  [(set (match_operand:SI 0 "s_register_operand" "=r")
5843	(unspec:SI [(match_operand:SI 1 "" "mX")] UNSPEC_PIC_SYM))]
5844  "TARGET_32BIT && flag_pic"
5845  "ldr%?\\t%0, %1"
5846  [(set_attr "type" "load1")
5847   (set (attr "pool_range")
5848	(if_then_else (eq_attr "is_thumb" "no")
5849		      (const_int 4096)
5850		      (const_int 4094)))
5851   (set (attr "neg_pool_range")
5852	(if_then_else (eq_attr "is_thumb" "no")
5853		      (const_int 4084)
5854		      (const_int 0)))]
5855)
5856
5857(define_insn "pic_load_addr_thumb1"
5858  [(set (match_operand:SI 0 "s_register_operand" "=l")
5859	(unspec:SI [(match_operand:SI 1 "" "mX")] UNSPEC_PIC_SYM))]
5860  "TARGET_THUMB1 && flag_pic"
5861  "ldr\\t%0, %1"
5862  [(set_attr "type" "load1")
5863   (set (attr "pool_range") (const_int 1018))]
5864)
5865
5866(define_insn "pic_add_dot_plus_four"
5867  [(set (match_operand:SI 0 "register_operand" "=r")
5868	(unspec:SI [(match_operand:SI 1 "register_operand" "0")
5869		    (const_int 4)
5870		    (match_operand 2 "" "")]
5871		   UNSPEC_PIC_BASE))]
5872  "TARGET_THUMB"
5873  "*
5874  (*targetm.asm_out.internal_label) (asm_out_file, \"LPIC\",
5875				     INTVAL (operands[2]));
5876  return \"add\\t%0, %|pc\";
5877  "
5878  [(set_attr "length" "2")
5879   (set_attr "type" "alu_sreg")]
5880)
5881
5882(define_insn "pic_add_dot_plus_eight"
5883  [(set (match_operand:SI 0 "register_operand" "=r")
5884	(unspec:SI [(match_operand:SI 1 "register_operand" "r")
5885		    (const_int 8)
5886		    (match_operand 2 "" "")]
5887		   UNSPEC_PIC_BASE))]
5888  "TARGET_ARM"
5889  "*
5890    (*targetm.asm_out.internal_label) (asm_out_file, \"LPIC\",
5891				       INTVAL (operands[2]));
5892    return \"add%?\\t%0, %|pc, %1\";
5893  "
5894  [(set_attr "predicable" "yes")
5895   (set_attr "type" "alu_sreg")]
5896)
5897
5898(define_insn "tls_load_dot_plus_eight"
5899  [(set (match_operand:SI 0 "register_operand" "=r")
5900	(mem:SI (unspec:SI [(match_operand:SI 1 "register_operand" "r")
5901			    (const_int 8)
5902			    (match_operand 2 "" "")]
5903			   UNSPEC_PIC_BASE)))]
5904  "TARGET_ARM"
5905  "*
5906    (*targetm.asm_out.internal_label) (asm_out_file, \"LPIC\",
5907				       INTVAL (operands[2]));
5908    return \"ldr%?\\t%0, [%|pc, %1]\t\t@ tls_load_dot_plus_eight\";
5909  "
5910  [(set_attr "predicable" "yes")
5911   (set_attr "type" "load1")]
5912)
5913
5914;; PIC references to local variables can generate pic_add_dot_plus_eight
5915;; followed by a load.  These sequences can be crunched down to
5916;; tls_load_dot_plus_eight by a peephole.
5917
5918(define_peephole2
5919  [(set (match_operand:SI 0 "register_operand" "")
5920	(unspec:SI [(match_operand:SI 3 "register_operand" "")
5921		    (const_int 8)
5922		    (match_operand 1 "" "")]
5923		   UNSPEC_PIC_BASE))
5924   (set (match_operand:SI 2 "arm_general_register_operand" "")
5925	(mem:SI (match_dup 0)))]
5926  "TARGET_ARM && peep2_reg_dead_p (2, operands[0])"
5927  [(set (match_dup 2)
5928	(mem:SI (unspec:SI [(match_dup 3)
5929			    (const_int 8)
5930			    (match_dup 1)]
5931			   UNSPEC_PIC_BASE)))]
5932  ""
5933)
5934
5935(define_insn "pic_offset_arm"
5936  [(set (match_operand:SI 0 "register_operand" "=r")
5937	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "r")
5938			 (unspec:SI [(match_operand:SI 2 "" "X")]
5939				    UNSPEC_PIC_OFFSET))))]
5940  "TARGET_VXWORKS_RTP && TARGET_ARM && flag_pic"
5941  "ldr%?\\t%0, [%1,%2]"
5942  [(set_attr "type" "load1")]
5943)
5944
5945(define_expand "builtin_setjmp_receiver"
5946  [(label_ref (match_operand 0 "" ""))]
5947  "flag_pic"
5948  "
5949{
5950  /* r3 is clobbered by set/longjmp, so we can use it as a scratch
5951     register.  */
5952  if (arm_pic_register != INVALID_REGNUM)
5953    arm_load_pic_register (1UL << 3);
5954  DONE;
5955}")
5956
5957;; If copying one reg to another we can set the condition codes according to
5958;; its value.  Such a move is common after a return from subroutine and the
5959;; result is being tested against zero.
5960
5961(define_insn "*movsi_compare0"
5962  [(set (reg:CC CC_REGNUM)
5963	(compare:CC (match_operand:SI 1 "s_register_operand" "0,r")
5964		    (const_int 0)))
5965   (set (match_operand:SI 0 "s_register_operand" "=r,r")
5966	(match_dup 1))]
5967  "TARGET_32BIT"
5968  "@
5969   cmp%?\\t%0, #0
5970   sub%.\\t%0, %1, #0"
5971  [(set_attr "conds" "set")
5972   (set_attr "type" "alus_imm,alus_imm")]
5973)
5974
5975;; Subroutine to store a half word from a register into memory.
5976;; Operand 0 is the source register (HImode)
5977;; Operand 1 is the destination address in a register (SImode)
5978
5979;; In both this routine and the next, we must be careful not to spill
5980;; a memory address of reg+large_const into a separate PLUS insn, since this
5981;; can generate unrecognizable rtl.
5982
5983(define_expand "storehi"
5984  [;; store the low byte
5985   (set (match_operand 1 "" "") (match_dup 3))
5986   ;; extract the high byte
5987   (set (match_dup 2)
5988	(ashiftrt:SI (match_operand 0 "" "") (const_int 8)))
5989   ;; store the high byte
5990   (set (match_dup 4) (match_dup 5))]
5991  "TARGET_ARM"
5992  "
5993  {
5994    rtx op1 = operands[1];
5995    rtx addr = XEXP (op1, 0);
5996    enum rtx_code code = GET_CODE (addr);
5997
5998    if ((code == PLUS && !CONST_INT_P (XEXP (addr, 1)))
5999	|| code == MINUS)
6000      op1 = replace_equiv_address (operands[1], force_reg (SImode, addr));
6001
6002    operands[4] = adjust_address (op1, QImode, 1);
6003    operands[1] = adjust_address (operands[1], QImode, 0);
6004    operands[3] = gen_lowpart (QImode, operands[0]);
6005    operands[0] = gen_lowpart (SImode, operands[0]);
6006    operands[2] = gen_reg_rtx (SImode);
6007    operands[5] = gen_lowpart (QImode, operands[2]);
6008  }"
6009)
6010
6011(define_expand "storehi_bigend"
6012  [(set (match_dup 4) (match_dup 3))
6013   (set (match_dup 2)
6014	(ashiftrt:SI (match_operand 0 "" "") (const_int 8)))
6015   (set (match_operand 1 "" "")	(match_dup 5))]
6016  "TARGET_ARM"
6017  "
6018  {
6019    rtx op1 = operands[1];
6020    rtx addr = XEXP (op1, 0);
6021    enum rtx_code code = GET_CODE (addr);
6022
6023    if ((code == PLUS && !CONST_INT_P (XEXP (addr, 1)))
6024	|| code == MINUS)
6025      op1 = replace_equiv_address (op1, force_reg (SImode, addr));
6026
6027    operands[4] = adjust_address (op1, QImode, 1);
6028    operands[1] = adjust_address (operands[1], QImode, 0);
6029    operands[3] = gen_lowpart (QImode, operands[0]);
6030    operands[0] = gen_lowpart (SImode, operands[0]);
6031    operands[2] = gen_reg_rtx (SImode);
6032    operands[5] = gen_lowpart (QImode, operands[2]);
6033  }"
6034)
6035
6036;; Subroutine to store a half word integer constant into memory.
6037(define_expand "storeinthi"
6038  [(set (match_operand 0 "" "")
6039	(match_operand 1 "" ""))
6040   (set (match_dup 3) (match_dup 2))]
6041  "TARGET_ARM"
6042  "
6043  {
6044    HOST_WIDE_INT value = INTVAL (operands[1]);
6045    rtx addr = XEXP (operands[0], 0);
6046    rtx op0 = operands[0];
6047    enum rtx_code code = GET_CODE (addr);
6048
6049    if ((code == PLUS && !CONST_INT_P (XEXP (addr, 1)))
6050	|| code == MINUS)
6051      op0 = replace_equiv_address (op0, force_reg (SImode, addr));
6052
6053    operands[1] = gen_reg_rtx (SImode);
6054    if (BYTES_BIG_ENDIAN)
6055      {
6056	emit_insn (gen_movsi (operands[1], GEN_INT ((value >> 8) & 255)));
6057	if ((value & 255) == ((value >> 8) & 255))
6058	  operands[2] = operands[1];
6059	else
6060	  {
6061	    operands[2] = gen_reg_rtx (SImode);
6062	    emit_insn (gen_movsi (operands[2], GEN_INT (value & 255)));
6063	  }
6064      }
6065    else
6066      {
6067	emit_insn (gen_movsi (operands[1], GEN_INT (value & 255)));
6068	if ((value & 255) == ((value >> 8) & 255))
6069	  operands[2] = operands[1];
6070	else
6071	  {
6072	    operands[2] = gen_reg_rtx (SImode);
6073	    emit_insn (gen_movsi (operands[2], GEN_INT ((value >> 8) & 255)));
6074	  }
6075      }
6076
6077    operands[3] = adjust_address (op0, QImode, 1);
6078    operands[0] = adjust_address (operands[0], QImode, 0);
6079    operands[2] = gen_lowpart (QImode, operands[2]);
6080    operands[1] = gen_lowpart (QImode, operands[1]);
6081  }"
6082)
6083
6084(define_expand "storehi_single_op"
6085  [(set (match_operand:HI 0 "memory_operand" "")
6086	(match_operand:HI 1 "general_operand" ""))]
6087  "TARGET_32BIT && arm_arch4"
6088  "
6089  if (!s_register_operand (operands[1], HImode))
6090    operands[1] = copy_to_mode_reg (HImode, operands[1]);
6091  "
6092)
6093
6094(define_expand "movhi"
6095  [(set (match_operand:HI 0 "general_operand" "")
6096	(match_operand:HI 1 "general_operand" ""))]
6097  "TARGET_EITHER"
6098  "
6099  if (TARGET_ARM)
6100    {
6101      if (can_create_pseudo_p ())
6102        {
6103          if (MEM_P (operands[0]))
6104	    {
6105	      if (arm_arch4)
6106	        {
6107	          emit_insn (gen_storehi_single_op (operands[0], operands[1]));
6108	          DONE;
6109	        }
6110	      if (CONST_INT_P (operands[1]))
6111	        emit_insn (gen_storeinthi (operands[0], operands[1]));
6112	      else
6113	        {
6114	          if (MEM_P (operands[1]))
6115		    operands[1] = force_reg (HImode, operands[1]);
6116	          if (BYTES_BIG_ENDIAN)
6117		    emit_insn (gen_storehi_bigend (operands[1], operands[0]));
6118	          else
6119		   emit_insn (gen_storehi (operands[1], operands[0]));
6120	        }
6121	      DONE;
6122	    }
6123          /* Sign extend a constant, and keep it in an SImode reg.  */
6124          else if (CONST_INT_P (operands[1]))
6125	    {
6126	      rtx reg = gen_reg_rtx (SImode);
6127	      HOST_WIDE_INT val = INTVAL (operands[1]) & 0xffff;
6128
6129	      /* If the constant is already valid, leave it alone.  */
6130	      if (!const_ok_for_arm (val))
6131	        {
6132	          /* If setting all the top bits will make the constant 
6133		     loadable in a single instruction, then set them.  
6134		     Otherwise, sign extend the number.  */
6135
6136	          if (const_ok_for_arm (~(val | ~0xffff)))
6137		    val |= ~0xffff;
6138	          else if (val & 0x8000)
6139		    val |= ~0xffff;
6140	        }
6141
6142	      emit_insn (gen_movsi (reg, GEN_INT (val)));
6143	      operands[1] = gen_lowpart (HImode, reg);
6144	    }
6145	  else if (arm_arch4 && optimize && can_create_pseudo_p ()
6146		   && MEM_P (operands[1]))
6147	    {
6148	      rtx reg = gen_reg_rtx (SImode);
6149
6150	      emit_insn (gen_zero_extendhisi2 (reg, operands[1]));
6151	      operands[1] = gen_lowpart (HImode, reg);
6152	    }
6153          else if (!arm_arch4)
6154	    {
6155	      if (MEM_P (operands[1]))
6156	        {
6157		  rtx base;
6158		  rtx offset = const0_rtx;
6159		  rtx reg = gen_reg_rtx (SImode);
6160
6161		  if ((REG_P (base = XEXP (operands[1], 0))
6162		       || (GET_CODE (base) == PLUS
6163			   && (CONST_INT_P (offset = XEXP (base, 1)))
6164                           && ((INTVAL(offset) & 1) != 1)
6165			   && REG_P (base = XEXP (base, 0))))
6166		      && REGNO_POINTER_ALIGN (REGNO (base)) >= 32)
6167		    {
6168		      rtx new_rtx;
6169
6170		      new_rtx = widen_memory_access (operands[1], SImode,
6171						     ((INTVAL (offset) & ~3)
6172						      - INTVAL (offset)));
6173		      emit_insn (gen_movsi (reg, new_rtx));
6174		      if (((INTVAL (offset) & 2) != 0)
6175			  ^ (BYTES_BIG_ENDIAN ? 1 : 0))
6176			{
6177			  rtx reg2 = gen_reg_rtx (SImode);
6178
6179			  emit_insn (gen_lshrsi3 (reg2, reg, GEN_INT (16)));
6180			  reg = reg2;
6181			}
6182		    }
6183		  else
6184		    emit_insn (gen_movhi_bytes (reg, operands[1]));
6185
6186		  operands[1] = gen_lowpart (HImode, reg);
6187	       }
6188	   }
6189        }
6190      /* Handle loading a large integer during reload.  */
6191      else if (CONST_INT_P (operands[1])
6192	       && !const_ok_for_arm (INTVAL (operands[1]))
6193	       && !const_ok_for_arm (~INTVAL (operands[1])))
6194        {
6195          /* Writing a constant to memory needs a scratch, which should
6196	     be handled with SECONDARY_RELOADs.  */
6197          gcc_assert (REG_P (operands[0]));
6198
6199          operands[0] = gen_rtx_SUBREG (SImode, operands[0], 0);
6200          emit_insn (gen_movsi (operands[0], operands[1]));
6201          DONE;
6202       }
6203    }
6204  else if (TARGET_THUMB2)
6205    {
6206      /* Thumb-2 can do everything except mem=mem and mem=const easily.  */
6207      if (can_create_pseudo_p ())
6208	{
6209	  if (!REG_P (operands[0]))
6210	    operands[1] = force_reg (HImode, operands[1]);
6211          /* Zero extend a constant, and keep it in an SImode reg.  */
6212          else if (CONST_INT_P (operands[1]))
6213	    {
6214	      rtx reg = gen_reg_rtx (SImode);
6215	      HOST_WIDE_INT val = INTVAL (operands[1]) & 0xffff;
6216
6217	      emit_insn (gen_movsi (reg, GEN_INT (val)));
6218	      operands[1] = gen_lowpart (HImode, reg);
6219	    }
6220	}
6221    }
6222  else /* TARGET_THUMB1 */
6223    {
6224      if (can_create_pseudo_p ())
6225        {
6226	  if (CONST_INT_P (operands[1]))
6227	    {
6228	      rtx reg = gen_reg_rtx (SImode);
6229
6230	      emit_insn (gen_movsi (reg, operands[1]));
6231	      operands[1] = gen_lowpart (HImode, reg);
6232	    }
6233
6234          /* ??? We shouldn't really get invalid addresses here, but this can
6235	     happen if we are passed a SP (never OK for HImode/QImode) or 
6236	     virtual register (also rejected as illegitimate for HImode/QImode)
6237	     relative address.  */
6238          /* ??? This should perhaps be fixed elsewhere, for instance, in
6239	     fixup_stack_1, by checking for other kinds of invalid addresses,
6240	     e.g. a bare reference to a virtual register.  This may confuse the
6241	     alpha though, which must handle this case differently.  */
6242          if (MEM_P (operands[0])
6243	      && !memory_address_p (GET_MODE (operands[0]),
6244				    XEXP (operands[0], 0)))
6245	    operands[0]
6246	      = replace_equiv_address (operands[0],
6247				       copy_to_reg (XEXP (operands[0], 0)));
6248   
6249          if (MEM_P (operands[1])
6250	      && !memory_address_p (GET_MODE (operands[1]),
6251				    XEXP (operands[1], 0)))
6252	    operands[1]
6253	      = replace_equiv_address (operands[1],
6254				       copy_to_reg (XEXP (operands[1], 0)));
6255
6256	  if (MEM_P (operands[1]) && optimize > 0)
6257	    {
6258	      rtx reg = gen_reg_rtx (SImode);
6259
6260	      emit_insn (gen_zero_extendhisi2 (reg, operands[1]));
6261	      operands[1] = gen_lowpart (HImode, reg);
6262	    }
6263
6264          if (MEM_P (operands[0]))
6265	    operands[1] = force_reg (HImode, operands[1]);
6266        }
6267      else if (CONST_INT_P (operands[1])
6268	        && !satisfies_constraint_I (operands[1]))
6269        {
6270	  /* Handle loading a large integer during reload.  */
6271
6272          /* Writing a constant to memory needs a scratch, which should
6273	     be handled with SECONDARY_RELOADs.  */
6274          gcc_assert (REG_P (operands[0]));
6275
6276          operands[0] = gen_rtx_SUBREG (SImode, operands[0], 0);
6277          emit_insn (gen_movsi (operands[0], operands[1]));
6278          DONE;
6279        }
6280    }
6281  "
6282)
6283
6284(define_expand "movhi_bytes"
6285  [(set (match_dup 2) (zero_extend:SI (match_operand:HI 1 "" "")))
6286   (set (match_dup 3)
6287	(zero_extend:SI (match_dup 6)))
6288   (set (match_operand:SI 0 "" "")
6289	 (ior:SI (ashift:SI (match_dup 4) (const_int 8)) (match_dup 5)))]
6290  "TARGET_ARM"
6291  "
6292  {
6293    rtx mem1, mem2;
6294    rtx addr = copy_to_mode_reg (SImode, XEXP (operands[1], 0));
6295
6296    mem1 = change_address (operands[1], QImode, addr);
6297    mem2 = change_address (operands[1], QImode,
6298			   plus_constant (Pmode, addr, 1));
6299    operands[0] = gen_lowpart (SImode, operands[0]);
6300    operands[1] = mem1;
6301    operands[2] = gen_reg_rtx (SImode);
6302    operands[3] = gen_reg_rtx (SImode);
6303    operands[6] = mem2;
6304
6305    if (BYTES_BIG_ENDIAN)
6306      {
6307	operands[4] = operands[2];
6308	operands[5] = operands[3];
6309      }
6310    else
6311      {
6312	operands[4] = operands[3];
6313	operands[5] = operands[2];
6314      }
6315  }"
6316)
6317
6318(define_expand "movhi_bigend"
6319  [(set (match_dup 2)
6320	(rotate:SI (subreg:SI (match_operand:HI 1 "memory_operand" "") 0)
6321		   (const_int 16)))
6322   (set (match_dup 3)
6323	(ashiftrt:SI (match_dup 2) (const_int 16)))
6324   (set (match_operand:HI 0 "s_register_operand" "")
6325	(match_dup 4))]
6326  "TARGET_ARM"
6327  "
6328  operands[2] = gen_reg_rtx (SImode);
6329  operands[3] = gen_reg_rtx (SImode);
6330  operands[4] = gen_lowpart (HImode, operands[3]);
6331  "
6332)
6333
6334;; Pattern to recognize insn generated default case above
6335(define_insn "*movhi_insn_arch4"
6336  [(set (match_operand:HI 0 "nonimmediate_operand" "=r,r,r,m,r")
6337	(match_operand:HI 1 "general_operand"      "rIk,K,n,r,mi"))]
6338  "TARGET_ARM
6339   && arm_arch4
6340   && (register_operand (operands[0], HImode)
6341       || register_operand (operands[1], HImode))"
6342  "@
6343   mov%?\\t%0, %1\\t%@ movhi
6344   mvn%?\\t%0, #%B1\\t%@ movhi
6345   movw%?\\t%0, %L1\\t%@ movhi
6346   str%(h%)\\t%1, %0\\t%@ movhi
6347   ldr%(h%)\\t%0, %1\\t%@ movhi"
6348  [(set_attr "predicable" "yes")
6349   (set_attr "pool_range" "*,*,*,*,256")
6350   (set_attr "neg_pool_range" "*,*,*,*,244")
6351   (set_attr "arch" "*,*,v6t2,*,*")
6352   (set_attr_alternative "type"
6353                         [(if_then_else (match_operand 1 "const_int_operand" "")
6354                                        (const_string "mov_imm" )
6355                                        (const_string "mov_reg"))
6356                          (const_string "mvn_imm")
6357                          (const_string "mov_imm")
6358                          (const_string "store1")
6359                          (const_string "load1")])]
6360)
6361
6362(define_insn "*movhi_bytes"
6363  [(set (match_operand:HI 0 "s_register_operand" "=r,r,r")
6364	(match_operand:HI 1 "arm_rhs_operand"  "I,rk,K"))]
6365  "TARGET_ARM"
6366  "@
6367   mov%?\\t%0, %1\\t%@ movhi
6368   mov%?\\t%0, %1\\t%@ movhi
6369   mvn%?\\t%0, #%B1\\t%@ movhi"
6370  [(set_attr "predicable" "yes")
6371   (set_attr "type" "mov_imm,mov_reg,mvn_imm")]
6372)
6373	
6374;; We use a DImode scratch because we may occasionally need an additional
6375;; temporary if the address isn't offsettable -- push_reload doesn't seem
6376;; to take any notice of the "o" constraints on reload_memory_operand operand.
6377(define_expand "reload_outhi"
6378  [(parallel [(match_operand:HI 0 "arm_reload_memory_operand" "=o")
6379	      (match_operand:HI 1 "s_register_operand"        "r")
6380	      (match_operand:DI 2 "s_register_operand"        "=&l")])]
6381  "TARGET_EITHER"
6382  "if (TARGET_ARM)
6383     arm_reload_out_hi (operands);
6384   else
6385     thumb_reload_out_hi (operands);
6386  DONE;
6387  "
6388)
6389
6390(define_expand "reload_inhi"
6391  [(parallel [(match_operand:HI 0 "s_register_operand" "=r")
6392	      (match_operand:HI 1 "arm_reload_memory_operand" "o")
6393	      (match_operand:DI 2 "s_register_operand" "=&r")])]
6394  "TARGET_EITHER"
6395  "
6396  if (TARGET_ARM)
6397    arm_reload_in_hi (operands);
6398  else
6399    thumb_reload_out_hi (operands);
6400  DONE;
6401")
6402
6403(define_expand "movqi"
6404  [(set (match_operand:QI 0 "general_operand" "")
6405        (match_operand:QI 1 "general_operand" ""))]
6406  "TARGET_EITHER"
6407  "
6408  /* Everything except mem = const or mem = mem can be done easily */
6409
6410  if (can_create_pseudo_p ())
6411    {
6412      if (CONST_INT_P (operands[1]))
6413	{
6414	  rtx reg = gen_reg_rtx (SImode);
6415
6416	  /* For thumb we want an unsigned immediate, then we are more likely 
6417	     to be able to use a movs insn.  */
6418	  if (TARGET_THUMB)
6419	    operands[1] = GEN_INT (INTVAL (operands[1]) & 255);
6420
6421	  emit_insn (gen_movsi (reg, operands[1]));
6422	  operands[1] = gen_lowpart (QImode, reg);
6423	}
6424
6425      if (TARGET_THUMB)
6426	{
6427          /* ??? We shouldn't really get invalid addresses here, but this can
6428	     happen if we are passed a SP (never OK for HImode/QImode) or
6429	     virtual register (also rejected as illegitimate for HImode/QImode)
6430	     relative address.  */
6431          /* ??? This should perhaps be fixed elsewhere, for instance, in
6432	     fixup_stack_1, by checking for other kinds of invalid addresses,
6433	     e.g. a bare reference to a virtual register.  This may confuse the
6434	     alpha though, which must handle this case differently.  */
6435          if (MEM_P (operands[0])
6436	      && !memory_address_p (GET_MODE (operands[0]),
6437		  		     XEXP (operands[0], 0)))
6438	    operands[0]
6439	      = replace_equiv_address (operands[0],
6440				       copy_to_reg (XEXP (operands[0], 0)));
6441          if (MEM_P (operands[1])
6442	      && !memory_address_p (GET_MODE (operands[1]),
6443				    XEXP (operands[1], 0)))
6444	     operands[1]
6445	       = replace_equiv_address (operands[1],
6446					copy_to_reg (XEXP (operands[1], 0)));
6447	}
6448
6449      if (MEM_P (operands[1]) && optimize > 0)
6450	{
6451	  rtx reg = gen_reg_rtx (SImode);
6452
6453	  emit_insn (gen_zero_extendqisi2 (reg, operands[1]));
6454	  operands[1] = gen_lowpart (QImode, reg);
6455	}
6456
6457      if (MEM_P (operands[0]))
6458	operands[1] = force_reg (QImode, operands[1]);
6459    }
6460  else if (TARGET_THUMB
6461	   && CONST_INT_P (operands[1])
6462	   && !satisfies_constraint_I (operands[1]))
6463    {
6464      /* Handle loading a large integer during reload.  */
6465
6466      /* Writing a constant to memory needs a scratch, which should
6467	 be handled with SECONDARY_RELOADs.  */
6468      gcc_assert (REG_P (operands[0]));
6469
6470      operands[0] = gen_rtx_SUBREG (SImode, operands[0], 0);
6471      emit_insn (gen_movsi (operands[0], operands[1]));
6472      DONE;
6473    }
6474  "
6475)
6476
6477(define_insn "*arm_movqi_insn"
6478  [(set (match_operand:QI 0 "nonimmediate_operand" "=r,r,r,l,r,l,Uu,r,m")
6479	(match_operand:QI 1 "general_operand" "rk,rk,I,Py,K,Uu,l,Uh,r"))]
6480  "TARGET_32BIT
6481   && (   register_operand (operands[0], QImode)
6482       || register_operand (operands[1], QImode))"
6483  "@
6484   mov%?\\t%0, %1
6485   mov%?\\t%0, %1
6486   mov%?\\t%0, %1
6487   mov%?\\t%0, %1
6488   mvn%?\\t%0, #%B1
6489   ldr%(b%)\\t%0, %1
6490   str%(b%)\\t%1, %0
6491   ldr%(b%)\\t%0, %1
6492   str%(b%)\\t%1, %0"
6493  [(set_attr "type" "mov_reg,mov_reg,mov_imm,mov_imm,mvn_imm,load1,store1,load1,store1")
6494   (set_attr "predicable" "yes")
6495   (set_attr "predicable_short_it" "yes,yes,yes,no,no,no,no,no,no")
6496   (set_attr "arch" "t2,any,any,t2,any,t2,t2,any,any")
6497   (set_attr "length" "2,4,4,2,4,2,2,4,4")]
6498)
6499
6500;; HFmode moves
6501(define_expand "movhf"
6502  [(set (match_operand:HF 0 "general_operand" "")
6503	(match_operand:HF 1 "general_operand" ""))]
6504  "TARGET_EITHER"
6505  "
6506  if (TARGET_32BIT)
6507    {
6508      if (MEM_P (operands[0]))
6509        operands[1] = force_reg (HFmode, operands[1]);
6510    }
6511  else /* TARGET_THUMB1 */
6512    {
6513      if (can_create_pseudo_p ())
6514        {
6515           if (!REG_P (operands[0]))
6516	     operands[1] = force_reg (HFmode, operands[1]);
6517        }
6518    }
6519  "
6520)
6521
6522(define_insn "*arm32_movhf"
6523  [(set (match_operand:HF 0 "nonimmediate_operand" "=r,m,r,r")
6524	(match_operand:HF 1 "general_operand"	   " m,r,r,F"))]
6525  "TARGET_32BIT && !(TARGET_HARD_FLOAT && TARGET_FP16)
6526   && (	  s_register_operand (operands[0], HFmode)
6527       || s_register_operand (operands[1], HFmode))"
6528  "*
6529  switch (which_alternative)
6530    {
6531    case 0:	/* ARM register from memory */
6532      return \"ldr%(h%)\\t%0, %1\\t%@ __fp16\";
6533    case 1:	/* memory from ARM register */
6534      return \"str%(h%)\\t%1, %0\\t%@ __fp16\";
6535    case 2:	/* ARM register from ARM register */
6536      return \"mov%?\\t%0, %1\\t%@ __fp16\";
6537    case 3:	/* ARM register from constant */
6538      {
6539	REAL_VALUE_TYPE r;
6540	long bits;
6541	rtx ops[4];
6542
6543	REAL_VALUE_FROM_CONST_DOUBLE (r, operands[1]);
6544	bits = real_to_target (NULL, &r, HFmode);
6545	ops[0] = operands[0];
6546	ops[1] = GEN_INT (bits);
6547	ops[2] = GEN_INT (bits & 0xff00);
6548	ops[3] = GEN_INT (bits & 0x00ff);
6549
6550	if (arm_arch_thumb2)
6551	  output_asm_insn (\"movw%?\\t%0, %1\", ops);
6552	else
6553	  output_asm_insn (\"mov%?\\t%0, %2\;orr%?\\t%0, %0, %3\", ops);
6554	return \"\";
6555       }
6556    default:
6557      gcc_unreachable ();
6558    }
6559  "
6560  [(set_attr "conds" "unconditional")
6561   (set_attr "type" "load1,store1,mov_reg,multiple")
6562   (set_attr "length" "4,4,4,8")
6563   (set_attr "predicable" "yes")
6564   (set_attr "predicable_short_it" "no")]
6565)
6566
6567(define_expand "movsf"
6568  [(set (match_operand:SF 0 "general_operand" "")
6569	(match_operand:SF 1 "general_operand" ""))]
6570  "TARGET_EITHER"
6571  "
6572  if (TARGET_32BIT)
6573    {
6574      if (MEM_P (operands[0]))
6575        operands[1] = force_reg (SFmode, operands[1]);
6576    }
6577  else /* TARGET_THUMB1 */
6578    {
6579      if (can_create_pseudo_p ())
6580        {
6581           if (!REG_P (operands[0]))
6582	     operands[1] = force_reg (SFmode, operands[1]);
6583        }
6584    }
6585  "
6586)
6587
6588;; Transform a floating-point move of a constant into a core register into
6589;; an SImode operation.
6590(define_split
6591  [(set (match_operand:SF 0 "arm_general_register_operand" "")
6592	(match_operand:SF 1 "immediate_operand" ""))]
6593  "TARGET_EITHER
6594   && reload_completed
6595   && CONST_DOUBLE_P (operands[1])"
6596  [(set (match_dup 2) (match_dup 3))]
6597  "
6598  operands[2] = gen_lowpart (SImode, operands[0]);
6599  operands[3] = gen_lowpart (SImode, operands[1]);
6600  if (operands[2] == 0 || operands[3] == 0)
6601    FAIL;
6602  "
6603)
6604
6605(define_insn "*arm_movsf_soft_insn"
6606  [(set (match_operand:SF 0 "nonimmediate_operand" "=r,r,m")
6607	(match_operand:SF 1 "general_operand"  "r,mE,r"))]
6608  "TARGET_32BIT
6609   && TARGET_SOFT_FLOAT
6610   && (!MEM_P (operands[0])
6611       || register_operand (operands[1], SFmode))"
6612  "@
6613   mov%?\\t%0, %1
6614   ldr%?\\t%0, %1\\t%@ float
6615   str%?\\t%1, %0\\t%@ float"
6616  [(set_attr "predicable" "yes")
6617   (set_attr "predicable_short_it" "no")
6618   (set_attr "type" "mov_reg,load1,store1")
6619   (set_attr "arm_pool_range" "*,4096,*")
6620   (set_attr "thumb2_pool_range" "*,4094,*")
6621   (set_attr "arm_neg_pool_range" "*,4084,*")
6622   (set_attr "thumb2_neg_pool_range" "*,0,*")]
6623)
6624
6625(define_expand "movdf"
6626  [(set (match_operand:DF 0 "general_operand" "")
6627	(match_operand:DF 1 "general_operand" ""))]
6628  "TARGET_EITHER"
6629  "
6630  if (TARGET_32BIT)
6631    {
6632      if (MEM_P (operands[0]))
6633        operands[1] = force_reg (DFmode, operands[1]);
6634    }
6635  else /* TARGET_THUMB */
6636    {
6637      if (can_create_pseudo_p ())
6638        {
6639          if (!REG_P (operands[0]))
6640	    operands[1] = force_reg (DFmode, operands[1]);
6641        }
6642    }
6643  "
6644)
6645
6646;; Reloading a df mode value stored in integer regs to memory can require a
6647;; scratch reg.
6648(define_expand "reload_outdf"
6649  [(match_operand:DF 0 "arm_reload_memory_operand" "=o")
6650   (match_operand:DF 1 "s_register_operand" "r")
6651   (match_operand:SI 2 "s_register_operand" "=&r")]
6652  "TARGET_THUMB2"
6653  "
6654  {
6655    enum rtx_code code = GET_CODE (XEXP (operands[0], 0));
6656
6657    if (code == REG)
6658      operands[2] = XEXP (operands[0], 0);
6659    else if (code == POST_INC || code == PRE_DEC)
6660      {
6661	operands[0] = gen_rtx_SUBREG (DImode, operands[0], 0);
6662	operands[1] = gen_rtx_SUBREG (DImode, operands[1], 0);
6663	emit_insn (gen_movdi (operands[0], operands[1]));
6664	DONE;
6665      }
6666    else if (code == PRE_INC)
6667      {
6668	rtx reg = XEXP (XEXP (operands[0], 0), 0);
6669
6670	emit_insn (gen_addsi3 (reg, reg, GEN_INT (8)));
6671	operands[2] = reg;
6672      }
6673    else if (code == POST_DEC)
6674      operands[2] = XEXP (XEXP (operands[0], 0), 0);
6675    else
6676      emit_insn (gen_addsi3 (operands[2], XEXP (XEXP (operands[0], 0), 0),
6677			     XEXP (XEXP (operands[0], 0), 1)));
6678
6679    emit_insn (gen_rtx_SET (VOIDmode,
6680			    replace_equiv_address (operands[0], operands[2]),
6681			    operands[1]));
6682
6683    if (code == POST_DEC)
6684      emit_insn (gen_addsi3 (operands[2], operands[2], GEN_INT (-8)));
6685
6686    DONE;
6687  }"
6688)
6689
6690(define_insn "*movdf_soft_insn"
6691  [(set (match_operand:DF 0 "nonimmediate_soft_df_operand" "=r,r,r,q,m")
6692	(match_operand:DF 1 "soft_df_operand" "rDa,Db,Dc,mF,q"))]
6693  "TARGET_32BIT && TARGET_SOFT_FLOAT
6694   && (   register_operand (operands[0], DFmode)
6695       || register_operand (operands[1], DFmode))"
6696  "*
6697  switch (which_alternative)
6698    {
6699    case 0:
6700    case 1:
6701    case 2:
6702      return \"#\";
6703    default:
6704      return output_move_double (operands, true, NULL);
6705    }
6706  "
6707  [(set_attr "length" "8,12,16,8,8")
6708   (set_attr "type" "multiple,multiple,multiple,load2,store2")
6709   (set_attr "arm_pool_range" "*,*,*,1020,*")
6710   (set_attr "thumb2_pool_range" "*,*,*,1018,*")
6711   (set_attr "arm_neg_pool_range" "*,*,*,1004,*")
6712   (set_attr "thumb2_neg_pool_range" "*,*,*,0,*")]
6713)
6714
6715
6716;; load- and store-multiple insns
6717;; The arm can load/store any set of registers, provided that they are in
6718;; ascending order, but these expanders assume a contiguous set.
6719
6720(define_expand "load_multiple"
6721  [(match_par_dup 3 [(set (match_operand:SI 0 "" "")
6722                          (match_operand:SI 1 "" ""))
6723                     (use (match_operand:SI 2 "" ""))])]
6724  "TARGET_32BIT"
6725{
6726  HOST_WIDE_INT offset = 0;
6727
6728  /* Support only fixed point registers.  */
6729  if (!CONST_INT_P (operands[2])
6730      || INTVAL (operands[2]) > 14
6731      || INTVAL (operands[2]) < 2
6732      || !MEM_P (operands[1])
6733      || !REG_P (operands[0])
6734      || REGNO (operands[0]) > (LAST_ARM_REGNUM - 1)
6735      || REGNO (operands[0]) + INTVAL (operands[2]) > LAST_ARM_REGNUM)
6736    FAIL;
6737
6738  operands[3]
6739    = arm_gen_load_multiple (arm_regs_in_sequence + REGNO (operands[0]),
6740			     INTVAL (operands[2]),
6741			     force_reg (SImode, XEXP (operands[1], 0)),
6742			     FALSE, operands[1], &offset);
6743})
6744
6745(define_expand "store_multiple"
6746  [(match_par_dup 3 [(set (match_operand:SI 0 "" "")
6747                          (match_operand:SI 1 "" ""))
6748                     (use (match_operand:SI 2 "" ""))])]
6749  "TARGET_32BIT"
6750{
6751  HOST_WIDE_INT offset = 0;
6752
6753  /* Support only fixed point registers.  */
6754  if (!CONST_INT_P (operands[2])
6755      || INTVAL (operands[2]) > 14
6756      || INTVAL (operands[2]) < 2
6757      || !REG_P (operands[1])
6758      || !MEM_P (operands[0])
6759      || REGNO (operands[1]) > (LAST_ARM_REGNUM - 1)
6760      || REGNO (operands[1]) + INTVAL (operands[2]) > LAST_ARM_REGNUM)
6761    FAIL;
6762
6763  operands[3]
6764    = arm_gen_store_multiple (arm_regs_in_sequence + REGNO (operands[1]),
6765			      INTVAL (operands[2]),
6766			      force_reg (SImode, XEXP (operands[0], 0)),
6767			      FALSE, operands[0], &offset);
6768})
6769
6770
6771(define_expand "setmemsi"
6772  [(match_operand:BLK 0 "general_operand" "")
6773   (match_operand:SI 1 "const_int_operand" "")
6774   (match_operand:SI 2 "const_int_operand" "")
6775   (match_operand:SI 3 "const_int_operand" "")]
6776  "TARGET_32BIT"
6777{
6778  if (arm_gen_setmem (operands))
6779    DONE;
6780
6781  FAIL;
6782})
6783
6784
6785;; Move a block of memory if it is word aligned and MORE than 2 words long.
6786;; We could let this apply for blocks of less than this, but it clobbers so
6787;; many registers that there is then probably a better way.
6788
6789(define_expand "movmemqi"
6790  [(match_operand:BLK 0 "general_operand" "")
6791   (match_operand:BLK 1 "general_operand" "")
6792   (match_operand:SI 2 "const_int_operand" "")
6793   (match_operand:SI 3 "const_int_operand" "")]
6794  ""
6795  "
6796  if (TARGET_32BIT)
6797    {
6798      if (TARGET_LDRD && current_tune->prefer_ldrd_strd
6799          && !optimize_function_for_size_p (cfun))
6800        {
6801          if (gen_movmem_ldrd_strd (operands))
6802            DONE;
6803          FAIL;
6804        }
6805
6806      if (arm_gen_movmemqi (operands))
6807        DONE;
6808      FAIL;
6809    }
6810  else /* TARGET_THUMB1 */
6811    {
6812      if (   INTVAL (operands[3]) != 4
6813          || INTVAL (operands[2]) > 48)
6814        FAIL;
6815
6816      thumb_expand_movmemqi (operands);
6817      DONE;
6818    }
6819  "
6820)
6821
6822
6823;; Compare & branch insns
6824;; The range calculations are based as follows:
6825;; For forward branches, the address calculation returns the address of
6826;; the next instruction.  This is 2 beyond the branch instruction.
6827;; For backward branches, the address calculation returns the address of
6828;; the first instruction in this pattern (cmp).  This is 2 before the branch
6829;; instruction for the shortest sequence, and 4 before the branch instruction
6830;; if we have to jump around an unconditional branch.
6831;; To the basic branch range the PC offset must be added (this is +4).
6832;; So for forward branches we have 
6833;;   (pos_range - pos_base_offs + pc_offs) = (pos_range - 2 + 4).
6834;; And for backward branches we have 
6835;;   (neg_range - neg_base_offs + pc_offs) = (neg_range - (-2 or -4) + 4).
6836;;
6837;; For a 'b'       pos_range = 2046, neg_range = -2048 giving (-2040->2048).
6838;; For a 'b<cond>' pos_range = 254,  neg_range = -256  giving (-250 ->256).
6839
6840(define_expand "cbranchsi4"
6841  [(set (pc) (if_then_else
6842	      (match_operator 0 "expandable_comparison_operator"
6843	       [(match_operand:SI 1 "s_register_operand" "")
6844	        (match_operand:SI 2 "nonmemory_operand" "")])
6845	      (label_ref (match_operand 3 "" ""))
6846	      (pc)))]
6847  "TARGET_EITHER"
6848  "
6849  if (!TARGET_THUMB1)
6850    {
6851      if (!arm_validize_comparison (&operands[0], &operands[1], &operands[2]))
6852        FAIL;
6853      emit_jump_insn (gen_cbranch_cc (operands[0], operands[1], operands[2],
6854				      operands[3]));
6855      DONE;
6856    }
6857  if (thumb1_cmpneg_operand (operands[2], SImode))
6858    {
6859      emit_jump_insn (gen_cbranchsi4_scratch (NULL, operands[1], operands[2],
6860					      operands[3], operands[0]));
6861      DONE;
6862    }
6863  if (!thumb1_cmp_operand (operands[2], SImode))
6864    operands[2] = force_reg (SImode, operands[2]);
6865  ")
6866
6867(define_expand "cbranchsf4"
6868  [(set (pc) (if_then_else
6869	      (match_operator 0 "expandable_comparison_operator"
6870	       [(match_operand:SF 1 "s_register_operand" "")
6871	        (match_operand:SF 2 "arm_float_compare_operand" "")])
6872	      (label_ref (match_operand 3 "" ""))
6873	      (pc)))]
6874  "TARGET_32BIT && TARGET_HARD_FLOAT"
6875  "emit_jump_insn (gen_cbranch_cc (operands[0], operands[1], operands[2],
6876				   operands[3])); DONE;"
6877)
6878
6879(define_expand "cbranchdf4"
6880  [(set (pc) (if_then_else
6881	      (match_operator 0 "expandable_comparison_operator"
6882	       [(match_operand:DF 1 "s_register_operand" "")
6883	        (match_operand:DF 2 "arm_float_compare_operand" "")])
6884	      (label_ref (match_operand 3 "" ""))
6885	      (pc)))]
6886  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
6887  "emit_jump_insn (gen_cbranch_cc (operands[0], operands[1], operands[2],
6888				   operands[3])); DONE;"
6889)
6890
6891(define_expand "cbranchdi4"
6892  [(set (pc) (if_then_else
6893	      (match_operator 0 "expandable_comparison_operator"
6894	       [(match_operand:DI 1 "s_register_operand" "")
6895	        (match_operand:DI 2 "cmpdi_operand" "")])
6896	      (label_ref (match_operand 3 "" ""))
6897	      (pc)))]
6898  "TARGET_32BIT"
6899  "{
6900     if (!arm_validize_comparison (&operands[0], &operands[1], &operands[2]))
6901       FAIL;
6902     emit_jump_insn (gen_cbranch_cc (operands[0], operands[1], operands[2],
6903				       operands[3]));
6904     DONE;
6905   }"
6906)
6907
6908;; Comparison and test insns
6909
6910(define_insn "*arm_cmpsi_insn"
6911  [(set (reg:CC CC_REGNUM)
6912	(compare:CC (match_operand:SI 0 "s_register_operand" "l,r,r,r,r")
6913		    (match_operand:SI 1 "arm_add_operand"    "Py,r,r,I,L")))]
6914  "TARGET_32BIT"
6915  "@
6916   cmp%?\\t%0, %1
6917   cmp%?\\t%0, %1
6918   cmp%?\\t%0, %1
6919   cmp%?\\t%0, %1
6920   cmn%?\\t%0, #%n1"
6921  [(set_attr "conds" "set")
6922   (set_attr "arch" "t2,t2,any,any,any")
6923   (set_attr "length" "2,2,4,4,4")
6924   (set_attr "predicable" "yes")
6925   (set_attr "predicable_short_it" "yes,yes,yes,no,no")
6926   (set_attr "type" "alus_imm,alus_sreg,alus_sreg,alus_imm,alus_imm")]
6927)
6928
6929(define_insn "*cmpsi_shiftsi"
6930  [(set (reg:CC CC_REGNUM)
6931	(compare:CC (match_operand:SI   0 "s_register_operand" "r,r,r")
6932		    (match_operator:SI  3 "shift_operator"
6933		     [(match_operand:SI 1 "s_register_operand" "r,r,r")
6934		      (match_operand:SI 2 "shift_amount_operand" "M,r,M")])))]
6935  "TARGET_32BIT"
6936  "cmp\\t%0, %1%S3"
6937  [(set_attr "conds" "set")
6938   (set_attr "shift" "1")
6939   (set_attr "arch" "32,a,a")
6940   (set_attr "type" "alus_shift_imm,alu_shift_reg,alus_shift_imm")])
6941
6942(define_insn "*cmpsi_shiftsi_swp"
6943  [(set (reg:CC_SWP CC_REGNUM)
6944	(compare:CC_SWP (match_operator:SI 3 "shift_operator"
6945			 [(match_operand:SI 1 "s_register_operand" "r,r,r")
6946			  (match_operand:SI 2 "shift_amount_operand" "M,r,M")])
6947			(match_operand:SI 0 "s_register_operand" "r,r,r")))]
6948  "TARGET_32BIT"
6949  "cmp%?\\t%0, %1%S3"
6950  [(set_attr "conds" "set")
6951   (set_attr "shift" "1")
6952   (set_attr "arch" "32,a,a")
6953   (set_attr "type" "alus_shift_imm,alu_shift_reg,alus_shift_imm")])
6954
6955(define_insn "*arm_cmpsi_negshiftsi_si"
6956  [(set (reg:CC_Z CC_REGNUM)
6957	(compare:CC_Z
6958	 (neg:SI (match_operator:SI 1 "shift_operator"
6959		    [(match_operand:SI 2 "s_register_operand" "r")
6960		     (match_operand:SI 3 "reg_or_int_operand" "rM")]))
6961	 (match_operand:SI 0 "s_register_operand" "r")))]
6962  "TARGET_ARM"
6963  "cmn%?\\t%0, %2%S1"
6964  [(set_attr "conds" "set")
6965   (set (attr "type") (if_then_else (match_operand 3 "const_int_operand" "")
6966				    (const_string "alus_shift_imm")
6967				    (const_string "alus_shift_reg")))
6968   (set_attr "predicable" "yes")]
6969)
6970
6971;; DImode comparisons.  The generic code generates branches that
6972;; if-conversion can not reduce to a conditional compare, so we do
6973;; that directly.
6974
6975(define_insn_and_split "*arm_cmpdi_insn"
6976  [(set (reg:CC_NCV CC_REGNUM)
6977	(compare:CC_NCV (match_operand:DI 0 "s_register_operand" "r")
6978			(match_operand:DI 1 "arm_di_operand"	   "rDi")))
6979   (clobber (match_scratch:SI 2 "=r"))]
6980  "TARGET_32BIT"
6981  "#"   ; "cmp\\t%Q0, %Q1\;sbcs\\t%2, %R0, %R1"
6982  "&& reload_completed"
6983  [(set (reg:CC CC_REGNUM)
6984        (compare:CC (match_dup 0) (match_dup 1)))
6985   (parallel [(set (reg:CC CC_REGNUM)
6986                   (compare:CC (match_dup 3) (match_dup 4)))
6987              (set (match_dup 2)
6988                   (minus:SI (match_dup 5)
6989                            (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))])]
6990  {
6991    operands[3] = gen_highpart (SImode, operands[0]);
6992    operands[0] = gen_lowpart (SImode, operands[0]);
6993    if (CONST_INT_P (operands[1]))
6994      {
6995        operands[4] = GEN_INT (~INTVAL (gen_highpart_mode (SImode,
6996                                                           DImode,
6997                                                           operands[1])));
6998        operands[5] = gen_rtx_PLUS (SImode, operands[3], operands[4]);
6999      }
7000    else
7001      {
7002        operands[4] = gen_highpart (SImode, operands[1]);
7003        operands[5] = gen_rtx_MINUS (SImode, operands[3], operands[4]);
7004      }
7005    operands[1] = gen_lowpart (SImode, operands[1]);
7006    operands[2] = gen_lowpart (SImode, operands[2]);
7007  }
7008  [(set_attr "conds" "set")
7009   (set_attr "length" "8")
7010   (set_attr "type" "multiple")]
7011)
7012
7013(define_insn_and_split "*arm_cmpdi_unsigned"
7014  [(set (reg:CC_CZ CC_REGNUM)
7015        (compare:CC_CZ (match_operand:DI 0 "s_register_operand" "l,r,r,r")
7016                       (match_operand:DI 1 "arm_di_operand"     "Py,r,Di,rDi")))]
7017
7018  "TARGET_32BIT"
7019  "#"   ; "cmp\\t%R0, %R1\;it eq\;cmpeq\\t%Q0, %Q1"
7020  "&& reload_completed"
7021  [(set (reg:CC CC_REGNUM)
7022        (compare:CC (match_dup 2) (match_dup 3)))
7023   (cond_exec (eq:SI (reg:CC CC_REGNUM) (const_int 0))
7024              (set (reg:CC CC_REGNUM)
7025                   (compare:CC (match_dup 0) (match_dup 1))))]
7026  {
7027    operands[2] = gen_highpart (SImode, operands[0]);
7028    operands[0] = gen_lowpart (SImode, operands[0]);
7029    if (CONST_INT_P (operands[1]))
7030      operands[3] = gen_highpart_mode (SImode, DImode, operands[1]);
7031    else
7032      operands[3] = gen_highpart (SImode, operands[1]);
7033    operands[1] = gen_lowpart (SImode, operands[1]);
7034  }
7035  [(set_attr "conds" "set")
7036   (set_attr "enabled_for_depr_it" "yes,yes,no,*")
7037   (set_attr "arch" "t2,t2,t2,a")
7038   (set_attr "length" "6,6,10,8")
7039   (set_attr "type" "multiple")]
7040)
7041
7042(define_insn "*arm_cmpdi_zero"
7043  [(set (reg:CC_Z CC_REGNUM)
7044	(compare:CC_Z (match_operand:DI 0 "s_register_operand" "r")
7045		      (const_int 0)))
7046   (clobber (match_scratch:SI 1 "=r"))]
7047  "TARGET_32BIT"
7048  "orr%.\\t%1, %Q0, %R0"
7049  [(set_attr "conds" "set")
7050   (set_attr "type" "logics_reg")]
7051)
7052
7053; This insn allows redundant compares to be removed by cse, nothing should
7054; ever appear in the output file since (set (reg x) (reg x)) is a no-op that
7055; is deleted later on. The match_dup will match the mode here, so that
7056; mode changes of the condition codes aren't lost by this even though we don't
7057; specify what they are.
7058
7059(define_insn "*deleted_compare"
7060  [(set (match_operand 0 "cc_register" "") (match_dup 0))]
7061  "TARGET_32BIT"
7062  "\\t%@ deleted compare"
7063  [(set_attr "conds" "set")
7064   (set_attr "length" "0")
7065   (set_attr "type" "no_insn")]
7066)
7067
7068
7069;; Conditional branch insns
7070
7071(define_expand "cbranch_cc"
7072  [(set (pc)
7073	(if_then_else (match_operator 0 "" [(match_operand 1 "" "")
7074					    (match_operand 2 "" "")])
7075		      (label_ref (match_operand 3 "" ""))
7076		      (pc)))]
7077  "TARGET_32BIT"
7078  "operands[1] = arm_gen_compare_reg (GET_CODE (operands[0]),
7079				      operands[1], operands[2], NULL_RTX);
7080   operands[2] = const0_rtx;"
7081)
7082
7083;;
7084;; Patterns to match conditional branch insns.
7085;;
7086
7087(define_insn "arm_cond_branch"
7088  [(set (pc)
7089	(if_then_else (match_operator 1 "arm_comparison_operator"
7090		       [(match_operand 2 "cc_register" "") (const_int 0)])
7091		      (label_ref (match_operand 0 "" ""))
7092		      (pc)))]
7093  "TARGET_32BIT"
7094  "*
7095  if (arm_ccfsm_state == 1 || arm_ccfsm_state == 2)
7096    {
7097      arm_ccfsm_state += 2;
7098      return \"\";
7099    }
7100  return \"b%d1\\t%l0\";
7101  "
7102  [(set_attr "conds" "use")
7103   (set_attr "type" "branch")
7104   (set (attr "length")
7105	(if_then_else
7106	   (and (match_test "TARGET_THUMB2")
7107		(and (ge (minus (match_dup 0) (pc)) (const_int -250))
7108		     (le (minus (match_dup 0) (pc)) (const_int 256))))
7109	   (const_int 2)
7110	   (const_int 4)))]
7111)
7112
7113(define_insn "*arm_cond_branch_reversed"
7114  [(set (pc)
7115	(if_then_else (match_operator 1 "arm_comparison_operator"
7116		       [(match_operand 2 "cc_register" "") (const_int 0)])
7117		      (pc)
7118		      (label_ref (match_operand 0 "" ""))))]
7119  "TARGET_32BIT"
7120  "*
7121  if (arm_ccfsm_state == 1 || arm_ccfsm_state == 2)
7122    {
7123      arm_ccfsm_state += 2;
7124      return \"\";
7125    }
7126  return \"b%D1\\t%l0\";
7127  "
7128  [(set_attr "conds" "use")
7129   (set_attr "type" "branch")
7130   (set (attr "length")
7131	(if_then_else
7132	   (and (match_test "TARGET_THUMB2")
7133		(and (ge (minus (match_dup 0) (pc)) (const_int -250))
7134		     (le (minus (match_dup 0) (pc)) (const_int 256))))
7135	   (const_int 2)
7136	   (const_int 4)))]
7137)
7138
7139
7140
7141; scc insns
7142
7143(define_expand "cstore_cc"
7144  [(set (match_operand:SI 0 "s_register_operand" "")
7145	(match_operator:SI 1 "" [(match_operand 2 "" "")
7146				 (match_operand 3 "" "")]))]
7147  "TARGET_32BIT"
7148  "operands[2] = arm_gen_compare_reg (GET_CODE (operands[1]),
7149				      operands[2], operands[3], NULL_RTX);
7150   operands[3] = const0_rtx;"
7151)
7152
7153(define_insn_and_split "*mov_scc"
7154  [(set (match_operand:SI 0 "s_register_operand" "=r")
7155	(match_operator:SI 1 "arm_comparison_operator"
7156	 [(match_operand 2 "cc_register" "") (const_int 0)]))]
7157  "TARGET_ARM"
7158  "#"   ; "mov%D1\\t%0, #0\;mov%d1\\t%0, #1"
7159  "TARGET_ARM"
7160  [(set (match_dup 0)
7161        (if_then_else:SI (match_dup 1)
7162                         (const_int 1)
7163                         (const_int 0)))]
7164  ""
7165  [(set_attr "conds" "use")
7166   (set_attr "length" "8")
7167   (set_attr "type" "multiple")]
7168)
7169
7170(define_insn_and_split "*mov_negscc"
7171  [(set (match_operand:SI 0 "s_register_operand" "=r")
7172	(neg:SI (match_operator:SI 1 "arm_comparison_operator"
7173		 [(match_operand 2 "cc_register" "") (const_int 0)])))]
7174  "TARGET_ARM"
7175  "#"   ; "mov%D1\\t%0, #0\;mvn%d1\\t%0, #0"
7176  "TARGET_ARM"
7177  [(set (match_dup 0)
7178        (if_then_else:SI (match_dup 1)
7179                         (match_dup 3)
7180                         (const_int 0)))]
7181  {
7182    operands[3] = GEN_INT (~0);
7183  }
7184  [(set_attr "conds" "use")
7185   (set_attr "length" "8")
7186   (set_attr "type" "multiple")]
7187)
7188
7189(define_insn_and_split "*mov_notscc"
7190  [(set (match_operand:SI 0 "s_register_operand" "=r")
7191	(not:SI (match_operator:SI 1 "arm_comparison_operator"
7192		 [(match_operand 2 "cc_register" "") (const_int 0)])))]
7193  "TARGET_ARM"
7194  "#"   ; "mvn%D1\\t%0, #0\;mvn%d1\\t%0, #1"
7195  "TARGET_ARM"
7196  [(set (match_dup 0)
7197        (if_then_else:SI (match_dup 1)
7198                         (match_dup 3)
7199                         (match_dup 4)))]
7200  {
7201    operands[3] = GEN_INT (~1);
7202    operands[4] = GEN_INT (~0);
7203  }
7204  [(set_attr "conds" "use")
7205   (set_attr "length" "8")
7206   (set_attr "type" "multiple")]
7207)
7208
7209(define_expand "cstoresi4"
7210  [(set (match_operand:SI 0 "s_register_operand" "")
7211	(match_operator:SI 1 "expandable_comparison_operator"
7212	 [(match_operand:SI 2 "s_register_operand" "")
7213	  (match_operand:SI 3 "reg_or_int_operand" "")]))]
7214  "TARGET_32BIT || TARGET_THUMB1"
7215  "{
7216  rtx op3, scratch, scratch2;
7217
7218  if (!TARGET_THUMB1)
7219    {
7220      if (!arm_add_operand (operands[3], SImode))
7221	operands[3] = force_reg (SImode, operands[3]);
7222      emit_insn (gen_cstore_cc (operands[0], operands[1],
7223				operands[2], operands[3]));
7224      DONE;
7225    }
7226
7227  if (operands[3] == const0_rtx)
7228    {
7229      switch (GET_CODE (operands[1]))
7230	{
7231	case EQ:
7232	  emit_insn (gen_cstoresi_eq0_thumb1 (operands[0], operands[2]));
7233	  break;
7234
7235	case NE:
7236	  emit_insn (gen_cstoresi_ne0_thumb1 (operands[0], operands[2]));
7237	  break;
7238
7239	case LE:
7240          scratch = expand_binop (SImode, add_optab, operands[2], constm1_rtx,
7241				  NULL_RTX, 0, OPTAB_WIDEN);
7242          scratch = expand_binop (SImode, ior_optab, operands[2], scratch,
7243				  NULL_RTX, 0, OPTAB_WIDEN);
7244          expand_binop (SImode, lshr_optab, scratch, GEN_INT (31),
7245			operands[0], 1, OPTAB_WIDEN);
7246	  break;
7247
7248        case GE:
7249          scratch = expand_unop (SImode, one_cmpl_optab, operands[2],
7250				 NULL_RTX, 1);
7251          expand_binop (SImode, lshr_optab, scratch, GEN_INT (31),
7252			NULL_RTX, 1, OPTAB_WIDEN);
7253          break;
7254
7255        case GT:
7256          scratch = expand_binop (SImode, ashr_optab, operands[2],
7257				  GEN_INT (31), NULL_RTX, 0, OPTAB_WIDEN);
7258          scratch = expand_binop (SImode, sub_optab, scratch, operands[2],
7259				  NULL_RTX, 0, OPTAB_WIDEN);
7260          expand_binop (SImode, lshr_optab, scratch, GEN_INT (31), operands[0],
7261			0, OPTAB_WIDEN);
7262          break;
7263
7264	/* LT is handled by generic code.  No need for unsigned with 0.  */
7265	default:
7266	  FAIL;
7267	}
7268      DONE;
7269    }
7270
7271  switch (GET_CODE (operands[1]))
7272    {
7273    case EQ:
7274      scratch = expand_binop (SImode, sub_optab, operands[2], operands[3],
7275			      NULL_RTX, 0, OPTAB_WIDEN);
7276      emit_insn (gen_cstoresi_eq0_thumb1 (operands[0], scratch));
7277      break;
7278
7279    case NE:
7280      scratch = expand_binop (SImode, sub_optab, operands[2], operands[3],
7281			      NULL_RTX, 0, OPTAB_WIDEN);
7282      emit_insn (gen_cstoresi_ne0_thumb1 (operands[0], scratch));
7283      break;
7284
7285    case LE:
7286      op3 = force_reg (SImode, operands[3]);
7287
7288      scratch = expand_binop (SImode, lshr_optab, operands[2], GEN_INT (31),
7289			      NULL_RTX, 1, OPTAB_WIDEN);
7290      scratch2 = expand_binop (SImode, ashr_optab, op3, GEN_INT (31),
7291			      NULL_RTX, 0, OPTAB_WIDEN);
7292      emit_insn (gen_thumb1_addsi3_addgeu (operands[0], scratch, scratch2,
7293					  op3, operands[2]));
7294      break;
7295
7296    case GE:
7297      op3 = operands[3];
7298      if (!thumb1_cmp_operand (op3, SImode))
7299        op3 = force_reg (SImode, op3);
7300      scratch = expand_binop (SImode, ashr_optab, operands[2], GEN_INT (31),
7301			      NULL_RTX, 0, OPTAB_WIDEN);
7302      scratch2 = expand_binop (SImode, lshr_optab, op3, GEN_INT (31),
7303			       NULL_RTX, 1, OPTAB_WIDEN);
7304      emit_insn (gen_thumb1_addsi3_addgeu (operands[0], scratch, scratch2,
7305					  operands[2], op3));
7306      break;
7307
7308    case LEU:
7309      op3 = force_reg (SImode, operands[3]);
7310      scratch = force_reg (SImode, const0_rtx);
7311      emit_insn (gen_thumb1_addsi3_addgeu (operands[0], scratch, scratch,
7312					  op3, operands[2]));
7313      break;
7314
7315    case GEU:
7316      op3 = operands[3];
7317      if (!thumb1_cmp_operand (op3, SImode))
7318        op3 = force_reg (SImode, op3);
7319      scratch = force_reg (SImode, const0_rtx);
7320      emit_insn (gen_thumb1_addsi3_addgeu (operands[0], scratch, scratch,
7321					  operands[2], op3));
7322      break;
7323
7324    case LTU:
7325      op3 = operands[3];
7326      if (!thumb1_cmp_operand (op3, SImode))
7327        op3 = force_reg (SImode, op3);
7328      scratch = gen_reg_rtx (SImode);
7329      emit_insn (gen_cstoresi_ltu_thumb1 (operands[0], operands[2], op3));
7330      break;
7331
7332    case GTU:
7333      op3 = force_reg (SImode, operands[3]);
7334      scratch = gen_reg_rtx (SImode);
7335      emit_insn (gen_cstoresi_ltu_thumb1 (operands[0], op3, operands[2]));
7336      break;
7337
7338    /* No good sequences for GT, LT.  */
7339    default:
7340      FAIL;
7341    }
7342  DONE;
7343}")
7344
7345(define_expand "cstoresf4"
7346  [(set (match_operand:SI 0 "s_register_operand" "")
7347	(match_operator:SI 1 "expandable_comparison_operator"
7348	 [(match_operand:SF 2 "s_register_operand" "")
7349	  (match_operand:SF 3 "arm_float_compare_operand" "")]))]
7350  "TARGET_32BIT && TARGET_HARD_FLOAT"
7351  "emit_insn (gen_cstore_cc (operands[0], operands[1],
7352			     operands[2], operands[3])); DONE;"
7353)
7354
7355(define_expand "cstoredf4"
7356  [(set (match_operand:SI 0 "s_register_operand" "")
7357	(match_operator:SI 1 "expandable_comparison_operator"
7358	 [(match_operand:DF 2 "s_register_operand" "")
7359	  (match_operand:DF 3 "arm_float_compare_operand" "")]))]
7360  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
7361  "emit_insn (gen_cstore_cc (operands[0], operands[1],
7362			     operands[2], operands[3])); DONE;"
7363)
7364
7365(define_expand "cstoredi4"
7366  [(set (match_operand:SI 0 "s_register_operand" "")
7367	(match_operator:SI 1 "expandable_comparison_operator"
7368	 [(match_operand:DI 2 "s_register_operand" "")
7369	  (match_operand:DI 3 "cmpdi_operand" "")]))]
7370  "TARGET_32BIT"
7371  "{
7372     if (!arm_validize_comparison (&operands[1],
7373     				   &operands[2],
7374				   &operands[3]))
7375       FAIL;
7376     emit_insn (gen_cstore_cc (operands[0], operands[1], operands[2],
7377		      	         operands[3]));
7378     DONE;
7379   }"
7380)
7381
7382
7383;; Conditional move insns
7384
7385(define_expand "movsicc"
7386  [(set (match_operand:SI 0 "s_register_operand" "")
7387	(if_then_else:SI (match_operand 1 "expandable_comparison_operator" "")
7388			 (match_operand:SI 2 "arm_not_operand" "")
7389			 (match_operand:SI 3 "arm_not_operand" "")))]
7390  "TARGET_32BIT"
7391  "
7392  {
7393    enum rtx_code code;
7394    rtx ccreg;
7395
7396    if (!arm_validize_comparison (&operands[1], &XEXP (operands[1], 0), 
7397       				  &XEXP (operands[1], 1)))
7398      FAIL;
7399    
7400    code = GET_CODE (operands[1]);
7401    ccreg = arm_gen_compare_reg (code, XEXP (operands[1], 0),
7402				 XEXP (operands[1], 1), NULL_RTX);
7403    operands[1] = gen_rtx_fmt_ee (code, VOIDmode, ccreg, const0_rtx);
7404  }"
7405)
7406
7407(define_expand "movsfcc"
7408  [(set (match_operand:SF 0 "s_register_operand" "")
7409	(if_then_else:SF (match_operand 1 "arm_cond_move_operator" "")
7410			 (match_operand:SF 2 "s_register_operand" "")
7411			 (match_operand:SF 3 "s_register_operand" "")))]
7412  "TARGET_32BIT && TARGET_HARD_FLOAT"
7413  "
7414  {
7415    enum rtx_code code = GET_CODE (operands[1]);
7416    rtx ccreg;
7417
7418    if (!arm_validize_comparison (&operands[1], &XEXP (operands[1], 0), 
7419       				  &XEXP (operands[1], 1)))
7420       FAIL;
7421
7422    code = GET_CODE (operands[1]);
7423    ccreg = arm_gen_compare_reg (code, XEXP (operands[1], 0),
7424				 XEXP (operands[1], 1), NULL_RTX);
7425    operands[1] = gen_rtx_fmt_ee (code, VOIDmode, ccreg, const0_rtx);
7426  }"
7427)
7428
7429(define_expand "movdfcc"
7430  [(set (match_operand:DF 0 "s_register_operand" "")
7431	(if_then_else:DF (match_operand 1 "arm_cond_move_operator" "")
7432			 (match_operand:DF 2 "s_register_operand" "")
7433			 (match_operand:DF 3 "s_register_operand" "")))]
7434  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP_DOUBLE"
7435  "
7436  {
7437    enum rtx_code code = GET_CODE (operands[1]);
7438    rtx ccreg;
7439
7440    if (!arm_validize_comparison (&operands[1], &XEXP (operands[1], 0), 
7441       				  &XEXP (operands[1], 1)))
7442       FAIL;
7443    code = GET_CODE (operands[1]);
7444    ccreg = arm_gen_compare_reg (code, XEXP (operands[1], 0),
7445				 XEXP (operands[1], 1), NULL_RTX);
7446    operands[1] = gen_rtx_fmt_ee (code, VOIDmode, ccreg, const0_rtx);
7447  }"
7448)
7449
7450(define_insn "*cmov<mode>"
7451    [(set (match_operand:SDF 0 "s_register_operand" "=<F_constraint>")
7452	(if_then_else:SDF (match_operator 1 "arm_vsel_comparison_operator"
7453			  [(match_operand 2 "cc_register" "") (const_int 0)])
7454			  (match_operand:SDF 3 "s_register_operand"
7455			                      "<F_constraint>")
7456			  (match_operand:SDF 4 "s_register_operand"
7457			                      "<F_constraint>")))]
7458  "TARGET_HARD_FLOAT && TARGET_FPU_ARMV8 <vfp_double_cond>"
7459  "*
7460  {
7461    enum arm_cond_code code = maybe_get_arm_condition_code (operands[1]);
7462    switch (code)
7463      {
7464      case ARM_GE:
7465      case ARM_GT:
7466      case ARM_EQ:
7467      case ARM_VS:
7468        return \"vsel%d1.<V_if_elem>\\t%<V_reg>0, %<V_reg>3, %<V_reg>4\";
7469      case ARM_LT:
7470      case ARM_LE:
7471      case ARM_NE:
7472      case ARM_VC:
7473        return \"vsel%D1.<V_if_elem>\\t%<V_reg>0, %<V_reg>4, %<V_reg>3\";
7474      default:
7475        gcc_unreachable ();
7476      }
7477    return \"\";
7478  }"
7479  [(set_attr "conds" "use")
7480   (set_attr "type" "fcsel")]
7481)
7482
7483(define_insn_and_split "*movsicc_insn"
7484  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r,r,r,r,r,r")
7485	(if_then_else:SI
7486	 (match_operator 3 "arm_comparison_operator"
7487	  [(match_operand 4 "cc_register" "") (const_int 0)])
7488	 (match_operand:SI 1 "arm_not_operand" "0,0,rI,K,rI,rI,K,K")
7489	 (match_operand:SI 2 "arm_not_operand" "rI,K,0,0,rI,K,rI,K")))]
7490  "TARGET_ARM"
7491  "@
7492   mov%D3\\t%0, %2
7493   mvn%D3\\t%0, #%B2
7494   mov%d3\\t%0, %1
7495   mvn%d3\\t%0, #%B1
7496   #
7497   #
7498   #
7499   #"
7500   ; alt4: mov%d3\\t%0, %1\;mov%D3\\t%0, %2
7501   ; alt5: mov%d3\\t%0, %1\;mvn%D3\\t%0, #%B2
7502   ; alt6: mvn%d3\\t%0, #%B1\;mov%D3\\t%0, %2
7503   ; alt7: mvn%d3\\t%0, #%B1\;mvn%D3\\t%0, #%B2"
7504  "&& reload_completed"
7505  [(const_int 0)]
7506  {
7507    enum rtx_code rev_code;
7508    machine_mode mode;
7509    rtx rev_cond;
7510
7511    emit_insn (gen_rtx_COND_EXEC (VOIDmode,
7512                                  operands[3],
7513                                  gen_rtx_SET (VOIDmode,
7514                                               operands[0],
7515                                               operands[1])));
7516
7517    rev_code = GET_CODE (operands[3]);
7518    mode = GET_MODE (operands[4]);
7519    if (mode == CCFPmode || mode == CCFPEmode)
7520      rev_code = reverse_condition_maybe_unordered (rev_code);
7521    else
7522      rev_code = reverse_condition (rev_code);
7523
7524    rev_cond = gen_rtx_fmt_ee (rev_code,
7525                               VOIDmode,
7526                               operands[4],
7527                               const0_rtx);
7528    emit_insn (gen_rtx_COND_EXEC (VOIDmode,
7529                                  rev_cond,
7530                                  gen_rtx_SET (VOIDmode,
7531                                               operands[0],
7532                                               operands[2])));
7533    DONE;
7534  }
7535  [(set_attr "length" "4,4,4,4,8,8,8,8")
7536   (set_attr "conds" "use")
7537   (set_attr_alternative "type"
7538                         [(if_then_else (match_operand 2 "const_int_operand" "")
7539                                        (const_string "mov_imm")
7540                                        (const_string "mov_reg"))
7541                          (const_string "mvn_imm")
7542                          (if_then_else (match_operand 1 "const_int_operand" "")
7543                                        (const_string "mov_imm")
7544                                        (const_string "mov_reg"))
7545                          (const_string "mvn_imm")
7546                          (const_string "mov_reg")
7547                          (const_string "mov_reg")
7548                          (const_string "mov_reg")
7549                          (const_string "mov_reg")])]
7550)
7551
7552(define_insn "*movsfcc_soft_insn"
7553  [(set (match_operand:SF 0 "s_register_operand" "=r,r")
7554	(if_then_else:SF (match_operator 3 "arm_comparison_operator"
7555			  [(match_operand 4 "cc_register" "") (const_int 0)])
7556			 (match_operand:SF 1 "s_register_operand" "0,r")
7557			 (match_operand:SF 2 "s_register_operand" "r,0")))]
7558  "TARGET_ARM && TARGET_SOFT_FLOAT"
7559  "@
7560   mov%D3\\t%0, %2
7561   mov%d3\\t%0, %1"
7562  [(set_attr "conds" "use")
7563   (set_attr "type" "mov_reg")]
7564)
7565
7566
7567;; Jump and linkage insns
7568
7569(define_expand "jump"
7570  [(set (pc)
7571	(label_ref (match_operand 0 "" "")))]
7572  "TARGET_EITHER"
7573  ""
7574)
7575
7576(define_insn "*arm_jump"
7577  [(set (pc)
7578	(label_ref (match_operand 0 "" "")))]
7579  "TARGET_32BIT"
7580  "*
7581  {
7582    if (arm_ccfsm_state == 1 || arm_ccfsm_state == 2)
7583      {
7584        arm_ccfsm_state += 2;
7585        return \"\";
7586      }
7587    return \"b%?\\t%l0\";
7588  }
7589  "
7590  [(set_attr "predicable" "yes")
7591   (set (attr "length")
7592	(if_then_else
7593	   (and (match_test "TARGET_THUMB2")
7594		(and (ge (minus (match_dup 0) (pc)) (const_int -2044))
7595		     (le (minus (match_dup 0) (pc)) (const_int 2048))))
7596	   (const_int 2)
7597	   (const_int 4)))
7598   (set_attr "type" "branch")]
7599)
7600
7601(define_expand "call"
7602  [(parallel [(call (match_operand 0 "memory_operand" "")
7603	            (match_operand 1 "general_operand" ""))
7604	      (use (match_operand 2 "" ""))
7605	      (clobber (reg:SI LR_REGNUM))])]
7606  "TARGET_EITHER"
7607  "
7608  {
7609    rtx callee, pat;
7610    
7611    /* In an untyped call, we can get NULL for operand 2.  */
7612    if (operands[2] == NULL_RTX)
7613      operands[2] = const0_rtx;
7614      
7615    /* Decide if we should generate indirect calls by loading the
7616       32-bit address of the callee into a register before performing the
7617       branch and link.  */
7618    callee = XEXP (operands[0], 0);
7619    if (GET_CODE (callee) == SYMBOL_REF
7620	? arm_is_long_call_p (SYMBOL_REF_DECL (callee))
7621	: !REG_P (callee))
7622      XEXP (operands[0], 0) = force_reg (Pmode, callee);
7623
7624    pat = gen_call_internal (operands[0], operands[1], operands[2]);
7625    arm_emit_call_insn (pat, XEXP (operands[0], 0), false);
7626    DONE;
7627  }"
7628)
7629
7630(define_expand "call_internal"
7631  [(parallel [(call (match_operand 0 "memory_operand" "")
7632	            (match_operand 1 "general_operand" ""))
7633	      (use (match_operand 2 "" ""))
7634	      (clobber (reg:SI LR_REGNUM))])])
7635
7636(define_insn "*call_reg_armv5"
7637  [(call (mem:SI (match_operand:SI 0 "s_register_operand" "r"))
7638         (match_operand 1 "" ""))
7639   (use (match_operand 2 "" ""))
7640   (clobber (reg:SI LR_REGNUM))]
7641  "TARGET_ARM && arm_arch5 && !SIBLING_CALL_P (insn)"
7642  "blx%?\\t%0"
7643  [(set_attr "type" "call")]
7644)
7645
7646(define_insn "*call_reg_arm"
7647  [(call (mem:SI (match_operand:SI 0 "s_register_operand" "r"))
7648         (match_operand 1 "" ""))
7649   (use (match_operand 2 "" ""))
7650   (clobber (reg:SI LR_REGNUM))]
7651  "TARGET_ARM && !arm_arch5 && !SIBLING_CALL_P (insn)"
7652  "*
7653  return output_call (operands);
7654  "
7655  ;; length is worst case, normally it is only two
7656  [(set_attr "length" "12")
7657   (set_attr "type" "call")]
7658)
7659
7660
7661;; Note: not used for armv5+ because the sequence used (ldr pc, ...) is not
7662;; considered a function call by the branch predictor of some cores (PR40887).
7663;; Falls back to blx rN (*call_reg_armv5).
7664
7665(define_insn "*call_mem"
7666  [(call (mem:SI (match_operand:SI 0 "call_memory_operand" "m"))
7667	 (match_operand 1 "" ""))
7668   (use (match_operand 2 "" ""))
7669   (clobber (reg:SI LR_REGNUM))]
7670  "TARGET_ARM && !arm_arch5 && !SIBLING_CALL_P (insn)"
7671  "*
7672  return output_call_mem (operands);
7673  "
7674  [(set_attr "length" "12")
7675   (set_attr "type" "call")]
7676)
7677
7678(define_expand "call_value"
7679  [(parallel [(set (match_operand       0 "" "")
7680	           (call (match_operand 1 "memory_operand" "")
7681		         (match_operand 2 "general_operand" "")))
7682	      (use (match_operand 3 "" ""))
7683	      (clobber (reg:SI LR_REGNUM))])]
7684  "TARGET_EITHER"
7685  "
7686  {
7687    rtx pat, callee;
7688    
7689    /* In an untyped call, we can get NULL for operand 2.  */
7690    if (operands[3] == 0)
7691      operands[3] = const0_rtx;
7692      
7693    /* Decide if we should generate indirect calls by loading the
7694       32-bit address of the callee into a register before performing the
7695       branch and link.  */
7696    callee = XEXP (operands[1], 0);
7697    if (GET_CODE (callee) == SYMBOL_REF
7698	? arm_is_long_call_p (SYMBOL_REF_DECL (callee))
7699	: !REG_P (callee))
7700      XEXP (operands[1], 0) = force_reg (Pmode, callee);
7701
7702    pat = gen_call_value_internal (operands[0], operands[1],
7703				   operands[2], operands[3]);
7704    arm_emit_call_insn (pat, XEXP (operands[1], 0), false);
7705    DONE;
7706  }"
7707)
7708
7709(define_expand "call_value_internal"
7710  [(parallel [(set (match_operand       0 "" "")
7711	           (call (match_operand 1 "memory_operand" "")
7712		         (match_operand 2 "general_operand" "")))
7713	      (use (match_operand 3 "" ""))
7714	      (clobber (reg:SI LR_REGNUM))])])
7715
7716(define_insn "*call_value_reg_armv5"
7717  [(set (match_operand 0 "" "")
7718        (call (mem:SI (match_operand:SI 1 "s_register_operand" "r"))
7719	      (match_operand 2 "" "")))
7720   (use (match_operand 3 "" ""))
7721   (clobber (reg:SI LR_REGNUM))]
7722  "TARGET_ARM && arm_arch5 && !SIBLING_CALL_P (insn)"
7723  "blx%?\\t%1"
7724  [(set_attr "type" "call")]
7725)
7726
7727(define_insn "*call_value_reg_arm"
7728  [(set (match_operand 0 "" "")
7729        (call (mem:SI (match_operand:SI 1 "s_register_operand" "r"))
7730	      (match_operand 2 "" "")))
7731   (use (match_operand 3 "" ""))
7732   (clobber (reg:SI LR_REGNUM))]
7733  "TARGET_ARM && !arm_arch5 && !SIBLING_CALL_P (insn)"
7734  "*
7735  return output_call (&operands[1]);
7736  "
7737  [(set_attr "length" "12")
7738   (set_attr "type" "call")]
7739)
7740
7741;; Note: see *call_mem
7742
7743(define_insn "*call_value_mem"
7744  [(set (match_operand 0 "" "")
7745	(call (mem:SI (match_operand:SI 1 "call_memory_operand" "m"))
7746	      (match_operand 2 "" "")))
7747   (use (match_operand 3 "" ""))
7748   (clobber (reg:SI LR_REGNUM))]
7749  "TARGET_ARM && !arm_arch5 && (!CONSTANT_ADDRESS_P (XEXP (operands[1], 0)))
7750   && !SIBLING_CALL_P (insn)"
7751  "*
7752  return output_call_mem (&operands[1]);
7753  "
7754  [(set_attr "length" "12")
7755   (set_attr "type" "call")]
7756)
7757
7758;; Allow calls to SYMBOL_REFs specially as they are not valid general addresses
7759;; The 'a' causes the operand to be treated as an address, i.e. no '#' output.
7760
7761(define_insn "*call_symbol"
7762  [(call (mem:SI (match_operand:SI 0 "" ""))
7763	 (match_operand 1 "" ""))
7764   (use (match_operand 2 "" ""))
7765   (clobber (reg:SI LR_REGNUM))]
7766  "TARGET_32BIT
7767   && !SIBLING_CALL_P (insn)
7768   && (GET_CODE (operands[0]) == SYMBOL_REF)
7769   && !arm_is_long_call_p (SYMBOL_REF_DECL (operands[0]))"
7770  "*
7771  {
7772    return NEED_PLT_RELOC ? \"bl%?\\t%a0(PLT)\" : \"bl%?\\t%a0\";
7773  }"
7774  [(set_attr "type" "call")]
7775)
7776
7777(define_insn "*call_value_symbol"
7778  [(set (match_operand 0 "" "")
7779	(call (mem:SI (match_operand:SI 1 "" ""))
7780	(match_operand:SI 2 "" "")))
7781   (use (match_operand 3 "" ""))
7782   (clobber (reg:SI LR_REGNUM))]
7783  "TARGET_32BIT
7784   && !SIBLING_CALL_P (insn)
7785   && (GET_CODE (operands[1]) == SYMBOL_REF)
7786   && !arm_is_long_call_p (SYMBOL_REF_DECL (operands[1]))"
7787  "*
7788  {
7789    return NEED_PLT_RELOC ? \"bl%?\\t%a1(PLT)\" : \"bl%?\\t%a1\";
7790  }"
7791  [(set_attr "type" "call")]
7792)
7793
7794(define_expand "sibcall_internal"
7795  [(parallel [(call (match_operand 0 "memory_operand" "")
7796		    (match_operand 1 "general_operand" ""))
7797	      (return)
7798	      (use (match_operand 2 "" ""))])])
7799
7800;; We may also be able to do sibcalls for Thumb, but it's much harder...
7801(define_expand "sibcall"
7802  [(parallel [(call (match_operand 0 "memory_operand" "")
7803		    (match_operand 1 "general_operand" ""))
7804	      (return)
7805	      (use (match_operand 2 "" ""))])]
7806  "TARGET_32BIT"
7807  "
7808  {
7809    rtx pat;
7810
7811    if ((!REG_P (XEXP (operands[0], 0))
7812	 && GET_CODE (XEXP (operands[0], 0)) != SYMBOL_REF)
7813	|| (GET_CODE (XEXP (operands[0], 0)) == SYMBOL_REF
7814	    && arm_is_long_call_p (SYMBOL_REF_DECL (XEXP (operands[0], 0)))))
7815     XEXP (operands[0], 0) = force_reg (SImode, XEXP (operands[0], 0));
7816
7817    if (operands[2] == NULL_RTX)
7818      operands[2] = const0_rtx;
7819
7820    pat = gen_sibcall_internal (operands[0], operands[1], operands[2]);
7821    arm_emit_call_insn (pat, operands[0], true);
7822    DONE;
7823  }"
7824)
7825
7826(define_expand "sibcall_value_internal"
7827  [(parallel [(set (match_operand 0 "" "")
7828		   (call (match_operand 1 "memory_operand" "")
7829			 (match_operand 2 "general_operand" "")))
7830	      (return)
7831	      (use (match_operand 3 "" ""))])])
7832
7833(define_expand "sibcall_value"
7834  [(parallel [(set (match_operand 0 "" "")
7835		   (call (match_operand 1 "memory_operand" "")
7836			 (match_operand 2 "general_operand" "")))
7837	      (return)
7838	      (use (match_operand 3 "" ""))])]
7839  "TARGET_32BIT"
7840  "
7841  {
7842    rtx pat;
7843
7844    if ((!REG_P (XEXP (operands[1], 0))
7845	 && GET_CODE (XEXP (operands[1], 0)) != SYMBOL_REF)
7846	|| (GET_CODE (XEXP (operands[1], 0)) == SYMBOL_REF
7847	    && arm_is_long_call_p (SYMBOL_REF_DECL (XEXP (operands[1], 0)))))
7848     XEXP (operands[1], 0) = force_reg (SImode, XEXP (operands[1], 0));
7849
7850    if (operands[3] == NULL_RTX)
7851      operands[3] = const0_rtx;
7852
7853    pat = gen_sibcall_value_internal (operands[0], operands[1],
7854                                      operands[2], operands[3]);
7855    arm_emit_call_insn (pat, operands[1], true);
7856    DONE;
7857  }"
7858)
7859
7860(define_insn "*sibcall_insn"
7861 [(call (mem:SI (match_operand:SI 0 "call_insn_operand" "Cs, US"))
7862	(match_operand 1 "" ""))
7863  (return)
7864  (use (match_operand 2 "" ""))]
7865  "TARGET_32BIT && SIBLING_CALL_P (insn)"
7866  "*
7867  if (which_alternative == 1)
7868    return NEED_PLT_RELOC ? \"b%?\\t%a0(PLT)\" : \"b%?\\t%a0\";
7869  else
7870    {
7871      if (arm_arch5 || arm_arch4t)
7872	return \"bx%?\\t%0\\t%@ indirect register sibling call\";
7873      else
7874	return \"mov%?\\t%|pc, %0\\t%@ indirect register sibling call\";
7875    }
7876  "
7877  [(set_attr "type" "call")]
7878)
7879
7880(define_insn "*sibcall_value_insn"
7881 [(set (match_operand 0 "" "")
7882       (call (mem:SI (match_operand:SI 1 "call_insn_operand" "Cs,US"))
7883	     (match_operand 2 "" "")))
7884  (return)
7885  (use (match_operand 3 "" ""))]
7886  "TARGET_32BIT && SIBLING_CALL_P (insn)"
7887  "*
7888  if (which_alternative == 1)
7889   return NEED_PLT_RELOC ? \"b%?\\t%a1(PLT)\" : \"b%?\\t%a1\";
7890  else
7891    {
7892      if (arm_arch5 || arm_arch4t)
7893	return \"bx%?\\t%1\";
7894      else
7895	return \"mov%?\\t%|pc, %1\\t@ indirect sibling call \";
7896    }
7897  "
7898  [(set_attr "type" "call")]
7899)
7900
7901(define_expand "<return_str>return"
7902  [(returns)]
7903  "(TARGET_ARM || (TARGET_THUMB2
7904                   && ARM_FUNC_TYPE (arm_current_func_type ()) == ARM_FT_NORMAL
7905                   && !IS_STACKALIGN (arm_current_func_type ())))
7906    <return_cond_false>"
7907  "
7908  {
7909    if (TARGET_THUMB2)
7910      {
7911        thumb2_expand_return (<return_simple_p>);
7912        DONE;
7913      }
7914  }
7915  "
7916)
7917
7918;; Often the return insn will be the same as loading from memory, so set attr
7919(define_insn "*arm_return"
7920  [(return)]
7921  "TARGET_ARM && USE_RETURN_INSN (FALSE)"
7922  "*
7923  {
7924    if (arm_ccfsm_state == 2)
7925      {
7926        arm_ccfsm_state += 2;
7927        return \"\";
7928      }
7929    return output_return_instruction (const_true_rtx, true, false, false);
7930  }"
7931  [(set_attr "type" "load1")
7932   (set_attr "length" "12")
7933   (set_attr "predicable" "yes")]
7934)
7935
7936(define_insn "*cond_<return_str>return"
7937  [(set (pc)
7938        (if_then_else (match_operator 0 "arm_comparison_operator"
7939		       [(match_operand 1 "cc_register" "") (const_int 0)])
7940                      (returns)
7941                      (pc)))]
7942  "TARGET_ARM  <return_cond_true>"
7943  "*
7944  {
7945    if (arm_ccfsm_state == 2)
7946      {
7947        arm_ccfsm_state += 2;
7948        return \"\";
7949      }
7950    return output_return_instruction (operands[0], true, false,
7951				      <return_simple_p>);
7952  }"
7953  [(set_attr "conds" "use")
7954   (set_attr "length" "12")
7955   (set_attr "type" "load1")]
7956)
7957
7958(define_insn "*cond_<return_str>return_inverted"
7959  [(set (pc)
7960        (if_then_else (match_operator 0 "arm_comparison_operator"
7961		       [(match_operand 1 "cc_register" "") (const_int 0)])
7962                      (pc)
7963		      (returns)))]
7964  "TARGET_ARM <return_cond_true>"
7965  "*
7966  {
7967    if (arm_ccfsm_state == 2)
7968      {
7969        arm_ccfsm_state += 2;
7970        return \"\";
7971      }
7972    return output_return_instruction (operands[0], true, true,
7973				      <return_simple_p>);
7974  }"
7975  [(set_attr "conds" "use")
7976   (set_attr "length" "12")
7977   (set_attr "type" "load1")]
7978)
7979
7980(define_insn "*arm_simple_return"
7981  [(simple_return)]
7982  "TARGET_ARM"
7983  "*
7984  {
7985    if (arm_ccfsm_state == 2)
7986      {
7987        arm_ccfsm_state += 2;
7988        return \"\";
7989      }
7990    return output_return_instruction (const_true_rtx, true, false, true);
7991  }"
7992  [(set_attr "type" "branch")
7993   (set_attr "length" "4")
7994   (set_attr "predicable" "yes")]
7995)
7996
7997;; Generate a sequence of instructions to determine if the processor is
7998;; in 26-bit or 32-bit mode, and return the appropriate return address
7999;; mask.
8000
8001(define_expand "return_addr_mask"
8002  [(set (match_dup 1)
8003      (compare:CC_NOOV (unspec [(const_int 0)] UNSPEC_CHECK_ARCH)
8004		       (const_int 0)))
8005   (set (match_operand:SI 0 "s_register_operand" "")
8006      (if_then_else:SI (eq (match_dup 1) (const_int 0))
8007		       (const_int -1)
8008		       (const_int 67108860)))] ; 0x03fffffc
8009  "TARGET_ARM"
8010  "
8011  operands[1] = gen_rtx_REG (CC_NOOVmode, CC_REGNUM);
8012  ")
8013
8014(define_insn "*check_arch2"
8015  [(set (match_operand:CC_NOOV 0 "cc_register" "")
8016      (compare:CC_NOOV (unspec [(const_int 0)] UNSPEC_CHECK_ARCH)
8017		       (const_int 0)))]
8018  "TARGET_ARM"
8019  "teq\\t%|r0, %|r0\;teq\\t%|pc, %|pc"
8020  [(set_attr "length" "8")
8021   (set_attr "conds" "set")
8022   (set_attr "type" "multiple")]
8023)
8024
8025;; Call subroutine returning any type.
8026
8027(define_expand "untyped_call"
8028  [(parallel [(call (match_operand 0 "" "")
8029		    (const_int 0))
8030	      (match_operand 1 "" "")
8031	      (match_operand 2 "" "")])]
8032  "TARGET_EITHER"
8033  "
8034  {
8035    int i;
8036    rtx par = gen_rtx_PARALLEL (VOIDmode,
8037				rtvec_alloc (XVECLEN (operands[2], 0)));
8038    rtx addr = gen_reg_rtx (Pmode);
8039    rtx mem;
8040    int size = 0;
8041
8042    emit_move_insn (addr, XEXP (operands[1], 0));
8043    mem = change_address (operands[1], BLKmode, addr);
8044
8045    for (i = 0; i < XVECLEN (operands[2], 0); i++)
8046      {
8047	rtx src = SET_SRC (XVECEXP (operands[2], 0, i));
8048
8049	/* Default code only uses r0 as a return value, but we could
8050	   be using anything up to 4 registers.  */
8051	if (REGNO (src) == R0_REGNUM)
8052	  src = gen_rtx_REG (TImode, R0_REGNUM);
8053
8054        XVECEXP (par, 0, i) = gen_rtx_EXPR_LIST (VOIDmode, src,
8055						 GEN_INT (size));
8056        size += GET_MODE_SIZE (GET_MODE (src));
8057      }
8058
8059    emit_call_insn (GEN_CALL_VALUE (par, operands[0], const0_rtx, NULL,
8060				    const0_rtx));
8061
8062    size = 0;
8063
8064    for (i = 0; i < XVECLEN (par, 0); i++)
8065      {
8066	HOST_WIDE_INT offset = 0;
8067	rtx reg = XEXP (XVECEXP (par, 0, i), 0);
8068
8069	if (size != 0)
8070	  emit_move_insn (addr, plus_constant (Pmode, addr, size));
8071
8072	mem = change_address (mem, GET_MODE (reg), NULL);
8073	if (REGNO (reg) == R0_REGNUM)
8074	  {
8075	    /* On thumb we have to use a write-back instruction.  */
8076	    emit_insn (arm_gen_store_multiple (arm_regs_in_sequence, 4, addr,
8077 		       TARGET_THUMB ? TRUE : FALSE, mem, &offset));
8078	    size = TARGET_ARM ? 16 : 0;
8079	  }
8080	else
8081	  {
8082	    emit_move_insn (mem, reg);
8083	    size = GET_MODE_SIZE (GET_MODE (reg));
8084	  }
8085      }
8086
8087    /* The optimizer does not know that the call sets the function value
8088       registers we stored in the result block.  We avoid problems by
8089       claiming that all hard registers are used and clobbered at this
8090       point.  */
8091    emit_insn (gen_blockage ());
8092
8093    DONE;
8094  }"
8095)
8096
8097(define_expand "untyped_return"
8098  [(match_operand:BLK 0 "memory_operand" "")
8099   (match_operand 1 "" "")]
8100  "TARGET_EITHER"
8101  "
8102  {
8103    int i;
8104    rtx addr = gen_reg_rtx (Pmode);
8105    rtx mem;
8106    int size = 0;
8107
8108    emit_move_insn (addr, XEXP (operands[0], 0));
8109    mem = change_address (operands[0], BLKmode, addr);
8110
8111    for (i = 0; i < XVECLEN (operands[1], 0); i++)
8112      {
8113	HOST_WIDE_INT offset = 0;
8114	rtx reg = SET_DEST (XVECEXP (operands[1], 0, i));
8115
8116	if (size != 0)
8117	  emit_move_insn (addr, plus_constant (Pmode, addr, size));
8118
8119	mem = change_address (mem, GET_MODE (reg), NULL);
8120	if (REGNO (reg) == R0_REGNUM)
8121	  {
8122	    /* On thumb we have to use a write-back instruction.  */
8123	    emit_insn (arm_gen_load_multiple (arm_regs_in_sequence, 4, addr,
8124 		       TARGET_THUMB ? TRUE : FALSE, mem, &offset));
8125	    size = TARGET_ARM ? 16 : 0;
8126	  }
8127	else
8128	  {
8129	    emit_move_insn (reg, mem);
8130	    size = GET_MODE_SIZE (GET_MODE (reg));
8131	  }
8132      }
8133
8134    /* Emit USE insns before the return.  */
8135    for (i = 0; i < XVECLEN (operands[1], 0); i++)
8136      emit_use (SET_DEST (XVECEXP (operands[1], 0, i)));
8137
8138    /* Construct the return.  */
8139    expand_naked_return ();
8140
8141    DONE;
8142  }"
8143)
8144
8145;; UNSPEC_VOLATILE is considered to use and clobber all hard registers and
8146;; all of memory.  This blocks insns from being moved across this point.
8147
8148(define_insn "blockage"
8149  [(unspec_volatile [(const_int 0)] VUNSPEC_BLOCKAGE)]
8150  "TARGET_EITHER"
8151  ""
8152  [(set_attr "length" "0")
8153   (set_attr "type" "block")]
8154)
8155
8156(define_expand "casesi"
8157  [(match_operand:SI 0 "s_register_operand" "")	; index to jump on
8158   (match_operand:SI 1 "const_int_operand" "")	; lower bound
8159   (match_operand:SI 2 "const_int_operand" "")	; total range
8160   (match_operand:SI 3 "" "")			; table label
8161   (match_operand:SI 4 "" "")]			; Out of range label
8162  "TARGET_32BIT || optimize_size || flag_pic"
8163  "
8164  {
8165    enum insn_code code;
8166    if (operands[1] != const0_rtx)
8167      {
8168	rtx reg = gen_reg_rtx (SImode);
8169
8170	emit_insn (gen_addsi3 (reg, operands[0],
8171			       gen_int_mode (-INTVAL (operands[1]),
8172			       		     SImode)));
8173	operands[0] = reg;
8174      }
8175
8176    if (TARGET_ARM)
8177      code = CODE_FOR_arm_casesi_internal;
8178    else if (TARGET_THUMB1)
8179      code = CODE_FOR_thumb1_casesi_internal_pic;
8180    else if (flag_pic)
8181      code = CODE_FOR_thumb2_casesi_internal_pic;
8182    else
8183      code = CODE_FOR_thumb2_casesi_internal;
8184
8185    if (!insn_data[(int) code].operand[1].predicate(operands[2], SImode))
8186      operands[2] = force_reg (SImode, operands[2]);
8187
8188    emit_jump_insn (GEN_FCN ((int) code) (operands[0], operands[2],
8189					  operands[3], operands[4]));
8190    DONE;
8191  }"
8192)
8193
8194;; The USE in this pattern is needed to tell flow analysis that this is
8195;; a CASESI insn.  It has no other purpose.
8196(define_insn "arm_casesi_internal"
8197  [(parallel [(set (pc)
8198	       (if_then_else
8199		(leu (match_operand:SI 0 "s_register_operand" "r")
8200		     (match_operand:SI 1 "arm_rhs_operand" "rI"))
8201		(mem:SI (plus:SI (mult:SI (match_dup 0) (const_int 4))
8202				 (label_ref (match_operand 2 "" ""))))
8203		(label_ref (match_operand 3 "" ""))))
8204	      (clobber (reg:CC CC_REGNUM))
8205	      (use (label_ref (match_dup 2)))])]
8206  "TARGET_ARM"
8207  "*
8208    if (flag_pic)
8209      return \"cmp\\t%0, %1\;addls\\t%|pc, %|pc, %0, asl #2\;b\\t%l3\";
8210    return   \"cmp\\t%0, %1\;ldrls\\t%|pc, [%|pc, %0, asl #2]\;b\\t%l3\";
8211  "
8212  [(set_attr "conds" "clob")
8213   (set_attr "length" "12")
8214   (set_attr "type" "multiple")]
8215)
8216
8217(define_expand "indirect_jump"
8218  [(set (pc)
8219	(match_operand:SI 0 "s_register_operand" ""))]
8220  "TARGET_EITHER"
8221  "
8222  /* Thumb-2 doesn't have mov pc, reg.  Explicitly set the low bit of the
8223     address and use bx.  */
8224  if (TARGET_THUMB2)
8225    {
8226      rtx tmp;
8227      tmp = gen_reg_rtx (SImode);
8228      emit_insn (gen_iorsi3 (tmp, operands[0], GEN_INT(1)));
8229      operands[0] = tmp;
8230    }
8231  "
8232)
8233
8234;; NB Never uses BX.
8235(define_insn "*arm_indirect_jump"
8236  [(set (pc)
8237	(match_operand:SI 0 "s_register_operand" "r"))]
8238  "TARGET_ARM"
8239  "mov%?\\t%|pc, %0\\t%@ indirect register jump"
8240  [(set_attr "predicable" "yes")
8241   (set_attr "type" "branch")]
8242)
8243
8244(define_insn "*load_indirect_jump"
8245  [(set (pc)
8246	(match_operand:SI 0 "memory_operand" "m"))]
8247  "TARGET_ARM"
8248  "ldr%?\\t%|pc, %0\\t%@ indirect memory jump"
8249  [(set_attr "type" "load1")
8250   (set_attr "pool_range" "4096")
8251   (set_attr "neg_pool_range" "4084")
8252   (set_attr "predicable" "yes")]
8253)
8254
8255
8256;; Misc insns
8257
8258(define_insn "nop"
8259  [(const_int 0)]
8260  "TARGET_EITHER"
8261  "*
8262  if (TARGET_UNIFIED_ASM)
8263    return \"nop\";
8264  if (TARGET_ARM)
8265    return \"mov%?\\t%|r0, %|r0\\t%@ nop\";
8266  return  \"mov\\tr8, r8\";
8267  "
8268  [(set (attr "length")
8269	(if_then_else (eq_attr "is_thumb" "yes")
8270		      (const_int 2)
8271		      (const_int 4)))
8272   (set_attr "type" "mov_reg")]
8273)
8274
8275(define_insn "trap"
8276  [(trap_if (const_int 1) (const_int 0))]
8277  ""
8278  "*
8279  if (TARGET_ARM)
8280    return \".inst\\t0xe7f000f0\";
8281  else
8282    return \".inst\\t0xdeff\";
8283  "
8284  [(set (attr "length")
8285	(if_then_else (eq_attr "is_thumb" "yes")
8286		      (const_int 2)
8287		      (const_int 4)))
8288   (set_attr "type" "trap")
8289   (set_attr "conds" "unconditional")]
8290)
8291
8292
8293;; Patterns to allow combination of arithmetic, cond code and shifts
8294
8295(define_insn "*<arith_shift_insn>_multsi"
8296  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
8297	(shiftable_ops:SI
8298	 (mult:SI (match_operand:SI 2 "s_register_operand" "r,r")
8299		  (match_operand:SI 3 "power_of_two_operand" ""))
8300	 (match_operand:SI 1 "s_register_operand" "rk,<t2_binop0>")))]
8301  "TARGET_32BIT"
8302  "<arith_shift_insn>%?\\t%0, %1, %2, lsl %b3"
8303  [(set_attr "predicable" "yes")
8304   (set_attr "predicable_short_it" "no")
8305   (set_attr "shift" "2")
8306   (set_attr "arch" "a,t2")
8307   (set_attr "type" "alu_shift_imm")])
8308
8309(define_insn "*<arith_shift_insn>_shiftsi"
8310  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
8311	(shiftable_ops:SI
8312	 (match_operator:SI 2 "shift_nomul_operator"
8313	  [(match_operand:SI 3 "s_register_operand" "r,r,r")
8314	   (match_operand:SI 4 "shift_amount_operand" "M,M,r")])
8315	 (match_operand:SI 1 "s_register_operand" "rk,<t2_binop0>,rk")))]
8316  "TARGET_32BIT && GET_CODE (operands[2]) != MULT"
8317  "<arith_shift_insn>%?\\t%0, %1, %3%S2"
8318  [(set_attr "predicable" "yes")
8319   (set_attr "predicable_short_it" "no")
8320   (set_attr "shift" "3")
8321   (set_attr "arch" "a,t2,a")
8322   (set_attr "type" "alu_shift_imm,alu_shift_imm,alu_shift_reg")])
8323
8324(define_split
8325  [(set (match_operand:SI 0 "s_register_operand" "")
8326	(match_operator:SI 1 "shiftable_operator"
8327	 [(match_operator:SI 2 "shiftable_operator"
8328	   [(match_operator:SI 3 "shift_operator"
8329	     [(match_operand:SI 4 "s_register_operand" "")
8330	      (match_operand:SI 5 "reg_or_int_operand" "")])
8331	    (match_operand:SI 6 "s_register_operand" "")])
8332	  (match_operand:SI 7 "arm_rhs_operand" "")]))
8333   (clobber (match_operand:SI 8 "s_register_operand" ""))]
8334  "TARGET_32BIT"
8335  [(set (match_dup 8)
8336	(match_op_dup 2 [(match_op_dup 3 [(match_dup 4) (match_dup 5)])
8337			 (match_dup 6)]))
8338   (set (match_dup 0)
8339	(match_op_dup 1 [(match_dup 8) (match_dup 7)]))]
8340  "")
8341
8342(define_insn "*arith_shiftsi_compare0"
8343  [(set (reg:CC_NOOV CC_REGNUM)
8344        (compare:CC_NOOV
8345	 (match_operator:SI 1 "shiftable_operator"
8346	  [(match_operator:SI 3 "shift_operator"
8347	    [(match_operand:SI 4 "s_register_operand" "r,r")
8348	     (match_operand:SI 5 "shift_amount_operand" "M,r")])
8349	   (match_operand:SI 2 "s_register_operand" "r,r")])
8350	 (const_int 0)))
8351   (set (match_operand:SI 0 "s_register_operand" "=r,r")
8352	(match_op_dup 1 [(match_op_dup 3 [(match_dup 4) (match_dup 5)])
8353			 (match_dup 2)]))]
8354  "TARGET_32BIT"
8355  "%i1%.\\t%0, %2, %4%S3"
8356  [(set_attr "conds" "set")
8357   (set_attr "shift" "4")
8358   (set_attr "arch" "32,a")
8359   (set_attr "type" "alus_shift_imm,alus_shift_reg")])
8360
8361(define_insn "*arith_shiftsi_compare0_scratch"
8362  [(set (reg:CC_NOOV CC_REGNUM)
8363        (compare:CC_NOOV
8364	 (match_operator:SI 1 "shiftable_operator"
8365	  [(match_operator:SI 3 "shift_operator"
8366	    [(match_operand:SI 4 "s_register_operand" "r,r")
8367	     (match_operand:SI 5 "shift_amount_operand" "M,r")])
8368	   (match_operand:SI 2 "s_register_operand" "r,r")])
8369	 (const_int 0)))
8370   (clobber (match_scratch:SI 0 "=r,r"))]
8371  "TARGET_32BIT"
8372  "%i1%.\\t%0, %2, %4%S3"
8373  [(set_attr "conds" "set")
8374   (set_attr "shift" "4")
8375   (set_attr "arch" "32,a")
8376   (set_attr "type" "alus_shift_imm,alus_shift_reg")])
8377
8378(define_insn "*sub_shiftsi"
8379  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
8380	(minus:SI (match_operand:SI 1 "s_register_operand" "r,r")
8381		  (match_operator:SI 2 "shift_operator"
8382		   [(match_operand:SI 3 "s_register_operand" "r,r")
8383		    (match_operand:SI 4 "shift_amount_operand" "M,r")])))]
8384  "TARGET_32BIT"
8385  "sub%?\\t%0, %1, %3%S2"
8386  [(set_attr "predicable" "yes")
8387   (set_attr "shift" "3")
8388   (set_attr "arch" "32,a")
8389   (set_attr "type" "alus_shift_imm,alus_shift_reg")])
8390
8391(define_insn "*sub_shiftsi_compare0"
8392  [(set (reg:CC_NOOV CC_REGNUM)
8393	(compare:CC_NOOV
8394	 (minus:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
8395		   (match_operator:SI 2 "shift_operator"
8396		    [(match_operand:SI 3 "s_register_operand" "r,r,r")
8397		     (match_operand:SI 4 "shift_amount_operand" "M,r,M")]))
8398	 (const_int 0)))
8399   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
8400	(minus:SI (match_dup 1)
8401		  (match_op_dup 2 [(match_dup 3) (match_dup 4)])))]
8402  "TARGET_32BIT"
8403  "sub%.\\t%0, %1, %3%S2"
8404  [(set_attr "conds" "set")
8405   (set_attr "shift" "3")
8406   (set_attr "arch" "32,a,a")
8407   (set_attr "type" "alus_shift_imm,alus_shift_reg,alus_shift_imm")])
8408
8409(define_insn "*sub_shiftsi_compare0_scratch"
8410  [(set (reg:CC_NOOV CC_REGNUM)
8411	(compare:CC_NOOV
8412	 (minus:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
8413		   (match_operator:SI 2 "shift_operator"
8414		    [(match_operand:SI 3 "s_register_operand" "r,r,r")
8415		     (match_operand:SI 4 "shift_amount_operand" "M,r,M")]))
8416	 (const_int 0)))
8417   (clobber (match_scratch:SI 0 "=r,r,r"))]
8418  "TARGET_32BIT"
8419  "sub%.\\t%0, %1, %3%S2"
8420  [(set_attr "conds" "set")
8421   (set_attr "shift" "3")
8422   (set_attr "arch" "32,a,a")
8423   (set_attr "type" "alus_shift_imm,alus_shift_reg,alus_shift_imm")])
8424
8425
8426(define_insn_and_split "*and_scc"
8427  [(set (match_operand:SI 0 "s_register_operand" "=r")
8428	(and:SI (match_operator:SI 1 "arm_comparison_operator"
8429		 [(match_operand 2 "cc_register" "") (const_int 0)])
8430		(match_operand:SI 3 "s_register_operand" "r")))]
8431  "TARGET_ARM"
8432  "#"   ; "mov%D1\\t%0, #0\;and%d1\\t%0, %3, #1"
8433  "&& reload_completed"
8434  [(cond_exec (match_dup 5) (set (match_dup 0) (const_int 0)))
8435   (cond_exec (match_dup 4) (set (match_dup 0)
8436                                 (and:SI (match_dup 3) (const_int 1))))]
8437  {
8438    machine_mode mode = GET_MODE (operands[2]);
8439    enum rtx_code rc = GET_CODE (operands[1]);
8440
8441    /* Note that operands[4] is the same as operands[1],
8442       but with VOIDmode as the result. */
8443    operands[4] = gen_rtx_fmt_ee (rc, VOIDmode, operands[2], const0_rtx);
8444    if (mode == CCFPmode || mode == CCFPEmode)
8445      rc = reverse_condition_maybe_unordered (rc);
8446    else
8447      rc = reverse_condition (rc);
8448    operands[5] = gen_rtx_fmt_ee (rc, VOIDmode, operands[2], const0_rtx);
8449  }
8450  [(set_attr "conds" "use")
8451   (set_attr "type" "multiple")
8452   (set_attr "length" "8")]
8453)
8454
8455(define_insn_and_split "*ior_scc"
8456  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
8457	(ior:SI (match_operator:SI 1 "arm_comparison_operator"
8458		 [(match_operand 2 "cc_register" "") (const_int 0)])
8459		(match_operand:SI 3 "s_register_operand" "0,?r")))]
8460  "TARGET_ARM"
8461  "@
8462   orr%d1\\t%0, %3, #1
8463   #"
8464  "&& reload_completed
8465   && REGNO (operands [0]) != REGNO (operands[3])"
8466  ;; && which_alternative == 1
8467  ; mov%D1\\t%0, %3\;orr%d1\\t%0, %3, #1
8468  [(cond_exec (match_dup 5) (set (match_dup 0) (match_dup 3)))
8469   (cond_exec (match_dup 4) (set (match_dup 0)
8470                                 (ior:SI (match_dup 3) (const_int 1))))]
8471  {
8472    machine_mode mode = GET_MODE (operands[2]);
8473    enum rtx_code rc = GET_CODE (operands[1]);
8474
8475    /* Note that operands[4] is the same as operands[1],
8476       but with VOIDmode as the result. */
8477    operands[4] = gen_rtx_fmt_ee (rc, VOIDmode, operands[2], const0_rtx);
8478    if (mode == CCFPmode || mode == CCFPEmode)
8479      rc = reverse_condition_maybe_unordered (rc);
8480    else
8481      rc = reverse_condition (rc);
8482    operands[5] = gen_rtx_fmt_ee (rc, VOIDmode, operands[2], const0_rtx);
8483  }
8484  [(set_attr "conds" "use")
8485   (set_attr "length" "4,8")
8486   (set_attr "type" "logic_imm,multiple")]
8487)
8488
8489; A series of splitters for the compare_scc pattern below.  Note that
8490; order is important.
8491(define_split
8492  [(set (match_operand:SI 0 "s_register_operand" "")
8493	(lt:SI (match_operand:SI 1 "s_register_operand" "")
8494	       (const_int 0)))
8495   (clobber (reg:CC CC_REGNUM))]
8496  "TARGET_32BIT && reload_completed"
8497  [(set (match_dup 0) (lshiftrt:SI (match_dup 1) (const_int 31)))])
8498
8499(define_split
8500  [(set (match_operand:SI 0 "s_register_operand" "")
8501	(ge:SI (match_operand:SI 1 "s_register_operand" "")
8502	       (const_int 0)))
8503   (clobber (reg:CC CC_REGNUM))]
8504  "TARGET_32BIT && reload_completed"
8505  [(set (match_dup 0) (not:SI (match_dup 1)))
8506   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 31)))])
8507
8508(define_split
8509  [(set (match_operand:SI 0 "s_register_operand" "")
8510	(eq:SI (match_operand:SI 1 "s_register_operand" "")
8511	       (const_int 0)))
8512   (clobber (reg:CC CC_REGNUM))]
8513  "arm_arch5 && TARGET_32BIT"
8514  [(set (match_dup 0) (clz:SI (match_dup 1)))
8515   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 5)))]
8516)
8517
8518(define_split
8519  [(set (match_operand:SI 0 "s_register_operand" "")
8520	(eq:SI (match_operand:SI 1 "s_register_operand" "")
8521	       (const_int 0)))
8522   (clobber (reg:CC CC_REGNUM))]
8523  "TARGET_32BIT && reload_completed"
8524  [(parallel
8525    [(set (reg:CC CC_REGNUM)
8526	  (compare:CC (const_int 1) (match_dup 1)))
8527     (set (match_dup 0)
8528	  (minus:SI (const_int 1) (match_dup 1)))])
8529   (cond_exec (ltu:CC (reg:CC CC_REGNUM) (const_int 0))
8530	      (set (match_dup 0) (const_int 0)))])
8531
8532(define_split
8533  [(set (match_operand:SI 0 "s_register_operand" "")
8534	(ne:SI (match_operand:SI 1 "s_register_operand" "")
8535	       (match_operand:SI 2 "const_int_operand" "")))
8536   (clobber (reg:CC CC_REGNUM))]
8537  "TARGET_32BIT && reload_completed"
8538  [(parallel
8539    [(set (reg:CC CC_REGNUM)
8540	  (compare:CC (match_dup 1) (match_dup 2)))
8541     (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 3)))])
8542   (cond_exec (ne:CC (reg:CC CC_REGNUM) (const_int 0))
8543	      (set (match_dup 0) (const_int 1)))]
8544{
8545  operands[3] = GEN_INT (-INTVAL (operands[2]));
8546})
8547
8548(define_split
8549  [(set (match_operand:SI 0 "s_register_operand" "")
8550	(ne:SI (match_operand:SI 1 "s_register_operand" "")
8551	       (match_operand:SI 2 "arm_add_operand" "")))
8552   (clobber (reg:CC CC_REGNUM))]
8553  "TARGET_32BIT && reload_completed"
8554  [(parallel
8555    [(set (reg:CC_NOOV CC_REGNUM)
8556	  (compare:CC_NOOV (minus:SI (match_dup 1) (match_dup 2))
8557			   (const_int 0)))
8558     (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
8559   (cond_exec (ne:CC_NOOV (reg:CC_NOOV CC_REGNUM) (const_int 0))
8560	      (set (match_dup 0) (const_int 1)))])
8561
8562(define_insn_and_split "*compare_scc"
8563  [(set (match_operand:SI 0 "s_register_operand" "=Ts,Ts")
8564	(match_operator:SI 1 "arm_comparison_operator"
8565	 [(match_operand:SI 2 "s_register_operand" "r,r")
8566	  (match_operand:SI 3 "arm_add_operand" "rI,L")]))
8567   (clobber (reg:CC CC_REGNUM))]
8568  "TARGET_32BIT"
8569  "#"
8570  "&& reload_completed"
8571  [(set (reg:CC CC_REGNUM) (compare:CC (match_dup 2) (match_dup 3)))
8572   (cond_exec (match_dup 4) (set (match_dup 0) (const_int 0)))
8573   (cond_exec (match_dup 5) (set (match_dup 0) (const_int 1)))]
8574{
8575  rtx tmp1;
8576  machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
8577					   operands[2], operands[3]);
8578  enum rtx_code rc = GET_CODE (operands[1]);
8579
8580  tmp1 = gen_rtx_REG (mode, CC_REGNUM);
8581
8582  operands[5] = gen_rtx_fmt_ee (rc, VOIDmode, tmp1, const0_rtx);
8583  if (mode == CCFPmode || mode == CCFPEmode)
8584    rc = reverse_condition_maybe_unordered (rc);
8585  else
8586    rc = reverse_condition (rc);
8587  operands[4] = gen_rtx_fmt_ee (rc, VOIDmode, tmp1, const0_rtx);
8588}
8589  [(set_attr "type" "multiple")]
8590)
8591
8592;; Attempt to improve the sequence generated by the compare_scc splitters
8593;; not to use conditional execution.
8594
8595;; Rd = (eq (reg1) (const_int0))  // ARMv5
8596;;	clz Rd, reg1
8597;;	lsr Rd, Rd, #5
8598(define_peephole2
8599  [(set (reg:CC CC_REGNUM)
8600	(compare:CC (match_operand:SI 1 "register_operand" "")
8601		    (const_int 0)))
8602   (cond_exec (ne (reg:CC CC_REGNUM) (const_int 0))
8603	      (set (match_operand:SI 0 "register_operand" "") (const_int 0)))
8604   (cond_exec (eq (reg:CC CC_REGNUM) (const_int 0))
8605	      (set (match_dup 0) (const_int 1)))]
8606  "arm_arch5 && TARGET_32BIT && peep2_regno_dead_p (3, CC_REGNUM)"
8607  [(set (match_dup 0) (clz:SI (match_dup 1)))
8608   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 5)))]
8609)
8610
8611;; Rd = (eq (reg1) (const_int0))  // !ARMv5
8612;;	negs Rd, reg1
8613;;	adc  Rd, Rd, reg1
8614(define_peephole2
8615  [(set (reg:CC CC_REGNUM)
8616	(compare:CC (match_operand:SI 1 "register_operand" "")
8617		    (const_int 0)))
8618   (cond_exec (ne (reg:CC CC_REGNUM) (const_int 0))
8619	      (set (match_operand:SI 0 "register_operand" "") (const_int 0)))
8620   (cond_exec (eq (reg:CC CC_REGNUM) (const_int 0))
8621	      (set (match_dup 0) (const_int 1)))
8622   (match_scratch:SI 2 "r")]
8623  "TARGET_32BIT && peep2_regno_dead_p (3, CC_REGNUM)"
8624  [(parallel
8625    [(set (reg:CC CC_REGNUM)
8626	  (compare:CC (const_int 0) (match_dup 1)))
8627     (set (match_dup 2) (minus:SI (const_int 0) (match_dup 1)))])
8628   (set (match_dup 0)
8629	(plus:SI (plus:SI (match_dup 1) (match_dup 2))
8630		 (geu:SI (reg:CC CC_REGNUM) (const_int 0))))]
8631)
8632
8633;; Rd = (eq (reg1) (reg2/imm))	// ARMv5 and optimising for speed.
8634;;	sub  Rd, Reg1, reg2
8635;;	clz  Rd, Rd
8636;;	lsr  Rd, Rd, #5
8637(define_peephole2
8638  [(set (reg:CC CC_REGNUM)
8639	(compare:CC (match_operand:SI 1 "register_operand" "")
8640		    (match_operand:SI 2 "arm_rhs_operand" "")))
8641   (cond_exec (ne (reg:CC CC_REGNUM) (const_int 0))
8642	      (set (match_operand:SI 0 "register_operand" "") (const_int 0)))
8643   (cond_exec (eq (reg:CC CC_REGNUM) (const_int 0))
8644	      (set (match_dup 0) (const_int 1)))]
8645  "arm_arch5 && TARGET_32BIT && peep2_regno_dead_p (3, CC_REGNUM)
8646  && !(TARGET_THUMB2 && optimize_insn_for_size_p ())"
8647  [(set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))
8648   (set (match_dup 0) (clz:SI (match_dup 0)))
8649   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 5)))]
8650)
8651
8652
8653;; Rd = (eq (reg1) (reg2))	// ! ARMv5 or optimising for size.
8654;;	sub  T1, Reg1, reg2
8655;;	negs Rd, T1
8656;;	adc  Rd, Rd, T1
8657(define_peephole2
8658  [(set (reg:CC CC_REGNUM)
8659	(compare:CC (match_operand:SI 1 "register_operand" "")
8660		    (match_operand:SI 2 "arm_rhs_operand" "")))
8661   (cond_exec (ne (reg:CC CC_REGNUM) (const_int 0))
8662	      (set (match_operand:SI 0 "register_operand" "") (const_int 0)))
8663   (cond_exec (eq (reg:CC CC_REGNUM) (const_int 0))
8664	      (set (match_dup 0) (const_int 1)))
8665   (match_scratch:SI 3 "r")]
8666  "TARGET_32BIT && peep2_regno_dead_p (3, CC_REGNUM)"
8667  [(set (match_dup 3) (match_dup 4))
8668   (parallel
8669    [(set (reg:CC CC_REGNUM)
8670	  (compare:CC (const_int 0) (match_dup 3)))
8671     (set (match_dup 0) (minus:SI (const_int 0) (match_dup 3)))])
8672   (set (match_dup 0)
8673	(plus:SI (plus:SI (match_dup 0) (match_dup 3))
8674		 (geu:SI (reg:CC CC_REGNUM) (const_int 0))))]
8675  "
8676  if (CONST_INT_P (operands[2]))
8677    operands[4] = plus_constant (SImode, operands[1], -INTVAL (operands[2]));
8678  else
8679    operands[4] = gen_rtx_MINUS (SImode, operands[1], operands[2]);
8680  ")
8681
8682(define_insn "*cond_move"
8683  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
8684	(if_then_else:SI (match_operator 3 "equality_operator"
8685			  [(match_operator 4 "arm_comparison_operator"
8686			    [(match_operand 5 "cc_register" "") (const_int 0)])
8687			   (const_int 0)])
8688			 (match_operand:SI 1 "arm_rhs_operand" "0,rI,?rI")
8689			 (match_operand:SI 2 "arm_rhs_operand" "rI,0,rI")))]
8690  "TARGET_ARM"
8691  "*
8692    if (GET_CODE (operands[3]) == NE)
8693      {
8694        if (which_alternative != 1)
8695	  output_asm_insn (\"mov%D4\\t%0, %2\", operands);
8696        if (which_alternative != 0)
8697	  output_asm_insn (\"mov%d4\\t%0, %1\", operands);
8698        return \"\";
8699      }
8700    if (which_alternative != 0)
8701      output_asm_insn (\"mov%D4\\t%0, %1\", operands);
8702    if (which_alternative != 1)
8703      output_asm_insn (\"mov%d4\\t%0, %2\", operands);
8704    return \"\";
8705  "
8706  [(set_attr "conds" "use")
8707   (set_attr "type" "mov_reg,mov_reg,multiple")
8708   (set_attr "length" "4,4,8")]
8709)
8710
8711(define_insn "*cond_arith"
8712  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
8713        (match_operator:SI 5 "shiftable_operator" 
8714	 [(match_operator:SI 4 "arm_comparison_operator"
8715           [(match_operand:SI 2 "s_register_operand" "r,r")
8716	    (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])
8717          (match_operand:SI 1 "s_register_operand" "0,?r")]))
8718   (clobber (reg:CC CC_REGNUM))]
8719  "TARGET_ARM"
8720  "*
8721    if (GET_CODE (operands[4]) == LT && operands[3] == const0_rtx)
8722      return \"%i5\\t%0, %1, %2, lsr #31\";
8723
8724    output_asm_insn (\"cmp\\t%2, %3\", operands);
8725    if (GET_CODE (operands[5]) == AND)
8726      output_asm_insn (\"mov%D4\\t%0, #0\", operands);
8727    else if (GET_CODE (operands[5]) == MINUS)
8728      output_asm_insn (\"rsb%D4\\t%0, %1, #0\", operands);
8729    else if (which_alternative != 0)
8730      output_asm_insn (\"mov%D4\\t%0, %1\", operands);
8731    return \"%i5%d4\\t%0, %1, #1\";
8732  "
8733  [(set_attr "conds" "clob")
8734   (set_attr "length" "12")
8735   (set_attr "type" "multiple")]
8736)
8737
8738(define_insn "*cond_sub"
8739  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
8740        (minus:SI (match_operand:SI 1 "s_register_operand" "0,?r")
8741		  (match_operator:SI 4 "arm_comparison_operator"
8742                   [(match_operand:SI 2 "s_register_operand" "r,r")
8743		    (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])))
8744   (clobber (reg:CC CC_REGNUM))]
8745  "TARGET_ARM"
8746  "*
8747    output_asm_insn (\"cmp\\t%2, %3\", operands);
8748    if (which_alternative != 0)
8749      output_asm_insn (\"mov%D4\\t%0, %1\", operands);
8750    return \"sub%d4\\t%0, %1, #1\";
8751  "
8752  [(set_attr "conds" "clob")
8753   (set_attr "length" "8,12")
8754   (set_attr "type" "multiple")]
8755)
8756
8757(define_insn "*cmp_ite0"
8758  [(set (match_operand 6 "dominant_cc_register" "")
8759	(compare
8760	 (if_then_else:SI
8761	  (match_operator 4 "arm_comparison_operator"
8762	   [(match_operand:SI 0 "s_register_operand"
8763	        "l,l,l,r,r,r,r,r,r")
8764	    (match_operand:SI 1 "arm_add_operand"
8765	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
8766	  (match_operator:SI 5 "arm_comparison_operator"
8767	   [(match_operand:SI 2 "s_register_operand"
8768	        "l,r,r,l,l,r,r,r,r")
8769	    (match_operand:SI 3 "arm_add_operand"
8770	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")])
8771	  (const_int 0))
8772	 (const_int 0)))]
8773  "TARGET_32BIT"
8774  "*
8775  {
8776    static const char * const cmp1[NUM_OF_COND_CMP][2] =
8777    {
8778      {\"cmp%d5\\t%0, %1\",
8779       \"cmp%d4\\t%2, %3\"},
8780      {\"cmn%d5\\t%0, #%n1\",
8781       \"cmp%d4\\t%2, %3\"},
8782      {\"cmp%d5\\t%0, %1\",
8783       \"cmn%d4\\t%2, #%n3\"},
8784      {\"cmn%d5\\t%0, #%n1\",
8785       \"cmn%d4\\t%2, #%n3\"}
8786    };
8787    static const char * const cmp2[NUM_OF_COND_CMP][2] =
8788    {
8789      {\"cmp\\t%2, %3\",
8790       \"cmp\\t%0, %1\"},
8791      {\"cmp\\t%2, %3\",
8792       \"cmn\\t%0, #%n1\"},
8793      {\"cmn\\t%2, #%n3\",
8794       \"cmp\\t%0, %1\"},
8795      {\"cmn\\t%2, #%n3\",
8796       \"cmn\\t%0, #%n1\"}
8797    };
8798    static const char * const ite[2] =
8799    {
8800      \"it\\t%d5\",
8801      \"it\\t%d4\"
8802    };
8803    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
8804                                   CMP_CMP, CMN_CMP, CMP_CMP,
8805                                   CMN_CMP, CMP_CMN, CMN_CMN};
8806    int swap =
8807      comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
8808
8809    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
8810    if (TARGET_THUMB2) {
8811      output_asm_insn (ite[swap], operands);
8812    }
8813    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
8814    return \"\";
8815  }"
8816  [(set_attr "conds" "set")
8817   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
8818   (set_attr "type" "multiple")
8819   (set_attr_alternative "length"
8820      [(const_int 6)
8821       (const_int 8)
8822       (const_int 8)
8823       (const_int 8)
8824       (const_int 8)
8825       (if_then_else (eq_attr "is_thumb" "no")
8826           (const_int 8)
8827           (const_int 10))
8828       (if_then_else (eq_attr "is_thumb" "no")
8829           (const_int 8)
8830           (const_int 10))
8831       (if_then_else (eq_attr "is_thumb" "no")
8832           (const_int 8)
8833           (const_int 10))
8834       (if_then_else (eq_attr "is_thumb" "no")
8835           (const_int 8)
8836           (const_int 10))])]
8837)
8838
8839(define_insn "*cmp_ite1"
8840  [(set (match_operand 6 "dominant_cc_register" "")
8841	(compare
8842	 (if_then_else:SI
8843	  (match_operator 4 "arm_comparison_operator"
8844	   [(match_operand:SI 0 "s_register_operand"
8845	        "l,l,l,r,r,r,r,r,r")
8846	    (match_operand:SI 1 "arm_add_operand"
8847	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
8848	  (match_operator:SI 5 "arm_comparison_operator"
8849	   [(match_operand:SI 2 "s_register_operand"
8850	        "l,r,r,l,l,r,r,r,r")
8851	    (match_operand:SI 3 "arm_add_operand"
8852	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")])
8853	  (const_int 1))
8854	 (const_int 0)))]
8855  "TARGET_32BIT"
8856  "*
8857  {
8858    static const char * const cmp1[NUM_OF_COND_CMP][2] =
8859    {
8860      {\"cmp\\t%0, %1\",
8861       \"cmp\\t%2, %3\"},
8862      {\"cmn\\t%0, #%n1\",
8863       \"cmp\\t%2, %3\"},
8864      {\"cmp\\t%0, %1\",
8865       \"cmn\\t%2, #%n3\"},
8866      {\"cmn\\t%0, #%n1\",
8867       \"cmn\\t%2, #%n3\"}
8868    };
8869    static const char * const cmp2[NUM_OF_COND_CMP][2] =
8870    {
8871      {\"cmp%d4\\t%2, %3\",
8872       \"cmp%D5\\t%0, %1\"},
8873      {\"cmp%d4\\t%2, %3\",
8874       \"cmn%D5\\t%0, #%n1\"},
8875      {\"cmn%d4\\t%2, #%n3\",
8876       \"cmp%D5\\t%0, %1\"},
8877      {\"cmn%d4\\t%2, #%n3\",
8878       \"cmn%D5\\t%0, #%n1\"}
8879    };
8880    static const char * const ite[2] =
8881    {
8882      \"it\\t%d4\",
8883      \"it\\t%D5\"
8884    };
8885    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
8886                                   CMP_CMP, CMN_CMP, CMP_CMP,
8887                                   CMN_CMP, CMP_CMN, CMN_CMN};
8888    int swap =
8889      comparison_dominates_p (GET_CODE (operands[5]),
8890			      reverse_condition (GET_CODE (operands[4])));
8891
8892    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
8893    if (TARGET_THUMB2) {
8894      output_asm_insn (ite[swap], operands);
8895    }
8896    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
8897    return \"\";
8898  }"
8899  [(set_attr "conds" "set")
8900   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
8901   (set_attr_alternative "length"
8902      [(const_int 6)
8903       (const_int 8)
8904       (const_int 8)
8905       (const_int 8)
8906       (const_int 8)
8907       (if_then_else (eq_attr "is_thumb" "no")
8908           (const_int 8)
8909           (const_int 10))
8910       (if_then_else (eq_attr "is_thumb" "no")
8911           (const_int 8)
8912           (const_int 10))
8913       (if_then_else (eq_attr "is_thumb" "no")
8914           (const_int 8)
8915           (const_int 10))
8916       (if_then_else (eq_attr "is_thumb" "no")
8917           (const_int 8)
8918           (const_int 10))])
8919   (set_attr "type" "multiple")]
8920)
8921
8922(define_insn "*cmp_and"
8923  [(set (match_operand 6 "dominant_cc_register" "")
8924	(compare
8925	 (and:SI
8926	  (match_operator 4 "arm_comparison_operator"
8927	   [(match_operand:SI 0 "s_register_operand" 
8928	        "l,l,l,r,r,r,r,r,r")
8929	    (match_operand:SI 1 "arm_add_operand" 
8930	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
8931	  (match_operator:SI 5 "arm_comparison_operator"
8932	   [(match_operand:SI 2 "s_register_operand" 
8933	        "l,r,r,l,l,r,r,r,r")
8934	    (match_operand:SI 3 "arm_add_operand" 
8935	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")]))
8936	 (const_int 0)))]
8937  "TARGET_32BIT"
8938  "*
8939  {
8940    static const char *const cmp1[NUM_OF_COND_CMP][2] =
8941    {
8942      {\"cmp%d5\\t%0, %1\",
8943       \"cmp%d4\\t%2, %3\"},
8944      {\"cmn%d5\\t%0, #%n1\",
8945       \"cmp%d4\\t%2, %3\"},
8946      {\"cmp%d5\\t%0, %1\",
8947       \"cmn%d4\\t%2, #%n3\"},
8948      {\"cmn%d5\\t%0, #%n1\",
8949       \"cmn%d4\\t%2, #%n3\"}
8950    };
8951    static const char *const cmp2[NUM_OF_COND_CMP][2] =
8952    {
8953      {\"cmp\\t%2, %3\",
8954       \"cmp\\t%0, %1\"},
8955      {\"cmp\\t%2, %3\",
8956       \"cmn\\t%0, #%n1\"},
8957      {\"cmn\\t%2, #%n3\",
8958       \"cmp\\t%0, %1\"},
8959      {\"cmn\\t%2, #%n3\",
8960       \"cmn\\t%0, #%n1\"}
8961    };
8962    static const char *const ite[2] =
8963    {
8964      \"it\\t%d5\",
8965      \"it\\t%d4\"
8966    };
8967    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
8968                                   CMP_CMP, CMN_CMP, CMP_CMP,
8969                                   CMN_CMP, CMP_CMN, CMN_CMN};
8970    int swap =
8971      comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
8972
8973    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
8974    if (TARGET_THUMB2) {
8975      output_asm_insn (ite[swap], operands);
8976    }
8977    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
8978    return \"\";
8979  }"
8980  [(set_attr "conds" "set")
8981   (set_attr "predicable" "no")
8982   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
8983   (set_attr_alternative "length"
8984      [(const_int 6)
8985       (const_int 8)
8986       (const_int 8)
8987       (const_int 8)
8988       (const_int 8)
8989       (if_then_else (eq_attr "is_thumb" "no")
8990           (const_int 8)
8991           (const_int 10))
8992       (if_then_else (eq_attr "is_thumb" "no")
8993           (const_int 8)
8994           (const_int 10))
8995       (if_then_else (eq_attr "is_thumb" "no")
8996           (const_int 8)
8997           (const_int 10))
8998       (if_then_else (eq_attr "is_thumb" "no")
8999           (const_int 8)
9000           (const_int 10))])
9001   (set_attr "type" "multiple")]
9002)
9003
9004(define_insn "*cmp_ior"
9005  [(set (match_operand 6 "dominant_cc_register" "")
9006	(compare
9007	 (ior:SI
9008	  (match_operator 4 "arm_comparison_operator"
9009	   [(match_operand:SI 0 "s_register_operand"
9010	        "l,l,l,r,r,r,r,r,r")
9011	    (match_operand:SI 1 "arm_add_operand"
9012	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
9013	  (match_operator:SI 5 "arm_comparison_operator"
9014	   [(match_operand:SI 2 "s_register_operand"
9015	        "l,r,r,l,l,r,r,r,r")
9016	    (match_operand:SI 3 "arm_add_operand"
9017	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")]))
9018	 (const_int 0)))]
9019  "TARGET_32BIT"
9020  "*
9021  {
9022    static const char *const cmp1[NUM_OF_COND_CMP][2] =
9023    {
9024      {\"cmp\\t%0, %1\",
9025       \"cmp\\t%2, %3\"},
9026      {\"cmn\\t%0, #%n1\",
9027       \"cmp\\t%2, %3\"},
9028      {\"cmp\\t%0, %1\",
9029       \"cmn\\t%2, #%n3\"},
9030      {\"cmn\\t%0, #%n1\",
9031       \"cmn\\t%2, #%n3\"}
9032    };
9033    static const char *const cmp2[NUM_OF_COND_CMP][2] =
9034    {
9035      {\"cmp%D4\\t%2, %3\",
9036       \"cmp%D5\\t%0, %1\"},
9037      {\"cmp%D4\\t%2, %3\",
9038       \"cmn%D5\\t%0, #%n1\"},
9039      {\"cmn%D4\\t%2, #%n3\",
9040       \"cmp%D5\\t%0, %1\"},
9041      {\"cmn%D4\\t%2, #%n3\",
9042       \"cmn%D5\\t%0, #%n1\"}
9043    };
9044    static const char *const ite[2] =
9045    {
9046      \"it\\t%D4\",
9047      \"it\\t%D5\"
9048    };
9049    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
9050                                   CMP_CMP, CMN_CMP, CMP_CMP,
9051                                   CMN_CMP, CMP_CMN, CMN_CMN};
9052    int swap =
9053      comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
9054
9055    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
9056    if (TARGET_THUMB2) {
9057      output_asm_insn (ite[swap], operands);
9058    }
9059    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
9060    return \"\";
9061  }
9062  "
9063  [(set_attr "conds" "set")
9064   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
9065   (set_attr_alternative "length"
9066      [(const_int 6)
9067       (const_int 8)
9068       (const_int 8)
9069       (const_int 8)
9070       (const_int 8)
9071       (if_then_else (eq_attr "is_thumb" "no")
9072           (const_int 8)
9073           (const_int 10))
9074       (if_then_else (eq_attr "is_thumb" "no")
9075           (const_int 8)
9076           (const_int 10))
9077       (if_then_else (eq_attr "is_thumb" "no")
9078           (const_int 8)
9079           (const_int 10))
9080       (if_then_else (eq_attr "is_thumb" "no")
9081           (const_int 8)
9082           (const_int 10))])
9083   (set_attr "type" "multiple")]
9084)
9085
9086(define_insn_and_split "*ior_scc_scc"
9087  [(set (match_operand:SI 0 "s_register_operand" "=Ts")
9088	(ior:SI (match_operator:SI 3 "arm_comparison_operator"
9089		 [(match_operand:SI 1 "s_register_operand" "r")
9090		  (match_operand:SI 2 "arm_add_operand" "rIL")])
9091		(match_operator:SI 6 "arm_comparison_operator"
9092		 [(match_operand:SI 4 "s_register_operand" "r")
9093		  (match_operand:SI 5 "arm_add_operand" "rIL")])))
9094   (clobber (reg:CC CC_REGNUM))]
9095  "TARGET_32BIT
9096   && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_OR_Y)
9097       != CCmode)"
9098  "#"
9099  "TARGET_32BIT && reload_completed"
9100  [(set (match_dup 7)
9101	(compare
9102	 (ior:SI
9103	  (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9104	  (match_op_dup 6 [(match_dup 4) (match_dup 5)]))
9105	 (const_int 0)))
9106   (set (match_dup 0) (ne:SI (match_dup 7) (const_int 0)))]
9107  "operands[7]
9108     = gen_rtx_REG (arm_select_dominance_cc_mode (operands[3], operands[6],
9109						  DOM_CC_X_OR_Y),
9110		    CC_REGNUM);"
9111  [(set_attr "conds" "clob")
9112   (set_attr "length" "16")
9113   (set_attr "type" "multiple")]
9114)
9115
9116; If the above pattern is followed by a CMP insn, then the compare is 
9117; redundant, since we can rework the conditional instruction that follows.
9118(define_insn_and_split "*ior_scc_scc_cmp"
9119  [(set (match_operand 0 "dominant_cc_register" "")
9120	(compare (ior:SI (match_operator:SI 3 "arm_comparison_operator"
9121			  [(match_operand:SI 1 "s_register_operand" "r")
9122			   (match_operand:SI 2 "arm_add_operand" "rIL")])
9123			 (match_operator:SI 6 "arm_comparison_operator"
9124			  [(match_operand:SI 4 "s_register_operand" "r")
9125			   (match_operand:SI 5 "arm_add_operand" "rIL")]))
9126		 (const_int 0)))
9127   (set (match_operand:SI 7 "s_register_operand" "=Ts")
9128	(ior:SI (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9129		(match_op_dup 6 [(match_dup 4) (match_dup 5)])))]
9130  "TARGET_32BIT"
9131  "#"
9132  "TARGET_32BIT && reload_completed"
9133  [(set (match_dup 0)
9134	(compare
9135	 (ior:SI
9136	  (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9137	  (match_op_dup 6 [(match_dup 4) (match_dup 5)]))
9138	 (const_int 0)))
9139   (set (match_dup 7) (ne:SI (match_dup 0) (const_int 0)))]
9140  ""
9141  [(set_attr "conds" "set")
9142   (set_attr "length" "16")
9143   (set_attr "type" "multiple")]
9144)
9145
9146(define_insn_and_split "*and_scc_scc"
9147  [(set (match_operand:SI 0 "s_register_operand" "=Ts")
9148	(and:SI (match_operator:SI 3 "arm_comparison_operator"
9149		 [(match_operand:SI 1 "s_register_operand" "r")
9150		  (match_operand:SI 2 "arm_add_operand" "rIL")])
9151		(match_operator:SI 6 "arm_comparison_operator"
9152		 [(match_operand:SI 4 "s_register_operand" "r")
9153		  (match_operand:SI 5 "arm_add_operand" "rIL")])))
9154   (clobber (reg:CC CC_REGNUM))]
9155  "TARGET_32BIT
9156   && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
9157       != CCmode)"
9158  "#"
9159  "TARGET_32BIT && reload_completed
9160   && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
9161       != CCmode)"
9162  [(set (match_dup 7)
9163	(compare
9164	 (and:SI
9165	  (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9166	  (match_op_dup 6 [(match_dup 4) (match_dup 5)]))
9167	 (const_int 0)))
9168   (set (match_dup 0) (ne:SI (match_dup 7) (const_int 0)))]
9169  "operands[7]
9170     = gen_rtx_REG (arm_select_dominance_cc_mode (operands[3], operands[6],
9171						  DOM_CC_X_AND_Y),
9172		    CC_REGNUM);"
9173  [(set_attr "conds" "clob")
9174   (set_attr "length" "16")
9175   (set_attr "type" "multiple")]
9176)
9177
9178; If the above pattern is followed by a CMP insn, then the compare is 
9179; redundant, since we can rework the conditional instruction that follows.
9180(define_insn_and_split "*and_scc_scc_cmp"
9181  [(set (match_operand 0 "dominant_cc_register" "")
9182	(compare (and:SI (match_operator:SI 3 "arm_comparison_operator"
9183			  [(match_operand:SI 1 "s_register_operand" "r")
9184			   (match_operand:SI 2 "arm_add_operand" "rIL")])
9185			 (match_operator:SI 6 "arm_comparison_operator"
9186			  [(match_operand:SI 4 "s_register_operand" "r")
9187			   (match_operand:SI 5 "arm_add_operand" "rIL")]))
9188		 (const_int 0)))
9189   (set (match_operand:SI 7 "s_register_operand" "=Ts")
9190	(and:SI (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9191		(match_op_dup 6 [(match_dup 4) (match_dup 5)])))]
9192  "TARGET_32BIT"
9193  "#"
9194  "TARGET_32BIT && reload_completed"
9195  [(set (match_dup 0)
9196	(compare
9197	 (and:SI
9198	  (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9199	  (match_op_dup 6 [(match_dup 4) (match_dup 5)]))
9200	 (const_int 0)))
9201   (set (match_dup 7) (ne:SI (match_dup 0) (const_int 0)))]
9202  ""
9203  [(set_attr "conds" "set")
9204   (set_attr "length" "16")
9205   (set_attr "type" "multiple")]
9206)
9207
9208;; If there is no dominance in the comparison, then we can still save an
9209;; instruction in the AND case, since we can know that the second compare
9210;; need only zero the value if false (if true, then the value is already
9211;; correct).
9212(define_insn_and_split "*and_scc_scc_nodom"
9213  [(set (match_operand:SI 0 "s_register_operand" "=&Ts,&Ts,&Ts")
9214	(and:SI (match_operator:SI 3 "arm_comparison_operator"
9215		 [(match_operand:SI 1 "s_register_operand" "r,r,0")
9216		  (match_operand:SI 2 "arm_add_operand" "rIL,0,rIL")])
9217		(match_operator:SI 6 "arm_comparison_operator"
9218		 [(match_operand:SI 4 "s_register_operand" "r,r,r")
9219		  (match_operand:SI 5 "arm_add_operand" "rIL,rIL,rIL")])))
9220   (clobber (reg:CC CC_REGNUM))]
9221  "TARGET_32BIT
9222   && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
9223       == CCmode)"
9224  "#"
9225  "TARGET_32BIT && reload_completed"
9226  [(parallel [(set (match_dup 0)
9227		   (match_op_dup 3 [(match_dup 1) (match_dup 2)]))
9228	      (clobber (reg:CC CC_REGNUM))])
9229   (set (match_dup 7) (match_op_dup 8 [(match_dup 4) (match_dup 5)]))
9230   (set (match_dup 0)
9231	(if_then_else:SI (match_op_dup 6 [(match_dup 7) (const_int 0)])
9232			 (match_dup 0)
9233			 (const_int 0)))]
9234  "operands[7] = gen_rtx_REG (SELECT_CC_MODE (GET_CODE (operands[6]),
9235					      operands[4], operands[5]),
9236			      CC_REGNUM);
9237   operands[8] = gen_rtx_COMPARE (GET_MODE (operands[7]), operands[4],
9238				  operands[5]);"
9239  [(set_attr "conds" "clob")
9240   (set_attr "length" "20")
9241   (set_attr "type" "multiple")]
9242)
9243
9244(define_split
9245  [(set (reg:CC_NOOV CC_REGNUM)
9246	(compare:CC_NOOV (ior:SI
9247			  (and:SI (match_operand:SI 0 "s_register_operand" "")
9248				  (const_int 1))
9249			  (match_operator:SI 1 "arm_comparison_operator"
9250			   [(match_operand:SI 2 "s_register_operand" "")
9251			    (match_operand:SI 3 "arm_add_operand" "")]))
9252			 (const_int 0)))
9253   (clobber (match_operand:SI 4 "s_register_operand" ""))]
9254  "TARGET_ARM"
9255  [(set (match_dup 4)
9256	(ior:SI (match_op_dup 1 [(match_dup 2) (match_dup 3)])
9257		(match_dup 0)))
9258   (set (reg:CC_NOOV CC_REGNUM)
9259	(compare:CC_NOOV (and:SI (match_dup 4) (const_int 1))
9260			 (const_int 0)))]
9261  "")
9262
9263(define_split
9264  [(set (reg:CC_NOOV CC_REGNUM)
9265	(compare:CC_NOOV (ior:SI
9266			  (match_operator:SI 1 "arm_comparison_operator"
9267			   [(match_operand:SI 2 "s_register_operand" "")
9268			    (match_operand:SI 3 "arm_add_operand" "")])
9269			  (and:SI (match_operand:SI 0 "s_register_operand" "")
9270				  (const_int 1)))
9271			 (const_int 0)))
9272   (clobber (match_operand:SI 4 "s_register_operand" ""))]
9273  "TARGET_ARM"
9274  [(set (match_dup 4)
9275	(ior:SI (match_op_dup 1 [(match_dup 2) (match_dup 3)])
9276		(match_dup 0)))
9277   (set (reg:CC_NOOV CC_REGNUM)
9278	(compare:CC_NOOV (and:SI (match_dup 4) (const_int 1))
9279			 (const_int 0)))]
9280  "")
9281;; ??? The conditional patterns above need checking for Thumb-2 usefulness
9282
9283(define_insn_and_split "*negscc"
9284  [(set (match_operand:SI 0 "s_register_operand" "=r")
9285	(neg:SI (match_operator 3 "arm_comparison_operator"
9286		 [(match_operand:SI 1 "s_register_operand" "r")
9287		  (match_operand:SI 2 "arm_rhs_operand" "rI")])))
9288   (clobber (reg:CC CC_REGNUM))]
9289  "TARGET_ARM"
9290  "#"
9291  "&& reload_completed"
9292  [(const_int 0)]
9293  {
9294    rtx cc_reg = gen_rtx_REG (CCmode, CC_REGNUM);
9295
9296    if (GET_CODE (operands[3]) == LT && operands[2] == const0_rtx)
9297       {
9298         /* Emit mov\\t%0, %1, asr #31 */
9299         emit_insn (gen_rtx_SET (VOIDmode,
9300                                 operands[0],
9301                                 gen_rtx_ASHIFTRT (SImode,
9302                                                   operands[1],
9303                                                   GEN_INT (31))));
9304         DONE;
9305       }
9306     else if (GET_CODE (operands[3]) == NE)
9307       {
9308        /* Emit subs\\t%0, %1, %2\;mvnne\\t%0, #0 */
9309        if (CONST_INT_P (operands[2]))
9310          emit_insn (gen_cmpsi2_addneg (operands[0], operands[1], operands[2],
9311                                        GEN_INT (- INTVAL (operands[2]))));
9312        else
9313          emit_insn (gen_subsi3_compare (operands[0], operands[1], operands[2]));
9314
9315        emit_insn (gen_rtx_COND_EXEC (VOIDmode,
9316                                      gen_rtx_NE (SImode,
9317                                                  cc_reg,
9318                                                  const0_rtx),
9319                                      gen_rtx_SET (SImode,
9320                                                   operands[0],
9321                                                   GEN_INT (~0))));
9322        DONE;
9323      }
9324    else
9325      {
9326        /* Emit: cmp\\t%1, %2\;mov%D3\\t%0, #0\;mvn%d3\\t%0, #0 */
9327        emit_insn (gen_rtx_SET (VOIDmode,
9328                                cc_reg,
9329                                gen_rtx_COMPARE (CCmode, operands[1], operands[2])));
9330        enum rtx_code rc = GET_CODE (operands[3]);
9331
9332        rc = reverse_condition (rc);
9333        emit_insn (gen_rtx_COND_EXEC (VOIDmode,
9334                                      gen_rtx_fmt_ee (rc,
9335                                                      VOIDmode,
9336                                                      cc_reg,
9337                                                      const0_rtx),
9338                                      gen_rtx_SET (VOIDmode, operands[0], const0_rtx)));
9339        rc = GET_CODE (operands[3]);
9340        emit_insn (gen_rtx_COND_EXEC (VOIDmode,
9341                                      gen_rtx_fmt_ee (rc,
9342                                                      VOIDmode,
9343                                                      cc_reg,
9344                                                      const0_rtx),
9345                                      gen_rtx_SET (VOIDmode,
9346                                                   operands[0],
9347                                                   GEN_INT (~0))));
9348        DONE;
9349      }
9350     FAIL;
9351  }
9352  [(set_attr "conds" "clob")
9353   (set_attr "length" "12")
9354   (set_attr "type" "multiple")]
9355)
9356
9357(define_insn_and_split "movcond_addsi"
9358  [(set (match_operand:SI 0 "s_register_operand" "=r,l,r")
9359	(if_then_else:SI
9360	 (match_operator 5 "comparison_operator"
9361	  [(plus:SI (match_operand:SI 3 "s_register_operand" "r,r,r")
9362	            (match_operand:SI 4 "arm_add_operand" "rIL,rIL,rIL"))
9363            (const_int 0)])
9364	 (match_operand:SI 1 "arm_rhs_operand" "rI,rPy,r")
9365	 (match_operand:SI 2 "arm_rhs_operand" "rI,rPy,r")))
9366   (clobber (reg:CC CC_REGNUM))]
9367   "TARGET_32BIT"
9368   "#"
9369   "&& reload_completed"
9370  [(set (reg:CC_NOOV CC_REGNUM)
9371	(compare:CC_NOOV
9372	 (plus:SI (match_dup 3)
9373		  (match_dup 4))
9374	 (const_int 0)))
9375   (set (match_dup 0) (match_dup 1))
9376   (cond_exec (match_dup 6)
9377	      (set (match_dup 0) (match_dup 2)))]
9378  "
9379  {
9380    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[5]),
9381					     operands[3], operands[4]);
9382    enum rtx_code rc = GET_CODE (operands[5]);
9383    operands[6] = gen_rtx_REG (mode, CC_REGNUM);
9384    gcc_assert (!(mode == CCFPmode || mode == CCFPEmode));
9385    if (!REG_P (operands[2]) || REGNO (operands[2]) != REGNO (operands[0]))
9386      rc = reverse_condition (rc);
9387    else
9388      std::swap (operands[1], operands[2]);
9389
9390    operands[6] = gen_rtx_fmt_ee (rc, VOIDmode, operands[6], const0_rtx);
9391  }
9392  "
9393  [(set_attr "conds" "clob")
9394   (set_attr "enabled_for_depr_it" "no,yes,yes")
9395   (set_attr "type" "multiple")]
9396)
9397
9398(define_insn "movcond"
9399  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
9400	(if_then_else:SI
9401	 (match_operator 5 "arm_comparison_operator"
9402	  [(match_operand:SI 3 "s_register_operand" "r,r,r")
9403	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL,rIL")])
9404	 (match_operand:SI 1 "arm_rhs_operand" "0,rI,?rI")
9405	 (match_operand:SI 2 "arm_rhs_operand" "rI,0,rI")))
9406   (clobber (reg:CC CC_REGNUM))]
9407  "TARGET_ARM"
9408  "*
9409  if (GET_CODE (operands[5]) == LT
9410      && (operands[4] == const0_rtx))
9411    {
9412      if (which_alternative != 1 && REG_P (operands[1]))
9413	{
9414	  if (operands[2] == const0_rtx)
9415	    return \"and\\t%0, %1, %3, asr #31\";
9416	  return \"ands\\t%0, %1, %3, asr #32\;movcc\\t%0, %2\";
9417	}
9418      else if (which_alternative != 0 && REG_P (operands[2]))
9419	{
9420	  if (operands[1] == const0_rtx)
9421	    return \"bic\\t%0, %2, %3, asr #31\";
9422	  return \"bics\\t%0, %2, %3, asr #32\;movcs\\t%0, %1\";
9423	}
9424      /* The only case that falls through to here is when both ops 1 & 2
9425	 are constants.  */
9426    }
9427
9428  if (GET_CODE (operands[5]) == GE
9429      && (operands[4] == const0_rtx))
9430    {
9431      if (which_alternative != 1 && REG_P (operands[1]))
9432	{
9433	  if (operands[2] == const0_rtx)
9434	    return \"bic\\t%0, %1, %3, asr #31\";
9435	  return \"bics\\t%0, %1, %3, asr #32\;movcs\\t%0, %2\";
9436	}
9437      else if (which_alternative != 0 && REG_P (operands[2]))
9438	{
9439	  if (operands[1] == const0_rtx)
9440	    return \"and\\t%0, %2, %3, asr #31\";
9441	  return \"ands\\t%0, %2, %3, asr #32\;movcc\\t%0, %1\";
9442	}
9443      /* The only case that falls through to here is when both ops 1 & 2
9444	 are constants.  */
9445    }
9446  if (CONST_INT_P (operands[4])
9447      && !const_ok_for_arm (INTVAL (operands[4])))
9448    output_asm_insn (\"cmn\\t%3, #%n4\", operands);
9449  else
9450    output_asm_insn (\"cmp\\t%3, %4\", operands);
9451  if (which_alternative != 0)
9452    output_asm_insn (\"mov%d5\\t%0, %1\", operands);
9453  if (which_alternative != 1)
9454    output_asm_insn (\"mov%D5\\t%0, %2\", operands);
9455  return \"\";
9456  "
9457  [(set_attr "conds" "clob")
9458   (set_attr "length" "8,8,12")
9459   (set_attr "type" "multiple")]
9460)
9461
9462;; ??? The patterns below need checking for Thumb-2 usefulness.
9463
9464(define_insn "*ifcompare_plus_move"
9465  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9466	(if_then_else:SI (match_operator 6 "arm_comparison_operator"
9467			  [(match_operand:SI 4 "s_register_operand" "r,r")
9468			   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
9469			 (plus:SI
9470			  (match_operand:SI 2 "s_register_operand" "r,r")
9471			  (match_operand:SI 3 "arm_add_operand" "rIL,rIL"))
9472			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")))
9473   (clobber (reg:CC CC_REGNUM))]
9474  "TARGET_ARM"
9475  "#"
9476  [(set_attr "conds" "clob")
9477   (set_attr "length" "8,12")
9478   (set_attr "type" "multiple")]
9479)
9480
9481(define_insn "*if_plus_move"
9482  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r,r")
9483	(if_then_else:SI
9484	 (match_operator 4 "arm_comparison_operator"
9485	  [(match_operand 5 "cc_register" "") (const_int 0)])
9486	 (plus:SI
9487	  (match_operand:SI 2 "s_register_operand" "r,r,r,r")
9488	  (match_operand:SI 3 "arm_add_operand" "rI,L,rI,L"))
9489	 (match_operand:SI 1 "arm_rhs_operand" "0,0,?rI,?rI")))]
9490  "TARGET_ARM"
9491  "@
9492   add%d4\\t%0, %2, %3
9493   sub%d4\\t%0, %2, #%n3
9494   add%d4\\t%0, %2, %3\;mov%D4\\t%0, %1
9495   sub%d4\\t%0, %2, #%n3\;mov%D4\\t%0, %1"
9496  [(set_attr "conds" "use")
9497   (set_attr "length" "4,4,8,8")
9498   (set_attr_alternative "type"
9499                         [(if_then_else (match_operand 3 "const_int_operand" "")
9500                                        (const_string "alu_imm" )
9501                                        (const_string "alu_sreg"))
9502                          (const_string "alu_imm")
9503                          (const_string "alu_sreg")
9504                          (const_string "alu_sreg")])]
9505)
9506
9507(define_insn "*ifcompare_move_plus"
9508  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9509	(if_then_else:SI (match_operator 6 "arm_comparison_operator"
9510			  [(match_operand:SI 4 "s_register_operand" "r,r")
9511			   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
9512			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")
9513			 (plus:SI
9514			  (match_operand:SI 2 "s_register_operand" "r,r")
9515			  (match_operand:SI 3 "arm_add_operand" "rIL,rIL"))))
9516   (clobber (reg:CC CC_REGNUM))]
9517  "TARGET_ARM"
9518  "#"
9519  [(set_attr "conds" "clob")
9520   (set_attr "length" "8,12")
9521   (set_attr "type" "multiple")]
9522)
9523
9524(define_insn "*if_move_plus"
9525  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r,r")
9526	(if_then_else:SI
9527	 (match_operator 4 "arm_comparison_operator"
9528	  [(match_operand 5 "cc_register" "") (const_int 0)])
9529	 (match_operand:SI 1 "arm_rhs_operand" "0,0,?rI,?rI")
9530	 (plus:SI
9531	  (match_operand:SI 2 "s_register_operand" "r,r,r,r")
9532	  (match_operand:SI 3 "arm_add_operand" "rI,L,rI,L"))))]
9533  "TARGET_ARM"
9534  "@
9535   add%D4\\t%0, %2, %3
9536   sub%D4\\t%0, %2, #%n3
9537   add%D4\\t%0, %2, %3\;mov%d4\\t%0, %1
9538   sub%D4\\t%0, %2, #%n3\;mov%d4\\t%0, %1"
9539  [(set_attr "conds" "use")
9540   (set_attr "length" "4,4,8,8")
9541   (set_attr "type" "alu_sreg,alu_imm,multiple,multiple")]
9542)
9543
9544(define_insn "*ifcompare_arith_arith"
9545  [(set (match_operand:SI 0 "s_register_operand" "=r")
9546	(if_then_else:SI (match_operator 9 "arm_comparison_operator"
9547			  [(match_operand:SI 5 "s_register_operand" "r")
9548			   (match_operand:SI 6 "arm_add_operand" "rIL")])
9549			 (match_operator:SI 8 "shiftable_operator"
9550			  [(match_operand:SI 1 "s_register_operand" "r")
9551			   (match_operand:SI 2 "arm_rhs_operand" "rI")])
9552			 (match_operator:SI 7 "shiftable_operator"
9553			  [(match_operand:SI 3 "s_register_operand" "r")
9554			   (match_operand:SI 4 "arm_rhs_operand" "rI")])))
9555   (clobber (reg:CC CC_REGNUM))]
9556  "TARGET_ARM"
9557  "#"
9558  [(set_attr "conds" "clob")
9559   (set_attr "length" "12")
9560   (set_attr "type" "multiple")]
9561)
9562
9563(define_insn "*if_arith_arith"
9564  [(set (match_operand:SI 0 "s_register_operand" "=r")
9565	(if_then_else:SI (match_operator 5 "arm_comparison_operator"
9566			  [(match_operand 8 "cc_register" "") (const_int 0)])
9567			 (match_operator:SI 6 "shiftable_operator"
9568			  [(match_operand:SI 1 "s_register_operand" "r")
9569			   (match_operand:SI 2 "arm_rhs_operand" "rI")])
9570			 (match_operator:SI 7 "shiftable_operator"
9571			  [(match_operand:SI 3 "s_register_operand" "r")
9572			   (match_operand:SI 4 "arm_rhs_operand" "rI")])))]
9573  "TARGET_ARM"
9574  "%I6%d5\\t%0, %1, %2\;%I7%D5\\t%0, %3, %4"
9575  [(set_attr "conds" "use")
9576   (set_attr "length" "8")
9577   (set_attr "type" "multiple")]
9578)
9579
9580(define_insn "*ifcompare_arith_move"
9581  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9582	(if_then_else:SI (match_operator 6 "arm_comparison_operator"
9583			  [(match_operand:SI 2 "s_register_operand" "r,r")
9584			   (match_operand:SI 3 "arm_add_operand" "rIL,rIL")])
9585			 (match_operator:SI 7 "shiftable_operator"
9586			  [(match_operand:SI 4 "s_register_operand" "r,r")
9587			   (match_operand:SI 5 "arm_rhs_operand" "rI,rI")])
9588			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")))
9589   (clobber (reg:CC CC_REGNUM))]
9590  "TARGET_ARM"
9591  "*
9592  /* If we have an operation where (op x 0) is the identity operation and
9593     the conditional operator is LT or GE and we are comparing against zero and
9594     everything is in registers then we can do this in two instructions.  */
9595  if (operands[3] == const0_rtx
9596      && GET_CODE (operands[7]) != AND
9597      && REG_P (operands[5])
9598      && REG_P (operands[1])
9599      && REGNO (operands[1]) == REGNO (operands[4])
9600      && REGNO (operands[4]) != REGNO (operands[0]))
9601    {
9602      if (GET_CODE (operands[6]) == LT)
9603	return \"and\\t%0, %5, %2, asr #31\;%I7\\t%0, %4, %0\";
9604      else if (GET_CODE (operands[6]) == GE)
9605	return \"bic\\t%0, %5, %2, asr #31\;%I7\\t%0, %4, %0\";
9606    }
9607  if (CONST_INT_P (operands[3])
9608      && !const_ok_for_arm (INTVAL (operands[3])))
9609    output_asm_insn (\"cmn\\t%2, #%n3\", operands);
9610  else
9611    output_asm_insn (\"cmp\\t%2, %3\", operands);
9612  output_asm_insn (\"%I7%d6\\t%0, %4, %5\", operands);
9613  if (which_alternative != 0)
9614    return \"mov%D6\\t%0, %1\";
9615  return \"\";
9616  "
9617  [(set_attr "conds" "clob")
9618   (set_attr "length" "8,12")
9619   (set_attr "type" "multiple")]
9620)
9621
9622(define_insn "*if_arith_move"
9623  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9624	(if_then_else:SI (match_operator 4 "arm_comparison_operator"
9625			  [(match_operand 6 "cc_register" "") (const_int 0)])
9626			 (match_operator:SI 5 "shiftable_operator"
9627			  [(match_operand:SI 2 "s_register_operand" "r,r")
9628			   (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])
9629			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")))]
9630  "TARGET_ARM"
9631  "@
9632   %I5%d4\\t%0, %2, %3
9633   %I5%d4\\t%0, %2, %3\;mov%D4\\t%0, %1"
9634  [(set_attr "conds" "use")
9635   (set_attr "length" "4,8")
9636   (set_attr "type" "alu_shift_reg,multiple")]
9637)
9638
9639(define_insn "*ifcompare_move_arith"
9640  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9641	(if_then_else:SI (match_operator 6 "arm_comparison_operator"
9642			  [(match_operand:SI 4 "s_register_operand" "r,r")
9643			   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
9644			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")
9645			 (match_operator:SI 7 "shiftable_operator"
9646			  [(match_operand:SI 2 "s_register_operand" "r,r")
9647			   (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])))
9648   (clobber (reg:CC CC_REGNUM))]
9649  "TARGET_ARM"
9650  "*
9651  /* If we have an operation where (op x 0) is the identity operation and
9652     the conditional operator is LT or GE and we are comparing against zero and
9653     everything is in registers then we can do this in two instructions */
9654  if (operands[5] == const0_rtx
9655      && GET_CODE (operands[7]) != AND
9656      && REG_P (operands[3])
9657      && REG_P (operands[1])
9658      && REGNO (operands[1]) == REGNO (operands[2])
9659      && REGNO (operands[2]) != REGNO (operands[0]))
9660    {
9661      if (GET_CODE (operands[6]) == GE)
9662	return \"and\\t%0, %3, %4, asr #31\;%I7\\t%0, %2, %0\";
9663      else if (GET_CODE (operands[6]) == LT)
9664	return \"bic\\t%0, %3, %4, asr #31\;%I7\\t%0, %2, %0\";
9665    }
9666
9667  if (CONST_INT_P (operands[5])
9668      && !const_ok_for_arm (INTVAL (operands[5])))
9669    output_asm_insn (\"cmn\\t%4, #%n5\", operands);
9670  else
9671    output_asm_insn (\"cmp\\t%4, %5\", operands);
9672
9673  if (which_alternative != 0)
9674    output_asm_insn (\"mov%d6\\t%0, %1\", operands);
9675  return \"%I7%D6\\t%0, %2, %3\";
9676  "
9677  [(set_attr "conds" "clob")
9678   (set_attr "length" "8,12")
9679   (set_attr "type" "multiple")]
9680)
9681
9682(define_insn "*if_move_arith"
9683  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9684	(if_then_else:SI
9685	 (match_operator 4 "arm_comparison_operator"
9686	  [(match_operand 6 "cc_register" "") (const_int 0)])
9687	 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")
9688	 (match_operator:SI 5 "shiftable_operator"
9689	  [(match_operand:SI 2 "s_register_operand" "r,r")
9690	   (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])))]
9691  "TARGET_ARM"
9692  "@
9693   %I5%D4\\t%0, %2, %3
9694   %I5%D4\\t%0, %2, %3\;mov%d4\\t%0, %1"
9695  [(set_attr "conds" "use")
9696   (set_attr "length" "4,8")
9697   (set_attr "type" "alu_shift_reg,multiple")]
9698)
9699
9700(define_insn "*ifcompare_move_not"
9701  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9702	(if_then_else:SI
9703	 (match_operator 5 "arm_comparison_operator"
9704	  [(match_operand:SI 3 "s_register_operand" "r,r")
9705	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL")])
9706	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")
9707	 (not:SI
9708	  (match_operand:SI 2 "s_register_operand" "r,r"))))
9709   (clobber (reg:CC CC_REGNUM))]
9710  "TARGET_ARM"
9711  "#"
9712  [(set_attr "conds" "clob")
9713   (set_attr "length" "8,12")
9714   (set_attr "type" "multiple")]
9715)
9716
9717(define_insn "*if_move_not"
9718  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
9719	(if_then_else:SI
9720	 (match_operator 4 "arm_comparison_operator"
9721	  [(match_operand 3 "cc_register" "") (const_int 0)])
9722	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")
9723	 (not:SI (match_operand:SI 2 "s_register_operand" "r,r,r"))))]
9724  "TARGET_ARM"
9725  "@
9726   mvn%D4\\t%0, %2
9727   mov%d4\\t%0, %1\;mvn%D4\\t%0, %2
9728   mvn%d4\\t%0, #%B1\;mvn%D4\\t%0, %2"
9729  [(set_attr "conds" "use")
9730   (set_attr "type" "mvn_reg")
9731   (set_attr "length" "4,8,8")
9732   (set_attr "type" "mvn_reg,multiple,multiple")]
9733)
9734
9735(define_insn "*ifcompare_not_move"
9736  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9737	(if_then_else:SI 
9738	 (match_operator 5 "arm_comparison_operator"
9739	  [(match_operand:SI 3 "s_register_operand" "r,r")
9740	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL")])
9741	 (not:SI
9742	  (match_operand:SI 2 "s_register_operand" "r,r"))
9743	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")))
9744   (clobber (reg:CC CC_REGNUM))]
9745  "TARGET_ARM"
9746  "#"
9747  [(set_attr "conds" "clob")
9748   (set_attr "length" "8,12")
9749   (set_attr "type" "multiple")]
9750)
9751
9752(define_insn "*if_not_move"
9753  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
9754	(if_then_else:SI
9755	 (match_operator 4 "arm_comparison_operator"
9756	  [(match_operand 3 "cc_register" "") (const_int 0)])
9757	 (not:SI (match_operand:SI 2 "s_register_operand" "r,r,r"))
9758	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")))]
9759  "TARGET_ARM"
9760  "@
9761   mvn%d4\\t%0, %2
9762   mov%D4\\t%0, %1\;mvn%d4\\t%0, %2
9763   mvn%D4\\t%0, #%B1\;mvn%d4\\t%0, %2"
9764  [(set_attr "conds" "use")
9765   (set_attr "type" "mvn_reg,multiple,multiple")
9766   (set_attr "length" "4,8,8")]
9767)
9768
9769(define_insn "*ifcompare_shift_move"
9770  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9771	(if_then_else:SI
9772	 (match_operator 6 "arm_comparison_operator"
9773	  [(match_operand:SI 4 "s_register_operand" "r,r")
9774	   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
9775	 (match_operator:SI 7 "shift_operator"
9776	  [(match_operand:SI 2 "s_register_operand" "r,r")
9777	   (match_operand:SI 3 "arm_rhs_operand" "rM,rM")])
9778	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")))
9779   (clobber (reg:CC CC_REGNUM))]
9780  "TARGET_ARM"
9781  "#"
9782  [(set_attr "conds" "clob")
9783   (set_attr "length" "8,12")
9784   (set_attr "type" "multiple")]
9785)
9786
9787(define_insn "*if_shift_move"
9788  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
9789	(if_then_else:SI
9790	 (match_operator 5 "arm_comparison_operator"
9791	  [(match_operand 6 "cc_register" "") (const_int 0)])
9792	 (match_operator:SI 4 "shift_operator"
9793	  [(match_operand:SI 2 "s_register_operand" "r,r,r")
9794	   (match_operand:SI 3 "arm_rhs_operand" "rM,rM,rM")])
9795	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")))]
9796  "TARGET_ARM"
9797  "@
9798   mov%d5\\t%0, %2%S4
9799   mov%D5\\t%0, %1\;mov%d5\\t%0, %2%S4
9800   mvn%D5\\t%0, #%B1\;mov%d5\\t%0, %2%S4"
9801  [(set_attr "conds" "use")
9802   (set_attr "shift" "2")
9803   (set_attr "length" "4,8,8")
9804   (set_attr "type" "mov_shift_reg,multiple,multiple")]
9805)
9806
9807(define_insn "*ifcompare_move_shift"
9808  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9809	(if_then_else:SI
9810	 (match_operator 6 "arm_comparison_operator"
9811	  [(match_operand:SI 4 "s_register_operand" "r,r")
9812	   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
9813	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")
9814	 (match_operator:SI 7 "shift_operator"
9815	  [(match_operand:SI 2 "s_register_operand" "r,r")
9816	   (match_operand:SI 3 "arm_rhs_operand" "rM,rM")])))
9817   (clobber (reg:CC CC_REGNUM))]
9818  "TARGET_ARM"
9819  "#"
9820  [(set_attr "conds" "clob")
9821   (set_attr "length" "8,12")
9822   (set_attr "type" "multiple")]
9823)
9824
9825(define_insn "*if_move_shift"
9826  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
9827	(if_then_else:SI
9828	 (match_operator 5 "arm_comparison_operator"
9829	  [(match_operand 6 "cc_register" "") (const_int 0)])
9830	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")
9831	 (match_operator:SI 4 "shift_operator"
9832	  [(match_operand:SI 2 "s_register_operand" "r,r,r")
9833	   (match_operand:SI 3 "arm_rhs_operand" "rM,rM,rM")])))]
9834  "TARGET_ARM"
9835  "@
9836   mov%D5\\t%0, %2%S4
9837   mov%d5\\t%0, %1\;mov%D5\\t%0, %2%S4
9838   mvn%d5\\t%0, #%B1\;mov%D5\\t%0, %2%S4"
9839  [(set_attr "conds" "use")
9840   (set_attr "shift" "2")
9841   (set_attr "length" "4,8,8")
9842   (set_attr "type" "mov_shift_reg,multiple,multiple")]
9843)
9844
9845(define_insn "*ifcompare_shift_shift"
9846  [(set (match_operand:SI 0 "s_register_operand" "=r")
9847	(if_then_else:SI
9848	 (match_operator 7 "arm_comparison_operator"
9849	  [(match_operand:SI 5 "s_register_operand" "r")
9850	   (match_operand:SI 6 "arm_add_operand" "rIL")])
9851	 (match_operator:SI 8 "shift_operator"
9852	  [(match_operand:SI 1 "s_register_operand" "r")
9853	   (match_operand:SI 2 "arm_rhs_operand" "rM")])
9854	 (match_operator:SI 9 "shift_operator"
9855	  [(match_operand:SI 3 "s_register_operand" "r")
9856	   (match_operand:SI 4 "arm_rhs_operand" "rM")])))
9857   (clobber (reg:CC CC_REGNUM))]
9858  "TARGET_ARM"
9859  "#"
9860  [(set_attr "conds" "clob")
9861   (set_attr "length" "12")
9862   (set_attr "type" "multiple")]
9863)
9864
9865(define_insn "*if_shift_shift"
9866  [(set (match_operand:SI 0 "s_register_operand" "=r")
9867	(if_then_else:SI
9868	 (match_operator 5 "arm_comparison_operator"
9869	  [(match_operand 8 "cc_register" "") (const_int 0)])
9870	 (match_operator:SI 6 "shift_operator"
9871	  [(match_operand:SI 1 "s_register_operand" "r")
9872	   (match_operand:SI 2 "arm_rhs_operand" "rM")])
9873	 (match_operator:SI 7 "shift_operator"
9874	  [(match_operand:SI 3 "s_register_operand" "r")
9875	   (match_operand:SI 4 "arm_rhs_operand" "rM")])))]
9876  "TARGET_ARM"
9877  "mov%d5\\t%0, %1%S6\;mov%D5\\t%0, %3%S7"
9878  [(set_attr "conds" "use")
9879   (set_attr "shift" "1")
9880   (set_attr "length" "8")
9881   (set (attr "type") (if_then_else
9882		        (and (match_operand 2 "const_int_operand" "")
9883                             (match_operand 4 "const_int_operand" ""))
9884		      (const_string "mov_shift")
9885		      (const_string "mov_shift_reg")))]
9886)
9887
9888(define_insn "*ifcompare_not_arith"
9889  [(set (match_operand:SI 0 "s_register_operand" "=r")
9890	(if_then_else:SI
9891	 (match_operator 6 "arm_comparison_operator"
9892	  [(match_operand:SI 4 "s_register_operand" "r")
9893	   (match_operand:SI 5 "arm_add_operand" "rIL")])
9894	 (not:SI (match_operand:SI 1 "s_register_operand" "r"))
9895	 (match_operator:SI 7 "shiftable_operator"
9896	  [(match_operand:SI 2 "s_register_operand" "r")
9897	   (match_operand:SI 3 "arm_rhs_operand" "rI")])))
9898   (clobber (reg:CC CC_REGNUM))]
9899  "TARGET_ARM"
9900  "#"
9901  [(set_attr "conds" "clob")
9902   (set_attr "length" "12")
9903   (set_attr "type" "multiple")]
9904)
9905
9906(define_insn "*if_not_arith"
9907  [(set (match_operand:SI 0 "s_register_operand" "=r")
9908	(if_then_else:SI
9909	 (match_operator 5 "arm_comparison_operator"
9910	  [(match_operand 4 "cc_register" "") (const_int 0)])
9911	 (not:SI (match_operand:SI 1 "s_register_operand" "r"))
9912	 (match_operator:SI 6 "shiftable_operator"
9913	  [(match_operand:SI 2 "s_register_operand" "r")
9914	   (match_operand:SI 3 "arm_rhs_operand" "rI")])))]
9915  "TARGET_ARM"
9916  "mvn%d5\\t%0, %1\;%I6%D5\\t%0, %2, %3"
9917  [(set_attr "conds" "use")
9918   (set_attr "type" "mvn_reg")
9919   (set_attr "length" "8")]
9920)
9921
9922(define_insn "*ifcompare_arith_not"
9923  [(set (match_operand:SI 0 "s_register_operand" "=r")
9924	(if_then_else:SI
9925	 (match_operator 6 "arm_comparison_operator"
9926	  [(match_operand:SI 4 "s_register_operand" "r")
9927	   (match_operand:SI 5 "arm_add_operand" "rIL")])
9928	 (match_operator:SI 7 "shiftable_operator"
9929	  [(match_operand:SI 2 "s_register_operand" "r")
9930	   (match_operand:SI 3 "arm_rhs_operand" "rI")])
9931	 (not:SI (match_operand:SI 1 "s_register_operand" "r"))))
9932   (clobber (reg:CC CC_REGNUM))]
9933  "TARGET_ARM"
9934  "#"
9935  [(set_attr "conds" "clob")
9936   (set_attr "length" "12")
9937   (set_attr "type" "multiple")]
9938)
9939
9940(define_insn "*if_arith_not"
9941  [(set (match_operand:SI 0 "s_register_operand" "=r")
9942	(if_then_else:SI
9943	 (match_operator 5 "arm_comparison_operator"
9944	  [(match_operand 4 "cc_register" "") (const_int 0)])
9945	 (match_operator:SI 6 "shiftable_operator"
9946	  [(match_operand:SI 2 "s_register_operand" "r")
9947	   (match_operand:SI 3 "arm_rhs_operand" "rI")])
9948	 (not:SI (match_operand:SI 1 "s_register_operand" "r"))))]
9949  "TARGET_ARM"
9950  "mvn%D5\\t%0, %1\;%I6%d5\\t%0, %2, %3"
9951  [(set_attr "conds" "use")
9952   (set_attr "type" "multiple")
9953   (set_attr "length" "8")]
9954)
9955
9956(define_insn "*ifcompare_neg_move"
9957  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9958	(if_then_else:SI
9959	 (match_operator 5 "arm_comparison_operator"
9960	  [(match_operand:SI 3 "s_register_operand" "r,r")
9961	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL")])
9962	 (neg:SI (match_operand:SI 2 "s_register_operand" "r,r"))
9963	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")))
9964   (clobber (reg:CC CC_REGNUM))]
9965  "TARGET_ARM"
9966  "#"
9967  [(set_attr "conds" "clob")
9968   (set_attr "length" "8,12")
9969   (set_attr "type" "multiple")]
9970)
9971
9972(define_insn "*if_neg_move"
9973  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
9974	(if_then_else:SI
9975	 (match_operator 4 "arm_comparison_operator"
9976	  [(match_operand 3 "cc_register" "") (const_int 0)])
9977	 (neg:SI (match_operand:SI 2 "s_register_operand" "r,r,r"))
9978	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")))]
9979  "TARGET_ARM"
9980  "@
9981   rsb%d4\\t%0, %2, #0
9982   mov%D4\\t%0, %1\;rsb%d4\\t%0, %2, #0
9983   mvn%D4\\t%0, #%B1\;rsb%d4\\t%0, %2, #0"
9984  [(set_attr "conds" "use")
9985   (set_attr "length" "4,8,8")
9986   (set_attr "type" "logic_shift_imm,multiple,multiple")]
9987)
9988
9989(define_insn "*ifcompare_move_neg"
9990  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9991	(if_then_else:SI
9992	 (match_operator 5 "arm_comparison_operator"
9993	  [(match_operand:SI 3 "s_register_operand" "r,r")
9994	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL")])
9995	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")
9996	 (neg:SI (match_operand:SI 2 "s_register_operand" "r,r"))))
9997   (clobber (reg:CC CC_REGNUM))]
9998  "TARGET_ARM"
9999  "#"
10000  [(set_attr "conds" "clob")
10001   (set_attr "length" "8,12")
10002   (set_attr "type" "multiple")]
10003)
10004
10005(define_insn "*if_move_neg"
10006  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
10007	(if_then_else:SI
10008	 (match_operator 4 "arm_comparison_operator"
10009	  [(match_operand 3 "cc_register" "") (const_int 0)])
10010	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")
10011	 (neg:SI (match_operand:SI 2 "s_register_operand" "r,r,r"))))]
10012  "TARGET_ARM"
10013  "@
10014   rsb%D4\\t%0, %2, #0
10015   mov%d4\\t%0, %1\;rsb%D4\\t%0, %2, #0
10016   mvn%d4\\t%0, #%B1\;rsb%D4\\t%0, %2, #0"
10017  [(set_attr "conds" "use")
10018   (set_attr "length" "4,8,8")
10019   (set_attr "type" "logic_shift_imm,multiple,multiple")]
10020)
10021
10022(define_insn "*arith_adjacentmem"
10023  [(set (match_operand:SI 0 "s_register_operand" "=r")
10024	(match_operator:SI 1 "shiftable_operator"
10025	 [(match_operand:SI 2 "memory_operand" "m")
10026	  (match_operand:SI 3 "memory_operand" "m")]))
10027   (clobber (match_scratch:SI 4 "=r"))]
10028  "TARGET_ARM && adjacent_mem_locations (operands[2], operands[3])"
10029  "*
10030  {
10031    rtx ldm[3];
10032    rtx arith[4];
10033    rtx base_reg;
10034    HOST_WIDE_INT val1 = 0, val2 = 0;
10035
10036    if (REGNO (operands[0]) > REGNO (operands[4]))
10037      {
10038	ldm[1] = operands[4];
10039	ldm[2] = operands[0];
10040      }
10041    else
10042      {
10043	ldm[1] = operands[0];
10044	ldm[2] = operands[4];
10045      }
10046
10047    base_reg = XEXP (operands[2], 0);
10048
10049    if (!REG_P (base_reg))
10050      {
10051	val1 = INTVAL (XEXP (base_reg, 1));
10052	base_reg = XEXP (base_reg, 0);
10053      }
10054
10055    if (!REG_P (XEXP (operands[3], 0)))
10056      val2 = INTVAL (XEXP (XEXP (operands[3], 0), 1));
10057
10058    arith[0] = operands[0];
10059    arith[3] = operands[1];
10060
10061    if (val1 < val2)
10062      {
10063	arith[1] = ldm[1];
10064	arith[2] = ldm[2];
10065      }
10066    else
10067      {
10068	arith[1] = ldm[2];
10069	arith[2] = ldm[1];
10070      }
10071
10072    ldm[0] = base_reg;
10073    if (val1 !=0 && val2 != 0)
10074      {
10075	rtx ops[3];
10076
10077	if (val1 == 4 || val2 == 4)
10078	  /* Other val must be 8, since we know they are adjacent and neither
10079	     is zero.  */
10080	  output_asm_insn (\"ldm%(ib%)\\t%0, {%1, %2}\", ldm);
10081	else if (const_ok_for_arm (val1) || const_ok_for_arm (-val1))
10082	  {
10083	    ldm[0] = ops[0] = operands[4];
10084	    ops[1] = base_reg;
10085	    ops[2] = GEN_INT (val1);
10086	    output_add_immediate (ops);
10087	    if (val1 < val2)
10088	      output_asm_insn (\"ldm%(ia%)\\t%0, {%1, %2}\", ldm);
10089	    else
10090	      output_asm_insn (\"ldm%(da%)\\t%0, {%1, %2}\", ldm);
10091	  }
10092	else
10093	  {
10094	    /* Offset is out of range for a single add, so use two ldr.  */
10095	    ops[0] = ldm[1];
10096	    ops[1] = base_reg;
10097	    ops[2] = GEN_INT (val1);
10098	    output_asm_insn (\"ldr%?\\t%0, [%1, %2]\", ops);
10099	    ops[0] = ldm[2];
10100	    ops[2] = GEN_INT (val2);
10101	    output_asm_insn (\"ldr%?\\t%0, [%1, %2]\", ops);
10102	  }
10103      }
10104    else if (val1 != 0)
10105      {
10106	if (val1 < val2)
10107	  output_asm_insn (\"ldm%(da%)\\t%0, {%1, %2}\", ldm);
10108	else
10109	  output_asm_insn (\"ldm%(ia%)\\t%0, {%1, %2}\", ldm);
10110      }
10111    else
10112      {
10113	if (val1 < val2)
10114	  output_asm_insn (\"ldm%(ia%)\\t%0, {%1, %2}\", ldm);
10115	else
10116	  output_asm_insn (\"ldm%(da%)\\t%0, {%1, %2}\", ldm);
10117      }
10118    output_asm_insn (\"%I3%?\\t%0, %1, %2\", arith);
10119    return \"\";
10120  }"
10121  [(set_attr "length" "12")
10122   (set_attr "predicable" "yes")
10123   (set_attr "type" "load1")]
10124)
10125
10126; This pattern is never tried by combine, so do it as a peephole
10127
10128(define_peephole2
10129  [(set (match_operand:SI 0 "arm_general_register_operand" "")
10130	(match_operand:SI 1 "arm_general_register_operand" ""))
10131   (set (reg:CC CC_REGNUM)
10132	(compare:CC (match_dup 1) (const_int 0)))]
10133  "TARGET_ARM"
10134  [(parallel [(set (reg:CC CC_REGNUM) (compare:CC (match_dup 1) (const_int 0)))
10135	      (set (match_dup 0) (match_dup 1))])]
10136  ""
10137)
10138
10139(define_split
10140  [(set (match_operand:SI 0 "s_register_operand" "")
10141	(and:SI (ge:SI (match_operand:SI 1 "s_register_operand" "")
10142		       (const_int 0))
10143		(neg:SI (match_operator:SI 2 "arm_comparison_operator"
10144			 [(match_operand:SI 3 "s_register_operand" "")
10145			  (match_operand:SI 4 "arm_rhs_operand" "")]))))
10146   (clobber (match_operand:SI 5 "s_register_operand" ""))]
10147  "TARGET_ARM"
10148  [(set (match_dup 5) (not:SI (ashiftrt:SI (match_dup 1) (const_int 31))))
10149   (set (match_dup 0) (and:SI (match_op_dup 2 [(match_dup 3) (match_dup 4)])
10150			      (match_dup 5)))]
10151  ""
10152)
10153
10154;; This split can be used because CC_Z mode implies that the following
10155;; branch will be an equality, or an unsigned inequality, so the sign
10156;; extension is not needed.
10157
10158(define_split
10159  [(set (reg:CC_Z CC_REGNUM)
10160	(compare:CC_Z
10161	 (ashift:SI (subreg:SI (match_operand:QI 0 "memory_operand" "") 0)
10162		    (const_int 24))
10163	 (match_operand 1 "const_int_operand" "")))
10164   (clobber (match_scratch:SI 2 ""))]
10165  "TARGET_ARM
10166   && (((unsigned HOST_WIDE_INT) INTVAL (operands[1]))
10167       == (((unsigned HOST_WIDE_INT) INTVAL (operands[1])) >> 24) << 24)"
10168  [(set (match_dup 2) (zero_extend:SI (match_dup 0)))
10169   (set (reg:CC CC_REGNUM) (compare:CC (match_dup 2) (match_dup 1)))]
10170  "
10171  operands[1] = GEN_INT (((unsigned long) INTVAL (operands[1])) >> 24);
10172  "
10173)
10174;; ??? Check the patterns above for Thumb-2 usefulness
10175
10176(define_expand "prologue"
10177  [(clobber (const_int 0))]
10178  "TARGET_EITHER"
10179  "if (TARGET_32BIT)
10180     arm_expand_prologue ();
10181   else
10182     thumb1_expand_prologue ();
10183  DONE;
10184  "
10185)
10186
10187(define_expand "epilogue"
10188  [(clobber (const_int 0))]
10189  "TARGET_EITHER"
10190  "
10191  if (crtl->calls_eh_return)
10192    emit_insn (gen_force_register_use (gen_rtx_REG (Pmode, 2)));
10193  if (TARGET_THUMB1)
10194   {
10195     thumb1_expand_epilogue ();
10196     emit_jump_insn (gen_rtx_UNSPEC_VOLATILE (VOIDmode,
10197                     gen_rtvec (1, ret_rtx), VUNSPEC_EPILOGUE));
10198   }
10199  else if (HAVE_return)
10200   {
10201     /* HAVE_return is testing for USE_RETURN_INSN (FALSE).  Hence,
10202        no need for explicit testing again.  */
10203     emit_jump_insn (gen_return ());
10204   }
10205  else if (TARGET_32BIT)
10206   {
10207    arm_expand_epilogue (true);
10208   }
10209  DONE;
10210  "
10211)
10212
10213;; Note - although unspec_volatile's USE all hard registers,
10214;; USEs are ignored after relaod has completed.  Thus we need
10215;; to add an unspec of the link register to ensure that flow
10216;; does not think that it is unused by the sibcall branch that
10217;; will replace the standard function epilogue.
10218(define_expand "sibcall_epilogue"
10219   [(parallel [(unspec:SI [(reg:SI LR_REGNUM)] UNSPEC_REGISTER_USE)
10220               (unspec_volatile [(return)] VUNSPEC_EPILOGUE)])]
10221   "TARGET_32BIT"
10222   "
10223   arm_expand_epilogue (false);
10224   DONE;
10225   "
10226)
10227
10228(define_expand "eh_epilogue"
10229  [(use (match_operand:SI 0 "register_operand" ""))
10230   (use (match_operand:SI 1 "register_operand" ""))
10231   (use (match_operand:SI 2 "register_operand" ""))]
10232  "TARGET_EITHER"
10233  "
10234  {
10235    cfun->machine->eh_epilogue_sp_ofs = operands[1];
10236    if (!REG_P (operands[2]) || REGNO (operands[2]) != 2)
10237      {
10238	rtx ra = gen_rtx_REG (Pmode, 2);
10239
10240	emit_move_insn (ra, operands[2]);
10241	operands[2] = ra;
10242      }
10243    /* This is a hack -- we may have crystalized the function type too
10244       early.  */
10245    cfun->machine->func_type = 0;
10246  }"
10247)
10248
10249;; This split is only used during output to reduce the number of patterns
10250;; that need assembler instructions adding to them.  We allowed the setting
10251;; of the conditions to be implicit during rtl generation so that
10252;; the conditional compare patterns would work.  However this conflicts to
10253;; some extent with the conditional data operations, so we have to split them
10254;; up again here.
10255
10256;; ??? Need to audit these splitters for Thumb-2.  Why isn't normal
10257;; conditional execution sufficient?
10258
10259(define_split
10260  [(set (match_operand:SI 0 "s_register_operand" "")
10261	(if_then_else:SI (match_operator 1 "arm_comparison_operator"
10262			  [(match_operand 2 "" "") (match_operand 3 "" "")])
10263			 (match_dup 0)
10264			 (match_operand 4 "" "")))
10265   (clobber (reg:CC CC_REGNUM))]
10266  "TARGET_ARM && reload_completed"
10267  [(set (match_dup 5) (match_dup 6))
10268   (cond_exec (match_dup 7)
10269	      (set (match_dup 0) (match_dup 4)))]
10270  "
10271  {
10272    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
10273					     operands[2], operands[3]);
10274    enum rtx_code rc = GET_CODE (operands[1]);
10275
10276    operands[5] = gen_rtx_REG (mode, CC_REGNUM);
10277    operands[6] = gen_rtx_COMPARE (mode, operands[2], operands[3]);
10278    if (mode == CCFPmode || mode == CCFPEmode)
10279      rc = reverse_condition_maybe_unordered (rc);
10280    else
10281      rc = reverse_condition (rc);
10282
10283    operands[7] = gen_rtx_fmt_ee (rc, VOIDmode, operands[5], const0_rtx);
10284  }"
10285)
10286
10287(define_split
10288  [(set (match_operand:SI 0 "s_register_operand" "")
10289	(if_then_else:SI (match_operator 1 "arm_comparison_operator"
10290			  [(match_operand 2 "" "") (match_operand 3 "" "")])
10291			 (match_operand 4 "" "")
10292			 (match_dup 0)))
10293   (clobber (reg:CC CC_REGNUM))]
10294  "TARGET_ARM && reload_completed"
10295  [(set (match_dup 5) (match_dup 6))
10296   (cond_exec (match_op_dup 1 [(match_dup 5) (const_int 0)])
10297	      (set (match_dup 0) (match_dup 4)))]
10298  "
10299  {
10300    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
10301					     operands[2], operands[3]);
10302
10303    operands[5] = gen_rtx_REG (mode, CC_REGNUM);
10304    operands[6] = gen_rtx_COMPARE (mode, operands[2], operands[3]);
10305  }"
10306)
10307
10308(define_split
10309  [(set (match_operand:SI 0 "s_register_operand" "")
10310	(if_then_else:SI (match_operator 1 "arm_comparison_operator"
10311			  [(match_operand 2 "" "") (match_operand 3 "" "")])
10312			 (match_operand 4 "" "")
10313			 (match_operand 5 "" "")))
10314   (clobber (reg:CC CC_REGNUM))]
10315  "TARGET_ARM && reload_completed"
10316  [(set (match_dup 6) (match_dup 7))
10317   (cond_exec (match_op_dup 1 [(match_dup 6) (const_int 0)])
10318	      (set (match_dup 0) (match_dup 4)))
10319   (cond_exec (match_dup 8)
10320	      (set (match_dup 0) (match_dup 5)))]
10321  "
10322  {
10323    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
10324					     operands[2], operands[3]);
10325    enum rtx_code rc = GET_CODE (operands[1]);
10326
10327    operands[6] = gen_rtx_REG (mode, CC_REGNUM);
10328    operands[7] = gen_rtx_COMPARE (mode, operands[2], operands[3]);
10329    if (mode == CCFPmode || mode == CCFPEmode)
10330      rc = reverse_condition_maybe_unordered (rc);
10331    else
10332      rc = reverse_condition (rc);
10333
10334    operands[8] = gen_rtx_fmt_ee (rc, VOIDmode, operands[6], const0_rtx);
10335  }"
10336)
10337
10338(define_split
10339  [(set (match_operand:SI 0 "s_register_operand" "")
10340	(if_then_else:SI (match_operator 1 "arm_comparison_operator"
10341			  [(match_operand:SI 2 "s_register_operand" "")
10342			   (match_operand:SI 3 "arm_add_operand" "")])
10343			 (match_operand:SI 4 "arm_rhs_operand" "")
10344			 (not:SI
10345			  (match_operand:SI 5 "s_register_operand" ""))))
10346   (clobber (reg:CC CC_REGNUM))]
10347  "TARGET_ARM && reload_completed"
10348  [(set (match_dup 6) (match_dup 7))
10349   (cond_exec (match_op_dup 1 [(match_dup 6) (const_int 0)])
10350	      (set (match_dup 0) (match_dup 4)))
10351   (cond_exec (match_dup 8)
10352	      (set (match_dup 0) (not:SI (match_dup 5))))]
10353  "
10354  {
10355    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
10356					     operands[2], operands[3]);
10357    enum rtx_code rc = GET_CODE (operands[1]);
10358
10359    operands[6] = gen_rtx_REG (mode, CC_REGNUM);
10360    operands[7] = gen_rtx_COMPARE (mode, operands[2], operands[3]);
10361    if (mode == CCFPmode || mode == CCFPEmode)
10362      rc = reverse_condition_maybe_unordered (rc);
10363    else
10364      rc = reverse_condition (rc);
10365
10366    operands[8] = gen_rtx_fmt_ee (rc, VOIDmode, operands[6], const0_rtx);
10367  }"
10368)
10369
10370(define_insn "*cond_move_not"
10371  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10372	(if_then_else:SI (match_operator 4 "arm_comparison_operator"
10373			  [(match_operand 3 "cc_register" "") (const_int 0)])
10374			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")
10375			 (not:SI
10376			  (match_operand:SI 2 "s_register_operand" "r,r"))))]
10377  "TARGET_ARM"
10378  "@
10379   mvn%D4\\t%0, %2
10380   mov%d4\\t%0, %1\;mvn%D4\\t%0, %2"
10381  [(set_attr "conds" "use")
10382   (set_attr "type" "mvn_reg,multiple")
10383   (set_attr "length" "4,8")]
10384)
10385
10386;; The next two patterns occur when an AND operation is followed by a
10387;; scc insn sequence 
10388
10389(define_insn "*sign_extract_onebit"
10390  [(set (match_operand:SI 0 "s_register_operand" "=r")
10391	(sign_extract:SI (match_operand:SI 1 "s_register_operand" "r")
10392			 (const_int 1)
10393			 (match_operand:SI 2 "const_int_operand" "n")))
10394    (clobber (reg:CC CC_REGNUM))]
10395  "TARGET_ARM"
10396  "*
10397    operands[2] = GEN_INT (1 << INTVAL (operands[2]));
10398    output_asm_insn (\"ands\\t%0, %1, %2\", operands);
10399    return \"mvnne\\t%0, #0\";
10400  "
10401  [(set_attr "conds" "clob")
10402   (set_attr "length" "8")
10403   (set_attr "type" "multiple")]
10404)
10405
10406(define_insn "*not_signextract_onebit"
10407  [(set (match_operand:SI 0 "s_register_operand" "=r")
10408	(not:SI
10409	 (sign_extract:SI (match_operand:SI 1 "s_register_operand" "r")
10410			  (const_int 1)
10411			  (match_operand:SI 2 "const_int_operand" "n"))))
10412   (clobber (reg:CC CC_REGNUM))]
10413  "TARGET_ARM"
10414  "*
10415    operands[2] = GEN_INT (1 << INTVAL (operands[2]));
10416    output_asm_insn (\"tst\\t%1, %2\", operands);
10417    output_asm_insn (\"mvneq\\t%0, #0\", operands);
10418    return \"movne\\t%0, #0\";
10419  "
10420  [(set_attr "conds" "clob")
10421   (set_attr "length" "12")
10422   (set_attr "type" "multiple")]
10423)
10424;; ??? The above patterns need auditing for Thumb-2
10425
10426;; Push multiple registers to the stack.  Registers are in parallel (use ...)
10427;; expressions.  For simplicity, the first register is also in the unspec
10428;; part.
10429;; To avoid the usage of GNU extension, the length attribute is computed
10430;; in a C function arm_attr_length_push_multi.
10431(define_insn "*push_multi"
10432  [(match_parallel 2 "multi_register_push"
10433    [(set (match_operand:BLK 0 "push_mult_memory_operand" "")
10434	  (unspec:BLK [(match_operand:SI 1 "s_register_operand" "")]
10435		      UNSPEC_PUSH_MULT))])]
10436  ""
10437  "*
10438  {
10439    int num_saves = XVECLEN (operands[2], 0);
10440     
10441    /* For the StrongARM at least it is faster to
10442       use STR to store only a single register.
10443       In Thumb mode always use push, and the assembler will pick
10444       something appropriate.  */
10445    if (num_saves == 1 && TARGET_ARM)
10446      output_asm_insn (\"str%?\\t%1, [%m0, #-4]!\", operands);
10447    else
10448      {
10449	int i;
10450	char pattern[100];
10451
10452	if (TARGET_ARM)
10453	    strcpy (pattern, \"stm%(fd%)\\t%m0!, {%1\");
10454	else if (TARGET_THUMB2)
10455	    strcpy (pattern, \"push%?\\t{%1\");
10456	else
10457	    strcpy (pattern, \"push\\t{%1\");
10458
10459	for (i = 1; i < num_saves; i++)
10460	  {
10461	    strcat (pattern, \", %|\");
10462	    strcat (pattern,
10463		    reg_names[REGNO (XEXP (XVECEXP (operands[2], 0, i), 0))]);
10464	  }
10465
10466	strcat (pattern, \"}\");
10467	output_asm_insn (pattern, operands);
10468      }
10469
10470    return \"\";
10471  }"
10472  [(set_attr "type" "store4")
10473   (set (attr "length")
10474	(symbol_ref "arm_attr_length_push_multi (operands[2], operands[1])"))]
10475)
10476
10477(define_insn "stack_tie"
10478  [(set (mem:BLK (scratch))
10479	(unspec:BLK [(match_operand:SI 0 "s_register_operand" "rk")
10480		     (match_operand:SI 1 "s_register_operand" "rk")]
10481		    UNSPEC_PRLG_STK))]
10482  ""
10483  ""
10484  [(set_attr "length" "0")
10485   (set_attr "type" "block")]
10486)
10487
10488;; Pop (as used in epilogue RTL)
10489;;
10490(define_insn "*load_multiple_with_writeback"
10491  [(match_parallel 0 "load_multiple_operation"
10492    [(set (match_operand:SI 1 "s_register_operand" "+rk")
10493          (plus:SI (match_dup 1)
10494                   (match_operand:SI 2 "const_int_I_operand" "I")))
10495     (set (match_operand:SI 3 "s_register_operand" "=rk")
10496          (mem:SI (match_dup 1)))
10497        ])]
10498  "TARGET_32BIT && (reload_in_progress || reload_completed)"
10499  "*
10500  {
10501    arm_output_multireg_pop (operands, /*return_pc=*/false,
10502                                       /*cond=*/const_true_rtx,
10503                                       /*reverse=*/false,
10504                                       /*update=*/true);
10505    return \"\";
10506  }
10507  "
10508  [(set_attr "type" "load4")
10509   (set_attr "predicable" "yes")]
10510)
10511
10512;; Pop with return (as used in epilogue RTL)
10513;;
10514;; This instruction is generated when the registers are popped at the end of
10515;; epilogue.  Here, instead of popping the value into LR and then generating
10516;; jump to LR, value is popped into PC directly.  Hence, the pattern is combined
10517;;  with (return).
10518(define_insn "*pop_multiple_with_writeback_and_return"
10519  [(match_parallel 0 "pop_multiple_return"
10520    [(return)
10521     (set (match_operand:SI 1 "s_register_operand" "+rk")
10522          (plus:SI (match_dup 1)
10523                   (match_operand:SI 2 "const_int_I_operand" "I")))
10524     (set (match_operand:SI 3 "s_register_operand" "=rk")
10525          (mem:SI (match_dup 1)))
10526        ])]
10527  "TARGET_32BIT && (reload_in_progress || reload_completed)"
10528  "*
10529  {
10530    arm_output_multireg_pop (operands, /*return_pc=*/true,
10531                                       /*cond=*/const_true_rtx,
10532                                       /*reverse=*/false,
10533                                       /*update=*/true);
10534    return \"\";
10535  }
10536  "
10537  [(set_attr "type" "load4")
10538   (set_attr "predicable" "yes")]
10539)
10540
10541(define_insn "*pop_multiple_with_return"
10542  [(match_parallel 0 "pop_multiple_return"
10543    [(return)
10544     (set (match_operand:SI 2 "s_register_operand" "=rk")
10545          (mem:SI (match_operand:SI 1 "s_register_operand" "rk")))
10546        ])]
10547  "TARGET_32BIT && (reload_in_progress || reload_completed)"
10548  "*
10549  {
10550    arm_output_multireg_pop (operands, /*return_pc=*/true,
10551                                       /*cond=*/const_true_rtx,
10552                                       /*reverse=*/false,
10553                                       /*update=*/false);
10554    return \"\";
10555  }
10556  "
10557  [(set_attr "type" "load4")
10558   (set_attr "predicable" "yes")]
10559)
10560
10561;; Load into PC and return
10562(define_insn "*ldr_with_return"
10563  [(return)
10564   (set (reg:SI PC_REGNUM)
10565        (mem:SI (post_inc:SI (match_operand:SI 0 "s_register_operand" "+rk"))))]
10566  "TARGET_32BIT && (reload_in_progress || reload_completed)"
10567  "ldr%?\t%|pc, [%0], #4"
10568  [(set_attr "type" "load1")
10569   (set_attr "predicable" "yes")]
10570)
10571;; Pop for floating point registers (as used in epilogue RTL)
10572(define_insn "*vfp_pop_multiple_with_writeback"
10573  [(match_parallel 0 "pop_multiple_fp"
10574    [(set (match_operand:SI 1 "s_register_operand" "+rk")
10575          (plus:SI (match_dup 1)
10576                   (match_operand:SI 2 "const_int_I_operand" "I")))
10577     (set (match_operand:DF 3 "vfp_hard_register_operand" "")
10578          (mem:DF (match_dup 1)))])]
10579  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP"
10580  "*
10581  {
10582    int num_regs = XVECLEN (operands[0], 0);
10583    char pattern[100];
10584    rtx op_list[2];
10585    strcpy (pattern, \"vldm\\t\");
10586    strcat (pattern, reg_names[REGNO (SET_DEST (XVECEXP (operands[0], 0, 0)))]);
10587    strcat (pattern, \"!, {\");
10588    op_list[0] = XEXP (XVECEXP (operands[0], 0, 1), 0);
10589    strcat (pattern, \"%P0\");
10590    if ((num_regs - 1) > 1)
10591      {
10592        strcat (pattern, \"-%P1\");
10593        op_list [1] = XEXP (XVECEXP (operands[0], 0, num_regs - 1), 0);
10594      }
10595
10596    strcat (pattern, \"}\");
10597    output_asm_insn (pattern, op_list);
10598    return \"\";
10599  }
10600  "
10601  [(set_attr "type" "load4")
10602   (set_attr "conds" "unconditional")
10603   (set_attr "predicable" "no")]
10604)
10605
10606;; Special patterns for dealing with the constant pool
10607
10608(define_insn "align_4"
10609  [(unspec_volatile [(const_int 0)] VUNSPEC_ALIGN)]
10610  "TARGET_EITHER"
10611  "*
10612  assemble_align (32);
10613  return \"\";
10614  "
10615  [(set_attr "type" "no_insn")]
10616)
10617
10618(define_insn "align_8"
10619  [(unspec_volatile [(const_int 0)] VUNSPEC_ALIGN8)]
10620  "TARGET_EITHER"
10621  "*
10622  assemble_align (64);
10623  return \"\";
10624  "
10625  [(set_attr "type" "no_insn")]
10626)
10627
10628(define_insn "consttable_end"
10629  [(unspec_volatile [(const_int 0)] VUNSPEC_POOL_END)]
10630  "TARGET_EITHER"
10631  "*
10632  making_const_table = FALSE;
10633  return \"\";
10634  "
10635  [(set_attr "type" "no_insn")]
10636)
10637
10638(define_insn "consttable_1"
10639  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_1)]
10640  "TARGET_EITHER"
10641  "*
10642  making_const_table = TRUE;
10643  assemble_integer (operands[0], 1, BITS_PER_WORD, 1);
10644  assemble_zeros (3);
10645  return \"\";
10646  "
10647  [(set_attr "length" "4")
10648   (set_attr "type" "no_insn")]
10649)
10650
10651(define_insn "consttable_2"
10652  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_2)]
10653  "TARGET_EITHER"
10654  "*
10655  {
10656    rtx x = operands[0];
10657    making_const_table = TRUE;
10658    switch (GET_MODE_CLASS (GET_MODE (x)))
10659      {
10660      case MODE_FLOAT:
10661	arm_emit_fp16_const (x);
10662	break;
10663      default:
10664	assemble_integer (operands[0], 2, BITS_PER_WORD, 1);
10665	assemble_zeros (2);
10666	break;
10667      }
10668    return \"\";
10669  }"
10670  [(set_attr "length" "4")
10671   (set_attr "type" "no_insn")]
10672)
10673
10674(define_insn "consttable_4"
10675  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_4)]
10676  "TARGET_EITHER"
10677  "*
10678  {
10679    rtx x = operands[0];
10680    making_const_table = TRUE;
10681    switch (GET_MODE_CLASS (GET_MODE (x)))
10682      {
10683      case MODE_FLOAT:
10684	{
10685	  REAL_VALUE_TYPE r;
10686	  REAL_VALUE_FROM_CONST_DOUBLE (r, x);
10687	  assemble_real (r, GET_MODE (x), BITS_PER_WORD);
10688	  break;
10689	}
10690      default:
10691	/* XXX: Sometimes gcc does something really dumb and ends up with
10692	   a HIGH in a constant pool entry, usually because it's trying to
10693	   load into a VFP register.  We know this will always be used in
10694	   combination with a LO_SUM which ignores the high bits, so just
10695	   strip off the HIGH.  */
10696	if (GET_CODE (x) == HIGH)
10697	  x = XEXP (x, 0);
10698        assemble_integer (x, 4, BITS_PER_WORD, 1);
10699	mark_symbol_refs_as_used (x);
10700        break;
10701      }
10702    return \"\";
10703  }"
10704  [(set_attr "length" "4")
10705   (set_attr "type" "no_insn")]
10706)
10707
10708(define_insn "consttable_8"
10709  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_8)]
10710  "TARGET_EITHER"
10711  "*
10712  {
10713    making_const_table = TRUE;
10714    switch (GET_MODE_CLASS (GET_MODE (operands[0])))
10715      {
10716       case MODE_FLOAT:
10717        {
10718          REAL_VALUE_TYPE r;
10719          REAL_VALUE_FROM_CONST_DOUBLE (r, operands[0]);
10720          assemble_real (r, GET_MODE (operands[0]), BITS_PER_WORD);
10721          break;
10722        }
10723      default:
10724        assemble_integer (operands[0], 8, BITS_PER_WORD, 1);
10725        break;
10726      }
10727    return \"\";
10728  }"
10729  [(set_attr "length" "8")
10730   (set_attr "type" "no_insn")]
10731)
10732
10733(define_insn "consttable_16"
10734  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_16)]
10735  "TARGET_EITHER"
10736  "*
10737  {
10738    making_const_table = TRUE;
10739    switch (GET_MODE_CLASS (GET_MODE (operands[0])))
10740      {
10741       case MODE_FLOAT:
10742        {
10743          REAL_VALUE_TYPE r;
10744          REAL_VALUE_FROM_CONST_DOUBLE (r, operands[0]);
10745          assemble_real (r, GET_MODE (operands[0]), BITS_PER_WORD);
10746          break;
10747        }
10748      default:
10749        assemble_integer (operands[0], 16, BITS_PER_WORD, 1);
10750        break;
10751      }
10752    return \"\";
10753  }"
10754  [(set_attr "length" "16")
10755   (set_attr "type" "no_insn")]
10756)
10757
10758;; V5 Instructions,
10759
10760(define_insn "clzsi2"
10761  [(set (match_operand:SI 0 "s_register_operand" "=r")
10762	(clz:SI (match_operand:SI 1 "s_register_operand" "r")))]
10763  "TARGET_32BIT && arm_arch5"
10764  "clz%?\\t%0, %1"
10765  [(set_attr "predicable" "yes")
10766   (set_attr "predicable_short_it" "no")
10767   (set_attr "type" "clz")])
10768
10769(define_insn "rbitsi2"
10770  [(set (match_operand:SI 0 "s_register_operand" "=r")
10771	(unspec:SI [(match_operand:SI 1 "s_register_operand" "r")] UNSPEC_RBIT))]
10772  "TARGET_32BIT && arm_arch_thumb2"
10773  "rbit%?\\t%0, %1"
10774  [(set_attr "predicable" "yes")
10775   (set_attr "predicable_short_it" "no")
10776   (set_attr "type" "clz")])
10777
10778(define_expand "ctzsi2"
10779 [(set (match_operand:SI           0 "s_register_operand" "")
10780       (ctz:SI (match_operand:SI  1 "s_register_operand" "")))]
10781  "TARGET_32BIT && arm_arch_thumb2"
10782  "
10783   {
10784     rtx tmp = gen_reg_rtx (SImode); 
10785     emit_insn (gen_rbitsi2 (tmp, operands[1]));
10786     emit_insn (gen_clzsi2 (operands[0], tmp));
10787   }
10788   DONE;
10789  "
10790)
10791
10792;; V5E instructions.
10793
10794(define_insn "prefetch"
10795  [(prefetch (match_operand:SI 0 "address_operand" "p")
10796	     (match_operand:SI 1 "" "")
10797	     (match_operand:SI 2 "" ""))]
10798  "TARGET_32BIT && arm_arch5e"
10799  "pld\\t%a0"
10800  [(set_attr "type" "load1")]
10801)
10802
10803;; General predication pattern
10804
10805(define_cond_exec
10806  [(match_operator 0 "arm_comparison_operator"
10807    [(match_operand 1 "cc_register" "")
10808     (const_int 0)])]
10809  "TARGET_32BIT
10810   && (!TARGET_NO_VOLATILE_CE || !volatile_refs_p (PATTERN (insn)))"
10811  ""
10812[(set_attr "predicated" "yes")]
10813)
10814
10815(define_insn "force_register_use"
10816  [(unspec:SI [(match_operand:SI 0 "register_operand" "")] UNSPEC_REGISTER_USE)]
10817  ""
10818  "%@ %0 needed"
10819  [(set_attr "length" "0")
10820   (set_attr "type" "no_insn")]
10821)
10822
10823
10824;; Patterns for exception handling
10825
10826(define_expand "eh_return"
10827  [(use (match_operand 0 "general_operand" ""))]
10828  "TARGET_EITHER"
10829  "
10830  {
10831    if (TARGET_32BIT)
10832      emit_insn (gen_arm_eh_return (operands[0]));
10833    else
10834      emit_insn (gen_thumb_eh_return (operands[0]));
10835    DONE;
10836  }"
10837)
10838				   
10839;; We can't expand this before we know where the link register is stored.
10840(define_insn_and_split "arm_eh_return"
10841  [(unspec_volatile [(match_operand:SI 0 "s_register_operand" "r")]
10842		    VUNSPEC_EH_RETURN)
10843   (clobber (match_scratch:SI 1 "=&r"))]
10844  "TARGET_ARM"
10845  "#"
10846  "&& reload_completed"
10847  [(const_int 0)]
10848  "
10849  {
10850    arm_set_return_address (operands[0], operands[1]);
10851    DONE;
10852  }"
10853)
10854
10855
10856;; TLS support
10857
10858(define_insn "load_tp_hard"
10859  [(set (match_operand:SI 0 "register_operand" "=r")
10860	(unspec:SI [(const_int 0)] UNSPEC_TLS))]
10861  "TARGET_HARD_TP"
10862  "mrc%?\\tp15, 0, %0, c13, c0, 3\\t@ load_tp_hard"
10863  [(set_attr "predicable" "yes")
10864   (set_attr "type" "mrs")]
10865)
10866
10867;; Doesn't clobber R1-R3.  Must use r0 for the first operand.
10868(define_insn "load_tp_soft"
10869  [(set (reg:SI 0) (unspec:SI [(const_int 0)] UNSPEC_TLS))
10870   (clobber (reg:SI LR_REGNUM))
10871   (clobber (reg:SI IP_REGNUM))
10872   (clobber (reg:CC CC_REGNUM))]
10873  "TARGET_SOFT_TP"
10874  "bl\\t__aeabi_read_tp\\t@ load_tp_soft"
10875  [(set_attr "conds" "clob")
10876   (set_attr "type" "branch")]
10877)
10878
10879;; tls descriptor call
10880(define_insn "tlscall"
10881  [(set (reg:SI R0_REGNUM)
10882        (unspec:SI [(reg:SI R0_REGNUM)
10883                    (match_operand:SI 0 "" "X")
10884	            (match_operand 1 "" "")] UNSPEC_TLS))
10885   (clobber (reg:SI R1_REGNUM))
10886   (clobber (reg:SI LR_REGNUM))
10887   (clobber (reg:SI CC_REGNUM))]
10888  "TARGET_GNU2_TLS"
10889  {
10890    targetm.asm_out.internal_label (asm_out_file, "LPIC",
10891				    INTVAL (operands[1]));
10892    return "bl\\t%c0(tlscall)";
10893  }
10894  [(set_attr "conds" "clob")
10895   (set_attr "length" "4")
10896   (set_attr "type" "branch")]
10897)
10898
10899;; For thread pointer builtin
10900(define_expand "get_thread_pointersi"
10901  [(match_operand:SI 0 "s_register_operand" "=r")]
10902 ""
10903 "
10904 {
10905   arm_load_tp (operands[0]);
10906   DONE;
10907 }")
10908
10909;;
10910
10911;; We only care about the lower 16 bits of the constant 
10912;; being inserted into the upper 16 bits of the register.
10913(define_insn "*arm_movtas_ze" 
10914  [(set (zero_extract:SI (match_operand:SI 0 "s_register_operand" "+r")
10915                   (const_int 16)
10916                   (const_int 16))
10917        (match_operand:SI 1 "const_int_operand" ""))]
10918  "arm_arch_thumb2"
10919  "movt%?\t%0, %L1"
10920 [(set_attr "predicable" "yes")
10921  (set_attr "predicable_short_it" "no")
10922  (set_attr "length" "4")
10923  (set_attr "type" "mov_imm")]
10924)
10925
10926(define_insn "*arm_rev"
10927  [(set (match_operand:SI 0 "s_register_operand" "=l,l,r")
10928	(bswap:SI (match_operand:SI 1 "s_register_operand" "l,l,r")))]
10929  "arm_arch6"
10930  "@
10931   rev\t%0, %1
10932   rev%?\t%0, %1
10933   rev%?\t%0, %1"
10934  [(set_attr "arch" "t1,t2,32")
10935   (set_attr "length" "2,2,4")
10936   (set_attr "predicable" "no,yes,yes")
10937   (set_attr "predicable_short_it" "no")
10938   (set_attr "type" "rev")]
10939)
10940
10941(define_expand "arm_legacy_rev"
10942  [(set (match_operand:SI 2 "s_register_operand" "")
10943	(xor:SI (rotatert:SI (match_operand:SI 1 "s_register_operand" "")
10944			     (const_int 16))
10945		(match_dup 1)))
10946   (set (match_dup 2)
10947	(lshiftrt:SI (match_dup 2)
10948		     (const_int 8)))
10949   (set (match_operand:SI 3 "s_register_operand" "")
10950	(rotatert:SI (match_dup 1)
10951		     (const_int 8)))
10952   (set (match_dup 2)
10953	(and:SI (match_dup 2)
10954		(const_int -65281)))
10955   (set (match_operand:SI 0 "s_register_operand" "")
10956	(xor:SI (match_dup 3)
10957		(match_dup 2)))]
10958  "TARGET_32BIT"
10959  ""
10960)
10961
10962;; Reuse temporaries to keep register pressure down.
10963(define_expand "thumb_legacy_rev"
10964  [(set (match_operand:SI 2 "s_register_operand" "")
10965     (ashift:SI (match_operand:SI 1 "s_register_operand" "")
10966                (const_int 24)))
10967   (set (match_operand:SI 3 "s_register_operand" "")
10968     (lshiftrt:SI (match_dup 1)
10969		  (const_int 24)))
10970   (set (match_dup 3)
10971     (ior:SI (match_dup 3)
10972	     (match_dup 2)))
10973   (set (match_operand:SI 4 "s_register_operand" "")
10974     (const_int 16))
10975   (set (match_operand:SI 5 "s_register_operand" "")
10976     (rotatert:SI (match_dup 1)
10977		  (match_dup 4)))
10978   (set (match_dup 2)
10979     (ashift:SI (match_dup 5)
10980                (const_int 24)))
10981   (set (match_dup 5)
10982     (lshiftrt:SI (match_dup 5)
10983		  (const_int 24)))
10984   (set (match_dup 5)
10985     (ior:SI (match_dup 5)
10986	     (match_dup 2)))
10987   (set (match_dup 5)
10988     (rotatert:SI (match_dup 5)
10989		  (match_dup 4)))
10990   (set (match_operand:SI 0 "s_register_operand" "")
10991     (ior:SI (match_dup 5)
10992             (match_dup 3)))]
10993  "TARGET_THUMB"
10994  ""
10995)
10996
10997(define_expand "bswapsi2"
10998  [(set (match_operand:SI 0 "s_register_operand" "=r")
10999  	(bswap:SI (match_operand:SI 1 "s_register_operand" "r")))]
11000"TARGET_EITHER && (arm_arch6 || !optimize_size)"
11001"
11002    if (!arm_arch6)
11003      {
11004	rtx op2 = gen_reg_rtx (SImode);
11005	rtx op3 = gen_reg_rtx (SImode);
11006
11007	if (TARGET_THUMB)
11008	  {
11009	    rtx op4 = gen_reg_rtx (SImode);
11010	    rtx op5 = gen_reg_rtx (SImode);
11011
11012	    emit_insn (gen_thumb_legacy_rev (operands[0], operands[1],
11013					     op2, op3, op4, op5));
11014	  }
11015	else
11016	  {
11017	    emit_insn (gen_arm_legacy_rev (operands[0], operands[1],
11018					   op2, op3));
11019	  }
11020
11021	DONE;
11022      }
11023  "
11024)
11025
11026;; bswap16 patterns: use revsh and rev16 instructions for the signed
11027;; and unsigned variants, respectively. For rev16, expose
11028;; byte-swapping in the lower 16 bits only.
11029(define_insn "*arm_revsh"
11030  [(set (match_operand:SI 0 "s_register_operand" "=l,l,r")
11031	(sign_extend:SI (bswap:HI (match_operand:HI 1 "s_register_operand" "l,l,r"))))]
11032  "arm_arch6"
11033  "@
11034  revsh\t%0, %1
11035  revsh%?\t%0, %1
11036  revsh%?\t%0, %1"
11037  [(set_attr "arch" "t1,t2,32")
11038   (set_attr "length" "2,2,4")
11039   (set_attr "type" "rev")]
11040)
11041
11042(define_insn "*arm_rev16"
11043  [(set (match_operand:HI 0 "s_register_operand" "=l,l,r")
11044	(bswap:HI (match_operand:HI 1 "s_register_operand" "l,l,r")))]
11045  "arm_arch6"
11046  "@
11047   rev16\t%0, %1
11048   rev16%?\t%0, %1
11049   rev16%?\t%0, %1"
11050  [(set_attr "arch" "t1,t2,32")
11051   (set_attr "length" "2,2,4")
11052   (set_attr "type" "rev")]
11053)
11054
11055;; There are no canonicalisation rules for the position of the lshiftrt, ashift
11056;; operations within an IOR/AND RTX, therefore we have two patterns matching
11057;; each valid permutation.
11058
11059(define_insn "arm_rev16si2"
11060  [(set (match_operand:SI 0 "register_operand" "=l,l,r")
11061        (ior:SI (and:SI (ashift:SI (match_operand:SI 1 "register_operand" "l,l,r")
11062                                   (const_int 8))
11063                        (match_operand:SI 3 "const_int_operand" "n,n,n"))
11064                (and:SI (lshiftrt:SI (match_dup 1)
11065                                     (const_int 8))
11066                        (match_operand:SI 2 "const_int_operand" "n,n,n"))))]
11067  "arm_arch6
11068   && aarch_rev16_shleft_mask_imm_p (operands[3], SImode)
11069   && aarch_rev16_shright_mask_imm_p (operands[2], SImode)"
11070  "rev16\\t%0, %1"
11071  [(set_attr "arch" "t1,t2,32")
11072   (set_attr "length" "2,2,4")
11073   (set_attr "type" "rev")]
11074)
11075
11076(define_insn "arm_rev16si2_alt"
11077  [(set (match_operand:SI 0 "register_operand" "=l,l,r")
11078        (ior:SI (and:SI (lshiftrt:SI (match_operand:SI 1 "register_operand" "l,l,r")
11079                                     (const_int 8))
11080                        (match_operand:SI 2 "const_int_operand" "n,n,n"))
11081                (and:SI (ashift:SI (match_dup 1)
11082                                   (const_int 8))
11083                        (match_operand:SI 3 "const_int_operand" "n,n,n"))))]
11084  "arm_arch6
11085   && aarch_rev16_shleft_mask_imm_p (operands[3], SImode)
11086   && aarch_rev16_shright_mask_imm_p (operands[2], SImode)"
11087  "rev16\\t%0, %1"
11088  [(set_attr "arch" "t1,t2,32")
11089   (set_attr "length" "2,2,4")
11090   (set_attr "type" "rev")]
11091)
11092
11093(define_expand "bswaphi2"
11094  [(set (match_operand:HI 0 "s_register_operand" "=r")
11095	(bswap:HI (match_operand:HI 1 "s_register_operand" "r")))]
11096"arm_arch6"
11097""
11098)
11099
11100;; Patterns for LDRD/STRD in Thumb2 mode
11101
11102(define_insn "*thumb2_ldrd"
11103  [(set (match_operand:SI 0 "s_register_operand" "=r")
11104        (mem:SI (plus:SI (match_operand:SI 1 "s_register_operand" "rk")
11105                         (match_operand:SI 2 "ldrd_strd_offset_operand" "Do"))))
11106   (set (match_operand:SI 3 "s_register_operand" "=r")
11107        (mem:SI (plus:SI (match_dup 1)
11108                         (match_operand:SI 4 "const_int_operand" ""))))]
11109  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11110     && current_tune->prefer_ldrd_strd
11111     && ((INTVAL (operands[2]) + 4) == INTVAL (operands[4]))
11112     && (operands_ok_ldrd_strd (operands[0], operands[3],
11113                                  operands[1], INTVAL (operands[2]),
11114                                  false, true))"
11115  "ldrd%?\t%0, %3, [%1, %2]"
11116  [(set_attr "type" "load2")
11117   (set_attr "predicable" "yes")
11118   (set_attr "predicable_short_it" "no")])
11119
11120(define_insn "*thumb2_ldrd_base"
11121  [(set (match_operand:SI 0 "s_register_operand" "=r")
11122        (mem:SI (match_operand:SI 1 "s_register_operand" "rk")))
11123   (set (match_operand:SI 2 "s_register_operand" "=r")
11124        (mem:SI (plus:SI (match_dup 1)
11125                         (const_int 4))))]
11126  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11127     && current_tune->prefer_ldrd_strd
11128     && (operands_ok_ldrd_strd (operands[0], operands[2],
11129                                  operands[1], 0, false, true))"
11130  "ldrd%?\t%0, %2, [%1]"
11131  [(set_attr "type" "load2")
11132   (set_attr "predicable" "yes")
11133   (set_attr "predicable_short_it" "no")])
11134
11135(define_insn "*thumb2_ldrd_base_neg"
11136  [(set (match_operand:SI 0 "s_register_operand" "=r")
11137	(mem:SI (plus:SI (match_operand:SI 1 "s_register_operand" "rk")
11138                         (const_int -4))))
11139   (set (match_operand:SI 2 "s_register_operand" "=r")
11140        (mem:SI (match_dup 1)))]
11141  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11142     && current_tune->prefer_ldrd_strd
11143     && (operands_ok_ldrd_strd (operands[0], operands[2],
11144                                  operands[1], -4, false, true))"
11145  "ldrd%?\t%0, %2, [%1, #-4]"
11146  [(set_attr "type" "load2")
11147   (set_attr "predicable" "yes")
11148   (set_attr "predicable_short_it" "no")])
11149
11150(define_insn "*thumb2_strd"
11151  [(set (mem:SI (plus:SI (match_operand:SI 0 "s_register_operand" "rk")
11152                         (match_operand:SI 1 "ldrd_strd_offset_operand" "Do")))
11153        (match_operand:SI 2 "s_register_operand" "r"))
11154   (set (mem:SI (plus:SI (match_dup 0)
11155                         (match_operand:SI 3 "const_int_operand" "")))
11156        (match_operand:SI 4 "s_register_operand" "r"))]
11157  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11158     && current_tune->prefer_ldrd_strd
11159     && ((INTVAL (operands[1]) + 4) == INTVAL (operands[3]))
11160     && (operands_ok_ldrd_strd (operands[2], operands[4],
11161                                  operands[0], INTVAL (operands[1]),
11162                                  false, false))"
11163  "strd%?\t%2, %4, [%0, %1]"
11164  [(set_attr "type" "store2")
11165   (set_attr "predicable" "yes")
11166   (set_attr "predicable_short_it" "no")])
11167
11168(define_insn "*thumb2_strd_base"
11169  [(set (mem:SI (match_operand:SI 0 "s_register_operand" "rk"))
11170        (match_operand:SI 1 "s_register_operand" "r"))
11171   (set (mem:SI (plus:SI (match_dup 0)
11172                         (const_int 4)))
11173        (match_operand:SI 2 "s_register_operand" "r"))]
11174  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11175     && current_tune->prefer_ldrd_strd
11176     && (operands_ok_ldrd_strd (operands[1], operands[2],
11177                                  operands[0], 0, false, false))"
11178  "strd%?\t%1, %2, [%0]"
11179  [(set_attr "type" "store2")
11180   (set_attr "predicable" "yes")
11181   (set_attr "predicable_short_it" "no")])
11182
11183(define_insn "*thumb2_strd_base_neg"
11184  [(set (mem:SI (plus:SI (match_operand:SI 0 "s_register_operand" "rk")
11185                         (const_int -4)))
11186        (match_operand:SI 1 "s_register_operand" "r"))
11187   (set (mem:SI (match_dup 0))
11188        (match_operand:SI 2 "s_register_operand" "r"))]
11189  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11190     && current_tune->prefer_ldrd_strd
11191     && (operands_ok_ldrd_strd (operands[1], operands[2],
11192                                  operands[0], -4, false, false))"
11193  "strd%?\t%1, %2, [%0, #-4]"
11194  [(set_attr "type" "store2")
11195   (set_attr "predicable" "yes")
11196   (set_attr "predicable_short_it" "no")])
11197
11198;; ARMv8 CRC32 instructions.
11199(define_insn "<crc_variant>"
11200  [(set (match_operand:SI 0 "s_register_operand" "=r")
11201        (unspec:SI [(match_operand:SI 1 "s_register_operand" "r")
11202                    (match_operand:<crc_mode> 2 "s_register_operand" "r")]
11203         CRC))]
11204  "TARGET_CRC32"
11205  "<crc_variant>\\t%0, %1, %2"
11206  [(set_attr "type" "crc")
11207   (set_attr "conds" "unconditional")]
11208)
11209
11210;; Load the load/store double peephole optimizations.
11211(include "ldrdstrd.md")
11212
11213;; Load the load/store multiple patterns
11214(include "ldmstm.md")
11215
11216;; Patterns in ldmstm.md don't cover more than 4 registers. This pattern covers
11217;; large lists without explicit writeback generated for APCS_FRAME epilogue.
11218(define_insn "*load_multiple"
11219  [(match_parallel 0 "load_multiple_operation"
11220    [(set (match_operand:SI 2 "s_register_operand" "=rk")
11221          (mem:SI (match_operand:SI 1 "s_register_operand" "rk")))
11222        ])]
11223  "TARGET_32BIT"
11224  "*
11225  {
11226    arm_output_multireg_pop (operands, /*return_pc=*/false,
11227                                       /*cond=*/const_true_rtx,
11228                                       /*reverse=*/false,
11229                                       /*update=*/false);
11230    return \"\";
11231  }
11232  "
11233  [(set_attr "predicable" "yes")]
11234)
11235
11236(define_expand "copysignsf3"
11237  [(match_operand:SF 0 "register_operand")
11238   (match_operand:SF 1 "register_operand")
11239   (match_operand:SF 2 "register_operand")]
11240  "TARGET_SOFT_FLOAT && arm_arch_thumb2"
11241  "{
11242     emit_move_insn (operands[0], operands[2]);
11243     emit_insn (gen_insv_t2 (simplify_gen_subreg (SImode, operands[0], SFmode, 0),
11244		GEN_INT (31), GEN_INT (0),
11245		simplify_gen_subreg (SImode, operands[1], SFmode, 0)));
11246     DONE;
11247  }"
11248)
11249
11250(define_expand "copysigndf3"
11251  [(match_operand:DF 0 "register_operand")
11252   (match_operand:DF 1 "register_operand")
11253   (match_operand:DF 2 "register_operand")]
11254  "TARGET_SOFT_FLOAT && arm_arch_thumb2"
11255  "{
11256     rtx op0_low = gen_lowpart (SImode, operands[0]);
11257     rtx op0_high = gen_highpart (SImode, operands[0]);
11258     rtx op1_low = gen_lowpart (SImode, operands[1]);
11259     rtx op1_high = gen_highpart (SImode, operands[1]);
11260     rtx op2_high = gen_highpart (SImode, operands[2]);
11261
11262     rtx scratch1 = gen_reg_rtx (SImode);
11263     rtx scratch2 = gen_reg_rtx (SImode);
11264     emit_move_insn (scratch1, op2_high);
11265     emit_move_insn (scratch2, op1_high);
11266
11267     emit_insn(gen_rtx_SET(SImode, scratch1,
11268			   gen_rtx_LSHIFTRT (SImode, op2_high, GEN_INT(31))));
11269     emit_insn(gen_insv_t2(scratch2, GEN_INT(1), GEN_INT(31), scratch1));
11270     emit_move_insn (op0_low, op1_low);
11271     emit_move_insn (op0_high, scratch2);
11272
11273     DONE;
11274  }"
11275)
11276
11277;; Vector bits common to IWMMXT and Neon
11278(include "vec-common.md")
11279;; Load the Intel Wireless Multimedia Extension patterns
11280(include "iwmmxt.md")
11281;; Load the VFP co-processor patterns
11282(include "vfp.md")
11283;; Thumb-1 patterns
11284(include "thumb1.md")
11285;; Thumb-2 patterns
11286(include "thumb2.md")
11287;; Neon patterns
11288(include "neon.md")
11289;; Crypto patterns
11290(include "crypto.md")
11291;; Synchronization Primitives
11292(include "sync.md")
11293;; Fixed-point patterns
11294(include "arm-fixed.md")
11295