@@ -769,6 +769,25 @@ assign_fortran_storage_classes(void)
769769 }
770770} /* end assign_fortran_storage_classes() */
771771
772+ INLINE static LL_MDRef
773+ cons_loop_metadata (void )
774+ {
775+ LL_MDRef lvcomp [2 ];
776+ LL_MDRef loopVect ;
777+ LL_MDRef rv ;
778+
779+ if (cpu_llvm_module -> loop_md )
780+ return cpu_llvm_module -> loop_md ;
781+ rv = ll_create_flexible_md_node (cpu_llvm_module );
782+ lvcomp [0 ] = ll_get_md_string (cpu_llvm_module , "llvm.loop.vectorize.enable" );
783+ lvcomp [1 ] = ll_get_md_i1 (0 );
784+ loopVect = ll_get_md_node (cpu_llvm_module , LL_PlainMDNode , lvcomp , 2 );
785+ ll_extend_md_node (cpu_llvm_module , rv , rv );
786+ ll_extend_md_node (cpu_llvm_module , rv , loopVect );
787+ cpu_llvm_module -> loop_md = rv ;
788+ return rv ;
789+ }
790+
772791/**
773792 \brief Perform code translation from ILI to LLVM for one routine
774793 */
@@ -965,19 +984,23 @@ schedule(void)
965984 continue ;
966985 }
967986
968- if (ILT_BR (ilt )) /* branch */
969- {
970- int next_bih_label ;
987+ if (ILT_BR (ilt )) { /* branch */
988+ int next_bih_label = 0 ;
971989
972- if (!ILT_NEXT (ilt ) && bihnext &&
973- ((next_bih_label = BIH_LABEL (bihnext )) &&
974- (DEFDG (next_bih_label ) || CCSYMG (next_bih_label ))))
975- make_stmt (STMT_BR , ilix , FALSE, next_bih_label , ilt );
976- else
977- make_stmt (STMT_BR , ilix , FALSE, 0 , ilt );
990+ if (!ILT_NEXT (ilt ) && bihnext ) {
991+ const int t_next_bih_label = BIH_LABEL (bihnext );
992+ if (t_next_bih_label &&
993+ (DEFDG (t_next_bih_label ) || CCSYMG (t_next_bih_label )))
994+ next_bih_label = t_next_bih_label ;
995+ }
996+ make_stmt (STMT_BR , ilix , FALSE, next_bih_label , ilt );
997+ if ((!XBIT (183 , 0x4000000 )) && BIH_SIMD (bih )) {
998+ LL_MDRef loop_md = cons_loop_metadata ();
999+ llvm_info .last_instr -> flags |= SIMD_BACKEDGE_FLAG ;
1000+ llvm_info .last_instr -> ll_type = (LL_Type * )(unsigned long )loop_md ;
1001+ }
9781002 } else if ((ILT_ST (ilt ) || ILT_DELETE (ilt )) &&
979- IL_TYPE (opc ) == ILTY_STORE ) /* store */
980- {
1003+ IL_TYPE (opc ) == ILTY_STORE ) { /* store */
9811004 rhs_ili = ILI_OPND (ilix , 1 );
9821005 lhs_ili = ILI_OPND (ilix , 2 );
9831006 nme = ILI_OPND (ilix , 3 );
@@ -1009,7 +1032,8 @@ schedule(void)
10091032 ilix = ILI_OPND (ilix , 1 );
10101033 opc = ILI_OPC (ilix );
10111034 break ;
1012- default :;
1035+ default :
1036+ break ;
10131037 }
10141038 if (is_mvili_opcode (opc )) /* call part of the return */
10151039 goto return_with_call ;
@@ -2213,8 +2237,7 @@ write_instructions(LL_Module *module)
22132237 print_token (llvm_instr_names [I_RESUME ]);
22142238 write_verbose_type (cc -> ll_type );
22152239 write_operand (cc , " " , FLG_OMIT_OP_TYPE );
2216- break ;
2217- }
2240+ } break ;
22182241 case I_CLEANUP :
22192242 print_token ("\t" );
22202243 print_token (llvm_instr_names [I_CLEANUP ]);
@@ -2248,8 +2271,7 @@ write_instructions(LL_Module *module)
22482271 write_operand (cc , " " , FLG_OMIT_OP_TYPE );
22492272 print_token (" to i8*)" );
22502273 }
2251- break ;
2252- }
2274+ } break ;
22532275 case I_FILTER : {
22542276 /* "filter <array-type> [ <array-of-typeinfo-vars> ]"
22552277 Each operand is a typeinfo variable for a type in the exception
@@ -2397,6 +2419,12 @@ write_instructions(LL_Module *module)
23972419 print_token (llvm_instr_names [i_name ]);
23982420 print_space (1 );
23992421 write_operands (instrs -> operands , 0 );
2422+ if (instrs -> flags & SIMD_BACKEDGE_FLAG ) {
2423+ char buf [32 ];
2424+ LL_MDRef loop_md = (LL_MDRef )(unsigned long )instrs -> ll_type ;
2425+ snprintf (buf , 32 , ", !llvm.loop !%u" , LL_MDREF_value (loop_md ));
2426+ print_token (buf );
2427+ }
24002428 }
24012429 break ;
24022430 case I_INDBR :
@@ -2796,7 +2824,7 @@ ad_instr(int ilix, INSTR_LIST *instr)
27962824 instr -> prev = llvm_info .last_instr ;
27972825 } else {
27982826 assert (!llvm_info .last_instr , "ad_instr(): last instruction not NULL" , 0 ,
2799- 4 );
2827+ ERR_Fatal );
28002828 Instructions = instr ;
28012829 }
28022830 llvm_info .last_instr = instr ;
@@ -2965,20 +2993,15 @@ make_stmt(STMT_Type stmt_type, int ilix, LOGICAL deletable, int next_bih_label,
29652993
29662994 case STMT_BR :
29672995 opc = ILI_OPC (ilix );
2968- if (opc == IL_JMP ) /* unconditional jump */
2969- {
2996+ if (opc == IL_JMP ) { /* unconditional jump */
29702997 last_stmt_is_branch = 1 ;
29712998 sptr = ILI_OPND (ilix , 1 );
2972- {
2973- /* also in gen_new_landingpad_jump */
2974- process_sptr (sptr );
2975- Curr_Instr = gen_instr (I_BR , NULL , NULL , make_target_op (sptr ));
2976- ad_instr (ilix , Curr_Instr );
2977- }
2978- } else if (exprjump (opc ) || zerojump (opc )) /* cond or zero jump */
2979- {
2980- if (exprjump (opc )) /* get sptr pointing to jump label */
2981- {
2999+ /* also in gen_new_landingpad_jump */
3000+ process_sptr (sptr );
3001+ Curr_Instr = gen_instr (I_BR , NULL , NULL , make_target_op (sptr ));
3002+ ad_instr (ilix , Curr_Instr );
3003+ } else if (exprjump (opc ) || zerojump (opc )) { /* cond or zero jump */
3004+ if (exprjump (opc )) { /* get sptr pointing to jump label */
29823005 sptr = ILI_OPND (ilix , 4 );
29833006 cc = ILI_OPND (ilix , 3 );
29843007 } else {
@@ -3811,7 +3834,8 @@ gen_unary_expr(int ilix, int itype)
38113834 case IL_DFLOATK :
38123835 opc_type = make_lltype_from_dtype (DT_INT8 );
38133836 break ;
3814- default :;
3837+ default :
3838+ break ;
38153839 }
38163840
38173841 DBGTRACE2 ("#generating unary operand, op_ili: %d(%s)" , op_ili ,
@@ -3993,7 +4017,8 @@ gen_minmax_expr(int ilix, OPERAND *op1, OPERAND *op2)
39934017 break ;
39944018 }
39954019 break ;
3996- default :; /*TODO: can this happen? */
4020+ default :
4021+ break ; /*TODO: can this happen? */
39974022 }
39984023 cmp_op = make_tmp_op (bool_type , make_tmps ());
39994024
@@ -4894,7 +4919,8 @@ gen_binary_expr(int ilix, int itype)
48944919 case IL_KNEG :
48954920 flags |= NOSIGNEDWRAP ;
48964921 break ;
4897- default :;
4922+ default :
4923+ break ;
48984924 }
48994925 /* account for the *NEG ili - LLVM treats all of these as subtractions
49004926 * from zero.
0 commit comments