1 /* Code translation -- generate GCC trees from gfc_code.
2 Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2012
3 Free Software Foundation, Inc.
4 Contributed by Paul Brook
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
24 #include "coretypes.h"
26 #include "gimple.h" /* For create_tmp_var_raw. */
27 #include "tree-iterator.h"
28 #include "diagnostic-core.h" /* For internal_error. */
32 #include "trans-stmt.h"
33 #include "trans-array.h"
34 #include "trans-types.h"
35 #include "trans-const.h"
37 /* Naming convention for backend interface code:
39 gfc_trans_* translate gfc_code into STMT trees.
41 gfc_conv_* expression conversion
43 gfc_get_* get a backend tree representation of a decl or type */
45 static gfc_file
*gfc_current_backend_file
;
47 const char gfc_msg_fault
[] = N_("Array reference out of bounds");
48 const char gfc_msg_wrong_return
[] = N_("Incorrect function return value");
51 /* Advance along TREE_CHAIN n times. */
54 gfc_advance_chain (tree t
, int n
)
58 gcc_assert (t
!= NULL_TREE
);
65 /* Strip off a legitimate source ending from the input
66 string NAME of length LEN. */
69 remove_suffix (char *name
, int len
)
73 for (i
= 2; i
< 8 && len
> i
; i
++)
75 if (name
[len
- i
] == '.')
84 /* Creates a variable declaration with a given TYPE. */
87 gfc_create_var_np (tree type
, const char *prefix
)
91 t
= create_tmp_var_raw (type
, prefix
);
93 /* No warnings for anonymous variables. */
95 TREE_NO_WARNING (t
) = 1;
101 /* Like above, but also adds it to the current scope. */
104 gfc_create_var (tree type
, const char *prefix
)
108 tmp
= gfc_create_var_np (type
, prefix
);
116 /* If the expression is not constant, evaluate it now. We assign the
117 result of the expression to an artificially created variable VAR, and
118 return a pointer to the VAR_DECL node for this variable. */
121 gfc_evaluate_now_loc (location_t loc
, tree expr
, stmtblock_t
* pblock
)
125 if (CONSTANT_CLASS_P (expr
))
128 var
= gfc_create_var (TREE_TYPE (expr
), NULL
);
129 gfc_add_modify_loc (loc
, pblock
, var
, expr
);
136 gfc_evaluate_now (tree expr
, stmtblock_t
* pblock
)
138 return gfc_evaluate_now_loc (input_location
, expr
, pblock
);
142 /* Build a MODIFY_EXPR node and add it to a given statement block PBLOCK.
143 A MODIFY_EXPR is an assignment:
147 gfc_add_modify_loc (location_t loc
, stmtblock_t
* pblock
, tree lhs
, tree rhs
)
151 #ifdef ENABLE_CHECKING
153 t1
= TREE_TYPE (rhs
);
154 t2
= TREE_TYPE (lhs
);
155 /* Make sure that the types of the rhs and the lhs are the same
156 for scalar assignments. We should probably have something
157 similar for aggregates, but right now removing that check just
158 breaks everything. */
160 || AGGREGATE_TYPE_P (TREE_TYPE (lhs
)));
163 tmp
= fold_build2_loc (loc
, MODIFY_EXPR
, void_type_node
, lhs
,
165 gfc_add_expr_to_block (pblock
, tmp
);
170 gfc_add_modify (stmtblock_t
* pblock
, tree lhs
, tree rhs
)
172 gfc_add_modify_loc (input_location
, pblock
, lhs
, rhs
);
176 /* Create a new scope/binding level and initialize a block. Care must be
177 taken when translating expressions as any temporaries will be placed in
178 the innermost scope. */
181 gfc_start_block (stmtblock_t
* block
)
183 /* Start a new binding level. */
185 block
->has_scope
= 1;
187 /* The block is empty. */
188 block
->head
= NULL_TREE
;
192 /* Initialize a block without creating a new scope. */
195 gfc_init_block (stmtblock_t
* block
)
197 block
->head
= NULL_TREE
;
198 block
->has_scope
= 0;
202 /* Sometimes we create a scope but it turns out that we don't actually
203 need it. This function merges the scope of BLOCK with its parent.
204 Only variable decls will be merged, you still need to add the code. */
207 gfc_merge_block_scope (stmtblock_t
* block
)
212 gcc_assert (block
->has_scope
);
213 block
->has_scope
= 0;
215 /* Remember the decls in this scope. */
219 /* Add them to the parent scope. */
220 while (decl
!= NULL_TREE
)
222 next
= DECL_CHAIN (decl
);
223 DECL_CHAIN (decl
) = NULL_TREE
;
231 /* Finish a scope containing a block of statements. */
234 gfc_finish_block (stmtblock_t
* stmtblock
)
240 expr
= stmtblock
->head
;
242 expr
= build_empty_stmt (input_location
);
244 stmtblock
->head
= NULL_TREE
;
246 if (stmtblock
->has_scope
)
252 block
= poplevel (1, 0);
253 expr
= build3_v (BIND_EXPR
, decl
, expr
, block
);
263 /* Build an ADDR_EXPR and cast the result to TYPE. If TYPE is NULL, the
264 natural type is used. */
267 gfc_build_addr_expr (tree type
, tree t
)
269 tree base_type
= TREE_TYPE (t
);
272 if (type
&& POINTER_TYPE_P (type
)
273 && TREE_CODE (base_type
) == ARRAY_TYPE
274 && TYPE_MAIN_VARIANT (TREE_TYPE (type
))
275 == TYPE_MAIN_VARIANT (TREE_TYPE (base_type
)))
277 tree min_val
= size_zero_node
;
278 tree type_domain
= TYPE_DOMAIN (base_type
);
279 if (type_domain
&& TYPE_MIN_VALUE (type_domain
))
280 min_val
= TYPE_MIN_VALUE (type_domain
);
281 t
= fold (build4_loc (input_location
, ARRAY_REF
, TREE_TYPE (type
),
282 t
, min_val
, NULL_TREE
, NULL_TREE
));
286 natural_type
= build_pointer_type (base_type
);
288 if (TREE_CODE (t
) == INDIRECT_REF
)
292 t
= TREE_OPERAND (t
, 0);
293 natural_type
= TREE_TYPE (t
);
297 tree base
= get_base_address (t
);
298 if (base
&& DECL_P (base
))
299 TREE_ADDRESSABLE (base
) = 1;
300 t
= fold_build1_loc (input_location
, ADDR_EXPR
, natural_type
, t
);
303 if (type
&& natural_type
!= type
)
304 t
= convert (type
, t
);
310 /* Build an ARRAY_REF with its natural type. */
313 gfc_build_array_ref (tree base
, tree offset
, tree decl
)
315 tree type
= TREE_TYPE (base
);
319 if (GFC_ARRAY_TYPE_P (type
) && GFC_TYPE_ARRAY_RANK (type
) == 0)
321 gcc_assert (GFC_TYPE_ARRAY_CORANK (type
) > 0);
323 return fold_convert (TYPE_MAIN_VARIANT (type
), base
);
326 /* Scalar coarray, there is nothing to do. */
327 if (TREE_CODE (type
) != ARRAY_TYPE
)
329 gcc_assert (decl
== NULL_TREE
);
330 gcc_assert (integer_zerop (offset
));
334 type
= TREE_TYPE (type
);
337 TREE_ADDRESSABLE (base
) = 1;
339 /* Strip NON_LVALUE_EXPR nodes. */
340 STRIP_TYPE_NOPS (offset
);
342 /* If the array reference is to a pointer, whose target contains a
343 subreference, use the span that is stored with the backend decl
344 and reference the element with pointer arithmetic. */
345 if (decl
&& (TREE_CODE (decl
) == FIELD_DECL
346 || TREE_CODE (decl
) == VAR_DECL
347 || TREE_CODE (decl
) == PARM_DECL
)
348 && ((GFC_DECL_SUBREF_ARRAY_P (decl
)
349 && !integer_zerop (GFC_DECL_SPAN(decl
)))
350 || GFC_DECL_CLASS (decl
)))
352 if (GFC_DECL_CLASS (decl
))
354 /* Allow for dummy arguments and other good things. */
355 if (POINTER_TYPE_P (TREE_TYPE (decl
)))
356 decl
= build_fold_indirect_ref_loc (input_location
, decl
);
358 /* Check if '_data' is an array descriptor. If it is not,
359 the array must be one of the components of the class object,
360 so return a normal array reference. */
361 if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_class_data_get (decl
))))
362 return build4_loc (input_location
, ARRAY_REF
, type
, base
,
363 offset
, NULL_TREE
, NULL_TREE
);
365 span
= gfc_vtable_size_get (decl
);
367 else if (GFC_DECL_SUBREF_ARRAY_P (decl
))
368 span
= GFC_DECL_SPAN(decl
);
372 offset
= fold_build2_loc (input_location
, MULT_EXPR
,
373 gfc_array_index_type
,
375 tmp
= gfc_build_addr_expr (pvoid_type_node
, base
);
376 tmp
= fold_build_pointer_plus_loc (input_location
, tmp
, offset
);
377 tmp
= fold_convert (build_pointer_type (type
), tmp
);
378 if (!TYPE_STRING_FLAG (type
))
379 tmp
= build_fold_indirect_ref_loc (input_location
, tmp
);
383 /* Otherwise use a straightforward array reference. */
384 return build4_loc (input_location
, ARRAY_REF
, type
, base
, offset
,
385 NULL_TREE
, NULL_TREE
);
389 /* Generate a call to print a runtime error possibly including multiple
390 arguments and a locus. */
393 trans_runtime_error_vararg (bool error
, locus
* where
, const char* msgid
,
406 /* Compute the number of extra arguments from the format string. */
407 for (p
= msgid
, nargs
= 0; *p
; p
++)
415 /* The code to generate the error. */
416 gfc_start_block (&block
);
420 line
= LOCATION_LINE (where
->lb
->location
);
421 asprintf (&message
, "At line %d of file %s", line
,
422 where
->lb
->file
->filename
);
425 asprintf (&message
, "In file '%s', around line %d",
426 gfc_source_file
, input_line
+ 1);
428 arg
= gfc_build_addr_expr (pchar_type_node
,
429 gfc_build_localized_cstring_const (message
));
432 asprintf (&message
, "%s", _(msgid
));
433 arg2
= gfc_build_addr_expr (pchar_type_node
,
434 gfc_build_localized_cstring_const (message
));
437 /* Build the argument array. */
438 argarray
= XALLOCAVEC (tree
, nargs
+ 2);
441 for (i
= 0; i
< nargs
; i
++)
442 argarray
[2 + i
] = va_arg (ap
, tree
);
444 /* Build the function call to runtime_(warning,error)_at; because of the
445 variable number of arguments, we can't use build_call_expr_loc dinput_location,
448 fntype
= TREE_TYPE (gfor_fndecl_runtime_error_at
);
450 fntype
= TREE_TYPE (gfor_fndecl_runtime_warning_at
);
452 loc
= where
? where
->lb
->location
: input_location
;
453 tmp
= fold_builtin_call_array (loc
, TREE_TYPE (fntype
),
454 fold_build1_loc (loc
, ADDR_EXPR
,
455 build_pointer_type (fntype
),
457 ? gfor_fndecl_runtime_error_at
458 : gfor_fndecl_runtime_warning_at
),
459 nargs
+ 2, argarray
);
460 gfc_add_expr_to_block (&block
, tmp
);
462 return gfc_finish_block (&block
);
467 gfc_trans_runtime_error (bool error
, locus
* where
, const char* msgid
, ...)
472 va_start (ap
, msgid
);
473 result
= trans_runtime_error_vararg (error
, where
, msgid
, ap
);
479 /* Generate a runtime error if COND is true. */
482 gfc_trans_runtime_check (bool error
, bool once
, tree cond
, stmtblock_t
* pblock
,
483 locus
* where
, const char * msgid
, ...)
491 if (integer_zerop (cond
))
496 tmpvar
= gfc_create_var (boolean_type_node
, "print_warning");
497 TREE_STATIC (tmpvar
) = 1;
498 DECL_INITIAL (tmpvar
) = boolean_true_node
;
499 gfc_add_expr_to_block (pblock
, tmpvar
);
502 gfc_start_block (&block
);
504 /* The code to generate the error. */
505 va_start (ap
, msgid
);
506 gfc_add_expr_to_block (&block
,
507 trans_runtime_error_vararg (error
, where
,
512 gfc_add_modify (&block
, tmpvar
, boolean_false_node
);
514 body
= gfc_finish_block (&block
);
516 if (integer_onep (cond
))
518 gfc_add_expr_to_block (pblock
, body
);
522 /* Tell the compiler that this isn't likely. */
524 cond
= fold_build2_loc (where
->lb
->location
, TRUTH_AND_EXPR
,
525 long_integer_type_node
, tmpvar
, cond
);
527 cond
= fold_convert (long_integer_type_node
, cond
);
529 cond
= gfc_unlikely (cond
);
530 tmp
= fold_build3_loc (where
->lb
->location
, COND_EXPR
, void_type_node
,
532 build_empty_stmt (where
->lb
->location
));
533 gfc_add_expr_to_block (pblock
, tmp
);
538 /* Call malloc to allocate size bytes of memory, with special conditions:
539 + if size == 0, return a malloced area of size 1,
540 + if malloc returns NULL, issue a runtime error. */
542 gfc_call_malloc (stmtblock_t
* block
, tree type
, tree size
)
544 tree tmp
, msg
, malloc_result
, null_result
, res
, malloc_tree
;
547 size
= gfc_evaluate_now (size
, block
);
549 if (TREE_TYPE (size
) != TREE_TYPE (size_type_node
))
550 size
= fold_convert (size_type_node
, size
);
552 /* Create a variable to hold the result. */
553 res
= gfc_create_var (prvoid_type_node
, NULL
);
556 gfc_start_block (&block2
);
558 size
= fold_build2_loc (input_location
, MAX_EXPR
, size_type_node
, size
,
559 build_int_cst (size_type_node
, 1));
561 malloc_tree
= builtin_decl_explicit (BUILT_IN_MALLOC
);
562 gfc_add_modify (&block2
, res
,
563 fold_convert (prvoid_type_node
,
564 build_call_expr_loc (input_location
,
565 malloc_tree
, 1, size
)));
567 /* Optionally check whether malloc was successful. */
568 if (gfc_option
.rtcheck
& GFC_RTCHECK_MEM
)
570 null_result
= fold_build2_loc (input_location
, EQ_EXPR
,
571 boolean_type_node
, res
,
572 build_int_cst (pvoid_type_node
, 0));
573 msg
= gfc_build_addr_expr (pchar_type_node
,
574 gfc_build_localized_cstring_const ("Memory allocation failed"));
575 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
,
577 build_call_expr_loc (input_location
,
578 gfor_fndecl_os_error
, 1, msg
),
579 build_empty_stmt (input_location
));
580 gfc_add_expr_to_block (&block2
, tmp
);
583 malloc_result
= gfc_finish_block (&block2
);
585 gfc_add_expr_to_block (block
, malloc_result
);
588 res
= fold_convert (type
, res
);
593 /* Allocate memory, using an optional status argument.
595 This function follows the following pseudo-code:
598 allocate (size_t size, integer_type stat)
605 newmem = malloc (MAX (size, 1));
609 *stat = LIBERROR_ALLOCATION;
611 runtime_error ("Allocation would exceed memory limit");
616 gfc_allocate_using_malloc (stmtblock_t
* block
, tree pointer
,
617 tree size
, tree status
)
619 tree tmp
, on_error
, error_cond
;
620 tree status_type
= status
? TREE_TYPE (status
) : NULL_TREE
;
622 /* Evaluate size only once, and make sure it has the right type. */
623 size
= gfc_evaluate_now (size
, block
);
624 if (TREE_TYPE (size
) != TREE_TYPE (size_type_node
))
625 size
= fold_convert (size_type_node
, size
);
627 /* If successful and stat= is given, set status to 0. */
628 if (status
!= NULL_TREE
)
629 gfc_add_expr_to_block (block
,
630 fold_build2_loc (input_location
, MODIFY_EXPR
, status_type
,
631 status
, build_int_cst (status_type
, 0)));
633 /* The allocation itself. */
634 gfc_add_modify (block
, pointer
,
635 fold_convert (TREE_TYPE (pointer
),
636 build_call_expr_loc (input_location
,
637 builtin_decl_explicit (BUILT_IN_MALLOC
), 1,
638 fold_build2_loc (input_location
,
639 MAX_EXPR
, size_type_node
, size
,
640 build_int_cst (size_type_node
, 1)))));
642 /* What to do in case of error. */
643 if (status
!= NULL_TREE
)
644 on_error
= fold_build2_loc (input_location
, MODIFY_EXPR
, status_type
,
645 status
, build_int_cst (status_type
, LIBERROR_ALLOCATION
));
647 on_error
= build_call_expr_loc (input_location
, gfor_fndecl_os_error
, 1,
648 gfc_build_addr_expr (pchar_type_node
,
649 gfc_build_localized_cstring_const
650 ("Allocation would exceed memory limit")));
652 error_cond
= fold_build2_loc (input_location
, EQ_EXPR
,
653 boolean_type_node
, pointer
,
654 build_int_cst (prvoid_type_node
, 0));
655 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
,
656 gfc_unlikely (error_cond
), on_error
,
657 build_empty_stmt (input_location
));
659 gfc_add_expr_to_block (block
, tmp
);
663 /* Allocate memory, using an optional status argument.
665 This function follows the following pseudo-code:
668 allocate (size_t size, void** token, int *stat, char* errmsg, int errlen)
672 newmem = _caf_register (size, regtype, token, &stat, errmsg, errlen);
676 gfc_allocate_using_lib (stmtblock_t
* block
, tree pointer
, tree size
,
677 tree token
, tree status
, tree errmsg
, tree errlen
)
681 gcc_assert (token
!= NULL_TREE
);
683 /* Evaluate size only once, and make sure it has the right type. */
684 size
= gfc_evaluate_now (size
, block
);
685 if (TREE_TYPE (size
) != TREE_TYPE (size_type_node
))
686 size
= fold_convert (size_type_node
, size
);
688 /* The allocation itself. */
689 if (status
== NULL_TREE
)
690 pstat
= null_pointer_node
;
692 pstat
= gfc_build_addr_expr (NULL_TREE
, status
);
694 if (errmsg
== NULL_TREE
)
696 gcc_assert(errlen
== NULL_TREE
);
697 errmsg
= null_pointer_node
;
698 errlen
= build_int_cst (integer_type_node
, 0);
701 tmp
= build_call_expr_loc (input_location
,
702 gfor_fndecl_caf_register
, 6,
703 fold_build2_loc (input_location
,
704 MAX_EXPR
, size_type_node
, size
,
705 build_int_cst (size_type_node
, 1)),
706 build_int_cst (integer_type_node
,
707 GFC_CAF_COARRAY_ALLOC
),
708 token
, pstat
, errmsg
, errlen
);
710 tmp
= fold_build2_loc (input_location
, MODIFY_EXPR
,
711 TREE_TYPE (pointer
), pointer
,
712 fold_convert ( TREE_TYPE (pointer
), tmp
));
713 gfc_add_expr_to_block (block
, tmp
);
717 /* Generate code for an ALLOCATE statement when the argument is an
718 allocatable variable. If the variable is currently allocated, it is an
719 error to allocate it again.
721 This function follows the following pseudo-code:
724 allocate_allocatable (void *mem, size_t size, integer_type stat)
727 return allocate (size, stat);
731 stat = LIBERROR_ALLOCATION;
733 runtime_error ("Attempting to allocate already allocated variable");
737 expr must be set to the original expression being allocated for its locus
738 and variable name in case a runtime error has to be printed. */
740 gfc_allocate_allocatable (stmtblock_t
* block
, tree mem
, tree size
, tree token
,
741 tree status
, tree errmsg
, tree errlen
, tree label_finish
,
744 stmtblock_t alloc_block
;
745 tree tmp
, null_mem
, alloc
, error
;
746 tree type
= TREE_TYPE (mem
);
748 if (TREE_TYPE (size
) != TREE_TYPE (size_type_node
))
749 size
= fold_convert (size_type_node
, size
);
751 null_mem
= gfc_unlikely (fold_build2_loc (input_location
, NE_EXPR
,
752 boolean_type_node
, mem
,
753 build_int_cst (type
, 0)));
755 /* If mem is NULL, we call gfc_allocate_using_malloc or
756 gfc_allocate_using_lib. */
757 gfc_start_block (&alloc_block
);
759 if (gfc_option
.coarray
== GFC_FCOARRAY_LIB
760 && gfc_expr_attr (expr
).codimension
)
764 gfc_allocate_using_lib (&alloc_block
, mem
, size
, token
, status
,
766 if (status
!= NULL_TREE
)
768 TREE_USED (label_finish
) = 1;
769 tmp
= build1_v (GOTO_EXPR
, label_finish
);
770 cond
= fold_build2_loc (input_location
, NE_EXPR
, boolean_type_node
,
771 status
, build_zero_cst (TREE_TYPE (status
)));
772 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
,
773 gfc_unlikely (cond
), tmp
,
774 build_empty_stmt (input_location
));
775 gfc_add_expr_to_block (&alloc_block
, tmp
);
779 gfc_allocate_using_malloc (&alloc_block
, mem
, size
, status
);
781 alloc
= gfc_finish_block (&alloc_block
);
783 /* If mem is not NULL, we issue a runtime error or set the
789 gcc_assert (expr
->expr_type
== EXPR_VARIABLE
&& expr
->symtree
);
790 varname
= gfc_build_cstring_const (expr
->symtree
->name
);
791 varname
= gfc_build_addr_expr (pchar_type_node
, varname
);
793 error
= gfc_trans_runtime_error (true, &expr
->where
,
794 "Attempting to allocate already"
795 " allocated variable '%s'",
799 error
= gfc_trans_runtime_error (true, NULL
,
800 "Attempting to allocate already allocated"
803 if (status
!= NULL_TREE
)
805 tree status_type
= TREE_TYPE (status
);
807 error
= fold_build2_loc (input_location
, MODIFY_EXPR
, status_type
,
808 status
, build_int_cst (status_type
, LIBERROR_ALLOCATION
));
811 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
, null_mem
,
813 gfc_add_expr_to_block (block
, tmp
);
817 /* Free a given variable, if it's not NULL. */
819 gfc_call_free (tree var
)
822 tree tmp
, cond
, call
;
824 if (TREE_TYPE (var
) != TREE_TYPE (pvoid_type_node
))
825 var
= fold_convert (pvoid_type_node
, var
);
827 gfc_start_block (&block
);
828 var
= gfc_evaluate_now (var
, &block
);
829 cond
= fold_build2_loc (input_location
, NE_EXPR
, boolean_type_node
, var
,
830 build_int_cst (pvoid_type_node
, 0));
831 call
= build_call_expr_loc (input_location
,
832 builtin_decl_explicit (BUILT_IN_FREE
),
834 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
, cond
, call
,
835 build_empty_stmt (input_location
));
836 gfc_add_expr_to_block (&block
, tmp
);
838 return gfc_finish_block (&block
);
843 /* User-deallocate; we emit the code directly from the front-end, and the
844 logic is the same as the previous library function:
847 deallocate (void *pointer, GFC_INTEGER_4 * stat)
854 runtime_error ("Attempt to DEALLOCATE unallocated memory.");
864 In this front-end version, status doesn't have to be GFC_INTEGER_4.
865 Moreover, if CAN_FAIL is true, then we will not emit a runtime error,
866 even when no status variable is passed to us (this is used for
867 unconditional deallocation generated by the front-end at end of
870 If a runtime-message is possible, `expr' must point to the original
871 expression being deallocated for its locus and variable name.
873 For coarrays, "pointer" must be the array descriptor and not its
876 gfc_deallocate_with_status (tree pointer
, tree status
, tree errmsg
,
877 tree errlen
, tree label_finish
,
878 bool can_fail
, gfc_expr
* expr
, bool coarray
)
880 stmtblock_t null
, non_null
;
881 tree cond
, tmp
, error
;
882 tree status_type
= NULL_TREE
;
883 tree caf_decl
= NULL_TREE
;
887 gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer
)));
889 pointer
= gfc_conv_descriptor_data_get (caf_decl
);
890 STRIP_NOPS (pointer
);
893 cond
= fold_build2_loc (input_location
, EQ_EXPR
, boolean_type_node
, pointer
,
894 build_int_cst (TREE_TYPE (pointer
), 0));
896 /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
897 we emit a runtime error. */
898 gfc_start_block (&null
);
903 gcc_assert (expr
&& expr
->expr_type
== EXPR_VARIABLE
&& expr
->symtree
);
905 varname
= gfc_build_cstring_const (expr
->symtree
->name
);
906 varname
= gfc_build_addr_expr (pchar_type_node
, varname
);
908 error
= gfc_trans_runtime_error (true, &expr
->where
,
909 "Attempt to DEALLOCATE unallocated '%s'",
913 error
= build_empty_stmt (input_location
);
915 if (status
!= NULL_TREE
&& !integer_zerop (status
))
919 status_type
= TREE_TYPE (TREE_TYPE (status
));
920 cond2
= fold_build2_loc (input_location
, NE_EXPR
, boolean_type_node
,
921 status
, build_int_cst (TREE_TYPE (status
), 0));
922 tmp
= fold_build2_loc (input_location
, MODIFY_EXPR
, status_type
,
923 fold_build1_loc (input_location
, INDIRECT_REF
,
924 status_type
, status
),
925 build_int_cst (status_type
, 1));
926 error
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
,
930 gfc_add_expr_to_block (&null
, error
);
932 /* When POINTER is not NULL, we free it. */
933 gfc_start_block (&non_null
);
934 if (!coarray
|| gfc_option
.coarray
!= GFC_FCOARRAY_LIB
)
936 tmp
= build_call_expr_loc (input_location
,
937 builtin_decl_explicit (BUILT_IN_FREE
), 1,
938 fold_convert (pvoid_type_node
, pointer
));
939 gfc_add_expr_to_block (&non_null
, tmp
);
941 if (status
!= NULL_TREE
&& !integer_zerop (status
))
943 /* We set STATUS to zero if it is present. */
944 tree status_type
= TREE_TYPE (TREE_TYPE (status
));
947 cond2
= fold_build2_loc (input_location
, NE_EXPR
, boolean_type_node
,
949 build_int_cst (TREE_TYPE (status
), 0));
950 tmp
= fold_build2_loc (input_location
, MODIFY_EXPR
, status_type
,
951 fold_build1_loc (input_location
, INDIRECT_REF
,
952 status_type
, status
),
953 build_int_cst (status_type
, 0));
954 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
,
955 gfc_unlikely (cond2
), tmp
,
956 build_empty_stmt (input_location
));
957 gfc_add_expr_to_block (&non_null
, tmp
);
962 tree caf_type
, token
, cond2
;
963 tree pstat
= null_pointer_node
;
965 if (errmsg
== NULL_TREE
)
967 gcc_assert (errlen
== NULL_TREE
);
968 errmsg
= null_pointer_node
;
969 errlen
= build_zero_cst (integer_type_node
);
973 gcc_assert (errlen
!= NULL_TREE
);
974 if (!POINTER_TYPE_P (TREE_TYPE (errmsg
)))
975 errmsg
= gfc_build_addr_expr (NULL_TREE
, errmsg
);
978 caf_type
= TREE_TYPE (caf_decl
);
980 if (status
!= NULL_TREE
&& !integer_zerop (status
))
982 gcc_assert (status_type
== integer_type_node
);
986 if (GFC_DESCRIPTOR_TYPE_P (caf_type
)
987 && GFC_TYPE_ARRAY_AKIND (caf_type
) == GFC_ARRAY_ALLOCATABLE
)
988 token
= gfc_conv_descriptor_token (caf_decl
);
989 else if (DECL_LANG_SPECIFIC (caf_decl
)
990 && GFC_DECL_TOKEN (caf_decl
) != NULL_TREE
)
991 token
= GFC_DECL_TOKEN (caf_decl
);
994 gcc_assert (GFC_ARRAY_TYPE_P (caf_type
)
995 && GFC_TYPE_ARRAY_CAF_TOKEN (caf_type
) != NULL_TREE
);
996 token
= GFC_TYPE_ARRAY_CAF_TOKEN (caf_type
);
999 token
= gfc_build_addr_expr (NULL_TREE
, token
);
1000 tmp
= build_call_expr_loc (input_location
,
1001 gfor_fndecl_caf_deregister
, 4,
1002 token
, pstat
, errmsg
, errlen
);
1003 gfc_add_expr_to_block (&non_null
, tmp
);
1005 if (status
!= NULL_TREE
)
1007 tree stat
= build_fold_indirect_ref_loc (input_location
, status
);
1009 TREE_USED (label_finish
) = 1;
1010 tmp
= build1_v (GOTO_EXPR
, label_finish
);
1011 cond2
= fold_build2_loc (input_location
, NE_EXPR
, boolean_type_node
,
1012 stat
, build_zero_cst (TREE_TYPE (stat
)));
1013 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
,
1014 gfc_unlikely (cond2
), tmp
,
1015 build_empty_stmt (input_location
));
1016 gfc_add_expr_to_block (&non_null
, tmp
);
1020 return fold_build3_loc (input_location
, COND_EXPR
, void_type_node
, cond
,
1021 gfc_finish_block (&null
),
1022 gfc_finish_block (&non_null
));
1026 /* Generate code for deallocation of allocatable scalars (variables or
1027 components). Before the object itself is freed, any allocatable
1028 subcomponents are being deallocated. */
1031 gfc_deallocate_scalar_with_status (tree pointer
, tree status
, bool can_fail
,
1032 gfc_expr
* expr
, gfc_typespec ts
)
1034 stmtblock_t null
, non_null
;
1035 tree cond
, tmp
, error
;
1037 cond
= fold_build2_loc (input_location
, EQ_EXPR
, boolean_type_node
, pointer
,
1038 build_int_cst (TREE_TYPE (pointer
), 0));
1040 /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
1041 we emit a runtime error. */
1042 gfc_start_block (&null
);
1047 gcc_assert (expr
&& expr
->expr_type
== EXPR_VARIABLE
&& expr
->symtree
);
1049 varname
= gfc_build_cstring_const (expr
->symtree
->name
);
1050 varname
= gfc_build_addr_expr (pchar_type_node
, varname
);
1052 error
= gfc_trans_runtime_error (true, &expr
->where
,
1053 "Attempt to DEALLOCATE unallocated '%s'",
1057 error
= build_empty_stmt (input_location
);
1059 if (status
!= NULL_TREE
&& !integer_zerop (status
))
1061 tree status_type
= TREE_TYPE (TREE_TYPE (status
));
1064 cond2
= fold_build2_loc (input_location
, NE_EXPR
, boolean_type_node
,
1065 status
, build_int_cst (TREE_TYPE (status
), 0));
1066 tmp
= fold_build2_loc (input_location
, MODIFY_EXPR
, status_type
,
1067 fold_build1_loc (input_location
, INDIRECT_REF
,
1068 status_type
, status
),
1069 build_int_cst (status_type
, 1));
1070 error
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
,
1074 gfc_add_expr_to_block (&null
, error
);
1076 /* When POINTER is not NULL, we free it. */
1077 gfc_start_block (&non_null
);
1079 /* Free allocatable components. */
1080 if (ts
.type
== BT_DERIVED
&& ts
.u
.derived
->attr
.alloc_comp
)
1082 tmp
= build_fold_indirect_ref_loc (input_location
, pointer
);
1083 tmp
= gfc_deallocate_alloc_comp (ts
.u
.derived
, tmp
, 0);
1084 gfc_add_expr_to_block (&non_null
, tmp
);
1086 else if (ts
.type
== BT_CLASS
1087 && ts
.u
.derived
->components
->ts
.u
.derived
->attr
.alloc_comp
)
1089 tmp
= build_fold_indirect_ref_loc (input_location
, pointer
);
1090 tmp
= gfc_deallocate_alloc_comp (ts
.u
.derived
->components
->ts
.u
.derived
,
1092 gfc_add_expr_to_block (&non_null
, tmp
);
1095 tmp
= build_call_expr_loc (input_location
,
1096 builtin_decl_explicit (BUILT_IN_FREE
), 1,
1097 fold_convert (pvoid_type_node
, pointer
));
1098 gfc_add_expr_to_block (&non_null
, tmp
);
1100 if (status
!= NULL_TREE
&& !integer_zerop (status
))
1102 /* We set STATUS to zero if it is present. */
1103 tree status_type
= TREE_TYPE (TREE_TYPE (status
));
1106 cond2
= fold_build2_loc (input_location
, NE_EXPR
, boolean_type_node
,
1107 status
, build_int_cst (TREE_TYPE (status
), 0));
1108 tmp
= fold_build2_loc (input_location
, MODIFY_EXPR
, status_type
,
1109 fold_build1_loc (input_location
, INDIRECT_REF
,
1110 status_type
, status
),
1111 build_int_cst (status_type
, 0));
1112 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
, cond2
,
1113 tmp
, build_empty_stmt (input_location
));
1114 gfc_add_expr_to_block (&non_null
, tmp
);
1117 return fold_build3_loc (input_location
, COND_EXPR
, void_type_node
, cond
,
1118 gfc_finish_block (&null
),
1119 gfc_finish_block (&non_null
));
1123 /* Reallocate MEM so it has SIZE bytes of data. This behaves like the
1124 following pseudo-code:
1127 internal_realloc (void *mem, size_t size)
1129 res = realloc (mem, size);
1130 if (!res && size != 0)
1131 _gfortran_os_error ("Allocation would exceed memory limit");
1136 gfc_call_realloc (stmtblock_t
* block
, tree mem
, tree size
)
1138 tree msg
, res
, nonzero
, null_result
, tmp
;
1139 tree type
= TREE_TYPE (mem
);
1141 size
= gfc_evaluate_now (size
, block
);
1143 if (TREE_TYPE (size
) != TREE_TYPE (size_type_node
))
1144 size
= fold_convert (size_type_node
, size
);
1146 /* Create a variable to hold the result. */
1147 res
= gfc_create_var (type
, NULL
);
1149 /* Call realloc and check the result. */
1150 tmp
= build_call_expr_loc (input_location
,
1151 builtin_decl_explicit (BUILT_IN_REALLOC
), 2,
1152 fold_convert (pvoid_type_node
, mem
), size
);
1153 gfc_add_modify (block
, res
, fold_convert (type
, tmp
));
1154 null_result
= fold_build2_loc (input_location
, EQ_EXPR
, boolean_type_node
,
1155 res
, build_int_cst (pvoid_type_node
, 0));
1156 nonzero
= fold_build2_loc (input_location
, NE_EXPR
, boolean_type_node
, size
,
1157 build_int_cst (size_type_node
, 0));
1158 null_result
= fold_build2_loc (input_location
, TRUTH_AND_EXPR
, boolean_type_node
,
1159 null_result
, nonzero
);
1160 msg
= gfc_build_addr_expr (pchar_type_node
, gfc_build_localized_cstring_const
1161 ("Allocation would exceed memory limit"));
1162 tmp
= fold_build3_loc (input_location
, COND_EXPR
, void_type_node
,
1164 build_call_expr_loc (input_location
,
1165 gfor_fndecl_os_error
, 1, msg
),
1166 build_empty_stmt (input_location
));
1167 gfc_add_expr_to_block (block
, tmp
);
1173 /* Add an expression to another one, either at the front or the back. */
1176 add_expr_to_chain (tree
* chain
, tree expr
, bool front
)
1178 if (expr
== NULL_TREE
|| IS_EMPTY_STMT (expr
))
1183 if (TREE_CODE (*chain
) != STATEMENT_LIST
)
1189 append_to_statement_list (tmp
, chain
);
1194 tree_stmt_iterator i
;
1196 i
= tsi_start (*chain
);
1197 tsi_link_before (&i
, expr
, TSI_CONTINUE_LINKING
);
1200 append_to_statement_list (expr
, chain
);
1207 /* Add a statement at the end of a block. */
1210 gfc_add_expr_to_block (stmtblock_t
* block
, tree expr
)
1213 add_expr_to_chain (&block
->head
, expr
, false);
1217 /* Add a statement at the beginning of a block. */
1220 gfc_prepend_expr_to_block (stmtblock_t
* block
, tree expr
)
1223 add_expr_to_chain (&block
->head
, expr
, true);
1227 /* Add a block the end of a block. */
1230 gfc_add_block_to_block (stmtblock_t
* block
, stmtblock_t
* append
)
1232 gcc_assert (append
);
1233 gcc_assert (!append
->has_scope
);
1235 gfc_add_expr_to_block (block
, append
->head
);
1236 append
->head
= NULL_TREE
;
1240 /* Save the current locus. The structure may not be complete, and should
1241 only be used with gfc_restore_backend_locus. */
1244 gfc_save_backend_locus (locus
* loc
)
1246 loc
->lb
= XCNEW (gfc_linebuf
);
1247 loc
->lb
->location
= input_location
;
1248 loc
->lb
->file
= gfc_current_backend_file
;
1252 /* Set the current locus. */
1255 gfc_set_backend_locus (locus
* loc
)
1257 gfc_current_backend_file
= loc
->lb
->file
;
1258 input_location
= loc
->lb
->location
;
1262 /* Restore the saved locus. Only used in conjonction with
1263 gfc_save_backend_locus, to free the memory when we are done. */
1266 gfc_restore_backend_locus (locus
* loc
)
1268 gfc_set_backend_locus (loc
);
1273 /* Translate an executable statement. The tree cond is used by gfc_trans_do.
1274 This static function is wrapped by gfc_trans_code_cond and
1278 trans_code (gfc_code
* code
, tree cond
)
1284 return build_empty_stmt (input_location
);
1286 gfc_start_block (&block
);
1288 /* Translate statements one by one into GENERIC trees until we reach
1289 the end of this gfc_code branch. */
1290 for (; code
; code
= code
->next
)
1292 if (code
->here
!= 0)
1294 res
= gfc_trans_label_here (code
);
1295 gfc_add_expr_to_block (&block
, res
);
1298 gfc_set_backend_locus (&code
->loc
);
1303 case EXEC_END_BLOCK
:
1304 case EXEC_END_NESTED_BLOCK
:
1305 case EXEC_END_PROCEDURE
:
1310 if (code
->expr1
->ts
.type
== BT_CLASS
)
1311 res
= gfc_trans_class_assign (code
->expr1
, code
->expr2
, code
->op
);
1313 res
= gfc_trans_assign (code
);
1316 case EXEC_LABEL_ASSIGN
:
1317 res
= gfc_trans_label_assign (code
);
1320 case EXEC_POINTER_ASSIGN
:
1321 if (code
->expr1
->ts
.type
== BT_CLASS
)
1322 res
= gfc_trans_class_assign (code
->expr1
, code
->expr2
, code
->op
);
1324 res
= gfc_trans_pointer_assign (code
);
1327 case EXEC_INIT_ASSIGN
:
1328 if (code
->expr1
->ts
.type
== BT_CLASS
)
1329 res
= gfc_trans_class_init_assign (code
);
1331 res
= gfc_trans_init_assign (code
);
1339 res
= gfc_trans_critical (code
);
1343 res
= gfc_trans_cycle (code
);
1347 res
= gfc_trans_exit (code
);
1351 res
= gfc_trans_goto (code
);
1355 res
= gfc_trans_entry (code
);
1359 res
= gfc_trans_pause (code
);
1363 case EXEC_ERROR_STOP
:
1364 res
= gfc_trans_stop (code
, code
->op
== EXEC_ERROR_STOP
);
1368 /* For MVBITS we've got the special exception that we need a
1369 dependency check, too. */
1371 bool is_mvbits
= false;
1373 if (code
->resolved_isym
)
1375 res
= gfc_conv_intrinsic_subroutine (code
);
1376 if (res
!= NULL_TREE
)
1380 if (code
->resolved_isym
1381 && code
->resolved_isym
->id
== GFC_ISYM_MVBITS
)
1384 res
= gfc_trans_call (code
, is_mvbits
, NULL_TREE
,
1390 res
= gfc_trans_call (code
, false, NULL_TREE
,
1394 case EXEC_ASSIGN_CALL
:
1395 res
= gfc_trans_call (code
, true, NULL_TREE
,
1400 res
= gfc_trans_return (code
);
1404 res
= gfc_trans_if (code
);
1407 case EXEC_ARITHMETIC_IF
:
1408 res
= gfc_trans_arithmetic_if (code
);
1412 res
= gfc_trans_block_construct (code
);
1416 res
= gfc_trans_do (code
, cond
);
1419 case EXEC_DO_CONCURRENT
:
1420 res
= gfc_trans_do_concurrent (code
);
1424 res
= gfc_trans_do_while (code
);
1428 res
= gfc_trans_select (code
);
1431 case EXEC_SELECT_TYPE
:
1432 /* Do nothing. SELECT TYPE statements should be transformed into
1433 an ordinary SELECT CASE at resolution stage.
1434 TODO: Add an error message here once this is done. */
1439 res
= gfc_trans_flush (code
);
1443 case EXEC_SYNC_IMAGES
:
1444 case EXEC_SYNC_MEMORY
:
1445 res
= gfc_trans_sync (code
, code
->op
);
1450 res
= gfc_trans_lock_unlock (code
, code
->op
);
1454 res
= gfc_trans_forall (code
);
1458 res
= gfc_trans_where (code
);
1462 res
= gfc_trans_allocate (code
);
1465 case EXEC_DEALLOCATE
:
1466 res
= gfc_trans_deallocate (code
);
1470 res
= gfc_trans_open (code
);
1474 res
= gfc_trans_close (code
);
1478 res
= gfc_trans_read (code
);
1482 res
= gfc_trans_write (code
);
1486 res
= gfc_trans_iolength (code
);
1489 case EXEC_BACKSPACE
:
1490 res
= gfc_trans_backspace (code
);
1494 res
= gfc_trans_endfile (code
);
1498 res
= gfc_trans_inquire (code
);
1502 res
= gfc_trans_wait (code
);
1506 res
= gfc_trans_rewind (code
);
1510 res
= gfc_trans_transfer (code
);
1514 res
= gfc_trans_dt_end (code
);
1517 case EXEC_OMP_ATOMIC
:
1518 case EXEC_OMP_BARRIER
:
1519 case EXEC_OMP_CRITICAL
:
1521 case EXEC_OMP_FLUSH
:
1522 case EXEC_OMP_MASTER
:
1523 case EXEC_OMP_ORDERED
:
1524 case EXEC_OMP_PARALLEL
:
1525 case EXEC_OMP_PARALLEL_DO
:
1526 case EXEC_OMP_PARALLEL_SECTIONS
:
1527 case EXEC_OMP_PARALLEL_WORKSHARE
:
1528 case EXEC_OMP_SECTIONS
:
1529 case EXEC_OMP_SINGLE
:
1531 case EXEC_OMP_TASKWAIT
:
1532 case EXEC_OMP_TASKYIELD
:
1533 case EXEC_OMP_WORKSHARE
:
1534 res
= gfc_trans_omp_directive (code
);
1538 internal_error ("gfc_trans_code(): Bad statement code");
1541 gfc_set_backend_locus (&code
->loc
);
1543 if (res
!= NULL_TREE
&& ! IS_EMPTY_STMT (res
))
1545 if (TREE_CODE (res
) != STATEMENT_LIST
)
1546 SET_EXPR_LOCATION (res
, input_location
);
1548 /* Add the new statement to the block. */
1549 gfc_add_expr_to_block (&block
, res
);
1553 /* Return the finished block. */
1554 return gfc_finish_block (&block
);
1558 /* Translate an executable statement with condition, cond. The condition is
1559 used by gfc_trans_do to test for IO result conditions inside implied
1560 DO loops of READ and WRITE statements. See build_dt in trans-io.c. */
1563 gfc_trans_code_cond (gfc_code
* code
, tree cond
)
1565 return trans_code (code
, cond
);
1568 /* Translate an executable statement without condition. */
1571 gfc_trans_code (gfc_code
* code
)
1573 return trans_code (code
, NULL_TREE
);
1577 /* This function is called after a complete program unit has been parsed
1581 gfc_generate_code (gfc_namespace
* ns
)
1584 if (ns
->is_block_data
)
1586 gfc_generate_block_data (ns
);
1590 gfc_generate_function_code (ns
);
1594 /* This function is called after a complete module has been parsed
1598 gfc_generate_module_code (gfc_namespace
* ns
)
1601 struct module_htab_entry
*entry
;
1603 gcc_assert (ns
->proc_name
->backend_decl
== NULL
);
1604 ns
->proc_name
->backend_decl
1605 = build_decl (ns
->proc_name
->declared_at
.lb
->location
,
1606 NAMESPACE_DECL
, get_identifier (ns
->proc_name
->name
),
1608 entry
= gfc_find_module (ns
->proc_name
->name
);
1609 if (entry
->namespace_decl
)
1610 /* Buggy sourcecode, using a module before defining it? */
1611 htab_empty (entry
->decls
);
1612 entry
->namespace_decl
= ns
->proc_name
->backend_decl
;
1614 gfc_generate_module_vars (ns
);
1616 /* We need to generate all module function prototypes first, to allow
1618 for (n
= ns
->contained
; n
; n
= n
->sibling
)
1625 gfc_create_function_decl (n
, false);
1626 DECL_CONTEXT (n
->proc_name
->backend_decl
) = ns
->proc_name
->backend_decl
;
1627 gfc_module_add_decl (entry
, n
->proc_name
->backend_decl
);
1628 for (el
= ns
->entries
; el
; el
= el
->next
)
1630 DECL_CONTEXT (el
->sym
->backend_decl
) = ns
->proc_name
->backend_decl
;
1631 gfc_module_add_decl (entry
, el
->sym
->backend_decl
);
1635 for (n
= ns
->contained
; n
; n
= n
->sibling
)
1640 gfc_generate_function_code (n
);
1645 /* Initialize an init/cleanup block with existing code. */
1648 gfc_start_wrapped_block (gfc_wrapped_block
* block
, tree code
)
1652 block
->init
= NULL_TREE
;
1654 block
->cleanup
= NULL_TREE
;
1658 /* Add a new pair of initializers/clean-up code. */
1661 gfc_add_init_cleanup (gfc_wrapped_block
* block
, tree init
, tree cleanup
)
1665 /* The new pair of init/cleanup should be "wrapped around" the existing
1666 block of code, thus the initialization is added to the front and the
1667 cleanup to the back. */
1668 add_expr_to_chain (&block
->init
, init
, true);
1669 add_expr_to_chain (&block
->cleanup
, cleanup
, false);
1673 /* Finish up a wrapped block by building a corresponding try-finally expr. */
1676 gfc_finish_wrapped_block (gfc_wrapped_block
* block
)
1682 /* Build the final expression. For this, just add init and body together,
1683 and put clean-up with that into a TRY_FINALLY_EXPR. */
1684 result
= block
->init
;
1685 add_expr_to_chain (&result
, block
->code
, false);
1687 result
= build2_loc (input_location
, TRY_FINALLY_EXPR
, void_type_node
,
1688 result
, block
->cleanup
);
1690 /* Clear the block. */
1691 block
->init
= NULL_TREE
;
1692 block
->code
= NULL_TREE
;
1693 block
->cleanup
= NULL_TREE
;
1699 /* Helper function for marking a boolean expression tree as unlikely. */
1702 gfc_unlikely (tree cond
)
1706 cond
= fold_convert (long_integer_type_node
, cond
);
1707 tmp
= build_zero_cst (long_integer_type_node
);
1708 cond
= build_call_expr_loc (input_location
,
1709 builtin_decl_explicit (BUILT_IN_EXPECT
),
1711 cond
= fold_convert (boolean_type_node
, cond
);
1716 /* Helper function for marking a boolean expression tree as likely. */
1719 gfc_likely (tree cond
)
1723 cond
= fold_convert (long_integer_type_node
, cond
);
1724 tmp
= build_one_cst (long_integer_type_node
);
1725 cond
= build_call_expr_loc (input_location
,
1726 builtin_decl_explicit (BUILT_IN_EXPECT
),
1728 cond
= fold_convert (boolean_type_node
, cond
);