1;;- Machine description for ARM for GNU compiler
2;;  Copyright (C) 1991-2018 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   (R4_REGNUM	      4)	; Fifth CORE register
34   (IP_REGNUM	     12)	; Scratch register
35   (SP_REGNUM	     13)	; Stack pointer
36   (LR_REGNUM        14)	; Return address register
37   (PC_REGNUM	     15)	; Program counter
38   (LAST_ARM_REGNUM  15)	;
39   (CC_REGNUM       100)	; Condition code pseudo register
40   (VFPCC_REGNUM    101)	; VFP Condition code pseudo register
41  ]
42)
43;; 3rd operand to select_dominance_cc_mode
44(define_constants
45  [(DOM_CC_X_AND_Y  0)
46   (DOM_CC_NX_OR_Y  1)
47   (DOM_CC_X_OR_Y   2)
48  ]
49)
50;; conditional compare combination
51(define_constants
52  [(CMP_CMP 0)
53   (CMN_CMP 1)
54   (CMP_CMN 2)
55   (CMN_CMN 3)
56   (NUM_OF_COND_CMP 4)
57  ]
58)
59
60
61;;---------------------------------------------------------------------------
62;; Attributes
63
64;; Processor type.  This is created automatically from arm-cores.def.
65(include "arm-tune.md")
66
67;; Instruction classification types
68(include "types.md")
69
70; IS_THUMB is set to 'yes' when we are generating Thumb code, and 'no' when
71; generating ARM code.  This is used to control the length of some insn
72; patterns that share the same RTL in both ARM and Thumb code.
73(define_attr "is_thumb" "yes,no"
74  (const (if_then_else (symbol_ref "TARGET_THUMB")
75		       (const_string "yes") (const_string "no"))))
76
77; IS_ARCH6 is set to 'yes' when we are generating code form ARMv6.
78(define_attr "is_arch6" "no,yes" (const (symbol_ref "arm_arch6")))
79
80; IS_THUMB1 is set to 'yes' iff we are generating Thumb-1 code.
81(define_attr "is_thumb1" "yes,no"
82  (const (if_then_else (symbol_ref "TARGET_THUMB1")
83		       (const_string "yes") (const_string "no"))))
84
85; Mark an instruction as suitable for "short IT" blocks in Thumb-2.
86; The arm_restrict_it flag enables the "short IT" feature which
87; restricts IT blocks to a single 16-bit instruction.
88; This attribute should only be used on 16-bit Thumb-2 instructions
89; which may be predicated (the "predicable" attribute must be set).
90(define_attr "predicable_short_it" "no,yes" (const_string "no"))
91
92; Mark an instruction as suitable for "short IT" blocks in Thumb-2.
93; This attribute should only be used on instructions which may emit
94; an IT block in their expansion which is not a short IT.
95(define_attr "enabled_for_short_it" "no,yes" (const_string "yes"))
96
97;; Operand number of an input operand that is shifted.  Zero if the
98;; given instruction does not shift one of its input operands.
99(define_attr "shift" "" (const_int 0))
100
101;; [For compatibility with AArch64 in pipeline models]
102;; Attribute that specifies whether or not the instruction touches fp
103;; registers.
104(define_attr "fp" "no,yes" (const_string "no"))
105
106; Floating Point Unit.  If we only have floating point emulation, then there
107; is no point in scheduling the floating point insns.  (Well, for best
108; performance we should try and group them together).
109(define_attr "fpu" "none,vfp"
110  (const (symbol_ref "arm_fpu_attr")))
111
112; Predicated means that the insn form is conditionally executed based on a
113; predicate.  We default to 'no' because no Thumb patterns match this rule
114; and not all ARM insns do.
115(define_attr "predicated" "yes,no" (const_string "no"))
116
117; LENGTH of an instruction (in bytes)
118(define_attr "length" ""
119  (const_int 4))
120
121; The architecture which supports the instruction (or alternative).
122; This can be "a" for ARM, "t" for either of the Thumbs, "32" for
123; TARGET_32BIT, "t1" or "t2" to specify a specific Thumb mode.  "v6"
124; for ARM or Thumb-2 with arm_arch6, and nov6 for ARM without
125; arm_arch6.  "v6t2" for Thumb-2 with arm_arch6 and "v8mb" for ARMv8-M
126; Baseline.  This attribute is used to compute attribute "enabled",
127; use type "any" to enable an alternative in all cases.
128(define_attr "arch" "any,a,t,32,t1,t2,v6,nov6,v6t2,v8mb,neon_for_64bits,avoid_neon_for_64bits,iwmmxt,iwmmxt2,armv6_or_vfpv3,neon"
129  (const_string "any"))
130
131(define_attr "arch_enabled" "no,yes"
132  (cond [(eq_attr "arch" "any")
133	 (const_string "yes")
134
135	 (and (eq_attr "arch" "a")
136	      (match_test "TARGET_ARM"))
137	 (const_string "yes")
138
139	 (and (eq_attr "arch" "t")
140	      (match_test "TARGET_THUMB"))
141	 (const_string "yes")
142
143	 (and (eq_attr "arch" "t1")
144	      (match_test "TARGET_THUMB1"))
145	 (const_string "yes")
146
147	 (and (eq_attr "arch" "t2")
148	      (match_test "TARGET_THUMB2"))
149	 (const_string "yes")
150
151	 (and (eq_attr "arch" "32")
152	      (match_test "TARGET_32BIT"))
153	 (const_string "yes")
154
155	 (and (eq_attr "arch" "v6")
156	      (match_test "TARGET_32BIT && arm_arch6"))
157	 (const_string "yes")
158
159	 (and (eq_attr "arch" "nov6")
160	      (match_test "TARGET_32BIT && !arm_arch6"))
161	 (const_string "yes")
162
163	 (and (eq_attr "arch" "v6t2")
164	      (match_test "TARGET_32BIT && arm_arch6 && arm_arch_thumb2"))
165	 (const_string "yes")
166
167	 (and (eq_attr "arch" "v8mb")
168	      (match_test "TARGET_THUMB1 && arm_arch8"))
169	 (const_string "yes")
170
171	 (and (eq_attr "arch" "avoid_neon_for_64bits")
172	      (match_test "TARGET_NEON")
173	      (not (match_test "TARGET_PREFER_NEON_64BITS")))
174	 (const_string "yes")
175
176	 (and (eq_attr "arch" "neon_for_64bits")
177	      (match_test "TARGET_NEON")
178	      (match_test "TARGET_PREFER_NEON_64BITS"))
179	 (const_string "yes")
180
181	 (and (eq_attr "arch" "iwmmxt2")
182	      (match_test "TARGET_REALLY_IWMMXT2"))
183	 (const_string "yes")
184
185	 (and (eq_attr "arch" "armv6_or_vfpv3")
186	      (match_test "arm_arch6 || TARGET_VFP3"))
187	 (const_string "yes")
188
189	 (and (eq_attr "arch" "neon")
190	      (match_test "TARGET_NEON"))
191	 (const_string "yes")
192	]
193
194	(const_string "no")))
195
196(define_attr "opt" "any,speed,size"
197  (const_string "any"))
198
199(define_attr "opt_enabled" "no,yes"
200  (cond [(eq_attr "opt" "any")
201         (const_string "yes")
202
203	 (and (eq_attr "opt" "speed")
204	      (match_test "optimize_function_for_speed_p (cfun)"))
205	 (const_string "yes")
206
207	 (and (eq_attr "opt" "size")
208	      (match_test "optimize_function_for_size_p (cfun)"))
209	 (const_string "yes")]
210	(const_string "no")))
211
212(define_attr "use_literal_pool" "no,yes"
213   (cond [(and (eq_attr "type" "f_loads,f_loadd")
214	       (match_test "CONSTANT_P (operands[1])"))
215	  (const_string "yes")]
216	 (const_string "no")))
217
218; Enable all alternatives that are both arch_enabled and insn_enabled.
219; FIXME:: opt_enabled has been temporarily removed till the time we have
220; an attribute that allows the use of such alternatives.
221; This depends on caching of speed_p, size_p on a per
222; alternative basis. The problem is that the enabled attribute
223; cannot depend on any state that is not cached or is not constant
224; for a compilation unit. We probably need a generic "hot/cold"
225; alternative which if implemented can help with this. We disable this
226; until such a time as this is implemented and / or the improvements or
227; regressions with removing this attribute are double checked.
228; See ashldi3_neon and <shift>di3_neon in neon.md.
229
230 (define_attr "enabled" "no,yes"
231   (cond [(and (eq_attr "predicable_short_it" "no")
232	       (and (eq_attr "predicated" "yes")
233	            (match_test "arm_restrict_it")))
234	  (const_string "no")
235
236	  (and (eq_attr "enabled_for_short_it" "no")
237	       (match_test "arm_restrict_it"))
238	  (const_string "no")
239
240	  (eq_attr "arch_enabled" "no")
241	  (const_string "no")]
242	 (const_string "yes")))
243
244; POOL_RANGE is how far away from a constant pool entry that this insn
245; can be placed.  If the distance is zero, then this insn will never
246; reference the pool.
247; Note that for Thumb constant pools the PC value is rounded down to the
248; nearest multiple of four.  Therefore, THUMB2_POOL_RANGE (and POOL_RANGE for
249; Thumb insns) should be set to <max_range> - 2.
250; NEG_POOL_RANGE is nonzero for insns that can reference a constant pool entry
251; before its address.  It is set to <max_range> - (8 + <data_size>).
252(define_attr "arm_pool_range" "" (const_int 0))
253(define_attr "thumb2_pool_range" "" (const_int 0))
254(define_attr "arm_neg_pool_range" "" (const_int 0))
255(define_attr "thumb2_neg_pool_range" "" (const_int 0))
256
257(define_attr "pool_range" ""
258  (cond [(eq_attr "is_thumb" "yes") (attr "thumb2_pool_range")]
259	(attr "arm_pool_range")))
260(define_attr "neg_pool_range" ""
261  (cond [(eq_attr "is_thumb" "yes") (attr "thumb2_neg_pool_range")]
262	(attr "arm_neg_pool_range")))
263
264; An assembler sequence may clobber the condition codes without us knowing.
265; If such an insn references the pool, then we have no way of knowing how,
266; so use the most conservative value for pool_range.
267(define_asm_attributes
268 [(set_attr "conds" "clob")
269  (set_attr "length" "4")
270  (set_attr "pool_range" "250")])
271
272; Load scheduling, set from the arm_ld_sched variable
273; initialized by arm_option_override()
274(define_attr "ldsched" "no,yes" (const (symbol_ref "arm_ld_sched")))
275
276; condition codes: this one is used by final_prescan_insn to speed up
277; conditionalizing instructions.  It saves having to scan the rtl to see if
278; it uses or alters the condition codes.
279;
280; USE means that the condition codes are used by the insn in the process of
281;   outputting code, this means (at present) that we can't use the insn in
282;   inlined branches
283;
284; SET means that the purpose of the insn is to set the condition codes in a
285;   well defined manner.
286;
287; CLOB means that the condition codes are altered in an undefined manner, if
288;   they are altered at all
289;
290; UNCONDITIONAL means the instruction can not be conditionally executed and
291;   that the instruction does not use or alter the condition codes.
292;
293; NOCOND means that the instruction does not use or alter the condition
294;   codes but can be converted into a conditionally exectuted instruction.
295
296(define_attr "conds" "use,set,clob,unconditional,nocond"
297	(if_then_else
298	 (ior (eq_attr "is_thumb1" "yes")
299	      (eq_attr "type" "call"))
300	 (const_string "clob")
301	 (if_then_else (eq_attr "is_neon_type" "no")
302	 (const_string "nocond")
303	 (const_string "unconditional"))))
304
305; Predicable means that the insn can be conditionally executed based on
306; an automatically added predicate (additional patterns are generated by
307; gen...).  We default to 'no' because no Thumb patterns match this rule
308; and not all ARM patterns do.
309(define_attr "predicable" "no,yes" (const_string "no"))
310
311; Only model the write buffer for ARM6 and ARM7.  Earlier processors don't
312; have one.  Later ones, such as StrongARM, have write-back caches, so don't
313; suffer blockages enough to warrant modelling this (and it can adversely
314; affect the schedule).
315(define_attr "model_wbuf" "no,yes" (const (symbol_ref "arm_tune_wbuf")))
316
317; WRITE_CONFLICT implies that a read following an unrelated write is likely
318; to stall the processor.  Used with model_wbuf above.
319(define_attr "write_conflict" "no,yes"
320  (if_then_else (eq_attr "type"
321		 "block,call,load_4")
322		(const_string "yes")
323		(const_string "no")))
324
325; Classify the insns into those that take one cycle and those that take more
326; than one on the main cpu execution unit.
327(define_attr "core_cycles" "single,multi"
328  (if_then_else (eq_attr "type"
329    "adc_imm, adc_reg, adcs_imm, adcs_reg, adr, alu_ext, alu_imm, alu_sreg,\
330    alu_shift_imm, alu_shift_reg, alu_dsp_reg, alus_ext, alus_imm, alus_sreg,\
331    alus_shift_imm, alus_shift_reg, bfm, csel, rev, logic_imm, logic_reg,\
332    logic_shift_imm, logic_shift_reg, logics_imm, logics_reg,\
333    logics_shift_imm, logics_shift_reg, extend, shift_imm, float, fcsel,\
334    wmmx_wor, wmmx_wxor, wmmx_wand, wmmx_wandn, wmmx_wmov, wmmx_tmcrr,\
335    wmmx_tmrrc, wmmx_wldr, wmmx_wstr, wmmx_tmcr, wmmx_tmrc, wmmx_wadd,\
336    wmmx_wsub, wmmx_wmul, wmmx_wmac, wmmx_wavg2, wmmx_tinsr, wmmx_textrm,\
337    wmmx_wshufh, wmmx_wcmpeq, wmmx_wcmpgt, wmmx_wmax, wmmx_wmin, wmmx_wpack,\
338    wmmx_wunpckih, wmmx_wunpckil, wmmx_wunpckeh, wmmx_wunpckel, wmmx_wror,\
339    wmmx_wsra, wmmx_wsrl, wmmx_wsll, wmmx_wmadd, wmmx_tmia, wmmx_tmiaph,\
340    wmmx_tmiaxy, wmmx_tbcst, wmmx_tmovmsk, wmmx_wacc, wmmx_waligni,\
341    wmmx_walignr, wmmx_tandc, wmmx_textrc, wmmx_torc, wmmx_torvsc, wmmx_wsad,\
342    wmmx_wabs, wmmx_wabsdiff, wmmx_waddsubhx, wmmx_wsubaddhx, wmmx_wavg4,\
343    wmmx_wmulw, wmmx_wqmulm, wmmx_wqmulwm, wmmx_waddbhus, wmmx_wqmiaxy,\
344    wmmx_wmiaxy, wmmx_wmiawxy, wmmx_wmerge")
345		(const_string "single")
346	        (const_string "multi")))
347
348;; FAR_JUMP is "yes" if a BL instruction is used to generate a branch to a
349;; distant label.  Only applicable to Thumb code.
350(define_attr "far_jump" "yes,no" (const_string "no"))
351
352
353;; The number of machine instructions this pattern expands to.
354;; Used for Thumb-2 conditional execution.
355(define_attr "ce_count" "" (const_int 1))
356
357;;---------------------------------------------------------------------------
358;; Unspecs
359
360(include "unspecs.md")
361
362;;---------------------------------------------------------------------------
363;; Mode iterators
364
365(include "iterators.md")
366
367;;---------------------------------------------------------------------------
368;; Predicates
369
370(include "predicates.md")
371(include "constraints.md")
372
373;;---------------------------------------------------------------------------
374;; Pipeline descriptions
375
376(define_attr "tune_cortexr4" "yes,no"
377  (const (if_then_else
378	  (eq_attr "tune" "cortexr4,cortexr4f,cortexr5")
379	  (const_string "yes")
380	  (const_string "no"))))
381
382;; True if the generic scheduling description should be used.
383
384(define_attr "generic_sched" "yes,no"
385  (const (if_then_else
386          (ior (eq_attr "tune" "fa526,fa626,fa606te,fa626te,fmp626,fa726te,\
387                                arm926ejs,arm1020e,arm1026ejs,arm1136js,\
388                                arm1136jfs,cortexa5,cortexa7,cortexa8,\
389                                cortexa9,cortexa12,cortexa15,cortexa17,\
390                                cortexa53,cortexa57,cortexm4,cortexm7,\
391				exynosm1,marvell_pj4,xgene1")
392	       (eq_attr "tune_cortexr4" "yes"))
393          (const_string "no")
394          (const_string "yes"))))
395
396(define_attr "generic_vfp" "yes,no"
397  (const (if_then_else
398	  (and (eq_attr "fpu" "vfp")
399	       (eq_attr "tune" "!arm1020e,arm1022e,cortexa5,cortexa7,\
400                                cortexa8,cortexa9,cortexa53,cortexm4,\
401                                cortexm7,marvell_pj4,xgene1")
402	       (eq_attr "tune_cortexr4" "no"))
403	  (const_string "yes")
404	  (const_string "no"))))
405
406(include "marvell-f-iwmmxt.md")
407(include "arm-generic.md")
408(include "arm926ejs.md")
409(include "arm1020e.md")
410(include "arm1026ejs.md")
411(include "arm1136jfs.md")
412(include "fa526.md")
413(include "fa606te.md")
414(include "fa626te.md")
415(include "fmp626.md")
416(include "fa726te.md")
417(include "cortex-a5.md")
418(include "cortex-a7.md")
419(include "cortex-a8.md")
420(include "cortex-a9.md")
421(include "cortex-a15.md")
422(include "cortex-a17.md")
423(include "cortex-a53.md")
424(include "cortex-a57.md")
425(include "cortex-r4.md")
426(include "cortex-r4f.md")
427(include "cortex-m7.md")
428(include "cortex-m4.md")
429(include "cortex-m4-fpu.md")
430(include "exynos-m1.md")
431(include "vfp11.md")
432(include "marvell-pj4.md")
433(include "xgene1.md")
434
435
436;;---------------------------------------------------------------------------
437;; Insn patterns
438;;
439;; Addition insns.
440
441;; Note: For DImode insns, there is normally no reason why operands should
442;; not be in the same register, what we don't want is for something being
443;; written to partially overlap something that is an input.
444
445(define_expand "adddi3"
446 [(parallel
447   [(set (match_operand:DI           0 "s_register_operand" "")
448	  (plus:DI (match_operand:DI 1 "s_register_operand" "")
449	           (match_operand:DI 2 "arm_adddi_operand"  "")))
450    (clobber (reg:CC CC_REGNUM))])]
451  "TARGET_EITHER"
452  "
453  if (TARGET_THUMB1)
454    {
455      if (!REG_P (operands[1]))
456        operands[1] = force_reg (DImode, operands[1]);
457      if (!REG_P (operands[2]))
458        operands[2] = force_reg (DImode, operands[2]);
459     }
460  "
461)
462
463(define_insn_and_split "*arm_adddi3"
464  [(set (match_operand:DI          0 "arm_general_register_operand" "=&r,&r,&r,&r,&r")
465	(plus:DI (match_operand:DI 1 "arm_general_register_operand" "%0, 0, r, 0, r")
466		 (match_operand:DI 2 "arm_general_adddi_operand"    "r,  0, r, Dd, Dd")))
467   (clobber (reg:CC CC_REGNUM))]
468  "TARGET_32BIT && !TARGET_NEON"
469  "#"
470  "TARGET_32BIT && ((!TARGET_NEON && !TARGET_IWMMXT) || reload_completed)"
471  [(parallel [(set (reg:CC_C CC_REGNUM)
472		   (compare:CC_C (plus:SI (match_dup 1) (match_dup 2))
473				 (match_dup 1)))
474	      (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2)))])
475   (set (match_dup 3) (plus:SI (plus:SI (match_dup 4) (match_dup 5))
476			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
477  "
478  {
479    operands[3] = gen_highpart (SImode, operands[0]);
480    operands[0] = gen_lowpart (SImode, operands[0]);
481    operands[4] = gen_highpart (SImode, operands[1]);
482    operands[1] = gen_lowpart (SImode, operands[1]);
483    operands[5] = gen_highpart_mode (SImode, DImode, operands[2]);
484    operands[2] = gen_lowpart (SImode, operands[2]);
485  }"
486  [(set_attr "conds" "clob")
487   (set_attr "length" "8")
488   (set_attr "type" "multiple")]
489)
490
491(define_insn_and_split "*adddi_sesidi_di"
492  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
493	(plus:DI (sign_extend:DI
494		  (match_operand:SI 2 "s_register_operand" "r,r"))
495		 (match_operand:DI 1 "s_register_operand" "0,r")))
496   (clobber (reg:CC CC_REGNUM))]
497  "TARGET_32BIT"
498  "#"
499  "TARGET_32BIT && reload_completed"
500  [(parallel [(set (reg:CC_C CC_REGNUM)
501		   (compare:CC_C (plus:SI (match_dup 1) (match_dup 2))
502				 (match_dup 1)))
503	      (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2)))])
504   (set (match_dup 3) (plus:SI (plus:SI (ashiftrt:SI (match_dup 2)
505						     (const_int 31))
506					(match_dup 4))
507			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
508  "
509  {
510    operands[3] = gen_highpart (SImode, operands[0]);
511    operands[0] = gen_lowpart (SImode, operands[0]);
512    operands[4] = gen_highpart (SImode, operands[1]);
513    operands[1] = gen_lowpart (SImode, operands[1]);
514    operands[2] = gen_lowpart (SImode, operands[2]);
515  }"
516  [(set_attr "conds" "clob")
517   (set_attr "length" "8")
518   (set_attr "type" "multiple")]
519)
520
521(define_insn_and_split "*adddi_zesidi_di"
522  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
523	(plus:DI (zero_extend:DI
524		  (match_operand:SI 2 "s_register_operand" "r,r"))
525		 (match_operand:DI 1 "s_register_operand" "0,r")))
526   (clobber (reg:CC CC_REGNUM))]
527  "TARGET_32BIT"
528  "#"
529  "TARGET_32BIT && reload_completed"
530  [(parallel [(set (reg:CC_C CC_REGNUM)
531		   (compare:CC_C (plus:SI (match_dup 1) (match_dup 2))
532				 (match_dup 1)))
533	      (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2)))])
534   (set (match_dup 3) (plus:SI (plus:SI (match_dup 4) (const_int 0))
535			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
536  "
537  {
538    operands[3] = gen_highpart (SImode, operands[0]);
539    operands[0] = gen_lowpart (SImode, operands[0]);
540    operands[4] = gen_highpart (SImode, operands[1]);
541    operands[1] = gen_lowpart (SImode, operands[1]);
542    operands[2] = gen_lowpart (SImode, operands[2]);
543  }"
544  [(set_attr "conds" "clob")
545   (set_attr "length" "8")
546   (set_attr "type" "multiple")]
547)
548
549(define_expand "addv<mode>4"
550  [(match_operand:SIDI 0 "register_operand")
551   (match_operand:SIDI 1 "register_operand")
552   (match_operand:SIDI 2 "register_operand")
553   (match_operand 3 "")]
554  "TARGET_32BIT"
555{
556  emit_insn (gen_add<mode>3_compareV (operands[0], operands[1], operands[2]));
557  arm_gen_unlikely_cbranch (NE, CC_Vmode, operands[3]);
558
559  DONE;
560})
561
562(define_expand "uaddv<mode>4"
563  [(match_operand:SIDI 0 "register_operand")
564   (match_operand:SIDI 1 "register_operand")
565   (match_operand:SIDI 2 "register_operand")
566   (match_operand 3 "")]
567  "TARGET_32BIT"
568{
569  emit_insn (gen_add<mode>3_compareC (operands[0], operands[1], operands[2]));
570  arm_gen_unlikely_cbranch (NE, CC_Cmode, operands[3]);
571
572  DONE;
573})
574
575(define_expand "addsi3"
576  [(set (match_operand:SI          0 "s_register_operand" "")
577	(plus:SI (match_operand:SI 1 "s_register_operand" "")
578		 (match_operand:SI 2 "reg_or_int_operand" "")))]
579  "TARGET_EITHER"
580  "
581  if (TARGET_32BIT && CONST_INT_P (operands[2]))
582    {
583      arm_split_constant (PLUS, SImode, NULL_RTX,
584	                  INTVAL (operands[2]), operands[0], operands[1],
585			  optimize && can_create_pseudo_p ());
586      DONE;
587    }
588  "
589)
590
591; If there is a scratch available, this will be faster than synthesizing the
592; addition.
593(define_peephole2
594  [(match_scratch:SI 3 "r")
595   (set (match_operand:SI          0 "arm_general_register_operand" "")
596	(plus:SI (match_operand:SI 1 "arm_general_register_operand" "")
597		 (match_operand:SI 2 "const_int_operand"  "")))]
598  "TARGET_32BIT &&
599   !(const_ok_for_arm (INTVAL (operands[2]))
600     || const_ok_for_arm (-INTVAL (operands[2])))
601    && const_ok_for_arm (~INTVAL (operands[2]))"
602  [(set (match_dup 3) (match_dup 2))
603   (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 3)))]
604  ""
605)
606
607;; The r/r/k alternative is required when reloading the address
608;;  (plus (reg rN) (reg sp)) into (reg rN).  In this case reload will
609;; put the duplicated register first, and not try the commutative version.
610(define_insn_and_split "*arm_addsi3"
611  [(set (match_operand:SI          0 "s_register_operand" "=rk,l,l ,l ,r ,k ,r,k ,r ,k ,r ,k,k,r ,k ,r")
612	(plus:SI (match_operand:SI 1 "s_register_operand" "%0 ,l,0 ,l ,rk,k ,r,r ,rk,k ,rk,k,r,rk,k ,rk")
613		 (match_operand:SI 2 "reg_or_int_operand" "rk ,l,Py,Pd,rI,rI,k,rI,Pj,Pj,L ,L,L,PJ,PJ,?n")))]
614  "TARGET_32BIT"
615  "@
616   add%?\\t%0, %0, %2
617   add%?\\t%0, %1, %2
618   add%?\\t%0, %1, %2
619   add%?\\t%0, %1, %2
620   add%?\\t%0, %1, %2
621   add%?\\t%0, %1, %2
622   add%?\\t%0, %2, %1
623   add%?\\t%0, %1, %2
624   addw%?\\t%0, %1, %2
625   addw%?\\t%0, %1, %2
626   sub%?\\t%0, %1, #%n2
627   sub%?\\t%0, %1, #%n2
628   sub%?\\t%0, %1, #%n2
629   subw%?\\t%0, %1, #%n2
630   subw%?\\t%0, %1, #%n2
631   #"
632  "TARGET_32BIT
633   && CONST_INT_P (operands[2])
634   && !const_ok_for_op (INTVAL (operands[2]), PLUS)
635   && (reload_completed || !arm_eliminable_register (operands[1]))"
636  [(clobber (const_int 0))]
637  "
638  arm_split_constant (PLUS, SImode, curr_insn,
639	              INTVAL (operands[2]), operands[0],
640		      operands[1], 0);
641  DONE;
642  "
643  [(set_attr "length" "2,4,4,4,4,4,4,4,4,4,4,4,4,4,4,16")
644   (set_attr "predicable" "yes")
645   (set_attr "predicable_short_it" "yes,yes,yes,yes,no,no,no,no,no,no,no,no,no,no,no,no")
646   (set_attr "arch" "t2,t2,t2,t2,*,*,*,a,t2,t2,*,*,a,t2,t2,*")
647   (set (attr "type") (if_then_else (match_operand 2 "const_int_operand" "")
648		      (const_string "alu_imm")
649		      (const_string "alu_sreg")))
650 ]
651)
652
653(define_insn_and_split "adddi3_compareV"
654  [(set (reg:CC_V CC_REGNUM)
655	(ne:CC_V
656	  (plus:TI
657	    (sign_extend:TI (match_operand:DI 1 "register_operand" "r"))
658	    (sign_extend:TI (match_operand:DI 2 "register_operand" "r")))
659	  (sign_extend:TI (plus:DI (match_dup 1) (match_dup 2)))))
660   (set (match_operand:DI 0 "register_operand" "=&r")
661	(plus:DI (match_dup 1) (match_dup 2)))]
662  "TARGET_32BIT"
663  "#"
664  "&& reload_completed"
665  [(parallel [(set (reg:CC_C CC_REGNUM)
666		   (compare:CC_C (plus:SI (match_dup 1) (match_dup 2))
667				 (match_dup 1)))
668	      (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2)))])
669   (parallel [(set (reg:CC_V CC_REGNUM)
670		   (ne:CC_V
671		    (plus:DI (plus:DI
672			      (sign_extend:DI (match_dup 4))
673			      (sign_extend:DI (match_dup 5)))
674			     (ltu:DI (reg:CC_C CC_REGNUM) (const_int 0)))
675		    (plus:DI (sign_extend:DI
676			      (plus:SI (match_dup 4) (match_dup 5)))
677			     (ltu:DI (reg:CC_C CC_REGNUM) (const_int 0)))))
678	     (set (match_dup 3) (plus:SI (plus:SI
679					  (match_dup 4) (match_dup 5))
680					 (ltu:SI (reg:CC_C CC_REGNUM)
681						 (const_int 0))))])]
682  "
683  {
684    operands[3] = gen_highpart (SImode, operands[0]);
685    operands[0] = gen_lowpart (SImode, operands[0]);
686    operands[4] = gen_highpart (SImode, operands[1]);
687    operands[1] = gen_lowpart (SImode, operands[1]);
688    operands[5] = gen_highpart (SImode, operands[2]);
689    operands[2] = gen_lowpart (SImode, operands[2]);
690  }"
691 [(set_attr "conds" "set")
692   (set_attr "length" "8")
693   (set_attr "type" "multiple")]
694)
695
696(define_insn "addsi3_compareV"
697  [(set (reg:CC_V CC_REGNUM)
698	(ne:CC_V
699	  (plus:DI
700	    (sign_extend:DI (match_operand:SI 1 "register_operand" "r"))
701	    (sign_extend:DI (match_operand:SI 2 "register_operand" "r")))
702	  (sign_extend:DI (plus:SI (match_dup 1) (match_dup 2)))))
703   (set (match_operand:SI 0 "register_operand" "=r")
704	(plus:SI (match_dup 1) (match_dup 2)))]
705  "TARGET_32BIT"
706  "adds%?\\t%0, %1, %2"
707  [(set_attr "conds" "set")
708   (set_attr "type" "alus_sreg")]
709)
710
711(define_insn "*addsi3_compareV_upper"
712  [(set (reg:CC_V CC_REGNUM)
713	(ne:CC_V
714	  (plus:DI
715	   (plus:DI
716	    (sign_extend:DI (match_operand:SI 1 "register_operand" "r"))
717	    (sign_extend:DI (match_operand:SI 2 "register_operand" "r")))
718	   (ltu:DI (reg:CC_C CC_REGNUM) (const_int 0)))
719	  (plus:DI (sign_extend:DI
720		    (plus:SI (match_dup 1) (match_dup 2)))
721		   (ltu:DI (reg:CC_C CC_REGNUM) (const_int 0)))))
722   (set (match_operand:SI 0 "register_operand" "=r")
723	(plus:SI
724	 (plus:SI (match_dup 1) (match_dup 2))
725	 (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
726  "TARGET_32BIT"
727  "adcs%?\\t%0, %1, %2"
728  [(set_attr "conds" "set")
729   (set_attr "type" "adcs_reg")]
730)
731
732(define_insn_and_split "adddi3_compareC"
733  [(set (reg:CC_C CC_REGNUM)
734	(ne:CC_C
735	  (plus:TI
736	    (zero_extend:TI (match_operand:DI 1 "register_operand" "r"))
737	    (zero_extend:TI (match_operand:DI 2 "register_operand" "r")))
738	  (zero_extend:TI (plus:DI (match_dup 1) (match_dup 2)))))
739   (set (match_operand:DI 0 "register_operand" "=&r")
740	(plus:DI (match_dup 1) (match_dup 2)))]
741  "TARGET_32BIT"
742  "#"
743  "&& reload_completed"
744  [(parallel [(set (reg:CC_C CC_REGNUM)
745		   (compare:CC_C (plus:SI (match_dup 1) (match_dup 2))
746				 (match_dup 1)))
747	      (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2)))])
748   (parallel [(set (reg:CC_C CC_REGNUM)
749		   (ne:CC_C
750		    (plus:DI (plus:DI
751			      (zero_extend:DI (match_dup 4))
752			      (zero_extend:DI (match_dup 5)))
753			     (ltu:DI (reg:CC_C CC_REGNUM) (const_int 0)))
754		    (plus:DI (zero_extend:DI
755			      (plus:SI (match_dup 4) (match_dup 5)))
756			     (ltu:DI (reg:CC_C CC_REGNUM) (const_int 0)))))
757	     (set (match_dup 3) (plus:SI
758				 (plus:SI (match_dup 4) (match_dup 5))
759				 (ltu:SI (reg:CC_C CC_REGNUM)
760					 (const_int 0))))])]
761  "
762  {
763    operands[3] = gen_highpart (SImode, operands[0]);
764    operands[0] = gen_lowpart (SImode, operands[0]);
765    operands[4] = gen_highpart (SImode, operands[1]);
766    operands[5] = gen_highpart (SImode, operands[2]);
767    operands[1] = gen_lowpart (SImode, operands[1]);
768    operands[2] = gen_lowpart (SImode, operands[2]);
769  }"
770 [(set_attr "conds" "set")
771   (set_attr "length" "8")
772   (set_attr "type" "multiple")]
773)
774
775(define_insn "*addsi3_compareC_upper"
776  [(set (reg:CC_C CC_REGNUM)
777	(ne:CC_C
778	  (plus:DI
779	   (plus:DI
780	    (zero_extend:DI (match_operand:SI 1 "register_operand" "r"))
781	    (zero_extend:DI (match_operand:SI 2 "register_operand" "r")))
782	   (ltu:DI (reg:CC_C CC_REGNUM) (const_int 0)))
783	  (plus:DI (zero_extend:DI
784		    (plus:SI (match_dup 1) (match_dup 2)))
785		   (ltu:DI (reg:CC_C CC_REGNUM) (const_int 0)))))
786   (set (match_operand:SI 0 "register_operand" "=r")
787	(plus:SI
788	 (plus:SI (match_dup 1) (match_dup 2))
789	 (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
790  "TARGET_32BIT"
791  "adcs%?\\t%0, %1, %2"
792  [(set_attr "conds" "set")
793   (set_attr "type" "adcs_reg")]
794)
795
796(define_insn "addsi3_compareC"
797   [(set (reg:CC_C CC_REGNUM)
798	 (ne:CC_C
799	  (plus:DI
800	   (zero_extend:DI (match_operand:SI 1 "register_operand" "r"))
801	   (zero_extend:DI (match_operand:SI 2 "register_operand" "r")))
802	  (zero_extend:DI
803	   (plus:SI (match_dup 1) (match_dup 2)))))
804    (set (match_operand:SI 0 "register_operand" "=r")
805	 (plus:SI (match_dup 1) (match_dup 2)))]
806  "TARGET_32BIT"
807  "adds%?\\t%0, %1, %2"
808  [(set_attr "conds" "set")
809   (set_attr "type" "alus_sreg")]
810)
811
812(define_insn "addsi3_compare0"
813  [(set (reg:CC_NOOV CC_REGNUM)
814	(compare:CC_NOOV
815	 (plus:SI (match_operand:SI 1 "s_register_operand" "r, r,r")
816		  (match_operand:SI 2 "arm_add_operand"    "I,L,r"))
817	 (const_int 0)))
818   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
819	(plus:SI (match_dup 1) (match_dup 2)))]
820  "TARGET_ARM"
821  "@
822   adds%?\\t%0, %1, %2
823   subs%?\\t%0, %1, #%n2
824   adds%?\\t%0, %1, %2"
825  [(set_attr "conds" "set")
826   (set_attr "type" "alus_imm,alus_imm,alus_sreg")]
827)
828
829(define_insn "*addsi3_compare0_scratch"
830  [(set (reg:CC_NOOV CC_REGNUM)
831	(compare:CC_NOOV
832	 (plus:SI (match_operand:SI 0 "s_register_operand" "r, r, r")
833		  (match_operand:SI 1 "arm_add_operand"    "I,L, r"))
834	 (const_int 0)))]
835  "TARGET_ARM"
836  "@
837   cmn%?\\t%0, %1
838   cmp%?\\t%0, #%n1
839   cmn%?\\t%0, %1"
840  [(set_attr "conds" "set")
841   (set_attr "predicable" "yes")
842   (set_attr "type" "alus_imm,alus_imm,alus_sreg")]
843)
844
845(define_insn "*compare_negsi_si"
846  [(set (reg:CC_Z CC_REGNUM)
847	(compare:CC_Z
848	 (neg:SI (match_operand:SI 0 "s_register_operand" "l,r"))
849	 (match_operand:SI 1 "s_register_operand" "l,r")))]
850  "TARGET_32BIT"
851  "cmn%?\\t%1, %0"
852  [(set_attr "conds" "set")
853   (set_attr "predicable" "yes")
854   (set_attr "arch" "t2,*")
855   (set_attr "length" "2,4")
856   (set_attr "predicable_short_it" "yes,no")
857   (set_attr "type" "alus_sreg")]
858)
859
860;; This is the canonicalization of addsi3_compare0_for_combiner when the
861;; addend is a constant.
862(define_insn "cmpsi2_addneg"
863  [(set (reg:CC CC_REGNUM)
864	(compare:CC
865	 (match_operand:SI 1 "s_register_operand" "r,r")
866	 (match_operand:SI 2 "arm_addimm_operand" "L,I")))
867   (set (match_operand:SI 0 "s_register_operand" "=r,r")
868	(plus:SI (match_dup 1)
869		 (match_operand:SI 3 "arm_addimm_operand" "I,L")))]
870  "TARGET_32BIT && INTVAL (operands[2]) == -INTVAL (operands[3])"
871  "@
872   adds%?\\t%0, %1, %3
873   subs%?\\t%0, %1, #%n3"
874  [(set_attr "conds" "set")
875   (set_attr "type" "alus_sreg")]
876)
877
878;; Convert the sequence
879;;  sub  rd, rn, #1
880;;  cmn  rd, #1	(equivalent to cmp rd, #-1)
881;;  bne  dest
882;; into
883;;  subs rd, rn, #1
884;;  bcs  dest	((unsigned)rn >= 1)
885;; similarly for the beq variant using bcc.
886;; This is a common looping idiom (while (n--))
887(define_peephole2
888  [(set (match_operand:SI 0 "arm_general_register_operand" "")
889	(plus:SI (match_operand:SI 1 "arm_general_register_operand" "")
890		 (const_int -1)))
891   (set (match_operand 2 "cc_register" "")
892	(compare (match_dup 0) (const_int -1)))
893   (set (pc)
894	(if_then_else (match_operator 3 "equality_operator"
895		       [(match_dup 2) (const_int 0)])
896		      (match_operand 4 "" "")
897		      (match_operand 5 "" "")))]
898  "TARGET_32BIT && peep2_reg_dead_p (3, operands[2])"
899  [(parallel[
900    (set (match_dup 2)
901	 (compare:CC
902	  (match_dup 1) (const_int 1)))
903    (set (match_dup 0) (plus:SI (match_dup 1) (const_int -1)))])
904   (set (pc)
905	(if_then_else (match_op_dup 3 [(match_dup 2) (const_int 0)])
906		      (match_dup 4)
907		      (match_dup 5)))]
908  "operands[2] = gen_rtx_REG (CCmode, CC_REGNUM);
909   operands[3] = gen_rtx_fmt_ee ((GET_CODE (operands[3]) == NE
910				  ? GEU : LTU),
911				 VOIDmode,
912				 operands[2], const0_rtx);"
913)
914
915;; The next four insns work because they compare the result with one of
916;; the operands, and we know that the use of the condition code is
917;; either GEU or LTU, so we can use the carry flag from the addition
918;; instead of doing the compare a second time.
919(define_insn "*addsi3_compare_op1"
920  [(set (reg:CC_C CC_REGNUM)
921	(compare:CC_C
922	 (plus:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
923		  (match_operand:SI 2 "arm_add_operand" "I,L,r"))
924	 (match_dup 1)))
925   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
926	(plus:SI (match_dup 1) (match_dup 2)))]
927  "TARGET_32BIT"
928  "@
929   adds%?\\t%0, %1, %2
930   subs%?\\t%0, %1, #%n2
931   adds%?\\t%0, %1, %2"
932  [(set_attr "conds" "set")
933   (set_attr "type"  "alus_imm,alus_imm,alus_sreg")]
934)
935
936(define_insn "*addsi3_compare_op2"
937  [(set (reg:CC_C CC_REGNUM)
938	(compare:CC_C
939	 (plus:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
940		  (match_operand:SI 2 "arm_add_operand" "I,L,r"))
941	 (match_dup 2)))
942   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
943	(plus:SI (match_dup 1) (match_dup 2)))]
944  "TARGET_32BIT"
945  "@
946   adds%?\\t%0, %1, %2
947   subs%?\\t%0, %1, #%n2
948   adds%?\\t%0, %1, %2"
949  [(set_attr "conds" "set")
950   (set_attr "type" "alus_imm,alus_imm,alus_sreg")]
951)
952
953(define_insn "*compare_addsi2_op0"
954  [(set (reg:CC_C CC_REGNUM)
955        (compare:CC_C
956          (plus:SI (match_operand:SI 0 "s_register_operand" "l,l,r,r,r")
957                   (match_operand:SI 1 "arm_add_operand" "Pv,l,I,L,r"))
958          (match_dup 0)))]
959  "TARGET_32BIT"
960  "@
961   cmp%?\\t%0, #%n1
962   cmn%?\\t%0, %1
963   cmn%?\\t%0, %1
964   cmp%?\\t%0, #%n1
965   cmn%?\\t%0, %1"
966  [(set_attr "conds" "set")
967   (set_attr "predicable" "yes")
968   (set_attr "arch" "t2,t2,*,*,*")
969   (set_attr "predicable_short_it" "yes,yes,no,no,no")
970   (set_attr "length" "2,2,4,4,4")
971   (set_attr "type" "alus_imm,alus_sreg,alus_imm,alus_imm,alus_sreg")]
972)
973
974(define_insn "*compare_addsi2_op1"
975  [(set (reg:CC_C CC_REGNUM)
976        (compare:CC_C
977          (plus:SI (match_operand:SI 0 "s_register_operand" "l,l,r,r,r")
978                   (match_operand:SI 1 "arm_add_operand" "Pv,l,I,L,r"))
979          (match_dup 1)))]
980  "TARGET_32BIT"
981  "@
982   cmp%?\\t%0, #%n1
983   cmn%?\\t%0, %1
984   cmn%?\\t%0, %1
985   cmp%?\\t%0, #%n1
986   cmn%?\\t%0, %1"
987  [(set_attr "conds" "set")
988   (set_attr "predicable" "yes")
989   (set_attr "arch" "t2,t2,*,*,*")
990   (set_attr "predicable_short_it" "yes,yes,no,no,no")
991   (set_attr "length" "2,2,4,4,4")
992   (set_attr "type" "alus_imm,alus_sreg,alus_imm,alus_imm,alus_sreg")]
993 )
994
995(define_insn "*addsi3_carryin_<optab>"
996  [(set (match_operand:SI 0 "s_register_operand" "=l,r,r")
997        (plus:SI (plus:SI (match_operand:SI 1 "s_register_operand" "%l,r,r")
998                          (match_operand:SI 2 "arm_not_operand" "0,rI,K"))
999                 (LTUGEU:SI (reg:<cnb> CC_REGNUM) (const_int 0))))]
1000  "TARGET_32BIT"
1001  "@
1002   adc%?\\t%0, %1, %2
1003   adc%?\\t%0, %1, %2
1004   sbc%?\\t%0, %1, #%B2"
1005  [(set_attr "conds" "use")
1006   (set_attr "predicable" "yes")
1007   (set_attr "arch" "t2,*,*")
1008   (set_attr "length" "4")
1009   (set_attr "predicable_short_it" "yes,no,no")
1010   (set_attr "type" "adc_reg,adc_reg,adc_imm")]
1011)
1012
1013(define_insn "*addsi3_carryin_alt2_<optab>"
1014  [(set (match_operand:SI 0 "s_register_operand" "=l,r,r")
1015        (plus:SI (plus:SI (LTUGEU:SI (reg:<cnb> CC_REGNUM) (const_int 0))
1016                          (match_operand:SI 1 "s_register_operand" "%l,r,r"))
1017                 (match_operand:SI 2 "arm_rhs_operand" "l,rI,K")))]
1018  "TARGET_32BIT"
1019  "@
1020   adc%?\\t%0, %1, %2
1021   adc%?\\t%0, %1, %2
1022   sbc%?\\t%0, %1, #%B2"
1023  [(set_attr "conds" "use")
1024   (set_attr "predicable" "yes")
1025   (set_attr "arch" "t2,*,*")
1026   (set_attr "length" "4")
1027   (set_attr "predicable_short_it" "yes,no,no")
1028   (set_attr "type" "adc_reg,adc_reg,adc_imm")]
1029)
1030
1031(define_insn "*addsi3_carryin_shift_<optab>"
1032  [(set (match_operand:SI 0 "s_register_operand" "=r")
1033	(plus:SI (plus:SI
1034		  (match_operator:SI 2 "shift_operator"
1035		    [(match_operand:SI 3 "s_register_operand" "r")
1036		     (match_operand:SI 4 "reg_or_int_operand" "rM")])
1037		  (match_operand:SI 1 "s_register_operand" "r"))
1038		 (LTUGEU:SI (reg:<cnb> CC_REGNUM) (const_int 0))))]
1039  "TARGET_32BIT"
1040  "adc%?\\t%0, %1, %3%S2"
1041  [(set_attr "conds" "use")
1042   (set_attr "predicable" "yes")
1043   (set (attr "type") (if_then_else (match_operand 4 "const_int_operand" "")
1044		      (const_string "alu_shift_imm")
1045		      (const_string "alu_shift_reg")))]
1046)
1047
1048(define_insn "*addsi3_carryin_clobercc_<optab>"
1049  [(set (match_operand:SI 0 "s_register_operand" "=r")
1050	(plus:SI (plus:SI (match_operand:SI 1 "s_register_operand" "%r")
1051			  (match_operand:SI 2 "arm_rhs_operand" "rI"))
1052		 (LTUGEU:SI (reg:<cnb> CC_REGNUM) (const_int 0))))
1053   (clobber (reg:CC CC_REGNUM))]
1054   "TARGET_32BIT"
1055   "adcs%?\\t%0, %1, %2"
1056   [(set_attr "conds" "set")
1057    (set_attr "type" "adcs_reg")]
1058)
1059
1060(define_expand "subv<mode>4"
1061  [(match_operand:SIDI 0 "register_operand")
1062   (match_operand:SIDI 1 "register_operand")
1063   (match_operand:SIDI 2 "register_operand")
1064   (match_operand 3 "")]
1065  "TARGET_32BIT"
1066{
1067  emit_insn (gen_sub<mode>3_compare1 (operands[0], operands[1], operands[2]));
1068  arm_gen_unlikely_cbranch (NE, CC_Vmode, operands[3]);
1069
1070  DONE;
1071})
1072
1073(define_expand "usubv<mode>4"
1074  [(match_operand:SIDI 0 "register_operand")
1075   (match_operand:SIDI 1 "register_operand")
1076   (match_operand:SIDI 2 "register_operand")
1077   (match_operand 3 "")]
1078  "TARGET_32BIT"
1079{
1080  emit_insn (gen_sub<mode>3_compare1 (operands[0], operands[1], operands[2]));
1081  arm_gen_unlikely_cbranch (LTU, CCmode, operands[3]);
1082
1083  DONE;
1084})
1085
1086(define_insn_and_split "subdi3_compare1"
1087  [(set (reg:CC CC_REGNUM)
1088	(compare:CC
1089	  (match_operand:DI 1 "register_operand" "r")
1090	  (match_operand:DI 2 "register_operand" "r")))
1091   (set (match_operand:DI 0 "register_operand" "=&r")
1092	(minus:DI (match_dup 1) (match_dup 2)))]
1093  "TARGET_32BIT"
1094  "#"
1095  "&& reload_completed"
1096  [(parallel [(set (reg:CC CC_REGNUM)
1097		   (compare:CC (match_dup 1) (match_dup 2)))
1098	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1099   (parallel [(set (reg:CC CC_REGNUM)
1100		   (compare:CC (match_dup 4) (match_dup 5)))
1101	     (set (match_dup 3) (minus:SI (minus:SI (match_dup 4) (match_dup 5))
1102			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))])]
1103  {
1104    operands[3] = gen_highpart (SImode, operands[0]);
1105    operands[0] = gen_lowpart (SImode, operands[0]);
1106    operands[4] = gen_highpart (SImode, operands[1]);
1107    operands[1] = gen_lowpart (SImode, operands[1]);
1108    operands[5] = gen_highpart (SImode, operands[2]);
1109    operands[2] = gen_lowpart (SImode, operands[2]);
1110   }
1111  [(set_attr "conds" "set")
1112   (set_attr "length" "8")
1113   (set_attr "type" "multiple")]
1114)
1115
1116(define_insn "subsi3_compare1"
1117  [(set (reg:CC CC_REGNUM)
1118	(compare:CC
1119	  (match_operand:SI 1 "register_operand" "r")
1120	  (match_operand:SI 2 "register_operand" "r")))
1121   (set (match_operand:SI 0 "register_operand" "=r")
1122	(minus:SI (match_dup 1) (match_dup 2)))]
1123  "TARGET_32BIT"
1124  "subs%?\\t%0, %1, %2"
1125  [(set_attr "conds" "set")
1126   (set_attr "type" "alus_sreg")]
1127)
1128
1129(define_insn "*subsi3_carryin"
1130  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
1131	(minus:SI (minus:SI (match_operand:SI 1 "reg_or_int_operand" "r,I,Pz")
1132			    (match_operand:SI 2 "s_register_operand" "r,r,r"))
1133		  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1134  "TARGET_32BIT"
1135  "@
1136   sbc%?\\t%0, %1, %2
1137   rsc%?\\t%0, %2, %1
1138   sbc%?\\t%0, %2, %2, lsl #1"
1139  [(set_attr "conds" "use")
1140   (set_attr "arch" "*,a,t2")
1141   (set_attr "predicable" "yes")
1142   (set_attr "type" "adc_reg,adc_imm,alu_shift_imm")]
1143)
1144
1145(define_insn "*subsi3_carryin_const"
1146  [(set (match_operand:SI 0 "s_register_operand" "=r")
1147        (minus:SI (plus:SI (match_operand:SI 1 "s_register_operand" "r")
1148                           (match_operand:SI 2 "arm_not_immediate_operand" "K"))
1149                  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1150  "TARGET_32BIT"
1151  "sbc\\t%0, %1, #%B2"
1152  [(set_attr "conds" "use")
1153   (set_attr "type" "adc_imm")]
1154)
1155
1156(define_insn "*subsi3_carryin_compare"
1157  [(set (reg:CC CC_REGNUM)
1158        (compare:CC (match_operand:SI 1 "s_register_operand" "r")
1159                    (match_operand:SI 2 "s_register_operand" "r")))
1160   (set (match_operand:SI 0 "s_register_operand" "=r")
1161        (minus:SI (minus:SI (match_dup 1)
1162                            (match_dup 2))
1163                  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1164  "TARGET_32BIT"
1165  "sbcs\\t%0, %1, %2"
1166  [(set_attr "conds" "set")
1167   (set_attr "type" "adcs_reg")]
1168)
1169
1170(define_insn "*subsi3_carryin_compare_const"
1171  [(set (reg:CC CC_REGNUM)
1172        (compare:CC (match_operand:SI 1 "reg_or_int_operand" "r")
1173                    (match_operand:SI 2 "arm_not_operand" "K")))
1174   (set (match_operand:SI 0 "s_register_operand" "=r")
1175        (minus:SI (plus:SI (match_dup 1)
1176                           (match_dup 2))
1177                  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1178  "TARGET_32BIT"
1179  "sbcs\\t%0, %1, #%B2"
1180  [(set_attr "conds" "set")
1181   (set_attr "type" "adcs_imm")]
1182)
1183
1184(define_insn "*subsi3_carryin_shift"
1185  [(set (match_operand:SI 0 "s_register_operand" "=r")
1186	(minus:SI (minus:SI
1187		  (match_operand:SI 1 "s_register_operand" "r")
1188                  (match_operator:SI 2 "shift_operator"
1189                   [(match_operand:SI 3 "s_register_operand" "r")
1190                    (match_operand:SI 4 "reg_or_int_operand" "rM")]))
1191                 (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1192  "TARGET_32BIT"
1193  "sbc%?\\t%0, %1, %3%S2"
1194  [(set_attr "conds" "use")
1195   (set_attr "predicable" "yes")
1196   (set (attr "type") (if_then_else (match_operand 4 "const_int_operand" "")
1197		      (const_string "alu_shift_imm")
1198                     (const_string "alu_shift_reg")))]
1199)
1200
1201(define_insn "*rsbsi3_carryin_shift"
1202  [(set (match_operand:SI 0 "s_register_operand" "=r")
1203	(minus:SI (minus:SI
1204                  (match_operator:SI 2 "shift_operator"
1205                   [(match_operand:SI 3 "s_register_operand" "r")
1206                    (match_operand:SI 4 "reg_or_int_operand" "rM")])
1207		   (match_operand:SI 1 "s_register_operand" "r"))
1208                 (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1209  "TARGET_ARM"
1210  "rsc%?\\t%0, %1, %3%S2"
1211  [(set_attr "conds" "use")
1212   (set_attr "predicable" "yes")
1213   (set (attr "type") (if_then_else (match_operand 4 "const_int_operand" "")
1214		      (const_string "alu_shift_imm")
1215		      (const_string "alu_shift_reg")))]
1216)
1217
1218; transform ((x << y) - 1) to ~(~(x-1) << y)  Where X is a constant.
1219(define_split
1220  [(set (match_operand:SI 0 "s_register_operand" "")
1221	(plus:SI (ashift:SI (match_operand:SI 1 "const_int_operand" "")
1222			    (match_operand:SI 2 "s_register_operand" ""))
1223		 (const_int -1)))
1224   (clobber (match_operand:SI 3 "s_register_operand" ""))]
1225  "TARGET_32BIT"
1226  [(set (match_dup 3) (match_dup 1))
1227   (set (match_dup 0) (not:SI (ashift:SI (match_dup 3) (match_dup 2))))]
1228  "
1229  operands[1] = GEN_INT (~(INTVAL (operands[1]) - 1));
1230")
1231
1232(define_expand "addsf3"
1233  [(set (match_operand:SF          0 "s_register_operand" "")
1234	(plus:SF (match_operand:SF 1 "s_register_operand" "")
1235		 (match_operand:SF 2 "s_register_operand" "")))]
1236  "TARGET_32BIT && TARGET_HARD_FLOAT"
1237  "
1238")
1239
1240(define_expand "adddf3"
1241  [(set (match_operand:DF          0 "s_register_operand" "")
1242	(plus:DF (match_operand:DF 1 "s_register_operand" "")
1243		 (match_operand:DF 2 "s_register_operand" "")))]
1244  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
1245  "
1246")
1247
1248(define_expand "subdi3"
1249 [(parallel
1250   [(set (match_operand:DI            0 "s_register_operand" "")
1251	  (minus:DI (match_operand:DI 1 "s_register_operand" "")
1252	            (match_operand:DI 2 "s_register_operand" "")))
1253    (clobber (reg:CC CC_REGNUM))])]
1254  "TARGET_EITHER"
1255  "
1256  if (TARGET_THUMB1)
1257    {
1258      if (!REG_P (operands[1]))
1259        operands[1] = force_reg (DImode, operands[1]);
1260      if (!REG_P (operands[2]))
1261        operands[2] = force_reg (DImode, operands[2]);
1262     }
1263  "
1264)
1265
1266(define_insn_and_split "*arm_subdi3"
1267  [(set (match_operand:DI           0 "arm_general_register_operand" "=&r,&r,&r")
1268	(minus:DI (match_operand:DI 1 "arm_general_register_operand" "0,r,0")
1269		  (match_operand:DI 2 "arm_general_register_operand" "r,0,0")))
1270   (clobber (reg:CC CC_REGNUM))]
1271  "TARGET_32BIT && !TARGET_NEON"
1272  "#"  ; "subs\\t%Q0, %Q1, %Q2\;sbc\\t%R0, %R1, %R2"
1273  "&& (!TARGET_IWMMXT || reload_completed)"
1274  [(parallel [(set (reg:CC CC_REGNUM)
1275		   (compare:CC (match_dup 1) (match_dup 2)))
1276	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1277   (set (match_dup 3) (minus:SI (minus:SI (match_dup 4) (match_dup 5))
1278			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1279  {
1280    operands[3] = gen_highpart (SImode, operands[0]);
1281    operands[0] = gen_lowpart (SImode, operands[0]);
1282    operands[4] = gen_highpart (SImode, operands[1]);
1283    operands[1] = gen_lowpart (SImode, operands[1]);
1284    operands[5] = gen_highpart (SImode, operands[2]);
1285    operands[2] = gen_lowpart (SImode, operands[2]);
1286   }
1287  [(set_attr "conds" "clob")
1288   (set_attr "length" "8")
1289   (set_attr "type" "multiple")]
1290)
1291
1292(define_insn_and_split "*subdi_di_zesidi"
1293  [(set (match_operand:DI           0 "s_register_operand" "=&r,&r")
1294	(minus:DI (match_operand:DI 1 "s_register_operand"  "0,r")
1295		  (zero_extend:DI
1296		   (match_operand:SI 2 "s_register_operand"  "r,r"))))
1297   (clobber (reg:CC CC_REGNUM))]
1298  "TARGET_32BIT"
1299  "#"   ; "subs\\t%Q0, %Q1, %2\;sbc\\t%R0, %R1, #0"
1300  "&& reload_completed"
1301  [(parallel [(set (reg:CC CC_REGNUM)
1302		   (compare:CC (match_dup 1) (match_dup 2)))
1303	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1304   (set (match_dup 3) (minus:SI (plus:SI (match_dup 4) (match_dup 5))
1305                                (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1306  {
1307    operands[3] = gen_highpart (SImode, operands[0]);
1308    operands[0] = gen_lowpart (SImode, operands[0]);
1309    operands[4] = gen_highpart (SImode, operands[1]);
1310    operands[1] = gen_lowpart (SImode, operands[1]);
1311    operands[5] = GEN_INT (~0);
1312   }
1313  [(set_attr "conds" "clob")
1314   (set_attr "length" "8")
1315   (set_attr "type" "multiple")]
1316)
1317
1318(define_insn_and_split "*subdi_di_sesidi"
1319  [(set (match_operand:DI            0 "s_register_operand" "=&r,&r")
1320	(minus:DI (match_operand:DI  1 "s_register_operand"  "0,r")
1321		  (sign_extend:DI
1322		   (match_operand:SI 2 "s_register_operand"  "r,r"))))
1323   (clobber (reg:CC CC_REGNUM))]
1324  "TARGET_32BIT"
1325  "#"   ; "subs\\t%Q0, %Q1, %2\;sbc\\t%R0, %R1, %2, asr #31"
1326  "&& reload_completed"
1327  [(parallel [(set (reg:CC CC_REGNUM)
1328		   (compare:CC (match_dup 1) (match_dup 2)))
1329	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1330   (set (match_dup 3) (minus:SI (minus:SI (match_dup 4)
1331                                         (ashiftrt:SI (match_dup 2)
1332                                                      (const_int 31)))
1333                                (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1334  {
1335    operands[3] = gen_highpart (SImode, operands[0]);
1336    operands[0] = gen_lowpart (SImode, operands[0]);
1337    operands[4] = gen_highpart (SImode, operands[1]);
1338    operands[1] = gen_lowpart (SImode, operands[1]);
1339  }
1340  [(set_attr "conds" "clob")
1341   (set_attr "length" "8")
1342   (set_attr "type" "multiple")]
1343)
1344
1345(define_insn_and_split "*subdi_zesidi_di"
1346  [(set (match_operand:DI            0 "s_register_operand" "=&r,&r")
1347	(minus:DI (zero_extend:DI
1348		   (match_operand:SI 2 "s_register_operand"  "r,r"))
1349		  (match_operand:DI  1 "s_register_operand" "0,r")))
1350   (clobber (reg:CC CC_REGNUM))]
1351  "TARGET_ARM"
1352  "#"   ; "rsbs\\t%Q0, %Q1, %2\;rsc\\t%R0, %R1, #0"
1353        ; is equivalent to:
1354        ; "subs\\t%Q0, %2, %Q1\;rsc\\t%R0, %R1, #0"
1355  "&& reload_completed"
1356  [(parallel [(set (reg:CC CC_REGNUM)
1357		   (compare:CC (match_dup 2) (match_dup 1)))
1358	      (set (match_dup 0) (minus:SI (match_dup 2) (match_dup 1)))])
1359   (set (match_dup 3) (minus:SI (minus:SI (const_int 0) (match_dup 4))
1360			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1361  {
1362    operands[3] = gen_highpart (SImode, operands[0]);
1363    operands[0] = gen_lowpart (SImode, operands[0]);
1364    operands[4] = gen_highpart (SImode, operands[1]);
1365    operands[1] = gen_lowpart (SImode, operands[1]);
1366  }
1367  [(set_attr "conds" "clob")
1368   (set_attr "length" "8")
1369   (set_attr "type" "multiple")]
1370)
1371
1372(define_insn_and_split "*subdi_sesidi_di"
1373  [(set (match_operand:DI            0 "s_register_operand" "=&r,&r")
1374	(minus:DI (sign_extend:DI
1375		   (match_operand:SI 2 "s_register_operand"   "r,r"))
1376		  (match_operand:DI  1 "s_register_operand"  "0,r")))
1377   (clobber (reg:CC CC_REGNUM))]
1378  "TARGET_ARM"
1379  "#"   ; "rsbs\\t%Q0, %Q1, %2\;rsc\\t%R0, %R1, %2, asr #31"
1380        ; is equivalent to:
1381        ; "subs\\t%Q0, %2, %Q1\;rsc\\t%R0, %R1, %2, asr #31"
1382  "&& reload_completed"
1383  [(parallel [(set (reg:CC CC_REGNUM)
1384		   (compare:CC (match_dup 2) (match_dup 1)))
1385	      (set (match_dup 0) (minus:SI (match_dup 2) (match_dup 1)))])
1386   (set (match_dup 3) (minus:SI (minus:SI
1387                                (ashiftrt:SI (match_dup 2)
1388                                             (const_int 31))
1389                                (match_dup 4))
1390			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1391  {
1392    operands[3] = gen_highpart (SImode, operands[0]);
1393    operands[0] = gen_lowpart (SImode, operands[0]);
1394    operands[4] = gen_highpart (SImode, operands[1]);
1395    operands[1] = gen_lowpart (SImode, operands[1]);
1396  }
1397  [(set_attr "conds" "clob")
1398   (set_attr "length" "8")
1399   (set_attr "type" "multiple")]
1400)
1401
1402(define_insn_and_split "*subdi_zesidi_zesidi"
1403  [(set (match_operand:DI            0 "s_register_operand" "=r")
1404	(minus:DI (zero_extend:DI
1405		   (match_operand:SI 1 "s_register_operand"  "r"))
1406		  (zero_extend:DI
1407		   (match_operand:SI 2 "s_register_operand"  "r"))))
1408   (clobber (reg:CC CC_REGNUM))]
1409  "TARGET_32BIT"
1410  "#"   ; "subs\\t%Q0, %1, %2\;sbc\\t%R0, %1, %1"
1411  "&& reload_completed"
1412  [(parallel [(set (reg:CC CC_REGNUM)
1413		   (compare:CC (match_dup 1) (match_dup 2)))
1414	      (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
1415   (set (match_dup 3) (minus:SI (minus:SI (match_dup 1) (match_dup 1))
1416			       (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
1417  {
1418       operands[3] = gen_highpart (SImode, operands[0]);
1419       operands[0] = gen_lowpart (SImode, operands[0]);
1420  }
1421  [(set_attr "conds" "clob")
1422   (set_attr "length" "8")
1423   (set_attr "type" "multiple")]
1424)
1425
1426(define_expand "subsi3"
1427  [(set (match_operand:SI           0 "s_register_operand" "")
1428	(minus:SI (match_operand:SI 1 "reg_or_int_operand" "")
1429		  (match_operand:SI 2 "s_register_operand" "")))]
1430  "TARGET_EITHER"
1431  "
1432  if (CONST_INT_P (operands[1]))
1433    {
1434      if (TARGET_32BIT)
1435        {
1436	  if (DONT_EARLY_SPLIT_CONSTANT (INTVAL (operands[1]), MINUS))
1437	    operands[1] = force_reg (SImode, operands[1]);
1438	  else
1439	    {
1440	      arm_split_constant (MINUS, SImode, NULL_RTX,
1441				  INTVAL (operands[1]), operands[0],
1442				  operands[2],
1443				  optimize && can_create_pseudo_p ());
1444	      DONE;
1445	    }
1446	}
1447      else /* TARGET_THUMB1 */
1448        operands[1] = force_reg (SImode, operands[1]);
1449    }
1450  "
1451)
1452
1453; ??? Check Thumb-2 split length
1454(define_insn_and_split "*arm_subsi3_insn"
1455  [(set (match_operand:SI           0 "s_register_operand" "=l,l ,l ,l ,r,r,r,rk,r")
1456	(minus:SI (match_operand:SI 1 "reg_or_int_operand" "l ,0 ,l ,Pz,I,r,r,k ,?n")
1457		  (match_operand:SI 2 "reg_or_int_operand" "l ,Py,Pd,l ,r,I,r,r ,r")))]
1458  "TARGET_32BIT"
1459  "@
1460   sub%?\\t%0, %1, %2
1461   sub%?\\t%0, %2
1462   sub%?\\t%0, %1, %2
1463   rsb%?\\t%0, %2, %1
1464   rsb%?\\t%0, %2, %1
1465   sub%?\\t%0, %1, %2
1466   sub%?\\t%0, %1, %2
1467   sub%?\\t%0, %1, %2
1468   #"
1469  "&& (CONST_INT_P (operands[1])
1470       && !const_ok_for_arm (INTVAL (operands[1])))"
1471  [(clobber (const_int 0))]
1472  "
1473  arm_split_constant (MINUS, SImode, curr_insn,
1474                      INTVAL (operands[1]), operands[0], operands[2], 0);
1475  DONE;
1476  "
1477  [(set_attr "length" "4,4,4,4,4,4,4,4,16")
1478   (set_attr "arch" "t2,t2,t2,t2,*,*,*,*,*")
1479   (set_attr "predicable" "yes")
1480   (set_attr "predicable_short_it" "yes,yes,yes,yes,no,no,no,no,no")
1481   (set_attr "type" "alu_sreg,alu_sreg,alu_sreg,alu_sreg,alu_imm,alu_imm,alu_sreg,alu_sreg,multiple")]
1482)
1483
1484(define_peephole2
1485  [(match_scratch:SI 3 "r")
1486   (set (match_operand:SI 0 "arm_general_register_operand" "")
1487	(minus:SI (match_operand:SI 1 "const_int_operand" "")
1488		  (match_operand:SI 2 "arm_general_register_operand" "")))]
1489  "TARGET_32BIT
1490   && !const_ok_for_arm (INTVAL (operands[1]))
1491   && const_ok_for_arm (~INTVAL (operands[1]))"
1492  [(set (match_dup 3) (match_dup 1))
1493   (set (match_dup 0) (minus:SI (match_dup 3) (match_dup 2)))]
1494  ""
1495)
1496
1497(define_insn "subsi3_compare0"
1498  [(set (reg:CC_NOOV CC_REGNUM)
1499	(compare:CC_NOOV
1500	 (minus:SI (match_operand:SI 1 "arm_rhs_operand" "r,r,I")
1501		   (match_operand:SI 2 "arm_rhs_operand" "I,r,r"))
1502	 (const_int 0)))
1503   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
1504	(minus:SI (match_dup 1) (match_dup 2)))]
1505  "TARGET_32BIT"
1506  "@
1507   subs%?\\t%0, %1, %2
1508   subs%?\\t%0, %1, %2
1509   rsbs%?\\t%0, %2, %1"
1510  [(set_attr "conds" "set")
1511   (set_attr "type"  "alus_imm,alus_sreg,alus_sreg")]
1512)
1513
1514(define_insn "subsi3_compare"
1515  [(set (reg:CC CC_REGNUM)
1516	(compare:CC (match_operand:SI 1 "arm_rhs_operand" "r,r,I")
1517		    (match_operand:SI 2 "arm_rhs_operand" "I,r,r")))
1518   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
1519	(minus:SI (match_dup 1) (match_dup 2)))]
1520  "TARGET_32BIT"
1521  "@
1522   subs%?\\t%0, %1, %2
1523   subs%?\\t%0, %1, %2
1524   rsbs%?\\t%0, %2, %1"
1525  [(set_attr "conds" "set")
1526   (set_attr "type" "alus_imm,alus_sreg,alus_sreg")]
1527)
1528
1529(define_expand "subsf3"
1530  [(set (match_operand:SF           0 "s_register_operand" "")
1531	(minus:SF (match_operand:SF 1 "s_register_operand" "")
1532		  (match_operand:SF 2 "s_register_operand" "")))]
1533  "TARGET_32BIT && TARGET_HARD_FLOAT"
1534  "
1535")
1536
1537(define_expand "subdf3"
1538  [(set (match_operand:DF           0 "s_register_operand" "")
1539	(minus:DF (match_operand:DF 1 "s_register_operand" "")
1540		  (match_operand:DF 2 "s_register_operand" "")))]
1541  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
1542  "
1543")
1544
1545
1546;; Multiplication insns
1547
1548(define_expand "mulhi3"
1549  [(set (match_operand:HI 0 "s_register_operand" "")
1550	(mult:HI (match_operand:HI 1 "s_register_operand" "")
1551		 (match_operand:HI 2 "s_register_operand" "")))]
1552  "TARGET_DSP_MULTIPLY"
1553  "
1554  {
1555    rtx result = gen_reg_rtx (SImode);
1556    emit_insn (gen_mulhisi3 (result, operands[1], operands[2]));
1557    emit_move_insn (operands[0], gen_lowpart (HImode, result));
1558    DONE;
1559  }"
1560)
1561
1562(define_expand "mulsi3"
1563  [(set (match_operand:SI          0 "s_register_operand" "")
1564	(mult:SI (match_operand:SI 2 "s_register_operand" "")
1565		 (match_operand:SI 1 "s_register_operand" "")))]
1566  "TARGET_EITHER"
1567  ""
1568)
1569
1570;; Use `&' and then `0' to prevent the operands 0 and 1 being the same
1571(define_insn "*arm_mulsi3"
1572  [(set (match_operand:SI          0 "s_register_operand" "=&r,&r")
1573	(mult:SI (match_operand:SI 2 "s_register_operand" "r,r")
1574		 (match_operand:SI 1 "s_register_operand" "%0,r")))]
1575  "TARGET_32BIT && !arm_arch6"
1576  "mul%?\\t%0, %2, %1"
1577  [(set_attr "type" "mul")
1578   (set_attr "predicable" "yes")]
1579)
1580
1581(define_insn "*arm_mulsi3_v6"
1582  [(set (match_operand:SI          0 "s_register_operand" "=l,l,r")
1583	(mult:SI (match_operand:SI 1 "s_register_operand" "0,l,r")
1584		 (match_operand:SI 2 "s_register_operand" "l,0,r")))]
1585  "TARGET_32BIT && arm_arch6"
1586  "mul%?\\t%0, %1, %2"
1587  [(set_attr "type" "mul")
1588   (set_attr "predicable" "yes")
1589   (set_attr "arch" "t2,t2,*")
1590   (set_attr "length" "4")
1591   (set_attr "predicable_short_it" "yes,yes,no")]
1592)
1593
1594(define_insn "*mulsi3_compare0"
1595  [(set (reg:CC_NOOV CC_REGNUM)
1596	(compare:CC_NOOV (mult:SI
1597			  (match_operand:SI 2 "s_register_operand" "r,r")
1598			  (match_operand:SI 1 "s_register_operand" "%0,r"))
1599			 (const_int 0)))
1600   (set (match_operand:SI 0 "s_register_operand" "=&r,&r")
1601	(mult:SI (match_dup 2) (match_dup 1)))]
1602  "TARGET_ARM && !arm_arch6"
1603  "muls%?\\t%0, %2, %1"
1604  [(set_attr "conds" "set")
1605   (set_attr "type" "muls")]
1606)
1607
1608(define_insn "*mulsi3_compare0_v6"
1609  [(set (reg:CC_NOOV CC_REGNUM)
1610	(compare:CC_NOOV (mult:SI
1611			  (match_operand:SI 2 "s_register_operand" "r")
1612			  (match_operand:SI 1 "s_register_operand" "r"))
1613			 (const_int 0)))
1614   (set (match_operand:SI 0 "s_register_operand" "=r")
1615	(mult:SI (match_dup 2) (match_dup 1)))]
1616  "TARGET_ARM && arm_arch6 && optimize_size"
1617  "muls%?\\t%0, %2, %1"
1618  [(set_attr "conds" "set")
1619   (set_attr "type" "muls")]
1620)
1621
1622(define_insn "*mulsi_compare0_scratch"
1623  [(set (reg:CC_NOOV CC_REGNUM)
1624	(compare:CC_NOOV (mult:SI
1625			  (match_operand:SI 2 "s_register_operand" "r,r")
1626			  (match_operand:SI 1 "s_register_operand" "%0,r"))
1627			 (const_int 0)))
1628   (clobber (match_scratch:SI 0 "=&r,&r"))]
1629  "TARGET_ARM && !arm_arch6"
1630  "muls%?\\t%0, %2, %1"
1631  [(set_attr "conds" "set")
1632   (set_attr "type" "muls")]
1633)
1634
1635(define_insn "*mulsi_compare0_scratch_v6"
1636  [(set (reg:CC_NOOV CC_REGNUM)
1637	(compare:CC_NOOV (mult:SI
1638			  (match_operand:SI 2 "s_register_operand" "r")
1639			  (match_operand:SI 1 "s_register_operand" "r"))
1640			 (const_int 0)))
1641   (clobber (match_scratch:SI 0 "=r"))]
1642  "TARGET_ARM && arm_arch6 && optimize_size"
1643  "muls%?\\t%0, %2, %1"
1644  [(set_attr "conds" "set")
1645   (set_attr "type" "muls")]
1646)
1647
1648;; Unnamed templates to match MLA instruction.
1649
1650(define_insn "*mulsi3addsi"
1651  [(set (match_operand:SI 0 "s_register_operand" "=&r,&r,&r,&r")
1652	(plus:SI
1653	  (mult:SI (match_operand:SI 2 "s_register_operand" "r,r,r,r")
1654		   (match_operand:SI 1 "s_register_operand" "%0,r,0,r"))
1655	  (match_operand:SI 3 "s_register_operand" "r,r,0,0")))]
1656  "TARGET_32BIT && !arm_arch6"
1657  "mla%?\\t%0, %2, %1, %3"
1658  [(set_attr "type" "mla")
1659   (set_attr "predicable" "yes")]
1660)
1661
1662(define_insn "*mulsi3addsi_v6"
1663  [(set (match_operand:SI 0 "s_register_operand" "=r")
1664	(plus:SI
1665	  (mult:SI (match_operand:SI 2 "s_register_operand" "r")
1666		   (match_operand:SI 1 "s_register_operand" "r"))
1667	  (match_operand:SI 3 "s_register_operand" "r")))]
1668  "TARGET_32BIT && arm_arch6"
1669  "mla%?\\t%0, %2, %1, %3"
1670  [(set_attr "type" "mla")
1671   (set_attr "predicable" "yes")]
1672)
1673
1674(define_insn "*mulsi3addsi_compare0"
1675  [(set (reg:CC_NOOV CC_REGNUM)
1676	(compare:CC_NOOV
1677	 (plus:SI (mult:SI
1678		   (match_operand:SI 2 "s_register_operand" "r,r,r,r")
1679		   (match_operand:SI 1 "s_register_operand" "%0,r,0,r"))
1680		  (match_operand:SI 3 "s_register_operand" "r,r,0,0"))
1681	 (const_int 0)))
1682   (set (match_operand:SI 0 "s_register_operand" "=&r,&r,&r,&r")
1683	(plus:SI (mult:SI (match_dup 2) (match_dup 1))
1684		 (match_dup 3)))]
1685  "TARGET_ARM && arm_arch6"
1686  "mlas%?\\t%0, %2, %1, %3"
1687  [(set_attr "conds" "set")
1688   (set_attr "type" "mlas")]
1689)
1690
1691(define_insn "*mulsi3addsi_compare0_v6"
1692  [(set (reg:CC_NOOV CC_REGNUM)
1693	(compare:CC_NOOV
1694	 (plus:SI (mult:SI
1695		   (match_operand:SI 2 "s_register_operand" "r")
1696		   (match_operand:SI 1 "s_register_operand" "r"))
1697		  (match_operand:SI 3 "s_register_operand" "r"))
1698	 (const_int 0)))
1699   (set (match_operand:SI 0 "s_register_operand" "=r")
1700	(plus:SI (mult:SI (match_dup 2) (match_dup 1))
1701		 (match_dup 3)))]
1702  "TARGET_ARM && arm_arch6 && optimize_size"
1703  "mlas%?\\t%0, %2, %1, %3"
1704  [(set_attr "conds" "set")
1705   (set_attr "type" "mlas")]
1706)
1707
1708(define_insn "*mulsi3addsi_compare0_scratch"
1709  [(set (reg:CC_NOOV CC_REGNUM)
1710	(compare:CC_NOOV
1711	 (plus:SI (mult:SI
1712		   (match_operand:SI 2 "s_register_operand" "r,r,r,r")
1713		   (match_operand:SI 1 "s_register_operand" "%0,r,0,r"))
1714		  (match_operand:SI 3 "s_register_operand" "?r,r,0,0"))
1715	 (const_int 0)))
1716   (clobber (match_scratch:SI 0 "=&r,&r,&r,&r"))]
1717  "TARGET_ARM && !arm_arch6"
1718  "mlas%?\\t%0, %2, %1, %3"
1719  [(set_attr "conds" "set")
1720   (set_attr "type" "mlas")]
1721)
1722
1723(define_insn "*mulsi3addsi_compare0_scratch_v6"
1724  [(set (reg:CC_NOOV CC_REGNUM)
1725	(compare:CC_NOOV
1726	 (plus:SI (mult:SI
1727		   (match_operand:SI 2 "s_register_operand" "r")
1728		   (match_operand:SI 1 "s_register_operand" "r"))
1729		  (match_operand:SI 3 "s_register_operand" "r"))
1730	 (const_int 0)))
1731   (clobber (match_scratch:SI 0 "=r"))]
1732  "TARGET_ARM && arm_arch6 && optimize_size"
1733  "mlas%?\\t%0, %2, %1, %3"
1734  [(set_attr "conds" "set")
1735   (set_attr "type" "mlas")]
1736)
1737
1738(define_insn "*mulsi3subsi"
1739  [(set (match_operand:SI 0 "s_register_operand" "=r")
1740	(minus:SI
1741	  (match_operand:SI 3 "s_register_operand" "r")
1742	  (mult:SI (match_operand:SI 2 "s_register_operand" "r")
1743		   (match_operand:SI 1 "s_register_operand" "r"))))]
1744  "TARGET_32BIT && arm_arch_thumb2"
1745  "mls%?\\t%0, %2, %1, %3"
1746  [(set_attr "type" "mla")
1747   (set_attr "predicable" "yes")]
1748)
1749
1750(define_expand "maddsidi4"
1751  [(set (match_operand:DI 0 "s_register_operand" "")
1752	(plus:DI
1753	 (mult:DI
1754	  (sign_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1755	  (sign_extend:DI (match_operand:SI 2 "s_register_operand" "")))
1756	 (match_operand:DI 3 "s_register_operand" "")))]
1757  "TARGET_32BIT && arm_arch3m"
1758  "")
1759
1760(define_insn "*mulsidi3adddi"
1761  [(set (match_operand:DI 0 "s_register_operand" "=&r")
1762	(plus:DI
1763	 (mult:DI
1764	  (sign_extend:DI (match_operand:SI 2 "s_register_operand" "%r"))
1765	  (sign_extend:DI (match_operand:SI 3 "s_register_operand" "r")))
1766	 (match_operand:DI 1 "s_register_operand" "0")))]
1767  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1768  "smlal%?\\t%Q0, %R0, %3, %2"
1769  [(set_attr "type" "smlal")
1770   (set_attr "predicable" "yes")]
1771)
1772
1773(define_insn "*mulsidi3adddi_v6"
1774  [(set (match_operand:DI 0 "s_register_operand" "=r")
1775	(plus:DI
1776	 (mult:DI
1777	  (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r"))
1778	  (sign_extend:DI (match_operand:SI 3 "s_register_operand" "r")))
1779	 (match_operand:DI 1 "s_register_operand" "0")))]
1780  "TARGET_32BIT && arm_arch6"
1781  "smlal%?\\t%Q0, %R0, %3, %2"
1782  [(set_attr "type" "smlal")
1783   (set_attr "predicable" "yes")]
1784)
1785
1786;; 32x32->64 widening multiply.
1787;; As with mulsi3, the only difference between the v3-5 and v6+
1788;; versions of these patterns is the requirement that the output not
1789;; overlap the inputs, but that still means we have to have a named
1790;; expander and two different starred insns.
1791
1792(define_expand "mulsidi3"
1793  [(set (match_operand:DI 0 "s_register_operand" "")
1794	(mult:DI
1795	 (sign_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1796	 (sign_extend:DI (match_operand:SI 2 "s_register_operand" ""))))]
1797  "TARGET_32BIT && arm_arch3m"
1798  ""
1799)
1800
1801(define_insn "*mulsidi3_nov6"
1802  [(set (match_operand:DI 0 "s_register_operand" "=&r")
1803	(mult:DI
1804	 (sign_extend:DI (match_operand:SI 1 "s_register_operand" "%r"))
1805	 (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r"))))]
1806  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1807  "smull%?\\t%Q0, %R0, %1, %2"
1808  [(set_attr "type" "smull")
1809   (set_attr "predicable" "yes")]
1810)
1811
1812(define_insn "*mulsidi3_v6"
1813  [(set (match_operand:DI 0 "s_register_operand" "=r")
1814	(mult:DI
1815	 (sign_extend:DI (match_operand:SI 1 "s_register_operand" "r"))
1816	 (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r"))))]
1817  "TARGET_32BIT && arm_arch6"
1818  "smull%?\\t%Q0, %R0, %1, %2"
1819  [(set_attr "type" "smull")
1820   (set_attr "predicable" "yes")]
1821)
1822
1823(define_expand "umulsidi3"
1824  [(set (match_operand:DI 0 "s_register_operand" "")
1825	(mult:DI
1826	 (zero_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1827	 (zero_extend:DI (match_operand:SI 2 "s_register_operand" ""))))]
1828  "TARGET_32BIT && arm_arch3m"
1829  ""
1830)
1831
1832(define_insn "*umulsidi3_nov6"
1833  [(set (match_operand:DI 0 "s_register_operand" "=&r")
1834	(mult:DI
1835	 (zero_extend:DI (match_operand:SI 1 "s_register_operand" "%r"))
1836	 (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r"))))]
1837  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1838  "umull%?\\t%Q0, %R0, %1, %2"
1839  [(set_attr "type" "umull")
1840   (set_attr "predicable" "yes")]
1841)
1842
1843(define_insn "*umulsidi3_v6"
1844  [(set (match_operand:DI 0 "s_register_operand" "=r")
1845	(mult:DI
1846	 (zero_extend:DI (match_operand:SI 1 "s_register_operand" "r"))
1847	 (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r"))))]
1848  "TARGET_32BIT && arm_arch6"
1849  "umull%?\\t%Q0, %R0, %1, %2"
1850  [(set_attr "type" "umull")
1851   (set_attr "predicable" "yes")]
1852)
1853
1854(define_expand "umaddsidi4"
1855  [(set (match_operand:DI 0 "s_register_operand" "")
1856	(plus:DI
1857	 (mult:DI
1858	  (zero_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1859	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" "")))
1860	 (match_operand:DI 3 "s_register_operand" "")))]
1861  "TARGET_32BIT && arm_arch3m"
1862  "")
1863
1864(define_insn "*umulsidi3adddi"
1865  [(set (match_operand:DI 0 "s_register_operand" "=&r")
1866	(plus:DI
1867	 (mult:DI
1868	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" "%r"))
1869	  (zero_extend:DI (match_operand:SI 3 "s_register_operand" "r")))
1870	 (match_operand:DI 1 "s_register_operand" "0")))]
1871  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1872  "umlal%?\\t%Q0, %R0, %3, %2"
1873  [(set_attr "type" "umlal")
1874   (set_attr "predicable" "yes")]
1875)
1876
1877(define_insn "*umulsidi3adddi_v6"
1878  [(set (match_operand:DI 0 "s_register_operand" "=r")
1879	(plus:DI
1880	 (mult:DI
1881	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r"))
1882	  (zero_extend:DI (match_operand:SI 3 "s_register_operand" "r")))
1883	 (match_operand:DI 1 "s_register_operand" "0")))]
1884  "TARGET_32BIT && arm_arch6"
1885  "umlal%?\\t%Q0, %R0, %3, %2"
1886  [(set_attr "type" "umlal")
1887   (set_attr "predicable" "yes")]
1888)
1889
1890(define_expand "smulsi3_highpart"
1891  [(parallel
1892    [(set (match_operand:SI 0 "s_register_operand" "")
1893	  (truncate:SI
1894	   (lshiftrt:DI
1895	    (mult:DI
1896	     (sign_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1897	     (sign_extend:DI (match_operand:SI 2 "s_register_operand" "")))
1898	    (const_int 32))))
1899     (clobber (match_scratch:SI 3 ""))])]
1900  "TARGET_32BIT && arm_arch3m"
1901  ""
1902)
1903
1904(define_insn "*smulsi3_highpart_nov6"
1905  [(set (match_operand:SI 0 "s_register_operand" "=&r,&r")
1906	(truncate:SI
1907	 (lshiftrt:DI
1908	  (mult:DI
1909	   (sign_extend:DI (match_operand:SI 1 "s_register_operand" "%0,r"))
1910	   (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r,r")))
1911	  (const_int 32))))
1912   (clobber (match_scratch:SI 3 "=&r,&r"))]
1913  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1914  "smull%?\\t%3, %0, %2, %1"
1915  [(set_attr "type" "smull")
1916   (set_attr "predicable" "yes")]
1917)
1918
1919(define_insn "*smulsi3_highpart_v6"
1920  [(set (match_operand:SI 0 "s_register_operand" "=r")
1921	(truncate:SI
1922	 (lshiftrt:DI
1923	  (mult:DI
1924	   (sign_extend:DI (match_operand:SI 1 "s_register_operand" "r"))
1925	   (sign_extend:DI (match_operand:SI 2 "s_register_operand" "r")))
1926	  (const_int 32))))
1927   (clobber (match_scratch:SI 3 "=r"))]
1928  "TARGET_32BIT && arm_arch6"
1929  "smull%?\\t%3, %0, %2, %1"
1930  [(set_attr "type" "smull")
1931   (set_attr "predicable" "yes")]
1932)
1933
1934(define_expand "umulsi3_highpart"
1935  [(parallel
1936    [(set (match_operand:SI 0 "s_register_operand" "")
1937	  (truncate:SI
1938	   (lshiftrt:DI
1939	    (mult:DI
1940	     (zero_extend:DI (match_operand:SI 1 "s_register_operand" ""))
1941	      (zero_extend:DI (match_operand:SI 2 "s_register_operand" "")))
1942	    (const_int 32))))
1943     (clobber (match_scratch:SI 3 ""))])]
1944  "TARGET_32BIT && arm_arch3m"
1945  ""
1946)
1947
1948(define_insn "*umulsi3_highpart_nov6"
1949  [(set (match_operand:SI 0 "s_register_operand" "=&r,&r")
1950	(truncate:SI
1951	 (lshiftrt:DI
1952	  (mult:DI
1953	   (zero_extend:DI (match_operand:SI 1 "s_register_operand" "%0,r"))
1954	   (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r,r")))
1955	  (const_int 32))))
1956   (clobber (match_scratch:SI 3 "=&r,&r"))]
1957  "TARGET_32BIT && arm_arch3m && !arm_arch6"
1958  "umull%?\\t%3, %0, %2, %1"
1959  [(set_attr "type" "umull")
1960   (set_attr "predicable" "yes")]
1961)
1962
1963(define_insn "*umulsi3_highpart_v6"
1964  [(set (match_operand:SI 0 "s_register_operand" "=r")
1965	(truncate:SI
1966	 (lshiftrt:DI
1967	  (mult:DI
1968	   (zero_extend:DI (match_operand:SI 1 "s_register_operand" "r"))
1969	   (zero_extend:DI (match_operand:SI 2 "s_register_operand" "r")))
1970	  (const_int 32))))
1971   (clobber (match_scratch:SI 3 "=r"))]
1972  "TARGET_32BIT && arm_arch6"
1973  "umull%?\\t%3, %0, %2, %1"
1974  [(set_attr "type" "umull")
1975   (set_attr "predicable" "yes")]
1976)
1977
1978(define_insn "mulhisi3"
1979  [(set (match_operand:SI 0 "s_register_operand" "=r")
1980	(mult:SI (sign_extend:SI
1981		  (match_operand:HI 1 "s_register_operand" "%r"))
1982		 (sign_extend:SI
1983		  (match_operand:HI 2 "s_register_operand" "r"))))]
1984  "TARGET_DSP_MULTIPLY"
1985  "smulbb%?\\t%0, %1, %2"
1986  [(set_attr "type" "smulxy")
1987   (set_attr "predicable" "yes")]
1988)
1989
1990(define_insn "*mulhisi3tb"
1991  [(set (match_operand:SI 0 "s_register_operand" "=r")
1992	(mult:SI (ashiftrt:SI
1993		  (match_operand:SI 1 "s_register_operand" "r")
1994		  (const_int 16))
1995		 (sign_extend:SI
1996		  (match_operand:HI 2 "s_register_operand" "r"))))]
1997  "TARGET_DSP_MULTIPLY"
1998  "smultb%?\\t%0, %1, %2"
1999  [(set_attr "type" "smulxy")
2000   (set_attr "predicable" "yes")]
2001)
2002
2003(define_insn "*mulhisi3bt"
2004  [(set (match_operand:SI 0 "s_register_operand" "=r")
2005	(mult:SI (sign_extend:SI
2006		  (match_operand:HI 1 "s_register_operand" "r"))
2007		 (ashiftrt:SI
2008		  (match_operand:SI 2 "s_register_operand" "r")
2009		  (const_int 16))))]
2010  "TARGET_DSP_MULTIPLY"
2011  "smulbt%?\\t%0, %1, %2"
2012  [(set_attr "type" "smulxy")
2013   (set_attr "predicable" "yes")]
2014)
2015
2016(define_insn "*mulhisi3tt"
2017  [(set (match_operand:SI 0 "s_register_operand" "=r")
2018	(mult:SI (ashiftrt:SI
2019		  (match_operand:SI 1 "s_register_operand" "r")
2020		  (const_int 16))
2021		 (ashiftrt:SI
2022		  (match_operand:SI 2 "s_register_operand" "r")
2023		  (const_int 16))))]
2024  "TARGET_DSP_MULTIPLY"
2025  "smultt%?\\t%0, %1, %2"
2026  [(set_attr "type" "smulxy")
2027   (set_attr "predicable" "yes")]
2028)
2029
2030(define_insn "maddhisi4"
2031  [(set (match_operand:SI 0 "s_register_operand" "=r")
2032	(plus:SI (mult:SI (sign_extend:SI
2033			   (match_operand:HI 1 "s_register_operand" "r"))
2034			  (sign_extend:SI
2035			   (match_operand:HI 2 "s_register_operand" "r")))
2036		 (match_operand:SI 3 "s_register_operand" "r")))]
2037  "TARGET_DSP_MULTIPLY"
2038  "smlabb%?\\t%0, %1, %2, %3"
2039  [(set_attr "type" "smlaxy")
2040   (set_attr "predicable" "yes")]
2041)
2042
2043;; Note: there is no maddhisi4ibt because this one is canonical form
2044(define_insn "*maddhisi4tb"
2045  [(set (match_operand:SI 0 "s_register_operand" "=r")
2046	(plus:SI (mult:SI (ashiftrt:SI
2047			   (match_operand:SI 1 "s_register_operand" "r")
2048			   (const_int 16))
2049			  (sign_extend:SI
2050			   (match_operand:HI 2 "s_register_operand" "r")))
2051		 (match_operand:SI 3 "s_register_operand" "r")))]
2052  "TARGET_DSP_MULTIPLY"
2053  "smlatb%?\\t%0, %1, %2, %3"
2054  [(set_attr "type" "smlaxy")
2055   (set_attr "predicable" "yes")]
2056)
2057
2058(define_insn "*maddhisi4tt"
2059  [(set (match_operand:SI 0 "s_register_operand" "=r")
2060	(plus:SI (mult:SI (ashiftrt:SI
2061			   (match_operand:SI 1 "s_register_operand" "r")
2062			   (const_int 16))
2063			  (ashiftrt:SI
2064			   (match_operand:SI 2 "s_register_operand" "r")
2065			   (const_int 16)))
2066		 (match_operand:SI 3 "s_register_operand" "r")))]
2067  "TARGET_DSP_MULTIPLY"
2068  "smlatt%?\\t%0, %1, %2, %3"
2069  [(set_attr "type" "smlaxy")
2070   (set_attr "predicable" "yes")]
2071)
2072
2073(define_insn "maddhidi4"
2074  [(set (match_operand:DI 0 "s_register_operand" "=r")
2075	(plus:DI
2076	  (mult:DI (sign_extend:DI
2077		    (match_operand:HI 1 "s_register_operand" "r"))
2078		   (sign_extend:DI
2079		    (match_operand:HI 2 "s_register_operand" "r")))
2080	  (match_operand:DI 3 "s_register_operand" "0")))]
2081  "TARGET_DSP_MULTIPLY"
2082  "smlalbb%?\\t%Q0, %R0, %1, %2"
2083  [(set_attr "type" "smlalxy")
2084   (set_attr "predicable" "yes")])
2085
2086;; Note: there is no maddhidi4ibt because this one is canonical form
2087(define_insn "*maddhidi4tb"
2088  [(set (match_operand:DI 0 "s_register_operand" "=r")
2089	(plus:DI
2090	  (mult:DI (sign_extend:DI
2091		    (ashiftrt:SI
2092		     (match_operand:SI 1 "s_register_operand" "r")
2093		     (const_int 16)))
2094		   (sign_extend:DI
2095		    (match_operand:HI 2 "s_register_operand" "r")))
2096	  (match_operand:DI 3 "s_register_operand" "0")))]
2097  "TARGET_DSP_MULTIPLY"
2098  "smlaltb%?\\t%Q0, %R0, %1, %2"
2099  [(set_attr "type" "smlalxy")
2100   (set_attr "predicable" "yes")])
2101
2102(define_insn "*maddhidi4tt"
2103  [(set (match_operand:DI 0 "s_register_operand" "=r")
2104	(plus:DI
2105	  (mult:DI (sign_extend:DI
2106		    (ashiftrt:SI
2107		     (match_operand:SI 1 "s_register_operand" "r")
2108		     (const_int 16)))
2109		   (sign_extend:DI
2110		    (ashiftrt:SI
2111		     (match_operand:SI 2 "s_register_operand" "r")
2112		     (const_int 16))))
2113	  (match_operand:DI 3 "s_register_operand" "0")))]
2114  "TARGET_DSP_MULTIPLY"
2115  "smlaltt%?\\t%Q0, %R0, %1, %2"
2116  [(set_attr "type" "smlalxy")
2117   (set_attr "predicable" "yes")])
2118
2119(define_expand "mulsf3"
2120  [(set (match_operand:SF          0 "s_register_operand" "")
2121	(mult:SF (match_operand:SF 1 "s_register_operand" "")
2122		 (match_operand:SF 2 "s_register_operand" "")))]
2123  "TARGET_32BIT && TARGET_HARD_FLOAT"
2124  "
2125")
2126
2127(define_expand "muldf3"
2128  [(set (match_operand:DF          0 "s_register_operand" "")
2129	(mult:DF (match_operand:DF 1 "s_register_operand" "")
2130		 (match_operand:DF 2 "s_register_operand" "")))]
2131  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
2132  "
2133")
2134
2135;; Division insns
2136
2137(define_expand "divsf3"
2138  [(set (match_operand:SF 0 "s_register_operand" "")
2139	(div:SF (match_operand:SF 1 "s_register_operand" "")
2140		(match_operand:SF 2 "s_register_operand" "")))]
2141  "TARGET_32BIT && TARGET_HARD_FLOAT"
2142  "")
2143
2144(define_expand "divdf3"
2145  [(set (match_operand:DF 0 "s_register_operand" "")
2146	(div:DF (match_operand:DF 1 "s_register_operand" "")
2147		(match_operand:DF 2 "s_register_operand" "")))]
2148  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP_DOUBLE"
2149  "")
2150
2151;; Boolean and,ior,xor insns
2152
2153;; Split up double word logical operations
2154
2155;; Split up simple DImode logical operations.  Simply perform the logical
2156;; operation on the upper and lower halves of the registers.
2157(define_split
2158  [(set (match_operand:DI 0 "s_register_operand" "")
2159	(match_operator:DI 6 "logical_binary_operator"
2160	  [(match_operand:DI 1 "s_register_operand" "")
2161	   (match_operand:DI 2 "s_register_operand" "")]))]
2162  "TARGET_32BIT && reload_completed
2163   && ! (TARGET_NEON && IS_VFP_REGNUM (REGNO (operands[0])))
2164   && ! IS_IWMMXT_REGNUM (REGNO (operands[0]))"
2165  [(set (match_dup 0) (match_op_dup:SI 6 [(match_dup 1) (match_dup 2)]))
2166   (set (match_dup 3) (match_op_dup:SI 6 [(match_dup 4) (match_dup 5)]))]
2167  "
2168  {
2169    operands[3] = gen_highpart (SImode, operands[0]);
2170    operands[0] = gen_lowpart (SImode, operands[0]);
2171    operands[4] = gen_highpart (SImode, operands[1]);
2172    operands[1] = gen_lowpart (SImode, operands[1]);
2173    operands[5] = gen_highpart (SImode, operands[2]);
2174    operands[2] = gen_lowpart (SImode, operands[2]);
2175  }"
2176)
2177
2178(define_split
2179  [(set (match_operand:DI 0 "s_register_operand" "")
2180	(match_operator:DI 6 "logical_binary_operator"
2181	  [(sign_extend:DI (match_operand:SI 2 "s_register_operand" ""))
2182	   (match_operand:DI 1 "s_register_operand" "")]))]
2183  "TARGET_32BIT && reload_completed"
2184  [(set (match_dup 0) (match_op_dup:SI 6 [(match_dup 1) (match_dup 2)]))
2185   (set (match_dup 3) (match_op_dup:SI 6
2186			[(ashiftrt:SI (match_dup 2) (const_int 31))
2187			 (match_dup 4)]))]
2188  "
2189  {
2190    operands[3] = gen_highpart (SImode, operands[0]);
2191    operands[0] = gen_lowpart (SImode, operands[0]);
2192    operands[4] = gen_highpart (SImode, operands[1]);
2193    operands[1] = gen_lowpart (SImode, operands[1]);
2194    operands[5] = gen_highpart (SImode, operands[2]);
2195    operands[2] = gen_lowpart (SImode, operands[2]);
2196  }"
2197)
2198
2199;; The zero extend of operand 2 means we can just copy the high part of
2200;; operand1 into operand0.
2201(define_split
2202  [(set (match_operand:DI 0 "s_register_operand" "")
2203	(ior:DI
2204	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" ""))
2205	  (match_operand:DI 1 "s_register_operand" "")))]
2206  "TARGET_32BIT && operands[0] != operands[1] && reload_completed"
2207  [(set (match_dup 0) (ior:SI (match_dup 1) (match_dup 2)))
2208   (set (match_dup 3) (match_dup 4))]
2209  "
2210  {
2211    operands[4] = gen_highpart (SImode, operands[1]);
2212    operands[3] = gen_highpart (SImode, operands[0]);
2213    operands[0] = gen_lowpart (SImode, operands[0]);
2214    operands[1] = gen_lowpart (SImode, operands[1]);
2215  }"
2216)
2217
2218;; The zero extend of operand 2 means we can just copy the high part of
2219;; operand1 into operand0.
2220(define_split
2221  [(set (match_operand:DI 0 "s_register_operand" "")
2222	(xor:DI
2223	  (zero_extend:DI (match_operand:SI 2 "s_register_operand" ""))
2224	  (match_operand:DI 1 "s_register_operand" "")))]
2225  "TARGET_32BIT && operands[0] != operands[1] && reload_completed"
2226  [(set (match_dup 0) (xor:SI (match_dup 1) (match_dup 2)))
2227   (set (match_dup 3) (match_dup 4))]
2228  "
2229  {
2230    operands[4] = gen_highpart (SImode, operands[1]);
2231    operands[3] = gen_highpart (SImode, operands[0]);
2232    operands[0] = gen_lowpart (SImode, operands[0]);
2233    operands[1] = gen_lowpart (SImode, operands[1]);
2234  }"
2235)
2236
2237(define_expand "anddi3"
2238  [(set (match_operand:DI         0 "s_register_operand" "")
2239	(and:DI (match_operand:DI 1 "s_register_operand" "")
2240		(match_operand:DI 2 "neon_inv_logic_op2" "")))]
2241  "TARGET_32BIT"
2242  "
2243  if (!TARGET_NEON && !TARGET_IWMMXT)
2244    {
2245      rtx low  = simplify_gen_binary (AND, SImode,
2246				      gen_lowpart (SImode, operands[1]),
2247				      gen_lowpart (SImode, operands[2]));
2248      rtx high = simplify_gen_binary (AND, SImode,
2249				      gen_highpart (SImode, operands[1]),
2250				      gen_highpart_mode (SImode, DImode,
2251							 operands[2]));
2252
2253      emit_insn (gen_rtx_SET (gen_lowpart (SImode, operands[0]), low));
2254      emit_insn (gen_rtx_SET (gen_highpart (SImode, operands[0]), high));
2255
2256      DONE;
2257    }
2258  /* Otherwise expand pattern as above.  */
2259  "
2260)
2261
2262(define_insn_and_split "*anddi3_insn"
2263  [(set (match_operand:DI         0 "s_register_operand"     "=w,w ,&r,&r,&r,&r,?w,?w")
2264        (and:DI (match_operand:DI 1 "s_register_operand"     "%w,0 ,0 ,r ,0 ,r ,w ,0")
2265                (match_operand:DI 2 "arm_anddi_operand_neon" "w ,DL,r ,r ,De,De,w ,DL")))]
2266  "TARGET_32BIT && !TARGET_IWMMXT"
2267{
2268  switch (which_alternative)
2269    {
2270    case 0: /* fall through */
2271    case 6: return "vand\t%P0, %P1, %P2";
2272    case 1: /* fall through */
2273    case 7: return neon_output_logic_immediate ("vand", &operands[2],
2274                    DImode, 1, VALID_NEON_QREG_MODE (DImode));
2275    case 2:
2276    case 3:
2277    case 4:
2278    case 5: /* fall through */
2279      return "#";
2280    default: gcc_unreachable ();
2281    }
2282}
2283  "TARGET_32BIT && !TARGET_IWMMXT && reload_completed
2284   && !(IS_VFP_REGNUM (REGNO (operands[0])))"
2285  [(set (match_dup 3) (match_dup 4))
2286   (set (match_dup 5) (match_dup 6))]
2287  "
2288  {
2289    operands[3] = gen_lowpart (SImode, operands[0]);
2290    operands[5] = gen_highpart (SImode, operands[0]);
2291
2292    operands[4] = simplify_gen_binary (AND, SImode,
2293                                           gen_lowpart (SImode, operands[1]),
2294                                           gen_lowpart (SImode, operands[2]));
2295    operands[6] = simplify_gen_binary (AND, SImode,
2296                                           gen_highpart (SImode, operands[1]),
2297                                           gen_highpart_mode (SImode, DImode, operands[2]));
2298
2299  }"
2300  [(set_attr "type" "neon_logic,neon_logic,multiple,multiple,\
2301                     multiple,multiple,neon_logic,neon_logic")
2302   (set_attr "arch" "neon_for_64bits,neon_for_64bits,*,*,*,*,
2303                     avoid_neon_for_64bits,avoid_neon_for_64bits")
2304   (set_attr "length" "*,*,8,8,8,8,*,*")
2305  ]
2306)
2307
2308(define_insn_and_split "*anddi_zesidi_di"
2309  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2310	(and:DI (zero_extend:DI
2311		 (match_operand:SI 2 "s_register_operand" "r,r"))
2312		(match_operand:DI 1 "s_register_operand" "0,r")))]
2313  "TARGET_32BIT"
2314  "#"
2315  "TARGET_32BIT && reload_completed"
2316  ; The zero extend of operand 2 clears the high word of the output
2317  ; operand.
2318  [(set (match_dup 0) (and:SI (match_dup 1) (match_dup 2)))
2319   (set (match_dup 3) (const_int 0))]
2320  "
2321  {
2322    operands[3] = gen_highpart (SImode, operands[0]);
2323    operands[0] = gen_lowpart (SImode, operands[0]);
2324    operands[1] = gen_lowpart (SImode, operands[1]);
2325  }"
2326  [(set_attr "length" "8")
2327   (set_attr "type" "multiple")]
2328)
2329
2330(define_insn "*anddi_sesdi_di"
2331  [(set (match_operand:DI          0 "s_register_operand" "=&r,&r")
2332	(and:DI (sign_extend:DI
2333		 (match_operand:SI 2 "s_register_operand" "r,r"))
2334		(match_operand:DI  1 "s_register_operand" "0,r")))]
2335  "TARGET_32BIT"
2336  "#"
2337  [(set_attr "length" "8")
2338   (set_attr "type" "multiple")]
2339)
2340
2341(define_expand "andsi3"
2342  [(set (match_operand:SI         0 "s_register_operand" "")
2343	(and:SI (match_operand:SI 1 "s_register_operand" "")
2344		(match_operand:SI 2 "reg_or_int_operand" "")))]
2345  "TARGET_EITHER"
2346  "
2347  if (TARGET_32BIT)
2348    {
2349      if (CONST_INT_P (operands[2]))
2350        {
2351	  if (INTVAL (operands[2]) == 255 && arm_arch6)
2352	    {
2353	      operands[1] = convert_to_mode (QImode, operands[1], 1);
2354	      emit_insn (gen_thumb2_zero_extendqisi2_v6 (operands[0],
2355							 operands[1]));
2356	      DONE;
2357	    }
2358	  else if (DONT_EARLY_SPLIT_CONSTANT (INTVAL (operands[2]), AND))
2359	    operands[2] = force_reg (SImode, operands[2]);
2360	  else
2361	    {
2362	      arm_split_constant (AND, SImode, NULL_RTX,
2363				  INTVAL (operands[2]), operands[0],
2364				  operands[1],
2365				  optimize && can_create_pseudo_p ());
2366
2367	      DONE;
2368	    }
2369        }
2370    }
2371  else /* TARGET_THUMB1 */
2372    {
2373      if (!CONST_INT_P (operands[2]))
2374        {
2375          rtx tmp = force_reg (SImode, operands[2]);
2376	  if (rtx_equal_p (operands[0], operands[1]))
2377	    operands[2] = tmp;
2378	  else
2379	    {
2380              operands[2] = operands[1];
2381              operands[1] = tmp;
2382	    }
2383        }
2384      else
2385        {
2386          int i;
2387
2388          if (((unsigned HOST_WIDE_INT) ~INTVAL (operands[2])) < 256)
2389  	    {
2390	      operands[2] = force_reg (SImode,
2391				       GEN_INT (~INTVAL (operands[2])));
2392
2393	      emit_insn (gen_thumb1_bicsi3 (operands[0], operands[2], operands[1]));
2394
2395	      DONE;
2396	    }
2397
2398          for (i = 9; i <= 31; i++)
2399	    {
2400	      if ((HOST_WIDE_INT_1 << i) - 1 == INTVAL (operands[2]))
2401	        {
2402	          emit_insn (gen_extzv (operands[0], operands[1], GEN_INT (i),
2403			 	        const0_rtx));
2404	          DONE;
2405	        }
2406	      else if ((HOST_WIDE_INT_1 << i) - 1
2407		       == ~INTVAL (operands[2]))
2408	        {
2409	          rtx shift = GEN_INT (i);
2410	          rtx reg = gen_reg_rtx (SImode);
2411
2412	          emit_insn (gen_lshrsi3 (reg, operands[1], shift));
2413	          emit_insn (gen_ashlsi3 (operands[0], reg, shift));
2414
2415	          DONE;
2416	        }
2417	    }
2418
2419          operands[2] = force_reg (SImode, operands[2]);
2420        }
2421    }
2422  "
2423)
2424
2425; ??? Check split length for Thumb-2
2426(define_insn_and_split "*arm_andsi3_insn"
2427  [(set (match_operand:SI         0 "s_register_operand" "=r,l,r,r,r")
2428	(and:SI (match_operand:SI 1 "s_register_operand" "%r,0,r,r,r")
2429		(match_operand:SI 2 "reg_or_int_operand" "I,l,K,r,?n")))]
2430  "TARGET_32BIT"
2431  "@
2432   and%?\\t%0, %1, %2
2433   and%?\\t%0, %1, %2
2434   bic%?\\t%0, %1, #%B2
2435   and%?\\t%0, %1, %2
2436   #"
2437  "TARGET_32BIT
2438   && CONST_INT_P (operands[2])
2439   && !(const_ok_for_arm (INTVAL (operands[2]))
2440	|| const_ok_for_arm (~INTVAL (operands[2])))"
2441  [(clobber (const_int 0))]
2442  "
2443  arm_split_constant  (AND, SImode, curr_insn,
2444	               INTVAL (operands[2]), operands[0], operands[1], 0);
2445  DONE;
2446  "
2447  [(set_attr "length" "4,4,4,4,16")
2448   (set_attr "predicable" "yes")
2449   (set_attr "predicable_short_it" "no,yes,no,no,no")
2450   (set_attr "type" "logic_imm,logic_imm,logic_reg,logic_reg,logic_imm")]
2451)
2452
2453(define_insn "*andsi3_compare0"
2454  [(set (reg:CC_NOOV CC_REGNUM)
2455	(compare:CC_NOOV
2456	 (and:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
2457		 (match_operand:SI 2 "arm_not_operand" "I,K,r"))
2458	 (const_int 0)))
2459   (set (match_operand:SI          0 "s_register_operand" "=r,r,r")
2460	(and:SI (match_dup 1) (match_dup 2)))]
2461  "TARGET_32BIT"
2462  "@
2463   ands%?\\t%0, %1, %2
2464   bics%?\\t%0, %1, #%B2
2465   ands%?\\t%0, %1, %2"
2466  [(set_attr "conds" "set")
2467   (set_attr "type" "logics_imm,logics_imm,logics_reg")]
2468)
2469
2470(define_insn "*andsi3_compare0_scratch"
2471  [(set (reg:CC_NOOV CC_REGNUM)
2472	(compare:CC_NOOV
2473	 (and:SI (match_operand:SI 0 "s_register_operand" "r,r,r")
2474		 (match_operand:SI 1 "arm_not_operand" "I,K,r"))
2475	 (const_int 0)))
2476   (clobber (match_scratch:SI 2 "=X,r,X"))]
2477  "TARGET_32BIT"
2478  "@
2479   tst%?\\t%0, %1
2480   bics%?\\t%2, %0, #%B1
2481   tst%?\\t%0, %1"
2482  [(set_attr "conds" "set")
2483   (set_attr "type"  "logics_imm,logics_imm,logics_reg")]
2484)
2485
2486(define_insn "*zeroextractsi_compare0_scratch"
2487  [(set (reg:CC_NOOV CC_REGNUM)
2488	(compare:CC_NOOV (zero_extract:SI
2489			  (match_operand:SI 0 "s_register_operand" "r")
2490			  (match_operand 1 "const_int_operand" "n")
2491			  (match_operand 2 "const_int_operand" "n"))
2492			 (const_int 0)))]
2493  "TARGET_32BIT
2494  && (INTVAL (operands[2]) >= 0 && INTVAL (operands[2]) < 32
2495      && INTVAL (operands[1]) > 0
2496      && INTVAL (operands[1]) + (INTVAL (operands[2]) & 1) <= 8
2497      && INTVAL (operands[1]) + INTVAL (operands[2]) <= 32)"
2498  "*
2499  operands[1] = GEN_INT (((1 << INTVAL (operands[1])) - 1)
2500			 << INTVAL (operands[2]));
2501  output_asm_insn (\"tst%?\\t%0, %1\", operands);
2502  return \"\";
2503  "
2504  [(set_attr "conds" "set")
2505   (set_attr "predicable" "yes")
2506   (set_attr "type" "logics_imm")]
2507)
2508
2509(define_insn_and_split "*ne_zeroextractsi"
2510  [(set (match_operand:SI 0 "s_register_operand" "=r")
2511	(ne:SI (zero_extract:SI
2512		(match_operand:SI 1 "s_register_operand" "r")
2513		(match_operand:SI 2 "const_int_operand" "n")
2514		(match_operand:SI 3 "const_int_operand" "n"))
2515	       (const_int 0)))
2516   (clobber (reg:CC CC_REGNUM))]
2517  "TARGET_32BIT
2518   && (INTVAL (operands[3]) >= 0 && INTVAL (operands[3]) < 32
2519       && INTVAL (operands[2]) > 0
2520       && INTVAL (operands[2]) + (INTVAL (operands[3]) & 1) <= 8
2521       && INTVAL (operands[2]) + INTVAL (operands[3]) <= 32)"
2522  "#"
2523  "TARGET_32BIT
2524   && (INTVAL (operands[3]) >= 0 && INTVAL (operands[3]) < 32
2525       && INTVAL (operands[2]) > 0
2526       && INTVAL (operands[2]) + (INTVAL (operands[3]) & 1) <= 8
2527       && INTVAL (operands[2]) + INTVAL (operands[3]) <= 32)"
2528  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
2529		   (compare:CC_NOOV (and:SI (match_dup 1) (match_dup 2))
2530				    (const_int 0)))
2531	      (set (match_dup 0) (and:SI (match_dup 1) (match_dup 2)))])
2532   (set (match_dup 0)
2533	(if_then_else:SI (eq (reg:CC_NOOV CC_REGNUM) (const_int 0))
2534			 (match_dup 0) (const_int 1)))]
2535  "
2536  operands[2] = GEN_INT (((1 << INTVAL (operands[2])) - 1)
2537			 << INTVAL (operands[3]));
2538  "
2539  [(set_attr "conds" "clob")
2540   (set (attr "length")
2541	(if_then_else (eq_attr "is_thumb" "yes")
2542		      (const_int 12)
2543		      (const_int 8)))
2544   (set_attr "type" "multiple")]
2545)
2546
2547(define_insn_and_split "*ne_zeroextractsi_shifted"
2548  [(set (match_operand:SI 0 "s_register_operand" "=r")
2549	(ne:SI (zero_extract:SI
2550		(match_operand:SI 1 "s_register_operand" "r")
2551		(match_operand:SI 2 "const_int_operand" "n")
2552		(const_int 0))
2553	       (const_int 0)))
2554   (clobber (reg:CC CC_REGNUM))]
2555  "TARGET_ARM"
2556  "#"
2557  "TARGET_ARM"
2558  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
2559		   (compare:CC_NOOV (ashift:SI (match_dup 1) (match_dup 2))
2560				    (const_int 0)))
2561	      (set (match_dup 0) (ashift:SI (match_dup 1) (match_dup 2)))])
2562   (set (match_dup 0)
2563	(if_then_else:SI (eq (reg:CC_NOOV CC_REGNUM) (const_int 0))
2564			 (match_dup 0) (const_int 1)))]
2565  "
2566  operands[2] = GEN_INT (32 - INTVAL (operands[2]));
2567  "
2568  [(set_attr "conds" "clob")
2569   (set_attr "length" "8")
2570   (set_attr "type" "multiple")]
2571)
2572
2573(define_insn_and_split "*ite_ne_zeroextractsi"
2574  [(set (match_operand:SI 0 "s_register_operand" "=r")
2575	(if_then_else:SI (ne (zero_extract:SI
2576			      (match_operand:SI 1 "s_register_operand" "r")
2577			      (match_operand:SI 2 "const_int_operand" "n")
2578			      (match_operand:SI 3 "const_int_operand" "n"))
2579			     (const_int 0))
2580			 (match_operand:SI 4 "arm_not_operand" "rIK")
2581			 (const_int 0)))
2582   (clobber (reg:CC CC_REGNUM))]
2583  "TARGET_ARM
2584   && (INTVAL (operands[3]) >= 0 && INTVAL (operands[3]) < 32
2585       && INTVAL (operands[2]) > 0
2586       && INTVAL (operands[2]) + (INTVAL (operands[3]) & 1) <= 8
2587       && INTVAL (operands[2]) + INTVAL (operands[3]) <= 32)
2588   && !reg_overlap_mentioned_p (operands[0], operands[4])"
2589  "#"
2590  "TARGET_ARM
2591   && (INTVAL (operands[3]) >= 0 && INTVAL (operands[3]) < 32
2592       && INTVAL (operands[2]) > 0
2593       && INTVAL (operands[2]) + (INTVAL (operands[3]) & 1) <= 8
2594       && INTVAL (operands[2]) + INTVAL (operands[3]) <= 32)
2595   && !reg_overlap_mentioned_p (operands[0], operands[4])"
2596  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
2597		   (compare:CC_NOOV (and:SI (match_dup 1) (match_dup 2))
2598				    (const_int 0)))
2599	      (set (match_dup 0) (and:SI (match_dup 1) (match_dup 2)))])
2600   (set (match_dup 0)
2601	(if_then_else:SI (eq (reg:CC_NOOV CC_REGNUM) (const_int 0))
2602			 (match_dup 0) (match_dup 4)))]
2603  "
2604  operands[2] = GEN_INT (((1 << INTVAL (operands[2])) - 1)
2605			 << INTVAL (operands[3]));
2606  "
2607  [(set_attr "conds" "clob")
2608   (set_attr "length" "8")
2609   (set_attr "type" "multiple")]
2610)
2611
2612(define_insn_and_split "*ite_ne_zeroextractsi_shifted"
2613  [(set (match_operand:SI 0 "s_register_operand" "=r")
2614	(if_then_else:SI (ne (zero_extract:SI
2615			      (match_operand:SI 1 "s_register_operand" "r")
2616			      (match_operand:SI 2 "const_int_operand" "n")
2617			      (const_int 0))
2618			     (const_int 0))
2619			 (match_operand:SI 3 "arm_not_operand" "rIK")
2620			 (const_int 0)))
2621   (clobber (reg:CC CC_REGNUM))]
2622  "TARGET_ARM && !reg_overlap_mentioned_p (operands[0], operands[3])"
2623  "#"
2624  "TARGET_ARM && !reg_overlap_mentioned_p (operands[0], operands[3])"
2625  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
2626		   (compare:CC_NOOV (ashift:SI (match_dup 1) (match_dup 2))
2627				    (const_int 0)))
2628	      (set (match_dup 0) (ashift:SI (match_dup 1) (match_dup 2)))])
2629   (set (match_dup 0)
2630	(if_then_else:SI (eq (reg:CC_NOOV CC_REGNUM) (const_int 0))
2631			 (match_dup 0) (match_dup 3)))]
2632  "
2633  operands[2] = GEN_INT (32 - INTVAL (operands[2]));
2634  "
2635  [(set_attr "conds" "clob")
2636   (set_attr "length" "8")
2637   (set_attr "type" "multiple")]
2638)
2639
2640;; ??? Use Thumb-2 has bitfield insert/extract instructions.
2641(define_split
2642  [(set (match_operand:SI 0 "s_register_operand" "")
2643	(match_operator:SI 1 "shiftable_operator"
2644	 [(zero_extract:SI (match_operand:SI 2 "s_register_operand" "")
2645			   (match_operand:SI 3 "const_int_operand" "")
2646			   (match_operand:SI 4 "const_int_operand" ""))
2647	  (match_operand:SI 5 "s_register_operand" "")]))
2648   (clobber (match_operand:SI 6 "s_register_operand" ""))]
2649  "TARGET_ARM"
2650  [(set (match_dup 6) (ashift:SI (match_dup 2) (match_dup 3)))
2651   (set (match_dup 0)
2652	(match_op_dup 1
2653	 [(lshiftrt:SI (match_dup 6) (match_dup 4))
2654	  (match_dup 5)]))]
2655  "{
2656     HOST_WIDE_INT temp = INTVAL (operands[3]);
2657
2658     operands[3] = GEN_INT (32 - temp - INTVAL (operands[4]));
2659     operands[4] = GEN_INT (32 - temp);
2660   }"
2661)
2662
2663(define_split
2664  [(set (match_operand:SI 0 "s_register_operand" "")
2665	(match_operator:SI 1 "shiftable_operator"
2666	 [(sign_extract:SI (match_operand:SI 2 "s_register_operand" "")
2667			   (match_operand:SI 3 "const_int_operand" "")
2668			   (match_operand:SI 4 "const_int_operand" ""))
2669	  (match_operand:SI 5 "s_register_operand" "")]))
2670   (clobber (match_operand:SI 6 "s_register_operand" ""))]
2671  "TARGET_ARM"
2672  [(set (match_dup 6) (ashift:SI (match_dup 2) (match_dup 3)))
2673   (set (match_dup 0)
2674	(match_op_dup 1
2675	 [(ashiftrt:SI (match_dup 6) (match_dup 4))
2676	  (match_dup 5)]))]
2677  "{
2678     HOST_WIDE_INT temp = INTVAL (operands[3]);
2679
2680     operands[3] = GEN_INT (32 - temp - INTVAL (operands[4]));
2681     operands[4] = GEN_INT (32 - temp);
2682   }"
2683)
2684
2685;;; ??? This pattern is bogus.  If operand3 has bits outside the range
2686;;; represented by the bitfield, then this will produce incorrect results.
2687;;; Somewhere, the value needs to be truncated.  On targets like the m68k,
2688;;; which have a real bit-field insert instruction, the truncation happens
2689;;; in the bit-field insert instruction itself.  Since arm does not have a
2690;;; bit-field insert instruction, we would have to emit code here to truncate
2691;;; the value before we insert.  This loses some of the advantage of having
2692;;; this insv pattern, so this pattern needs to be reevalutated.
2693
2694(define_expand "insv"
2695  [(set (zero_extract (match_operand 0 "nonimmediate_operand" "")
2696                      (match_operand 1 "general_operand" "")
2697                      (match_operand 2 "general_operand" ""))
2698        (match_operand 3 "reg_or_int_operand" ""))]
2699  "TARGET_ARM || arm_arch_thumb2"
2700  "
2701  {
2702    int start_bit = INTVAL (operands[2]);
2703    int width = INTVAL (operands[1]);
2704    HOST_WIDE_INT mask = (HOST_WIDE_INT_1 << width) - 1;
2705    rtx target, subtarget;
2706
2707    if (arm_arch_thumb2)
2708      {
2709        if (unaligned_access && MEM_P (operands[0])
2710	    && s_register_operand (operands[3], GET_MODE (operands[3]))
2711	    && (width == 16 || width == 32) && (start_bit % BITS_PER_UNIT) == 0)
2712	  {
2713	    rtx base_addr;
2714
2715	    if (BYTES_BIG_ENDIAN)
2716	      start_bit = GET_MODE_BITSIZE (GET_MODE (operands[3])) - width
2717			  - start_bit;
2718
2719	    if (width == 32)
2720	      {
2721	        base_addr = adjust_address (operands[0], SImode,
2722					    start_bit / BITS_PER_UNIT);
2723		emit_insn (gen_unaligned_storesi (base_addr, operands[3]));
2724	      }
2725	    else
2726	      {
2727	        rtx tmp = gen_reg_rtx (HImode);
2728
2729	        base_addr = adjust_address (operands[0], HImode,
2730					    start_bit / BITS_PER_UNIT);
2731		emit_move_insn (tmp, gen_lowpart (HImode, operands[3]));
2732		emit_insn (gen_unaligned_storehi (base_addr, tmp));
2733	      }
2734	    DONE;
2735	  }
2736	else if (s_register_operand (operands[0], GET_MODE (operands[0])))
2737	  {
2738	    bool use_bfi = TRUE;
2739
2740	    if (CONST_INT_P (operands[3]))
2741	      {
2742		HOST_WIDE_INT val = INTVAL (operands[3]) & mask;
2743
2744		if (val == 0)
2745		  {
2746		    emit_insn (gen_insv_zero (operands[0], operands[1],
2747					      operands[2]));
2748		    DONE;
2749		  }
2750
2751		/* See if the set can be done with a single orr instruction.  */
2752		if (val == mask && const_ok_for_arm (val << start_bit))
2753		  use_bfi = FALSE;
2754	      }
2755
2756	    if (use_bfi)
2757	      {
2758		if (!REG_P (operands[3]))
2759		  operands[3] = force_reg (SImode, operands[3]);
2760
2761		emit_insn (gen_insv_t2 (operands[0], operands[1], operands[2],
2762					operands[3]));
2763		DONE;
2764	      }
2765	  }
2766	else
2767	  FAIL;
2768      }
2769
2770    if (!s_register_operand (operands[0], GET_MODE (operands[0])))
2771      FAIL;
2772
2773    target = copy_rtx (operands[0]);
2774    /* Avoid using a subreg as a subtarget, and avoid writing a paradoxical
2775       subreg as the final target.  */
2776    if (GET_CODE (target) == SUBREG)
2777      {
2778	subtarget = gen_reg_rtx (SImode);
2779	if (GET_MODE_SIZE (GET_MODE (SUBREG_REG (target)))
2780	    < GET_MODE_SIZE (SImode))
2781	  target = SUBREG_REG (target);
2782      }
2783    else
2784      subtarget = target;
2785
2786    if (CONST_INT_P (operands[3]))
2787      {
2788	/* Since we are inserting a known constant, we may be able to
2789	   reduce the number of bits that we have to clear so that
2790	   the mask becomes simple.  */
2791	/* ??? This code does not check to see if the new mask is actually
2792	   simpler.  It may not be.  */
2793	rtx op1 = gen_reg_rtx (SImode);
2794	/* ??? Truncate operand3 to fit in the bitfield.  See comment before
2795	   start of this pattern.  */
2796	HOST_WIDE_INT op3_value = mask & INTVAL (operands[3]);
2797	HOST_WIDE_INT mask2 = ((mask & ~op3_value) << start_bit);
2798
2799	emit_insn (gen_andsi3 (op1, operands[0],
2800			       gen_int_mode (~mask2, SImode)));
2801	emit_insn (gen_iorsi3 (subtarget, op1,
2802			       gen_int_mode (op3_value << start_bit, SImode)));
2803      }
2804    else if (start_bit == 0
2805	     && !(const_ok_for_arm (mask)
2806		  || const_ok_for_arm (~mask)))
2807      {
2808	/* A Trick, since we are setting the bottom bits in the word,
2809	   we can shift operand[3] up, operand[0] down, OR them together
2810	   and rotate the result back again.  This takes 3 insns, and
2811	   the third might be mergeable into another op.  */
2812	/* The shift up copes with the possibility that operand[3] is
2813           wider than the bitfield.  */
2814	rtx op0 = gen_reg_rtx (SImode);
2815	rtx op1 = gen_reg_rtx (SImode);
2816
2817	emit_insn (gen_ashlsi3 (op0, operands[3], GEN_INT (32 - width)));
2818	emit_insn (gen_lshrsi3 (op1, operands[0], operands[1]));
2819	emit_insn (gen_iorsi3  (op1, op1, op0));
2820	emit_insn (gen_rotlsi3 (subtarget, op1, operands[1]));
2821      }
2822    else if ((width + start_bit == 32)
2823	     && !(const_ok_for_arm (mask)
2824		  || const_ok_for_arm (~mask)))
2825      {
2826	/* Similar trick, but slightly less efficient.  */
2827
2828	rtx op0 = gen_reg_rtx (SImode);
2829	rtx op1 = gen_reg_rtx (SImode);
2830
2831	emit_insn (gen_ashlsi3 (op0, operands[3], GEN_INT (32 - width)));
2832	emit_insn (gen_ashlsi3 (op1, operands[0], operands[1]));
2833	emit_insn (gen_lshrsi3 (op1, op1, operands[1]));
2834	emit_insn (gen_iorsi3 (subtarget, op1, op0));
2835      }
2836    else
2837      {
2838	rtx op0 = gen_int_mode (mask, SImode);
2839	rtx op1 = gen_reg_rtx (SImode);
2840	rtx op2 = gen_reg_rtx (SImode);
2841
2842	if (!(const_ok_for_arm (mask) || const_ok_for_arm (~mask)))
2843	  {
2844	    rtx tmp = gen_reg_rtx (SImode);
2845
2846	    emit_insn (gen_movsi (tmp, op0));
2847	    op0 = tmp;
2848	  }
2849
2850	/* Mask out any bits in operand[3] that are not needed.  */
2851	   emit_insn (gen_andsi3 (op1, operands[3], op0));
2852
2853	if (CONST_INT_P (op0)
2854	    && (const_ok_for_arm (mask << start_bit)
2855		|| const_ok_for_arm (~(mask << start_bit))))
2856	  {
2857	    op0 = gen_int_mode (~(mask << start_bit), SImode);
2858	    emit_insn (gen_andsi3 (op2, operands[0], op0));
2859	  }
2860	else
2861	  {
2862	    if (CONST_INT_P (op0))
2863	      {
2864		rtx tmp = gen_reg_rtx (SImode);
2865
2866		emit_insn (gen_movsi (tmp, op0));
2867		op0 = tmp;
2868	      }
2869
2870	    if (start_bit != 0)
2871	      emit_insn (gen_ashlsi3 (op0, op0, operands[2]));
2872
2873	    emit_insn (gen_andsi_notsi_si (op2, operands[0], op0));
2874	  }
2875
2876	if (start_bit != 0)
2877          emit_insn (gen_ashlsi3 (op1, op1, operands[2]));
2878
2879	emit_insn (gen_iorsi3 (subtarget, op1, op2));
2880      }
2881
2882    if (subtarget != target)
2883      {
2884	/* If TARGET is still a SUBREG, then it must be wider than a word,
2885	   so we must be careful only to set the subword we were asked to.  */
2886	if (GET_CODE (target) == SUBREG)
2887	  emit_move_insn (target, subtarget);
2888	else
2889	  emit_move_insn (target, gen_lowpart (GET_MODE (target), subtarget));
2890      }
2891
2892    DONE;
2893  }"
2894)
2895
2896(define_insn "insv_zero"
2897  [(set (zero_extract:SI (match_operand:SI 0 "s_register_operand" "+r")
2898                         (match_operand:SI 1 "const_int_M_operand" "M")
2899                         (match_operand:SI 2 "const_int_M_operand" "M"))
2900        (const_int 0))]
2901  "arm_arch_thumb2"
2902  "bfc%?\t%0, %2, %1"
2903  [(set_attr "length" "4")
2904   (set_attr "predicable" "yes")
2905   (set_attr "type" "bfm")]
2906)
2907
2908(define_insn "insv_t2"
2909  [(set (zero_extract:SI (match_operand:SI 0 "s_register_operand" "+r")
2910                         (match_operand:SI 1 "const_int_M_operand" "M")
2911                         (match_operand:SI 2 "const_int_M_operand" "M"))
2912        (match_operand:SI 3 "s_register_operand" "r"))]
2913  "arm_arch_thumb2"
2914  "bfi%?\t%0, %3, %2, %1"
2915  [(set_attr "length" "4")
2916   (set_attr "predicable" "yes")
2917   (set_attr "type" "bfm")]
2918)
2919
2920; constants for op 2 will never be given to these patterns.
2921(define_insn_and_split "*anddi_notdi_di"
2922  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2923	(and:DI (not:DI (match_operand:DI 1 "s_register_operand" "0,r"))
2924		(match_operand:DI 2 "s_register_operand" "r,0")))]
2925  "TARGET_32BIT"
2926  "#"
2927  "TARGET_32BIT && reload_completed
2928   && ! (TARGET_NEON && IS_VFP_REGNUM (REGNO (operands[0])))
2929   && ! IS_IWMMXT_REGNUM (REGNO (operands[0]))"
2930  [(set (match_dup 0) (and:SI (not:SI (match_dup 1)) (match_dup 2)))
2931   (set (match_dup 3) (and:SI (not:SI (match_dup 4)) (match_dup 5)))]
2932  "
2933  {
2934    operands[3] = gen_highpart (SImode, operands[0]);
2935    operands[0] = gen_lowpart (SImode, operands[0]);
2936    operands[4] = gen_highpart (SImode, operands[1]);
2937    operands[1] = gen_lowpart (SImode, operands[1]);
2938    operands[5] = gen_highpart (SImode, operands[2]);
2939    operands[2] = gen_lowpart (SImode, operands[2]);
2940  }"
2941  [(set_attr "length" "8")
2942   (set_attr "predicable" "yes")
2943   (set_attr "type" "multiple")]
2944)
2945
2946(define_insn_and_split "*anddi_notzesidi_di"
2947  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2948	(and:DI (not:DI (zero_extend:DI
2949			 (match_operand:SI 2 "s_register_operand" "r,r")))
2950		(match_operand:DI 1 "s_register_operand" "0,?r")))]
2951  "TARGET_32BIT"
2952  "@
2953   bic%?\\t%Q0, %Q1, %2
2954   #"
2955  ; (not (zero_extend ...)) allows us to just copy the high word from
2956  ; operand1 to operand0.
2957  "TARGET_32BIT
2958   && reload_completed
2959   && operands[0] != operands[1]"
2960  [(set (match_dup 0) (and:SI (not:SI (match_dup 2)) (match_dup 1)))
2961   (set (match_dup 3) (match_dup 4))]
2962  "
2963  {
2964    operands[3] = gen_highpart (SImode, operands[0]);
2965    operands[0] = gen_lowpart (SImode, operands[0]);
2966    operands[4] = gen_highpart (SImode, operands[1]);
2967    operands[1] = gen_lowpart (SImode, operands[1]);
2968  }"
2969  [(set_attr "length" "4,8")
2970   (set_attr "predicable" "yes")
2971   (set_attr "type" "multiple")]
2972)
2973
2974(define_insn_and_split "*anddi_notdi_zesidi"
2975  [(set (match_operand:DI 0 "s_register_operand" "=r")
2976        (and:DI (not:DI (match_operand:DI 2 "s_register_operand" "r"))
2977                (zero_extend:DI
2978                 (match_operand:SI 1 "s_register_operand" "r"))))]
2979  "TARGET_32BIT"
2980  "#"
2981  "TARGET_32BIT && reload_completed"
2982  [(set (match_dup 0) (and:SI (not:SI (match_dup 2)) (match_dup 1)))
2983   (set (match_dup 3) (const_int 0))]
2984  "
2985  {
2986    operands[3] = gen_highpart (SImode, operands[0]);
2987    operands[0] = gen_lowpart (SImode, operands[0]);
2988    operands[2] = gen_lowpart (SImode, operands[2]);
2989  }"
2990  [(set_attr "length" "8")
2991   (set_attr "predicable" "yes")
2992   (set_attr "type" "multiple")]
2993)
2994
2995(define_insn_and_split "*anddi_notsesidi_di"
2996  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
2997	(and:DI (not:DI (sign_extend:DI
2998			 (match_operand:SI 2 "s_register_operand" "r,r")))
2999		(match_operand:DI 1 "s_register_operand" "0,r")))]
3000  "TARGET_32BIT"
3001  "#"
3002  "TARGET_32BIT && reload_completed"
3003  [(set (match_dup 0) (and:SI (not:SI (match_dup 2)) (match_dup 1)))
3004   (set (match_dup 3) (and:SI (not:SI
3005				(ashiftrt:SI (match_dup 2) (const_int 31)))
3006			       (match_dup 4)))]
3007  "
3008  {
3009    operands[3] = gen_highpart (SImode, operands[0]);
3010    operands[0] = gen_lowpart (SImode, operands[0]);
3011    operands[4] = gen_highpart (SImode, operands[1]);
3012    operands[1] = gen_lowpart (SImode, operands[1]);
3013  }"
3014  [(set_attr "length" "8")
3015   (set_attr "predicable" "yes")
3016   (set_attr "type" "multiple")]
3017)
3018
3019(define_insn "andsi_notsi_si"
3020  [(set (match_operand:SI 0 "s_register_operand" "=r")
3021	(and:SI (not:SI (match_operand:SI 2 "s_register_operand" "r"))
3022		(match_operand:SI 1 "s_register_operand" "r")))]
3023  "TARGET_32BIT"
3024  "bic%?\\t%0, %1, %2"
3025  [(set_attr "predicable" "yes")
3026   (set_attr "type" "logic_reg")]
3027)
3028
3029(define_insn "andsi_not_shiftsi_si"
3030  [(set (match_operand:SI 0 "s_register_operand" "=r")
3031	(and:SI (not:SI (match_operator:SI 4 "shift_operator"
3032			 [(match_operand:SI 2 "s_register_operand" "r")
3033			  (match_operand:SI 3 "arm_rhs_operand" "rM")]))
3034		(match_operand:SI 1 "s_register_operand" "r")))]
3035  "TARGET_ARM"
3036  "bic%?\\t%0, %1, %2%S4"
3037  [(set_attr "predicable" "yes")
3038   (set_attr "shift" "2")
3039   (set (attr "type") (if_then_else (match_operand 3 "const_int_operand" "")
3040		      (const_string "logic_shift_imm")
3041		      (const_string "logic_shift_reg")))]
3042)
3043
3044;; Shifted bics pattern used to set up CC status register and not reusing
3045;; bics output.  Pattern restricts Thumb2 shift operand as bics for Thumb2
3046;; does not support shift by register.
3047(define_insn "andsi_not_shiftsi_si_scc_no_reuse"
3048  [(set (reg:CC_NOOV CC_REGNUM)
3049	(compare:CC_NOOV
3050		(and:SI (not:SI (match_operator:SI 0 "shift_operator"
3051			[(match_operand:SI 1 "s_register_operand" "r")
3052			 (match_operand:SI 2 "arm_rhs_operand" "rM")]))
3053			(match_operand:SI 3 "s_register_operand" "r"))
3054		(const_int 0)))
3055   (clobber (match_scratch:SI 4 "=r"))]
3056  "TARGET_ARM || (TARGET_THUMB2 && CONST_INT_P (operands[2]))"
3057  "bics%?\\t%4, %3, %1%S0"
3058  [(set_attr "predicable" "yes")
3059   (set_attr "conds" "set")
3060   (set_attr "shift" "1")
3061   (set (attr "type") (if_then_else (match_operand 2 "const_int_operand" "")
3062		      (const_string "logic_shift_imm")
3063		      (const_string "logic_shift_reg")))]
3064)
3065
3066;; Same as andsi_not_shiftsi_si_scc_no_reuse, but the bics result is also
3067;; getting reused later.
3068(define_insn "andsi_not_shiftsi_si_scc"
3069  [(parallel [(set (reg:CC_NOOV CC_REGNUM)
3070	(compare:CC_NOOV
3071		(and:SI (not:SI (match_operator:SI 0 "shift_operator"
3072			[(match_operand:SI 1 "s_register_operand" "r")
3073			 (match_operand:SI 2 "arm_rhs_operand" "rM")]))
3074			(match_operand:SI 3 "s_register_operand" "r"))
3075		(const_int 0)))
3076	(set (match_operand:SI 4 "s_register_operand" "=r")
3077	     (and:SI (not:SI (match_op_dup 0
3078		     [(match_dup 1)
3079		      (match_dup 2)]))
3080		     (match_dup 3)))])]
3081  "TARGET_ARM || (TARGET_THUMB2 && CONST_INT_P (operands[2]))"
3082  "bics%?\\t%4, %3, %1%S0"
3083  [(set_attr "predicable" "yes")
3084   (set_attr "conds" "set")
3085   (set_attr "shift" "1")
3086   (set (attr "type") (if_then_else (match_operand 2 "const_int_operand" "")
3087		      (const_string "logic_shift_imm")
3088		      (const_string "logic_shift_reg")))]
3089)
3090
3091(define_insn "*andsi_notsi_si_compare0"
3092  [(set (reg:CC_NOOV CC_REGNUM)
3093	(compare:CC_NOOV
3094	 (and:SI (not:SI (match_operand:SI 2 "s_register_operand" "r"))
3095		 (match_operand:SI 1 "s_register_operand" "r"))
3096	 (const_int 0)))
3097   (set (match_operand:SI 0 "s_register_operand" "=r")
3098	(and:SI (not:SI (match_dup 2)) (match_dup 1)))]
3099  "TARGET_32BIT"
3100  "bics\\t%0, %1, %2"
3101  [(set_attr "conds" "set")
3102   (set_attr "type" "logics_shift_reg")]
3103)
3104
3105(define_insn "*andsi_notsi_si_compare0_scratch"
3106  [(set (reg:CC_NOOV CC_REGNUM)
3107	(compare:CC_NOOV
3108	 (and:SI (not:SI (match_operand:SI 2 "s_register_operand" "r"))
3109		 (match_operand:SI 1 "s_register_operand" "r"))
3110	 (const_int 0)))
3111   (clobber (match_scratch:SI 0 "=r"))]
3112  "TARGET_32BIT"
3113  "bics\\t%0, %1, %2"
3114  [(set_attr "conds" "set")
3115   (set_attr "type" "logics_shift_reg")]
3116)
3117
3118(define_expand "iordi3"
3119  [(set (match_operand:DI         0 "s_register_operand" "")
3120	(ior:DI (match_operand:DI 1 "s_register_operand" "")
3121		(match_operand:DI 2 "neon_logic_op2" "")))]
3122  "TARGET_32BIT"
3123  "
3124  if (!TARGET_NEON && !TARGET_IWMMXT)
3125    {
3126      rtx low  = simplify_gen_binary (IOR, SImode,
3127				      gen_lowpart (SImode, operands[1]),
3128				      gen_lowpart (SImode, operands[2]));
3129      rtx high = simplify_gen_binary (IOR, SImode,
3130				      gen_highpart (SImode, operands[1]),
3131				      gen_highpart_mode (SImode, DImode,
3132							 operands[2]));
3133
3134      emit_insn (gen_rtx_SET (gen_lowpart (SImode, operands[0]), low));
3135      emit_insn (gen_rtx_SET (gen_highpart (SImode, operands[0]), high));
3136
3137      DONE;
3138    }
3139  /* Otherwise expand pattern as above.  */
3140  "
3141)
3142
3143(define_insn_and_split "*iordi3_insn"
3144  [(set (match_operand:DI         0 "s_register_operand"     "=w,w ,&r,&r,&r,&r,?w,?w")
3145	(ior:DI (match_operand:DI 1 "s_register_operand"     "%w,0 ,0 ,r ,0 ,r ,w ,0")
3146		(match_operand:DI 2 "arm_iordi_operand_neon" "w ,Dl,r ,r ,Df,Df,w ,Dl")))]
3147  "TARGET_32BIT && !TARGET_IWMMXT"
3148  {
3149  switch (which_alternative)
3150    {
3151    case 0: /* fall through */
3152    case 6: return "vorr\t%P0, %P1, %P2";
3153    case 1: /* fall through */
3154    case 7: return neon_output_logic_immediate ("vorr", &operands[2],
3155		     DImode, 0, VALID_NEON_QREG_MODE (DImode));
3156    case 2:
3157    case 3:
3158    case 4:
3159    case 5:
3160      return "#";
3161    default: gcc_unreachable ();
3162    }
3163  }
3164  "TARGET_32BIT && !TARGET_IWMMXT && reload_completed
3165   && !(IS_VFP_REGNUM (REGNO (operands[0])))"
3166  [(set (match_dup 3) (match_dup 4))
3167   (set (match_dup 5) (match_dup 6))]
3168  "
3169  {
3170    operands[3] = gen_lowpart (SImode, operands[0]);
3171    operands[5] = gen_highpart (SImode, operands[0]);
3172
3173    operands[4] = simplify_gen_binary (IOR, SImode,
3174                                           gen_lowpart (SImode, operands[1]),
3175                                           gen_lowpart (SImode, operands[2]));
3176    operands[6] = simplify_gen_binary (IOR, SImode,
3177                                           gen_highpart (SImode, operands[1]),
3178                                           gen_highpart_mode (SImode, DImode, operands[2]));
3179
3180  }"
3181  [(set_attr "type" "neon_logic,neon_logic,multiple,multiple,multiple,\
3182                     multiple,neon_logic,neon_logic")
3183   (set_attr "length" "*,*,8,8,8,8,*,*")
3184   (set_attr "arch" "neon_for_64bits,neon_for_64bits,*,*,*,*,avoid_neon_for_64bits,avoid_neon_for_64bits")]
3185)
3186
3187(define_insn "*iordi_zesidi_di"
3188  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
3189	(ior:DI (zero_extend:DI
3190		 (match_operand:SI 2 "s_register_operand" "r,r"))
3191		(match_operand:DI 1 "s_register_operand" "0,?r")))]
3192  "TARGET_32BIT"
3193  "@
3194   orr%?\\t%Q0, %Q1, %2
3195   #"
3196  [(set_attr "length" "4,8")
3197   (set_attr "predicable" "yes")
3198   (set_attr "type" "logic_reg,multiple")]
3199)
3200
3201(define_insn "*iordi_sesidi_di"
3202  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
3203	(ior:DI (sign_extend:DI
3204		 (match_operand:SI 2 "s_register_operand" "r,r"))
3205		(match_operand:DI 1 "s_register_operand" "0,r")))]
3206  "TARGET_32BIT"
3207  "#"
3208  [(set_attr "length" "8")
3209   (set_attr "predicable" "yes")
3210   (set_attr "type" "multiple")]
3211)
3212
3213(define_expand "iorsi3"
3214  [(set (match_operand:SI         0 "s_register_operand" "")
3215	(ior:SI (match_operand:SI 1 "s_register_operand" "")
3216		(match_operand:SI 2 "reg_or_int_operand" "")))]
3217  "TARGET_EITHER"
3218  "
3219  if (CONST_INT_P (operands[2]))
3220    {
3221      if (TARGET_32BIT)
3222        {
3223	  if (DONT_EARLY_SPLIT_CONSTANT (INTVAL (operands[2]), IOR))
3224	    operands[2] = force_reg (SImode, operands[2]);
3225	  else
3226	    {
3227	      arm_split_constant (IOR, SImode, NULL_RTX,
3228				  INTVAL (operands[2]), operands[0],
3229				  operands[1],
3230				  optimize && can_create_pseudo_p ());
3231	      DONE;
3232	    }
3233	}
3234      else /* TARGET_THUMB1 */
3235        {
3236          rtx tmp = force_reg (SImode, operands[2]);
3237	  if (rtx_equal_p (operands[0], operands[1]))
3238	    operands[2] = tmp;
3239	  else
3240	    {
3241              operands[2] = operands[1];
3242              operands[1] = tmp;
3243	    }
3244        }
3245    }
3246  "
3247)
3248
3249(define_insn_and_split "*iorsi3_insn"
3250  [(set (match_operand:SI 0 "s_register_operand" "=r,l,r,r,r")
3251	(ior:SI (match_operand:SI 1 "s_register_operand" "%r,0,r,r,r")
3252		(match_operand:SI 2 "reg_or_int_operand" "I,l,K,r,?n")))]
3253  "TARGET_32BIT"
3254  "@
3255   orr%?\\t%0, %1, %2
3256   orr%?\\t%0, %1, %2
3257   orn%?\\t%0, %1, #%B2
3258   orr%?\\t%0, %1, %2
3259   #"
3260  "TARGET_32BIT
3261   && CONST_INT_P (operands[2])
3262   && !(const_ok_for_arm (INTVAL (operands[2]))
3263        || (TARGET_THUMB2 && const_ok_for_arm (~INTVAL (operands[2]))))"
3264  [(clobber (const_int 0))]
3265{
3266  arm_split_constant (IOR, SImode, curr_insn,
3267                      INTVAL (operands[2]), operands[0], operands[1], 0);
3268  DONE;
3269}
3270  [(set_attr "length" "4,4,4,4,16")
3271   (set_attr "arch" "32,t2,t2,32,32")
3272   (set_attr "predicable" "yes")
3273   (set_attr "predicable_short_it" "no,yes,no,no,no")
3274   (set_attr "type" "logic_imm,logic_reg,logic_imm,logic_reg,logic_reg")]
3275)
3276
3277(define_peephole2
3278  [(match_scratch:SI 3 "r")
3279   (set (match_operand:SI 0 "arm_general_register_operand" "")
3280	(ior:SI (match_operand:SI 1 "arm_general_register_operand" "")
3281		(match_operand:SI 2 "const_int_operand" "")))]
3282  "TARGET_ARM
3283   && !const_ok_for_arm (INTVAL (operands[2]))
3284   && const_ok_for_arm (~INTVAL (operands[2]))"
3285  [(set (match_dup 3) (match_dup 2))
3286   (set (match_dup 0) (ior:SI (match_dup 1) (match_dup 3)))]
3287  ""
3288)
3289
3290(define_insn "*iorsi3_compare0"
3291  [(set (reg:CC_NOOV CC_REGNUM)
3292	(compare:CC_NOOV (ior:SI (match_operand:SI 1 "s_register_operand" "%r,r")
3293				 (match_operand:SI 2 "arm_rhs_operand" "I,r"))
3294			 (const_int 0)))
3295   (set (match_operand:SI 0 "s_register_operand" "=r,r")
3296	(ior:SI (match_dup 1) (match_dup 2)))]
3297  "TARGET_32BIT"
3298  "orrs%?\\t%0, %1, %2"
3299  [(set_attr "conds" "set")
3300   (set_attr "type" "logics_imm,logics_reg")]
3301)
3302
3303(define_insn "*iorsi3_compare0_scratch"
3304  [(set (reg:CC_NOOV CC_REGNUM)
3305	(compare:CC_NOOV (ior:SI (match_operand:SI 1 "s_register_operand" "%r,r")
3306				 (match_operand:SI 2 "arm_rhs_operand" "I,r"))
3307			 (const_int 0)))
3308   (clobber (match_scratch:SI 0 "=r,r"))]
3309  "TARGET_32BIT"
3310  "orrs%?\\t%0, %1, %2"
3311  [(set_attr "conds" "set")
3312   (set_attr "type" "logics_imm,logics_reg")]
3313)
3314
3315(define_expand "xordi3"
3316  [(set (match_operand:DI         0 "s_register_operand" "")
3317	(xor:DI (match_operand:DI 1 "s_register_operand" "")
3318		(match_operand:DI 2 "arm_xordi_operand" "")))]
3319  "TARGET_32BIT"
3320  {
3321    /* The iWMMXt pattern for xordi3 accepts only register operands but we want
3322       to reuse this expander for all TARGET_32BIT targets so just force the
3323       constants into a register.  Unlike for the anddi3 and iordi3 there are
3324       no NEON instructions that take an immediate.  */
3325    if (TARGET_IWMMXT && !REG_P (operands[2]))
3326      operands[2] = force_reg (DImode, operands[2]);
3327    if (!TARGET_NEON && !TARGET_IWMMXT)
3328      {
3329	rtx low  = simplify_gen_binary (XOR, SImode,
3330					gen_lowpart (SImode, operands[1]),
3331					gen_lowpart (SImode, operands[2]));
3332	rtx high = simplify_gen_binary (XOR, SImode,
3333					gen_highpart (SImode, operands[1]),
3334					gen_highpart_mode (SImode, DImode,
3335							   operands[2]));
3336
3337	emit_insn (gen_rtx_SET (gen_lowpart (SImode, operands[0]), low));
3338	emit_insn (gen_rtx_SET (gen_highpart (SImode, operands[0]), high));
3339
3340	DONE;
3341      }
3342    /* Otherwise expand pattern as above.  */
3343  }
3344)
3345
3346(define_insn_and_split "*xordi3_insn"
3347  [(set (match_operand:DI         0 "s_register_operand" "=w,&r,&r,&r,&r,?w")
3348	(xor:DI (match_operand:DI 1 "s_register_operand" "%w ,0,r ,0 ,r ,w")
3349		(match_operand:DI 2 "arm_xordi_operand"  "w ,r ,r ,Dg,Dg,w")))]
3350  "TARGET_32BIT && !TARGET_IWMMXT"
3351{
3352  switch (which_alternative)
3353    {
3354    case 1:
3355    case 2:
3356    case 3:
3357    case 4:  /* fall through */
3358      return "#";
3359    case 0: /* fall through */
3360    case 5: return "veor\t%P0, %P1, %P2";
3361    default: gcc_unreachable ();
3362    }
3363}
3364  "TARGET_32BIT && !TARGET_IWMMXT && reload_completed
3365   && !(IS_VFP_REGNUM (REGNO (operands[0])))"
3366  [(set (match_dup 3) (match_dup 4))
3367   (set (match_dup 5) (match_dup 6))]
3368  "
3369  {
3370    operands[3] = gen_lowpart (SImode, operands[0]);
3371    operands[5] = gen_highpart (SImode, operands[0]);
3372
3373    operands[4] = simplify_gen_binary (XOR, SImode,
3374                                           gen_lowpart (SImode, operands[1]),
3375                                           gen_lowpart (SImode, operands[2]));
3376    operands[6] = simplify_gen_binary (XOR, SImode,
3377                                           gen_highpart (SImode, operands[1]),
3378                                           gen_highpart_mode (SImode, DImode, operands[2]));
3379
3380  }"
3381  [(set_attr "length" "*,8,8,8,8,*")
3382   (set_attr "type" "neon_logic,multiple,multiple,multiple,multiple,neon_logic")
3383   (set_attr "arch" "neon_for_64bits,*,*,*,*,avoid_neon_for_64bits")]
3384)
3385
3386(define_insn "*xordi_zesidi_di"
3387  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
3388	(xor:DI (zero_extend:DI
3389		 (match_operand:SI 2 "s_register_operand" "r,r"))
3390		(match_operand:DI 1 "s_register_operand" "0,?r")))]
3391  "TARGET_32BIT"
3392  "@
3393   eor%?\\t%Q0, %Q1, %2
3394   #"
3395  [(set_attr "length" "4,8")
3396   (set_attr "predicable" "yes")
3397   (set_attr "type" "logic_reg")]
3398)
3399
3400(define_insn "*xordi_sesidi_di"
3401  [(set (match_operand:DI 0 "s_register_operand" "=&r,&r")
3402	(xor:DI (sign_extend:DI
3403		 (match_operand:SI 2 "s_register_operand" "r,r"))
3404		(match_operand:DI 1 "s_register_operand" "0,r")))]
3405  "TARGET_32BIT"
3406  "#"
3407  [(set_attr "length" "8")
3408   (set_attr "predicable" "yes")
3409   (set_attr "type" "multiple")]
3410)
3411
3412(define_expand "xorsi3"
3413  [(set (match_operand:SI         0 "s_register_operand" "")
3414	(xor:SI (match_operand:SI 1 "s_register_operand" "")
3415		(match_operand:SI 2 "reg_or_int_operand" "")))]
3416  "TARGET_EITHER"
3417  "if (CONST_INT_P (operands[2]))
3418    {
3419      if (TARGET_32BIT)
3420        {
3421	  if (DONT_EARLY_SPLIT_CONSTANT (INTVAL (operands[2]), XOR))
3422	    operands[2] = force_reg (SImode, operands[2]);
3423	  else
3424	    {
3425	      arm_split_constant (XOR, SImode, NULL_RTX,
3426				  INTVAL (operands[2]), operands[0],
3427				  operands[1],
3428				  optimize && can_create_pseudo_p ());
3429	      DONE;
3430	    }
3431	}
3432      else /* TARGET_THUMB1 */
3433        {
3434          rtx tmp = force_reg (SImode, operands[2]);
3435	  if (rtx_equal_p (operands[0], operands[1]))
3436	    operands[2] = tmp;
3437	  else
3438	    {
3439              operands[2] = operands[1];
3440              operands[1] = tmp;
3441	    }
3442        }
3443    }"
3444)
3445
3446(define_insn_and_split "*arm_xorsi3"
3447  [(set (match_operand:SI         0 "s_register_operand" "=r,l,r,r")
3448	(xor:SI (match_operand:SI 1 "s_register_operand" "%r,0,r,r")
3449		(match_operand:SI 2 "reg_or_int_operand" "I,l,r,?n")))]
3450  "TARGET_32BIT"
3451  "@
3452   eor%?\\t%0, %1, %2
3453   eor%?\\t%0, %1, %2
3454   eor%?\\t%0, %1, %2
3455   #"
3456  "TARGET_32BIT
3457   && CONST_INT_P (operands[2])
3458   && !const_ok_for_arm (INTVAL (operands[2]))"
3459  [(clobber (const_int 0))]
3460{
3461  arm_split_constant (XOR, SImode, curr_insn,
3462                      INTVAL (operands[2]), operands[0], operands[1], 0);
3463  DONE;
3464}
3465  [(set_attr "length" "4,4,4,16")
3466   (set_attr "predicable" "yes")
3467   (set_attr "predicable_short_it" "no,yes,no,no")
3468   (set_attr "type"  "logic_imm,logic_reg,logic_reg,multiple")]
3469)
3470
3471(define_insn "*xorsi3_compare0"
3472  [(set (reg:CC_NOOV CC_REGNUM)
3473	(compare:CC_NOOV (xor:SI (match_operand:SI 1 "s_register_operand" "r,r")
3474				 (match_operand:SI 2 "arm_rhs_operand" "I,r"))
3475			 (const_int 0)))
3476   (set (match_operand:SI 0 "s_register_operand" "=r,r")
3477	(xor:SI (match_dup 1) (match_dup 2)))]
3478  "TARGET_32BIT"
3479  "eors%?\\t%0, %1, %2"
3480  [(set_attr "conds" "set")
3481   (set_attr "type" "logics_imm,logics_reg")]
3482)
3483
3484(define_insn "*xorsi3_compare0_scratch"
3485  [(set (reg:CC_NOOV CC_REGNUM)
3486	(compare:CC_NOOV (xor:SI (match_operand:SI 0 "s_register_operand" "r,r")
3487				 (match_operand:SI 1 "arm_rhs_operand" "I,r"))
3488			 (const_int 0)))]
3489  "TARGET_32BIT"
3490  "teq%?\\t%0, %1"
3491  [(set_attr "conds" "set")
3492   (set_attr "type" "logics_imm,logics_reg")]
3493)
3494
3495; By splitting (IOR (AND (NOT A) (NOT B)) C) as D = AND (IOR A B) (NOT C),
3496; (NOT D) we can sometimes merge the final NOT into one of the following
3497; insns.
3498
3499(define_split
3500  [(set (match_operand:SI 0 "s_register_operand" "")
3501	(ior:SI (and:SI (not:SI (match_operand:SI 1 "s_register_operand" ""))
3502			(not:SI (match_operand:SI 2 "arm_rhs_operand" "")))
3503		(match_operand:SI 3 "arm_rhs_operand" "")))
3504   (clobber (match_operand:SI 4 "s_register_operand" ""))]
3505  "TARGET_32BIT"
3506  [(set (match_dup 4) (and:SI (ior:SI (match_dup 1) (match_dup 2))
3507			      (not:SI (match_dup 3))))
3508   (set (match_dup 0) (not:SI (match_dup 4)))]
3509  ""
3510)
3511
3512(define_insn_and_split "*andsi_iorsi3_notsi"
3513  [(set (match_operand:SI 0 "s_register_operand" "=&r,&r,&r")
3514	(and:SI (ior:SI (match_operand:SI 1 "s_register_operand" "%0,r,r")
3515			(match_operand:SI 2 "arm_rhs_operand" "rI,0,rI"))
3516		(not:SI (match_operand:SI 3 "arm_rhs_operand" "rI,rI,rI"))))]
3517  "TARGET_32BIT"
3518  "#"   ; "orr%?\\t%0, %1, %2\;bic%?\\t%0, %0, %3"
3519  "&& reload_completed"
3520  [(set (match_dup 0) (ior:SI (match_dup 1) (match_dup 2)))
3521   (set (match_dup 0) (and:SI (match_dup 4) (match_dup 5)))]
3522  {
3523     /* If operands[3] is a constant make sure to fold the NOT into it
3524	to avoid creating a NOT of a CONST_INT.  */
3525    rtx not_rtx = simplify_gen_unary (NOT, SImode, operands[3], SImode);
3526    if (CONST_INT_P (not_rtx))
3527      {
3528	operands[4] = operands[0];
3529	operands[5] = not_rtx;
3530      }
3531    else
3532      {
3533	operands[5] = operands[0];
3534	operands[4] = not_rtx;
3535      }
3536  }
3537  [(set_attr "length" "8")
3538   (set_attr "ce_count" "2")
3539   (set_attr "predicable" "yes")
3540   (set_attr "type" "multiple")]
3541)
3542
3543; ??? Are these four splitters still beneficial when the Thumb-2 bitfield
3544; insns are available?
3545(define_split
3546  [(set (match_operand:SI 0 "s_register_operand" "")
3547	(match_operator:SI 1 "logical_binary_operator"
3548	 [(zero_extract:SI (match_operand:SI 2 "s_register_operand" "")
3549			   (match_operand:SI 3 "const_int_operand" "")
3550			   (match_operand:SI 4 "const_int_operand" ""))
3551	  (match_operator:SI 9 "logical_binary_operator"
3552	   [(lshiftrt:SI (match_operand:SI 5 "s_register_operand" "")
3553			 (match_operand:SI 6 "const_int_operand" ""))
3554	    (match_operand:SI 7 "s_register_operand" "")])]))
3555   (clobber (match_operand:SI 8 "s_register_operand" ""))]
3556  "TARGET_32BIT
3557   && GET_CODE (operands[1]) == GET_CODE (operands[9])
3558   && INTVAL (operands[3]) == 32 - INTVAL (operands[6])"
3559  [(set (match_dup 8)
3560	(match_op_dup 1
3561	 [(ashift:SI (match_dup 2) (match_dup 4))
3562	  (match_dup 5)]))
3563   (set (match_dup 0)
3564	(match_op_dup 1
3565	 [(lshiftrt:SI (match_dup 8) (match_dup 6))
3566	  (match_dup 7)]))]
3567  "
3568  operands[4] = GEN_INT (32 - (INTVAL (operands[3]) + INTVAL (operands[4])));
3569")
3570
3571(define_split
3572  [(set (match_operand:SI 0 "s_register_operand" "")
3573	(match_operator:SI 1 "logical_binary_operator"
3574	 [(match_operator:SI 9 "logical_binary_operator"
3575	   [(lshiftrt:SI (match_operand:SI 5 "s_register_operand" "")
3576			 (match_operand:SI 6 "const_int_operand" ""))
3577	    (match_operand:SI 7 "s_register_operand" "")])
3578	  (zero_extract:SI (match_operand:SI 2 "s_register_operand" "")
3579			   (match_operand:SI 3 "const_int_operand" "")
3580			   (match_operand:SI 4 "const_int_operand" ""))]))
3581   (clobber (match_operand:SI 8 "s_register_operand" ""))]
3582  "TARGET_32BIT
3583   && GET_CODE (operands[1]) == GET_CODE (operands[9])
3584   && INTVAL (operands[3]) == 32 - INTVAL (operands[6])"
3585  [(set (match_dup 8)
3586	(match_op_dup 1
3587	 [(ashift:SI (match_dup 2) (match_dup 4))
3588	  (match_dup 5)]))
3589   (set (match_dup 0)
3590	(match_op_dup 1
3591	 [(lshiftrt:SI (match_dup 8) (match_dup 6))
3592	  (match_dup 7)]))]
3593  "
3594  operands[4] = GEN_INT (32 - (INTVAL (operands[3]) + INTVAL (operands[4])));
3595")
3596
3597(define_split
3598  [(set (match_operand:SI 0 "s_register_operand" "")
3599	(match_operator:SI 1 "logical_binary_operator"
3600	 [(sign_extract:SI (match_operand:SI 2 "s_register_operand" "")
3601			   (match_operand:SI 3 "const_int_operand" "")
3602			   (match_operand:SI 4 "const_int_operand" ""))
3603	  (match_operator:SI 9 "logical_binary_operator"
3604	   [(ashiftrt:SI (match_operand:SI 5 "s_register_operand" "")
3605			 (match_operand:SI 6 "const_int_operand" ""))
3606	    (match_operand:SI 7 "s_register_operand" "")])]))
3607   (clobber (match_operand:SI 8 "s_register_operand" ""))]
3608  "TARGET_32BIT
3609   && GET_CODE (operands[1]) == GET_CODE (operands[9])
3610   && INTVAL (operands[3]) == 32 - INTVAL (operands[6])"
3611  [(set (match_dup 8)
3612	(match_op_dup 1
3613	 [(ashift:SI (match_dup 2) (match_dup 4))
3614	  (match_dup 5)]))
3615   (set (match_dup 0)
3616	(match_op_dup 1
3617	 [(ashiftrt:SI (match_dup 8) (match_dup 6))
3618	  (match_dup 7)]))]
3619  "
3620  operands[4] = GEN_INT (32 - (INTVAL (operands[3]) + INTVAL (operands[4])));
3621")
3622
3623(define_split
3624  [(set (match_operand:SI 0 "s_register_operand" "")
3625	(match_operator:SI 1 "logical_binary_operator"
3626	 [(match_operator:SI 9 "logical_binary_operator"
3627	   [(ashiftrt:SI (match_operand:SI 5 "s_register_operand" "")
3628			 (match_operand:SI 6 "const_int_operand" ""))
3629	    (match_operand:SI 7 "s_register_operand" "")])
3630	  (sign_extract:SI (match_operand:SI 2 "s_register_operand" "")
3631			   (match_operand:SI 3 "const_int_operand" "")
3632			   (match_operand:SI 4 "const_int_operand" ""))]))
3633   (clobber (match_operand:SI 8 "s_register_operand" ""))]
3634  "TARGET_32BIT
3635   && GET_CODE (operands[1]) == GET_CODE (operands[9])
3636   && INTVAL (operands[3]) == 32 - INTVAL (operands[6])"
3637  [(set (match_dup 8)
3638	(match_op_dup 1
3639	 [(ashift:SI (match_dup 2) (match_dup 4))
3640	  (match_dup 5)]))
3641   (set (match_dup 0)
3642	(match_op_dup 1
3643	 [(ashiftrt:SI (match_dup 8) (match_dup 6))
3644	  (match_dup 7)]))]
3645  "
3646  operands[4] = GEN_INT (32 - (INTVAL (operands[3]) + INTVAL (operands[4])));
3647")
3648
3649
3650;; Minimum and maximum insns
3651
3652(define_expand "smaxsi3"
3653  [(parallel [
3654    (set (match_operand:SI 0 "s_register_operand" "")
3655	 (smax:SI (match_operand:SI 1 "s_register_operand" "")
3656		  (match_operand:SI 2 "arm_rhs_operand" "")))
3657    (clobber (reg:CC CC_REGNUM))])]
3658  "TARGET_32BIT"
3659  "
3660  if (operands[2] == const0_rtx || operands[2] == constm1_rtx)
3661    {
3662      /* No need for a clobber of the condition code register here.  */
3663      emit_insn (gen_rtx_SET (operands[0],
3664			      gen_rtx_SMAX (SImode, operands[1],
3665					    operands[2])));
3666      DONE;
3667    }
3668")
3669
3670(define_insn "*smax_0"
3671  [(set (match_operand:SI 0 "s_register_operand" "=r")
3672	(smax:SI (match_operand:SI 1 "s_register_operand" "r")
3673		 (const_int 0)))]
3674  "TARGET_32BIT"
3675  "bic%?\\t%0, %1, %1, asr #31"
3676  [(set_attr "predicable" "yes")
3677   (set_attr "type" "logic_shift_reg")]
3678)
3679
3680(define_insn "*smax_m1"
3681  [(set (match_operand:SI 0 "s_register_operand" "=r")
3682	(smax:SI (match_operand:SI 1 "s_register_operand" "r")
3683		 (const_int -1)))]
3684  "TARGET_32BIT"
3685  "orr%?\\t%0, %1, %1, asr #31"
3686  [(set_attr "predicable" "yes")
3687   (set_attr "type" "logic_shift_reg")]
3688)
3689
3690(define_insn_and_split "*arm_smax_insn"
3691  [(set (match_operand:SI          0 "s_register_operand" "=r,r")
3692	(smax:SI (match_operand:SI 1 "s_register_operand"  "%0,?r")
3693		 (match_operand:SI 2 "arm_rhs_operand"    "rI,rI")))
3694   (clobber (reg:CC CC_REGNUM))]
3695  "TARGET_ARM"
3696  "#"
3697   ; cmp\\t%1, %2\;movlt\\t%0, %2
3698   ; cmp\\t%1, %2\;movge\\t%0, %1\;movlt\\t%0, %2"
3699  "TARGET_ARM"
3700  [(set (reg:CC CC_REGNUM)
3701        (compare:CC (match_dup 1) (match_dup 2)))
3702   (set (match_dup 0)
3703        (if_then_else:SI (ge:SI (reg:CC CC_REGNUM) (const_int 0))
3704                         (match_dup 1)
3705                         (match_dup 2)))]
3706  ""
3707  [(set_attr "conds" "clob")
3708   (set_attr "length" "8,12")
3709   (set_attr "type" "multiple")]
3710)
3711
3712(define_expand "sminsi3"
3713  [(parallel [
3714    (set (match_operand:SI 0 "s_register_operand" "")
3715	 (smin:SI (match_operand:SI 1 "s_register_operand" "")
3716		  (match_operand:SI 2 "arm_rhs_operand" "")))
3717    (clobber (reg:CC CC_REGNUM))])]
3718  "TARGET_32BIT"
3719  "
3720  if (operands[2] == const0_rtx)
3721    {
3722      /* No need for a clobber of the condition code register here.  */
3723      emit_insn (gen_rtx_SET (operands[0],
3724			      gen_rtx_SMIN (SImode, operands[1],
3725					    operands[2])));
3726      DONE;
3727    }
3728")
3729
3730(define_insn "*smin_0"
3731  [(set (match_operand:SI 0 "s_register_operand" "=r")
3732	(smin:SI (match_operand:SI 1 "s_register_operand" "r")
3733		 (const_int 0)))]
3734  "TARGET_32BIT"
3735  "and%?\\t%0, %1, %1, asr #31"
3736  [(set_attr "predicable" "yes")
3737   (set_attr "type" "logic_shift_reg")]
3738)
3739
3740(define_insn_and_split "*arm_smin_insn"
3741  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
3742	(smin:SI (match_operand:SI 1 "s_register_operand" "%0,?r")
3743		 (match_operand:SI 2 "arm_rhs_operand" "rI,rI")))
3744   (clobber (reg:CC CC_REGNUM))]
3745  "TARGET_ARM"
3746  "#"
3747    ; cmp\\t%1, %2\;movge\\t%0, %2
3748    ; cmp\\t%1, %2\;movlt\\t%0, %1\;movge\\t%0, %2"
3749  "TARGET_ARM"
3750  [(set (reg:CC CC_REGNUM)
3751        (compare:CC (match_dup 1) (match_dup 2)))
3752   (set (match_dup 0)
3753        (if_then_else:SI (lt:SI (reg:CC CC_REGNUM) (const_int 0))
3754                         (match_dup 1)
3755                         (match_dup 2)))]
3756  ""
3757  [(set_attr "conds" "clob")
3758   (set_attr "length" "8,12")
3759   (set_attr "type" "multiple,multiple")]
3760)
3761
3762(define_expand "umaxsi3"
3763  [(parallel [
3764    (set (match_operand:SI 0 "s_register_operand" "")
3765	 (umax:SI (match_operand:SI 1 "s_register_operand" "")
3766		  (match_operand:SI 2 "arm_rhs_operand" "")))
3767    (clobber (reg:CC CC_REGNUM))])]
3768  "TARGET_32BIT"
3769  ""
3770)
3771
3772(define_insn_and_split "*arm_umaxsi3"
3773  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
3774	(umax:SI (match_operand:SI 1 "s_register_operand" "0,r,?r")
3775		 (match_operand:SI 2 "arm_rhs_operand" "rI,0,rI")))
3776   (clobber (reg:CC CC_REGNUM))]
3777  "TARGET_ARM"
3778  "#"
3779    ; cmp\\t%1, %2\;movcc\\t%0, %2
3780    ; cmp\\t%1, %2\;movcs\\t%0, %1
3781    ; cmp\\t%1, %2\;movcs\\t%0, %1\;movcc\\t%0, %2"
3782  "TARGET_ARM"
3783  [(set (reg:CC CC_REGNUM)
3784        (compare:CC (match_dup 1) (match_dup 2)))
3785   (set (match_dup 0)
3786        (if_then_else:SI (geu:SI (reg:CC CC_REGNUM) (const_int 0))
3787                         (match_dup 1)
3788                         (match_dup 2)))]
3789  ""
3790  [(set_attr "conds" "clob")
3791   (set_attr "length" "8,8,12")
3792   (set_attr "type" "store_4")]
3793)
3794
3795(define_expand "uminsi3"
3796  [(parallel [
3797    (set (match_operand:SI 0 "s_register_operand" "")
3798	 (umin:SI (match_operand:SI 1 "s_register_operand" "")
3799		  (match_operand:SI 2 "arm_rhs_operand" "")))
3800    (clobber (reg:CC CC_REGNUM))])]
3801  "TARGET_32BIT"
3802  ""
3803)
3804
3805(define_insn_and_split "*arm_uminsi3"
3806  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
3807	(umin:SI (match_operand:SI 1 "s_register_operand" "0,r,?r")
3808		 (match_operand:SI 2 "arm_rhs_operand" "rI,0,rI")))
3809   (clobber (reg:CC CC_REGNUM))]
3810  "TARGET_ARM"
3811  "#"
3812   ; cmp\\t%1, %2\;movcs\\t%0, %2
3813   ; cmp\\t%1, %2\;movcc\\t%0, %1
3814   ; cmp\\t%1, %2\;movcc\\t%0, %1\;movcs\\t%0, %2"
3815  "TARGET_ARM"
3816  [(set (reg:CC CC_REGNUM)
3817        (compare:CC (match_dup 1) (match_dup 2)))
3818   (set (match_dup 0)
3819        (if_then_else:SI (ltu:SI (reg:CC CC_REGNUM) (const_int 0))
3820                         (match_dup 1)
3821                         (match_dup 2)))]
3822  ""
3823  [(set_attr "conds" "clob")
3824   (set_attr "length" "8,8,12")
3825   (set_attr "type" "store_4")]
3826)
3827
3828(define_insn "*store_minmaxsi"
3829  [(set (match_operand:SI 0 "memory_operand" "=m")
3830	(match_operator:SI 3 "minmax_operator"
3831	 [(match_operand:SI 1 "s_register_operand" "r")
3832	  (match_operand:SI 2 "s_register_operand" "r")]))
3833   (clobber (reg:CC CC_REGNUM))]
3834  "TARGET_32BIT && optimize_function_for_size_p (cfun) && !arm_restrict_it"
3835  "*
3836  operands[3] = gen_rtx_fmt_ee (minmax_code (operands[3]), SImode,
3837				operands[1], operands[2]);
3838  output_asm_insn (\"cmp\\t%1, %2\", operands);
3839  if (TARGET_THUMB2)
3840    output_asm_insn (\"ite\t%d3\", operands);
3841  output_asm_insn (\"str%d3\\t%1, %0\", operands);
3842  output_asm_insn (\"str%D3\\t%2, %0\", operands);
3843  return \"\";
3844  "
3845  [(set_attr "conds" "clob")
3846   (set (attr "length")
3847	(if_then_else (eq_attr "is_thumb" "yes")
3848		      (const_int 14)
3849		      (const_int 12)))
3850   (set_attr "type" "store_4")]
3851)
3852
3853; Reject the frame pointer in operand[1], since reloading this after
3854; it has been eliminated can cause carnage.
3855(define_insn "*minmax_arithsi"
3856  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
3857	(match_operator:SI 4 "shiftable_operator"
3858	 [(match_operator:SI 5 "minmax_operator"
3859	   [(match_operand:SI 2 "s_register_operand" "r,r")
3860	    (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])
3861	  (match_operand:SI 1 "s_register_operand" "0,?r")]))
3862   (clobber (reg:CC CC_REGNUM))]
3863  "TARGET_32BIT && !arm_eliminable_register (operands[1]) && !arm_restrict_it"
3864  "*
3865  {
3866    enum rtx_code code = GET_CODE (operands[4]);
3867    bool need_else;
3868
3869    if (which_alternative != 0 || operands[3] != const0_rtx
3870        || (code != PLUS && code != IOR && code != XOR))
3871      need_else = true;
3872    else
3873      need_else = false;
3874
3875    operands[5] = gen_rtx_fmt_ee (minmax_code (operands[5]), SImode,
3876				  operands[2], operands[3]);
3877    output_asm_insn (\"cmp\\t%2, %3\", operands);
3878    if (TARGET_THUMB2)
3879      {
3880	if (need_else)
3881	  output_asm_insn (\"ite\\t%d5\", operands);
3882	else
3883	  output_asm_insn (\"it\\t%d5\", operands);
3884      }
3885    output_asm_insn (\"%i4%d5\\t%0, %1, %2\", operands);
3886    if (need_else)
3887      output_asm_insn (\"%i4%D5\\t%0, %1, %3\", operands);
3888    return \"\";
3889  }"
3890  [(set_attr "conds" "clob")
3891   (set (attr "length")
3892	(if_then_else (eq_attr "is_thumb" "yes")
3893		      (const_int 14)
3894		      (const_int 12)))
3895   (set_attr "type" "multiple")]
3896)
3897
3898; Reject the frame pointer in operand[1], since reloading this after
3899; it has been eliminated can cause carnage.
3900(define_insn_and_split "*minmax_arithsi_non_canon"
3901  [(set (match_operand:SI 0 "s_register_operand" "=Ts,Ts")
3902	(minus:SI
3903	 (match_operand:SI 1 "s_register_operand" "0,?Ts")
3904	  (match_operator:SI 4 "minmax_operator"
3905	   [(match_operand:SI 2 "s_register_operand" "Ts,Ts")
3906	    (match_operand:SI 3 "arm_rhs_operand" "TsI,TsI")])))
3907   (clobber (reg:CC CC_REGNUM))]
3908  "TARGET_32BIT && !arm_eliminable_register (operands[1])
3909   && !(arm_restrict_it && CONST_INT_P (operands[3]))"
3910  "#"
3911  "TARGET_32BIT && !arm_eliminable_register (operands[1]) && reload_completed"
3912  [(set (reg:CC CC_REGNUM)
3913        (compare:CC (match_dup 2) (match_dup 3)))
3914
3915   (cond_exec (match_op_dup 4 [(reg:CC CC_REGNUM) (const_int 0)])
3916              (set (match_dup 0)
3917                   (minus:SI (match_dup 1)
3918                             (match_dup 2))))
3919   (cond_exec (match_op_dup 5 [(reg:CC CC_REGNUM) (const_int 0)])
3920              (set (match_dup 0)
3921                   (match_dup 6)))]
3922  {
3923  machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
3924                                           operands[2], operands[3]);
3925  enum rtx_code rc = minmax_code (operands[4]);
3926  operands[4] = gen_rtx_fmt_ee (rc, VOIDmode,
3927                                operands[2], operands[3]);
3928
3929  if (mode == CCFPmode || mode == CCFPEmode)
3930    rc = reverse_condition_maybe_unordered (rc);
3931  else
3932    rc = reverse_condition (rc);
3933  operands[5] = gen_rtx_fmt_ee (rc, SImode, operands[2], operands[3]);
3934  if (CONST_INT_P (operands[3]))
3935    operands[6] = plus_constant (SImode, operands[1], -INTVAL (operands[3]));
3936  else
3937    operands[6] = gen_rtx_MINUS (SImode, operands[1], operands[3]);
3938  }
3939  [(set_attr "conds" "clob")
3940   (set (attr "length")
3941	(if_then_else (eq_attr "is_thumb" "yes")
3942		      (const_int 14)
3943		      (const_int 12)))
3944   (set_attr "type" "multiple")]
3945)
3946
3947(define_code_iterator SAT [smin smax])
3948(define_code_iterator SATrev [smin smax])
3949(define_code_attr SATlo [(smin "1") (smax "2")])
3950(define_code_attr SAThi [(smin "2") (smax "1")])
3951
3952(define_insn "*satsi_<SAT:code>"
3953  [(set (match_operand:SI 0 "s_register_operand" "=r")
3954        (SAT:SI (SATrev:SI (match_operand:SI 3 "s_register_operand" "r")
3955                           (match_operand:SI 1 "const_int_operand" "i"))
3956                (match_operand:SI 2 "const_int_operand" "i")))]
3957  "TARGET_32BIT && arm_arch6 && <SAT:CODE> != <SATrev:CODE>
3958   && arm_sat_operator_match (operands[<SAT:SATlo>], operands[<SAT:SAThi>], NULL, NULL)"
3959{
3960  int mask;
3961  bool signed_sat;
3962  if (!arm_sat_operator_match (operands[<SAT:SATlo>], operands[<SAT:SAThi>],
3963                               &mask, &signed_sat))
3964    gcc_unreachable ();
3965
3966  operands[1] = GEN_INT (mask);
3967  if (signed_sat)
3968    return "ssat%?\t%0, %1, %3";
3969  else
3970    return "usat%?\t%0, %1, %3";
3971}
3972  [(set_attr "predicable" "yes")
3973   (set_attr "type" "alus_imm")]
3974)
3975
3976(define_insn "*satsi_<SAT:code>_shift"
3977  [(set (match_operand:SI 0 "s_register_operand" "=r")
3978        (SAT:SI (SATrev:SI (match_operator:SI 3 "sat_shift_operator"
3979                             [(match_operand:SI 4 "s_register_operand" "r")
3980                              (match_operand:SI 5 "const_int_operand" "i")])
3981                           (match_operand:SI 1 "const_int_operand" "i"))
3982                (match_operand:SI 2 "const_int_operand" "i")))]
3983  "TARGET_32BIT && arm_arch6 && <SAT:CODE> != <SATrev:CODE>
3984   && arm_sat_operator_match (operands[<SAT:SATlo>], operands[<SAT:SAThi>], NULL, NULL)"
3985{
3986  int mask;
3987  bool signed_sat;
3988  if (!arm_sat_operator_match (operands[<SAT:SATlo>], operands[<SAT:SAThi>],
3989                               &mask, &signed_sat))
3990    gcc_unreachable ();
3991
3992  operands[1] = GEN_INT (mask);
3993  if (signed_sat)
3994    return "ssat%?\t%0, %1, %4%S3";
3995  else
3996    return "usat%?\t%0, %1, %4%S3";
3997}
3998  [(set_attr "predicable" "yes")
3999   (set_attr "shift" "3")
4000   (set_attr "type" "logic_shift_reg")])
4001
4002;; Shift and rotation insns
4003
4004(define_expand "ashldi3"
4005  [(set (match_operand:DI            0 "s_register_operand" "")
4006        (ashift:DI (match_operand:DI 1 "s_register_operand" "")
4007                   (match_operand:SI 2 "general_operand" "")))]
4008  "TARGET_32BIT"
4009  "
4010  if (TARGET_NEON)
4011    {
4012      /* Delay the decision whether to use NEON or core-regs until
4013	 register allocation.  */
4014      emit_insn (gen_ashldi3_neon (operands[0], operands[1], operands[2]));
4015      DONE;
4016    }
4017  else
4018    {
4019      /* Only the NEON case can handle in-memory shift counts.  */
4020      if (!reg_or_int_operand (operands[2], SImode))
4021        operands[2] = force_reg (SImode, operands[2]);
4022    }
4023
4024  if (!CONST_INT_P (operands[2]) && TARGET_REALLY_IWMMXT)
4025    ; /* No special preparation statements; expand pattern as above.  */
4026  else
4027    {
4028      rtx scratch1, scratch2;
4029
4030      /* Ideally we should use iwmmxt here if we could know that operands[1]
4031         ends up already living in an iwmmxt register. Otherwise it's
4032         cheaper to have the alternate code being generated than moving
4033         values to iwmmxt regs and back.  */
4034
4035      /* Expand operation using core-registers.
4036	 'FAIL' would achieve the same thing, but this is a bit smarter.  */
4037      scratch1 = gen_reg_rtx (SImode);
4038      scratch2 = gen_reg_rtx (SImode);
4039      arm_emit_coreregs_64bit_shift (ASHIFT, operands[0], operands[1],
4040				     operands[2], scratch1, scratch2);
4041      DONE;
4042    }
4043  "
4044)
4045
4046(define_expand "ashlsi3"
4047  [(set (match_operand:SI            0 "s_register_operand" "")
4048	(ashift:SI (match_operand:SI 1 "s_register_operand" "")
4049		   (match_operand:SI 2 "arm_rhs_operand" "")))]
4050  "TARGET_EITHER"
4051  "
4052  if (CONST_INT_P (operands[2])
4053      && (UINTVAL (operands[2])) > 31)
4054    {
4055      emit_insn (gen_movsi (operands[0], const0_rtx));
4056      DONE;
4057    }
4058  "
4059)
4060
4061(define_expand "ashrdi3"
4062  [(set (match_operand:DI              0 "s_register_operand" "")
4063        (ashiftrt:DI (match_operand:DI 1 "s_register_operand" "")
4064                     (match_operand:SI 2 "reg_or_int_operand" "")))]
4065  "TARGET_32BIT"
4066  "
4067  if (TARGET_NEON)
4068    {
4069      /* Delay the decision whether to use NEON or core-regs until
4070	 register allocation.  */
4071      emit_insn (gen_ashrdi3_neon (operands[0], operands[1], operands[2]));
4072      DONE;
4073    }
4074
4075  if (!CONST_INT_P (operands[2]) && TARGET_REALLY_IWMMXT)
4076    ; /* No special preparation statements; expand pattern as above.  */
4077  else
4078    {
4079      rtx scratch1, scratch2;
4080
4081      /* Ideally we should use iwmmxt here if we could know that operands[1]
4082         ends up already living in an iwmmxt register. Otherwise it's
4083         cheaper to have the alternate code being generated than moving
4084         values to iwmmxt regs and back.  */
4085
4086      /* Expand operation using core-registers.
4087	 'FAIL' would achieve the same thing, but this is a bit smarter.  */
4088      scratch1 = gen_reg_rtx (SImode);
4089      scratch2 = gen_reg_rtx (SImode);
4090      arm_emit_coreregs_64bit_shift (ASHIFTRT, operands[0], operands[1],
4091				     operands[2], scratch1, scratch2);
4092      DONE;
4093    }
4094  "
4095)
4096
4097(define_expand "ashrsi3"
4098  [(set (match_operand:SI              0 "s_register_operand" "")
4099	(ashiftrt:SI (match_operand:SI 1 "s_register_operand" "")
4100		     (match_operand:SI 2 "arm_rhs_operand" "")))]
4101  "TARGET_EITHER"
4102  "
4103  if (CONST_INT_P (operands[2])
4104      && UINTVAL (operands[2]) > 31)
4105    operands[2] = GEN_INT (31);
4106  "
4107)
4108
4109(define_expand "lshrdi3"
4110  [(set (match_operand:DI              0 "s_register_operand" "")
4111        (lshiftrt:DI (match_operand:DI 1 "s_register_operand" "")
4112                     (match_operand:SI 2 "reg_or_int_operand" "")))]
4113  "TARGET_32BIT"
4114  "
4115  if (TARGET_NEON)
4116    {
4117      /* Delay the decision whether to use NEON or core-regs until
4118	 register allocation.  */
4119      emit_insn (gen_lshrdi3_neon (operands[0], operands[1], operands[2]));
4120      DONE;
4121    }
4122
4123  if (!CONST_INT_P (operands[2]) && TARGET_REALLY_IWMMXT)
4124    ; /* No special preparation statements; expand pattern as above.  */
4125  else
4126    {
4127      rtx scratch1, scratch2;
4128
4129      /* Ideally we should use iwmmxt here if we could know that operands[1]
4130         ends up already living in an iwmmxt register. Otherwise it's
4131         cheaper to have the alternate code being generated than moving
4132         values to iwmmxt regs and back.  */
4133
4134      /* Expand operation using core-registers.
4135	 'FAIL' would achieve the same thing, but this is a bit smarter.  */
4136      scratch1 = gen_reg_rtx (SImode);
4137      scratch2 = gen_reg_rtx (SImode);
4138      arm_emit_coreregs_64bit_shift (LSHIFTRT, operands[0], operands[1],
4139				     operands[2], scratch1, scratch2);
4140      DONE;
4141    }
4142  "
4143)
4144
4145(define_expand "lshrsi3"
4146  [(set (match_operand:SI              0 "s_register_operand" "")
4147	(lshiftrt:SI (match_operand:SI 1 "s_register_operand" "")
4148		     (match_operand:SI 2 "arm_rhs_operand" "")))]
4149  "TARGET_EITHER"
4150  "
4151  if (CONST_INT_P (operands[2])
4152      && (UINTVAL (operands[2])) > 31)
4153    {
4154      emit_insn (gen_movsi (operands[0], const0_rtx));
4155      DONE;
4156    }
4157  "
4158)
4159
4160(define_expand "rotlsi3"
4161  [(set (match_operand:SI              0 "s_register_operand" "")
4162	(rotatert:SI (match_operand:SI 1 "s_register_operand" "")
4163		     (match_operand:SI 2 "reg_or_int_operand" "")))]
4164  "TARGET_32BIT"
4165  "
4166  if (CONST_INT_P (operands[2]))
4167    operands[2] = GEN_INT ((32 - INTVAL (operands[2])) % 32);
4168  else
4169    {
4170      rtx reg = gen_reg_rtx (SImode);
4171      emit_insn (gen_subsi3 (reg, GEN_INT (32), operands[2]));
4172      operands[2] = reg;
4173    }
4174  "
4175)
4176
4177(define_expand "rotrsi3"
4178  [(set (match_operand:SI              0 "s_register_operand" "")
4179	(rotatert:SI (match_operand:SI 1 "s_register_operand" "")
4180		     (match_operand:SI 2 "arm_rhs_operand" "")))]
4181  "TARGET_EITHER"
4182  "
4183  if (TARGET_32BIT)
4184    {
4185      if (CONST_INT_P (operands[2])
4186          && UINTVAL (operands[2]) > 31)
4187        operands[2] = GEN_INT (INTVAL (operands[2]) % 32);
4188    }
4189  else /* TARGET_THUMB1 */
4190    {
4191      if (CONST_INT_P (operands [2]))
4192        operands [2] = force_reg (SImode, operands[2]);
4193    }
4194  "
4195)
4196
4197(define_insn "*arm_shiftsi3"
4198  [(set (match_operand:SI   0 "s_register_operand" "=l,l,r,r")
4199	(match_operator:SI  3 "shift_operator"
4200	 [(match_operand:SI 1 "s_register_operand"  "0,l,r,r")
4201	  (match_operand:SI 2 "reg_or_int_operand" "l,M,M,r")]))]
4202  "TARGET_32BIT"
4203  "* return arm_output_shift(operands, 0);"
4204  [(set_attr "predicable" "yes")
4205   (set_attr "arch" "t2,t2,*,*")
4206   (set_attr "predicable_short_it" "yes,yes,no,no")
4207   (set_attr "length" "4")
4208   (set_attr "shift" "1")
4209   (set_attr "type" "alu_shift_reg,alu_shift_imm,alu_shift_imm,alu_shift_reg")]
4210)
4211
4212(define_insn "*shiftsi3_compare0"
4213  [(set (reg:CC_NOOV CC_REGNUM)
4214	(compare:CC_NOOV (match_operator:SI 3 "shift_operator"
4215			  [(match_operand:SI 1 "s_register_operand" "r,r")
4216			   (match_operand:SI 2 "arm_rhs_operand" "M,r")])
4217			 (const_int 0)))
4218   (set (match_operand:SI 0 "s_register_operand" "=r,r")
4219	(match_op_dup 3 [(match_dup 1) (match_dup 2)]))]
4220  "TARGET_32BIT"
4221  "* return arm_output_shift(operands, 1);"
4222  [(set_attr "conds" "set")
4223   (set_attr "shift" "1")
4224   (set_attr "type" "alus_shift_imm,alus_shift_reg")]
4225)
4226
4227(define_insn "*shiftsi3_compare0_scratch"
4228  [(set (reg:CC_NOOV CC_REGNUM)
4229	(compare:CC_NOOV (match_operator:SI 3 "shift_operator"
4230			  [(match_operand:SI 1 "s_register_operand" "r,r")
4231			   (match_operand:SI 2 "arm_rhs_operand" "M,r")])
4232			 (const_int 0)))
4233   (clobber (match_scratch:SI 0 "=r,r"))]
4234  "TARGET_32BIT"
4235  "* return arm_output_shift(operands, 1);"
4236  [(set_attr "conds" "set")
4237   (set_attr "shift" "1")
4238   (set_attr "type" "shift_imm,shift_reg")]
4239)
4240
4241(define_insn "*not_shiftsi"
4242  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
4243	(not:SI (match_operator:SI 3 "shift_operator"
4244		 [(match_operand:SI 1 "s_register_operand" "r,r")
4245		  (match_operand:SI 2 "shift_amount_operand" "M,rM")])))]
4246  "TARGET_32BIT"
4247  "mvn%?\\t%0, %1%S3"
4248  [(set_attr "predicable" "yes")
4249   (set_attr "shift" "1")
4250   (set_attr "arch" "32,a")
4251   (set_attr "type" "mvn_shift,mvn_shift_reg")])
4252
4253(define_insn "*not_shiftsi_compare0"
4254  [(set (reg:CC_NOOV CC_REGNUM)
4255	(compare:CC_NOOV
4256	 (not:SI (match_operator:SI 3 "shift_operator"
4257		  [(match_operand:SI 1 "s_register_operand" "r,r")
4258		   (match_operand:SI 2 "shift_amount_operand" "M,rM")]))
4259	 (const_int 0)))
4260   (set (match_operand:SI 0 "s_register_operand" "=r,r")
4261	(not:SI (match_op_dup 3 [(match_dup 1) (match_dup 2)])))]
4262  "TARGET_32BIT"
4263  "mvns%?\\t%0, %1%S3"
4264  [(set_attr "conds" "set")
4265   (set_attr "shift" "1")
4266   (set_attr "arch" "32,a")
4267   (set_attr "type" "mvn_shift,mvn_shift_reg")])
4268
4269(define_insn "*not_shiftsi_compare0_scratch"
4270  [(set (reg:CC_NOOV CC_REGNUM)
4271	(compare:CC_NOOV
4272	 (not:SI (match_operator:SI 3 "shift_operator"
4273		  [(match_operand:SI 1 "s_register_operand" "r,r")
4274		   (match_operand:SI 2 "shift_amount_operand" "M,rM")]))
4275	 (const_int 0)))
4276   (clobber (match_scratch:SI 0 "=r,r"))]
4277  "TARGET_32BIT"
4278  "mvns%?\\t%0, %1%S3"
4279  [(set_attr "conds" "set")
4280   (set_attr "shift" "1")
4281   (set_attr "arch" "32,a")
4282   (set_attr "type" "mvn_shift,mvn_shift_reg")])
4283
4284;; We don't really have extzv, but defining this using shifts helps
4285;; to reduce register pressure later on.
4286
4287(define_expand "extzv"
4288  [(set (match_operand 0 "s_register_operand" "")
4289	(zero_extract (match_operand 1 "nonimmediate_operand" "")
4290		      (match_operand 2 "const_int_operand" "")
4291		      (match_operand 3 "const_int_operand" "")))]
4292  "TARGET_THUMB1 || arm_arch_thumb2"
4293  "
4294  {
4295    HOST_WIDE_INT lshift = 32 - INTVAL (operands[2]) - INTVAL (operands[3]);
4296    HOST_WIDE_INT rshift = 32 - INTVAL (operands[2]);
4297
4298    if (arm_arch_thumb2)
4299      {
4300	HOST_WIDE_INT width = INTVAL (operands[2]);
4301	HOST_WIDE_INT bitpos = INTVAL (operands[3]);
4302
4303	if (unaligned_access && MEM_P (operands[1])
4304	    && (width == 16 || width == 32) && (bitpos % BITS_PER_UNIT) == 0)
4305	  {
4306	    rtx base_addr;
4307
4308	    if (BYTES_BIG_ENDIAN)
4309	      bitpos = GET_MODE_BITSIZE (GET_MODE (operands[0])) - width
4310		       - bitpos;
4311
4312	    if (width == 32)
4313              {
4314		base_addr = adjust_address (operands[1], SImode,
4315					    bitpos / BITS_PER_UNIT);
4316		emit_insn (gen_unaligned_loadsi (operands[0], base_addr));
4317              }
4318	    else
4319              {
4320		rtx dest = operands[0];
4321		rtx tmp = gen_reg_rtx (SImode);
4322
4323		/* We may get a paradoxical subreg here.  Strip it off.  */
4324		if (GET_CODE (dest) == SUBREG
4325		    && GET_MODE (dest) == SImode
4326		    && GET_MODE (SUBREG_REG (dest)) == HImode)
4327		  dest = SUBREG_REG (dest);
4328
4329		if (GET_MODE_BITSIZE (GET_MODE (dest)) != width)
4330		  FAIL;
4331
4332		base_addr = adjust_address (operands[1], HImode,
4333					    bitpos / BITS_PER_UNIT);
4334		emit_insn (gen_unaligned_loadhiu (tmp, base_addr));
4335		emit_move_insn (gen_lowpart (SImode, dest), tmp);
4336	      }
4337	    DONE;
4338	  }
4339	else if (s_register_operand (operands[1], GET_MODE (operands[1])))
4340	  {
4341	    emit_insn (gen_extzv_t2 (operands[0], operands[1], operands[2],
4342				     operands[3]));
4343	    DONE;
4344	  }
4345	else
4346	  FAIL;
4347      }
4348
4349    if (!s_register_operand (operands[1], GET_MODE (operands[1])))
4350      FAIL;
4351
4352    operands[3] = GEN_INT (rshift);
4353
4354    if (lshift == 0)
4355      {
4356        emit_insn (gen_lshrsi3 (operands[0], operands[1], operands[3]));
4357        DONE;
4358      }
4359
4360    emit_insn (gen_extzv_t1 (operands[0], operands[1], GEN_INT (lshift),
4361			     operands[3], gen_reg_rtx (SImode)));
4362    DONE;
4363  }"
4364)
4365
4366;; Helper for extzv, for the Thumb-1 register-shifts case.
4367
4368(define_expand "extzv_t1"
4369  [(set (match_operand:SI 4 "s_register_operand" "")
4370	(ashift:SI (match_operand:SI 1 "nonimmediate_operand" "")
4371		   (match_operand:SI 2 "const_int_operand" "")))
4372   (set (match_operand:SI 0 "s_register_operand" "")
4373	(lshiftrt:SI (match_dup 4)
4374		     (match_operand:SI 3 "const_int_operand" "")))]
4375  "TARGET_THUMB1"
4376  "")
4377
4378(define_expand "extv"
4379  [(set (match_operand 0 "s_register_operand" "")
4380	(sign_extract (match_operand 1 "nonimmediate_operand" "")
4381		      (match_operand 2 "const_int_operand" "")
4382		      (match_operand 3 "const_int_operand" "")))]
4383  "arm_arch_thumb2"
4384{
4385  HOST_WIDE_INT width = INTVAL (operands[2]);
4386  HOST_WIDE_INT bitpos = INTVAL (operands[3]);
4387
4388  if (unaligned_access && MEM_P (operands[1]) && (width == 16 || width == 32)
4389      && (bitpos % BITS_PER_UNIT)  == 0)
4390    {
4391      rtx base_addr;
4392
4393      if (BYTES_BIG_ENDIAN)
4394	bitpos = GET_MODE_BITSIZE (GET_MODE (operands[0])) - width - bitpos;
4395
4396      if (width == 32)
4397        {
4398	  base_addr = adjust_address (operands[1], SImode,
4399				      bitpos / BITS_PER_UNIT);
4400	  emit_insn (gen_unaligned_loadsi (operands[0], base_addr));
4401        }
4402      else
4403        {
4404	  rtx dest = operands[0];
4405	  rtx tmp = gen_reg_rtx (SImode);
4406
4407	  /* We may get a paradoxical subreg here.  Strip it off.  */
4408	  if (GET_CODE (dest) == SUBREG
4409	      && GET_MODE (dest) == SImode
4410	      && GET_MODE (SUBREG_REG (dest)) == HImode)
4411	    dest = SUBREG_REG (dest);
4412
4413	  if (GET_MODE_BITSIZE (GET_MODE (dest)) != width)
4414	    FAIL;
4415
4416	  base_addr = adjust_address (operands[1], HImode,
4417				      bitpos / BITS_PER_UNIT);
4418	  emit_insn (gen_unaligned_loadhis (tmp, base_addr));
4419	  emit_move_insn (gen_lowpart (SImode, dest), tmp);
4420	}
4421
4422      DONE;
4423    }
4424  else if (!s_register_operand (operands[1], GET_MODE (operands[1])))
4425    FAIL;
4426  else if (GET_MODE (operands[0]) == SImode
4427	   && GET_MODE (operands[1]) == SImode)
4428    {
4429      emit_insn (gen_extv_regsi (operands[0], operands[1], operands[2],
4430				 operands[3]));
4431      DONE;
4432    }
4433
4434  FAIL;
4435})
4436
4437; Helper to expand register forms of extv with the proper modes.
4438
4439(define_expand "extv_regsi"
4440  [(set (match_operand:SI 0 "s_register_operand" "")
4441	(sign_extract:SI (match_operand:SI 1 "s_register_operand" "")
4442			 (match_operand 2 "const_int_operand" "")
4443			 (match_operand 3 "const_int_operand" "")))]
4444  ""
4445{
4446})
4447
4448; ARMv6+ unaligned load/store instructions (used for packed structure accesses).
4449
4450(define_insn "unaligned_loadsi"
4451  [(set (match_operand:SI 0 "s_register_operand" "=l,l,r")
4452	(unspec:SI [(match_operand:SI 1 "memory_operand" "m,Uw,m")]
4453		   UNSPEC_UNALIGNED_LOAD))]
4454  "unaligned_access"
4455  "@
4456   ldr\t%0, %1\t@ unaligned
4457   ldr%?\t%0, %1\t@ unaligned
4458   ldr%?\t%0, %1\t@ unaligned"
4459  [(set_attr "arch" "t1,t2,32")
4460   (set_attr "length" "2,2,4")
4461   (set_attr "predicable" "no,yes,yes")
4462   (set_attr "predicable_short_it" "no,yes,no")
4463   (set_attr "type" "load_4")])
4464
4465;; The 16-bit Thumb1 variant of ldrsh requires two registers in the
4466;; address (there's no immediate format).  That's tricky to support
4467;; here and we don't really need this pattern for that case, so only
4468;; enable for 32-bit ISAs.
4469(define_insn "unaligned_loadhis"
4470  [(set (match_operand:SI 0 "s_register_operand" "=r")
4471	(sign_extend:SI
4472	  (unspec:HI [(match_operand:HI 1 "memory_operand" "Uh")]
4473		     UNSPEC_UNALIGNED_LOAD)))]
4474  "unaligned_access && TARGET_32BIT"
4475  "ldrsh%?\t%0, %1\t@ unaligned"
4476  [(set_attr "predicable" "yes")
4477   (set_attr "type" "load_byte")])
4478
4479(define_insn "unaligned_loadhiu"
4480  [(set (match_operand:SI 0 "s_register_operand" "=l,l,r")
4481	(zero_extend:SI
4482	  (unspec:HI [(match_operand:HI 1 "memory_operand" "m,Uw,m")]
4483		     UNSPEC_UNALIGNED_LOAD)))]
4484  "unaligned_access"
4485  "@
4486   ldrh\t%0, %1\t@ unaligned
4487   ldrh%?\t%0, %1\t@ unaligned
4488   ldrh%?\t%0, %1\t@ unaligned"
4489  [(set_attr "arch" "t1,t2,32")
4490   (set_attr "length" "2,2,4")
4491   (set_attr "predicable" "no,yes,yes")
4492   (set_attr "predicable_short_it" "no,yes,no")
4493   (set_attr "type" "load_byte")])
4494
4495(define_insn "unaligned_storesi"
4496  [(set (match_operand:SI 0 "memory_operand" "=m,Uw,m")
4497	(unspec:SI [(match_operand:SI 1 "s_register_operand" "l,l,r")]
4498		   UNSPEC_UNALIGNED_STORE))]
4499  "unaligned_access"
4500  "@
4501   str\t%1, %0\t@ unaligned
4502   str%?\t%1, %0\t@ unaligned
4503   str%?\t%1, %0\t@ unaligned"
4504  [(set_attr "arch" "t1,t2,32")
4505   (set_attr "length" "2,2,4")
4506   (set_attr "predicable" "no,yes,yes")
4507   (set_attr "predicable_short_it" "no,yes,no")
4508   (set_attr "type" "store_4")])
4509
4510(define_insn "unaligned_storehi"
4511  [(set (match_operand:HI 0 "memory_operand" "=m,Uw,m")
4512	(unspec:HI [(match_operand:HI 1 "s_register_operand" "l,l,r")]
4513		   UNSPEC_UNALIGNED_STORE))]
4514  "unaligned_access"
4515  "@
4516   strh\t%1, %0\t@ unaligned
4517   strh%?\t%1, %0\t@ unaligned
4518   strh%?\t%1, %0\t@ unaligned"
4519  [(set_attr "arch" "t1,t2,32")
4520   (set_attr "length" "2,2,4")
4521   (set_attr "predicable" "no,yes,yes")
4522   (set_attr "predicable_short_it" "no,yes,no")
4523   (set_attr "type" "store_4")])
4524
4525
4526(define_insn "*extv_reg"
4527  [(set (match_operand:SI 0 "s_register_operand" "=r")
4528	(sign_extract:SI (match_operand:SI 1 "s_register_operand" "r")
4529			  (match_operand:SI 2 "const_int_operand" "n")
4530			  (match_operand:SI 3 "const_int_operand" "n")))]
4531  "arm_arch_thumb2
4532   && IN_RANGE (INTVAL (operands[3]), 0, 31)
4533   && IN_RANGE (INTVAL (operands[2]), 1, 32 - INTVAL (operands[3]))"
4534  "sbfx%?\t%0, %1, %3, %2"
4535  [(set_attr "length" "4")
4536   (set_attr "predicable" "yes")
4537   (set_attr "type" "bfm")]
4538)
4539
4540(define_insn "extzv_t2"
4541  [(set (match_operand:SI 0 "s_register_operand" "=r")
4542	(zero_extract:SI (match_operand:SI 1 "s_register_operand" "r")
4543			  (match_operand:SI 2 "const_int_operand" "n")
4544			  (match_operand:SI 3 "const_int_operand" "n")))]
4545  "arm_arch_thumb2
4546   && IN_RANGE (INTVAL (operands[3]), 0, 31)
4547   && IN_RANGE (INTVAL (operands[2]), 1, 32 - INTVAL (operands[3]))"
4548  "ubfx%?\t%0, %1, %3, %2"
4549  [(set_attr "length" "4")
4550   (set_attr "predicable" "yes")
4551   (set_attr "type" "bfm")]
4552)
4553
4554
4555;; Division instructions
4556(define_insn "divsi3"
4557  [(set (match_operand:SI	  0 "s_register_operand" "=r,r")
4558	(div:SI (match_operand:SI 1 "s_register_operand"  "r,r")
4559		(match_operand:SI 2 "s_register_operand"  "r,r")))]
4560  "TARGET_IDIV"
4561  "@
4562   sdiv%?\t%0, %1, %2
4563   sdiv\t%0, %1, %2"
4564  [(set_attr "arch" "32,v8mb")
4565   (set_attr "predicable" "yes")
4566   (set_attr "type" "sdiv")]
4567)
4568
4569(define_insn "udivsi3"
4570  [(set (match_operand:SI	   0 "s_register_operand" "=r,r")
4571	(udiv:SI (match_operand:SI 1 "s_register_operand"  "r,r")
4572		 (match_operand:SI 2 "s_register_operand"  "r,r")))]
4573  "TARGET_IDIV"
4574  "@
4575   udiv%?\t%0, %1, %2
4576   udiv\t%0, %1, %2"
4577  [(set_attr "arch" "32,v8mb")
4578   (set_attr "predicable" "yes")
4579   (set_attr "type" "udiv")]
4580)
4581
4582
4583;; Unary arithmetic insns
4584
4585(define_expand "negvsi3"
4586  [(match_operand:SI 0 "register_operand")
4587   (match_operand:SI 1 "register_operand")
4588   (match_operand 2 "")]
4589  "TARGET_32BIT"
4590{
4591  emit_insn (gen_subsi3_compare (operands[0], const0_rtx, operands[1]));
4592  arm_gen_unlikely_cbranch (NE, CC_Vmode, operands[2]);
4593
4594  DONE;
4595})
4596
4597(define_expand "negvdi3"
4598  [(match_operand:DI 0 "register_operand")
4599   (match_operand:DI 1 "register_operand")
4600   (match_operand 2 "")]
4601  "TARGET_ARM"
4602{
4603  emit_insn (gen_negdi2_compare (operands[0], operands[1]));
4604  arm_gen_unlikely_cbranch (NE, CC_Vmode, operands[2]);
4605
4606  DONE;
4607})
4608
4609
4610(define_insn_and_split "negdi2_compare"
4611  [(set (reg:CC CC_REGNUM)
4612	(compare:CC
4613	  (const_int 0)
4614	  (match_operand:DI 1 "register_operand" "0,r")))
4615   (set (match_operand:DI 0 "register_operand" "=r,&r")
4616	(minus:DI (const_int 0) (match_dup 1)))]
4617  "TARGET_ARM"
4618  "#"
4619  "&& reload_completed"
4620  [(parallel [(set (reg:CC CC_REGNUM)
4621		   (compare:CC (const_int 0) (match_dup 1)))
4622	      (set (match_dup 0) (minus:SI (const_int 0)
4623					   (match_dup 1)))])
4624   (parallel [(set (reg:CC CC_REGNUM)
4625		   (compare:CC (const_int 0) (match_dup 3)))
4626	     (set (match_dup 2)
4627		  (minus:SI
4628		   (minus:SI (const_int 0) (match_dup 3))
4629		   (ltu:SI (reg:CC_C CC_REGNUM)
4630			   (const_int 0))))])]
4631  {
4632    operands[2] = gen_highpart (SImode, operands[0]);
4633    operands[0] = gen_lowpart (SImode, operands[0]);
4634    operands[3] = gen_highpart (SImode, operands[1]);
4635    operands[1] = gen_lowpart (SImode, operands[1]);
4636  }
4637  [(set_attr "conds" "set")
4638   (set_attr "length" "8")
4639   (set_attr "type" "multiple")]
4640)
4641
4642(define_expand "negdi2"
4643 [(parallel
4644   [(set (match_operand:DI 0 "s_register_operand" "")
4645	 (neg:DI (match_operand:DI 1 "s_register_operand" "")))
4646    (clobber (reg:CC CC_REGNUM))])]
4647  "TARGET_EITHER"
4648  {
4649    if (TARGET_NEON)
4650      {
4651        emit_insn (gen_negdi2_neon (operands[0], operands[1]));
4652	DONE;
4653      }
4654  }
4655)
4656
4657;; The constraints here are to prevent a *partial* overlap (where %Q0 == %R1).
4658;; The first alternative allows the common case of a *full* overlap.
4659(define_insn_and_split "*negdi2_insn"
4660  [(set (match_operand:DI         0 "s_register_operand" "=r,&r")
4661	(neg:DI (match_operand:DI 1 "s_register_operand"  "0,r")))
4662   (clobber (reg:CC CC_REGNUM))]
4663  "TARGET_32BIT"
4664  "#"	; rsbs %Q0, %Q1, #0; rsc %R0, %R1, #0	       (ARM)
4665	; negs %Q0, %Q1    ; sbc %R0, %R1, %R1, lsl #1 (Thumb-2)
4666  "&& reload_completed"
4667  [(parallel [(set (reg:CC CC_REGNUM)
4668		   (compare:CC (const_int 0) (match_dup 1)))
4669	      (set (match_dup 0) (minus:SI (const_int 0) (match_dup 1)))])
4670   (set (match_dup 2) (minus:SI (minus:SI (const_int 0) (match_dup 3))
4671                                (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
4672  {
4673    operands[2] = gen_highpart (SImode, operands[0]);
4674    operands[0] = gen_lowpart (SImode, operands[0]);
4675    operands[3] = gen_highpart (SImode, operands[1]);
4676    operands[1] = gen_lowpart (SImode, operands[1]);
4677  }
4678  [(set_attr "conds" "clob")
4679   (set_attr "length" "8")
4680   (set_attr "type" "multiple")]
4681)
4682
4683(define_insn "*negsi2_carryin_compare"
4684  [(set (reg:CC CC_REGNUM)
4685	(compare:CC (const_int 0)
4686		    (match_operand:SI 1 "s_register_operand" "r")))
4687   (set (match_operand:SI 0 "s_register_operand" "=r")
4688	(minus:SI (minus:SI (const_int 0)
4689			    (match_dup 1))
4690		  (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
4691  "TARGET_ARM"
4692  "rscs\\t%0, %1, #0"
4693  [(set_attr "conds" "set")
4694   (set_attr "type" "alus_imm")]
4695)
4696
4697(define_expand "negsi2"
4698  [(set (match_operand:SI         0 "s_register_operand" "")
4699	(neg:SI (match_operand:SI 1 "s_register_operand" "")))]
4700  "TARGET_EITHER"
4701  ""
4702)
4703
4704(define_insn "*arm_negsi2"
4705  [(set (match_operand:SI         0 "s_register_operand" "=l,r")
4706	(neg:SI (match_operand:SI 1 "s_register_operand" "l,r")))]
4707  "TARGET_32BIT"
4708  "rsb%?\\t%0, %1, #0"
4709  [(set_attr "predicable" "yes")
4710   (set_attr "predicable_short_it" "yes,no")
4711   (set_attr "arch" "t2,*")
4712   (set_attr "length" "4")
4713   (set_attr "type" "alu_sreg")]
4714)
4715
4716(define_expand "negsf2"
4717  [(set (match_operand:SF         0 "s_register_operand" "")
4718	(neg:SF (match_operand:SF 1 "s_register_operand" "")))]
4719  "TARGET_32BIT && TARGET_HARD_FLOAT"
4720  ""
4721)
4722
4723(define_expand "negdf2"
4724  [(set (match_operand:DF         0 "s_register_operand" "")
4725	(neg:DF (match_operand:DF 1 "s_register_operand" "")))]
4726  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP_DOUBLE"
4727  "")
4728
4729(define_insn_and_split "*zextendsidi_negsi"
4730  [(set (match_operand:DI 0 "s_register_operand" "=r")
4731        (zero_extend:DI (neg:SI (match_operand:SI 1 "s_register_operand" "r"))))]
4732   "TARGET_32BIT"
4733   "#"
4734   ""
4735   [(set (match_dup 2)
4736         (neg:SI (match_dup 1)))
4737    (set (match_dup 3)
4738         (const_int 0))]
4739   {
4740      operands[2] = gen_lowpart (SImode, operands[0]);
4741      operands[3] = gen_highpart (SImode, operands[0]);
4742   }
4743 [(set_attr "length" "8")
4744  (set_attr "type" "multiple")]
4745)
4746
4747;; Negate an extended 32-bit value.
4748(define_insn_and_split "*negdi_extendsidi"
4749  [(set (match_operand:DI 0 "s_register_operand" "=l,r")
4750	(neg:DI (sign_extend:DI
4751		 (match_operand:SI 1 "s_register_operand" "l,r"))))
4752   (clobber (reg:CC CC_REGNUM))]
4753  "TARGET_32BIT"
4754  "#"
4755  "&& reload_completed"
4756  [(const_int 0)]
4757  {
4758    rtx low = gen_lowpart (SImode, operands[0]);
4759    rtx high = gen_highpart (SImode, operands[0]);
4760
4761    if (reg_overlap_mentioned_p (low, operands[1]))
4762      {
4763	/* Input overlaps the low word of the output.  Use:
4764		asr	Rhi, Rin, #31
4765		rsbs	Rlo, Rin, #0
4766		rsc	Rhi, Rhi, #0 (thumb2: sbc Rhi, Rhi, Rhi, lsl #1).  */
4767	rtx cc_reg = gen_rtx_REG (CC_Cmode, CC_REGNUM);
4768
4769	emit_insn (gen_rtx_SET (high,
4770				gen_rtx_ASHIFTRT (SImode, operands[1],
4771						  GEN_INT (31))));
4772
4773	emit_insn (gen_subsi3_compare (low, const0_rtx, operands[1]));
4774	if (TARGET_ARM)
4775	  emit_insn (gen_rtx_SET (high,
4776				  gen_rtx_MINUS (SImode,
4777						 gen_rtx_MINUS (SImode,
4778								const0_rtx,
4779								high),
4780						 gen_rtx_LTU (SImode,
4781							      cc_reg,
4782							      const0_rtx))));
4783	else
4784	  {
4785	    rtx two_x = gen_rtx_ASHIFT (SImode, high, GEN_INT (1));
4786	    emit_insn (gen_rtx_SET (high,
4787				    gen_rtx_MINUS (SImode,
4788						   gen_rtx_MINUS (SImode,
4789								  high,
4790								  two_x),
4791						   gen_rtx_LTU (SImode,
4792								cc_reg,
4793								const0_rtx))));
4794	  }
4795      }
4796    else
4797      {
4798	/* No overlap, or overlap on high word.  Use:
4799		rsb	Rlo, Rin, #0
4800		bic	Rhi, Rlo, Rin
4801		asr	Rhi, Rhi, #31
4802	   Flags not needed for this sequence.  */
4803	emit_insn (gen_rtx_SET (low, gen_rtx_NEG (SImode, operands[1])));
4804	emit_insn (gen_rtx_SET (high,
4805				gen_rtx_AND (SImode,
4806					     gen_rtx_NOT (SImode, operands[1]),
4807					     low)));
4808	emit_insn (gen_rtx_SET (high,
4809				gen_rtx_ASHIFTRT (SImode, high,
4810						  GEN_INT (31))));
4811      }
4812    DONE;
4813  }
4814  [(set_attr "length" "12")
4815   (set_attr "arch" "t2,*")
4816   (set_attr "type" "multiple")]
4817)
4818
4819(define_insn_and_split "*negdi_zero_extendsidi"
4820  [(set (match_operand:DI 0 "s_register_operand" "=r,&r")
4821	(neg:DI (zero_extend:DI (match_operand:SI 1 "s_register_operand" "0,r"))))
4822   (clobber (reg:CC CC_REGNUM))]
4823  "TARGET_32BIT"
4824  "#" ; "rsbs\\t%Q0, %1, #0\;sbc\\t%R0,%R0,%R0"
4825      ;; Don't care what register is input to sbc,
4826      ;; since we just need to propagate the carry.
4827  "&& reload_completed"
4828  [(parallel [(set (reg:CC CC_REGNUM)
4829                   (compare:CC (const_int 0) (match_dup 1)))
4830              (set (match_dup 0) (minus:SI (const_int 0) (match_dup 1)))])
4831   (set (match_dup 2) (minus:SI (minus:SI (match_dup 2) (match_dup 2))
4832                                (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))]
4833  {
4834    operands[2] = gen_highpart (SImode, operands[0]);
4835    operands[0] = gen_lowpart (SImode, operands[0]);
4836  }
4837  [(set_attr "conds" "clob")
4838   (set_attr "length" "8")
4839   (set_attr "type" "multiple")]   ;; length in thumb is 4
4840)
4841
4842;; abssi2 doesn't really clobber the condition codes if a different register
4843;; is being set.  To keep things simple, assume during rtl manipulations that
4844;; it does, but tell the final scan operator the truth.  Similarly for
4845;; (neg (abs...))
4846
4847(define_expand "abssi2"
4848  [(parallel
4849    [(set (match_operand:SI         0 "s_register_operand" "")
4850	  (abs:SI (match_operand:SI 1 "s_register_operand" "")))
4851     (clobber (match_dup 2))])]
4852  "TARGET_EITHER"
4853  "
4854  if (TARGET_THUMB1)
4855    operands[2] = gen_rtx_SCRATCH (SImode);
4856  else
4857    operands[2] = gen_rtx_REG (CCmode, CC_REGNUM);
4858")
4859
4860(define_insn_and_split "*arm_abssi2"
4861  [(set (match_operand:SI 0 "s_register_operand" "=r,&r")
4862	(abs:SI (match_operand:SI 1 "s_register_operand" "0,r")))
4863   (clobber (reg:CC CC_REGNUM))]
4864  "TARGET_ARM"
4865  "#"
4866  "&& reload_completed"
4867  [(const_int 0)]
4868  {
4869   /* if (which_alternative == 0) */
4870   if (REGNO(operands[0]) == REGNO(operands[1]))
4871     {
4872      /* Emit the pattern:
4873         cmp\\t%0, #0\;rsblt\\t%0, %0, #0
4874         [(set (reg:CC CC_REGNUM)
4875               (compare:CC (match_dup 0) (const_int 0)))
4876          (cond_exec (lt:CC (reg:CC CC_REGNUM) (const_int 0))
4877                     (set (match_dup 0) (minus:SI (const_int 0) (match_dup 1))))]
4878      */
4879      emit_insn (gen_rtx_SET (gen_rtx_REG (CCmode, CC_REGNUM),
4880                              gen_rtx_COMPARE (CCmode, operands[0], const0_rtx)));
4881      emit_insn (gen_rtx_COND_EXEC (VOIDmode,
4882                                    (gen_rtx_LT (SImode,
4883                                                 gen_rtx_REG (CCmode, CC_REGNUM),
4884                                                 const0_rtx)),
4885                                    (gen_rtx_SET (operands[0],
4886                                                  (gen_rtx_MINUS (SImode,
4887                                                                  const0_rtx,
4888                                                                  operands[1]))))));
4889      DONE;
4890     }
4891   else
4892     {
4893      /* Emit the pattern:
4894         alt1: eor%?\\t%0, %1, %1, asr #31\;sub%?\\t%0, %0, %1, asr #31
4895         [(set (match_dup 0)
4896               (xor:SI (match_dup 1)
4897                       (ashiftrt:SI (match_dup 1) (const_int 31))))
4898          (set (match_dup 0)
4899               (minus:SI (match_dup 0)
4900                      (ashiftrt:SI (match_dup 1) (const_int 31))))]
4901      */
4902      emit_insn (gen_rtx_SET (operands[0],
4903                              gen_rtx_XOR (SImode,
4904                                           gen_rtx_ASHIFTRT (SImode,
4905                                                             operands[1],
4906                                                             GEN_INT (31)),
4907                                           operands[1])));
4908      emit_insn (gen_rtx_SET (operands[0],
4909                              gen_rtx_MINUS (SImode,
4910                                             operands[0],
4911                                             gen_rtx_ASHIFTRT (SImode,
4912                                                               operands[1],
4913                                                               GEN_INT (31)))));
4914      DONE;
4915     }
4916  }
4917  [(set_attr "conds" "clob,*")
4918   (set_attr "shift" "1")
4919   (set_attr "predicable" "no, yes")
4920   (set_attr "length" "8")
4921   (set_attr "type" "multiple")]
4922)
4923
4924(define_insn_and_split "*arm_neg_abssi2"
4925  [(set (match_operand:SI 0 "s_register_operand" "=r,&r")
4926	(neg:SI (abs:SI (match_operand:SI 1 "s_register_operand" "0,r"))))
4927   (clobber (reg:CC CC_REGNUM))]
4928  "TARGET_ARM"
4929  "#"
4930  "&& reload_completed"
4931  [(const_int 0)]
4932  {
4933   /* if (which_alternative == 0) */
4934   if (REGNO (operands[0]) == REGNO (operands[1]))
4935     {
4936      /* Emit the pattern:
4937         cmp\\t%0, #0\;rsbgt\\t%0, %0, #0
4938      */
4939      emit_insn (gen_rtx_SET (gen_rtx_REG (CCmode, CC_REGNUM),
4940                              gen_rtx_COMPARE (CCmode, operands[0], const0_rtx)));
4941      emit_insn (gen_rtx_COND_EXEC (VOIDmode,
4942                                    gen_rtx_GT (SImode,
4943                                                gen_rtx_REG (CCmode, CC_REGNUM),
4944                                                const0_rtx),
4945                                    gen_rtx_SET (operands[0],
4946                                                 (gen_rtx_MINUS (SImode,
4947                                                                 const0_rtx,
4948                                                                 operands[1])))));
4949     }
4950   else
4951     {
4952      /* Emit the pattern:
4953         eor%?\\t%0, %1, %1, asr #31\;rsb%?\\t%0, %0, %1, asr #31
4954      */
4955      emit_insn (gen_rtx_SET (operands[0],
4956                              gen_rtx_XOR (SImode,
4957                                           gen_rtx_ASHIFTRT (SImode,
4958                                                             operands[1],
4959                                                             GEN_INT (31)),
4960                                           operands[1])));
4961      emit_insn (gen_rtx_SET (operands[0],
4962                              gen_rtx_MINUS (SImode,
4963                                             gen_rtx_ASHIFTRT (SImode,
4964                                                               operands[1],
4965                                                               GEN_INT (31)),
4966                                             operands[0])));
4967     }
4968   DONE;
4969  }
4970  [(set_attr "conds" "clob,*")
4971   (set_attr "shift" "1")
4972   (set_attr "predicable" "no, yes")
4973   (set_attr "length" "8")
4974   (set_attr "type" "multiple")]
4975)
4976
4977(define_expand "abssf2"
4978  [(set (match_operand:SF         0 "s_register_operand" "")
4979	(abs:SF (match_operand:SF 1 "s_register_operand" "")))]
4980  "TARGET_32BIT && TARGET_HARD_FLOAT"
4981  "")
4982
4983(define_expand "absdf2"
4984  [(set (match_operand:DF         0 "s_register_operand" "")
4985	(abs:DF (match_operand:DF 1 "s_register_operand" "")))]
4986  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
4987  "")
4988
4989(define_expand "sqrtsf2"
4990  [(set (match_operand:SF 0 "s_register_operand" "")
4991	(sqrt:SF (match_operand:SF 1 "s_register_operand" "")))]
4992  "TARGET_32BIT && TARGET_HARD_FLOAT"
4993  "")
4994
4995(define_expand "sqrtdf2"
4996  [(set (match_operand:DF 0 "s_register_operand" "")
4997	(sqrt:DF (match_operand:DF 1 "s_register_operand" "")))]
4998  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP_DOUBLE"
4999  "")
5000
5001(define_expand "one_cmpldi2"
5002  [(set (match_operand:DI 0 "s_register_operand" "")
5003	(not:DI (match_operand:DI 1 "s_register_operand" "")))]
5004  "TARGET_32BIT"
5005  "
5006  if (!TARGET_NEON && !TARGET_IWMMXT)
5007    {
5008      rtx low  = simplify_gen_unary (NOT, SImode,
5009				     gen_lowpart (SImode, operands[1]),
5010				     SImode);
5011      rtx high = simplify_gen_unary (NOT, SImode,
5012				     gen_highpart_mode (SImode, DImode,
5013							operands[1]),
5014				     SImode);
5015
5016      emit_insn (gen_rtx_SET (gen_lowpart (SImode, operands[0]), low));
5017      emit_insn (gen_rtx_SET (gen_highpart (SImode, operands[0]), high));
5018
5019      DONE;
5020    }
5021  /* Otherwise expand pattern as above.  */
5022  "
5023)
5024
5025(define_insn_and_split "*one_cmpldi2_insn"
5026  [(set (match_operand:DI 0 "s_register_operand"	 "=w,&r,&r,?w")
5027	(not:DI (match_operand:DI 1 "s_register_operand" " w, 0, r, w")))]
5028  "TARGET_32BIT"
5029  "@
5030   vmvn\t%P0, %P1
5031   #
5032   #
5033   vmvn\t%P0, %P1"
5034  "TARGET_32BIT && reload_completed
5035   && arm_general_register_operand (operands[0], DImode)"
5036  [(set (match_dup 0) (not:SI (match_dup 1)))
5037   (set (match_dup 2) (not:SI (match_dup 3)))]
5038  "
5039  {
5040    operands[2] = gen_highpart (SImode, operands[0]);
5041    operands[0] = gen_lowpart (SImode, operands[0]);
5042    operands[3] = gen_highpart (SImode, operands[1]);
5043    operands[1] = gen_lowpart (SImode, operands[1]);
5044  }"
5045  [(set_attr "length" "*,8,8,*")
5046   (set_attr "predicable" "no,yes,yes,no")
5047   (set_attr "type" "neon_move,multiple,multiple,neon_move")
5048   (set_attr "arch" "neon_for_64bits,*,*,avoid_neon_for_64bits")]
5049)
5050
5051(define_expand "one_cmplsi2"
5052  [(set (match_operand:SI         0 "s_register_operand" "")
5053	(not:SI (match_operand:SI 1 "s_register_operand" "")))]
5054  "TARGET_EITHER"
5055  ""
5056)
5057
5058(define_insn "*arm_one_cmplsi2"
5059  [(set (match_operand:SI         0 "s_register_operand" "=l,r")
5060	(not:SI (match_operand:SI 1 "s_register_operand"  "l,r")))]
5061  "TARGET_32BIT"
5062  "mvn%?\\t%0, %1"
5063  [(set_attr "predicable" "yes")
5064   (set_attr "predicable_short_it" "yes,no")
5065   (set_attr "arch" "t2,*")
5066   (set_attr "length" "4")
5067   (set_attr "type" "mvn_reg")]
5068)
5069
5070(define_insn "*notsi_compare0"
5071  [(set (reg:CC_NOOV CC_REGNUM)
5072	(compare:CC_NOOV (not:SI (match_operand:SI 1 "s_register_operand" "r"))
5073			 (const_int 0)))
5074   (set (match_operand:SI 0 "s_register_operand" "=r")
5075	(not:SI (match_dup 1)))]
5076  "TARGET_32BIT"
5077  "mvns%?\\t%0, %1"
5078  [(set_attr "conds" "set")
5079   (set_attr "type" "mvn_reg")]
5080)
5081
5082(define_insn "*notsi_compare0_scratch"
5083  [(set (reg:CC_NOOV CC_REGNUM)
5084	(compare:CC_NOOV (not:SI (match_operand:SI 1 "s_register_operand" "r"))
5085			 (const_int 0)))
5086   (clobber (match_scratch:SI 0 "=r"))]
5087  "TARGET_32BIT"
5088  "mvns%?\\t%0, %1"
5089  [(set_attr "conds" "set")
5090   (set_attr "type" "mvn_reg")]
5091)
5092
5093;; Fixed <--> Floating conversion insns
5094
5095(define_expand "floatsihf2"
5096  [(set (match_operand:HF           0 "general_operand" "")
5097	(float:HF (match_operand:SI 1 "general_operand" "")))]
5098  "TARGET_EITHER"
5099  "
5100  {
5101    rtx op1 = gen_reg_rtx (SFmode);
5102    expand_float (op1, operands[1], 0);
5103    op1 = convert_to_mode (HFmode, op1, 0);
5104    emit_move_insn (operands[0], op1);
5105    DONE;
5106  }"
5107)
5108
5109(define_expand "floatdihf2"
5110  [(set (match_operand:HF           0 "general_operand" "")
5111	(float:HF (match_operand:DI 1 "general_operand" "")))]
5112  "TARGET_EITHER"
5113  "
5114  {
5115    rtx op1 = gen_reg_rtx (SFmode);
5116    expand_float (op1, operands[1], 0);
5117    op1 = convert_to_mode (HFmode, op1, 0);
5118    emit_move_insn (operands[0], op1);
5119    DONE;
5120  }"
5121)
5122
5123(define_expand "floatsisf2"
5124  [(set (match_operand:SF           0 "s_register_operand" "")
5125	(float:SF (match_operand:SI 1 "s_register_operand" "")))]
5126  "TARGET_32BIT && TARGET_HARD_FLOAT"
5127  "
5128")
5129
5130(define_expand "floatsidf2"
5131  [(set (match_operand:DF           0 "s_register_operand" "")
5132	(float:DF (match_operand:SI 1 "s_register_operand" "")))]
5133  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
5134  "
5135")
5136
5137(define_expand "fix_trunchfsi2"
5138  [(set (match_operand:SI         0 "general_operand" "")
5139	(fix:SI (fix:HF (match_operand:HF 1 "general_operand"  ""))))]
5140  "TARGET_EITHER"
5141  "
5142  {
5143    rtx op1 = convert_to_mode (SFmode, operands[1], 0);
5144    expand_fix (operands[0], op1, 0);
5145    DONE;
5146  }"
5147)
5148
5149(define_expand "fix_trunchfdi2"
5150  [(set (match_operand:DI         0 "general_operand" "")
5151	(fix:DI (fix:HF (match_operand:HF 1 "general_operand"  ""))))]
5152  "TARGET_EITHER"
5153  "
5154  {
5155    rtx op1 = convert_to_mode (SFmode, operands[1], 0);
5156    expand_fix (operands[0], op1, 0);
5157    DONE;
5158  }"
5159)
5160
5161(define_expand "fix_truncsfsi2"
5162  [(set (match_operand:SI         0 "s_register_operand" "")
5163	(fix:SI (fix:SF (match_operand:SF 1 "s_register_operand"  ""))))]
5164  "TARGET_32BIT && TARGET_HARD_FLOAT"
5165  "
5166")
5167
5168(define_expand "fix_truncdfsi2"
5169  [(set (match_operand:SI         0 "s_register_operand" "")
5170	(fix:SI (fix:DF (match_operand:DF 1 "s_register_operand"  ""))))]
5171  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
5172  "
5173")
5174
5175;; Truncation insns
5176
5177(define_expand "truncdfsf2"
5178  [(set (match_operand:SF  0 "s_register_operand" "")
5179	(float_truncate:SF
5180 	 (match_operand:DF 1 "s_register_operand" "")))]
5181  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
5182  ""
5183)
5184
5185;; DFmode to HFmode conversions on targets without a single-step hardware
5186;; instruction for it would have to go through SFmode.  This is dangerous
5187;; as it introduces double rounding.
5188;;
5189;; Disable this pattern unless we are in an unsafe math mode, or we have
5190;; a single-step instruction.
5191
5192(define_expand "truncdfhf2"
5193  [(set (match_operand:HF  0 "s_register_operand" "")
5194	(float_truncate:HF
5195	 (match_operand:DF 1 "s_register_operand" "")))]
5196  "(TARGET_EITHER && flag_unsafe_math_optimizations)
5197   || (TARGET_32BIT && TARGET_FP16_TO_DOUBLE)"
5198{
5199  /* We don't have a direct instruction for this, so we must be in
5200     an unsafe math mode, and going via SFmode.  */
5201
5202  if (!(TARGET_32BIT && TARGET_FP16_TO_DOUBLE))
5203    {
5204      rtx op1;
5205      op1 = convert_to_mode (SFmode, operands[1], 0);
5206      op1 = convert_to_mode (HFmode, op1, 0);
5207      emit_move_insn (operands[0], op1);
5208      DONE;
5209    }
5210  /* Otherwise, we will pick this up as a single instruction with
5211     no intermediary rounding.  */
5212}
5213)
5214
5215;; Zero and sign extension instructions.
5216
5217(define_insn "zero_extend<mode>di2"
5218  [(set (match_operand:DI 0 "s_register_operand" "=w,r,?r,w")
5219        (zero_extend:DI (match_operand:QHSI 1 "<qhs_zextenddi_op>"
5220					    "<qhs_zextenddi_cstr>")))]
5221  "TARGET_32BIT <qhs_zextenddi_cond>"
5222  "#"
5223  [(set_attr "length" "8,4,8,8")
5224   (set_attr "arch" "neon_for_64bits,*,*,avoid_neon_for_64bits")
5225   (set_attr "ce_count" "2")
5226   (set_attr "predicable" "yes")
5227   (set_attr "type" "multiple,mov_reg,multiple,multiple")]
5228)
5229
5230(define_insn "extend<mode>di2"
5231  [(set (match_operand:DI 0 "s_register_operand" "=w,r,?r,?r,w")
5232        (sign_extend:DI (match_operand:QHSI 1 "<qhs_extenddi_op>"
5233					    "<qhs_extenddi_cstr>")))]
5234  "TARGET_32BIT <qhs_sextenddi_cond>"
5235  "#"
5236  [(set_attr "length" "8,4,8,8,8")
5237   (set_attr "ce_count" "2")
5238   (set_attr "shift" "1")
5239   (set_attr "predicable" "yes")
5240   (set_attr "arch" "neon_for_64bits,*,a,t,avoid_neon_for_64bits")
5241   (set_attr "type" "multiple,mov_reg,multiple,multiple,multiple")]
5242)
5243
5244;; Splits for all extensions to DImode
5245(define_split
5246  [(set (match_operand:DI 0 "s_register_operand" "")
5247        (zero_extend:DI (match_operand 1 "nonimmediate_operand" "")))]
5248  "TARGET_32BIT && reload_completed && !IS_VFP_REGNUM (REGNO (operands[0]))"
5249  [(set (match_dup 0) (match_dup 1))]
5250{
5251  rtx lo_part = gen_lowpart (SImode, operands[0]);
5252  machine_mode src_mode = GET_MODE (operands[1]);
5253
5254  if (REG_P (operands[0])
5255      && !reg_overlap_mentioned_p (operands[0], operands[1]))
5256    emit_clobber (operands[0]);
5257  if (!REG_P (lo_part) || src_mode != SImode
5258      || !rtx_equal_p (lo_part, operands[1]))
5259    {
5260      if (src_mode == SImode)
5261        emit_move_insn (lo_part, operands[1]);
5262      else
5263        emit_insn (gen_rtx_SET (lo_part,
5264				gen_rtx_ZERO_EXTEND (SImode, operands[1])));
5265      operands[1] = lo_part;
5266    }
5267  operands[0] = gen_highpart (SImode, operands[0]);
5268  operands[1] = const0_rtx;
5269})
5270
5271(define_split
5272  [(set (match_operand:DI 0 "s_register_operand" "")
5273        (sign_extend:DI (match_operand 1 "nonimmediate_operand" "")))]
5274  "TARGET_32BIT && reload_completed && !IS_VFP_REGNUM (REGNO (operands[0]))"
5275  [(set (match_dup 0) (ashiftrt:SI (match_dup 1) (const_int 31)))]
5276{
5277  rtx lo_part = gen_lowpart (SImode, operands[0]);
5278  machine_mode src_mode = GET_MODE (operands[1]);
5279
5280  if (REG_P (operands[0])
5281      && !reg_overlap_mentioned_p (operands[0], operands[1]))
5282    emit_clobber (operands[0]);
5283
5284  if (!REG_P (lo_part) || src_mode != SImode
5285      || !rtx_equal_p (lo_part, operands[1]))
5286    {
5287      if (src_mode == SImode)
5288        emit_move_insn (lo_part, operands[1]);
5289      else
5290        emit_insn (gen_rtx_SET (lo_part,
5291				gen_rtx_SIGN_EXTEND (SImode, operands[1])));
5292      operands[1] = lo_part;
5293    }
5294  operands[0] = gen_highpart (SImode, operands[0]);
5295})
5296
5297(define_expand "zero_extendhisi2"
5298  [(set (match_operand:SI 0 "s_register_operand" "")
5299	(zero_extend:SI (match_operand:HI 1 "nonimmediate_operand" "")))]
5300  "TARGET_EITHER"
5301{
5302  if (TARGET_ARM && !arm_arch4 && MEM_P (operands[1]))
5303    {
5304      emit_insn (gen_movhi_bytes (operands[0], operands[1]));
5305      DONE;
5306    }
5307  if (!arm_arch6 && !MEM_P (operands[1]))
5308    {
5309      rtx t = gen_lowpart (SImode, operands[1]);
5310      rtx tmp = gen_reg_rtx (SImode);
5311      emit_insn (gen_ashlsi3 (tmp, t, GEN_INT (16)));
5312      emit_insn (gen_lshrsi3 (operands[0], tmp, GEN_INT (16)));
5313      DONE;
5314    }
5315})
5316
5317(define_split
5318  [(set (match_operand:SI 0 "s_register_operand" "")
5319	(zero_extend:SI (match_operand:HI 1 "s_register_operand" "")))]
5320  "!TARGET_THUMB2 && !arm_arch6"
5321  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 16)))
5322   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 16)))]
5323{
5324  operands[2] = gen_lowpart (SImode, operands[1]);
5325})
5326
5327(define_insn "*arm_zero_extendhisi2"
5328  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5329	(zero_extend:SI (match_operand:HI 1 "nonimmediate_operand" "r,m")))]
5330  "TARGET_ARM && arm_arch4 && !arm_arch6"
5331  "@
5332   #
5333   ldrh%?\\t%0, %1"
5334  [(set_attr "type" "alu_shift_reg,load_byte")
5335   (set_attr "predicable" "yes")]
5336)
5337
5338(define_insn "*arm_zero_extendhisi2_v6"
5339  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5340	(zero_extend:SI (match_operand:HI 1 "nonimmediate_operand" "r,Uh")))]
5341  "TARGET_ARM && arm_arch6"
5342  "@
5343   uxth%?\\t%0, %1
5344   ldrh%?\\t%0, %1"
5345  [(set_attr "predicable" "yes")
5346   (set_attr "type" "extend,load_byte")]
5347)
5348
5349(define_insn "*arm_zero_extendhisi2addsi"
5350  [(set (match_operand:SI 0 "s_register_operand" "=r")
5351	(plus:SI (zero_extend:SI (match_operand:HI 1 "s_register_operand" "r"))
5352		 (match_operand:SI 2 "s_register_operand" "r")))]
5353  "TARGET_INT_SIMD"
5354  "uxtah%?\\t%0, %2, %1"
5355  [(set_attr "type" "alu_shift_reg")
5356   (set_attr "predicable" "yes")]
5357)
5358
5359(define_expand "zero_extendqisi2"
5360  [(set (match_operand:SI 0 "s_register_operand" "")
5361	(zero_extend:SI (match_operand:QI 1 "nonimmediate_operand" "")))]
5362  "TARGET_EITHER"
5363{
5364  if (TARGET_ARM && !arm_arch6 && !MEM_P (operands[1]))
5365    {
5366      emit_insn (gen_andsi3 (operands[0],
5367			     gen_lowpart (SImode, operands[1]),
5368					  GEN_INT (255)));
5369      DONE;
5370    }
5371  if (!arm_arch6 && !MEM_P (operands[1]))
5372    {
5373      rtx t = gen_lowpart (SImode, operands[1]);
5374      rtx tmp = gen_reg_rtx (SImode);
5375      emit_insn (gen_ashlsi3 (tmp, t, GEN_INT (24)));
5376      emit_insn (gen_lshrsi3 (operands[0], tmp, GEN_INT (24)));
5377      DONE;
5378    }
5379})
5380
5381(define_split
5382  [(set (match_operand:SI 0 "s_register_operand" "")
5383	(zero_extend:SI (match_operand:QI 1 "s_register_operand" "")))]
5384  "!arm_arch6"
5385  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 24)))
5386   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 24)))]
5387{
5388  operands[2] = simplify_gen_subreg (SImode, operands[1], QImode, 0);
5389  if (TARGET_ARM)
5390    {
5391      emit_insn (gen_andsi3 (operands[0], operands[2], GEN_INT (255)));
5392      DONE;
5393    }
5394})
5395
5396(define_insn "*arm_zero_extendqisi2"
5397  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5398	(zero_extend:SI (match_operand:QI 1 "nonimmediate_operand" "r,m")))]
5399  "TARGET_ARM && !arm_arch6"
5400  "@
5401   #
5402   ldrb%?\\t%0, %1\\t%@ zero_extendqisi2"
5403  [(set_attr "length" "8,4")
5404   (set_attr "type" "alu_shift_reg,load_byte")
5405   (set_attr "predicable" "yes")]
5406)
5407
5408(define_insn "*arm_zero_extendqisi2_v6"
5409  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5410	(zero_extend:SI (match_operand:QI 1 "nonimmediate_operand" "r,Uh")))]
5411  "TARGET_ARM && arm_arch6"
5412  "@
5413   uxtb%?\\t%0, %1
5414   ldrb%?\\t%0, %1\\t%@ zero_extendqisi2"
5415  [(set_attr "type" "extend,load_byte")
5416   (set_attr "predicable" "yes")]
5417)
5418
5419(define_insn "*arm_zero_extendqisi2addsi"
5420  [(set (match_operand:SI 0 "s_register_operand" "=r")
5421	(plus:SI (zero_extend:SI (match_operand:QI 1 "s_register_operand" "r"))
5422		 (match_operand:SI 2 "s_register_operand" "r")))]
5423  "TARGET_INT_SIMD"
5424  "uxtab%?\\t%0, %2, %1"
5425  [(set_attr "predicable" "yes")
5426   (set_attr "type" "alu_shift_reg")]
5427)
5428
5429(define_split
5430  [(set (match_operand:SI 0 "s_register_operand" "")
5431	(zero_extend:SI (subreg:QI (match_operand:SI 1 "" "") 0)))
5432   (clobber (match_operand:SI 2 "s_register_operand" ""))]
5433  "TARGET_32BIT && (!MEM_P (operands[1])) && ! BYTES_BIG_ENDIAN"
5434  [(set (match_dup 2) (match_dup 1))
5435   (set (match_dup 0) (and:SI (match_dup 2) (const_int 255)))]
5436  ""
5437)
5438
5439(define_split
5440  [(set (match_operand:SI 0 "s_register_operand" "")
5441	(zero_extend:SI (subreg:QI (match_operand:SI 1 "" "") 3)))
5442   (clobber (match_operand:SI 2 "s_register_operand" ""))]
5443  "TARGET_32BIT && (!MEM_P (operands[1])) && BYTES_BIG_ENDIAN"
5444  [(set (match_dup 2) (match_dup 1))
5445   (set (match_dup 0) (and:SI (match_dup 2) (const_int 255)))]
5446  ""
5447)
5448
5449
5450(define_split
5451  [(set (match_operand:SI 0 "s_register_operand" "")
5452	(IOR_XOR:SI (and:SI (ashift:SI
5453			     (match_operand:SI 1 "s_register_operand" "")
5454			     (match_operand:SI 2 "const_int_operand" ""))
5455			    (match_operand:SI 3 "const_int_operand" ""))
5456		    (zero_extend:SI
5457		     (match_operator 5 "subreg_lowpart_operator"
5458		      [(match_operand:SI 4 "s_register_operand" "")]))))]
5459  "TARGET_32BIT
5460   && (UINTVAL (operands[3])
5461       == (GET_MODE_MASK (GET_MODE (operands[5]))
5462           & (GET_MODE_MASK (GET_MODE (operands[5]))
5463	      << (INTVAL (operands[2])))))"
5464  [(set (match_dup 0) (IOR_XOR:SI (ashift:SI (match_dup 1) (match_dup 2))
5465				  (match_dup 4)))
5466   (set (match_dup 0) (zero_extend:SI (match_dup 5)))]
5467  "operands[5] = gen_lowpart (GET_MODE (operands[5]), operands[0]);"
5468)
5469
5470(define_insn "*compareqi_eq0"
5471  [(set (reg:CC_Z CC_REGNUM)
5472	(compare:CC_Z (match_operand:QI 0 "s_register_operand" "r")
5473			 (const_int 0)))]
5474  "TARGET_32BIT"
5475  "tst%?\\t%0, #255"
5476  [(set_attr "conds" "set")
5477   (set_attr "predicable" "yes")
5478   (set_attr "type" "logic_imm")]
5479)
5480
5481(define_expand "extendhisi2"
5482  [(set (match_operand:SI 0 "s_register_operand" "")
5483	(sign_extend:SI (match_operand:HI 1 "nonimmediate_operand" "")))]
5484  "TARGET_EITHER"
5485{
5486  if (TARGET_THUMB1)
5487    {
5488      emit_insn (gen_thumb1_extendhisi2 (operands[0], operands[1]));
5489      DONE;
5490    }
5491  if (MEM_P (operands[1]) && TARGET_ARM && !arm_arch4)
5492    {
5493      emit_insn (gen_extendhisi2_mem (operands[0], operands[1]));
5494      DONE;
5495    }
5496
5497  if (!arm_arch6 && !MEM_P (operands[1]))
5498    {
5499      rtx t = gen_lowpart (SImode, operands[1]);
5500      rtx tmp = gen_reg_rtx (SImode);
5501      emit_insn (gen_ashlsi3 (tmp, t, GEN_INT (16)));
5502      emit_insn (gen_ashrsi3 (operands[0], tmp, GEN_INT (16)));
5503      DONE;
5504    }
5505})
5506
5507(define_split
5508  [(parallel
5509    [(set (match_operand:SI 0 "register_operand" "")
5510	  (sign_extend:SI (match_operand:HI 1 "register_operand" "")))
5511     (clobber (match_scratch:SI 2 ""))])]
5512  "!arm_arch6"
5513  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 16)))
5514   (set (match_dup 0) (ashiftrt:SI (match_dup 0) (const_int 16)))]
5515{
5516  operands[2] = simplify_gen_subreg (SImode, operands[1], HImode, 0);
5517})
5518
5519;; This pattern will only be used when ldsh is not available
5520(define_expand "extendhisi2_mem"
5521  [(set (match_dup 2) (zero_extend:SI (match_operand:HI 1 "" "")))
5522   (set (match_dup 3)
5523	(zero_extend:SI (match_dup 7)))
5524   (set (match_dup 6) (ashift:SI (match_dup 4) (const_int 24)))
5525   (set (match_operand:SI 0 "" "")
5526	(ior:SI (ashiftrt:SI (match_dup 6) (const_int 16)) (match_dup 5)))]
5527  "TARGET_ARM"
5528  "
5529  {
5530    rtx mem1, mem2;
5531    rtx addr = copy_to_mode_reg (SImode, XEXP (operands[1], 0));
5532
5533    mem1 = change_address (operands[1], QImode, addr);
5534    mem2 = change_address (operands[1], QImode,
5535			   plus_constant (Pmode, addr, 1));
5536    operands[0] = gen_lowpart (SImode, operands[0]);
5537    operands[1] = mem1;
5538    operands[2] = gen_reg_rtx (SImode);
5539    operands[3] = gen_reg_rtx (SImode);
5540    operands[6] = gen_reg_rtx (SImode);
5541    operands[7] = mem2;
5542
5543    if (BYTES_BIG_ENDIAN)
5544      {
5545	operands[4] = operands[2];
5546	operands[5] = operands[3];
5547      }
5548    else
5549      {
5550	operands[4] = operands[3];
5551	operands[5] = operands[2];
5552      }
5553  }"
5554)
5555
5556(define_split
5557  [(set (match_operand:SI 0 "register_operand" "")
5558	(sign_extend:SI (match_operand:HI 1 "register_operand" "")))]
5559  "!arm_arch6"
5560  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 16)))
5561   (set (match_dup 0) (ashiftrt:SI (match_dup 0) (const_int 16)))]
5562{
5563  operands[2] = simplify_gen_subreg (SImode, operands[1], HImode, 0);
5564})
5565
5566(define_insn "*arm_extendhisi2"
5567  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5568	(sign_extend:SI (match_operand:HI 1 "nonimmediate_operand" "r,Uh")))]
5569  "TARGET_ARM && arm_arch4 && !arm_arch6"
5570  "@
5571   #
5572   ldrsh%?\\t%0, %1"
5573  [(set_attr "length" "8,4")
5574   (set_attr "type" "alu_shift_reg,load_byte")
5575   (set_attr "predicable" "yes")]
5576)
5577
5578;; ??? Check Thumb-2 pool range
5579(define_insn "*arm_extendhisi2_v6"
5580  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5581	(sign_extend:SI (match_operand:HI 1 "nonimmediate_operand" "r,Uh")))]
5582  "TARGET_32BIT && arm_arch6"
5583  "@
5584   sxth%?\\t%0, %1
5585   ldrsh%?\\t%0, %1"
5586  [(set_attr "type" "extend,load_byte")
5587   (set_attr "predicable" "yes")]
5588)
5589
5590(define_insn "*arm_extendhisi2addsi"
5591  [(set (match_operand:SI 0 "s_register_operand" "=r")
5592	(plus:SI (sign_extend:SI (match_operand:HI 1 "s_register_operand" "r"))
5593		 (match_operand:SI 2 "s_register_operand" "r")))]
5594  "TARGET_INT_SIMD"
5595  "sxtah%?\\t%0, %2, %1"
5596  [(set_attr "type" "alu_shift_reg")]
5597)
5598
5599(define_expand "extendqihi2"
5600  [(set (match_dup 2)
5601	(ashift:SI (match_operand:QI 1 "arm_reg_or_extendqisi_mem_op" "")
5602		   (const_int 24)))
5603   (set (match_operand:HI 0 "s_register_operand" "")
5604	(ashiftrt:SI (match_dup 2)
5605		     (const_int 24)))]
5606  "TARGET_ARM"
5607  "
5608  {
5609    if (arm_arch4 && MEM_P (operands[1]))
5610      {
5611	emit_insn (gen_rtx_SET (operands[0],
5612				gen_rtx_SIGN_EXTEND (HImode, operands[1])));
5613	DONE;
5614      }
5615    if (!s_register_operand (operands[1], QImode))
5616      operands[1] = copy_to_mode_reg (QImode, operands[1]);
5617    operands[0] = gen_lowpart (SImode, operands[0]);
5618    operands[1] = gen_lowpart (SImode, operands[1]);
5619    operands[2] = gen_reg_rtx (SImode);
5620  }"
5621)
5622
5623(define_insn "*arm_extendqihi_insn"
5624  [(set (match_operand:HI 0 "s_register_operand" "=r")
5625	(sign_extend:HI (match_operand:QI 1 "arm_extendqisi_mem_op" "Uq")))]
5626  "TARGET_ARM && arm_arch4"
5627  "ldrsb%?\\t%0, %1"
5628  [(set_attr "type" "load_byte")
5629   (set_attr "predicable" "yes")]
5630)
5631
5632(define_expand "extendqisi2"
5633  [(set (match_operand:SI 0 "s_register_operand" "")
5634	(sign_extend:SI (match_operand:QI 1 "arm_reg_or_extendqisi_mem_op" "")))]
5635  "TARGET_EITHER"
5636{
5637  if (!arm_arch4 && MEM_P (operands[1]))
5638    operands[1] = copy_to_mode_reg (QImode, operands[1]);
5639
5640  if (!arm_arch6 && !MEM_P (operands[1]))
5641    {
5642      rtx t = gen_lowpart (SImode, operands[1]);
5643      rtx tmp = gen_reg_rtx (SImode);
5644      emit_insn (gen_ashlsi3 (tmp, t, GEN_INT (24)));
5645      emit_insn (gen_ashrsi3 (operands[0], tmp, GEN_INT (24)));
5646      DONE;
5647    }
5648})
5649
5650(define_split
5651  [(set (match_operand:SI 0 "register_operand" "")
5652	(sign_extend:SI (match_operand:QI 1 "register_operand" "")))]
5653  "!arm_arch6"
5654  [(set (match_dup 0) (ashift:SI (match_dup 2) (const_int 24)))
5655   (set (match_dup 0) (ashiftrt:SI (match_dup 0) (const_int 24)))]
5656{
5657  operands[2] = simplify_gen_subreg (SImode, operands[1], QImode, 0);
5658})
5659
5660(define_insn "*arm_extendqisi"
5661  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5662	(sign_extend:SI (match_operand:QI 1 "arm_reg_or_extendqisi_mem_op" "r,Uq")))]
5663  "TARGET_ARM && arm_arch4 && !arm_arch6"
5664  "@
5665   #
5666   ldrsb%?\\t%0, %1"
5667  [(set_attr "length" "8,4")
5668   (set_attr "type" "alu_shift_reg,load_byte")
5669   (set_attr "predicable" "yes")]
5670)
5671
5672(define_insn "*arm_extendqisi_v6"
5673  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
5674	(sign_extend:SI
5675	 (match_operand:QI 1 "arm_reg_or_extendqisi_mem_op" "r,Uq")))]
5676  "TARGET_ARM && arm_arch6"
5677  "@
5678   sxtb%?\\t%0, %1
5679   ldrsb%?\\t%0, %1"
5680  [(set_attr "type" "extend,load_byte")
5681   (set_attr "predicable" "yes")]
5682)
5683
5684(define_insn "*arm_extendqisi2addsi"
5685  [(set (match_operand:SI 0 "s_register_operand" "=r")
5686	(plus:SI (sign_extend:SI (match_operand:QI 1 "s_register_operand" "r"))
5687		 (match_operand:SI 2 "s_register_operand" "r")))]
5688  "TARGET_INT_SIMD"
5689  "sxtab%?\\t%0, %2, %1"
5690  [(set_attr "type" "alu_shift_reg")
5691   (set_attr "predicable" "yes")]
5692)
5693
5694(define_expand "extendsfdf2"
5695  [(set (match_operand:DF                  0 "s_register_operand" "")
5696	(float_extend:DF (match_operand:SF 1 "s_register_operand"  "")))]
5697  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
5698  ""
5699)
5700
5701;; HFmode -> DFmode conversions where we don't have an instruction for it
5702;; must go through SFmode.
5703;;
5704;; This is always safe for an extend.
5705
5706(define_expand "extendhfdf2"
5707  [(set (match_operand:DF		   0 "s_register_operand" "")
5708	(float_extend:DF (match_operand:HF 1 "s_register_operand" "")))]
5709  "TARGET_EITHER"
5710{
5711  /* We don't have a direct instruction for this, so go via SFmode.  */
5712  if (!(TARGET_32BIT && TARGET_FP16_TO_DOUBLE))
5713    {
5714      rtx op1;
5715      op1 = convert_to_mode (SFmode, operands[1], 0);
5716      op1 = convert_to_mode (DFmode, op1, 0);
5717      emit_insn (gen_movdf (operands[0], op1));
5718      DONE;
5719    }
5720  /* Otherwise, we're done producing RTL and will pick up the correct
5721     pattern to do this with one rounding-step in a single instruction.  */
5722}
5723)
5724
5725;; Move insns (including loads and stores)
5726
5727;; XXX Just some ideas about movti.
5728;; I don't think these are a good idea on the arm, there just aren't enough
5729;; registers
5730;;(define_expand "loadti"
5731;;  [(set (match_operand:TI 0 "s_register_operand" "")
5732;;	(mem:TI (match_operand:SI 1 "address_operand" "")))]
5733;;  "" "")
5734
5735;;(define_expand "storeti"
5736;;  [(set (mem:TI (match_operand:TI 0 "address_operand" ""))
5737;;	(match_operand:TI 1 "s_register_operand" ""))]
5738;;  "" "")
5739
5740;;(define_expand "movti"
5741;;  [(set (match_operand:TI 0 "general_operand" "")
5742;;	(match_operand:TI 1 "general_operand" ""))]
5743;;  ""
5744;;  "
5745;;{
5746;;  rtx insn;
5747;;
5748;;  if (MEM_P (operands[0]) && MEM_P (operands[1]))
5749;;    operands[1] = copy_to_reg (operands[1]);
5750;;  if (MEM_P (operands[0]))
5751;;    insn = gen_storeti (XEXP (operands[0], 0), operands[1]);
5752;;  else if (MEM_P (operands[1]))
5753;;    insn = gen_loadti (operands[0], XEXP (operands[1], 0));
5754;;  else
5755;;    FAIL;
5756;;
5757;;  emit_insn (insn);
5758;;  DONE;
5759;;}")
5760
5761;; Recognize garbage generated above.
5762
5763;;(define_insn ""
5764;;  [(set (match_operand:TI 0 "general_operand" "=r,r,r,<,>,m")
5765;;	(match_operand:TI 1 "general_operand" "<,>,m,r,r,r"))]
5766;;  ""
5767;;  "*
5768;;  {
5769;;    register mem = (which_alternative < 3);
5770;;    register const char *template;
5771;;
5772;;    operands[mem] = XEXP (operands[mem], 0);
5773;;    switch (which_alternative)
5774;;      {
5775;;      case 0: template = \"ldmdb\\t%1!, %M0\"; break;
5776;;      case 1: template = \"ldmia\\t%1!, %M0\"; break;
5777;;      case 2: template = \"ldmia\\t%1, %M0\"; break;
5778;;      case 3: template = \"stmdb\\t%0!, %M1\"; break;
5779;;      case 4: template = \"stmia\\t%0!, %M1\"; break;
5780;;      case 5: template = \"stmia\\t%0, %M1\"; break;
5781;;      }
5782;;    output_asm_insn (template, operands);
5783;;    return \"\";
5784;;  }")
5785
5786(define_expand "movdi"
5787  [(set (match_operand:DI 0 "general_operand" "")
5788	(match_operand:DI 1 "general_operand" ""))]
5789  "TARGET_EITHER"
5790  "
5791  if (can_create_pseudo_p ())
5792    {
5793      if (!REG_P (operands[0]))
5794	operands[1] = force_reg (DImode, operands[1]);
5795    }
5796  if (REG_P (operands[0]) && REGNO (operands[0]) <= LAST_ARM_REGNUM
5797      && !targetm.hard_regno_mode_ok (REGNO (operands[0]), DImode))
5798    {
5799      /* Avoid LDRD's into an odd-numbered register pair in ARM state
5800	 when expanding function calls.  */
5801      gcc_assert (can_create_pseudo_p ());
5802      if (MEM_P (operands[1]) && MEM_VOLATILE_P (operands[1]))
5803	{
5804	  /* Perform load into legal reg pair first, then move.  */
5805	  rtx reg = gen_reg_rtx (DImode);
5806	  emit_insn (gen_movdi (reg, operands[1]));
5807	  operands[1] = reg;
5808	}
5809      emit_move_insn (gen_lowpart (SImode, operands[0]),
5810		      gen_lowpart (SImode, operands[1]));
5811      emit_move_insn (gen_highpart (SImode, operands[0]),
5812		      gen_highpart (SImode, operands[1]));
5813      DONE;
5814    }
5815  else if (REG_P (operands[1]) && REGNO (operands[1]) <= LAST_ARM_REGNUM
5816	   && !targetm.hard_regno_mode_ok (REGNO (operands[1]), DImode))
5817    {
5818      /* Avoid STRD's from an odd-numbered register pair in ARM state
5819	 when expanding function prologue.  */
5820      gcc_assert (can_create_pseudo_p ());
5821      rtx split_dest = (MEM_P (operands[0]) && MEM_VOLATILE_P (operands[0]))
5822		       ? gen_reg_rtx (DImode)
5823		       : operands[0];
5824      emit_move_insn (gen_lowpart (SImode, split_dest),
5825		      gen_lowpart (SImode, operands[1]));
5826      emit_move_insn (gen_highpart (SImode, split_dest),
5827		      gen_highpart (SImode, operands[1]));
5828      if (split_dest != operands[0])
5829	emit_insn (gen_movdi (operands[0], split_dest));
5830      DONE;
5831    }
5832  "
5833)
5834
5835(define_insn "*arm_movdi"
5836  [(set (match_operand:DI 0 "nonimmediate_di_operand" "=r, r, r, q, m")
5837	(match_operand:DI 1 "di_operand"              "rDa,Db,Dc,mi,q"))]
5838  "TARGET_32BIT
5839   && !(TARGET_HARD_FLOAT)
5840   && !TARGET_IWMMXT
5841   && (   register_operand (operands[0], DImode)
5842       || register_operand (operands[1], DImode))"
5843  "*
5844  switch (which_alternative)
5845    {
5846    case 0:
5847    case 1:
5848    case 2:
5849      return \"#\";
5850    default:
5851      return output_move_double (operands, true, NULL);
5852    }
5853  "
5854  [(set_attr "length" "8,12,16,8,8")
5855   (set_attr "type" "multiple,multiple,multiple,load_8,store_8")
5856   (set_attr "arm_pool_range" "*,*,*,1020,*")
5857   (set_attr "arm_neg_pool_range" "*,*,*,1004,*")
5858   (set_attr "thumb2_pool_range" "*,*,*,4094,*")
5859   (set_attr "thumb2_neg_pool_range" "*,*,*,0,*")]
5860)
5861
5862(define_split
5863  [(set (match_operand:ANY64 0 "arm_general_register_operand" "")
5864	(match_operand:ANY64 1 "immediate_operand" ""))]
5865  "TARGET_32BIT
5866   && reload_completed
5867   && (arm_disable_literal_pool
5868       || (arm_const_double_inline_cost (operands[1])
5869	   <= arm_max_const_double_inline_cost ()))"
5870  [(const_int 0)]
5871  "
5872  arm_split_constant (SET, SImode, curr_insn,
5873		      INTVAL (gen_lowpart (SImode, operands[1])),
5874		      gen_lowpart (SImode, operands[0]), NULL_RTX, 0);
5875  arm_split_constant (SET, SImode, curr_insn,
5876		      INTVAL (gen_highpart_mode (SImode,
5877						 GET_MODE (operands[0]),
5878						 operands[1])),
5879		      gen_highpart (SImode, operands[0]), NULL_RTX, 0);
5880  DONE;
5881  "
5882)
5883
5884; If optimizing for size, or if we have load delay slots, then
5885; we want to split the constant into two separate operations.
5886; In both cases this may split a trivial part into a single data op
5887; leaving a single complex constant to load.  We can also get longer
5888; offsets in a LDR which means we get better chances of sharing the pool
5889; entries.  Finally, we can normally do a better job of scheduling
5890; LDR instructions than we can with LDM.
5891; This pattern will only match if the one above did not.
5892(define_split
5893  [(set (match_operand:ANY64 0 "arm_general_register_operand" "")
5894	(match_operand:ANY64 1 "const_double_operand" ""))]
5895  "TARGET_ARM && reload_completed
5896   && arm_const_double_by_parts (operands[1])"
5897  [(set (match_dup 0) (match_dup 1))
5898   (set (match_dup 2) (match_dup 3))]
5899  "
5900  operands[2] = gen_highpart (SImode, operands[0]);
5901  operands[3] = gen_highpart_mode (SImode, GET_MODE (operands[0]),
5902				   operands[1]);
5903  operands[0] = gen_lowpart (SImode, operands[0]);
5904  operands[1] = gen_lowpart (SImode, operands[1]);
5905  "
5906)
5907
5908(define_split
5909  [(set (match_operand:ANY64 0 "arm_general_register_operand" "")
5910	(match_operand:ANY64 1 "arm_general_register_operand" ""))]
5911  "TARGET_EITHER && reload_completed"
5912  [(set (match_dup 0) (match_dup 1))
5913   (set (match_dup 2) (match_dup 3))]
5914  "
5915  operands[2] = gen_highpart (SImode, operands[0]);
5916  operands[3] = gen_highpart (SImode, operands[1]);
5917  operands[0] = gen_lowpart (SImode, operands[0]);
5918  operands[1] = gen_lowpart (SImode, operands[1]);
5919
5920  /* Handle a partial overlap.  */
5921  if (rtx_equal_p (operands[0], operands[3]))
5922    {
5923      rtx tmp0 = operands[0];
5924      rtx tmp1 = operands[1];
5925
5926      operands[0] = operands[2];
5927      operands[1] = operands[3];
5928      operands[2] = tmp0;
5929      operands[3] = tmp1;
5930    }
5931  "
5932)
5933
5934;; We can't actually do base+index doubleword loads if the index and
5935;; destination overlap.  Split here so that we at least have chance to
5936;; schedule.
5937(define_split
5938  [(set (match_operand:DI 0 "s_register_operand" "")
5939	(mem:DI (plus:SI (match_operand:SI 1 "s_register_operand" "")
5940			 (match_operand:SI 2 "s_register_operand" ""))))]
5941  "TARGET_LDRD
5942  && reg_overlap_mentioned_p (operands[0], operands[1])
5943  && reg_overlap_mentioned_p (operands[0], operands[2])"
5944  [(set (match_dup 4)
5945	(plus:SI (match_dup 1)
5946		 (match_dup 2)))
5947   (set (match_dup 0)
5948	(mem:DI (match_dup 4)))]
5949  "
5950  operands[4] = gen_rtx_REG (SImode, REGNO(operands[0]));
5951  "
5952)
5953
5954(define_expand "movsi"
5955  [(set (match_operand:SI 0 "general_operand" "")
5956        (match_operand:SI 1 "general_operand" ""))]
5957  "TARGET_EITHER"
5958  "
5959  {
5960  rtx base, offset, tmp;
5961
5962  if (TARGET_32BIT || TARGET_HAVE_MOVT)
5963    {
5964      /* Everything except mem = const or mem = mem can be done easily.  */
5965      if (MEM_P (operands[0]))
5966        operands[1] = force_reg (SImode, operands[1]);
5967      if (arm_general_register_operand (operands[0], SImode)
5968	  && CONST_INT_P (operands[1])
5969          && !(const_ok_for_arm (INTVAL (operands[1]))
5970               || const_ok_for_arm (~INTVAL (operands[1]))))
5971        {
5972	   if (DONT_EARLY_SPLIT_CONSTANT (INTVAL (operands[1]), SET))
5973	     {
5974		emit_insn (gen_rtx_SET (operands[0], operands[1]));
5975		DONE;
5976	     }
5977	  else
5978	     {
5979		arm_split_constant (SET, SImode, NULL_RTX,
5980	                            INTVAL (operands[1]), operands[0], NULL_RTX,
5981			            optimize && can_create_pseudo_p ());
5982		DONE;
5983	     }
5984        }
5985    }
5986  else /* Target doesn't have MOVT...  */
5987    {
5988      if (can_create_pseudo_p ())
5989        {
5990          if (!REG_P (operands[0]))
5991	    operands[1] = force_reg (SImode, operands[1]);
5992        }
5993    }
5994
5995  split_const (operands[1], &base, &offset);
5996  if (INTVAL (offset) != 0
5997      && targetm.cannot_force_const_mem (SImode, operands[1]))
5998    {
5999      tmp = can_create_pseudo_p () ? gen_reg_rtx (SImode) : operands[0];
6000      emit_move_insn (tmp, base);
6001      emit_insn (gen_addsi3 (operands[0], tmp, offset));
6002      DONE;
6003    }
6004
6005  tmp = can_create_pseudo_p () ? NULL_RTX : operands[0];
6006
6007  /* Recognize the case where operand[1] is a reference to thread-local
6008     data and load its address to a register.  Offsets have been split off
6009     already.  */
6010  if (arm_tls_referenced_p (operands[1]))
6011    operands[1] = legitimize_tls_address (operands[1], tmp);
6012  else if (flag_pic
6013	   && (CONSTANT_P (operands[1])
6014	       || symbol_mentioned_p (operands[1])
6015	       || label_mentioned_p (operands[1])))
6016    operands[1] =
6017      legitimize_pic_address (operands[1], SImode, tmp);
6018  }
6019  "
6020)
6021
6022;; The ARM LO_SUM and HIGH are backwards - HIGH sets the low bits, and
6023;; LO_SUM adds in the high bits.  Fortunately these are opaque operations
6024;; so this does not matter.
6025(define_insn "*arm_movt"
6026  [(set (match_operand:SI 0 "nonimmediate_operand" "=r,r")
6027	(lo_sum:SI (match_operand:SI 1 "nonimmediate_operand" "0,0")
6028		   (match_operand:SI 2 "general_operand"      "i,i")))]
6029  "TARGET_HAVE_MOVT && arm_valid_symbolic_address_p (operands[2])"
6030  "@
6031   movt%?\t%0, #:upper16:%c2
6032   movt\t%0, #:upper16:%c2"
6033  [(set_attr "arch"  "32,v8mb")
6034   (set_attr "predicable" "yes")
6035   (set_attr "length" "4")
6036   (set_attr "type" "alu_sreg")]
6037)
6038
6039(define_insn "*arm_movsi_insn"
6040  [(set (match_operand:SI 0 "nonimmediate_operand" "=rk,r,r,r,rk,m")
6041	(match_operand:SI 1 "general_operand"      "rk, I,K,j,mi,rk"))]
6042  "TARGET_ARM && !TARGET_IWMMXT && !TARGET_HARD_FLOAT
6043   && (   register_operand (operands[0], SImode)
6044       || register_operand (operands[1], SImode))"
6045  "@
6046   mov%?\\t%0, %1
6047   mov%?\\t%0, %1
6048   mvn%?\\t%0, #%B1
6049   movw%?\\t%0, %1
6050   ldr%?\\t%0, %1
6051   str%?\\t%1, %0"
6052  [(set_attr "type" "mov_reg,mov_imm,mvn_imm,mov_imm,load_4,store_4")
6053   (set_attr "predicable" "yes")
6054   (set_attr "arch" "*,*,*,v6t2,*,*")
6055   (set_attr "pool_range" "*,*,*,*,4096,*")
6056   (set_attr "neg_pool_range" "*,*,*,*,4084,*")]
6057)
6058
6059(define_split
6060  [(set (match_operand:SI 0 "arm_general_register_operand" "")
6061	(match_operand:SI 1 "const_int_operand" ""))]
6062  "(TARGET_32BIT || TARGET_HAVE_MOVT)
6063  && (!(const_ok_for_arm (INTVAL (operands[1]))
6064        || const_ok_for_arm (~INTVAL (operands[1]))))"
6065  [(clobber (const_int 0))]
6066  "
6067  arm_split_constant (SET, SImode, NULL_RTX,
6068                      INTVAL (operands[1]), operands[0], NULL_RTX, 0);
6069  DONE;
6070  "
6071)
6072
6073;; A normal way to do (symbol + offset) requires three instructions at least
6074;; (depends on how big the offset is) as below:
6075;; movw r0, #:lower16:g
6076;; movw r0, #:upper16:g
6077;; adds r0, #4
6078;;
6079;; A better way would be:
6080;; movw r0, #:lower16:g+4
6081;; movw r0, #:upper16:g+4
6082;;
6083;; The limitation of this way is that the length of offset should be a 16-bit
6084;; signed value, because current assembler only supports REL type relocation for
6085;; such case.  If the more powerful RELA type is supported in future, we should
6086;; update this pattern to go with better way.
6087(define_split
6088  [(set (match_operand:SI 0 "arm_general_register_operand" "")
6089	(const:SI (plus:SI (match_operand:SI 1 "general_operand" "")
6090			   (match_operand:SI 2 "const_int_operand" ""))))]
6091  "TARGET_THUMB
6092   && TARGET_HAVE_MOVT
6093   && arm_disable_literal_pool
6094   && reload_completed
6095   && GET_CODE (operands[1]) == SYMBOL_REF"
6096  [(clobber (const_int 0))]
6097  "
6098    int offset = INTVAL (operands[2]);
6099
6100    if (offset < -0x8000 || offset > 0x7fff)
6101      {
6102	arm_emit_movpair (operands[0], operands[1]);
6103	emit_insn (gen_rtx_SET (operands[0],
6104				gen_rtx_PLUS (SImode, operands[0], operands[2])));
6105      }
6106    else
6107      {
6108	rtx op = gen_rtx_CONST (SImode,
6109				gen_rtx_PLUS (SImode, operands[1], operands[2]));
6110	arm_emit_movpair (operands[0], op);
6111      }
6112  "
6113)
6114
6115;; Split symbol_refs at the later stage (after cprop), instead of generating
6116;; movt/movw pair directly at expand.  Otherwise corresponding high_sum
6117;; and lo_sum would be merged back into memory load at cprop.  However,
6118;; if the default is to prefer movt/movw rather than a load from the constant
6119;; pool, the performance is better.
6120(define_split
6121  [(set (match_operand:SI 0 "arm_general_register_operand" "")
6122       (match_operand:SI 1 "general_operand" ""))]
6123  "TARGET_USE_MOVT && GET_CODE (operands[1]) == SYMBOL_REF
6124   && !flag_pic && !target_word_relocations
6125   && !arm_tls_referenced_p (operands[1])"
6126  [(clobber (const_int 0))]
6127{
6128  arm_emit_movpair (operands[0], operands[1]);
6129  DONE;
6130})
6131
6132;; When generating pic, we need to load the symbol offset into a register.
6133;; So that the optimizer does not confuse this with a normal symbol load
6134;; we use an unspec.  The offset will be loaded from a constant pool entry,
6135;; since that is the only type of relocation we can use.
6136
6137;; Wrap calculation of the whole PIC address in a single pattern for the
6138;; benefit of optimizers, particularly, PRE and HOIST.  Calculation of
6139;; a PIC address involves two loads from memory, so we want to CSE it
6140;; as often as possible.
6141;; This pattern will be split into one of the pic_load_addr_* patterns
6142;; and a move after GCSE optimizations.
6143;;
6144;; Note: Update arm.c: legitimize_pic_address() when changing this pattern.
6145(define_expand "calculate_pic_address"
6146  [(set (match_operand:SI 0 "register_operand" "")
6147	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "")
6148			 (unspec:SI [(match_operand:SI 2 "" "")]
6149				    UNSPEC_PIC_SYM))))]
6150  "flag_pic"
6151)
6152
6153;; Split calculate_pic_address into pic_load_addr_* and a move.
6154(define_split
6155  [(set (match_operand:SI 0 "register_operand" "")
6156	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "")
6157			 (unspec:SI [(match_operand:SI 2 "" "")]
6158				    UNSPEC_PIC_SYM))))]
6159  "flag_pic"
6160  [(set (match_dup 3) (unspec:SI [(match_dup 2)] UNSPEC_PIC_SYM))
6161   (set (match_dup 0) (mem:SI (plus:SI (match_dup 1) (match_dup 3))))]
6162  "operands[3] = can_create_pseudo_p () ? gen_reg_rtx (SImode) : operands[0];"
6163)
6164
6165;; operand1 is the memory address to go into
6166;; pic_load_addr_32bit.
6167;; operand2 is the PIC label to be emitted
6168;; from pic_add_dot_plus_eight.
6169;; We do this to allow hoisting of the entire insn.
6170(define_insn_and_split "pic_load_addr_unified"
6171  [(set (match_operand:SI 0 "s_register_operand" "=r,r,l")
6172	(unspec:SI [(match_operand:SI 1 "" "mX,mX,mX")
6173		    (match_operand:SI 2 "" "")]
6174		    UNSPEC_PIC_UNIFIED))]
6175 "flag_pic"
6176 "#"
6177 "&& reload_completed"
6178 [(set (match_dup 0) (unspec:SI [(match_dup 1)] UNSPEC_PIC_SYM))
6179  (set (match_dup 0) (unspec:SI [(match_dup 0) (match_dup 3)
6180       		     		 (match_dup 2)] UNSPEC_PIC_BASE))]
6181 "operands[3] = TARGET_THUMB ? GEN_INT (4) : GEN_INT (8);"
6182 [(set_attr "type" "load_4,load_4,load_4")
6183  (set_attr "pool_range" "4096,4094,1022")
6184  (set_attr "neg_pool_range" "4084,0,0")
6185  (set_attr "arch"  "a,t2,t1")
6186  (set_attr "length" "8,6,4")]
6187)
6188
6189;; The rather odd constraints on the following are to force reload to leave
6190;; the insn alone, and to force the minipool generation pass to then move
6191;; the GOT symbol to memory.
6192
6193(define_insn "pic_load_addr_32bit"
6194  [(set (match_operand:SI 0 "s_register_operand" "=r")
6195	(unspec:SI [(match_operand:SI 1 "" "mX")] UNSPEC_PIC_SYM))]
6196  "TARGET_32BIT && flag_pic"
6197  "ldr%?\\t%0, %1"
6198  [(set_attr "type" "load_4")
6199   (set (attr "pool_range")
6200	(if_then_else (eq_attr "is_thumb" "no")
6201		      (const_int 4096)
6202		      (const_int 4094)))
6203   (set (attr "neg_pool_range")
6204	(if_then_else (eq_attr "is_thumb" "no")
6205		      (const_int 4084)
6206		      (const_int 0)))]
6207)
6208
6209(define_insn "pic_load_addr_thumb1"
6210  [(set (match_operand:SI 0 "s_register_operand" "=l")
6211	(unspec:SI [(match_operand:SI 1 "" "mX")] UNSPEC_PIC_SYM))]
6212  "TARGET_THUMB1 && flag_pic"
6213  "ldr\\t%0, %1"
6214  [(set_attr "type" "load_4")
6215   (set (attr "pool_range") (const_int 1018))]
6216)
6217
6218(define_insn "pic_add_dot_plus_four"
6219  [(set (match_operand:SI 0 "register_operand" "=r")
6220	(unspec:SI [(match_operand:SI 1 "register_operand" "0")
6221		    (const_int 4)
6222		    (match_operand 2 "" "")]
6223		   UNSPEC_PIC_BASE))]
6224  "TARGET_THUMB"
6225  "*
6226  (*targetm.asm_out.internal_label) (asm_out_file, \"LPIC\",
6227				     INTVAL (operands[2]));
6228  return \"add\\t%0, %|pc\";
6229  "
6230  [(set_attr "length" "2")
6231   (set_attr "type" "alu_sreg")]
6232)
6233
6234(define_insn "pic_add_dot_plus_eight"
6235  [(set (match_operand:SI 0 "register_operand" "=r")
6236	(unspec:SI [(match_operand:SI 1 "register_operand" "r")
6237		    (const_int 8)
6238		    (match_operand 2 "" "")]
6239		   UNSPEC_PIC_BASE))]
6240  "TARGET_ARM"
6241  "*
6242    (*targetm.asm_out.internal_label) (asm_out_file, \"LPIC\",
6243				       INTVAL (operands[2]));
6244    return \"add%?\\t%0, %|pc, %1\";
6245  "
6246  [(set_attr "predicable" "yes")
6247   (set_attr "type" "alu_sreg")]
6248)
6249
6250(define_insn "tls_load_dot_plus_eight"
6251  [(set (match_operand:SI 0 "register_operand" "=r")
6252	(mem:SI (unspec:SI [(match_operand:SI 1 "register_operand" "r")
6253			    (const_int 8)
6254			    (match_operand 2 "" "")]
6255			   UNSPEC_PIC_BASE)))]
6256  "TARGET_ARM"
6257  "*
6258    (*targetm.asm_out.internal_label) (asm_out_file, \"LPIC\",
6259				       INTVAL (operands[2]));
6260    return \"ldr%?\\t%0, [%|pc, %1]\t\t@ tls_load_dot_plus_eight\";
6261  "
6262  [(set_attr "predicable" "yes")
6263   (set_attr "type" "load_4")]
6264)
6265
6266;; PIC references to local variables can generate pic_add_dot_plus_eight
6267;; followed by a load.  These sequences can be crunched down to
6268;; tls_load_dot_plus_eight by a peephole.
6269
6270(define_peephole2
6271  [(set (match_operand:SI 0 "register_operand" "")
6272	(unspec:SI [(match_operand:SI 3 "register_operand" "")
6273		    (const_int 8)
6274		    (match_operand 1 "" "")]
6275		   UNSPEC_PIC_BASE))
6276   (set (match_operand:SI 2 "arm_general_register_operand" "")
6277	(mem:SI (match_dup 0)))]
6278  "TARGET_ARM && peep2_reg_dead_p (2, operands[0])"
6279  [(set (match_dup 2)
6280	(mem:SI (unspec:SI [(match_dup 3)
6281			    (const_int 8)
6282			    (match_dup 1)]
6283			   UNSPEC_PIC_BASE)))]
6284  ""
6285)
6286
6287(define_insn "pic_offset_arm"
6288  [(set (match_operand:SI 0 "register_operand" "=r")
6289	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "r")
6290			 (unspec:SI [(match_operand:SI 2 "" "X")]
6291				    UNSPEC_PIC_OFFSET))))]
6292  "TARGET_VXWORKS_RTP && TARGET_ARM && flag_pic"
6293  "ldr%?\\t%0, [%1,%2]"
6294  [(set_attr "type" "load_4")]
6295)
6296
6297(define_expand "builtin_setjmp_receiver"
6298  [(label_ref (match_operand 0 "" ""))]
6299  "flag_pic"
6300  "
6301{
6302  /* r3 is clobbered by set/longjmp, so we can use it as a scratch
6303     register.  */
6304  if (arm_pic_register != INVALID_REGNUM)
6305    arm_load_pic_register (1UL << 3);
6306  DONE;
6307}")
6308
6309;; If copying one reg to another we can set the condition codes according to
6310;; its value.  Such a move is common after a return from subroutine and the
6311;; result is being tested against zero.
6312
6313(define_insn "*movsi_compare0"
6314  [(set (reg:CC CC_REGNUM)
6315	(compare:CC (match_operand:SI 1 "s_register_operand" "0,0,l,rk,rk")
6316		    (const_int 0)))
6317   (set (match_operand:SI 0 "s_register_operand" "=l,rk,l,r,rk")
6318	(match_dup 1))]
6319  "TARGET_32BIT"
6320  "@
6321   cmp%?\\t%0, #0
6322   cmp%?\\t%0, #0
6323   subs%?\\t%0, %1, #0
6324   subs%?\\t%0, %1, #0
6325   subs%?\\t%0, %1, #0"
6326  [(set_attr "conds" "set")
6327   (set_attr "arch" "t2,*,t2,t2,a")
6328   (set_attr "type" "alus_imm")
6329   (set_attr "length" "2,4,2,4,4")]
6330)
6331
6332;; Subroutine to store a half word from a register into memory.
6333;; Operand 0 is the source register (HImode)
6334;; Operand 1 is the destination address in a register (SImode)
6335
6336;; In both this routine and the next, we must be careful not to spill
6337;; a memory address of reg+large_const into a separate PLUS insn, since this
6338;; can generate unrecognizable rtl.
6339
6340(define_expand "storehi"
6341  [;; store the low byte
6342   (set (match_operand 1 "" "") (match_dup 3))
6343   ;; extract the high byte
6344   (set (match_dup 2)
6345	(ashiftrt:SI (match_operand 0 "" "") (const_int 8)))
6346   ;; store the high byte
6347   (set (match_dup 4) (match_dup 5))]
6348  "TARGET_ARM"
6349  "
6350  {
6351    rtx op1 = operands[1];
6352    rtx addr = XEXP (op1, 0);
6353    enum rtx_code code = GET_CODE (addr);
6354
6355    if ((code == PLUS && !CONST_INT_P (XEXP (addr, 1)))
6356	|| code == MINUS)
6357      op1 = replace_equiv_address (operands[1], force_reg (SImode, addr));
6358
6359    operands[4] = adjust_address (op1, QImode, 1);
6360    operands[1] = adjust_address (operands[1], QImode, 0);
6361    operands[3] = gen_lowpart (QImode, operands[0]);
6362    operands[0] = gen_lowpart (SImode, operands[0]);
6363    operands[2] = gen_reg_rtx (SImode);
6364    operands[5] = gen_lowpart (QImode, operands[2]);
6365  }"
6366)
6367
6368(define_expand "storehi_bigend"
6369  [(set (match_dup 4) (match_dup 3))
6370   (set (match_dup 2)
6371	(ashiftrt:SI (match_operand 0 "" "") (const_int 8)))
6372   (set (match_operand 1 "" "")	(match_dup 5))]
6373  "TARGET_ARM"
6374  "
6375  {
6376    rtx op1 = operands[1];
6377    rtx addr = XEXP (op1, 0);
6378    enum rtx_code code = GET_CODE (addr);
6379
6380    if ((code == PLUS && !CONST_INT_P (XEXP (addr, 1)))
6381	|| code == MINUS)
6382      op1 = replace_equiv_address (op1, force_reg (SImode, addr));
6383
6384    operands[4] = adjust_address (op1, QImode, 1);
6385    operands[1] = adjust_address (operands[1], QImode, 0);
6386    operands[3] = gen_lowpart (QImode, operands[0]);
6387    operands[0] = gen_lowpart (SImode, operands[0]);
6388    operands[2] = gen_reg_rtx (SImode);
6389    operands[5] = gen_lowpart (QImode, operands[2]);
6390  }"
6391)
6392
6393;; Subroutine to store a half word integer constant into memory.
6394(define_expand "storeinthi"
6395  [(set (match_operand 0 "" "")
6396	(match_operand 1 "" ""))
6397   (set (match_dup 3) (match_dup 2))]
6398  "TARGET_ARM"
6399  "
6400  {
6401    HOST_WIDE_INT value = INTVAL (operands[1]);
6402    rtx addr = XEXP (operands[0], 0);
6403    rtx op0 = operands[0];
6404    enum rtx_code code = GET_CODE (addr);
6405
6406    if ((code == PLUS && !CONST_INT_P (XEXP (addr, 1)))
6407	|| code == MINUS)
6408      op0 = replace_equiv_address (op0, force_reg (SImode, addr));
6409
6410    operands[1] = gen_reg_rtx (SImode);
6411    if (BYTES_BIG_ENDIAN)
6412      {
6413	emit_insn (gen_movsi (operands[1], GEN_INT ((value >> 8) & 255)));
6414	if ((value & 255) == ((value >> 8) & 255))
6415	  operands[2] = operands[1];
6416	else
6417	  {
6418	    operands[2] = gen_reg_rtx (SImode);
6419	    emit_insn (gen_movsi (operands[2], GEN_INT (value & 255)));
6420	  }
6421      }
6422    else
6423      {
6424	emit_insn (gen_movsi (operands[1], GEN_INT (value & 255)));
6425	if ((value & 255) == ((value >> 8) & 255))
6426	  operands[2] = operands[1];
6427	else
6428	  {
6429	    operands[2] = gen_reg_rtx (SImode);
6430	    emit_insn (gen_movsi (operands[2], GEN_INT ((value >> 8) & 255)));
6431	  }
6432      }
6433
6434    operands[3] = adjust_address (op0, QImode, 1);
6435    operands[0] = adjust_address (operands[0], QImode, 0);
6436    operands[2] = gen_lowpart (QImode, operands[2]);
6437    operands[1] = gen_lowpart (QImode, operands[1]);
6438  }"
6439)
6440
6441(define_expand "storehi_single_op"
6442  [(set (match_operand:HI 0 "memory_operand" "")
6443	(match_operand:HI 1 "general_operand" ""))]
6444  "TARGET_32BIT && arm_arch4"
6445  "
6446  if (!s_register_operand (operands[1], HImode))
6447    operands[1] = copy_to_mode_reg (HImode, operands[1]);
6448  "
6449)
6450
6451(define_expand "movhi"
6452  [(set (match_operand:HI 0 "general_operand" "")
6453	(match_operand:HI 1 "general_operand" ""))]
6454  "TARGET_EITHER"
6455  "
6456  if (TARGET_ARM)
6457    {
6458      if (can_create_pseudo_p ())
6459        {
6460          if (MEM_P (operands[0]))
6461	    {
6462	      if (arm_arch4)
6463	        {
6464	          emit_insn (gen_storehi_single_op (operands[0], operands[1]));
6465	          DONE;
6466	        }
6467	      if (CONST_INT_P (operands[1]))
6468	        emit_insn (gen_storeinthi (operands[0], operands[1]));
6469	      else
6470	        {
6471	          if (MEM_P (operands[1]))
6472		    operands[1] = force_reg (HImode, operands[1]);
6473	          if (BYTES_BIG_ENDIAN)
6474		    emit_insn (gen_storehi_bigend (operands[1], operands[0]));
6475	          else
6476		   emit_insn (gen_storehi (operands[1], operands[0]));
6477	        }
6478	      DONE;
6479	    }
6480          /* Sign extend a constant, and keep it in an SImode reg.  */
6481          else if (CONST_INT_P (operands[1]))
6482	    {
6483	      rtx reg = gen_reg_rtx (SImode);
6484	      HOST_WIDE_INT val = INTVAL (operands[1]) & 0xffff;
6485
6486	      /* If the constant is already valid, leave it alone.  */
6487	      if (!const_ok_for_arm (val))
6488	        {
6489	          /* If setting all the top bits will make the constant
6490		     loadable in a single instruction, then set them.
6491		     Otherwise, sign extend the number.  */
6492
6493	          if (const_ok_for_arm (~(val | ~0xffff)))
6494		    val |= ~0xffff;
6495	          else if (val & 0x8000)
6496		    val |= ~0xffff;
6497	        }
6498
6499	      emit_insn (gen_movsi (reg, GEN_INT (val)));
6500	      operands[1] = gen_lowpart (HImode, reg);
6501	    }
6502	  else if (arm_arch4 && optimize && can_create_pseudo_p ()
6503		   && MEM_P (operands[1]))
6504	    {
6505	      rtx reg = gen_reg_rtx (SImode);
6506
6507	      emit_insn (gen_zero_extendhisi2 (reg, operands[1]));
6508	      operands[1] = gen_lowpart (HImode, reg);
6509	    }
6510          else if (!arm_arch4)
6511	    {
6512	      if (MEM_P (operands[1]))
6513	        {
6514		  rtx base;
6515		  rtx offset = const0_rtx;
6516		  rtx reg = gen_reg_rtx (SImode);
6517
6518		  if ((REG_P (base = XEXP (operands[1], 0))
6519		       || (GET_CODE (base) == PLUS
6520			   && (CONST_INT_P (offset = XEXP (base, 1)))
6521                           && ((INTVAL(offset) & 1) != 1)
6522			   && REG_P (base = XEXP (base, 0))))
6523		      && REGNO_POINTER_ALIGN (REGNO (base)) >= 32)
6524		    {
6525		      rtx new_rtx;
6526
6527		      new_rtx = widen_memory_access (operands[1], SImode,
6528						     ((INTVAL (offset) & ~3)
6529						      - INTVAL (offset)));
6530		      emit_insn (gen_movsi (reg, new_rtx));
6531		      if (((INTVAL (offset) & 2) != 0)
6532			  ^ (BYTES_BIG_ENDIAN ? 1 : 0))
6533			{
6534			  rtx reg2 = gen_reg_rtx (SImode);
6535
6536			  emit_insn (gen_lshrsi3 (reg2, reg, GEN_INT (16)));
6537			  reg = reg2;
6538			}
6539		    }
6540		  else
6541		    emit_insn (gen_movhi_bytes (reg, operands[1]));
6542
6543		  operands[1] = gen_lowpart (HImode, reg);
6544	       }
6545	   }
6546        }
6547      /* Handle loading a large integer during reload.  */
6548      else if (CONST_INT_P (operands[1])
6549	       && !const_ok_for_arm (INTVAL (operands[1]))
6550	       && !const_ok_for_arm (~INTVAL (operands[1])))
6551        {
6552          /* Writing a constant to memory needs a scratch, which should
6553	     be handled with SECONDARY_RELOADs.  */
6554          gcc_assert (REG_P (operands[0]));
6555
6556          operands[0] = gen_rtx_SUBREG (SImode, operands[0], 0);
6557          emit_insn (gen_movsi (operands[0], operands[1]));
6558          DONE;
6559       }
6560    }
6561  else if (TARGET_THUMB2)
6562    {
6563      /* Thumb-2 can do everything except mem=mem and mem=const easily.  */
6564      if (can_create_pseudo_p ())
6565	{
6566	  if (!REG_P (operands[0]))
6567	    operands[1] = force_reg (HImode, operands[1]);
6568          /* Zero extend a constant, and keep it in an SImode reg.  */
6569          else if (CONST_INT_P (operands[1]))
6570	    {
6571	      rtx reg = gen_reg_rtx (SImode);
6572	      HOST_WIDE_INT val = INTVAL (operands[1]) & 0xffff;
6573
6574	      emit_insn (gen_movsi (reg, GEN_INT (val)));
6575	      operands[1] = gen_lowpart (HImode, reg);
6576	    }
6577	}
6578    }
6579  else /* TARGET_THUMB1 */
6580    {
6581      if (can_create_pseudo_p ())
6582        {
6583	  if (CONST_INT_P (operands[1]))
6584	    {
6585	      rtx reg = gen_reg_rtx (SImode);
6586
6587	      emit_insn (gen_movsi (reg, operands[1]));
6588	      operands[1] = gen_lowpart (HImode, reg);
6589	    }
6590
6591          /* ??? We shouldn't really get invalid addresses here, but this can
6592	     happen if we are passed a SP (never OK for HImode/QImode) or
6593	     virtual register (also rejected as illegitimate for HImode/QImode)
6594	     relative address.  */
6595          /* ??? This should perhaps be fixed elsewhere, for instance, in
6596	     fixup_stack_1, by checking for other kinds of invalid addresses,
6597	     e.g. a bare reference to a virtual register.  This may confuse the
6598	     alpha though, which must handle this case differently.  */
6599          if (MEM_P (operands[0])
6600	      && !memory_address_p (GET_MODE (operands[0]),
6601				    XEXP (operands[0], 0)))
6602	    operands[0]
6603	      = replace_equiv_address (operands[0],
6604				       copy_to_reg (XEXP (operands[0], 0)));
6605
6606          if (MEM_P (operands[1])
6607	      && !memory_address_p (GET_MODE (operands[1]),
6608				    XEXP (operands[1], 0)))
6609	    operands[1]
6610	      = replace_equiv_address (operands[1],
6611				       copy_to_reg (XEXP (operands[1], 0)));
6612
6613	  if (MEM_P (operands[1]) && optimize > 0)
6614	    {
6615	      rtx reg = gen_reg_rtx (SImode);
6616
6617	      emit_insn (gen_zero_extendhisi2 (reg, operands[1]));
6618	      operands[1] = gen_lowpart (HImode, reg);
6619	    }
6620
6621          if (MEM_P (operands[0]))
6622	    operands[1] = force_reg (HImode, operands[1]);
6623        }
6624      else if (CONST_INT_P (operands[1])
6625	        && !satisfies_constraint_I (operands[1]))
6626        {
6627	  /* Handle loading a large integer during reload.  */
6628
6629          /* Writing a constant to memory needs a scratch, which should
6630	     be handled with SECONDARY_RELOADs.  */
6631          gcc_assert (REG_P (operands[0]));
6632
6633          operands[0] = gen_rtx_SUBREG (SImode, operands[0], 0);
6634          emit_insn (gen_movsi (operands[0], operands[1]));
6635          DONE;
6636        }
6637    }
6638  "
6639)
6640
6641(define_expand "movhi_bytes"
6642  [(set (match_dup 2) (zero_extend:SI (match_operand:HI 1 "" "")))
6643   (set (match_dup 3)
6644	(zero_extend:SI (match_dup 6)))
6645   (set (match_operand:SI 0 "" "")
6646	 (ior:SI (ashift:SI (match_dup 4) (const_int 8)) (match_dup 5)))]
6647  "TARGET_ARM"
6648  "
6649  {
6650    rtx mem1, mem2;
6651    rtx addr = copy_to_mode_reg (SImode, XEXP (operands[1], 0));
6652
6653    mem1 = change_address (operands[1], QImode, addr);
6654    mem2 = change_address (operands[1], QImode,
6655			   plus_constant (Pmode, addr, 1));
6656    operands[0] = gen_lowpart (SImode, operands[0]);
6657    operands[1] = mem1;
6658    operands[2] = gen_reg_rtx (SImode);
6659    operands[3] = gen_reg_rtx (SImode);
6660    operands[6] = mem2;
6661
6662    if (BYTES_BIG_ENDIAN)
6663      {
6664	operands[4] = operands[2];
6665	operands[5] = operands[3];
6666      }
6667    else
6668      {
6669	operands[4] = operands[3];
6670	operands[5] = operands[2];
6671      }
6672  }"
6673)
6674
6675(define_expand "movhi_bigend"
6676  [(set (match_dup 2)
6677	(rotate:SI (subreg:SI (match_operand:HI 1 "memory_operand" "") 0)
6678		   (const_int 16)))
6679   (set (match_dup 3)
6680	(ashiftrt:SI (match_dup 2) (const_int 16)))
6681   (set (match_operand:HI 0 "s_register_operand" "")
6682	(match_dup 4))]
6683  "TARGET_ARM"
6684  "
6685  operands[2] = gen_reg_rtx (SImode);
6686  operands[3] = gen_reg_rtx (SImode);
6687  operands[4] = gen_lowpart (HImode, operands[3]);
6688  "
6689)
6690
6691;; Pattern to recognize insn generated default case above
6692(define_insn "*movhi_insn_arch4"
6693  [(set (match_operand:HI 0 "nonimmediate_operand" "=r,r,r,m,r")
6694	(match_operand:HI 1 "general_operand"      "rIk,K,n,r,mi"))]
6695  "TARGET_ARM
6696   && arm_arch4 && !TARGET_HARD_FLOAT
6697   && (register_operand (operands[0], HImode)
6698       || register_operand (operands[1], HImode))"
6699  "@
6700   mov%?\\t%0, %1\\t%@ movhi
6701   mvn%?\\t%0, #%B1\\t%@ movhi
6702   movw%?\\t%0, %L1\\t%@ movhi
6703   strh%?\\t%1, %0\\t%@ movhi
6704   ldrh%?\\t%0, %1\\t%@ movhi"
6705  [(set_attr "predicable" "yes")
6706   (set_attr "pool_range" "*,*,*,*,256")
6707   (set_attr "neg_pool_range" "*,*,*,*,244")
6708   (set_attr "arch" "*,*,v6t2,*,*")
6709   (set_attr_alternative "type"
6710                         [(if_then_else (match_operand 1 "const_int_operand" "")
6711                                        (const_string "mov_imm" )
6712                                        (const_string "mov_reg"))
6713                          (const_string "mvn_imm")
6714                          (const_string "mov_imm")
6715                          (const_string "store_4")
6716                          (const_string "load_4")])]
6717)
6718
6719(define_insn "*movhi_bytes"
6720  [(set (match_operand:HI 0 "s_register_operand" "=r,r,r")
6721	(match_operand:HI 1 "arm_rhs_operand"  "I,rk,K"))]
6722  "TARGET_ARM && !TARGET_HARD_FLOAT"
6723  "@
6724   mov%?\\t%0, %1\\t%@ movhi
6725   mov%?\\t%0, %1\\t%@ movhi
6726   mvn%?\\t%0, #%B1\\t%@ movhi"
6727  [(set_attr "predicable" "yes")
6728   (set_attr "type" "mov_imm,mov_reg,mvn_imm")]
6729)
6730
6731;; We use a DImode scratch because we may occasionally need an additional
6732;; temporary if the address isn't offsettable -- push_reload doesn't seem
6733;; to take any notice of the "o" constraints on reload_memory_operand operand.
6734(define_expand "reload_outhi"
6735  [(parallel [(match_operand:HI 0 "arm_reload_memory_operand" "=o")
6736	      (match_operand:HI 1 "s_register_operand"        "r")
6737	      (match_operand:DI 2 "s_register_operand"        "=&l")])]
6738  "TARGET_EITHER"
6739  "if (TARGET_ARM)
6740     arm_reload_out_hi (operands);
6741   else
6742     thumb_reload_out_hi (operands);
6743  DONE;
6744  "
6745)
6746
6747(define_expand "reload_inhi"
6748  [(parallel [(match_operand:HI 0 "s_register_operand" "=r")
6749	      (match_operand:HI 1 "arm_reload_memory_operand" "o")
6750	      (match_operand:DI 2 "s_register_operand" "=&r")])]
6751  "TARGET_EITHER"
6752  "
6753  if (TARGET_ARM)
6754    arm_reload_in_hi (operands);
6755  else
6756    thumb_reload_out_hi (operands);
6757  DONE;
6758")
6759
6760(define_expand "movqi"
6761  [(set (match_operand:QI 0 "general_operand" "")
6762        (match_operand:QI 1 "general_operand" ""))]
6763  "TARGET_EITHER"
6764  "
6765  /* Everything except mem = const or mem = mem can be done easily */
6766
6767  if (can_create_pseudo_p ())
6768    {
6769      if (CONST_INT_P (operands[1]))
6770	{
6771	  rtx reg = gen_reg_rtx (SImode);
6772
6773	  /* For thumb we want an unsigned immediate, then we are more likely
6774	     to be able to use a movs insn.  */
6775	  if (TARGET_THUMB)
6776	    operands[1] = GEN_INT (INTVAL (operands[1]) & 255);
6777
6778	  emit_insn (gen_movsi (reg, operands[1]));
6779	  operands[1] = gen_lowpart (QImode, reg);
6780	}
6781
6782      if (TARGET_THUMB)
6783	{
6784          /* ??? We shouldn't really get invalid addresses here, but this can
6785	     happen if we are passed a SP (never OK for HImode/QImode) or
6786	     virtual register (also rejected as illegitimate for HImode/QImode)
6787	     relative address.  */
6788          /* ??? This should perhaps be fixed elsewhere, for instance, in
6789	     fixup_stack_1, by checking for other kinds of invalid addresses,
6790	     e.g. a bare reference to a virtual register.  This may confuse the
6791	     alpha though, which must handle this case differently.  */
6792          if (MEM_P (operands[0])
6793	      && !memory_address_p (GET_MODE (operands[0]),
6794		  		     XEXP (operands[0], 0)))
6795	    operands[0]
6796	      = replace_equiv_address (operands[0],
6797				       copy_to_reg (XEXP (operands[0], 0)));
6798          if (MEM_P (operands[1])
6799	      && !memory_address_p (GET_MODE (operands[1]),
6800				    XEXP (operands[1], 0)))
6801	     operands[1]
6802	       = replace_equiv_address (operands[1],
6803					copy_to_reg (XEXP (operands[1], 0)));
6804	}
6805
6806      if (MEM_P (operands[1]) && optimize > 0)
6807	{
6808	  rtx reg = gen_reg_rtx (SImode);
6809
6810	  emit_insn (gen_zero_extendqisi2 (reg, operands[1]));
6811	  operands[1] = gen_lowpart (QImode, reg);
6812	}
6813
6814      if (MEM_P (operands[0]))
6815	operands[1] = force_reg (QImode, operands[1]);
6816    }
6817  else if (TARGET_THUMB
6818	   && CONST_INT_P (operands[1])
6819	   && !satisfies_constraint_I (operands[1]))
6820    {
6821      /* Handle loading a large integer during reload.  */
6822
6823      /* Writing a constant to memory needs a scratch, which should
6824	 be handled with SECONDARY_RELOADs.  */
6825      gcc_assert (REG_P (operands[0]));
6826
6827      operands[0] = gen_rtx_SUBREG (SImode, operands[0], 0);
6828      emit_insn (gen_movsi (operands[0], operands[1]));
6829      DONE;
6830    }
6831  "
6832)
6833
6834(define_insn "*arm_movqi_insn"
6835  [(set (match_operand:QI 0 "nonimmediate_operand" "=r,r,r,l,r,l,Uu,r,m")
6836	(match_operand:QI 1 "general_operand" "rk,rk,I,Py,K,Uu,l,Uh,r"))]
6837  "TARGET_32BIT
6838   && (   register_operand (operands[0], QImode)
6839       || register_operand (operands[1], QImode))"
6840  "@
6841   mov%?\\t%0, %1
6842   mov%?\\t%0, %1
6843   mov%?\\t%0, %1
6844   mov%?\\t%0, %1
6845   mvn%?\\t%0, #%B1
6846   ldrb%?\\t%0, %1
6847   strb%?\\t%1, %0
6848   ldrb%?\\t%0, %1
6849   strb%?\\t%1, %0"
6850  [(set_attr "type" "mov_reg,mov_reg,mov_imm,mov_imm,mvn_imm,load_4,store_4,load_4,store_4")
6851   (set_attr "predicable" "yes")
6852   (set_attr "predicable_short_it" "yes,yes,no,yes,no,no,no,no,no")
6853   (set_attr "arch" "t2,any,any,t2,any,t2,t2,any,any")
6854   (set_attr "length" "2,4,4,2,4,2,2,4,4")]
6855)
6856
6857;; HFmode moves
6858(define_expand "movhf"
6859  [(set (match_operand:HF 0 "general_operand" "")
6860	(match_operand:HF 1 "general_operand" ""))]
6861  "TARGET_EITHER"
6862  "
6863  if (TARGET_32BIT)
6864    {
6865      if (MEM_P (operands[0]))
6866        operands[1] = force_reg (HFmode, operands[1]);
6867    }
6868  else /* TARGET_THUMB1 */
6869    {
6870      if (can_create_pseudo_p ())
6871        {
6872           if (!REG_P (operands[0]))
6873	     operands[1] = force_reg (HFmode, operands[1]);
6874        }
6875    }
6876  "
6877)
6878
6879(define_insn "*arm32_movhf"
6880  [(set (match_operand:HF 0 "nonimmediate_operand" "=r,m,r,r")
6881	(match_operand:HF 1 "general_operand"	   " m,r,r,F"))]
6882  "TARGET_32BIT && !TARGET_HARD_FLOAT
6883   && (	  s_register_operand (operands[0], HFmode)
6884       || s_register_operand (operands[1], HFmode))"
6885  "*
6886  switch (which_alternative)
6887    {
6888    case 0:	/* ARM register from memory */
6889      return \"ldrh%?\\t%0, %1\\t%@ __fp16\";
6890    case 1:	/* memory from ARM register */
6891      return \"strh%?\\t%1, %0\\t%@ __fp16\";
6892    case 2:	/* ARM register from ARM register */
6893      return \"mov%?\\t%0, %1\\t%@ __fp16\";
6894    case 3:	/* ARM register from constant */
6895      {
6896	long bits;
6897	rtx ops[4];
6898
6899	bits = real_to_target (NULL, CONST_DOUBLE_REAL_VALUE (operands[1]),
6900			       HFmode);
6901	ops[0] = operands[0];
6902	ops[1] = GEN_INT (bits);
6903	ops[2] = GEN_INT (bits & 0xff00);
6904	ops[3] = GEN_INT (bits & 0x00ff);
6905
6906	if (arm_arch_thumb2)
6907	  output_asm_insn (\"movw%?\\t%0, %1\", ops);
6908	else
6909	  output_asm_insn (\"mov%?\\t%0, %2\;orr%?\\t%0, %0, %3\", ops);
6910	return \"\";
6911       }
6912    default:
6913      gcc_unreachable ();
6914    }
6915  "
6916  [(set_attr "conds" "unconditional")
6917   (set_attr "type" "load_4,store_4,mov_reg,multiple")
6918   (set_attr "length" "4,4,4,8")
6919   (set_attr "predicable" "yes")]
6920)
6921
6922(define_expand "movsf"
6923  [(set (match_operand:SF 0 "general_operand" "")
6924	(match_operand:SF 1 "general_operand" ""))]
6925  "TARGET_EITHER"
6926  "
6927  if (TARGET_32BIT)
6928    {
6929      if (MEM_P (operands[0]))
6930        operands[1] = force_reg (SFmode, operands[1]);
6931    }
6932  else /* TARGET_THUMB1 */
6933    {
6934      if (can_create_pseudo_p ())
6935        {
6936           if (!REG_P (operands[0]))
6937	     operands[1] = force_reg (SFmode, operands[1]);
6938        }
6939    }
6940  "
6941)
6942
6943;; Transform a floating-point move of a constant into a core register into
6944;; an SImode operation.
6945(define_split
6946  [(set (match_operand:SF 0 "arm_general_register_operand" "")
6947	(match_operand:SF 1 "immediate_operand" ""))]
6948  "TARGET_EITHER
6949   && reload_completed
6950   && CONST_DOUBLE_P (operands[1])"
6951  [(set (match_dup 2) (match_dup 3))]
6952  "
6953  operands[2] = gen_lowpart (SImode, operands[0]);
6954  operands[3] = gen_lowpart (SImode, operands[1]);
6955  if (operands[2] == 0 || operands[3] == 0)
6956    FAIL;
6957  "
6958)
6959
6960(define_insn "*arm_movsf_soft_insn"
6961  [(set (match_operand:SF 0 "nonimmediate_operand" "=r,r,m")
6962	(match_operand:SF 1 "general_operand"  "r,mE,r"))]
6963  "TARGET_32BIT
6964   && TARGET_SOFT_FLOAT
6965   && (!MEM_P (operands[0])
6966       || register_operand (operands[1], SFmode))"
6967  "@
6968   mov%?\\t%0, %1
6969   ldr%?\\t%0, %1\\t%@ float
6970   str%?\\t%1, %0\\t%@ float"
6971  [(set_attr "predicable" "yes")
6972   (set_attr "type" "mov_reg,load_4,store_4")
6973   (set_attr "arm_pool_range" "*,4096,*")
6974   (set_attr "thumb2_pool_range" "*,4094,*")
6975   (set_attr "arm_neg_pool_range" "*,4084,*")
6976   (set_attr "thumb2_neg_pool_range" "*,0,*")]
6977)
6978
6979(define_expand "movdf"
6980  [(set (match_operand:DF 0 "general_operand" "")
6981	(match_operand:DF 1 "general_operand" ""))]
6982  "TARGET_EITHER"
6983  "
6984  if (TARGET_32BIT)
6985    {
6986      if (MEM_P (operands[0]))
6987        operands[1] = force_reg (DFmode, operands[1]);
6988    }
6989  else /* TARGET_THUMB */
6990    {
6991      if (can_create_pseudo_p ())
6992        {
6993          if (!REG_P (operands[0]))
6994	    operands[1] = force_reg (DFmode, operands[1]);
6995        }
6996    }
6997  "
6998)
6999
7000;; Reloading a df mode value stored in integer regs to memory can require a
7001;; scratch reg.
7002(define_expand "reload_outdf"
7003  [(match_operand:DF 0 "arm_reload_memory_operand" "=o")
7004   (match_operand:DF 1 "s_register_operand" "r")
7005   (match_operand:SI 2 "s_register_operand" "=&r")]
7006  "TARGET_THUMB2"
7007  "
7008  {
7009    enum rtx_code code = GET_CODE (XEXP (operands[0], 0));
7010
7011    if (code == REG)
7012      operands[2] = XEXP (operands[0], 0);
7013    else if (code == POST_INC || code == PRE_DEC)
7014      {
7015	operands[0] = gen_rtx_SUBREG (DImode, operands[0], 0);
7016	operands[1] = gen_rtx_SUBREG (DImode, operands[1], 0);
7017	emit_insn (gen_movdi (operands[0], operands[1]));
7018	DONE;
7019      }
7020    else if (code == PRE_INC)
7021      {
7022	rtx reg = XEXP (XEXP (operands[0], 0), 0);
7023
7024	emit_insn (gen_addsi3 (reg, reg, GEN_INT (8)));
7025	operands[2] = reg;
7026      }
7027    else if (code == POST_DEC)
7028      operands[2] = XEXP (XEXP (operands[0], 0), 0);
7029    else
7030      emit_insn (gen_addsi3 (operands[2], XEXP (XEXP (operands[0], 0), 0),
7031			     XEXP (XEXP (operands[0], 0), 1)));
7032
7033    emit_insn (gen_rtx_SET (replace_equiv_address (operands[0], operands[2]),
7034			    operands[1]));
7035
7036    if (code == POST_DEC)
7037      emit_insn (gen_addsi3 (operands[2], operands[2], GEN_INT (-8)));
7038
7039    DONE;
7040  }"
7041)
7042
7043(define_insn "*movdf_soft_insn"
7044  [(set (match_operand:DF 0 "nonimmediate_soft_df_operand" "=r,r,r,q,m")
7045	(match_operand:DF 1 "soft_df_operand" "rDa,Db,Dc,mF,q"))]
7046  "TARGET_32BIT && TARGET_SOFT_FLOAT
7047   && (   register_operand (operands[0], DFmode)
7048       || register_operand (operands[1], DFmode))"
7049  "*
7050  switch (which_alternative)
7051    {
7052    case 0:
7053    case 1:
7054    case 2:
7055      return \"#\";
7056    default:
7057      return output_move_double (operands, true, NULL);
7058    }
7059  "
7060  [(set_attr "length" "8,12,16,8,8")
7061   (set_attr "type" "multiple,multiple,multiple,load_8,store_8")
7062   (set_attr "arm_pool_range" "*,*,*,1020,*")
7063   (set_attr "thumb2_pool_range" "*,*,*,1018,*")
7064   (set_attr "arm_neg_pool_range" "*,*,*,1004,*")
7065   (set_attr "thumb2_neg_pool_range" "*,*,*,0,*")]
7066)
7067
7068
7069;; load- and store-multiple insns
7070;; The arm can load/store any set of registers, provided that they are in
7071;; ascending order, but these expanders assume a contiguous set.
7072
7073(define_expand "load_multiple"
7074  [(match_par_dup 3 [(set (match_operand:SI 0 "" "")
7075                          (match_operand:SI 1 "" ""))
7076                     (use (match_operand:SI 2 "" ""))])]
7077  "TARGET_32BIT"
7078{
7079  HOST_WIDE_INT offset = 0;
7080
7081  /* Support only fixed point registers.  */
7082  if (!CONST_INT_P (operands[2])
7083      || INTVAL (operands[2]) > MAX_LDM_STM_OPS
7084      || INTVAL (operands[2]) < 2
7085      || !MEM_P (operands[1])
7086      || !REG_P (operands[0])
7087      || REGNO (operands[0]) > (LAST_ARM_REGNUM - 1)
7088      || REGNO (operands[0]) + INTVAL (operands[2]) > LAST_ARM_REGNUM)
7089    FAIL;
7090
7091  operands[3]
7092    = arm_gen_load_multiple (arm_regs_in_sequence + REGNO (operands[0]),
7093			     INTVAL (operands[2]),
7094			     force_reg (SImode, XEXP (operands[1], 0)),
7095			     FALSE, operands[1], &offset);
7096})
7097
7098(define_expand "store_multiple"
7099  [(match_par_dup 3 [(set (match_operand:SI 0 "" "")
7100                          (match_operand:SI 1 "" ""))
7101                     (use (match_operand:SI 2 "" ""))])]
7102  "TARGET_32BIT"
7103{
7104  HOST_WIDE_INT offset = 0;
7105
7106  /* Support only fixed point registers.  */
7107  if (!CONST_INT_P (operands[2])
7108      || INTVAL (operands[2]) > MAX_LDM_STM_OPS
7109      || INTVAL (operands[2]) < 2
7110      || !REG_P (operands[1])
7111      || !MEM_P (operands[0])
7112      || REGNO (operands[1]) > (LAST_ARM_REGNUM - 1)
7113      || REGNO (operands[1]) + INTVAL (operands[2]) > LAST_ARM_REGNUM)
7114    FAIL;
7115
7116  operands[3]
7117    = arm_gen_store_multiple (arm_regs_in_sequence + REGNO (operands[1]),
7118			      INTVAL (operands[2]),
7119			      force_reg (SImode, XEXP (operands[0], 0)),
7120			      FALSE, operands[0], &offset);
7121})
7122
7123
7124(define_expand "setmemsi"
7125  [(match_operand:BLK 0 "general_operand" "")
7126   (match_operand:SI 1 "const_int_operand" "")
7127   (match_operand:SI 2 "const_int_operand" "")
7128   (match_operand:SI 3 "const_int_operand" "")]
7129  "TARGET_32BIT"
7130{
7131  if (arm_gen_setmem (operands))
7132    DONE;
7133
7134  FAIL;
7135})
7136
7137
7138;; Move a block of memory if it is word aligned and MORE than 2 words long.
7139;; We could let this apply for blocks of less than this, but it clobbers so
7140;; many registers that there is then probably a better way.
7141
7142(define_expand "movmemqi"
7143  [(match_operand:BLK 0 "general_operand" "")
7144   (match_operand:BLK 1 "general_operand" "")
7145   (match_operand:SI 2 "const_int_operand" "")
7146   (match_operand:SI 3 "const_int_operand" "")]
7147  ""
7148  "
7149  if (TARGET_32BIT)
7150    {
7151      if (TARGET_LDRD && current_tune->prefer_ldrd_strd
7152          && !optimize_function_for_size_p (cfun))
7153        {
7154          if (gen_movmem_ldrd_strd (operands))
7155            DONE;
7156          FAIL;
7157        }
7158
7159      if (arm_gen_movmemqi (operands))
7160        DONE;
7161      FAIL;
7162    }
7163  else /* TARGET_THUMB1 */
7164    {
7165      if (   INTVAL (operands[3]) != 4
7166          || INTVAL (operands[2]) > 48)
7167        FAIL;
7168
7169      thumb_expand_movmemqi (operands);
7170      DONE;
7171    }
7172  "
7173)
7174
7175
7176;; Compare & branch insns
7177;; The range calculations are based as follows:
7178;; For forward branches, the address calculation returns the address of
7179;; the next instruction.  This is 2 beyond the branch instruction.
7180;; For backward branches, the address calculation returns the address of
7181;; the first instruction in this pattern (cmp).  This is 2 before the branch
7182;; instruction for the shortest sequence, and 4 before the branch instruction
7183;; if we have to jump around an unconditional branch.
7184;; To the basic branch range the PC offset must be added (this is +4).
7185;; So for forward branches we have
7186;;   (pos_range - pos_base_offs + pc_offs) = (pos_range - 2 + 4).
7187;; And for backward branches we have
7188;;   (neg_range - neg_base_offs + pc_offs) = (neg_range - (-2 or -4) + 4).
7189;;
7190;; In 16-bit Thumb these ranges are:
7191;; For a 'b'       pos_range = 2046, neg_range = -2048 giving (-2040->2048).
7192;; For a 'b<cond>' pos_range = 254,  neg_range = -256  giving (-250 ->256).
7193
7194;; In 32-bit Thumb these ranges are:
7195;; For a 'b'       +/- 16MB is not checked for.
7196;; For a 'b<cond>' pos_range = 1048574,  neg_range = -1048576  giving
7197;; (-1048568 -> 1048576).
7198
7199(define_expand "cbranchsi4"
7200  [(set (pc) (if_then_else
7201	      (match_operator 0 "expandable_comparison_operator"
7202	       [(match_operand:SI 1 "s_register_operand" "")
7203	        (match_operand:SI 2 "nonmemory_operand" "")])
7204	      (label_ref (match_operand 3 "" ""))
7205	      (pc)))]
7206  "TARGET_EITHER"
7207  "
7208  if (!TARGET_THUMB1)
7209    {
7210      if (!arm_validize_comparison (&operands[0], &operands[1], &operands[2]))
7211        FAIL;
7212      emit_jump_insn (gen_cbranch_cc (operands[0], operands[1], operands[2],
7213				      operands[3]));
7214      DONE;
7215    }
7216  if (thumb1_cmpneg_operand (operands[2], SImode))
7217    {
7218      emit_jump_insn (gen_cbranchsi4_scratch (NULL, operands[1], operands[2],
7219					      operands[3], operands[0]));
7220      DONE;
7221    }
7222  if (!thumb1_cmp_operand (operands[2], SImode))
7223    operands[2] = force_reg (SImode, operands[2]);
7224  ")
7225
7226(define_expand "cbranchsf4"
7227  [(set (pc) (if_then_else
7228	      (match_operator 0 "expandable_comparison_operator"
7229	       [(match_operand:SF 1 "s_register_operand" "")
7230	        (match_operand:SF 2 "vfp_compare_operand" "")])
7231	      (label_ref (match_operand 3 "" ""))
7232	      (pc)))]
7233  "TARGET_32BIT && TARGET_HARD_FLOAT"
7234  "emit_jump_insn (gen_cbranch_cc (operands[0], operands[1], operands[2],
7235				   operands[3])); DONE;"
7236)
7237
7238(define_expand "cbranchdf4"
7239  [(set (pc) (if_then_else
7240	      (match_operator 0 "expandable_comparison_operator"
7241	       [(match_operand:DF 1 "s_register_operand" "")
7242	        (match_operand:DF 2 "vfp_compare_operand" "")])
7243	      (label_ref (match_operand 3 "" ""))
7244	      (pc)))]
7245  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
7246  "emit_jump_insn (gen_cbranch_cc (operands[0], operands[1], operands[2],
7247				   operands[3])); DONE;"
7248)
7249
7250(define_expand "cbranchdi4"
7251  [(set (pc) (if_then_else
7252	      (match_operator 0 "expandable_comparison_operator"
7253	       [(match_operand:DI 1 "s_register_operand" "")
7254	        (match_operand:DI 2 "cmpdi_operand" "")])
7255	      (label_ref (match_operand 3 "" ""))
7256	      (pc)))]
7257  "TARGET_32BIT"
7258  "{
7259     if (!arm_validize_comparison (&operands[0], &operands[1], &operands[2]))
7260       FAIL;
7261     emit_jump_insn (gen_cbranch_cc (operands[0], operands[1], operands[2],
7262				       operands[3]));
7263     DONE;
7264   }"
7265)
7266
7267;; Comparison and test insns
7268
7269(define_insn "*arm_cmpsi_insn"
7270  [(set (reg:CC CC_REGNUM)
7271	(compare:CC (match_operand:SI 0 "s_register_operand" "l,r,r,r,r")
7272		    (match_operand:SI 1 "arm_add_operand"    "Py,r,r,I,L")))]
7273  "TARGET_32BIT"
7274  "@
7275   cmp%?\\t%0, %1
7276   cmp%?\\t%0, %1
7277   cmp%?\\t%0, %1
7278   cmp%?\\t%0, %1
7279   cmn%?\\t%0, #%n1"
7280  [(set_attr "conds" "set")
7281   (set_attr "arch" "t2,t2,any,any,any")
7282   (set_attr "length" "2,2,4,4,4")
7283   (set_attr "predicable" "yes")
7284   (set_attr "predicable_short_it" "yes,yes,yes,no,no")
7285   (set_attr "type" "alus_imm,alus_sreg,alus_sreg,alus_imm,alus_imm")]
7286)
7287
7288(define_insn "*cmpsi_shiftsi"
7289  [(set (reg:CC CC_REGNUM)
7290	(compare:CC (match_operand:SI   0 "s_register_operand" "r,r,r")
7291		    (match_operator:SI  3 "shift_operator"
7292		     [(match_operand:SI 1 "s_register_operand" "r,r,r")
7293		      (match_operand:SI 2 "shift_amount_operand" "M,r,M")])))]
7294  "TARGET_32BIT"
7295  "cmp\\t%0, %1%S3"
7296  [(set_attr "conds" "set")
7297   (set_attr "shift" "1")
7298   (set_attr "arch" "32,a,a")
7299   (set_attr "type" "alus_shift_imm,alus_shift_reg,alus_shift_imm")])
7300
7301(define_insn "*cmpsi_shiftsi_swp"
7302  [(set (reg:CC_SWP CC_REGNUM)
7303	(compare:CC_SWP (match_operator:SI 3 "shift_operator"
7304			 [(match_operand:SI 1 "s_register_operand" "r,r,r")
7305			  (match_operand:SI 2 "shift_amount_operand" "M,r,M")])
7306			(match_operand:SI 0 "s_register_operand" "r,r,r")))]
7307  "TARGET_32BIT"
7308  "cmp%?\\t%0, %1%S3"
7309  [(set_attr "conds" "set")
7310   (set_attr "shift" "1")
7311   (set_attr "arch" "32,a,a")
7312   (set_attr "type" "alus_shift_imm,alus_shift_reg,alus_shift_imm")])
7313
7314(define_insn "*arm_cmpsi_negshiftsi_si"
7315  [(set (reg:CC_Z CC_REGNUM)
7316	(compare:CC_Z
7317	 (neg:SI (match_operator:SI 1 "shift_operator"
7318		    [(match_operand:SI 2 "s_register_operand" "r")
7319		     (match_operand:SI 3 "reg_or_int_operand" "rM")]))
7320	 (match_operand:SI 0 "s_register_operand" "r")))]
7321  "TARGET_ARM"
7322  "cmn%?\\t%0, %2%S1"
7323  [(set_attr "conds" "set")
7324   (set (attr "type") (if_then_else (match_operand 3 "const_int_operand" "")
7325				    (const_string "alus_shift_imm")
7326				    (const_string "alus_shift_reg")))
7327   (set_attr "predicable" "yes")]
7328)
7329
7330;; DImode comparisons.  The generic code generates branches that
7331;; if-conversion can not reduce to a conditional compare, so we do
7332;; that directly.
7333
7334(define_insn_and_split "*arm_cmpdi_insn"
7335  [(set (reg:CC_NCV CC_REGNUM)
7336	(compare:CC_NCV (match_operand:DI 0 "s_register_operand" "r")
7337			(match_operand:DI 1 "arm_di_operand"	   "rDi")))
7338   (clobber (match_scratch:SI 2 "=r"))]
7339  "TARGET_32BIT"
7340  "#"   ; "cmp\\t%Q0, %Q1\;sbcs\\t%2, %R0, %R1"
7341  "&& reload_completed"
7342  [(set (reg:CC CC_REGNUM)
7343        (compare:CC (match_dup 0) (match_dup 1)))
7344   (parallel [(set (reg:CC CC_REGNUM)
7345                   (compare:CC (match_dup 3) (match_dup 4)))
7346              (set (match_dup 2)
7347                   (minus:SI (match_dup 5)
7348                            (ltu:SI (reg:CC_C CC_REGNUM) (const_int 0))))])]
7349  {
7350    operands[3] = gen_highpart (SImode, operands[0]);
7351    operands[0] = gen_lowpart (SImode, operands[0]);
7352    if (CONST_INT_P (operands[1]))
7353      {
7354        operands[4] = GEN_INT (~INTVAL (gen_highpart_mode (SImode,
7355                                                           DImode,
7356                                                           operands[1])));
7357        operands[5] = gen_rtx_PLUS (SImode, operands[3], operands[4]);
7358      }
7359    else
7360      {
7361        operands[4] = gen_highpart (SImode, operands[1]);
7362        operands[5] = gen_rtx_MINUS (SImode, operands[3], operands[4]);
7363      }
7364    operands[1] = gen_lowpart (SImode, operands[1]);
7365    operands[2] = gen_lowpart (SImode, operands[2]);
7366  }
7367  [(set_attr "conds" "set")
7368   (set_attr "length" "8")
7369   (set_attr "type" "multiple")]
7370)
7371
7372(define_insn_and_split "*arm_cmpdi_unsigned"
7373  [(set (reg:CC_CZ CC_REGNUM)
7374        (compare:CC_CZ (match_operand:DI 0 "s_register_operand" "l,r,r,r")
7375                       (match_operand:DI 1 "arm_di_operand"     "Py,r,Di,rDi")))]
7376
7377  "TARGET_32BIT"
7378  "#"   ; "cmp\\t%R0, %R1\;it eq\;cmpeq\\t%Q0, %Q1"
7379  "&& reload_completed"
7380  [(set (reg:CC CC_REGNUM)
7381        (compare:CC (match_dup 2) (match_dup 3)))
7382   (cond_exec (eq:SI (reg:CC CC_REGNUM) (const_int 0))
7383              (set (reg:CC CC_REGNUM)
7384                   (compare:CC (match_dup 0) (match_dup 1))))]
7385  {
7386    operands[2] = gen_highpart (SImode, operands[0]);
7387    operands[0] = gen_lowpart (SImode, operands[0]);
7388    if (CONST_INT_P (operands[1]))
7389      operands[3] = gen_highpart_mode (SImode, DImode, operands[1]);
7390    else
7391      operands[3] = gen_highpart (SImode, operands[1]);
7392    operands[1] = gen_lowpart (SImode, operands[1]);
7393  }
7394  [(set_attr "conds" "set")
7395   (set_attr "enabled_for_short_it" "yes,yes,no,*")
7396   (set_attr "arch" "t2,t2,t2,a")
7397   (set_attr "length" "6,6,10,8")
7398   (set_attr "type" "multiple")]
7399)
7400
7401(define_insn "*arm_cmpdi_zero"
7402  [(set (reg:CC_Z CC_REGNUM)
7403	(compare:CC_Z (match_operand:DI 0 "s_register_operand" "r")
7404		      (const_int 0)))
7405   (clobber (match_scratch:SI 1 "=r"))]
7406  "TARGET_32BIT"
7407  "orrs%?\\t%1, %Q0, %R0"
7408  [(set_attr "conds" "set")
7409   (set_attr "type" "logics_reg")]
7410)
7411
7412; This insn allows redundant compares to be removed by cse, nothing should
7413; ever appear in the output file since (set (reg x) (reg x)) is a no-op that
7414; is deleted later on. The match_dup will match the mode here, so that
7415; mode changes of the condition codes aren't lost by this even though we don't
7416; specify what they are.
7417
7418(define_insn "*deleted_compare"
7419  [(set (match_operand 0 "cc_register" "") (match_dup 0))]
7420  "TARGET_32BIT"
7421  "\\t%@ deleted compare"
7422  [(set_attr "conds" "set")
7423   (set_attr "length" "0")
7424   (set_attr "type" "no_insn")]
7425)
7426
7427
7428;; Conditional branch insns
7429
7430(define_expand "cbranch_cc"
7431  [(set (pc)
7432	(if_then_else (match_operator 0 "" [(match_operand 1 "" "")
7433					    (match_operand 2 "" "")])
7434		      (label_ref (match_operand 3 "" ""))
7435		      (pc)))]
7436  "TARGET_32BIT"
7437  "operands[1] = arm_gen_compare_reg (GET_CODE (operands[0]),
7438				      operands[1], operands[2], NULL_RTX);
7439   operands[2] = const0_rtx;"
7440)
7441
7442;;
7443;; Patterns to match conditional branch insns.
7444;;
7445
7446(define_insn "arm_cond_branch"
7447  [(set (pc)
7448	(if_then_else (match_operator 1 "arm_comparison_operator"
7449		       [(match_operand 2 "cc_register" "") (const_int 0)])
7450		      (label_ref (match_operand 0 "" ""))
7451		      (pc)))]
7452  "TARGET_32BIT"
7453  {
7454    if (arm_ccfsm_state == 1 || arm_ccfsm_state == 2)
7455    {
7456      arm_ccfsm_state += 2;
7457      return "";
7458    }
7459    switch (get_attr_length (insn))
7460      {
7461	case 2: /* Thumb2 16-bit b{cond}.  */
7462	case 4: /* Thumb2 32-bit b{cond} or A32 b{cond}.  */
7463	  return "b%d1\t%l0";
7464	  break;
7465
7466	/* Thumb2 b{cond} out of range.  Use 16-bit b{cond} and
7467	   unconditional branch b.  */
7468	default: return arm_gen_far_branch (operands, 0, "Lbcond", "b%D1\t");
7469      }
7470  }
7471  [(set_attr "conds" "use")
7472   (set_attr "type" "branch")
7473   (set (attr "length")
7474    (if_then_else (match_test "!TARGET_THUMB2")
7475
7476      ;;Target is not Thumb2, therefore is A32.  Generate b{cond}.
7477      (const_int 4)
7478
7479      ;; Check if target is within 16-bit Thumb2 b{cond} range.
7480      (if_then_else (and (ge (minus (match_dup 0) (pc)) (const_int -250))
7481		         (le (minus (match_dup 0) (pc)) (const_int 256)))
7482
7483	;; Target is Thumb2, within narrow range.
7484	;; Generate b{cond}.
7485	(const_int 2)
7486
7487	;; Check if target is within 32-bit Thumb2 b{cond} range.
7488	(if_then_else (and (ge (minus (match_dup 0) (pc))(const_int -1048568))
7489			   (le (minus (match_dup 0) (pc)) (const_int 1048576)))
7490
7491	  ;; Target is Thumb2, within wide range.
7492	  ;; Generate b{cond}
7493	  (const_int 4)
7494	  ;; Target is Thumb2, out of range.
7495	  ;; Generate narrow b{cond} and unconditional branch b.
7496	  (const_int 6)))))]
7497)
7498
7499(define_insn "*arm_cond_branch_reversed"
7500  [(set (pc)
7501	(if_then_else (match_operator 1 "arm_comparison_operator"
7502		       [(match_operand 2 "cc_register" "") (const_int 0)])
7503		      (pc)
7504		      (label_ref (match_operand 0 "" ""))))]
7505  "TARGET_32BIT"
7506  {
7507    if (arm_ccfsm_state == 1 || arm_ccfsm_state == 2)
7508      {
7509	arm_ccfsm_state += 2;
7510	return "";
7511      }
7512    switch (get_attr_length (insn))
7513      {
7514	case 2: /* Thumb2 16-bit b{cond}.  */
7515	case 4: /* Thumb2 32-bit b{cond} or A32 b{cond}.  */
7516	  return "b%D1\t%l0";
7517	  break;
7518
7519	/* Thumb2 b{cond} out of range.  Use 16-bit b{cond} and
7520	   unconditional branch b.  */
7521	default: return arm_gen_far_branch (operands, 0, "Lbcond", "b%d1\t");
7522      }
7523  }
7524[(set_attr "conds" "use")
7525   (set_attr "type" "branch")
7526   (set (attr "length")
7527    (if_then_else (match_test "!TARGET_THUMB2")
7528
7529      ;;Target is not Thumb2, therefore is A32.  Generate b{cond}.
7530      (const_int 4)
7531
7532      ;; Check if target is within 16-bit Thumb2 b{cond} range.
7533      (if_then_else (and (ge (minus (match_dup 0) (pc)) (const_int -250))
7534			 (le (minus (match_dup 0) (pc)) (const_int 256)))
7535
7536	;; Target is Thumb2, within narrow range.
7537	;; Generate b{cond}.
7538	(const_int 2)
7539
7540	;; Check if target is within 32-bit Thumb2 b{cond} range.
7541	(if_then_else (and (ge (minus (match_dup 0) (pc))(const_int -1048568))
7542			   (le (minus (match_dup 0) (pc)) (const_int 1048576)))
7543
7544	  ;; Target is Thumb2, within wide range.
7545	  ;; Generate b{cond}.
7546	  (const_int 4)
7547	  ;; Target is Thumb2, out of range.
7548	  ;; Generate narrow b{cond} and unconditional branch b.
7549	  (const_int 6)))))]
7550)
7551
7552
7553
7554; scc insns
7555
7556(define_expand "cstore_cc"
7557  [(set (match_operand:SI 0 "s_register_operand" "")
7558	(match_operator:SI 1 "" [(match_operand 2 "" "")
7559				 (match_operand 3 "" "")]))]
7560  "TARGET_32BIT"
7561  "operands[2] = arm_gen_compare_reg (GET_CODE (operands[1]),
7562				      operands[2], operands[3], NULL_RTX);
7563   operands[3] = const0_rtx;"
7564)
7565
7566(define_insn_and_split "*mov_scc"
7567  [(set (match_operand:SI 0 "s_register_operand" "=r")
7568	(match_operator:SI 1 "arm_comparison_operator_mode"
7569	 [(match_operand 2 "cc_register" "") (const_int 0)]))]
7570  "TARGET_ARM"
7571  "#"   ; "mov%D1\\t%0, #0\;mov%d1\\t%0, #1"
7572  "TARGET_ARM"
7573  [(set (match_dup 0)
7574        (if_then_else:SI (match_dup 1)
7575                         (const_int 1)
7576                         (const_int 0)))]
7577  ""
7578  [(set_attr "conds" "use")
7579   (set_attr "length" "8")
7580   (set_attr "type" "multiple")]
7581)
7582
7583(define_insn_and_split "*mov_negscc"
7584  [(set (match_operand:SI 0 "s_register_operand" "=r")
7585	(neg:SI (match_operator:SI 1 "arm_comparison_operator_mode"
7586		 [(match_operand 2 "cc_register" "") (const_int 0)])))]
7587  "TARGET_ARM"
7588  "#"   ; "mov%D1\\t%0, #0\;mvn%d1\\t%0, #0"
7589  "TARGET_ARM"
7590  [(set (match_dup 0)
7591        (if_then_else:SI (match_dup 1)
7592                         (match_dup 3)
7593                         (const_int 0)))]
7594  {
7595    operands[3] = GEN_INT (~0);
7596  }
7597  [(set_attr "conds" "use")
7598   (set_attr "length" "8")
7599   (set_attr "type" "multiple")]
7600)
7601
7602(define_insn_and_split "*mov_notscc"
7603  [(set (match_operand:SI 0 "s_register_operand" "=r")
7604	(not:SI (match_operator:SI 1 "arm_comparison_operator"
7605		 [(match_operand 2 "cc_register" "") (const_int 0)])))]
7606  "TARGET_ARM"
7607  "#"   ; "mvn%D1\\t%0, #0\;mvn%d1\\t%0, #1"
7608  "TARGET_ARM"
7609  [(set (match_dup 0)
7610        (if_then_else:SI (match_dup 1)
7611                         (match_dup 3)
7612                         (match_dup 4)))]
7613  {
7614    operands[3] = GEN_INT (~1);
7615    operands[4] = GEN_INT (~0);
7616  }
7617  [(set_attr "conds" "use")
7618   (set_attr "length" "8")
7619   (set_attr "type" "multiple")]
7620)
7621
7622(define_expand "cstoresi4"
7623  [(set (match_operand:SI 0 "s_register_operand" "")
7624	(match_operator:SI 1 "expandable_comparison_operator"
7625	 [(match_operand:SI 2 "s_register_operand" "")
7626	  (match_operand:SI 3 "reg_or_int_operand" "")]))]
7627  "TARGET_32BIT || TARGET_THUMB1"
7628  "{
7629  rtx op3, scratch, scratch2;
7630
7631  if (!TARGET_THUMB1)
7632    {
7633      if (!arm_add_operand (operands[3], SImode))
7634	operands[3] = force_reg (SImode, operands[3]);
7635      emit_insn (gen_cstore_cc (operands[0], operands[1],
7636				operands[2], operands[3]));
7637      DONE;
7638    }
7639
7640  if (operands[3] == const0_rtx)
7641    {
7642      switch (GET_CODE (operands[1]))
7643	{
7644	case EQ:
7645	  emit_insn (gen_cstoresi_eq0_thumb1 (operands[0], operands[2]));
7646	  break;
7647
7648	case NE:
7649	  emit_insn (gen_cstoresi_ne0_thumb1 (operands[0], operands[2]));
7650	  break;
7651
7652	case LE:
7653          scratch = expand_binop (SImode, add_optab, operands[2], constm1_rtx,
7654				  NULL_RTX, 0, OPTAB_WIDEN);
7655          scratch = expand_binop (SImode, ior_optab, operands[2], scratch,
7656				  NULL_RTX, 0, OPTAB_WIDEN);
7657          expand_binop (SImode, lshr_optab, scratch, GEN_INT (31),
7658			operands[0], 1, OPTAB_WIDEN);
7659	  break;
7660
7661        case GE:
7662          scratch = expand_unop (SImode, one_cmpl_optab, operands[2],
7663				 NULL_RTX, 1);
7664          expand_binop (SImode, lshr_optab, scratch, GEN_INT (31),
7665			NULL_RTX, 1, OPTAB_WIDEN);
7666          break;
7667
7668        case GT:
7669          scratch = expand_binop (SImode, ashr_optab, operands[2],
7670				  GEN_INT (31), NULL_RTX, 0, OPTAB_WIDEN);
7671          scratch = expand_binop (SImode, sub_optab, scratch, operands[2],
7672				  NULL_RTX, 0, OPTAB_WIDEN);
7673          expand_binop (SImode, lshr_optab, scratch, GEN_INT (31), operands[0],
7674			0, OPTAB_WIDEN);
7675          break;
7676
7677	/* LT is handled by generic code.  No need for unsigned with 0.  */
7678	default:
7679	  FAIL;
7680	}
7681      DONE;
7682    }
7683
7684  switch (GET_CODE (operands[1]))
7685    {
7686    case EQ:
7687      scratch = expand_binop (SImode, sub_optab, operands[2], operands[3],
7688			      NULL_RTX, 0, OPTAB_WIDEN);
7689      emit_insn (gen_cstoresi_eq0_thumb1 (operands[0], scratch));
7690      break;
7691
7692    case NE:
7693      scratch = expand_binop (SImode, sub_optab, operands[2], operands[3],
7694			      NULL_RTX, 0, OPTAB_WIDEN);
7695      emit_insn (gen_cstoresi_ne0_thumb1 (operands[0], scratch));
7696      break;
7697
7698    case LE:
7699      op3 = force_reg (SImode, operands[3]);
7700
7701      scratch = expand_binop (SImode, lshr_optab, operands[2], GEN_INT (31),
7702			      NULL_RTX, 1, OPTAB_WIDEN);
7703      scratch2 = expand_binop (SImode, ashr_optab, op3, GEN_INT (31),
7704			      NULL_RTX, 0, OPTAB_WIDEN);
7705      emit_insn (gen_thumb1_addsi3_addgeu (operands[0], scratch, scratch2,
7706					  op3, operands[2]));
7707      break;
7708
7709    case GE:
7710      op3 = operands[3];
7711      if (!thumb1_cmp_operand (op3, SImode))
7712        op3 = force_reg (SImode, op3);
7713      scratch = expand_binop (SImode, ashr_optab, operands[2], GEN_INT (31),
7714			      NULL_RTX, 0, OPTAB_WIDEN);
7715      scratch2 = expand_binop (SImode, lshr_optab, op3, GEN_INT (31),
7716			       NULL_RTX, 1, OPTAB_WIDEN);
7717      emit_insn (gen_thumb1_addsi3_addgeu (operands[0], scratch, scratch2,
7718					  operands[2], op3));
7719      break;
7720
7721    case LEU:
7722      op3 = force_reg (SImode, operands[3]);
7723      scratch = force_reg (SImode, const0_rtx);
7724      emit_insn (gen_thumb1_addsi3_addgeu (operands[0], scratch, scratch,
7725					  op3, operands[2]));
7726      break;
7727
7728    case GEU:
7729      op3 = operands[3];
7730      if (!thumb1_cmp_operand (op3, SImode))
7731        op3 = force_reg (SImode, op3);
7732      scratch = force_reg (SImode, const0_rtx);
7733      emit_insn (gen_thumb1_addsi3_addgeu (operands[0], scratch, scratch,
7734					  operands[2], op3));
7735      break;
7736
7737    case LTU:
7738      op3 = operands[3];
7739      if (!thumb1_cmp_operand (op3, SImode))
7740        op3 = force_reg (SImode, op3);
7741      scratch = gen_reg_rtx (SImode);
7742      emit_insn (gen_cstoresi_ltu_thumb1 (operands[0], operands[2], op3));
7743      break;
7744
7745    case GTU:
7746      op3 = force_reg (SImode, operands[3]);
7747      scratch = gen_reg_rtx (SImode);
7748      emit_insn (gen_cstoresi_ltu_thumb1 (operands[0], op3, operands[2]));
7749      break;
7750
7751    /* No good sequences for GT, LT.  */
7752    default:
7753      FAIL;
7754    }
7755  DONE;
7756}")
7757
7758(define_expand "cstorehf4"
7759  [(set (match_operand:SI 0 "s_register_operand")
7760	(match_operator:SI 1 "expandable_comparison_operator"
7761	 [(match_operand:HF 2 "s_register_operand")
7762	  (match_operand:HF 3 "vfp_compare_operand")]))]
7763  "TARGET_VFP_FP16INST"
7764  {
7765    if (!arm_validize_comparison (&operands[1],
7766				  &operands[2],
7767				  &operands[3]))
7768       FAIL;
7769
7770    emit_insn (gen_cstore_cc (operands[0], operands[1],
7771			      operands[2], operands[3]));
7772    DONE;
7773  }
7774)
7775
7776(define_expand "cstoresf4"
7777  [(set (match_operand:SI 0 "s_register_operand" "")
7778	(match_operator:SI 1 "expandable_comparison_operator"
7779	 [(match_operand:SF 2 "s_register_operand" "")
7780	  (match_operand:SF 3 "vfp_compare_operand" "")]))]
7781  "TARGET_32BIT && TARGET_HARD_FLOAT"
7782  "emit_insn (gen_cstore_cc (operands[0], operands[1],
7783			     operands[2], operands[3])); DONE;"
7784)
7785
7786(define_expand "cstoredf4"
7787  [(set (match_operand:SI 0 "s_register_operand" "")
7788	(match_operator:SI 1 "expandable_comparison_operator"
7789	 [(match_operand:DF 2 "s_register_operand" "")
7790	  (match_operand:DF 3 "vfp_compare_operand" "")]))]
7791  "TARGET_32BIT && TARGET_HARD_FLOAT && !TARGET_VFP_SINGLE"
7792  "emit_insn (gen_cstore_cc (operands[0], operands[1],
7793			     operands[2], operands[3])); DONE;"
7794)
7795
7796(define_expand "cstoredi4"
7797  [(set (match_operand:SI 0 "s_register_operand" "")
7798	(match_operator:SI 1 "expandable_comparison_operator"
7799	 [(match_operand:DI 2 "s_register_operand" "")
7800	  (match_operand:DI 3 "cmpdi_operand" "")]))]
7801  "TARGET_32BIT"
7802  "{
7803     if (!arm_validize_comparison (&operands[1],
7804     				   &operands[2],
7805				   &operands[3]))
7806       FAIL;
7807     emit_insn (gen_cstore_cc (operands[0], operands[1], operands[2],
7808		      	         operands[3]));
7809     DONE;
7810   }"
7811)
7812
7813
7814;; Conditional move insns
7815
7816(define_expand "movsicc"
7817  [(set (match_operand:SI 0 "s_register_operand" "")
7818	(if_then_else:SI (match_operand 1 "expandable_comparison_operator" "")
7819			 (match_operand:SI 2 "arm_not_operand" "")
7820			 (match_operand:SI 3 "arm_not_operand" "")))]
7821  "TARGET_32BIT"
7822  "
7823  {
7824    enum rtx_code code;
7825    rtx ccreg;
7826
7827    if (!arm_validize_comparison (&operands[1], &XEXP (operands[1], 0),
7828				  &XEXP (operands[1], 1)))
7829      FAIL;
7830
7831    code = GET_CODE (operands[1]);
7832    ccreg = arm_gen_compare_reg (code, XEXP (operands[1], 0),
7833				 XEXP (operands[1], 1), NULL_RTX);
7834    operands[1] = gen_rtx_fmt_ee (code, VOIDmode, ccreg, const0_rtx);
7835  }"
7836)
7837
7838(define_expand "movhfcc"
7839  [(set (match_operand:HF 0 "s_register_operand")
7840	(if_then_else:HF (match_operand 1 "arm_cond_move_operator")
7841			 (match_operand:HF 2 "s_register_operand")
7842			 (match_operand:HF 3 "s_register_operand")))]
7843  "TARGET_VFP_FP16INST"
7844  "
7845  {
7846    enum rtx_code code = GET_CODE (operands[1]);
7847    rtx ccreg;
7848
7849    if (!arm_validize_comparison (&operands[1], &XEXP (operands[1], 0),
7850				  &XEXP (operands[1], 1)))
7851      FAIL;
7852
7853    code = GET_CODE (operands[1]);
7854    ccreg = arm_gen_compare_reg (code, XEXP (operands[1], 0),
7855				 XEXP (operands[1], 1), NULL_RTX);
7856    operands[1] = gen_rtx_fmt_ee (code, VOIDmode, ccreg, const0_rtx);
7857  }"
7858)
7859
7860(define_expand "movsfcc"
7861  [(set (match_operand:SF 0 "s_register_operand" "")
7862	(if_then_else:SF (match_operand 1 "arm_cond_move_operator" "")
7863			 (match_operand:SF 2 "s_register_operand" "")
7864			 (match_operand:SF 3 "s_register_operand" "")))]
7865  "TARGET_32BIT && TARGET_HARD_FLOAT"
7866  "
7867  {
7868    enum rtx_code code = GET_CODE (operands[1]);
7869    rtx ccreg;
7870
7871    if (!arm_validize_comparison (&operands[1], &XEXP (operands[1], 0),
7872       				  &XEXP (operands[1], 1)))
7873       FAIL;
7874
7875    code = GET_CODE (operands[1]);
7876    ccreg = arm_gen_compare_reg (code, XEXP (operands[1], 0),
7877				 XEXP (operands[1], 1), NULL_RTX);
7878    operands[1] = gen_rtx_fmt_ee (code, VOIDmode, ccreg, const0_rtx);
7879  }"
7880)
7881
7882(define_expand "movdfcc"
7883  [(set (match_operand:DF 0 "s_register_operand" "")
7884	(if_then_else:DF (match_operand 1 "arm_cond_move_operator" "")
7885			 (match_operand:DF 2 "s_register_operand" "")
7886			 (match_operand:DF 3 "s_register_operand" "")))]
7887  "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP_DOUBLE"
7888  "
7889  {
7890    enum rtx_code code = GET_CODE (operands[1]);
7891    rtx ccreg;
7892
7893    if (!arm_validize_comparison (&operands[1], &XEXP (operands[1], 0),
7894       				  &XEXP (operands[1], 1)))
7895       FAIL;
7896    code = GET_CODE (operands[1]);
7897    ccreg = arm_gen_compare_reg (code, XEXP (operands[1], 0),
7898				 XEXP (operands[1], 1), NULL_RTX);
7899    operands[1] = gen_rtx_fmt_ee (code, VOIDmode, ccreg, const0_rtx);
7900  }"
7901)
7902
7903(define_insn "*cmov<mode>"
7904    [(set (match_operand:SDF 0 "s_register_operand" "=<F_constraint>")
7905	(if_then_else:SDF (match_operator 1 "arm_vsel_comparison_operator"
7906			  [(match_operand 2 "cc_register" "") (const_int 0)])
7907			  (match_operand:SDF 3 "s_register_operand"
7908			                      "<F_constraint>")
7909			  (match_operand:SDF 4 "s_register_operand"
7910			                      "<F_constraint>")))]
7911  "TARGET_HARD_FLOAT && TARGET_VFP5 <vfp_double_cond>"
7912  "*
7913  {
7914    enum arm_cond_code code = maybe_get_arm_condition_code (operands[1]);
7915    switch (code)
7916      {
7917      case ARM_GE:
7918      case ARM_GT:
7919      case ARM_EQ:
7920      case ARM_VS:
7921        return \"vsel%d1.<V_if_elem>\\t%<V_reg>0, %<V_reg>3, %<V_reg>4\";
7922      case ARM_LT:
7923      case ARM_LE:
7924      case ARM_NE:
7925      case ARM_VC:
7926        return \"vsel%D1.<V_if_elem>\\t%<V_reg>0, %<V_reg>4, %<V_reg>3\";
7927      default:
7928        gcc_unreachable ();
7929      }
7930    return \"\";
7931  }"
7932  [(set_attr "conds" "use")
7933   (set_attr "type" "fcsel")]
7934)
7935
7936(define_insn "*cmovhf"
7937    [(set (match_operand:HF 0 "s_register_operand" "=t")
7938	(if_then_else:HF (match_operator 1 "arm_vsel_comparison_operator"
7939			 [(match_operand 2 "cc_register" "") (const_int 0)])
7940			  (match_operand:HF 3 "s_register_operand" "t")
7941			  (match_operand:HF 4 "s_register_operand" "t")))]
7942  "TARGET_VFP_FP16INST"
7943  "*
7944  {
7945    enum arm_cond_code code = maybe_get_arm_condition_code (operands[1]);
7946    switch (code)
7947      {
7948      case ARM_GE:
7949      case ARM_GT:
7950      case ARM_EQ:
7951      case ARM_VS:
7952	return \"vsel%d1.f16\\t%0, %3, %4\";
7953      case ARM_LT:
7954      case ARM_LE:
7955      case ARM_NE:
7956      case ARM_VC:
7957	return \"vsel%D1.f16\\t%0, %4, %3\";
7958      default:
7959	gcc_unreachable ();
7960      }
7961    return \"\";
7962  }"
7963  [(set_attr "conds" "use")
7964   (set_attr "type" "fcsel")]
7965)
7966
7967(define_insn_and_split "*movsicc_insn"
7968  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r,r,r,r,r,r")
7969	(if_then_else:SI
7970	 (match_operator 3 "arm_comparison_operator"
7971	  [(match_operand 4 "cc_register" "") (const_int 0)])
7972	 (match_operand:SI 1 "arm_not_operand" "0,0,rI,K,rI,rI,K,K")
7973	 (match_operand:SI 2 "arm_not_operand" "rI,K,0,0,rI,K,rI,K")))]
7974  "TARGET_ARM"
7975  "@
7976   mov%D3\\t%0, %2
7977   mvn%D3\\t%0, #%B2
7978   mov%d3\\t%0, %1
7979   mvn%d3\\t%0, #%B1
7980   #
7981   #
7982   #
7983   #"
7984   ; alt4: mov%d3\\t%0, %1\;mov%D3\\t%0, %2
7985   ; alt5: mov%d3\\t%0, %1\;mvn%D3\\t%0, #%B2
7986   ; alt6: mvn%d3\\t%0, #%B1\;mov%D3\\t%0, %2
7987   ; alt7: mvn%d3\\t%0, #%B1\;mvn%D3\\t%0, #%B2"
7988  "&& reload_completed"
7989  [(const_int 0)]
7990  {
7991    enum rtx_code rev_code;
7992    machine_mode mode;
7993    rtx rev_cond;
7994
7995    emit_insn (gen_rtx_COND_EXEC (VOIDmode,
7996                                  operands[3],
7997                                  gen_rtx_SET (operands[0], operands[1])));
7998
7999    rev_code = GET_CODE (operands[3]);
8000    mode = GET_MODE (operands[4]);
8001    if (mode == CCFPmode || mode == CCFPEmode)
8002      rev_code = reverse_condition_maybe_unordered (rev_code);
8003    else
8004      rev_code = reverse_condition (rev_code);
8005
8006    rev_cond = gen_rtx_fmt_ee (rev_code,
8007                               VOIDmode,
8008                               operands[4],
8009                               const0_rtx);
8010    emit_insn (gen_rtx_COND_EXEC (VOIDmode,
8011                                  rev_cond,
8012                                  gen_rtx_SET (operands[0], operands[2])));
8013    DONE;
8014  }
8015  [(set_attr "length" "4,4,4,4,8,8,8,8")
8016   (set_attr "conds" "use")
8017   (set_attr_alternative "type"
8018                         [(if_then_else (match_operand 2 "const_int_operand" "")
8019                                        (const_string "mov_imm")
8020                                        (const_string "mov_reg"))
8021                          (const_string "mvn_imm")
8022                          (if_then_else (match_operand 1 "const_int_operand" "")
8023                                        (const_string "mov_imm")
8024                                        (const_string "mov_reg"))
8025                          (const_string "mvn_imm")
8026                          (const_string "multiple")
8027                          (const_string "multiple")
8028                          (const_string "multiple")
8029                          (const_string "multiple")])]
8030)
8031
8032(define_insn "*movsfcc_soft_insn"
8033  [(set (match_operand:SF 0 "s_register_operand" "=r,r")
8034	(if_then_else:SF (match_operator 3 "arm_comparison_operator"
8035			  [(match_operand 4 "cc_register" "") (const_int 0)])
8036			 (match_operand:SF 1 "s_register_operand" "0,r")
8037			 (match_operand:SF 2 "s_register_operand" "r,0")))]
8038  "TARGET_ARM && TARGET_SOFT_FLOAT"
8039  "@
8040   mov%D3\\t%0, %2
8041   mov%d3\\t%0, %1"
8042  [(set_attr "conds" "use")
8043   (set_attr "type" "mov_reg")]
8044)
8045
8046
8047;; Jump and linkage insns
8048
8049(define_expand "jump"
8050  [(set (pc)
8051	(label_ref (match_operand 0 "" "")))]
8052  "TARGET_EITHER"
8053  ""
8054)
8055
8056(define_insn "*arm_jump"
8057  [(set (pc)
8058	(label_ref (match_operand 0 "" "")))]
8059  "TARGET_32BIT"
8060  "*
8061  {
8062    if (arm_ccfsm_state == 1 || arm_ccfsm_state == 2)
8063      {
8064        arm_ccfsm_state += 2;
8065        return \"\";
8066      }
8067    return \"b%?\\t%l0\";
8068  }
8069  "
8070  [(set_attr "predicable" "yes")
8071   (set (attr "length")
8072	(if_then_else
8073	   (and (match_test "TARGET_THUMB2")
8074		(and (ge (minus (match_dup 0) (pc)) (const_int -2044))
8075		     (le (minus (match_dup 0) (pc)) (const_int 2048))))
8076	   (const_int 2)
8077	   (const_int 4)))
8078   (set_attr "type" "branch")]
8079)
8080
8081(define_expand "call"
8082  [(parallel [(call (match_operand 0 "memory_operand" "")
8083	            (match_operand 1 "general_operand" ""))
8084	      (use (match_operand 2 "" ""))
8085	      (clobber (reg:SI LR_REGNUM))])]
8086  "TARGET_EITHER"
8087  "
8088  {
8089    rtx callee, pat;
8090    tree addr = MEM_EXPR (operands[0]);
8091
8092    /* In an untyped call, we can get NULL for operand 2.  */
8093    if (operands[2] == NULL_RTX)
8094      operands[2] = const0_rtx;
8095
8096    /* Decide if we should generate indirect calls by loading the
8097       32-bit address of the callee into a register before performing the
8098       branch and link.  */
8099    callee = XEXP (operands[0], 0);
8100    if (GET_CODE (callee) == SYMBOL_REF
8101	? arm_is_long_call_p (SYMBOL_REF_DECL (callee))
8102	: !REG_P (callee))
8103      XEXP (operands[0], 0) = force_reg (Pmode, callee);
8104
8105    if (detect_cmse_nonsecure_call (addr))
8106      {
8107	pat = gen_nonsecure_call_internal (operands[0], operands[1],
8108					   operands[2]);
8109	emit_call_insn (pat);
8110      }
8111    else
8112      {
8113	pat = gen_call_internal (operands[0], operands[1], operands[2]);
8114	arm_emit_call_insn (pat, XEXP (operands[0], 0), false);
8115      }
8116    DONE;
8117  }"
8118)
8119
8120(define_expand "call_internal"
8121  [(parallel [(call (match_operand 0 "memory_operand" "")
8122	            (match_operand 1 "general_operand" ""))
8123	      (use (match_operand 2 "" ""))
8124	      (clobber (reg:SI LR_REGNUM))])])
8125
8126(define_expand "nonsecure_call_internal"
8127  [(parallel [(call (unspec:SI [(match_operand 0 "memory_operand" "")]
8128			       UNSPEC_NONSECURE_MEM)
8129		    (match_operand 1 "general_operand" ""))
8130	      (use (match_operand 2 "" ""))
8131	      (clobber (reg:SI LR_REGNUM))])]
8132  "use_cmse"
8133  "
8134  {
8135    rtx tmp;
8136    tmp = copy_to_suggested_reg (XEXP (operands[0], 0),
8137				 gen_rtx_REG (SImode, R4_REGNUM),
8138				 SImode);
8139
8140    operands[0] = replace_equiv_address (operands[0], tmp);
8141  }")
8142
8143(define_insn "*call_reg_armv5"
8144  [(call (mem:SI (match_operand:SI 0 "s_register_operand" "r"))
8145         (match_operand 1 "" ""))
8146   (use (match_operand 2 "" ""))
8147   (clobber (reg:SI LR_REGNUM))]
8148  "TARGET_ARM && arm_arch5 && !SIBLING_CALL_P (insn)"
8149  "blx%?\\t%0"
8150  [(set_attr "type" "call")]
8151)
8152
8153(define_insn "*call_reg_arm"
8154  [(call (mem:SI (match_operand:SI 0 "s_register_operand" "r"))
8155         (match_operand 1 "" ""))
8156   (use (match_operand 2 "" ""))
8157   (clobber (reg:SI LR_REGNUM))]
8158  "TARGET_ARM && !arm_arch5 && !SIBLING_CALL_P (insn)"
8159  "*
8160  return output_call (operands);
8161  "
8162  ;; length is worst case, normally it is only two
8163  [(set_attr "length" "12")
8164   (set_attr "type" "call")]
8165)
8166
8167
8168(define_expand "call_value"
8169  [(parallel [(set (match_operand       0 "" "")
8170	           (call (match_operand 1 "memory_operand" "")
8171		         (match_operand 2 "general_operand" "")))
8172	      (use (match_operand 3 "" ""))
8173	      (clobber (reg:SI LR_REGNUM))])]
8174  "TARGET_EITHER"
8175  "
8176  {
8177    rtx pat, callee;
8178    tree addr = MEM_EXPR (operands[1]);
8179
8180    /* In an untyped call, we can get NULL for operand 2.  */
8181    if (operands[3] == 0)
8182      operands[3] = const0_rtx;
8183
8184    /* Decide if we should generate indirect calls by loading the
8185       32-bit address of the callee into a register before performing the
8186       branch and link.  */
8187    callee = XEXP (operands[1], 0);
8188    if (GET_CODE (callee) == SYMBOL_REF
8189	? arm_is_long_call_p (SYMBOL_REF_DECL (callee))
8190	: !REG_P (callee))
8191      XEXP (operands[1], 0) = force_reg (Pmode, callee);
8192
8193    if (detect_cmse_nonsecure_call (addr))
8194      {
8195	pat = gen_nonsecure_call_value_internal (operands[0], operands[1],
8196						 operands[2], operands[3]);
8197	emit_call_insn (pat);
8198      }
8199    else
8200      {
8201	pat = gen_call_value_internal (operands[0], operands[1],
8202				       operands[2], operands[3]);
8203	arm_emit_call_insn (pat, XEXP (operands[1], 0), false);
8204      }
8205    DONE;
8206  }"
8207)
8208
8209(define_expand "call_value_internal"
8210  [(parallel [(set (match_operand       0 "" "")
8211	           (call (match_operand 1 "memory_operand" "")
8212		         (match_operand 2 "general_operand" "")))
8213	      (use (match_operand 3 "" ""))
8214	      (clobber (reg:SI LR_REGNUM))])])
8215
8216(define_expand "nonsecure_call_value_internal"
8217  [(parallel [(set (match_operand       0 "" "")
8218		   (call (unspec:SI [(match_operand 1 "memory_operand" "")]
8219				    UNSPEC_NONSECURE_MEM)
8220			 (match_operand 2 "general_operand" "")))
8221	      (use (match_operand 3 "" ""))
8222	      (clobber (reg:SI LR_REGNUM))])]
8223  "use_cmse"
8224  "
8225  {
8226    rtx tmp;
8227    tmp = copy_to_suggested_reg (XEXP (operands[1], 0),
8228				 gen_rtx_REG (SImode, R4_REGNUM),
8229				 SImode);
8230
8231    operands[1] = replace_equiv_address (operands[1], tmp);
8232  }")
8233
8234(define_insn "*call_value_reg_armv5"
8235  [(set (match_operand 0 "" "")
8236        (call (mem:SI (match_operand:SI 1 "s_register_operand" "r"))
8237	      (match_operand 2 "" "")))
8238   (use (match_operand 3 "" ""))
8239   (clobber (reg:SI LR_REGNUM))]
8240  "TARGET_ARM && arm_arch5 && !SIBLING_CALL_P (insn)"
8241  "blx%?\\t%1"
8242  [(set_attr "type" "call")]
8243)
8244
8245(define_insn "*call_value_reg_arm"
8246  [(set (match_operand 0 "" "")
8247        (call (mem:SI (match_operand:SI 1 "s_register_operand" "r"))
8248	      (match_operand 2 "" "")))
8249   (use (match_operand 3 "" ""))
8250   (clobber (reg:SI LR_REGNUM))]
8251  "TARGET_ARM && !arm_arch5 && !SIBLING_CALL_P (insn)"
8252  "*
8253  return output_call (&operands[1]);
8254  "
8255  [(set_attr "length" "12")
8256   (set_attr "type" "call")]
8257)
8258
8259;; Allow calls to SYMBOL_REFs specially as they are not valid general addresses
8260;; The 'a' causes the operand to be treated as an address, i.e. no '#' output.
8261
8262(define_insn "*call_symbol"
8263  [(call (mem:SI (match_operand:SI 0 "" ""))
8264	 (match_operand 1 "" ""))
8265   (use (match_operand 2 "" ""))
8266   (clobber (reg:SI LR_REGNUM))]
8267  "TARGET_32BIT
8268   && !SIBLING_CALL_P (insn)
8269   && (GET_CODE (operands[0]) == SYMBOL_REF)
8270   && !arm_is_long_call_p (SYMBOL_REF_DECL (operands[0]))"
8271  "*
8272  {
8273   rtx op = operands[0];
8274
8275   /* Switch mode now when possible.  */
8276   if (SYMBOL_REF_DECL (op) && !TREE_PUBLIC (SYMBOL_REF_DECL (op))
8277        && arm_arch5 && arm_change_mode_p (SYMBOL_REF_DECL (op)))
8278      return NEED_PLT_RELOC ? \"blx%?\\t%a0(PLT)\" : \"blx%?\\t(%a0)\";
8279
8280    return NEED_PLT_RELOC ? \"bl%?\\t%a0(PLT)\" : \"bl%?\\t%a0\";
8281  }"
8282  [(set_attr "type" "call")]
8283)
8284
8285(define_insn "*call_value_symbol"
8286  [(set (match_operand 0 "" "")
8287	(call (mem:SI (match_operand:SI 1 "" ""))
8288	(match_operand:SI 2 "" "")))
8289   (use (match_operand 3 "" ""))
8290   (clobber (reg:SI LR_REGNUM))]
8291  "TARGET_32BIT
8292   && !SIBLING_CALL_P (insn)
8293   && (GET_CODE (operands[1]) == SYMBOL_REF)
8294   && !arm_is_long_call_p (SYMBOL_REF_DECL (operands[1]))"
8295  "*
8296  {
8297   rtx op = operands[1];
8298
8299   /* Switch mode now when possible.  */
8300   if (SYMBOL_REF_DECL (op) && !TREE_PUBLIC (SYMBOL_REF_DECL (op))
8301        && arm_arch5 && arm_change_mode_p (SYMBOL_REF_DECL (op)))
8302      return NEED_PLT_RELOC ? \"blx%?\\t%a1(PLT)\" : \"blx%?\\t(%a1)\";
8303
8304    return NEED_PLT_RELOC ? \"bl%?\\t%a1(PLT)\" : \"bl%?\\t%a1\";
8305  }"
8306  [(set_attr "type" "call")]
8307)
8308
8309(define_expand "sibcall_internal"
8310  [(parallel [(call (match_operand 0 "memory_operand" "")
8311		    (match_operand 1 "general_operand" ""))
8312	      (return)
8313	      (use (match_operand 2 "" ""))])])
8314
8315;; We may also be able to do sibcalls for Thumb, but it's much harder...
8316(define_expand "sibcall"
8317  [(parallel [(call (match_operand 0 "memory_operand" "")
8318		    (match_operand 1 "general_operand" ""))
8319	      (return)
8320	      (use (match_operand 2 "" ""))])]
8321  "TARGET_32BIT"
8322  "
8323  {
8324    rtx pat;
8325
8326    if ((!REG_P (XEXP (operands[0], 0))
8327	 && GET_CODE (XEXP (operands[0], 0)) != SYMBOL_REF)
8328	|| (GET_CODE (XEXP (operands[0], 0)) == SYMBOL_REF
8329	    && arm_is_long_call_p (SYMBOL_REF_DECL (XEXP (operands[0], 0)))))
8330     XEXP (operands[0], 0) = force_reg (SImode, XEXP (operands[0], 0));
8331
8332    if (operands[2] == NULL_RTX)
8333      operands[2] = const0_rtx;
8334
8335    pat = gen_sibcall_internal (operands[0], operands[1], operands[2]);
8336    arm_emit_call_insn (pat, operands[0], true);
8337    DONE;
8338  }"
8339)
8340
8341(define_expand "sibcall_value_internal"
8342  [(parallel [(set (match_operand 0 "" "")
8343		   (call (match_operand 1 "memory_operand" "")
8344			 (match_operand 2 "general_operand" "")))
8345	      (return)
8346	      (use (match_operand 3 "" ""))])])
8347
8348(define_expand "sibcall_value"
8349  [(parallel [(set (match_operand 0 "" "")
8350		   (call (match_operand 1 "memory_operand" "")
8351			 (match_operand 2 "general_operand" "")))
8352	      (return)
8353	      (use (match_operand 3 "" ""))])]
8354  "TARGET_32BIT"
8355  "
8356  {
8357    rtx pat;
8358
8359    if ((!REG_P (XEXP (operands[1], 0))
8360	 && GET_CODE (XEXP (operands[1], 0)) != SYMBOL_REF)
8361	|| (GET_CODE (XEXP (operands[1], 0)) == SYMBOL_REF
8362	    && arm_is_long_call_p (SYMBOL_REF_DECL (XEXP (operands[1], 0)))))
8363     XEXP (operands[1], 0) = force_reg (SImode, XEXP (operands[1], 0));
8364
8365    if (operands[3] == NULL_RTX)
8366      operands[3] = const0_rtx;
8367
8368    pat = gen_sibcall_value_internal (operands[0], operands[1],
8369                                      operands[2], operands[3]);
8370    arm_emit_call_insn (pat, operands[1], true);
8371    DONE;
8372  }"
8373)
8374
8375(define_insn "*sibcall_insn"
8376 [(call (mem:SI (match_operand:SI 0 "call_insn_operand" "Cs, US"))
8377	(match_operand 1 "" ""))
8378  (return)
8379  (use (match_operand 2 "" ""))]
8380  "TARGET_32BIT && SIBLING_CALL_P (insn)"
8381  "*
8382  if (which_alternative == 1)
8383    return NEED_PLT_RELOC ? \"b%?\\t%a0(PLT)\" : \"b%?\\t%a0\";
8384  else
8385    {
8386      if (arm_arch5 || arm_arch4t)
8387	return \"bx%?\\t%0\\t%@ indirect register sibling call\";
8388      else
8389	return \"mov%?\\t%|pc, %0\\t%@ indirect register sibling call\";
8390    }
8391  "
8392  [(set_attr "type" "call")]
8393)
8394
8395(define_insn "*sibcall_value_insn"
8396 [(set (match_operand 0 "" "")
8397       (call (mem:SI (match_operand:SI 1 "call_insn_operand" "Cs,US"))
8398	     (match_operand 2 "" "")))
8399  (return)
8400  (use (match_operand 3 "" ""))]
8401  "TARGET_32BIT && SIBLING_CALL_P (insn)"
8402  "*
8403  if (which_alternative == 1)
8404   return NEED_PLT_RELOC ? \"b%?\\t%a1(PLT)\" : \"b%?\\t%a1\";
8405  else
8406    {
8407      if (arm_arch5 || arm_arch4t)
8408	return \"bx%?\\t%1\";
8409      else
8410	return \"mov%?\\t%|pc, %1\\t@ indirect sibling call \";
8411    }
8412  "
8413  [(set_attr "type" "call")]
8414)
8415
8416(define_expand "<return_str>return"
8417  [(RETURNS)]
8418  "(TARGET_ARM || (TARGET_THUMB2
8419                   && ARM_FUNC_TYPE (arm_current_func_type ()) == ARM_FT_NORMAL
8420                   && !IS_STACKALIGN (arm_current_func_type ())))
8421    <return_cond_false>"
8422  "
8423  {
8424    if (TARGET_THUMB2)
8425      {
8426        thumb2_expand_return (<return_simple_p>);
8427        DONE;
8428      }
8429  }
8430  "
8431)
8432
8433;; Often the return insn will be the same as loading from memory, so set attr
8434(define_insn "*arm_return"
8435  [(return)]
8436  "TARGET_ARM && USE_RETURN_INSN (FALSE)"
8437  "*
8438  {
8439    if (arm_ccfsm_state == 2)
8440      {
8441        arm_ccfsm_state += 2;
8442        return \"\";
8443      }
8444    return output_return_instruction (const_true_rtx, true, false, false);
8445  }"
8446  [(set_attr "type" "load_4")
8447   (set_attr "length" "12")
8448   (set_attr "predicable" "yes")]
8449)
8450
8451(define_insn "*cond_<return_str>return"
8452  [(set (pc)
8453        (if_then_else (match_operator 0 "arm_comparison_operator"
8454		       [(match_operand 1 "cc_register" "") (const_int 0)])
8455                      (RETURNS)
8456                      (pc)))]
8457  "TARGET_ARM  <return_cond_true>"
8458  "*
8459  {
8460    if (arm_ccfsm_state == 2)
8461      {
8462        arm_ccfsm_state += 2;
8463        return \"\";
8464      }
8465    return output_return_instruction (operands[0], true, false,
8466				      <return_simple_p>);
8467  }"
8468  [(set_attr "conds" "use")
8469   (set_attr "length" "12")
8470   (set_attr "type" "load_4")]
8471)
8472
8473(define_insn "*cond_<return_str>return_inverted"
8474  [(set (pc)
8475        (if_then_else (match_operator 0 "arm_comparison_operator"
8476		       [(match_operand 1 "cc_register" "") (const_int 0)])
8477                      (pc)
8478		      (RETURNS)))]
8479  "TARGET_ARM <return_cond_true>"
8480  "*
8481  {
8482    if (arm_ccfsm_state == 2)
8483      {
8484        arm_ccfsm_state += 2;
8485        return \"\";
8486      }
8487    return output_return_instruction (operands[0], true, true,
8488				      <return_simple_p>);
8489  }"
8490  [(set_attr "conds" "use")
8491   (set_attr "length" "12")
8492   (set_attr "type" "load_4")]
8493)
8494
8495(define_insn "*arm_simple_return"
8496  [(simple_return)]
8497  "TARGET_ARM"
8498  "*
8499  {
8500    if (arm_ccfsm_state == 2)
8501      {
8502        arm_ccfsm_state += 2;
8503        return \"\";
8504      }
8505    return output_return_instruction (const_true_rtx, true, false, true);
8506  }"
8507  [(set_attr "type" "branch")
8508   (set_attr "length" "4")
8509   (set_attr "predicable" "yes")]
8510)
8511
8512;; Generate a sequence of instructions to determine if the processor is
8513;; in 26-bit or 32-bit mode, and return the appropriate return address
8514;; mask.
8515
8516(define_expand "return_addr_mask"
8517  [(set (match_dup 1)
8518      (compare:CC_NOOV (unspec [(const_int 0)] UNSPEC_CHECK_ARCH)
8519		       (const_int 0)))
8520   (set (match_operand:SI 0 "s_register_operand" "")
8521      (if_then_else:SI (eq (match_dup 1) (const_int 0))
8522		       (const_int -1)
8523		       (const_int 67108860)))] ; 0x03fffffc
8524  "TARGET_ARM"
8525  "
8526  operands[1] = gen_rtx_REG (CC_NOOVmode, CC_REGNUM);
8527  ")
8528
8529(define_insn "*check_arch2"
8530  [(set (match_operand:CC_NOOV 0 "cc_register" "")
8531      (compare:CC_NOOV (unspec [(const_int 0)] UNSPEC_CHECK_ARCH)
8532		       (const_int 0)))]
8533  "TARGET_ARM"
8534  "teq\\t%|r0, %|r0\;teq\\t%|pc, %|pc"
8535  [(set_attr "length" "8")
8536   (set_attr "conds" "set")
8537   (set_attr "type" "multiple")]
8538)
8539
8540;; Call subroutine returning any type.
8541
8542(define_expand "untyped_call"
8543  [(parallel [(call (match_operand 0 "" "")
8544		    (const_int 0))
8545	      (match_operand 1 "" "")
8546	      (match_operand 2 "" "")])]
8547  "TARGET_EITHER"
8548  "
8549  {
8550    int i;
8551    rtx par = gen_rtx_PARALLEL (VOIDmode,
8552				rtvec_alloc (XVECLEN (operands[2], 0)));
8553    rtx addr = gen_reg_rtx (Pmode);
8554    rtx mem;
8555    int size = 0;
8556
8557    emit_move_insn (addr, XEXP (operands[1], 0));
8558    mem = change_address (operands[1], BLKmode, addr);
8559
8560    for (i = 0; i < XVECLEN (operands[2], 0); i++)
8561      {
8562	rtx src = SET_SRC (XVECEXP (operands[2], 0, i));
8563
8564	/* Default code only uses r0 as a return value, but we could
8565	   be using anything up to 4 registers.  */
8566	if (REGNO (src) == R0_REGNUM)
8567	  src = gen_rtx_REG (TImode, R0_REGNUM);
8568
8569        XVECEXP (par, 0, i) = gen_rtx_EXPR_LIST (VOIDmode, src,
8570						 GEN_INT (size));
8571        size += GET_MODE_SIZE (GET_MODE (src));
8572      }
8573
8574    emit_call_insn (gen_call_value (par, operands[0], const0_rtx, NULL));
8575
8576    size = 0;
8577
8578    for (i = 0; i < XVECLEN (par, 0); i++)
8579      {
8580	HOST_WIDE_INT offset = 0;
8581	rtx reg = XEXP (XVECEXP (par, 0, i), 0);
8582
8583	if (size != 0)
8584	  emit_move_insn (addr, plus_constant (Pmode, addr, size));
8585
8586	mem = change_address (mem, GET_MODE (reg), NULL);
8587	if (REGNO (reg) == R0_REGNUM)
8588	  {
8589	    /* On thumb we have to use a write-back instruction.  */
8590	    emit_insn (arm_gen_store_multiple (arm_regs_in_sequence, 4, addr,
8591 		       TARGET_THUMB ? TRUE : FALSE, mem, &offset));
8592	    size = TARGET_ARM ? 16 : 0;
8593	  }
8594	else
8595	  {
8596	    emit_move_insn (mem, reg);
8597	    size = GET_MODE_SIZE (GET_MODE (reg));
8598	  }
8599      }
8600
8601    /* The optimizer does not know that the call sets the function value
8602       registers we stored in the result block.  We avoid problems by
8603       claiming that all hard registers are used and clobbered at this
8604       point.  */
8605    emit_insn (gen_blockage ());
8606
8607    DONE;
8608  }"
8609)
8610
8611(define_expand "untyped_return"
8612  [(match_operand:BLK 0 "memory_operand" "")
8613   (match_operand 1 "" "")]
8614  "TARGET_EITHER"
8615  "
8616  {
8617    int i;
8618    rtx addr = gen_reg_rtx (Pmode);
8619    rtx mem;
8620    int size = 0;
8621
8622    emit_move_insn (addr, XEXP (operands[0], 0));
8623    mem = change_address (operands[0], BLKmode, addr);
8624
8625    for (i = 0; i < XVECLEN (operands[1], 0); i++)
8626      {
8627	HOST_WIDE_INT offset = 0;
8628	rtx reg = SET_DEST (XVECEXP (operands[1], 0, i));
8629
8630	if (size != 0)
8631	  emit_move_insn (addr, plus_constant (Pmode, addr, size));
8632
8633	mem = change_address (mem, GET_MODE (reg), NULL);
8634	if (REGNO (reg) == R0_REGNUM)
8635	  {
8636	    /* On thumb we have to use a write-back instruction.  */
8637	    emit_insn (arm_gen_load_multiple (arm_regs_in_sequence, 4, addr,
8638 		       TARGET_THUMB ? TRUE : FALSE, mem, &offset));
8639	    size = TARGET_ARM ? 16 : 0;
8640	  }
8641	else
8642	  {
8643	    emit_move_insn (reg, mem);
8644	    size = GET_MODE_SIZE (GET_MODE (reg));
8645	  }
8646      }
8647
8648    /* Emit USE insns before the return.  */
8649    for (i = 0; i < XVECLEN (operands[1], 0); i++)
8650      emit_use (SET_DEST (XVECEXP (operands[1], 0, i)));
8651
8652    /* Construct the return.  */
8653    expand_naked_return ();
8654
8655    DONE;
8656  }"
8657)
8658
8659;; UNSPEC_VOLATILE is considered to use and clobber all hard registers and
8660;; all of memory.  This blocks insns from being moved across this point.
8661
8662(define_insn "blockage"
8663  [(unspec_volatile [(const_int 0)] VUNSPEC_BLOCKAGE)]
8664  "TARGET_EITHER"
8665  ""
8666  [(set_attr "length" "0")
8667   (set_attr "type" "block")]
8668)
8669
8670;; Since we hard code r0 here use the 'o' constraint to prevent
8671;; provoking undefined behaviour in the hardware with putting out
8672;; auto-increment operations with potentially r0 as the base register.
8673(define_insn "probe_stack"
8674  [(set (match_operand:SI 0 "memory_operand" "=o")
8675        (unspec:SI [(const_int 0)] UNSPEC_PROBE_STACK))]
8676  "TARGET_32BIT"
8677  "str%?\\tr0, %0"
8678  [(set_attr "type" "store_4")
8679   (set_attr "predicable" "yes")]
8680)
8681
8682(define_insn "probe_stack_range"
8683  [(set (match_operand:SI 0 "register_operand" "=r")
8684	(unspec_volatile:SI [(match_operand:SI 1 "register_operand" "0")
8685			     (match_operand:SI 2 "register_operand" "r")]
8686			     VUNSPEC_PROBE_STACK_RANGE))]
8687  "TARGET_32BIT"
8688{
8689  return output_probe_stack_range (operands[0], operands[2]);
8690}
8691  [(set_attr "type" "multiple")
8692   (set_attr "conds" "clob")]
8693)
8694
8695(define_expand "casesi"
8696  [(match_operand:SI 0 "s_register_operand" "")	; index to jump on
8697   (match_operand:SI 1 "const_int_operand" "")	; lower bound
8698   (match_operand:SI 2 "const_int_operand" "")	; total range
8699   (match_operand:SI 3 "" "")			; table label
8700   (match_operand:SI 4 "" "")]			; Out of range label
8701  "(TARGET_32BIT || optimize_size || flag_pic) && !target_pure_code"
8702  "
8703  {
8704    enum insn_code code;
8705    if (operands[1] != const0_rtx)
8706      {
8707	rtx reg = gen_reg_rtx (SImode);
8708
8709	emit_insn (gen_addsi3 (reg, operands[0],
8710			       gen_int_mode (-INTVAL (operands[1]),
8711			       		     SImode)));
8712	operands[0] = reg;
8713      }
8714
8715    if (TARGET_ARM)
8716      code = CODE_FOR_arm_casesi_internal;
8717    else if (TARGET_THUMB1)
8718      code = CODE_FOR_thumb1_casesi_internal_pic;
8719    else if (flag_pic)
8720      code = CODE_FOR_thumb2_casesi_internal_pic;
8721    else
8722      code = CODE_FOR_thumb2_casesi_internal;
8723
8724    if (!insn_data[(int) code].operand[1].predicate(operands[2], SImode))
8725      operands[2] = force_reg (SImode, operands[2]);
8726
8727    emit_jump_insn (GEN_FCN ((int) code) (operands[0], operands[2],
8728					  operands[3], operands[4]));
8729    DONE;
8730  }"
8731)
8732
8733;; The USE in this pattern is needed to tell flow analysis that this is
8734;; a CASESI insn.  It has no other purpose.
8735(define_insn "arm_casesi_internal"
8736  [(parallel [(set (pc)
8737	       (if_then_else
8738		(leu (match_operand:SI 0 "s_register_operand" "r")
8739		     (match_operand:SI 1 "arm_rhs_operand" "rI"))
8740		(mem:SI (plus:SI (mult:SI (match_dup 0) (const_int 4))
8741				 (label_ref (match_operand 2 "" ""))))
8742		(label_ref (match_operand 3 "" ""))))
8743	      (clobber (reg:CC CC_REGNUM))
8744	      (use (label_ref (match_dup 2)))])]
8745  "TARGET_ARM"
8746  "*
8747    if (flag_pic)
8748      return \"cmp\\t%0, %1\;addls\\t%|pc, %|pc, %0, asl #2\;b\\t%l3\";
8749    return   \"cmp\\t%0, %1\;ldrls\\t%|pc, [%|pc, %0, asl #2]\;b\\t%l3\";
8750  "
8751  [(set_attr "conds" "clob")
8752   (set_attr "length" "12")
8753   (set_attr "type" "multiple")]
8754)
8755
8756(define_expand "indirect_jump"
8757  [(set (pc)
8758	(match_operand:SI 0 "s_register_operand" ""))]
8759  "TARGET_EITHER"
8760  "
8761  /* Thumb-2 doesn't have mov pc, reg.  Explicitly set the low bit of the
8762     address and use bx.  */
8763  if (TARGET_THUMB2)
8764    {
8765      rtx tmp;
8766      tmp = gen_reg_rtx (SImode);
8767      emit_insn (gen_iorsi3 (tmp, operands[0], GEN_INT(1)));
8768      operands[0] = tmp;
8769    }
8770  "
8771)
8772
8773;; NB Never uses BX.
8774(define_insn "*arm_indirect_jump"
8775  [(set (pc)
8776	(match_operand:SI 0 "s_register_operand" "r"))]
8777  "TARGET_ARM"
8778  "mov%?\\t%|pc, %0\\t%@ indirect register jump"
8779  [(set_attr "predicable" "yes")
8780   (set_attr "type" "branch")]
8781)
8782
8783(define_insn "*load_indirect_jump"
8784  [(set (pc)
8785	(match_operand:SI 0 "memory_operand" "m"))]
8786  "TARGET_ARM"
8787  "ldr%?\\t%|pc, %0\\t%@ indirect memory jump"
8788  [(set_attr "type" "load_4")
8789   (set_attr "pool_range" "4096")
8790   (set_attr "neg_pool_range" "4084")
8791   (set_attr "predicable" "yes")]
8792)
8793
8794
8795;; Misc insns
8796
8797(define_insn "nop"
8798  [(const_int 0)]
8799  "TARGET_EITHER"
8800  "nop"
8801  [(set (attr "length")
8802	(if_then_else (eq_attr "is_thumb" "yes")
8803		      (const_int 2)
8804		      (const_int 4)))
8805   (set_attr "type" "mov_reg")]
8806)
8807
8808(define_insn "trap"
8809  [(trap_if (const_int 1) (const_int 0))]
8810  ""
8811  "*
8812  if (TARGET_ARM)
8813    return \".inst\\t0xe7f000f0\";
8814  else
8815    return \".inst\\t0xdeff\";
8816  "
8817  [(set (attr "length")
8818	(if_then_else (eq_attr "is_thumb" "yes")
8819		      (const_int 2)
8820		      (const_int 4)))
8821   (set_attr "type" "trap")
8822   (set_attr "conds" "unconditional")]
8823)
8824
8825
8826;; Patterns to allow combination of arithmetic, cond code and shifts
8827
8828(define_insn "*<arith_shift_insn>_multsi"
8829  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
8830	(SHIFTABLE_OPS:SI
8831	 (mult:SI (match_operand:SI 2 "s_register_operand" "r,r")
8832		  (match_operand:SI 3 "power_of_two_operand" ""))
8833	 (match_operand:SI 1 "s_register_operand" "rk,<t2_binop0>")))]
8834  "TARGET_32BIT"
8835  "<arith_shift_insn>%?\\t%0, %1, %2, lsl %b3"
8836  [(set_attr "predicable" "yes")
8837   (set_attr "shift" "2")
8838   (set_attr "arch" "a,t2")
8839   (set_attr "type" "alu_shift_imm")])
8840
8841(define_insn "*<arith_shift_insn>_shiftsi"
8842  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
8843	(SHIFTABLE_OPS:SI
8844	 (match_operator:SI 2 "shift_nomul_operator"
8845	  [(match_operand:SI 3 "s_register_operand" "r,r,r")
8846	   (match_operand:SI 4 "shift_amount_operand" "M,M,r")])
8847	 (match_operand:SI 1 "s_register_operand" "rk,<t2_binop0>,rk")))]
8848  "TARGET_32BIT && GET_CODE (operands[2]) != MULT"
8849  "<arith_shift_insn>%?\\t%0, %1, %3%S2"
8850  [(set_attr "predicable" "yes")
8851   (set_attr "shift" "3")
8852   (set_attr "arch" "a,t2,a")
8853   (set_attr "type" "alu_shift_imm,alu_shift_imm,alu_shift_reg")])
8854
8855(define_split
8856  [(set (match_operand:SI 0 "s_register_operand" "")
8857	(match_operator:SI 1 "shiftable_operator"
8858	 [(match_operator:SI 2 "shiftable_operator"
8859	   [(match_operator:SI 3 "shift_operator"
8860	     [(match_operand:SI 4 "s_register_operand" "")
8861	      (match_operand:SI 5 "reg_or_int_operand" "")])
8862	    (match_operand:SI 6 "s_register_operand" "")])
8863	  (match_operand:SI 7 "arm_rhs_operand" "")]))
8864   (clobber (match_operand:SI 8 "s_register_operand" ""))]
8865  "TARGET_32BIT"
8866  [(set (match_dup 8)
8867	(match_op_dup 2 [(match_op_dup 3 [(match_dup 4) (match_dup 5)])
8868			 (match_dup 6)]))
8869   (set (match_dup 0)
8870	(match_op_dup 1 [(match_dup 8) (match_dup 7)]))]
8871  "")
8872
8873(define_insn "*arith_shiftsi_compare0"
8874  [(set (reg:CC_NOOV CC_REGNUM)
8875        (compare:CC_NOOV
8876	 (match_operator:SI 1 "shiftable_operator"
8877	  [(match_operator:SI 3 "shift_operator"
8878	    [(match_operand:SI 4 "s_register_operand" "r,r")
8879	     (match_operand:SI 5 "shift_amount_operand" "M,r")])
8880	   (match_operand:SI 2 "s_register_operand" "r,r")])
8881	 (const_int 0)))
8882   (set (match_operand:SI 0 "s_register_operand" "=r,r")
8883	(match_op_dup 1 [(match_op_dup 3 [(match_dup 4) (match_dup 5)])
8884			 (match_dup 2)]))]
8885  "TARGET_32BIT"
8886  "%i1s%?\\t%0, %2, %4%S3"
8887  [(set_attr "conds" "set")
8888   (set_attr "shift" "4")
8889   (set_attr "arch" "32,a")
8890   (set_attr "type" "alus_shift_imm,alus_shift_reg")])
8891
8892(define_insn "*arith_shiftsi_compare0_scratch"
8893  [(set (reg:CC_NOOV CC_REGNUM)
8894        (compare:CC_NOOV
8895	 (match_operator:SI 1 "shiftable_operator"
8896	  [(match_operator:SI 3 "shift_operator"
8897	    [(match_operand:SI 4 "s_register_operand" "r,r")
8898	     (match_operand:SI 5 "shift_amount_operand" "M,r")])
8899	   (match_operand:SI 2 "s_register_operand" "r,r")])
8900	 (const_int 0)))
8901   (clobber (match_scratch:SI 0 "=r,r"))]
8902  "TARGET_32BIT"
8903  "%i1s%?\\t%0, %2, %4%S3"
8904  [(set_attr "conds" "set")
8905   (set_attr "shift" "4")
8906   (set_attr "arch" "32,a")
8907   (set_attr "type" "alus_shift_imm,alus_shift_reg")])
8908
8909(define_insn "*sub_shiftsi"
8910  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
8911	(minus:SI (match_operand:SI 1 "s_register_operand" "r,r")
8912		  (match_operator:SI 2 "shift_operator"
8913		   [(match_operand:SI 3 "s_register_operand" "r,r")
8914		    (match_operand:SI 4 "shift_amount_operand" "M,r")])))]
8915  "TARGET_32BIT"
8916  "sub%?\\t%0, %1, %3%S2"
8917  [(set_attr "predicable" "yes")
8918   (set_attr "predicable_short_it" "no")
8919   (set_attr "shift" "3")
8920   (set_attr "arch" "32,a")
8921   (set_attr "type" "alus_shift_imm,alus_shift_reg")])
8922
8923(define_insn "*sub_shiftsi_compare0"
8924  [(set (reg:CC_NOOV CC_REGNUM)
8925	(compare:CC_NOOV
8926	 (minus:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
8927		   (match_operator:SI 2 "shift_operator"
8928		    [(match_operand:SI 3 "s_register_operand" "r,r,r")
8929		     (match_operand:SI 4 "shift_amount_operand" "M,r,M")]))
8930	 (const_int 0)))
8931   (set (match_operand:SI 0 "s_register_operand" "=r,r,r")
8932	(minus:SI (match_dup 1)
8933		  (match_op_dup 2 [(match_dup 3) (match_dup 4)])))]
8934  "TARGET_32BIT"
8935  "subs%?\\t%0, %1, %3%S2"
8936  [(set_attr "conds" "set")
8937   (set_attr "shift" "3")
8938   (set_attr "arch" "32,a,a")
8939   (set_attr "type" "alus_shift_imm,alus_shift_reg,alus_shift_imm")])
8940
8941(define_insn "*sub_shiftsi_compare0_scratch"
8942  [(set (reg:CC_NOOV CC_REGNUM)
8943	(compare:CC_NOOV
8944	 (minus:SI (match_operand:SI 1 "s_register_operand" "r,r,r")
8945		   (match_operator:SI 2 "shift_operator"
8946		    [(match_operand:SI 3 "s_register_operand" "r,r,r")
8947		     (match_operand:SI 4 "shift_amount_operand" "M,r,M")]))
8948	 (const_int 0)))
8949   (clobber (match_scratch:SI 0 "=r,r,r"))]
8950  "TARGET_32BIT"
8951  "subs%?\\t%0, %1, %3%S2"
8952  [(set_attr "conds" "set")
8953   (set_attr "shift" "3")
8954   (set_attr "arch" "32,a,a")
8955   (set_attr "type" "alus_shift_imm,alus_shift_reg,alus_shift_imm")])
8956
8957
8958(define_insn_and_split "*and_scc"
8959  [(set (match_operand:SI 0 "s_register_operand" "=r")
8960	(and:SI (match_operator:SI 1 "arm_comparison_operator"
8961		 [(match_operand 2 "cc_register" "") (const_int 0)])
8962		(match_operand:SI 3 "s_register_operand" "r")))]
8963  "TARGET_ARM"
8964  "#"   ; "mov%D1\\t%0, #0\;and%d1\\t%0, %3, #1"
8965  "&& reload_completed"
8966  [(cond_exec (match_dup 5) (set (match_dup 0) (const_int 0)))
8967   (cond_exec (match_dup 4) (set (match_dup 0)
8968                                 (and:SI (match_dup 3) (const_int 1))))]
8969  {
8970    machine_mode mode = GET_MODE (operands[2]);
8971    enum rtx_code rc = GET_CODE (operands[1]);
8972
8973    /* Note that operands[4] is the same as operands[1],
8974       but with VOIDmode as the result. */
8975    operands[4] = gen_rtx_fmt_ee (rc, VOIDmode, operands[2], const0_rtx);
8976    if (mode == CCFPmode || mode == CCFPEmode)
8977      rc = reverse_condition_maybe_unordered (rc);
8978    else
8979      rc = reverse_condition (rc);
8980    operands[5] = gen_rtx_fmt_ee (rc, VOIDmode, operands[2], const0_rtx);
8981  }
8982  [(set_attr "conds" "use")
8983   (set_attr "type" "multiple")
8984   (set_attr "length" "8")]
8985)
8986
8987(define_insn_and_split "*ior_scc"
8988  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
8989	(ior:SI (match_operator:SI 1 "arm_comparison_operator"
8990		 [(match_operand 2 "cc_register" "") (const_int 0)])
8991		(match_operand:SI 3 "s_register_operand" "0,?r")))]
8992  "TARGET_ARM"
8993  "@
8994   orr%d1\\t%0, %3, #1
8995   #"
8996  "&& reload_completed
8997   && REGNO (operands [0]) != REGNO (operands[3])"
8998  ;; && which_alternative == 1
8999  ; mov%D1\\t%0, %3\;orr%d1\\t%0, %3, #1
9000  [(cond_exec (match_dup 5) (set (match_dup 0) (match_dup 3)))
9001   (cond_exec (match_dup 4) (set (match_dup 0)
9002                                 (ior:SI (match_dup 3) (const_int 1))))]
9003  {
9004    machine_mode mode = GET_MODE (operands[2]);
9005    enum rtx_code rc = GET_CODE (operands[1]);
9006
9007    /* Note that operands[4] is the same as operands[1],
9008       but with VOIDmode as the result. */
9009    operands[4] = gen_rtx_fmt_ee (rc, VOIDmode, operands[2], const0_rtx);
9010    if (mode == CCFPmode || mode == CCFPEmode)
9011      rc = reverse_condition_maybe_unordered (rc);
9012    else
9013      rc = reverse_condition (rc);
9014    operands[5] = gen_rtx_fmt_ee (rc, VOIDmode, operands[2], const0_rtx);
9015  }
9016  [(set_attr "conds" "use")
9017   (set_attr "length" "4,8")
9018   (set_attr "type" "logic_imm,multiple")]
9019)
9020
9021; A series of splitters for the compare_scc pattern below.  Note that
9022; order is important.
9023(define_split
9024  [(set (match_operand:SI 0 "s_register_operand" "")
9025	(lt:SI (match_operand:SI 1 "s_register_operand" "")
9026	       (const_int 0)))
9027   (clobber (reg:CC CC_REGNUM))]
9028  "TARGET_32BIT && reload_completed"
9029  [(set (match_dup 0) (lshiftrt:SI (match_dup 1) (const_int 31)))])
9030
9031(define_split
9032  [(set (match_operand:SI 0 "s_register_operand" "")
9033	(ge:SI (match_operand:SI 1 "s_register_operand" "")
9034	       (const_int 0)))
9035   (clobber (reg:CC CC_REGNUM))]
9036  "TARGET_32BIT && reload_completed"
9037  [(set (match_dup 0) (not:SI (match_dup 1)))
9038   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 31)))])
9039
9040(define_split
9041  [(set (match_operand:SI 0 "s_register_operand" "")
9042	(eq:SI (match_operand:SI 1 "s_register_operand" "")
9043	       (const_int 0)))
9044   (clobber (reg:CC CC_REGNUM))]
9045  "arm_arch5 && TARGET_32BIT"
9046  [(set (match_dup 0) (clz:SI (match_dup 1)))
9047   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 5)))]
9048)
9049
9050(define_split
9051  [(set (match_operand:SI 0 "s_register_operand" "")
9052	(eq:SI (match_operand:SI 1 "s_register_operand" "")
9053	       (const_int 0)))
9054   (clobber (reg:CC CC_REGNUM))]
9055  "TARGET_32BIT && reload_completed"
9056  [(parallel
9057    [(set (reg:CC CC_REGNUM)
9058	  (compare:CC (const_int 1) (match_dup 1)))
9059     (set (match_dup 0)
9060	  (minus:SI (const_int 1) (match_dup 1)))])
9061   (cond_exec (ltu:CC (reg:CC CC_REGNUM) (const_int 0))
9062	      (set (match_dup 0) (const_int 0)))])
9063
9064(define_split
9065  [(set (match_operand:SI 0 "s_register_operand" "")
9066	(ne:SI (match_operand:SI 1 "s_register_operand" "")
9067	       (match_operand:SI 2 "const_int_operand" "")))
9068   (clobber (reg:CC CC_REGNUM))]
9069  "TARGET_32BIT && reload_completed"
9070  [(parallel
9071    [(set (reg:CC CC_REGNUM)
9072	  (compare:CC (match_dup 1) (match_dup 2)))
9073     (set (match_dup 0) (plus:SI (match_dup 1) (match_dup 3)))])
9074   (cond_exec (ne:CC (reg:CC CC_REGNUM) (const_int 0))
9075	      (set (match_dup 0) (const_int 1)))]
9076{
9077  operands[3] = GEN_INT (-INTVAL (operands[2]));
9078})
9079
9080(define_split
9081  [(set (match_operand:SI 0 "s_register_operand" "")
9082	(ne:SI (match_operand:SI 1 "s_register_operand" "")
9083	       (match_operand:SI 2 "arm_add_operand" "")))
9084   (clobber (reg:CC CC_REGNUM))]
9085  "TARGET_32BIT && reload_completed"
9086  [(parallel
9087    [(set (reg:CC_NOOV CC_REGNUM)
9088	  (compare:CC_NOOV (minus:SI (match_dup 1) (match_dup 2))
9089			   (const_int 0)))
9090     (set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))])
9091   (cond_exec (ne:CC_NOOV (reg:CC_NOOV CC_REGNUM) (const_int 0))
9092	      (set (match_dup 0) (const_int 1)))])
9093
9094(define_insn_and_split "*compare_scc"
9095  [(set (match_operand:SI 0 "s_register_operand" "=Ts,Ts")
9096	(match_operator:SI 1 "arm_comparison_operator"
9097	 [(match_operand:SI 2 "s_register_operand" "r,r")
9098	  (match_operand:SI 3 "arm_add_operand" "rI,L")]))
9099   (clobber (reg:CC CC_REGNUM))]
9100  "TARGET_32BIT"
9101  "#"
9102  "&& reload_completed"
9103  [(set (reg:CC CC_REGNUM) (compare:CC (match_dup 2) (match_dup 3)))
9104   (cond_exec (match_dup 4) (set (match_dup 0) (const_int 0)))
9105   (cond_exec (match_dup 5) (set (match_dup 0) (const_int 1)))]
9106{
9107  rtx tmp1;
9108  machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
9109					   operands[2], operands[3]);
9110  enum rtx_code rc = GET_CODE (operands[1]);
9111
9112  tmp1 = gen_rtx_REG (mode, CC_REGNUM);
9113
9114  operands[5] = gen_rtx_fmt_ee (rc, VOIDmode, tmp1, const0_rtx);
9115  if (mode == CCFPmode || mode == CCFPEmode)
9116    rc = reverse_condition_maybe_unordered (rc);
9117  else
9118    rc = reverse_condition (rc);
9119  operands[4] = gen_rtx_fmt_ee (rc, VOIDmode, tmp1, const0_rtx);
9120}
9121  [(set_attr "type" "multiple")]
9122)
9123
9124;; Attempt to improve the sequence generated by the compare_scc splitters
9125;; not to use conditional execution.
9126
9127;; Rd = (eq (reg1) (const_int0))  // ARMv5
9128;;	clz Rd, reg1
9129;;	lsr Rd, Rd, #5
9130(define_peephole2
9131  [(set (reg:CC CC_REGNUM)
9132	(compare:CC (match_operand:SI 1 "register_operand" "")
9133		    (const_int 0)))
9134   (cond_exec (ne (reg:CC CC_REGNUM) (const_int 0))
9135	      (set (match_operand:SI 0 "register_operand" "") (const_int 0)))
9136   (cond_exec (eq (reg:CC CC_REGNUM) (const_int 0))
9137	      (set (match_dup 0) (const_int 1)))]
9138  "arm_arch5 && TARGET_32BIT && peep2_regno_dead_p (3, CC_REGNUM)"
9139  [(set (match_dup 0) (clz:SI (match_dup 1)))
9140   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 5)))]
9141)
9142
9143;; Rd = (eq (reg1) (const_int0))  // !ARMv5
9144;;	negs Rd, reg1
9145;;	adc  Rd, Rd, reg1
9146(define_peephole2
9147  [(set (reg:CC CC_REGNUM)
9148	(compare:CC (match_operand:SI 1 "register_operand" "")
9149		    (const_int 0)))
9150   (cond_exec (ne (reg:CC CC_REGNUM) (const_int 0))
9151	      (set (match_operand:SI 0 "register_operand" "") (const_int 0)))
9152   (cond_exec (eq (reg:CC CC_REGNUM) (const_int 0))
9153	      (set (match_dup 0) (const_int 1)))
9154   (match_scratch:SI 2 "r")]
9155  "TARGET_32BIT && peep2_regno_dead_p (3, CC_REGNUM)"
9156  [(parallel
9157    [(set (reg:CC CC_REGNUM)
9158	  (compare:CC (const_int 0) (match_dup 1)))
9159     (set (match_dup 2) (minus:SI (const_int 0) (match_dup 1)))])
9160   (set (match_dup 0)
9161	(plus:SI (plus:SI (match_dup 1) (match_dup 2))
9162		 (geu:SI (reg:CC CC_REGNUM) (const_int 0))))]
9163)
9164
9165;; Rd = (eq (reg1) (reg2/imm))	// ARMv5 and optimising for speed.
9166;;	sub  Rd, Reg1, reg2
9167;;	clz  Rd, Rd
9168;;	lsr  Rd, Rd, #5
9169(define_peephole2
9170  [(set (reg:CC CC_REGNUM)
9171	(compare:CC (match_operand:SI 1 "register_operand" "")
9172		    (match_operand:SI 2 "arm_rhs_operand" "")))
9173   (cond_exec (ne (reg:CC CC_REGNUM) (const_int 0))
9174	      (set (match_operand:SI 0 "register_operand" "") (const_int 0)))
9175   (cond_exec (eq (reg:CC CC_REGNUM) (const_int 0))
9176	      (set (match_dup 0) (const_int 1)))]
9177  "arm_arch5 && TARGET_32BIT && peep2_regno_dead_p (3, CC_REGNUM)
9178  && !(TARGET_THUMB2 && optimize_insn_for_size_p ())"
9179  [(set (match_dup 0) (minus:SI (match_dup 1) (match_dup 2)))
9180   (set (match_dup 0) (clz:SI (match_dup 0)))
9181   (set (match_dup 0) (lshiftrt:SI (match_dup 0) (const_int 5)))]
9182)
9183
9184
9185;; Rd = (eq (reg1) (reg2))	// ! ARMv5 or optimising for size.
9186;;	sub  T1, Reg1, reg2
9187;;	negs Rd, T1
9188;;	adc  Rd, Rd, T1
9189(define_peephole2
9190  [(set (reg:CC CC_REGNUM)
9191	(compare:CC (match_operand:SI 1 "register_operand" "")
9192		    (match_operand:SI 2 "arm_rhs_operand" "")))
9193   (cond_exec (ne (reg:CC CC_REGNUM) (const_int 0))
9194	      (set (match_operand:SI 0 "register_operand" "") (const_int 0)))
9195   (cond_exec (eq (reg:CC CC_REGNUM) (const_int 0))
9196	      (set (match_dup 0) (const_int 1)))
9197   (match_scratch:SI 3 "r")]
9198  "TARGET_32BIT && peep2_regno_dead_p (3, CC_REGNUM)"
9199  [(set (match_dup 3) (match_dup 4))
9200   (parallel
9201    [(set (reg:CC CC_REGNUM)
9202	  (compare:CC (const_int 0) (match_dup 3)))
9203     (set (match_dup 0) (minus:SI (const_int 0) (match_dup 3)))])
9204   (set (match_dup 0)
9205	(plus:SI (plus:SI (match_dup 0) (match_dup 3))
9206		 (geu:SI (reg:CC CC_REGNUM) (const_int 0))))]
9207  "
9208  if (CONST_INT_P (operands[2]))
9209    operands[4] = plus_constant (SImode, operands[1], -INTVAL (operands[2]));
9210  else
9211    operands[4] = gen_rtx_MINUS (SImode, operands[1], operands[2]);
9212  ")
9213
9214(define_insn "*cond_move"
9215  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
9216	(if_then_else:SI (match_operator 3 "equality_operator"
9217			  [(match_operator 4 "arm_comparison_operator"
9218			    [(match_operand 5 "cc_register" "") (const_int 0)])
9219			   (const_int 0)])
9220			 (match_operand:SI 1 "arm_rhs_operand" "0,rI,?rI")
9221			 (match_operand:SI 2 "arm_rhs_operand" "rI,0,rI")))]
9222  "TARGET_ARM"
9223  "*
9224    if (GET_CODE (operands[3]) == NE)
9225      {
9226        if (which_alternative != 1)
9227	  output_asm_insn (\"mov%D4\\t%0, %2\", operands);
9228        if (which_alternative != 0)
9229	  output_asm_insn (\"mov%d4\\t%0, %1\", operands);
9230        return \"\";
9231      }
9232    if (which_alternative != 0)
9233      output_asm_insn (\"mov%D4\\t%0, %1\", operands);
9234    if (which_alternative != 1)
9235      output_asm_insn (\"mov%d4\\t%0, %2\", operands);
9236    return \"\";
9237  "
9238  [(set_attr "conds" "use")
9239   (set_attr_alternative "type"
9240                         [(if_then_else (match_operand 2 "const_int_operand" "")
9241                                        (const_string "mov_imm")
9242                                        (const_string "mov_reg"))
9243                          (if_then_else (match_operand 1 "const_int_operand" "")
9244                                        (const_string "mov_imm")
9245                                        (const_string "mov_reg"))
9246                          (const_string "multiple")])
9247   (set_attr "length" "4,4,8")]
9248)
9249
9250(define_insn "*cond_arith"
9251  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9252        (match_operator:SI 5 "shiftable_operator"
9253	 [(match_operator:SI 4 "arm_comparison_operator"
9254           [(match_operand:SI 2 "s_register_operand" "r,r")
9255	    (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])
9256          (match_operand:SI 1 "s_register_operand" "0,?r")]))
9257   (clobber (reg:CC CC_REGNUM))]
9258  "TARGET_ARM"
9259  "*
9260    if (GET_CODE (operands[4]) == LT && operands[3] == const0_rtx)
9261      return \"%i5\\t%0, %1, %2, lsr #31\";
9262
9263    output_asm_insn (\"cmp\\t%2, %3\", operands);
9264    if (GET_CODE (operands[5]) == AND)
9265      output_asm_insn (\"mov%D4\\t%0, #0\", operands);
9266    else if (GET_CODE (operands[5]) == MINUS)
9267      output_asm_insn (\"rsb%D4\\t%0, %1, #0\", operands);
9268    else if (which_alternative != 0)
9269      output_asm_insn (\"mov%D4\\t%0, %1\", operands);
9270    return \"%i5%d4\\t%0, %1, #1\";
9271  "
9272  [(set_attr "conds" "clob")
9273   (set_attr "length" "12")
9274   (set_attr "type" "multiple")]
9275)
9276
9277(define_insn "*cond_sub"
9278  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
9279        (minus:SI (match_operand:SI 1 "s_register_operand" "0,?r")
9280		  (match_operator:SI 4 "arm_comparison_operator"
9281                   [(match_operand:SI 2 "s_register_operand" "r,r")
9282		    (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])))
9283   (clobber (reg:CC CC_REGNUM))]
9284  "TARGET_ARM"
9285  "*
9286    output_asm_insn (\"cmp\\t%2, %3\", operands);
9287    if (which_alternative != 0)
9288      output_asm_insn (\"mov%D4\\t%0, %1\", operands);
9289    return \"sub%d4\\t%0, %1, #1\";
9290  "
9291  [(set_attr "conds" "clob")
9292   (set_attr "length" "8,12")
9293   (set_attr "type" "multiple")]
9294)
9295
9296(define_insn "*cmp_ite0"
9297  [(set (match_operand 6 "dominant_cc_register" "")
9298	(compare
9299	 (if_then_else:SI
9300	  (match_operator 4 "arm_comparison_operator"
9301	   [(match_operand:SI 0 "s_register_operand"
9302	        "l,l,l,r,r,r,r,r,r")
9303	    (match_operand:SI 1 "arm_add_operand"
9304	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
9305	  (match_operator:SI 5 "arm_comparison_operator"
9306	   [(match_operand:SI 2 "s_register_operand"
9307	        "l,r,r,l,l,r,r,r,r")
9308	    (match_operand:SI 3 "arm_add_operand"
9309	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")])
9310	  (const_int 0))
9311	 (const_int 0)))]
9312  "TARGET_32BIT"
9313  "*
9314  {
9315    static const char * const cmp1[NUM_OF_COND_CMP][2] =
9316    {
9317      {\"cmp%d5\\t%0, %1\",
9318       \"cmp%d4\\t%2, %3\"},
9319      {\"cmn%d5\\t%0, #%n1\",
9320       \"cmp%d4\\t%2, %3\"},
9321      {\"cmp%d5\\t%0, %1\",
9322       \"cmn%d4\\t%2, #%n3\"},
9323      {\"cmn%d5\\t%0, #%n1\",
9324       \"cmn%d4\\t%2, #%n3\"}
9325    };
9326    static const char * const cmp2[NUM_OF_COND_CMP][2] =
9327    {
9328      {\"cmp\\t%2, %3\",
9329       \"cmp\\t%0, %1\"},
9330      {\"cmp\\t%2, %3\",
9331       \"cmn\\t%0, #%n1\"},
9332      {\"cmn\\t%2, #%n3\",
9333       \"cmp\\t%0, %1\"},
9334      {\"cmn\\t%2, #%n3\",
9335       \"cmn\\t%0, #%n1\"}
9336    };
9337    static const char * const ite[2] =
9338    {
9339      \"it\\t%d5\",
9340      \"it\\t%d4\"
9341    };
9342    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
9343                                   CMP_CMP, CMN_CMP, CMP_CMP,
9344                                   CMN_CMP, CMP_CMN, CMN_CMN};
9345    int swap =
9346      comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
9347
9348    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
9349    if (TARGET_THUMB2) {
9350      output_asm_insn (ite[swap], operands);
9351    }
9352    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
9353    return \"\";
9354  }"
9355  [(set_attr "conds" "set")
9356   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
9357   (set_attr "enabled_for_short_it" "yes,no,no,no,no,no,no,no,no")
9358   (set_attr "type" "multiple")
9359   (set_attr_alternative "length"
9360      [(const_int 6)
9361       (const_int 8)
9362       (const_int 8)
9363       (const_int 8)
9364       (const_int 8)
9365       (if_then_else (eq_attr "is_thumb" "no")
9366           (const_int 8)
9367           (const_int 10))
9368       (if_then_else (eq_attr "is_thumb" "no")
9369           (const_int 8)
9370           (const_int 10))
9371       (if_then_else (eq_attr "is_thumb" "no")
9372           (const_int 8)
9373           (const_int 10))
9374       (if_then_else (eq_attr "is_thumb" "no")
9375           (const_int 8)
9376           (const_int 10))])]
9377)
9378
9379(define_insn "*cmp_ite1"
9380  [(set (match_operand 6 "dominant_cc_register" "")
9381	(compare
9382	 (if_then_else:SI
9383	  (match_operator 4 "arm_comparison_operator"
9384	   [(match_operand:SI 0 "s_register_operand"
9385	        "l,l,l,r,r,r,r,r,r")
9386	    (match_operand:SI 1 "arm_add_operand"
9387	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
9388	  (match_operator:SI 5 "arm_comparison_operator"
9389	   [(match_operand:SI 2 "s_register_operand"
9390	        "l,r,r,l,l,r,r,r,r")
9391	    (match_operand:SI 3 "arm_add_operand"
9392	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")])
9393	  (const_int 1))
9394	 (const_int 0)))]
9395  "TARGET_32BIT"
9396  "*
9397  {
9398    static const char * const cmp1[NUM_OF_COND_CMP][2] =
9399    {
9400      {\"cmp\\t%0, %1\",
9401       \"cmp\\t%2, %3\"},
9402      {\"cmn\\t%0, #%n1\",
9403       \"cmp\\t%2, %3\"},
9404      {\"cmp\\t%0, %1\",
9405       \"cmn\\t%2, #%n3\"},
9406      {\"cmn\\t%0, #%n1\",
9407       \"cmn\\t%2, #%n3\"}
9408    };
9409    static const char * const cmp2[NUM_OF_COND_CMP][2] =
9410    {
9411      {\"cmp%d4\\t%2, %3\",
9412       \"cmp%D5\\t%0, %1\"},
9413      {\"cmp%d4\\t%2, %3\",
9414       \"cmn%D5\\t%0, #%n1\"},
9415      {\"cmn%d4\\t%2, #%n3\",
9416       \"cmp%D5\\t%0, %1\"},
9417      {\"cmn%d4\\t%2, #%n3\",
9418       \"cmn%D5\\t%0, #%n1\"}
9419    };
9420    static const char * const ite[2] =
9421    {
9422      \"it\\t%d4\",
9423      \"it\\t%D5\"
9424    };
9425    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
9426                                   CMP_CMP, CMN_CMP, CMP_CMP,
9427                                   CMN_CMP, CMP_CMN, CMN_CMN};
9428    int swap =
9429      comparison_dominates_p (GET_CODE (operands[5]),
9430			      reverse_condition (GET_CODE (operands[4])));
9431
9432    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
9433    if (TARGET_THUMB2) {
9434      output_asm_insn (ite[swap], operands);
9435    }
9436    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
9437    return \"\";
9438  }"
9439  [(set_attr "conds" "set")
9440   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
9441   (set_attr "enabled_for_short_it" "yes,no,no,no,no,no,no,no,no")
9442   (set_attr_alternative "length"
9443      [(const_int 6)
9444       (const_int 8)
9445       (const_int 8)
9446       (const_int 8)
9447       (const_int 8)
9448       (if_then_else (eq_attr "is_thumb" "no")
9449           (const_int 8)
9450           (const_int 10))
9451       (if_then_else (eq_attr "is_thumb" "no")
9452           (const_int 8)
9453           (const_int 10))
9454       (if_then_else (eq_attr "is_thumb" "no")
9455           (const_int 8)
9456           (const_int 10))
9457       (if_then_else (eq_attr "is_thumb" "no")
9458           (const_int 8)
9459           (const_int 10))])
9460   (set_attr "type" "multiple")]
9461)
9462
9463(define_insn "*cmp_and"
9464  [(set (match_operand 6 "dominant_cc_register" "")
9465	(compare
9466	 (and:SI
9467	  (match_operator 4 "arm_comparison_operator"
9468	   [(match_operand:SI 0 "s_register_operand"
9469	        "l,l,l,r,r,r,r,r,r")
9470	    (match_operand:SI 1 "arm_add_operand"
9471	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
9472	  (match_operator:SI 5 "arm_comparison_operator"
9473	   [(match_operand:SI 2 "s_register_operand"
9474	        "l,r,r,l,l,r,r,r,r")
9475	    (match_operand:SI 3 "arm_add_operand"
9476	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")]))
9477	 (const_int 0)))]
9478  "TARGET_32BIT"
9479  "*
9480  {
9481    static const char *const cmp1[NUM_OF_COND_CMP][2] =
9482    {
9483      {\"cmp%d5\\t%0, %1\",
9484       \"cmp%d4\\t%2, %3\"},
9485      {\"cmn%d5\\t%0, #%n1\",
9486       \"cmp%d4\\t%2, %3\"},
9487      {\"cmp%d5\\t%0, %1\",
9488       \"cmn%d4\\t%2, #%n3\"},
9489      {\"cmn%d5\\t%0, #%n1\",
9490       \"cmn%d4\\t%2, #%n3\"}
9491    };
9492    static const char *const cmp2[NUM_OF_COND_CMP][2] =
9493    {
9494      {\"cmp\\t%2, %3\",
9495       \"cmp\\t%0, %1\"},
9496      {\"cmp\\t%2, %3\",
9497       \"cmn\\t%0, #%n1\"},
9498      {\"cmn\\t%2, #%n3\",
9499       \"cmp\\t%0, %1\"},
9500      {\"cmn\\t%2, #%n3\",
9501       \"cmn\\t%0, #%n1\"}
9502    };
9503    static const char *const ite[2] =
9504    {
9505      \"it\\t%d5\",
9506      \"it\\t%d4\"
9507    };
9508    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
9509                                   CMP_CMP, CMN_CMP, CMP_CMP,
9510                                   CMN_CMP, CMP_CMN, CMN_CMN};
9511    int swap =
9512      comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
9513
9514    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
9515    if (TARGET_THUMB2) {
9516      output_asm_insn (ite[swap], operands);
9517    }
9518    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
9519    return \"\";
9520  }"
9521  [(set_attr "conds" "set")
9522   (set_attr "predicable" "no")
9523   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
9524   (set_attr "enabled_for_short_it" "yes,no,no,no,no,no,no,no,no")
9525   (set_attr_alternative "length"
9526      [(const_int 6)
9527       (const_int 8)
9528       (const_int 8)
9529       (const_int 8)
9530       (const_int 8)
9531       (if_then_else (eq_attr "is_thumb" "no")
9532           (const_int 8)
9533           (const_int 10))
9534       (if_then_else (eq_attr "is_thumb" "no")
9535           (const_int 8)
9536           (const_int 10))
9537       (if_then_else (eq_attr "is_thumb" "no")
9538           (const_int 8)
9539           (const_int 10))
9540       (if_then_else (eq_attr "is_thumb" "no")
9541           (const_int 8)
9542           (const_int 10))])
9543   (set_attr "type" "multiple")]
9544)
9545
9546(define_insn "*cmp_ior"
9547  [(set (match_operand 6 "dominant_cc_register" "")
9548	(compare
9549	 (ior:SI
9550	  (match_operator 4 "arm_comparison_operator"
9551	   [(match_operand:SI 0 "s_register_operand"
9552	        "l,l,l,r,r,r,r,r,r")
9553	    (match_operand:SI 1 "arm_add_operand"
9554	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
9555	  (match_operator:SI 5 "arm_comparison_operator"
9556	   [(match_operand:SI 2 "s_register_operand"
9557	        "l,r,r,l,l,r,r,r,r")
9558	    (match_operand:SI 3 "arm_add_operand"
9559	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")]))
9560	 (const_int 0)))]
9561  "TARGET_32BIT"
9562  "*
9563  {
9564    static const char *const cmp1[NUM_OF_COND_CMP][2] =
9565    {
9566      {\"cmp\\t%0, %1\",
9567       \"cmp\\t%2, %3\"},
9568      {\"cmn\\t%0, #%n1\",
9569       \"cmp\\t%2, %3\"},
9570      {\"cmp\\t%0, %1\",
9571       \"cmn\\t%2, #%n3\"},
9572      {\"cmn\\t%0, #%n1\",
9573       \"cmn\\t%2, #%n3\"}
9574    };
9575    static const char *const cmp2[NUM_OF_COND_CMP][2] =
9576    {
9577      {\"cmp%D4\\t%2, %3\",
9578       \"cmp%D5\\t%0, %1\"},
9579      {\"cmp%D4\\t%2, %3\",
9580       \"cmn%D5\\t%0, #%n1\"},
9581      {\"cmn%D4\\t%2, #%n3\",
9582       \"cmp%D5\\t%0, %1\"},
9583      {\"cmn%D4\\t%2, #%n3\",
9584       \"cmn%D5\\t%0, #%n1\"}
9585    };
9586    static const char *const ite[2] =
9587    {
9588      \"it\\t%D4\",
9589      \"it\\t%D5\"
9590    };
9591    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
9592                                   CMP_CMP, CMN_CMP, CMP_CMP,
9593                                   CMN_CMP, CMP_CMN, CMN_CMN};
9594    int swap =
9595      comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
9596
9597    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
9598    if (TARGET_THUMB2) {
9599      output_asm_insn (ite[swap], operands);
9600    }
9601    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
9602    return \"\";
9603  }
9604  "
9605  [(set_attr "conds" "set")
9606   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
9607   (set_attr "enabled_for_short_it" "yes,no,no,no,no,no,no,no,no")
9608   (set_attr_alternative "length"
9609      [(const_int 6)
9610       (const_int 8)
9611       (const_int 8)
9612       (const_int 8)
9613       (const_int 8)
9614       (if_then_else (eq_attr "is_thumb" "no")
9615           (const_int 8)
9616           (const_int 10))
9617       (if_then_else (eq_attr "is_thumb" "no")
9618           (const_int 8)
9619           (const_int 10))
9620       (if_then_else (eq_attr "is_thumb" "no")
9621           (const_int 8)
9622           (const_int 10))
9623       (if_then_else (eq_attr "is_thumb" "no")
9624           (const_int 8)
9625           (const_int 10))])
9626   (set_attr "type" "multiple")]
9627)
9628
9629(define_insn_and_split "*ior_scc_scc"
9630  [(set (match_operand:SI 0 "s_register_operand" "=Ts,Ts")
9631	(ior:SI (match_operator:SI 3 "arm_comparison_operator"
9632		 [(match_operand:SI 1 "s_register_operand" "l,r")
9633		  (match_operand:SI 2 "arm_add_operand" "lPy,rIL")])
9634		(match_operator:SI 6 "arm_comparison_operator"
9635		 [(match_operand:SI 4 "s_register_operand" "l,r")
9636		  (match_operand:SI 5 "arm_add_operand" "lPy,rIL")])))
9637   (clobber (reg:CC CC_REGNUM))]
9638  "TARGET_32BIT
9639   && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_OR_Y)
9640       != CCmode)"
9641  "#"
9642  "TARGET_32BIT && reload_completed"
9643  [(set (match_dup 7)
9644	(compare
9645	 (ior:SI
9646	  (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9647	  (match_op_dup 6 [(match_dup 4) (match_dup 5)]))
9648	 (const_int 0)))
9649   (set (match_dup 0) (ne:SI (match_dup 7) (const_int 0)))]
9650  "operands[7]
9651     = gen_rtx_REG (arm_select_dominance_cc_mode (operands[3], operands[6],
9652						  DOM_CC_X_OR_Y),
9653		    CC_REGNUM);"
9654  [(set_attr "conds" "clob")
9655   (set_attr "enabled_for_short_it" "yes,no")
9656   (set_attr "length" "16")
9657   (set_attr "type" "multiple")]
9658)
9659
9660; If the above pattern is followed by a CMP insn, then the compare is
9661; redundant, since we can rework the conditional instruction that follows.
9662(define_insn_and_split "*ior_scc_scc_cmp"
9663  [(set (match_operand 0 "dominant_cc_register" "")
9664	(compare (ior:SI (match_operator:SI 3 "arm_comparison_operator"
9665			  [(match_operand:SI 1 "s_register_operand" "l,r")
9666			   (match_operand:SI 2 "arm_add_operand" "lPy,rIL")])
9667			 (match_operator:SI 6 "arm_comparison_operator"
9668			  [(match_operand:SI 4 "s_register_operand" "l,r")
9669			   (match_operand:SI 5 "arm_add_operand" "lPy,rIL")]))
9670		 (const_int 0)))
9671   (set (match_operand:SI 7 "s_register_operand" "=Ts,Ts")
9672	(ior:SI (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9673		(match_op_dup 6 [(match_dup 4) (match_dup 5)])))]
9674  "TARGET_32BIT"
9675  "#"
9676  "TARGET_32BIT && reload_completed"
9677  [(set (match_dup 0)
9678	(compare
9679	 (ior:SI
9680	  (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9681	  (match_op_dup 6 [(match_dup 4) (match_dup 5)]))
9682	 (const_int 0)))
9683   (set (match_dup 7) (ne:SI (match_dup 0) (const_int 0)))]
9684  ""
9685  [(set_attr "conds" "set")
9686   (set_attr "enabled_for_short_it" "yes,no")
9687   (set_attr "length" "16")
9688   (set_attr "type" "multiple")]
9689)
9690
9691(define_insn_and_split "*and_scc_scc"
9692  [(set (match_operand:SI 0 "s_register_operand" "=Ts,Ts")
9693	(and:SI (match_operator:SI 3 "arm_comparison_operator"
9694		 [(match_operand:SI 1 "s_register_operand" "l,r")
9695		  (match_operand:SI 2 "arm_add_operand" "lPy,rIL")])
9696		(match_operator:SI 6 "arm_comparison_operator"
9697		 [(match_operand:SI 4 "s_register_operand" "l,r")
9698		  (match_operand:SI 5 "arm_add_operand" "lPy,rIL")])))
9699   (clobber (reg:CC CC_REGNUM))]
9700  "TARGET_32BIT
9701   && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
9702       != CCmode)"
9703  "#"
9704  "TARGET_32BIT && reload_completed
9705   && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
9706       != CCmode)"
9707  [(set (match_dup 7)
9708	(compare
9709	 (and:SI
9710	  (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9711	  (match_op_dup 6 [(match_dup 4) (match_dup 5)]))
9712	 (const_int 0)))
9713   (set (match_dup 0) (ne:SI (match_dup 7) (const_int 0)))]
9714  "operands[7]
9715     = gen_rtx_REG (arm_select_dominance_cc_mode (operands[3], operands[6],
9716						  DOM_CC_X_AND_Y),
9717		    CC_REGNUM);"
9718  [(set_attr "conds" "clob")
9719   (set_attr "enabled_for_short_it" "yes,no")
9720   (set_attr "length" "16")
9721   (set_attr "type" "multiple")]
9722)
9723
9724; If the above pattern is followed by a CMP insn, then the compare is
9725; redundant, since we can rework the conditional instruction that follows.
9726(define_insn_and_split "*and_scc_scc_cmp"
9727  [(set (match_operand 0 "dominant_cc_register" "")
9728	(compare (and:SI (match_operator:SI 3 "arm_comparison_operator"
9729			  [(match_operand:SI 1 "s_register_operand" "l,r")
9730			   (match_operand:SI 2 "arm_add_operand" "lPy,rIL")])
9731			 (match_operator:SI 6 "arm_comparison_operator"
9732			  [(match_operand:SI 4 "s_register_operand" "l,r")
9733			   (match_operand:SI 5 "arm_add_operand" "lPy,rIL")]))
9734		 (const_int 0)))
9735   (set (match_operand:SI 7 "s_register_operand" "=Ts,Ts")
9736	(and:SI (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9737		(match_op_dup 6 [(match_dup 4) (match_dup 5)])))]
9738  "TARGET_32BIT"
9739  "#"
9740  "TARGET_32BIT && reload_completed"
9741  [(set (match_dup 0)
9742	(compare
9743	 (and:SI
9744	  (match_op_dup 3 [(match_dup 1) (match_dup 2)])
9745	  (match_op_dup 6 [(match_dup 4) (match_dup 5)]))
9746	 (const_int 0)))
9747   (set (match_dup 7) (ne:SI (match_dup 0) (const_int 0)))]
9748  ""
9749  [(set_attr "conds" "set")
9750   (set_attr "enabled_for_short_it" "yes,no")
9751   (set_attr "length" "16")
9752   (set_attr "type" "multiple")]
9753)
9754
9755;; If there is no dominance in the comparison, then we can still save an
9756;; instruction in the AND case, since we can know that the second compare
9757;; need only zero the value if false (if true, then the value is already
9758;; correct).
9759(define_insn_and_split "*and_scc_scc_nodom"
9760  [(set (match_operand:SI 0 "s_register_operand" "=&Ts,&Ts,&Ts")
9761	(and:SI (match_operator:SI 3 "arm_comparison_operator"
9762		 [(match_operand:SI 1 "s_register_operand" "r,r,0")
9763		  (match_operand:SI 2 "arm_add_operand" "rIL,0,rIL")])
9764		(match_operator:SI 6 "arm_comparison_operator"
9765		 [(match_operand:SI 4 "s_register_operand" "r,r,r")
9766		  (match_operand:SI 5 "arm_add_operand" "rIL,rIL,rIL")])))
9767   (clobber (reg:CC CC_REGNUM))]
9768  "TARGET_32BIT
9769   && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
9770       == CCmode)"
9771  "#"
9772  "TARGET_32BIT && reload_completed"
9773  [(parallel [(set (match_dup 0)
9774		   (match_op_dup 3 [(match_dup 1) (match_dup 2)]))
9775	      (clobber (reg:CC CC_REGNUM))])
9776   (set (match_dup 7) (match_op_dup 8 [(match_dup 4) (match_dup 5)]))
9777   (set (match_dup 0)
9778	(if_then_else:SI (match_op_dup 6 [(match_dup 7) (const_int 0)])
9779			 (match_dup 0)
9780			 (const_int 0)))]
9781  "operands[7] = gen_rtx_REG (SELECT_CC_MODE (GET_CODE (operands[6]),
9782					      operands[4], operands[5]),
9783			      CC_REGNUM);
9784   operands[8] = gen_rtx_COMPARE (GET_MODE (operands[7]), operands[4],
9785				  operands[5]);"
9786  [(set_attr "conds" "clob")
9787   (set_attr "length" "20")
9788   (set_attr "type" "multiple")]
9789)
9790
9791(define_split
9792  [(set (reg:CC_NOOV CC_REGNUM)
9793	(compare:CC_NOOV (ior:SI
9794			  (and:SI (match_operand:SI 0 "s_register_operand" "")
9795				  (const_int 1))
9796			  (match_operator:SI 1 "arm_comparison_operator"
9797			   [(match_operand:SI 2 "s_register_operand" "")
9798			    (match_operand:SI 3 "arm_add_operand" "")]))
9799			 (const_int 0)))
9800   (clobber (match_operand:SI 4 "s_register_operand" ""))]
9801  "TARGET_ARM"
9802  [(set (match_dup 4)
9803	(ior:SI (match_op_dup 1 [(match_dup 2) (match_dup 3)])
9804		(match_dup 0)))
9805   (set (reg:CC_NOOV CC_REGNUM)
9806	(compare:CC_NOOV (and:SI (match_dup 4) (const_int 1))
9807			 (const_int 0)))]
9808  "")
9809
9810(define_split
9811  [(set (reg:CC_NOOV CC_REGNUM)
9812	(compare:CC_NOOV (ior:SI
9813			  (match_operator:SI 1 "arm_comparison_operator"
9814			   [(match_operand:SI 2 "s_register_operand" "")
9815			    (match_operand:SI 3 "arm_add_operand" "")])
9816			  (and:SI (match_operand:SI 0 "s_register_operand" "")
9817				  (const_int 1)))
9818			 (const_int 0)))
9819   (clobber (match_operand:SI 4 "s_register_operand" ""))]
9820  "TARGET_ARM"
9821  [(set (match_dup 4)
9822	(ior:SI (match_op_dup 1 [(match_dup 2) (match_dup 3)])
9823		(match_dup 0)))
9824   (set (reg:CC_NOOV CC_REGNUM)
9825	(compare:CC_NOOV (and:SI (match_dup 4) (const_int 1))
9826			 (const_int 0)))]
9827  "")
9828;; ??? The conditional patterns above need checking for Thumb-2 usefulness
9829
9830(define_insn_and_split "*negscc"
9831  [(set (match_operand:SI 0 "s_register_operand" "=r")
9832	(neg:SI (match_operator 3 "arm_comparison_operator"
9833		 [(match_operand:SI 1 "s_register_operand" "r")
9834		  (match_operand:SI 2 "arm_rhs_operand" "rI")])))
9835   (clobber (reg:CC CC_REGNUM))]
9836  "TARGET_ARM"
9837  "#"
9838  "&& reload_completed"
9839  [(const_int 0)]
9840  {
9841    rtx cc_reg = gen_rtx_REG (CCmode, CC_REGNUM);
9842
9843    if (GET_CODE (operands[3]) == LT && operands[2] == const0_rtx)
9844       {
9845         /* Emit mov\\t%0, %1, asr #31 */
9846         emit_insn (gen_rtx_SET (operands[0],
9847                                 gen_rtx_ASHIFTRT (SImode,
9848                                                   operands[1],
9849                                                   GEN_INT (31))));
9850         DONE;
9851       }
9852     else if (GET_CODE (operands[3]) == NE)
9853       {
9854        /* Emit subs\\t%0, %1, %2\;mvnne\\t%0, #0 */
9855        if (CONST_INT_P (operands[2]))
9856          emit_insn (gen_cmpsi2_addneg (operands[0], operands[1], operands[2],
9857                                        GEN_INT (- INTVAL (operands[2]))));
9858        else
9859          emit_insn (gen_subsi3_compare (operands[0], operands[1], operands[2]));
9860
9861        emit_insn (gen_rtx_COND_EXEC (VOIDmode,
9862                                      gen_rtx_NE (SImode,
9863                                                  cc_reg,
9864                                                  const0_rtx),
9865                                      gen_rtx_SET (operands[0],
9866                                                   GEN_INT (~0))));
9867        DONE;
9868      }
9869    else
9870      {
9871        /* Emit: cmp\\t%1, %2\;mov%D3\\t%0, #0\;mvn%d3\\t%0, #0 */
9872        emit_insn (gen_rtx_SET (cc_reg,
9873                                gen_rtx_COMPARE (CCmode, operands[1], operands[2])));
9874        enum rtx_code rc = GET_CODE (operands[3]);
9875
9876        rc = reverse_condition (rc);
9877        emit_insn (gen_rtx_COND_EXEC (VOIDmode,
9878                                      gen_rtx_fmt_ee (rc,
9879                                                      VOIDmode,
9880                                                      cc_reg,
9881                                                      const0_rtx),
9882                                      gen_rtx_SET (operands[0], const0_rtx)));
9883        rc = GET_CODE (operands[3]);
9884        emit_insn (gen_rtx_COND_EXEC (VOIDmode,
9885                                      gen_rtx_fmt_ee (rc,
9886                                                      VOIDmode,
9887                                                      cc_reg,
9888                                                      const0_rtx),
9889                                      gen_rtx_SET (operands[0],
9890                                                   GEN_INT (~0))));
9891        DONE;
9892      }
9893     FAIL;
9894  }
9895  [(set_attr "conds" "clob")
9896   (set_attr "length" "12")
9897   (set_attr "type" "multiple")]
9898)
9899
9900(define_insn_and_split "movcond_addsi"
9901  [(set (match_operand:SI 0 "s_register_operand" "=r,l,r")
9902	(if_then_else:SI
9903	 (match_operator 5 "comparison_operator"
9904	  [(plus:SI (match_operand:SI 3 "s_register_operand" "r,r,r")
9905	            (match_operand:SI 4 "arm_add_operand" "rIL,rIL,rIL"))
9906            (const_int 0)])
9907	 (match_operand:SI 1 "arm_rhs_operand" "rI,rPy,r")
9908	 (match_operand:SI 2 "arm_rhs_operand" "rI,rPy,r")))
9909   (clobber (reg:CC CC_REGNUM))]
9910   "TARGET_32BIT"
9911   "#"
9912   "&& reload_completed"
9913  [(set (reg:CC_NOOV CC_REGNUM)
9914	(compare:CC_NOOV
9915	 (plus:SI (match_dup 3)
9916		  (match_dup 4))
9917	 (const_int 0)))
9918   (set (match_dup 0) (match_dup 1))
9919   (cond_exec (match_dup 6)
9920	      (set (match_dup 0) (match_dup 2)))]
9921  "
9922  {
9923    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[5]),
9924					     operands[3], operands[4]);
9925    enum rtx_code rc = GET_CODE (operands[5]);
9926    operands[6] = gen_rtx_REG (mode, CC_REGNUM);
9927    gcc_assert (!(mode == CCFPmode || mode == CCFPEmode));
9928    if (!REG_P (operands[2]) || REGNO (operands[2]) != REGNO (operands[0]))
9929      rc = reverse_condition (rc);
9930    else
9931      std::swap (operands[1], operands[2]);
9932
9933    operands[6] = gen_rtx_fmt_ee (rc, VOIDmode, operands[6], const0_rtx);
9934  }
9935  "
9936  [(set_attr "conds" "clob")
9937   (set_attr "enabled_for_short_it" "no,yes,yes")
9938   (set_attr "type" "multiple")]
9939)
9940
9941(define_insn "movcond"
9942  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
9943	(if_then_else:SI
9944	 (match_operator 5 "arm_comparison_operator"
9945	  [(match_operand:SI 3 "s_register_operand" "r,r,r")
9946	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL,rIL")])
9947	 (match_operand:SI 1 "arm_rhs_operand" "0,rI,?rI")
9948	 (match_operand:SI 2 "arm_rhs_operand" "rI,0,rI")))
9949   (clobber (reg:CC CC_REGNUM))]
9950  "TARGET_ARM"
9951  "*
9952  if (GET_CODE (operands[5]) == LT
9953      && (operands[4] == const0_rtx))
9954    {
9955      if (which_alternative != 1 && REG_P (operands[1]))
9956	{
9957	  if (operands[2] == const0_rtx)
9958	    return \"and\\t%0, %1, %3, asr #31\";
9959	  return \"ands\\t%0, %1, %3, asr #32\;movcc\\t%0, %2\";
9960	}
9961      else if (which_alternative != 0 && REG_P (operands[2]))
9962	{
9963	  if (operands[1] == const0_rtx)
9964	    return \"bic\\t%0, %2, %3, asr #31\";
9965	  return \"bics\\t%0, %2, %3, asr #32\;movcs\\t%0, %1\";
9966	}
9967      /* The only case that falls through to here is when both ops 1 & 2
9968	 are constants.  */
9969    }
9970
9971  if (GET_CODE (operands[5]) == GE
9972      && (operands[4] == const0_rtx))
9973    {
9974      if (which_alternative != 1 && REG_P (operands[1]))
9975	{
9976	  if (operands[2] == const0_rtx)
9977	    return \"bic\\t%0, %1, %3, asr #31\";
9978	  return \"bics\\t%0, %1, %3, asr #32\;movcs\\t%0, %2\";
9979	}
9980      else if (which_alternative != 0 && REG_P (operands[2]))
9981	{
9982	  if (operands[1] == const0_rtx)
9983	    return \"and\\t%0, %2, %3, asr #31\";
9984	  return \"ands\\t%0, %2, %3, asr #32\;movcc\\t%0, %1\";
9985	}
9986      /* The only case that falls through to here is when both ops 1 & 2
9987	 are constants.  */
9988    }
9989  if (CONST_INT_P (operands[4])
9990      && !const_ok_for_arm (INTVAL (operands[4])))
9991    output_asm_insn (\"cmn\\t%3, #%n4\", operands);
9992  else
9993    output_asm_insn (\"cmp\\t%3, %4\", operands);
9994  if (which_alternative != 0)
9995    output_asm_insn (\"mov%d5\\t%0, %1\", operands);
9996  if (which_alternative != 1)
9997    output_asm_insn (\"mov%D5\\t%0, %2\", operands);
9998  return \"\";
9999  "
10000  [(set_attr "conds" "clob")
10001   (set_attr "length" "8,8,12")
10002   (set_attr "type" "multiple")]
10003)
10004
10005;; ??? The patterns below need checking for Thumb-2 usefulness.
10006
10007(define_insn "*ifcompare_plus_move"
10008  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10009	(if_then_else:SI (match_operator 6 "arm_comparison_operator"
10010			  [(match_operand:SI 4 "s_register_operand" "r,r")
10011			   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
10012			 (plus:SI
10013			  (match_operand:SI 2 "s_register_operand" "r,r")
10014			  (match_operand:SI 3 "arm_add_operand" "rIL,rIL"))
10015			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")))
10016   (clobber (reg:CC CC_REGNUM))]
10017  "TARGET_ARM"
10018  "#"
10019  [(set_attr "conds" "clob")
10020   (set_attr "length" "8,12")
10021   (set_attr "type" "multiple")]
10022)
10023
10024(define_insn "*if_plus_move"
10025  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r,r")
10026	(if_then_else:SI
10027	 (match_operator 4 "arm_comparison_operator"
10028	  [(match_operand 5 "cc_register" "") (const_int 0)])
10029	 (plus:SI
10030	  (match_operand:SI 2 "s_register_operand" "r,r,r,r")
10031	  (match_operand:SI 3 "arm_add_operand" "rI,L,rI,L"))
10032	 (match_operand:SI 1 "arm_rhs_operand" "0,0,?rI,?rI")))]
10033  "TARGET_ARM"
10034  "@
10035   add%d4\\t%0, %2, %3
10036   sub%d4\\t%0, %2, #%n3
10037   add%d4\\t%0, %2, %3\;mov%D4\\t%0, %1
10038   sub%d4\\t%0, %2, #%n3\;mov%D4\\t%0, %1"
10039  [(set_attr "conds" "use")
10040   (set_attr "length" "4,4,8,8")
10041   (set_attr_alternative "type"
10042                         [(if_then_else (match_operand 3 "const_int_operand" "")
10043                                        (const_string "alu_imm" )
10044                                        (const_string "alu_sreg"))
10045                          (const_string "alu_imm")
10046                          (const_string "multiple")
10047                          (const_string "multiple")])]
10048)
10049
10050(define_insn "*ifcompare_move_plus"
10051  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10052	(if_then_else:SI (match_operator 6 "arm_comparison_operator"
10053			  [(match_operand:SI 4 "s_register_operand" "r,r")
10054			   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
10055			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")
10056			 (plus:SI
10057			  (match_operand:SI 2 "s_register_operand" "r,r")
10058			  (match_operand:SI 3 "arm_add_operand" "rIL,rIL"))))
10059   (clobber (reg:CC CC_REGNUM))]
10060  "TARGET_ARM"
10061  "#"
10062  [(set_attr "conds" "clob")
10063   (set_attr "length" "8,12")
10064   (set_attr "type" "multiple")]
10065)
10066
10067(define_insn "*if_move_plus"
10068  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r,r")
10069	(if_then_else:SI
10070	 (match_operator 4 "arm_comparison_operator"
10071	  [(match_operand 5 "cc_register" "") (const_int 0)])
10072	 (match_operand:SI 1 "arm_rhs_operand" "0,0,?rI,?rI")
10073	 (plus:SI
10074	  (match_operand:SI 2 "s_register_operand" "r,r,r,r")
10075	  (match_operand:SI 3 "arm_add_operand" "rI,L,rI,L"))))]
10076  "TARGET_ARM"
10077  "@
10078   add%D4\\t%0, %2, %3
10079   sub%D4\\t%0, %2, #%n3
10080   add%D4\\t%0, %2, %3\;mov%d4\\t%0, %1
10081   sub%D4\\t%0, %2, #%n3\;mov%d4\\t%0, %1"
10082  [(set_attr "conds" "use")
10083   (set_attr "length" "4,4,8,8")
10084   (set_attr_alternative "type"
10085                         [(if_then_else (match_operand 3 "const_int_operand" "")
10086                                        (const_string "alu_imm" )
10087                                        (const_string "alu_sreg"))
10088                          (const_string "alu_imm")
10089                          (const_string "multiple")
10090                          (const_string "multiple")])]
10091)
10092
10093(define_insn "*ifcompare_arith_arith"
10094  [(set (match_operand:SI 0 "s_register_operand" "=r")
10095	(if_then_else:SI (match_operator 9 "arm_comparison_operator"
10096			  [(match_operand:SI 5 "s_register_operand" "r")
10097			   (match_operand:SI 6 "arm_add_operand" "rIL")])
10098			 (match_operator:SI 8 "shiftable_operator"
10099			  [(match_operand:SI 1 "s_register_operand" "r")
10100			   (match_operand:SI 2 "arm_rhs_operand" "rI")])
10101			 (match_operator:SI 7 "shiftable_operator"
10102			  [(match_operand:SI 3 "s_register_operand" "r")
10103			   (match_operand:SI 4 "arm_rhs_operand" "rI")])))
10104   (clobber (reg:CC CC_REGNUM))]
10105  "TARGET_ARM"
10106  "#"
10107  [(set_attr "conds" "clob")
10108   (set_attr "length" "12")
10109   (set_attr "type" "multiple")]
10110)
10111
10112(define_insn "*if_arith_arith"
10113  [(set (match_operand:SI 0 "s_register_operand" "=r")
10114	(if_then_else:SI (match_operator 5 "arm_comparison_operator"
10115			  [(match_operand 8 "cc_register" "") (const_int 0)])
10116			 (match_operator:SI 6 "shiftable_operator"
10117			  [(match_operand:SI 1 "s_register_operand" "r")
10118			   (match_operand:SI 2 "arm_rhs_operand" "rI")])
10119			 (match_operator:SI 7 "shiftable_operator"
10120			  [(match_operand:SI 3 "s_register_operand" "r")
10121			   (match_operand:SI 4 "arm_rhs_operand" "rI")])))]
10122  "TARGET_ARM"
10123  "%I6%d5\\t%0, %1, %2\;%I7%D5\\t%0, %3, %4"
10124  [(set_attr "conds" "use")
10125   (set_attr "length" "8")
10126   (set_attr "type" "multiple")]
10127)
10128
10129(define_insn "*ifcompare_arith_move"
10130  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10131	(if_then_else:SI (match_operator 6 "arm_comparison_operator"
10132			  [(match_operand:SI 2 "s_register_operand" "r,r")
10133			   (match_operand:SI 3 "arm_add_operand" "rIL,rIL")])
10134			 (match_operator:SI 7 "shiftable_operator"
10135			  [(match_operand:SI 4 "s_register_operand" "r,r")
10136			   (match_operand:SI 5 "arm_rhs_operand" "rI,rI")])
10137			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")))
10138   (clobber (reg:CC CC_REGNUM))]
10139  "TARGET_ARM"
10140  "*
10141  /* If we have an operation where (op x 0) is the identity operation and
10142     the conditional operator is LT or GE and we are comparing against zero and
10143     everything is in registers then we can do this in two instructions.  */
10144  if (operands[3] == const0_rtx
10145      && GET_CODE (operands[7]) != AND
10146      && REG_P (operands[5])
10147      && REG_P (operands[1])
10148      && REGNO (operands[1]) == REGNO (operands[4])
10149      && REGNO (operands[4]) != REGNO (operands[0]))
10150    {
10151      if (GET_CODE (operands[6]) == LT)
10152	return \"and\\t%0, %5, %2, asr #31\;%I7\\t%0, %4, %0\";
10153      else if (GET_CODE (operands[6]) == GE)
10154	return \"bic\\t%0, %5, %2, asr #31\;%I7\\t%0, %4, %0\";
10155    }
10156  if (CONST_INT_P (operands[3])
10157      && !const_ok_for_arm (INTVAL (operands[3])))
10158    output_asm_insn (\"cmn\\t%2, #%n3\", operands);
10159  else
10160    output_asm_insn (\"cmp\\t%2, %3\", operands);
10161  output_asm_insn (\"%I7%d6\\t%0, %4, %5\", operands);
10162  if (which_alternative != 0)
10163    return \"mov%D6\\t%0, %1\";
10164  return \"\";
10165  "
10166  [(set_attr "conds" "clob")
10167   (set_attr "length" "8,12")
10168   (set_attr "type" "multiple")]
10169)
10170
10171(define_insn "*if_arith_move"
10172  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10173	(if_then_else:SI (match_operator 4 "arm_comparison_operator"
10174			  [(match_operand 6 "cc_register" "") (const_int 0)])
10175			 (match_operator:SI 5 "shiftable_operator"
10176			  [(match_operand:SI 2 "s_register_operand" "r,r")
10177			   (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])
10178			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")))]
10179  "TARGET_ARM"
10180  "@
10181   %I5%d4\\t%0, %2, %3
10182   %I5%d4\\t%0, %2, %3\;mov%D4\\t%0, %1"
10183  [(set_attr "conds" "use")
10184   (set_attr "length" "4,8")
10185   (set_attr_alternative "type"
10186                         [(if_then_else (match_operand 3 "const_int_operand" "")
10187                                        (const_string "alu_shift_imm" )
10188                                        (const_string "alu_shift_reg"))
10189                          (const_string "multiple")])]
10190)
10191
10192(define_insn "*ifcompare_move_arith"
10193  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10194	(if_then_else:SI (match_operator 6 "arm_comparison_operator"
10195			  [(match_operand:SI 4 "s_register_operand" "r,r")
10196			   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
10197			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")
10198			 (match_operator:SI 7 "shiftable_operator"
10199			  [(match_operand:SI 2 "s_register_operand" "r,r")
10200			   (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])))
10201   (clobber (reg:CC CC_REGNUM))]
10202  "TARGET_ARM"
10203  "*
10204  /* If we have an operation where (op x 0) is the identity operation and
10205     the conditional operator is LT or GE and we are comparing against zero and
10206     everything is in registers then we can do this in two instructions */
10207  if (operands[5] == const0_rtx
10208      && GET_CODE (operands[7]) != AND
10209      && REG_P (operands[3])
10210      && REG_P (operands[1])
10211      && REGNO (operands[1]) == REGNO (operands[2])
10212      && REGNO (operands[2]) != REGNO (operands[0]))
10213    {
10214      if (GET_CODE (operands[6]) == GE)
10215	return \"and\\t%0, %3, %4, asr #31\;%I7\\t%0, %2, %0\";
10216      else if (GET_CODE (operands[6]) == LT)
10217	return \"bic\\t%0, %3, %4, asr #31\;%I7\\t%0, %2, %0\";
10218    }
10219
10220  if (CONST_INT_P (operands[5])
10221      && !const_ok_for_arm (INTVAL (operands[5])))
10222    output_asm_insn (\"cmn\\t%4, #%n5\", operands);
10223  else
10224    output_asm_insn (\"cmp\\t%4, %5\", operands);
10225
10226  if (which_alternative != 0)
10227    output_asm_insn (\"mov%d6\\t%0, %1\", operands);
10228  return \"%I7%D6\\t%0, %2, %3\";
10229  "
10230  [(set_attr "conds" "clob")
10231   (set_attr "length" "8,12")
10232   (set_attr "type" "multiple")]
10233)
10234
10235(define_insn "*if_move_arith"
10236  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10237	(if_then_else:SI
10238	 (match_operator 4 "arm_comparison_operator"
10239	  [(match_operand 6 "cc_register" "") (const_int 0)])
10240	 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")
10241	 (match_operator:SI 5 "shiftable_operator"
10242	  [(match_operand:SI 2 "s_register_operand" "r,r")
10243	   (match_operand:SI 3 "arm_rhs_operand" "rI,rI")])))]
10244  "TARGET_ARM"
10245  "@
10246   %I5%D4\\t%0, %2, %3
10247   %I5%D4\\t%0, %2, %3\;mov%d4\\t%0, %1"
10248  [(set_attr "conds" "use")
10249   (set_attr "length" "4,8")
10250   (set_attr_alternative "type"
10251                         [(if_then_else (match_operand 3 "const_int_operand" "")
10252                                        (const_string "alu_shift_imm" )
10253                                        (const_string "alu_shift_reg"))
10254                          (const_string "multiple")])]
10255)
10256
10257(define_insn "*ifcompare_move_not"
10258  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10259	(if_then_else:SI
10260	 (match_operator 5 "arm_comparison_operator"
10261	  [(match_operand:SI 3 "s_register_operand" "r,r")
10262	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL")])
10263	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")
10264	 (not:SI
10265	  (match_operand:SI 2 "s_register_operand" "r,r"))))
10266   (clobber (reg:CC CC_REGNUM))]
10267  "TARGET_ARM"
10268  "#"
10269  [(set_attr "conds" "clob")
10270   (set_attr "length" "8,12")
10271   (set_attr "type" "multiple")]
10272)
10273
10274(define_insn "*if_move_not"
10275  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
10276	(if_then_else:SI
10277	 (match_operator 4 "arm_comparison_operator"
10278	  [(match_operand 3 "cc_register" "") (const_int 0)])
10279	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")
10280	 (not:SI (match_operand:SI 2 "s_register_operand" "r,r,r"))))]
10281  "TARGET_ARM"
10282  "@
10283   mvn%D4\\t%0, %2
10284   mov%d4\\t%0, %1\;mvn%D4\\t%0, %2
10285   mvn%d4\\t%0, #%B1\;mvn%D4\\t%0, %2"
10286  [(set_attr "conds" "use")
10287   (set_attr "type" "mvn_reg")
10288   (set_attr "length" "4,8,8")
10289   (set_attr "type" "mvn_reg,multiple,multiple")]
10290)
10291
10292(define_insn "*ifcompare_not_move"
10293  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10294	(if_then_else:SI
10295	 (match_operator 5 "arm_comparison_operator"
10296	  [(match_operand:SI 3 "s_register_operand" "r,r")
10297	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL")])
10298	 (not:SI
10299	  (match_operand:SI 2 "s_register_operand" "r,r"))
10300	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")))
10301   (clobber (reg:CC CC_REGNUM))]
10302  "TARGET_ARM"
10303  "#"
10304  [(set_attr "conds" "clob")
10305   (set_attr "length" "8,12")
10306   (set_attr "type" "multiple")]
10307)
10308
10309(define_insn "*if_not_move"
10310  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
10311	(if_then_else:SI
10312	 (match_operator 4 "arm_comparison_operator"
10313	  [(match_operand 3 "cc_register" "") (const_int 0)])
10314	 (not:SI (match_operand:SI 2 "s_register_operand" "r,r,r"))
10315	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")))]
10316  "TARGET_ARM"
10317  "@
10318   mvn%d4\\t%0, %2
10319   mov%D4\\t%0, %1\;mvn%d4\\t%0, %2
10320   mvn%D4\\t%0, #%B1\;mvn%d4\\t%0, %2"
10321  [(set_attr "conds" "use")
10322   (set_attr "type" "mvn_reg,multiple,multiple")
10323   (set_attr "length" "4,8,8")]
10324)
10325
10326(define_insn "*ifcompare_shift_move"
10327  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10328	(if_then_else:SI
10329	 (match_operator 6 "arm_comparison_operator"
10330	  [(match_operand:SI 4 "s_register_operand" "r,r")
10331	   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
10332	 (match_operator:SI 7 "shift_operator"
10333	  [(match_operand:SI 2 "s_register_operand" "r,r")
10334	   (match_operand:SI 3 "arm_rhs_operand" "rM,rM")])
10335	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")))
10336   (clobber (reg:CC CC_REGNUM))]
10337  "TARGET_ARM"
10338  "#"
10339  [(set_attr "conds" "clob")
10340   (set_attr "length" "8,12")
10341   (set_attr "type" "multiple")]
10342)
10343
10344(define_insn "*if_shift_move"
10345  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
10346	(if_then_else:SI
10347	 (match_operator 5 "arm_comparison_operator"
10348	  [(match_operand 6 "cc_register" "") (const_int 0)])
10349	 (match_operator:SI 4 "shift_operator"
10350	  [(match_operand:SI 2 "s_register_operand" "r,r,r")
10351	   (match_operand:SI 3 "arm_rhs_operand" "rM,rM,rM")])
10352	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")))]
10353  "TARGET_ARM"
10354  "@
10355   mov%d5\\t%0, %2%S4
10356   mov%D5\\t%0, %1\;mov%d5\\t%0, %2%S4
10357   mvn%D5\\t%0, #%B1\;mov%d5\\t%0, %2%S4"
10358  [(set_attr "conds" "use")
10359   (set_attr "shift" "2")
10360   (set_attr "length" "4,8,8")
10361   (set_attr_alternative "type"
10362                         [(if_then_else (match_operand 3 "const_int_operand" "")
10363                                        (const_string "mov_shift" )
10364                                        (const_string "mov_shift_reg"))
10365                          (const_string "multiple")
10366                          (const_string "multiple")])]
10367)
10368
10369(define_insn "*ifcompare_move_shift"
10370  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10371	(if_then_else:SI
10372	 (match_operator 6 "arm_comparison_operator"
10373	  [(match_operand:SI 4 "s_register_operand" "r,r")
10374	   (match_operand:SI 5 "arm_add_operand" "rIL,rIL")])
10375	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")
10376	 (match_operator:SI 7 "shift_operator"
10377	  [(match_operand:SI 2 "s_register_operand" "r,r")
10378	   (match_operand:SI 3 "arm_rhs_operand" "rM,rM")])))
10379   (clobber (reg:CC CC_REGNUM))]
10380  "TARGET_ARM"
10381  "#"
10382  [(set_attr "conds" "clob")
10383   (set_attr "length" "8,12")
10384   (set_attr "type" "multiple")]
10385)
10386
10387(define_insn "*if_move_shift"
10388  [(set (match_operand:SI 0 "s_register_operand" "=r,r,r")
10389	(if_then_else:SI
10390	 (match_operator 5 "arm_comparison_operator"
10391	  [(match_operand 6 "cc_register" "") (const_int 0)])
10392	 (match_operand:SI 1 "arm_not_operand" "0,?rI,K")
10393	 (match_operator:SI 4 "shift_operator"
10394	  [(match_operand:SI 2 "s_register_operand" "r,r,r")
10395	   (match_operand:SI 3 "arm_rhs_operand" "rM,rM,rM")])))]
10396  "TARGET_ARM"
10397  "@
10398   mov%D5\\t%0, %2%S4
10399   mov%d5\\t%0, %1\;mov%D5\\t%0, %2%S4
10400   mvn%d5\\t%0, #%B1\;mov%D5\\t%0, %2%S4"
10401  [(set_attr "conds" "use")
10402   (set_attr "shift" "2")
10403   (set_attr "length" "4,8,8")
10404   (set_attr_alternative "type"
10405                         [(if_then_else (match_operand 3 "const_int_operand" "")
10406                                        (const_string "mov_shift" )
10407                                        (const_string "mov_shift_reg"))
10408                          (const_string "multiple")
10409                          (const_string "multiple")])]
10410)
10411
10412(define_insn "*ifcompare_shift_shift"
10413  [(set (match_operand:SI 0 "s_register_operand" "=r")
10414	(if_then_else:SI
10415	 (match_operator 7 "arm_comparison_operator"
10416	  [(match_operand:SI 5 "s_register_operand" "r")
10417	   (match_operand:SI 6 "arm_add_operand" "rIL")])
10418	 (match_operator:SI 8 "shift_operator"
10419	  [(match_operand:SI 1 "s_register_operand" "r")
10420	   (match_operand:SI 2 "arm_rhs_operand" "rM")])
10421	 (match_operator:SI 9 "shift_operator"
10422	  [(match_operand:SI 3 "s_register_operand" "r")
10423	   (match_operand:SI 4 "arm_rhs_operand" "rM")])))
10424   (clobber (reg:CC CC_REGNUM))]
10425  "TARGET_ARM"
10426  "#"
10427  [(set_attr "conds" "clob")
10428   (set_attr "length" "12")
10429   (set_attr "type" "multiple")]
10430)
10431
10432(define_insn "*if_shift_shift"
10433  [(set (match_operand:SI 0 "s_register_operand" "=r")
10434	(if_then_else:SI
10435	 (match_operator 5 "arm_comparison_operator"
10436	  [(match_operand 8 "cc_register" "") (const_int 0)])
10437	 (match_operator:SI 6 "shift_operator"
10438	  [(match_operand:SI 1 "s_register_operand" "r")
10439	   (match_operand:SI 2 "arm_rhs_operand" "rM")])
10440	 (match_operator:SI 7 "shift_operator"
10441	  [(match_operand:SI 3 "s_register_operand" "r")
10442	   (match_operand:SI 4 "arm_rhs_operand" "rM")])))]
10443  "TARGET_ARM"
10444  "mov%d5\\t%0, %1%S6\;mov%D5\\t%0, %3%S7"
10445  [(set_attr "conds" "use")
10446   (set_attr "shift" "1")
10447   (set_attr "length" "8")
10448   (set (attr "type") (if_then_else
10449		        (and (match_operand 2 "const_int_operand" "")
10450                             (match_operand 4 "const_int_operand" ""))
10451		      (const_string "mov_shift")
10452		      (const_string "mov_shift_reg")))]
10453)
10454
10455(define_insn "*ifcompare_not_arith"
10456  [(set (match_operand:SI 0 "s_register_operand" "=r")
10457	(if_then_else:SI
10458	 (match_operator 6 "arm_comparison_operator"
10459	  [(match_operand:SI 4 "s_register_operand" "r")
10460	   (match_operand:SI 5 "arm_add_operand" "rIL")])
10461	 (not:SI (match_operand:SI 1 "s_register_operand" "r"))
10462	 (match_operator:SI 7 "shiftable_operator"
10463	  [(match_operand:SI 2 "s_register_operand" "r")
10464	   (match_operand:SI 3 "arm_rhs_operand" "rI")])))
10465   (clobber (reg:CC CC_REGNUM))]
10466  "TARGET_ARM"
10467  "#"
10468  [(set_attr "conds" "clob")
10469   (set_attr "length" "12")
10470   (set_attr "type" "multiple")]
10471)
10472
10473(define_insn "*if_not_arith"
10474  [(set (match_operand:SI 0 "s_register_operand" "=r")
10475	(if_then_else:SI
10476	 (match_operator 5 "arm_comparison_operator"
10477	  [(match_operand 4 "cc_register" "") (const_int 0)])
10478	 (not:SI (match_operand:SI 1 "s_register_operand" "r"))
10479	 (match_operator:SI 6 "shiftable_operator"
10480	  [(match_operand:SI 2 "s_register_operand" "r")
10481	   (match_operand:SI 3 "arm_rhs_operand" "rI")])))]
10482  "TARGET_ARM"
10483  "mvn%d5\\t%0, %1\;%I6%D5\\t%0, %2, %3"
10484  [(set_attr "conds" "use")
10485   (set_attr "type" "mvn_reg")
10486   (set_attr "length" "8")]
10487)
10488
10489(define_insn "*ifcompare_arith_not"
10490  [(set (match_operand:SI 0 "s_register_operand" "=r")
10491	(if_then_else:SI
10492	 (match_operator 6 "arm_comparison_operator"
10493	  [(match_operand:SI 4 "s_register_operand" "r")
10494	   (match_operand:SI 5 "arm_add_operand" "rIL")])
10495	 (match_operator:SI 7 "shiftable_operator"
10496	  [(match_operand:SI 2 "s_register_operand" "r")
10497	   (match_operand:SI 3 "arm_rhs_operand" "rI")])
10498	 (not:SI (match_operand:SI 1 "s_register_operand" "r"))))
10499   (clobber (reg:CC CC_REGNUM))]
10500  "TARGET_ARM"
10501  "#"
10502  [(set_attr "conds" "clob")
10503   (set_attr "length" "12")
10504   (set_attr "type" "multiple")]
10505)
10506
10507(define_insn "*if_arith_not"
10508  [(set (match_operand:SI 0 "s_register_operand" "=r")
10509	(if_then_else:SI
10510	 (match_operator 5 "arm_comparison_operator"
10511	  [(match_operand 4 "cc_register" "") (const_int 0)])
10512	 (match_operator:SI 6 "shiftable_operator"
10513	  [(match_operand:SI 2 "s_register_operand" "r")
10514	   (match_operand:SI 3 "arm_rhs_operand" "rI")])
10515	 (not:SI (match_operand:SI 1 "s_register_operand" "r"))))]
10516  "TARGET_ARM"
10517  "mvn%D5\\t%0, %1\;%I6%d5\\t%0, %2, %3"
10518  [(set_attr "conds" "use")
10519   (set_attr "type" "multiple")
10520   (set_attr "length" "8")]
10521)
10522
10523(define_insn "*ifcompare_neg_move"
10524  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10525	(if_then_else:SI
10526	 (match_operator 5 "arm_comparison_operator"
10527	  [(match_operand:SI 3 "s_register_operand" "r,r")
10528	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL")])
10529	 (neg:SI (match_operand:SI 2 "s_register_operand" "r,r"))
10530	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")))
10531   (clobber (reg:CC CC_REGNUM))]
10532  "TARGET_ARM"
10533  "#"
10534  [(set_attr "conds" "clob")
10535   (set_attr "length" "8,12")
10536   (set_attr "type" "multiple")]
10537)
10538
10539(define_insn_and_split "*if_neg_move"
10540  [(set (match_operand:SI 0 "s_register_operand" "=l,r")
10541	(if_then_else:SI
10542	 (match_operator 4 "arm_comparison_operator"
10543	  [(match_operand 3 "cc_register" "") (const_int 0)])
10544	 (neg:SI (match_operand:SI 2 "s_register_operand" "l,r"))
10545	 (match_operand:SI 1 "s_register_operand" "0,0")))]
10546  "TARGET_32BIT"
10547  "#"
10548  "&& reload_completed"
10549  [(cond_exec (match_op_dup 4 [(match_dup 3) (const_int 0)])
10550	      (set (match_dup 0) (neg:SI (match_dup 2))))]
10551  ""
10552  [(set_attr "conds" "use")
10553   (set_attr "length" "4")
10554   (set_attr "arch" "t2,32")
10555   (set_attr "enabled_for_short_it" "yes,no")
10556   (set_attr "type" "logic_shift_imm")]
10557)
10558
10559(define_insn "*ifcompare_move_neg"
10560  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10561	(if_then_else:SI
10562	 (match_operator 5 "arm_comparison_operator"
10563	  [(match_operand:SI 3 "s_register_operand" "r,r")
10564	   (match_operand:SI 4 "arm_add_operand" "rIL,rIL")])
10565	 (match_operand:SI 1 "arm_not_operand" "0,?rIK")
10566	 (neg:SI (match_operand:SI 2 "s_register_operand" "r,r"))))
10567   (clobber (reg:CC CC_REGNUM))]
10568  "TARGET_ARM"
10569  "#"
10570  [(set_attr "conds" "clob")
10571   (set_attr "length" "8,12")
10572   (set_attr "type" "multiple")]
10573)
10574
10575(define_insn_and_split "*if_move_neg"
10576  [(set (match_operand:SI 0 "s_register_operand" "=l,r")
10577	(if_then_else:SI
10578	 (match_operator 4 "arm_comparison_operator"
10579	  [(match_operand 3 "cc_register" "") (const_int 0)])
10580	 (match_operand:SI 1 "s_register_operand" "0,0")
10581	 (neg:SI (match_operand:SI 2 "s_register_operand" "l,r"))))]
10582  "TARGET_32BIT"
10583  "#"
10584  "&& reload_completed"
10585  [(cond_exec (match_dup 5)
10586	      (set (match_dup 0) (neg:SI (match_dup 2))))]
10587  {
10588    machine_mode mode = GET_MODE (operands[3]);
10589    rtx_code rc = GET_CODE (operands[4]);
10590
10591    if (mode == CCFPmode || mode == CCFPEmode)
10592      rc = reverse_condition_maybe_unordered (rc);
10593    else
10594      rc = reverse_condition (rc);
10595
10596    operands[5] = gen_rtx_fmt_ee (rc, VOIDmode, operands[3], const0_rtx);
10597  }
10598  [(set_attr "conds" "use")
10599   (set_attr "length" "4")
10600   (set_attr "arch" "t2,32")
10601   (set_attr "enabled_for_short_it" "yes,no")
10602   (set_attr "type" "logic_shift_imm")]
10603)
10604
10605(define_insn "*arith_adjacentmem"
10606  [(set (match_operand:SI 0 "s_register_operand" "=r")
10607	(match_operator:SI 1 "shiftable_operator"
10608	 [(match_operand:SI 2 "memory_operand" "m")
10609	  (match_operand:SI 3 "memory_operand" "m")]))
10610   (clobber (match_scratch:SI 4 "=r"))]
10611  "TARGET_ARM && adjacent_mem_locations (operands[2], operands[3])"
10612  "*
10613  {
10614    rtx ldm[3];
10615    rtx arith[4];
10616    rtx base_reg;
10617    HOST_WIDE_INT val1 = 0, val2 = 0;
10618
10619    if (REGNO (operands[0]) > REGNO (operands[4]))
10620      {
10621	ldm[1] = operands[4];
10622	ldm[2] = operands[0];
10623      }
10624    else
10625      {
10626	ldm[1] = operands[0];
10627	ldm[2] = operands[4];
10628      }
10629
10630    base_reg = XEXP (operands[2], 0);
10631
10632    if (!REG_P (base_reg))
10633      {
10634	val1 = INTVAL (XEXP (base_reg, 1));
10635	base_reg = XEXP (base_reg, 0);
10636      }
10637
10638    if (!REG_P (XEXP (operands[3], 0)))
10639      val2 = INTVAL (XEXP (XEXP (operands[3], 0), 1));
10640
10641    arith[0] = operands[0];
10642    arith[3] = operands[1];
10643
10644    if (val1 < val2)
10645      {
10646	arith[1] = ldm[1];
10647	arith[2] = ldm[2];
10648      }
10649    else
10650      {
10651	arith[1] = ldm[2];
10652	arith[2] = ldm[1];
10653      }
10654
10655    ldm[0] = base_reg;
10656    if (val1 !=0 && val2 != 0)
10657      {
10658	rtx ops[3];
10659
10660	if (val1 == 4 || val2 == 4)
10661	  /* Other val must be 8, since we know they are adjacent and neither
10662	     is zero.  */
10663	  output_asm_insn (\"ldmib%?\\t%0, {%1, %2}\", ldm);
10664	else if (const_ok_for_arm (val1) || const_ok_for_arm (-val1))
10665	  {
10666	    ldm[0] = ops[0] = operands[4];
10667	    ops[1] = base_reg;
10668	    ops[2] = GEN_INT (val1);
10669	    output_add_immediate (ops);
10670	    if (val1 < val2)
10671	      output_asm_insn (\"ldmia%?\\t%0, {%1, %2}\", ldm);
10672	    else
10673	      output_asm_insn (\"ldmda%?\\t%0, {%1, %2}\", ldm);
10674	  }
10675	else
10676	  {
10677	    /* Offset is out of range for a single add, so use two ldr.  */
10678	    ops[0] = ldm[1];
10679	    ops[1] = base_reg;
10680	    ops[2] = GEN_INT (val1);
10681	    output_asm_insn (\"ldr%?\\t%0, [%1, %2]\", ops);
10682	    ops[0] = ldm[2];
10683	    ops[2] = GEN_INT (val2);
10684	    output_asm_insn (\"ldr%?\\t%0, [%1, %2]\", ops);
10685	  }
10686      }
10687    else if (val1 != 0)
10688      {
10689	if (val1 < val2)
10690	  output_asm_insn (\"ldmda%?\\t%0, {%1, %2}\", ldm);
10691	else
10692	  output_asm_insn (\"ldmia%?\\t%0, {%1, %2}\", ldm);
10693      }
10694    else
10695      {
10696	if (val1 < val2)
10697	  output_asm_insn (\"ldmia%?\\t%0, {%1, %2}\", ldm);
10698	else
10699	  output_asm_insn (\"ldmda%?\\t%0, {%1, %2}\", ldm);
10700      }
10701    output_asm_insn (\"%I3%?\\t%0, %1, %2\", arith);
10702    return \"\";
10703  }"
10704  [(set_attr "length" "12")
10705   (set_attr "predicable" "yes")
10706   (set_attr "type" "load_4")]
10707)
10708
10709; This pattern is never tried by combine, so do it as a peephole
10710
10711(define_peephole2
10712  [(set (match_operand:SI 0 "arm_general_register_operand" "")
10713	(match_operand:SI 1 "arm_general_register_operand" ""))
10714   (set (reg:CC CC_REGNUM)
10715	(compare:CC (match_dup 1) (const_int 0)))]
10716  "TARGET_ARM"
10717  [(parallel [(set (reg:CC CC_REGNUM) (compare:CC (match_dup 1) (const_int 0)))
10718	      (set (match_dup 0) (match_dup 1))])]
10719  ""
10720)
10721
10722(define_split
10723  [(set (match_operand:SI 0 "s_register_operand" "")
10724	(and:SI (ge:SI (match_operand:SI 1 "s_register_operand" "")
10725		       (const_int 0))
10726		(neg:SI (match_operator:SI 2 "arm_comparison_operator"
10727			 [(match_operand:SI 3 "s_register_operand" "")
10728			  (match_operand:SI 4 "arm_rhs_operand" "")]))))
10729   (clobber (match_operand:SI 5 "s_register_operand" ""))]
10730  "TARGET_ARM"
10731  [(set (match_dup 5) (not:SI (ashiftrt:SI (match_dup 1) (const_int 31))))
10732   (set (match_dup 0) (and:SI (match_op_dup 2 [(match_dup 3) (match_dup 4)])
10733			      (match_dup 5)))]
10734  ""
10735)
10736
10737;; This split can be used because CC_Z mode implies that the following
10738;; branch will be an equality, or an unsigned inequality, so the sign
10739;; extension is not needed.
10740
10741(define_split
10742  [(set (reg:CC_Z CC_REGNUM)
10743	(compare:CC_Z
10744	 (ashift:SI (subreg:SI (match_operand:QI 0 "memory_operand" "") 0)
10745		    (const_int 24))
10746	 (match_operand 1 "const_int_operand" "")))
10747   (clobber (match_scratch:SI 2 ""))]
10748  "TARGET_ARM
10749   && ((UINTVAL (operands[1]))
10750       == ((UINTVAL (operands[1])) >> 24) << 24)"
10751  [(set (match_dup 2) (zero_extend:SI (match_dup 0)))
10752   (set (reg:CC CC_REGNUM) (compare:CC (match_dup 2) (match_dup 1)))]
10753  "
10754  operands[1] = GEN_INT (((unsigned long) INTVAL (operands[1])) >> 24);
10755  "
10756)
10757;; ??? Check the patterns above for Thumb-2 usefulness
10758
10759(define_expand "prologue"
10760  [(clobber (const_int 0))]
10761  "TARGET_EITHER"
10762  "if (TARGET_32BIT)
10763     arm_expand_prologue ();
10764   else
10765     thumb1_expand_prologue ();
10766  DONE;
10767  "
10768)
10769
10770(define_expand "epilogue"
10771  [(clobber (const_int 0))]
10772  "TARGET_EITHER"
10773  "
10774  if (crtl->calls_eh_return)
10775    emit_insn (gen_force_register_use (gen_rtx_REG (Pmode, 2)));
10776  if (TARGET_THUMB1)
10777   {
10778     thumb1_expand_epilogue ();
10779     emit_jump_insn (gen_rtx_UNSPEC_VOLATILE (VOIDmode,
10780                     gen_rtvec (1, ret_rtx), VUNSPEC_EPILOGUE));
10781   }
10782  else if (HAVE_return)
10783   {
10784     /* HAVE_return is testing for USE_RETURN_INSN (FALSE).  Hence,
10785        no need for explicit testing again.  */
10786     emit_jump_insn (gen_return ());
10787   }
10788  else if (TARGET_32BIT)
10789   {
10790    arm_expand_epilogue (true);
10791   }
10792  DONE;
10793  "
10794)
10795
10796;; Note - although unspec_volatile's USE all hard registers,
10797;; USEs are ignored after relaod has completed.  Thus we need
10798;; to add an unspec of the link register to ensure that flow
10799;; does not think that it is unused by the sibcall branch that
10800;; will replace the standard function epilogue.
10801(define_expand "sibcall_epilogue"
10802   [(parallel [(unspec:SI [(reg:SI LR_REGNUM)] UNSPEC_REGISTER_USE)
10803               (unspec_volatile [(return)] VUNSPEC_EPILOGUE)])]
10804   "TARGET_32BIT"
10805   "
10806   arm_expand_epilogue (false);
10807   DONE;
10808   "
10809)
10810
10811(define_expand "eh_epilogue"
10812  [(use (match_operand:SI 0 "register_operand" ""))
10813   (use (match_operand:SI 1 "register_operand" ""))
10814   (use (match_operand:SI 2 "register_operand" ""))]
10815  "TARGET_EITHER"
10816  "
10817  {
10818    cfun->machine->eh_epilogue_sp_ofs = operands[1];
10819    if (!REG_P (operands[2]) || REGNO (operands[2]) != 2)
10820      {
10821	rtx ra = gen_rtx_REG (Pmode, 2);
10822
10823	emit_move_insn (ra, operands[2]);
10824	operands[2] = ra;
10825      }
10826    /* This is a hack -- we may have crystalized the function type too
10827       early.  */
10828    cfun->machine->func_type = 0;
10829  }"
10830)
10831
10832;; This split is only used during output to reduce the number of patterns
10833;; that need assembler instructions adding to them.  We allowed the setting
10834;; of the conditions to be implicit during rtl generation so that
10835;; the conditional compare patterns would work.  However this conflicts to
10836;; some extent with the conditional data operations, so we have to split them
10837;; up again here.
10838
10839;; ??? Need to audit these splitters for Thumb-2.  Why isn't normal
10840;; conditional execution sufficient?
10841
10842(define_split
10843  [(set (match_operand:SI 0 "s_register_operand" "")
10844	(if_then_else:SI (match_operator 1 "arm_comparison_operator"
10845			  [(match_operand 2 "" "") (match_operand 3 "" "")])
10846			 (match_dup 0)
10847			 (match_operand 4 "" "")))
10848   (clobber (reg:CC CC_REGNUM))]
10849  "TARGET_ARM && reload_completed"
10850  [(set (match_dup 5) (match_dup 6))
10851   (cond_exec (match_dup 7)
10852	      (set (match_dup 0) (match_dup 4)))]
10853  "
10854  {
10855    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
10856					     operands[2], operands[3]);
10857    enum rtx_code rc = GET_CODE (operands[1]);
10858
10859    operands[5] = gen_rtx_REG (mode, CC_REGNUM);
10860    operands[6] = gen_rtx_COMPARE (mode, operands[2], operands[3]);
10861    if (mode == CCFPmode || mode == CCFPEmode)
10862      rc = reverse_condition_maybe_unordered (rc);
10863    else
10864      rc = reverse_condition (rc);
10865
10866    operands[7] = gen_rtx_fmt_ee (rc, VOIDmode, operands[5], const0_rtx);
10867  }"
10868)
10869
10870(define_split
10871  [(set (match_operand:SI 0 "s_register_operand" "")
10872	(if_then_else:SI (match_operator 1 "arm_comparison_operator"
10873			  [(match_operand 2 "" "") (match_operand 3 "" "")])
10874			 (match_operand 4 "" "")
10875			 (match_dup 0)))
10876   (clobber (reg:CC CC_REGNUM))]
10877  "TARGET_ARM && reload_completed"
10878  [(set (match_dup 5) (match_dup 6))
10879   (cond_exec (match_op_dup 1 [(match_dup 5) (const_int 0)])
10880	      (set (match_dup 0) (match_dup 4)))]
10881  "
10882  {
10883    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
10884					     operands[2], operands[3]);
10885
10886    operands[5] = gen_rtx_REG (mode, CC_REGNUM);
10887    operands[6] = gen_rtx_COMPARE (mode, operands[2], operands[3]);
10888  }"
10889)
10890
10891(define_split
10892  [(set (match_operand:SI 0 "s_register_operand" "")
10893	(if_then_else:SI (match_operator 1 "arm_comparison_operator"
10894			  [(match_operand 2 "" "") (match_operand 3 "" "")])
10895			 (match_operand 4 "" "")
10896			 (match_operand 5 "" "")))
10897   (clobber (reg:CC CC_REGNUM))]
10898  "TARGET_ARM && reload_completed"
10899  [(set (match_dup 6) (match_dup 7))
10900   (cond_exec (match_op_dup 1 [(match_dup 6) (const_int 0)])
10901	      (set (match_dup 0) (match_dup 4)))
10902   (cond_exec (match_dup 8)
10903	      (set (match_dup 0) (match_dup 5)))]
10904  "
10905  {
10906    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
10907					     operands[2], operands[3]);
10908    enum rtx_code rc = GET_CODE (operands[1]);
10909
10910    operands[6] = gen_rtx_REG (mode, CC_REGNUM);
10911    operands[7] = gen_rtx_COMPARE (mode, operands[2], operands[3]);
10912    if (mode == CCFPmode || mode == CCFPEmode)
10913      rc = reverse_condition_maybe_unordered (rc);
10914    else
10915      rc = reverse_condition (rc);
10916
10917    operands[8] = gen_rtx_fmt_ee (rc, VOIDmode, operands[6], const0_rtx);
10918  }"
10919)
10920
10921(define_split
10922  [(set (match_operand:SI 0 "s_register_operand" "")
10923	(if_then_else:SI (match_operator 1 "arm_comparison_operator"
10924			  [(match_operand:SI 2 "s_register_operand" "")
10925			   (match_operand:SI 3 "arm_add_operand" "")])
10926			 (match_operand:SI 4 "arm_rhs_operand" "")
10927			 (not:SI
10928			  (match_operand:SI 5 "s_register_operand" ""))))
10929   (clobber (reg:CC CC_REGNUM))]
10930  "TARGET_ARM && reload_completed"
10931  [(set (match_dup 6) (match_dup 7))
10932   (cond_exec (match_op_dup 1 [(match_dup 6) (const_int 0)])
10933	      (set (match_dup 0) (match_dup 4)))
10934   (cond_exec (match_dup 8)
10935	      (set (match_dup 0) (not:SI (match_dup 5))))]
10936  "
10937  {
10938    machine_mode mode = SELECT_CC_MODE (GET_CODE (operands[1]),
10939					     operands[2], operands[3]);
10940    enum rtx_code rc = GET_CODE (operands[1]);
10941
10942    operands[6] = gen_rtx_REG (mode, CC_REGNUM);
10943    operands[7] = gen_rtx_COMPARE (mode, operands[2], operands[3]);
10944    if (mode == CCFPmode || mode == CCFPEmode)
10945      rc = reverse_condition_maybe_unordered (rc);
10946    else
10947      rc = reverse_condition (rc);
10948
10949    operands[8] = gen_rtx_fmt_ee (rc, VOIDmode, operands[6], const0_rtx);
10950  }"
10951)
10952
10953(define_insn "*cond_move_not"
10954  [(set (match_operand:SI 0 "s_register_operand" "=r,r")
10955	(if_then_else:SI (match_operator 4 "arm_comparison_operator"
10956			  [(match_operand 3 "cc_register" "") (const_int 0)])
10957			 (match_operand:SI 1 "arm_rhs_operand" "0,?rI")
10958			 (not:SI
10959			  (match_operand:SI 2 "s_register_operand" "r,r"))))]
10960  "TARGET_ARM"
10961  "@
10962   mvn%D4\\t%0, %2
10963   mov%d4\\t%0, %1\;mvn%D4\\t%0, %2"
10964  [(set_attr "conds" "use")
10965   (set_attr "type" "mvn_reg,multiple")
10966   (set_attr "length" "4,8")]
10967)
10968
10969;; The next two patterns occur when an AND operation is followed by a
10970;; scc insn sequence
10971
10972(define_insn "*sign_extract_onebit"
10973  [(set (match_operand:SI 0 "s_register_operand" "=r")
10974	(sign_extract:SI (match_operand:SI 1 "s_register_operand" "r")
10975			 (const_int 1)
10976			 (match_operand:SI 2 "const_int_operand" "n")))
10977    (clobber (reg:CC CC_REGNUM))]
10978  "TARGET_ARM"
10979  "*
10980    operands[2] = GEN_INT (1 << INTVAL (operands[2]));
10981    output_asm_insn (\"ands\\t%0, %1, %2\", operands);
10982    return \"mvnne\\t%0, #0\";
10983  "
10984  [(set_attr "conds" "clob")
10985   (set_attr "length" "8")
10986   (set_attr "type" "multiple")]
10987)
10988
10989(define_insn "*not_signextract_onebit"
10990  [(set (match_operand:SI 0 "s_register_operand" "=r")
10991	(not:SI
10992	 (sign_extract:SI (match_operand:SI 1 "s_register_operand" "r")
10993			  (const_int 1)
10994			  (match_operand:SI 2 "const_int_operand" "n"))))
10995   (clobber (reg:CC CC_REGNUM))]
10996  "TARGET_ARM"
10997  "*
10998    operands[2] = GEN_INT (1 << INTVAL (operands[2]));
10999    output_asm_insn (\"tst\\t%1, %2\", operands);
11000    output_asm_insn (\"mvneq\\t%0, #0\", operands);
11001    return \"movne\\t%0, #0\";
11002  "
11003  [(set_attr "conds" "clob")
11004   (set_attr "length" "12")
11005   (set_attr "type" "multiple")]
11006)
11007;; ??? The above patterns need auditing for Thumb-2
11008
11009;; Push multiple registers to the stack.  Registers are in parallel (use ...)
11010;; expressions.  For simplicity, the first register is also in the unspec
11011;; part.
11012;; To avoid the usage of GNU extension, the length attribute is computed
11013;; in a C function arm_attr_length_push_multi.
11014(define_insn "*push_multi"
11015  [(match_parallel 2 "multi_register_push"
11016    [(set (match_operand:BLK 0 "push_mult_memory_operand" "")
11017	  (unspec:BLK [(match_operand:SI 1 "s_register_operand" "")]
11018		      UNSPEC_PUSH_MULT))])]
11019  ""
11020  "*
11021  {
11022    int num_saves = XVECLEN (operands[2], 0);
11023
11024    /* For the StrongARM at least it is faster to
11025       use STR to store only a single register.
11026       In Thumb mode always use push, and the assembler will pick
11027       something appropriate.  */
11028    if (num_saves == 1 && TARGET_ARM)
11029      output_asm_insn (\"str%?\\t%1, [%m0, #-4]!\", operands);
11030    else
11031      {
11032	int i;
11033	char pattern[100];
11034
11035	if (TARGET_32BIT)
11036	    strcpy (pattern, \"push%?\\t{%1\");
11037	else
11038	    strcpy (pattern, \"push\\t{%1\");
11039
11040	for (i = 1; i < num_saves; i++)
11041	  {
11042	    strcat (pattern, \", %|\");
11043	    strcat (pattern,
11044		    reg_names[REGNO (XEXP (XVECEXP (operands[2], 0, i), 0))]);
11045	  }
11046
11047	strcat (pattern, \"}\");
11048	output_asm_insn (pattern, operands);
11049      }
11050
11051    return \"\";
11052  }"
11053  [(set_attr "type" "store_16")
11054   (set (attr "length")
11055	(symbol_ref "arm_attr_length_push_multi (operands[2], operands[1])"))]
11056)
11057
11058(define_insn "stack_tie"
11059  [(set (mem:BLK (scratch))
11060	(unspec:BLK [(match_operand:SI 0 "s_register_operand" "rk")
11061		     (match_operand:SI 1 "s_register_operand" "rk")]
11062		    UNSPEC_PRLG_STK))]
11063  ""
11064  ""
11065  [(set_attr "length" "0")
11066   (set_attr "type" "block")]
11067)
11068
11069;; Pop (as used in epilogue RTL)
11070;;
11071(define_insn "*load_multiple_with_writeback"
11072  [(match_parallel 0 "load_multiple_operation"
11073    [(set (match_operand:SI 1 "s_register_operand" "+rk")
11074          (plus:SI (match_dup 1)
11075                   (match_operand:SI 2 "const_int_I_operand" "I")))
11076     (set (match_operand:SI 3 "s_register_operand" "=rk")
11077          (mem:SI (match_dup 1)))
11078        ])]
11079  "TARGET_32BIT && (reload_in_progress || reload_completed)"
11080  "*
11081  {
11082    arm_output_multireg_pop (operands, /*return_pc=*/false,
11083                                       /*cond=*/const_true_rtx,
11084                                       /*reverse=*/false,
11085                                       /*update=*/true);
11086    return \"\";
11087  }
11088  "
11089  [(set_attr "type" "load_16")
11090   (set_attr "predicable" "yes")
11091   (set (attr "length")
11092	(symbol_ref "arm_attr_length_pop_multi (operands,
11093						/*return_pc=*/false,
11094						/*write_back_p=*/true)"))]
11095)
11096
11097;; Pop with return (as used in epilogue RTL)
11098;;
11099;; This instruction is generated when the registers are popped at the end of
11100;; epilogue.  Here, instead of popping the value into LR and then generating
11101;; jump to LR, value is popped into PC directly.  Hence, the pattern is combined
11102;;  with (return).
11103(define_insn "*pop_multiple_with_writeback_and_return"
11104  [(match_parallel 0 "pop_multiple_return"
11105    [(return)
11106     (set (match_operand:SI 1 "s_register_operand" "+rk")
11107          (plus:SI (match_dup 1)
11108                   (match_operand:SI 2 "const_int_I_operand" "I")))
11109     (set (match_operand:SI 3 "s_register_operand" "=rk")
11110          (mem:SI (match_dup 1)))
11111        ])]
11112  "TARGET_32BIT && (reload_in_progress || reload_completed)"
11113  "*
11114  {
11115    arm_output_multireg_pop (operands, /*return_pc=*/true,
11116                                       /*cond=*/const_true_rtx,
11117                                       /*reverse=*/false,
11118                                       /*update=*/true);
11119    return \"\";
11120  }
11121  "
11122  [(set_attr "type" "load_16")
11123   (set_attr "predicable" "yes")
11124   (set (attr "length")
11125	(symbol_ref "arm_attr_length_pop_multi (operands, /*return_pc=*/true,
11126						/*write_back_p=*/true)"))]
11127)
11128
11129(define_insn "*pop_multiple_with_return"
11130  [(match_parallel 0 "pop_multiple_return"
11131    [(return)
11132     (set (match_operand:SI 2 "s_register_operand" "=rk")
11133          (mem:SI (match_operand:SI 1 "s_register_operand" "rk")))
11134        ])]
11135  "TARGET_32BIT && (reload_in_progress || reload_completed)"
11136  "*
11137  {
11138    arm_output_multireg_pop (operands, /*return_pc=*/true,
11139                                       /*cond=*/const_true_rtx,
11140                                       /*reverse=*/false,
11141                                       /*update=*/false);
11142    return \"\";
11143  }
11144  "
11145  [(set_attr "type" "load_16")
11146   (set_attr "predicable" "yes")
11147   (set (attr "length")
11148	(symbol_ref "arm_attr_length_pop_multi (operands, /*return_pc=*/true,
11149						/*write_back_p=*/false)"))]
11150)
11151
11152;; Load into PC and return
11153(define_insn "*ldr_with_return"
11154  [(return)
11155   (set (reg:SI PC_REGNUM)
11156        (mem:SI (post_inc:SI (match_operand:SI 0 "s_register_operand" "+rk"))))]
11157  "TARGET_32BIT && (reload_in_progress || reload_completed)"
11158  "ldr%?\t%|pc, [%0], #4"
11159  [(set_attr "type" "load_4")
11160   (set_attr "predicable" "yes")]
11161)
11162;; Pop for floating point registers (as used in epilogue RTL)
11163(define_insn "*vfp_pop_multiple_with_writeback"
11164  [(match_parallel 0 "pop_multiple_fp"
11165    [(set (match_operand:SI 1 "s_register_operand" "+rk")
11166          (plus:SI (match_dup 1)
11167                   (match_operand:SI 2 "const_int_I_operand" "I")))
11168     (set (match_operand:DF 3 "vfp_hard_register_operand" "")
11169          (mem:DF (match_dup 1)))])]
11170  "TARGET_32BIT && TARGET_HARD_FLOAT"
11171  "*
11172  {
11173    int num_regs = XVECLEN (operands[0], 0);
11174    char pattern[100];
11175    rtx op_list[2];
11176    strcpy (pattern, \"vldm\\t\");
11177    strcat (pattern, reg_names[REGNO (SET_DEST (XVECEXP (operands[0], 0, 0)))]);
11178    strcat (pattern, \"!, {\");
11179    op_list[0] = XEXP (XVECEXP (operands[0], 0, 1), 0);
11180    strcat (pattern, \"%P0\");
11181    if ((num_regs - 1) > 1)
11182      {
11183        strcat (pattern, \"-%P1\");
11184        op_list [1] = XEXP (XVECEXP (operands[0], 0, num_regs - 1), 0);
11185      }
11186
11187    strcat (pattern, \"}\");
11188    output_asm_insn (pattern, op_list);
11189    return \"\";
11190  }
11191  "
11192  [(set_attr "type" "load_16")
11193   (set_attr "conds" "unconditional")
11194   (set_attr "predicable" "no")]
11195)
11196
11197;; Special patterns for dealing with the constant pool
11198
11199(define_insn "align_4"
11200  [(unspec_volatile [(const_int 0)] VUNSPEC_ALIGN)]
11201  "TARGET_EITHER"
11202  "*
11203  assemble_align (32);
11204  return \"\";
11205  "
11206  [(set_attr "type" "no_insn")]
11207)
11208
11209(define_insn "align_8"
11210  [(unspec_volatile [(const_int 0)] VUNSPEC_ALIGN8)]
11211  "TARGET_EITHER"
11212  "*
11213  assemble_align (64);
11214  return \"\";
11215  "
11216  [(set_attr "type" "no_insn")]
11217)
11218
11219(define_insn "consttable_end"
11220  [(unspec_volatile [(const_int 0)] VUNSPEC_POOL_END)]
11221  "TARGET_EITHER"
11222  "*
11223  making_const_table = FALSE;
11224  return \"\";
11225  "
11226  [(set_attr "type" "no_insn")]
11227)
11228
11229(define_insn "consttable_1"
11230  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_1)]
11231  "TARGET_EITHER"
11232  "*
11233  making_const_table = TRUE;
11234  assemble_integer (operands[0], 1, BITS_PER_WORD, 1);
11235  assemble_zeros (3);
11236  return \"\";
11237  "
11238  [(set_attr "length" "4")
11239   (set_attr "type" "no_insn")]
11240)
11241
11242(define_insn "consttable_2"
11243  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_2)]
11244  "TARGET_EITHER"
11245  "*
11246  {
11247    rtx x = operands[0];
11248    making_const_table = TRUE;
11249    switch (GET_MODE_CLASS (GET_MODE (x)))
11250      {
11251      case MODE_FLOAT:
11252	arm_emit_fp16_const (x);
11253	break;
11254      default:
11255	assemble_integer (operands[0], 2, BITS_PER_WORD, 1);
11256	assemble_zeros (2);
11257	break;
11258      }
11259    return \"\";
11260  }"
11261  [(set_attr "length" "4")
11262   (set_attr "type" "no_insn")]
11263)
11264
11265(define_insn "consttable_4"
11266  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_4)]
11267  "TARGET_EITHER"
11268  "*
11269  {
11270    rtx x = operands[0];
11271    making_const_table = TRUE;
11272    scalar_float_mode float_mode;
11273    if (is_a <scalar_float_mode> (GET_MODE (x), &float_mode))
11274      assemble_real (*CONST_DOUBLE_REAL_VALUE (x), float_mode, BITS_PER_WORD);
11275    else
11276      {
11277	/* XXX: Sometimes gcc does something really dumb and ends up with
11278	   a HIGH in a constant pool entry, usually because it's trying to
11279	   load into a VFP register.  We know this will always be used in
11280	   combination with a LO_SUM which ignores the high bits, so just
11281	   strip off the HIGH.  */
11282	if (GET_CODE (x) == HIGH)
11283	  x = XEXP (x, 0);
11284        assemble_integer (x, 4, BITS_PER_WORD, 1);
11285	mark_symbol_refs_as_used (x);
11286      }
11287    return \"\";
11288  }"
11289  [(set_attr "length" "4")
11290   (set_attr "type" "no_insn")]
11291)
11292
11293(define_insn "consttable_8"
11294  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_8)]
11295  "TARGET_EITHER"
11296  "*
11297  {
11298    making_const_table = TRUE;
11299    scalar_float_mode float_mode;
11300    if (is_a <scalar_float_mode> (GET_MODE (operands[0]), &float_mode))
11301      assemble_real (*CONST_DOUBLE_REAL_VALUE (operands[0]),
11302		     float_mode, BITS_PER_WORD);
11303    else
11304      assemble_integer (operands[0], 8, BITS_PER_WORD, 1);
11305    return \"\";
11306  }"
11307  [(set_attr "length" "8")
11308   (set_attr "type" "no_insn")]
11309)
11310
11311(define_insn "consttable_16"
11312  [(unspec_volatile [(match_operand 0 "" "")] VUNSPEC_POOL_16)]
11313  "TARGET_EITHER"
11314  "*
11315  {
11316    making_const_table = TRUE;
11317    scalar_float_mode float_mode;
11318    if (is_a <scalar_float_mode> (GET_MODE (operands[0]), &float_mode))
11319      assemble_real (*CONST_DOUBLE_REAL_VALUE (operands[0]),
11320		     float_mode, BITS_PER_WORD);
11321    else
11322      assemble_integer (operands[0], 16, BITS_PER_WORD, 1);
11323    return \"\";
11324  }"
11325  [(set_attr "length" "16")
11326   (set_attr "type" "no_insn")]
11327)
11328
11329;; V5 Instructions,
11330
11331(define_insn "clzsi2"
11332  [(set (match_operand:SI 0 "s_register_operand" "=r")
11333	(clz:SI (match_operand:SI 1 "s_register_operand" "r")))]
11334  "TARGET_32BIT && arm_arch5"
11335  "clz%?\\t%0, %1"
11336  [(set_attr "predicable" "yes")
11337   (set_attr "type" "clz")])
11338
11339(define_insn "rbitsi2"
11340  [(set (match_operand:SI 0 "s_register_operand" "=r")
11341	(unspec:SI [(match_operand:SI 1 "s_register_operand" "r")] UNSPEC_RBIT))]
11342  "TARGET_32BIT && arm_arch_thumb2"
11343  "rbit%?\\t%0, %1"
11344  [(set_attr "predicable" "yes")
11345   (set_attr "type" "clz")])
11346
11347;; Keep this as a CTZ expression until after reload and then split
11348;; into RBIT + CLZ.  Since RBIT is represented as an UNSPEC it is unlikely
11349;; to fold with any other expression.
11350
11351(define_insn_and_split "ctzsi2"
11352 [(set (match_operand:SI           0 "s_register_operand" "=r")
11353       (ctz:SI (match_operand:SI  1 "s_register_operand" "r")))]
11354  "TARGET_32BIT && arm_arch_thumb2"
11355  "#"
11356  "&& reload_completed"
11357  [(const_int 0)]
11358  "
11359  emit_insn (gen_rbitsi2 (operands[0], operands[1]));
11360  emit_insn (gen_clzsi2 (operands[0], operands[0]));
11361  DONE;
11362")
11363
11364;; V5E instructions.
11365
11366(define_insn "prefetch"
11367  [(prefetch (match_operand:SI 0 "address_operand" "p")
11368	     (match_operand:SI 1 "" "")
11369	     (match_operand:SI 2 "" ""))]
11370  "TARGET_32BIT && arm_arch5e"
11371  "pld\\t%a0"
11372  [(set_attr "type" "load_4")]
11373)
11374
11375;; General predication pattern
11376
11377(define_cond_exec
11378  [(match_operator 0 "arm_comparison_operator"
11379    [(match_operand 1 "cc_register" "")
11380     (const_int 0)])]
11381  "TARGET_32BIT
11382   && (!TARGET_NO_VOLATILE_CE || !volatile_refs_p (PATTERN (insn)))"
11383  ""
11384[(set_attr "predicated" "yes")]
11385)
11386
11387(define_insn "force_register_use"
11388  [(unspec:SI [(match_operand:SI 0 "register_operand" "")] UNSPEC_REGISTER_USE)]
11389  ""
11390  "%@ %0 needed"
11391  [(set_attr "length" "0")
11392   (set_attr "type" "no_insn")]
11393)
11394
11395
11396;; Patterns for exception handling
11397
11398(define_expand "eh_return"
11399  [(use (match_operand 0 "general_operand" ""))]
11400  "TARGET_EITHER"
11401  "
11402  {
11403    if (TARGET_32BIT)
11404      emit_insn (gen_arm_eh_return (operands[0]));
11405    else
11406      emit_insn (gen_thumb_eh_return (operands[0]));
11407    DONE;
11408  }"
11409)
11410
11411;; We can't expand this before we know where the link register is stored.
11412(define_insn_and_split "arm_eh_return"
11413  [(unspec_volatile [(match_operand:SI 0 "s_register_operand" "r")]
11414		    VUNSPEC_EH_RETURN)
11415   (clobber (match_scratch:SI 1 "=&r"))]
11416  "TARGET_ARM"
11417  "#"
11418  "&& reload_completed"
11419  [(const_int 0)]
11420  "
11421  {
11422    arm_set_return_address (operands[0], operands[1]);
11423    DONE;
11424  }"
11425)
11426
11427
11428;; TLS support
11429
11430(define_insn "load_tp_hard"
11431  [(set (match_operand:SI 0 "register_operand" "=r")
11432	(unspec:SI [(const_int 0)] UNSPEC_TLS))]
11433  "TARGET_HARD_TP"
11434  "mrc%?\\tp15, 0, %0, c13, c0, 3\\t@ load_tp_hard"
11435  [(set_attr "predicable" "yes")
11436   (set_attr "type" "mrs")]
11437)
11438
11439;; Doesn't clobber R1-R3.  Must use r0 for the first operand.
11440(define_insn "load_tp_soft"
11441  [(set (reg:SI 0) (unspec:SI [(const_int 0)] UNSPEC_TLS))
11442   (clobber (reg:SI LR_REGNUM))
11443   (clobber (reg:SI IP_REGNUM))
11444   (clobber (reg:CC CC_REGNUM))]
11445  "TARGET_SOFT_TP"
11446  "bl\\t__aeabi_read_tp\\t@ load_tp_soft"
11447  [(set_attr "conds" "clob")
11448   (set_attr "type" "branch")]
11449)
11450
11451;; tls descriptor call
11452(define_insn "tlscall"
11453  [(set (reg:SI R0_REGNUM)
11454        (unspec:SI [(reg:SI R0_REGNUM)
11455                    (match_operand:SI 0 "" "X")
11456	            (match_operand 1 "" "")] UNSPEC_TLS))
11457   (clobber (reg:SI R1_REGNUM))
11458   (clobber (reg:SI LR_REGNUM))
11459   (clobber (reg:SI CC_REGNUM))]
11460  "TARGET_GNU2_TLS"
11461  {
11462    targetm.asm_out.internal_label (asm_out_file, "LPIC",
11463				    INTVAL (operands[1]));
11464    return "bl\\t%c0(tlscall)";
11465  }
11466  [(set_attr "conds" "clob")
11467   (set_attr "length" "4")
11468   (set_attr "type" "branch")]
11469)
11470
11471;; For thread pointer builtin
11472(define_expand "get_thread_pointersi"
11473  [(match_operand:SI 0 "s_register_operand" "=r")]
11474 ""
11475 "
11476 {
11477   arm_load_tp (operands[0]);
11478   DONE;
11479 }")
11480
11481;;
11482
11483;; We only care about the lower 16 bits of the constant
11484;; being inserted into the upper 16 bits of the register.
11485(define_insn "*arm_movtas_ze"
11486  [(set (zero_extract:SI (match_operand:SI 0 "s_register_operand" "+r,r")
11487                   (const_int 16)
11488                   (const_int 16))
11489        (match_operand:SI 1 "const_int_operand" ""))]
11490  "TARGET_HAVE_MOVT"
11491  "@
11492   movt%?\t%0, %L1
11493   movt\t%0, %L1"
11494 [(set_attr "arch" "32,v8mb")
11495  (set_attr "predicable" "yes")
11496  (set_attr "length" "4")
11497  (set_attr "type" "alu_sreg")]
11498)
11499
11500(define_insn "*arm_rev"
11501  [(set (match_operand:SI 0 "s_register_operand" "=l,l,r")
11502	(bswap:SI (match_operand:SI 1 "s_register_operand" "l,l,r")))]
11503  "arm_arch6"
11504  "@
11505   rev\t%0, %1
11506   rev%?\t%0, %1
11507   rev%?\t%0, %1"
11508  [(set_attr "arch" "t1,t2,32")
11509   (set_attr "length" "2,2,4")
11510   (set_attr "predicable" "no,yes,yes")
11511   (set_attr "type" "rev")]
11512)
11513
11514(define_expand "arm_legacy_rev"
11515  [(set (match_operand:SI 2 "s_register_operand" "")
11516	(xor:SI (rotatert:SI (match_operand:SI 1 "s_register_operand" "")
11517			     (const_int 16))
11518		(match_dup 1)))
11519   (set (match_dup 2)
11520	(lshiftrt:SI (match_dup 2)
11521		     (const_int 8)))
11522   (set (match_operand:SI 3 "s_register_operand" "")
11523	(rotatert:SI (match_dup 1)
11524		     (const_int 8)))
11525   (set (match_dup 2)
11526	(and:SI (match_dup 2)
11527		(const_int -65281)))
11528   (set (match_operand:SI 0 "s_register_operand" "")
11529	(xor:SI (match_dup 3)
11530		(match_dup 2)))]
11531  "TARGET_32BIT"
11532  ""
11533)
11534
11535;; Reuse temporaries to keep register pressure down.
11536(define_expand "thumb_legacy_rev"
11537  [(set (match_operand:SI 2 "s_register_operand" "")
11538     (ashift:SI (match_operand:SI 1 "s_register_operand" "")
11539                (const_int 24)))
11540   (set (match_operand:SI 3 "s_register_operand" "")
11541     (lshiftrt:SI (match_dup 1)
11542		  (const_int 24)))
11543   (set (match_dup 3)
11544     (ior:SI (match_dup 3)
11545	     (match_dup 2)))
11546   (set (match_operand:SI 4 "s_register_operand" "")
11547     (const_int 16))
11548   (set (match_operand:SI 5 "s_register_operand" "")
11549     (rotatert:SI (match_dup 1)
11550		  (match_dup 4)))
11551   (set (match_dup 2)
11552     (ashift:SI (match_dup 5)
11553                (const_int 24)))
11554   (set (match_dup 5)
11555     (lshiftrt:SI (match_dup 5)
11556		  (const_int 24)))
11557   (set (match_dup 5)
11558     (ior:SI (match_dup 5)
11559	     (match_dup 2)))
11560   (set (match_dup 5)
11561     (rotatert:SI (match_dup 5)
11562		  (match_dup 4)))
11563   (set (match_operand:SI 0 "s_register_operand" "")
11564     (ior:SI (match_dup 5)
11565             (match_dup 3)))]
11566  "TARGET_THUMB"
11567  ""
11568)
11569
11570;; ARM-specific expansion of signed mod by power of 2
11571;; using conditional negate.
11572;; For r0 % n where n is a power of 2 produce:
11573;; rsbs    r1, r0, #0
11574;; and     r0, r0, #(n - 1)
11575;; and     r1, r1, #(n - 1)
11576;; rsbpl   r0, r1, #0
11577
11578(define_expand "modsi3"
11579  [(match_operand:SI 0 "register_operand" "")
11580   (match_operand:SI 1 "register_operand" "")
11581   (match_operand:SI 2 "const_int_operand" "")]
11582  "TARGET_32BIT"
11583  {
11584    HOST_WIDE_INT val = INTVAL (operands[2]);
11585
11586    if (val <= 0
11587       || exact_log2 (val) <= 0)
11588      FAIL;
11589
11590    rtx mask = GEN_INT (val - 1);
11591
11592    /* In the special case of x0 % 2 we can do the even shorter:
11593	cmp     r0, #0
11594	and     r0, r0, #1
11595	rsblt   r0, r0, #0.  */
11596
11597    if (val == 2)
11598      {
11599	rtx cc_reg = arm_gen_compare_reg (LT,
11600					  operands[1], const0_rtx, NULL_RTX);
11601	rtx cond = gen_rtx_LT (SImode, cc_reg, const0_rtx);
11602	rtx masked = gen_reg_rtx (SImode);
11603
11604	emit_insn (gen_andsi3 (masked, operands[1], mask));
11605	emit_move_insn (operands[0],
11606			gen_rtx_IF_THEN_ELSE (SImode, cond,
11607					      gen_rtx_NEG (SImode,
11608							   masked),
11609					      masked));
11610	DONE;
11611      }
11612
11613    rtx neg_op = gen_reg_rtx (SImode);
11614    rtx_insn *insn = emit_insn (gen_subsi3_compare0 (neg_op, const0_rtx,
11615						      operands[1]));
11616
11617    /* Extract the condition register and mode.  */
11618    rtx cmp = XVECEXP (PATTERN (insn), 0, 0);
11619    rtx cc_reg = SET_DEST (cmp);
11620    rtx cond = gen_rtx_GE (SImode, cc_reg, const0_rtx);
11621
11622    emit_insn (gen_andsi3 (operands[0], operands[1], mask));
11623
11624    rtx masked_neg = gen_reg_rtx (SImode);
11625    emit_insn (gen_andsi3 (masked_neg, neg_op, mask));
11626
11627    /* We want a conditional negate here, but emitting COND_EXEC rtxes
11628       during expand does not always work.  Do an IF_THEN_ELSE instead.  */
11629    emit_move_insn (operands[0],
11630		    gen_rtx_IF_THEN_ELSE (SImode, cond,
11631					  gen_rtx_NEG (SImode, masked_neg),
11632					  operands[0]));
11633
11634
11635    DONE;
11636  }
11637)
11638
11639(define_expand "bswapsi2"
11640  [(set (match_operand:SI 0 "s_register_operand" "=r")
11641  	(bswap:SI (match_operand:SI 1 "s_register_operand" "r")))]
11642"TARGET_EITHER && (arm_arch6 || !optimize_size)"
11643"
11644    if (!arm_arch6)
11645      {
11646	rtx op2 = gen_reg_rtx (SImode);
11647	rtx op3 = gen_reg_rtx (SImode);
11648
11649	if (TARGET_THUMB)
11650	  {
11651	    rtx op4 = gen_reg_rtx (SImode);
11652	    rtx op5 = gen_reg_rtx (SImode);
11653
11654	    emit_insn (gen_thumb_legacy_rev (operands[0], operands[1],
11655					     op2, op3, op4, op5));
11656	  }
11657	else
11658	  {
11659	    emit_insn (gen_arm_legacy_rev (operands[0], operands[1],
11660					   op2, op3));
11661	  }
11662
11663	DONE;
11664      }
11665  "
11666)
11667
11668;; bswap16 patterns: use revsh and rev16 instructions for the signed
11669;; and unsigned variants, respectively. For rev16, expose
11670;; byte-swapping in the lower 16 bits only.
11671(define_insn "*arm_revsh"
11672  [(set (match_operand:SI 0 "s_register_operand" "=l,l,r")
11673	(sign_extend:SI (bswap:HI (match_operand:HI 1 "s_register_operand" "l,l,r"))))]
11674  "arm_arch6"
11675  "@
11676  revsh\t%0, %1
11677  revsh%?\t%0, %1
11678  revsh%?\t%0, %1"
11679  [(set_attr "arch" "t1,t2,32")
11680   (set_attr "length" "2,2,4")
11681   (set_attr "type" "rev")]
11682)
11683
11684(define_insn "*arm_rev16"
11685  [(set (match_operand:HI 0 "s_register_operand" "=l,l,r")
11686	(bswap:HI (match_operand:HI 1 "s_register_operand" "l,l,r")))]
11687  "arm_arch6"
11688  "@
11689   rev16\t%0, %1
11690   rev16%?\t%0, %1
11691   rev16%?\t%0, %1"
11692  [(set_attr "arch" "t1,t2,32")
11693   (set_attr "length" "2,2,4")
11694   (set_attr "type" "rev")]
11695)
11696
11697;; There are no canonicalisation rules for the position of the lshiftrt, ashift
11698;; operations within an IOR/AND RTX, therefore we have two patterns matching
11699;; each valid permutation.
11700
11701(define_insn "arm_rev16si2"
11702  [(set (match_operand:SI 0 "register_operand" "=l,l,r")
11703        (ior:SI (and:SI (ashift:SI (match_operand:SI 1 "register_operand" "l,l,r")
11704                                   (const_int 8))
11705                        (match_operand:SI 3 "const_int_operand" "n,n,n"))
11706                (and:SI (lshiftrt:SI (match_dup 1)
11707                                     (const_int 8))
11708                        (match_operand:SI 2 "const_int_operand" "n,n,n"))))]
11709  "arm_arch6
11710   && aarch_rev16_shleft_mask_imm_p (operands[3], SImode)
11711   && aarch_rev16_shright_mask_imm_p (operands[2], SImode)"
11712  "rev16\\t%0, %1"
11713  [(set_attr "arch" "t1,t2,32")
11714   (set_attr "length" "2,2,4")
11715   (set_attr "type" "rev")]
11716)
11717
11718(define_insn "arm_rev16si2_alt"
11719  [(set (match_operand:SI 0 "register_operand" "=l,l,r")
11720        (ior:SI (and:SI (lshiftrt:SI (match_operand:SI 1 "register_operand" "l,l,r")
11721                                     (const_int 8))
11722                        (match_operand:SI 2 "const_int_operand" "n,n,n"))
11723                (and:SI (ashift:SI (match_dup 1)
11724                                   (const_int 8))
11725                        (match_operand:SI 3 "const_int_operand" "n,n,n"))))]
11726  "arm_arch6
11727   && aarch_rev16_shleft_mask_imm_p (operands[3], SImode)
11728   && aarch_rev16_shright_mask_imm_p (operands[2], SImode)"
11729  "rev16\\t%0, %1"
11730  [(set_attr "arch" "t1,t2,32")
11731   (set_attr "length" "2,2,4")
11732   (set_attr "type" "rev")]
11733)
11734
11735(define_expand "bswaphi2"
11736  [(set (match_operand:HI 0 "s_register_operand" "=r")
11737	(bswap:HI (match_operand:HI 1 "s_register_operand" "r")))]
11738"arm_arch6"
11739""
11740)
11741
11742;; Patterns for LDRD/STRD in Thumb2 mode
11743
11744(define_insn "*thumb2_ldrd"
11745  [(set (match_operand:SI 0 "s_register_operand" "=r")
11746        (mem:SI (plus:SI (match_operand:SI 1 "s_register_operand" "rk")
11747                         (match_operand:SI 2 "ldrd_strd_offset_operand" "Do"))))
11748   (set (match_operand:SI 3 "s_register_operand" "=r")
11749        (mem:SI (plus:SI (match_dup 1)
11750                         (match_operand:SI 4 "const_int_operand" ""))))]
11751  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11752     && ((INTVAL (operands[2]) + 4) == INTVAL (operands[4]))
11753     && (operands_ok_ldrd_strd (operands[0], operands[3],
11754                                  operands[1], INTVAL (operands[2]),
11755                                  false, true))"
11756  "ldrd%?\t%0, %3, [%1, %2]"
11757  [(set_attr "type" "load_8")
11758   (set_attr "predicable" "yes")])
11759
11760(define_insn "*thumb2_ldrd_base"
11761  [(set (match_operand:SI 0 "s_register_operand" "=r")
11762        (mem:SI (match_operand:SI 1 "s_register_operand" "rk")))
11763   (set (match_operand:SI 2 "s_register_operand" "=r")
11764        (mem:SI (plus:SI (match_dup 1)
11765                         (const_int 4))))]
11766  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11767     && (operands_ok_ldrd_strd (operands[0], operands[2],
11768                                  operands[1], 0, false, true))"
11769  "ldrd%?\t%0, %2, [%1]"
11770  [(set_attr "type" "load_8")
11771   (set_attr "predicable" "yes")])
11772
11773(define_insn "*thumb2_ldrd_base_neg"
11774  [(set (match_operand:SI 0 "s_register_operand" "=r")
11775	(mem:SI (plus:SI (match_operand:SI 1 "s_register_operand" "rk")
11776                         (const_int -4))))
11777   (set (match_operand:SI 2 "s_register_operand" "=r")
11778        (mem:SI (match_dup 1)))]
11779  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11780     && (operands_ok_ldrd_strd (operands[0], operands[2],
11781                                  operands[1], -4, false, true))"
11782  "ldrd%?\t%0, %2, [%1, #-4]"
11783  [(set_attr "type" "load_8")
11784   (set_attr "predicable" "yes")])
11785
11786(define_insn "*thumb2_strd"
11787  [(set (mem:SI (plus:SI (match_operand:SI 0 "s_register_operand" "rk")
11788                         (match_operand:SI 1 "ldrd_strd_offset_operand" "Do")))
11789        (match_operand:SI 2 "s_register_operand" "r"))
11790   (set (mem:SI (plus:SI (match_dup 0)
11791                         (match_operand:SI 3 "const_int_operand" "")))
11792        (match_operand:SI 4 "s_register_operand" "r"))]
11793  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11794     && ((INTVAL (operands[1]) + 4) == INTVAL (operands[3]))
11795     && (operands_ok_ldrd_strd (operands[2], operands[4],
11796                                  operands[0], INTVAL (operands[1]),
11797                                  false, false))"
11798  "strd%?\t%2, %4, [%0, %1]"
11799  [(set_attr "type" "store_8")
11800   (set_attr "predicable" "yes")])
11801
11802(define_insn "*thumb2_strd_base"
11803  [(set (mem:SI (match_operand:SI 0 "s_register_operand" "rk"))
11804        (match_operand:SI 1 "s_register_operand" "r"))
11805   (set (mem:SI (plus:SI (match_dup 0)
11806                         (const_int 4)))
11807        (match_operand:SI 2 "s_register_operand" "r"))]
11808  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11809     && (operands_ok_ldrd_strd (operands[1], operands[2],
11810                                  operands[0], 0, false, false))"
11811  "strd%?\t%1, %2, [%0]"
11812  [(set_attr "type" "store_8")
11813   (set_attr "predicable" "yes")])
11814
11815(define_insn "*thumb2_strd_base_neg"
11816  [(set (mem:SI (plus:SI (match_operand:SI 0 "s_register_operand" "rk")
11817                         (const_int -4)))
11818        (match_operand:SI 1 "s_register_operand" "r"))
11819   (set (mem:SI (match_dup 0))
11820        (match_operand:SI 2 "s_register_operand" "r"))]
11821  "TARGET_LDRD && TARGET_THUMB2 && reload_completed
11822     && (operands_ok_ldrd_strd (operands[1], operands[2],
11823                                  operands[0], -4, false, false))"
11824  "strd%?\t%1, %2, [%0, #-4]"
11825  [(set_attr "type" "store_8")
11826   (set_attr "predicable" "yes")])
11827
11828;; ARMv8 CRC32 instructions.
11829(define_insn "<crc_variant>"
11830  [(set (match_operand:SI 0 "s_register_operand" "=r")
11831        (unspec:SI [(match_operand:SI 1 "s_register_operand" "r")
11832                    (match_operand:<crc_mode> 2 "s_register_operand" "r")]
11833         CRC))]
11834  "TARGET_CRC32"
11835  "<crc_variant>\\t%0, %1, %2"
11836  [(set_attr "type" "crc")
11837   (set_attr "conds" "unconditional")]
11838)
11839
11840;; Load the load/store double peephole optimizations.
11841(include "ldrdstrd.md")
11842
11843;; Load the load/store multiple patterns
11844(include "ldmstm.md")
11845
11846;; Patterns in ldmstm.md don't cover more than 4 registers. This pattern covers
11847;; large lists without explicit writeback generated for APCS_FRAME epilogue.
11848;; The operands are validated through the load_multiple_operation
11849;; match_parallel predicate rather than through constraints so enable it only
11850;; after reload.
11851(define_insn "*load_multiple"
11852  [(match_parallel 0 "load_multiple_operation"
11853    [(set (match_operand:SI 2 "s_register_operand" "=rk")
11854          (mem:SI (match_operand:SI 1 "s_register_operand" "rk")))
11855        ])]
11856  "TARGET_32BIT && reload_completed"
11857  "*
11858  {
11859    arm_output_multireg_pop (operands, /*return_pc=*/false,
11860                                       /*cond=*/const_true_rtx,
11861                                       /*reverse=*/false,
11862                                       /*update=*/false);
11863    return \"\";
11864  }
11865  "
11866  [(set_attr "predicable" "yes")]
11867)
11868
11869(define_expand "copysignsf3"
11870  [(match_operand:SF 0 "register_operand")
11871   (match_operand:SF 1 "register_operand")
11872   (match_operand:SF 2 "register_operand")]
11873  "TARGET_SOFT_FLOAT && arm_arch_thumb2"
11874  "{
11875     emit_move_insn (operands[0], operands[2]);
11876     emit_insn (gen_insv_t2 (simplify_gen_subreg (SImode, operands[0], SFmode, 0),
11877		GEN_INT (31), GEN_INT (0),
11878		simplify_gen_subreg (SImode, operands[1], SFmode, 0)));
11879     DONE;
11880  }"
11881)
11882
11883(define_expand "copysigndf3"
11884  [(match_operand:DF 0 "register_operand")
11885   (match_operand:DF 1 "register_operand")
11886   (match_operand:DF 2 "register_operand")]
11887  "TARGET_SOFT_FLOAT && arm_arch_thumb2"
11888  "{
11889     rtx op0_low = gen_lowpart (SImode, operands[0]);
11890     rtx op0_high = gen_highpart (SImode, operands[0]);
11891     rtx op1_low = gen_lowpart (SImode, operands[1]);
11892     rtx op1_high = gen_highpart (SImode, operands[1]);
11893     rtx op2_high = gen_highpart (SImode, operands[2]);
11894
11895     rtx scratch1 = gen_reg_rtx (SImode);
11896     rtx scratch2 = gen_reg_rtx (SImode);
11897     emit_move_insn (scratch1, op2_high);
11898     emit_move_insn (scratch2, op1_high);
11899
11900     emit_insn(gen_rtx_SET(scratch1,
11901			   gen_rtx_LSHIFTRT (SImode, op2_high, GEN_INT(31))));
11902     emit_insn(gen_insv_t2(scratch2, GEN_INT(1), GEN_INT(31), scratch1));
11903     emit_move_insn (op0_low, op1_low);
11904     emit_move_insn (op0_high, scratch2);
11905
11906     DONE;
11907  }"
11908)
11909
11910;; movmisalign patterns for HImode and SImode.
11911(define_expand "movmisalign<mode>"
11912  [(match_operand:HSI 0 "general_operand")
11913   (match_operand:HSI 1 "general_operand")]
11914  "unaligned_access"
11915{
11916  /* This pattern is not permitted to fail during expansion: if both arguments
11917     are non-registers (e.g. memory := constant), force operand 1 into a
11918     register.  */
11919  rtx (* gen_unaligned_load)(rtx, rtx);
11920  rtx tmp_dest = operands[0];
11921  if (!s_register_operand (operands[0], <MODE>mode)
11922      && !s_register_operand (operands[1], <MODE>mode))
11923    operands[1] = force_reg (<MODE>mode, operands[1]);
11924
11925  if (<MODE>mode == HImode)
11926   {
11927    gen_unaligned_load = gen_unaligned_loadhiu;
11928    tmp_dest = gen_reg_rtx (SImode);
11929   }
11930  else
11931    gen_unaligned_load = gen_unaligned_loadsi;
11932
11933  if (MEM_P (operands[1]))
11934   {
11935    emit_insn (gen_unaligned_load (tmp_dest, operands[1]));
11936    if (<MODE>mode == HImode)
11937      emit_move_insn (operands[0], gen_lowpart (HImode, tmp_dest));
11938   }
11939  else
11940    emit_insn (gen_unaligned_store<mode> (operands[0], operands[1]));
11941
11942  DONE;
11943})
11944
11945(define_insn "<cdp>"
11946  [(unspec_volatile [(match_operand:SI 0 "immediate_operand" "n")
11947		     (match_operand:SI 1 "immediate_operand" "n")
11948		     (match_operand:SI 2 "immediate_operand" "n")
11949		     (match_operand:SI 3 "immediate_operand" "n")
11950		     (match_operand:SI 4 "immediate_operand" "n")
11951		     (match_operand:SI 5 "immediate_operand" "n")] CDPI)]
11952  "arm_coproc_builtin_available (VUNSPEC_<CDP>)"
11953{
11954  arm_const_bounds (operands[0], 0, 16);
11955  arm_const_bounds (operands[1], 0, 16);
11956  arm_const_bounds (operands[2], 0, (1 << 5));
11957  arm_const_bounds (operands[3], 0, (1 << 5));
11958  arm_const_bounds (operands[4], 0, (1 << 5));
11959  arm_const_bounds (operands[5], 0, 8);
11960  return "<cdp>\\tp%c0, %1, CR%c2, CR%c3, CR%c4, %5";
11961}
11962  [(set_attr "length" "4")
11963   (set_attr "type" "coproc")])
11964
11965(define_insn "*ldc"
11966  [(unspec_volatile [(match_operand:SI 0 "immediate_operand" "n")
11967		     (match_operand:SI 1 "immediate_operand" "n")
11968		     (match_operand:SI 2 "memory_operand" "Uz")] LDCI)]
11969  "arm_coproc_builtin_available (VUNSPEC_<LDC>)"
11970{
11971  arm_const_bounds (operands[0], 0, 16);
11972  arm_const_bounds (operands[1], 0, (1 << 5));
11973  return "<ldc>\\tp%c0, CR%c1, %2";
11974}
11975  [(set_attr "length" "4")
11976   (set_attr "type" "coproc")])
11977
11978(define_insn "*stc"
11979  [(unspec_volatile [(match_operand:SI 0 "immediate_operand" "n")
11980		     (match_operand:SI 1 "immediate_operand" "n")
11981		     (match_operand:SI 2 "memory_operand" "=Uz")] STCI)]
11982  "arm_coproc_builtin_available (VUNSPEC_<STC>)"
11983{
11984  arm_const_bounds (operands[0], 0, 16);
11985  arm_const_bounds (operands[1], 0, (1 << 5));
11986  return "<stc>\\tp%c0, CR%c1, %2";
11987}
11988  [(set_attr "length" "4")
11989   (set_attr "type" "coproc")])
11990
11991(define_expand "<ldc>"
11992  [(unspec_volatile [(match_operand:SI 0 "immediate_operand")
11993		     (match_operand:SI 1 "immediate_operand")
11994		     (mem:SI (match_operand:SI 2 "s_register_operand"))] LDCI)]
11995  "arm_coproc_builtin_available (VUNSPEC_<LDC>)")
11996
11997(define_expand "<stc>"
11998  [(unspec_volatile [(match_operand:SI 0 "immediate_operand")
11999		     (match_operand:SI 1 "immediate_operand")
12000		     (mem:SI (match_operand:SI 2 "s_register_operand"))] STCI)]
12001  "arm_coproc_builtin_available (VUNSPEC_<STC>)")
12002
12003(define_insn "<mcr>"
12004  [(unspec_volatile [(match_operand:SI 0 "immediate_operand" "n")
12005		     (match_operand:SI 1 "immediate_operand" "n")
12006		     (match_operand:SI 2 "s_register_operand" "r")
12007		     (match_operand:SI 3 "immediate_operand" "n")
12008		     (match_operand:SI 4 "immediate_operand" "n")
12009		     (match_operand:SI 5 "immediate_operand" "n")] MCRI)
12010   (use (match_dup 2))]
12011  "arm_coproc_builtin_available (VUNSPEC_<MCR>)"
12012{
12013  arm_const_bounds (operands[0], 0, 16);
12014  arm_const_bounds (operands[1], 0, 8);
12015  arm_const_bounds (operands[3], 0, (1 << 5));
12016  arm_const_bounds (operands[4], 0, (1 << 5));
12017  arm_const_bounds (operands[5], 0, 8);
12018  return "<mcr>\\tp%c0, %1, %2, CR%c3, CR%c4, %5";
12019}
12020  [(set_attr "length" "4")
12021   (set_attr "type" "coproc")])
12022
12023(define_insn "<mrc>"
12024  [(set (match_operand:SI 0 "s_register_operand" "=r")
12025	(unspec_volatile:SI [(match_operand:SI 1 "immediate_operand" "n")
12026			  (match_operand:SI 2 "immediate_operand" "n")
12027			  (match_operand:SI 3 "immediate_operand" "n")
12028			  (match_operand:SI 4 "immediate_operand" "n")
12029			  (match_operand:SI 5 "immediate_operand" "n")] MRCI))]
12030  "arm_coproc_builtin_available (VUNSPEC_<MRC>)"
12031{
12032  arm_const_bounds (operands[1], 0, 16);
12033  arm_const_bounds (operands[2], 0, 8);
12034  arm_const_bounds (operands[3], 0, (1 << 5));
12035  arm_const_bounds (operands[4], 0, (1 << 5));
12036  arm_const_bounds (operands[5], 0, 8);
12037  return "<mrc>\\tp%c1, %2, %0, CR%c3, CR%c4, %5";
12038}
12039  [(set_attr "length" "4")
12040   (set_attr "type" "coproc")])
12041
12042(define_insn "<mcrr>"
12043  [(unspec_volatile [(match_operand:SI 0 "immediate_operand" "n")
12044		     (match_operand:SI 1 "immediate_operand" "n")
12045		     (match_operand:DI 2 "s_register_operand" "r")
12046		     (match_operand:SI 3 "immediate_operand" "n")] MCRRI)
12047   (use (match_dup 2))]
12048  "arm_coproc_builtin_available (VUNSPEC_<MCRR>)"
12049{
12050  arm_const_bounds (operands[0], 0, 16);
12051  arm_const_bounds (operands[1], 0, 8);
12052  arm_const_bounds (operands[3], 0, (1 << 5));
12053  return "<mcrr>\\tp%c0, %1, %Q2, %R2, CR%c3";
12054}
12055  [(set_attr "length" "4")
12056   (set_attr "type" "coproc")])
12057
12058(define_insn "<mrrc>"
12059  [(set (match_operand:DI 0 "s_register_operand" "=r")
12060	(unspec_volatile:DI [(match_operand:SI 1 "immediate_operand" "n")
12061			  (match_operand:SI 2 "immediate_operand" "n")
12062			  (match_operand:SI 3 "immediate_operand" "n")] MRRCI))]
12063  "arm_coproc_builtin_available (VUNSPEC_<MRRC>)"
12064{
12065  arm_const_bounds (operands[1], 0, 16);
12066  arm_const_bounds (operands[2], 0, 8);
12067  arm_const_bounds (operands[3], 0, (1 << 5));
12068  return "<mrrc>\\tp%c1, %2, %Q0, %R0, CR%c3";
12069}
12070  [(set_attr "length" "4")
12071   (set_attr "type" "coproc")])
12072
12073;; Vector bits common to IWMMXT and Neon
12074(include "vec-common.md")
12075;; Load the Intel Wireless Multimedia Extension patterns
12076(include "iwmmxt.md")
12077;; Load the VFP co-processor patterns
12078(include "vfp.md")
12079;; Thumb-1 patterns
12080(include "thumb1.md")
12081;; Thumb-2 patterns
12082(include "thumb2.md")
12083;; Neon patterns
12084(include "neon.md")
12085;; Crypto patterns
12086(include "crypto.md")
12087;; Synchronization Primitives
12088(include "sync.md")
12089;; Fixed-point patterns
12090(include "arm-fixed.md")
12091