Skip to content

Commit d2d64f0

Browse files
committed
Implement the Fortran 2008 BLOCK construct
This change is a nearly complete implementation of the F08 BLOCK construct. The exception to full standard compliance is that the special handling of ASYNCHRONOUS and VOLATILE statements in Clause 8.1.4p2 is not implemented. The expectation is that this minor functionality would be relatively difficult to reliably implement. This CL also disallows blocks in OpenMP parallel constructs. OpenMP 5.0 Section 1.7 states that use of the BLOCK construct is not explicitly addressed, and such use "may result in unspecified behavior." However, to the extent that BLOCK is similar to C name scopes, it should be possible to use BLOCKs in parallel code. These limitations might be addressed with future changes. In this CL, use of these features will generate error messages. Relative to Fortran 2008, the Fortran 2018 standard has a few changes that are not implemented, such as allowing IMPORT statements in a block. The block construct allows variables and other entities to be declared with a restricted scope. A declaration in a block can hide same-named entities in an ancestor subprogram or block scope, and can in turn be hidden by declarations in a nested block. The handling of declarations in a block differs from declarations in module and subprogram scopes in that implicit declarations in a block have subprogram scope, not block scope (Note 5.39). This is one of several reasons why existing symbol management routines are not easily extendable to fully process declarations in a block. In contexts where block locality must be taken into account, this functionality is instead provided by a new routine - block_local_sym. These calls are distributed throughout the parsing/semantic processing phase. Code downstream from parsing must insert code at the entry to the block to allocate memory, initialize derived type values, and do array bounds checking as necessary. At block exit, code must be inserted to finalize derived type objects, and deallocate memory. Routine-level instances of these code insertions are distributed across three phases. Most are done either in the bblock or convert-output phases. The code that does these insertions is somewhat decentralized, with different techniques used for different cases, both within and across phases, with some dependencies between phases. This code has been modified to make it somewhat more uniform where possible, and to apply it to block level insertions. Additional insertions for array bounds checking are done in the output/lowering phase. The code for these insertions is mostly independent of block context, but a few changes are required there as well. In part to allow for code insertions, the form of code for a block is: continue -- first block std (labeled) block prolog -- allocate/init/array_check code comment (continue) -- prolog end == body begin boundary marker block body -- user code block epilog -- finalize/deallocate code continue -- last block std (labeled) For any sptr local to a block, the block entry, end-of-prolog, and exit stds that are needed for inserting prolog and epilog code are accessible via macros: - BLOCK_ENTRY_STD(sptr) - BLOCK_ENDPROLOG_STD(sptr) - BLOCK_EXIT_STD(sptr) Code can be inserted at the top of the prolog via BLOCK_ENTRY_STD, and at the end of the prolog via BLOCK_ENDPROLOG_STD. Epilog code can be inserted at the end of the epilog via BLOCK_EXIT_STD. There is no known need to insert code at the top of the epilog, so there is no marker std between body and epilog code. The comm-optimize compilation phase analyzes forall loops to determine if they can be fused. Fusion of two otherwise compatible loops in different blocks can be invalid if either loop declares a variable that has associated block entry/exit code insertions. Incorrect fusion is conservatively avoided by disallowing any fusion across block boundaries. More detailed analysis and/or a more sophisticated fusion implementation could allow this fusion in some cases. There is some degree of code cleanup in various files, notably scan.c, dpm_out.c, scopestack.c, and semant.h. For scan.c, some of the changes were made in support of functionality that was later found to be unneeded and removed, but the cleanup changes were retained. All -g block compilations fail with linker errors about undefined block entry/exit label references. This is because these labels currently don't survive through to the back end. This was done because at -O2 and higher, unrolling + constant propagation + dead code elimination can potentially generate a control flow graph with an unreachable basic block that setup for vectorization can't handle. In the long run, these labels need to be retained for parallel code, so we need to look for a permanent fix for this issue. However, parallelelization of code containing a block is currently prohibited. Debugging only needs these labels below -O2 (at the cost of degraded optimized code debugging), and the "vectorization" problem only occurs at -O2 and above. So for now, a simple fix is to only retain these labels below -O2. This is done by marking them as volatile in semant.c. F08 constraint C807 is "A SAVE statement in a BLOCK construct shall contain a saved-entity-list that does not specify a common-block-name." It is somewhat reasonable to interpret this as saying (in part) that "A SAVE statement in a BLOCK construct shall contain a saved-entity-list." However, other compilers allow such SAVE statements; there doesn't seem to be any good language justification for disallowing them; and the standard seems to also suggest this elsewhere, such as in Note 8.5. So we modify the compiler to allow these SAVE statements. This is done by marking the ST_BLOCK symbol of a block scope with SAVE, and checking for this flag when necessary by calling new utility function in_save_scope. Variables such as arrays, pointers, and allocatables may have associated compiler-created syms such as descriptors and pointers. Secondary syms associated with a primary sym declared in a block should probably have block locality. Changes are made to do this somewhat more consistently. (More such changes may eventually be needed.)
1 parent 249b986 commit d2d64f0

File tree

32 files changed

+1400
-1137
lines changed

32 files changed

+1400
-1137
lines changed

include/flang/Error/errmsg-in.n

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -397,7 +397,7 @@ left (e.g. '1234567890abcdef1'x will be '234567890abcdef1'x).
397397
.MS S 116 "Illegal use of pointer-based variable $ $"
398398
.MS S 117 "Statement not allowed within a $ definition"
399399
The statement may not appear in a STRUCTURE or derived type definition.
400-
.MS S 118 "Statement not allowed in DO, IF, or WHERE block"
400+
.MS S 118 "Statement not allowed in BLOCK, DO, IF, WHERE, or other executable construct"
401401
.MS I 119 "Redundant specification for $"
402402
Data type of indicated symbol specified more than once.
403403
.MS I 120 "Label $ is defined but never referenced"
@@ -1531,3 +1531,5 @@ Starting from 1100, Reserved for OpenMP GPU
15311531
.MS S 1215 "OpenACC data clause expected after $."
15321532
.MS S 1216 "Expression in assignment statement contains type bound procedure name $. This may be a function call that's missing parentheses."
15331533
.MS S 1217 "Left hand side of polymorphic assignment must be allocatable - $"
1534+
.MS S 1218 "$ statement may not appear in a BLOCK construct."
1535+
.MS S 1219 "Unimplemented feature: $."

test/f90_correct/src/oop773.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,15 +29,15 @@ subroutine foo()
2929
subroutine bar(this)
3030
class(obj) :: this
3131

32-
!block
32+
block
3333
type t
3434
contains
3535
procedure, nopass :: foo
3636
end type
3737
type(t) :: o
3838

3939
call o%foo()
40-
!end block
40+
end block
4141
end subroutine
4242

4343
end module

test/f90_correct/src/oop774.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ subroutine foo2(i)
3131

3232
subroutine bar()
3333
use mod
34-
!block
34+
block
3535
type t
3636
contains
3737
procedure, nopass :: foo
@@ -41,7 +41,7 @@ subroutine bar()
4141
type(t) :: o
4242

4343
call o%func(-99)
44-
!end block
44+
end block
4545
end subroutine
4646

4747
use mod

test/f90_correct/src/oop775.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ subroutine foo2(i)
3333

3434
subroutine bar(this)
3535
class(obj) :: this
36-
!block
36+
block
3737
type t
3838
contains
3939
procedure, nopass :: foo
@@ -43,7 +43,7 @@ subroutine bar(this)
4343
type(t) :: o
4444

4545
call o%func(-99)
46-
!end block
46+
end block
4747
end subroutine
4848

4949
end module

tools/flang1/flang1exe/astout.c

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2322,6 +2322,7 @@ print_ast(int ast)
23222322
print_ast(A_ENDLABG(ast));
23232323
}
23242324
A_TYPEP(ast, A_DO);
2325+
put_string(" ");
23252326
print_ast(ast);
23262327
A_TYPEP(ast, A_MP_PDO);
23272328
break;

tools/flang1/flang1exe/bblock.c

Lines changed: 77 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
/*
2-
* Copyright (c) 1994-2018, NVIDIA CORPORATION. All rights reserved.
2+
* Copyright (c) 1994-2019, NVIDIA CORPORATION. All rights reserved.
33
*
44
* Licensed under the Apache License, Version 2.0 (the "License");
55
* you may not use this file except in compliance with the License.
@@ -35,7 +35,6 @@
3535
#include "pd.h"
3636
#include "rtlRtns.h"
3737

38-
static int exit_point;
3938
static int entry_point;
4039
static int par; /* in OpenMp parallel region */
4140
static int cs; /* in OpenMp critical section */
@@ -88,6 +87,7 @@ bblock()
8887
INT ent_cnt;
8988
int ent_select_id;
9089
int has_kernel = 0;
90+
ITEM *itemp;
9191

9292
if (STD_NEXT(0) == STD_PREV(0)) { /* end only ? */
9393
/* add something for entry -- lfm */
@@ -102,7 +102,7 @@ bblock()
102102

103103
sem.temps_reset = TRUE;
104104
entry_point = 0;
105-
last_std = STD_PREV(0);
105+
last_std = STD_LAST;
106106

107107
if (gbl.arets) {
108108
/* for alternate returns, will use a compiler-created local symbol
@@ -369,35 +369,35 @@ bblock()
369369
ENTSTDP(ent, entry_point);
370370
}
371371

372-
/*
373-
* gen_auto_dealloc();
374-
*/
375-
{
376-
ITEM *itemp;
372+
if (sem.type_initialize) {
377373
int std2;
378-
for (itemp = sem.auto_dealloc; itemp; itemp = itemp->next) {
379-
gen_conditional_dealloc_for_sym(itemp->t.sptr, gbl.exitstd);
374+
for (std2 = ENTSTDG(gbl.currsub); STD_LINENO(std2) == 0;
375+
std2 = STD_NEXT(std2))
376+
;
377+
std2 = STD_PREV(std2);
378+
for (itemp = sem.type_initialize; itemp; itemp = itemp->next) {
379+
int stdx = CONSTRUCTSYMG(itemp->t.sptr) ?
380+
BLOCK_ENTRY_STD(itemp->t.sptr) : std2;
381+
gen_type_initialize_for_sym(itemp->t.sptr, stdx, 0, 0);
380382
}
383+
}
381384

382-
std2 = gbl.exitstd;
383-
for (itemp = sem.auto_finalize; itemp; itemp = itemp->next) {
384-
std2 = gen_finalization_for_sym(itemp->t.sptr, gbl.exitstd, 0);
385-
}
386-
gbl.exitstd = std2;
387-
388-
if (sem.type_initialize) {
389-
int std;
390-
for (std = ENTSTDG(gbl.currsub); STD_LINENO(std) == 0;
391-
std = STD_NEXT(std))
392-
;
393-
std = STD_PREV(std);
394-
for (itemp = sem.type_initialize; itemp; itemp = itemp->next) {
395-
gen_type_initialize_for_sym(itemp->t.sptr, std, 0, 0);
396-
}
397-
}
398-
for (itemp = sem.alloc_mem_initialize; itemp; itemp = itemp->next) {
399-
gen_alloc_mem_initialize_for_sym(itemp->t.sptr, ENTSTDG(gbl.currsub));
400-
}
385+
for (itemp = sem.alloc_mem_initialize; itemp; itemp = itemp->next) {
386+
int stdx = CONSTRUCTSYMG(itemp->t.sptr) ?
387+
BLOCK_ENTRY_STD(itemp->t.sptr) : ENTSTDG(gbl.currsub);
388+
gen_alloc_mem_initialize_for_sym(itemp->t.sptr, stdx);
389+
}
390+
391+
for (itemp = sem.auto_dealloc; itemp; itemp = itemp->next) {
392+
int stdx = CONSTRUCTSYMG(itemp->t.sptr) ?
393+
STD_PREV(BLOCK_EXIT_STD(itemp->t.sptr)) : gbl.exitstd;
394+
gen_conditional_dealloc_for_sym(itemp->t.sptr, stdx);
395+
}
396+
397+
for (itemp = sem.auto_finalize; itemp; itemp = itemp->next) {
398+
int stdx = CONSTRUCTSYMG(itemp->t.sptr) ?
399+
STD_PREV(BLOCK_EXIT_STD(itemp->t.sptr)) : gbl.exitstd;
400+
gen_finalization_for_sym(itemp->t.sptr, stdx, 0);
401401
}
402402

403403
#if DEBUG
@@ -676,41 +676,41 @@ gen_early_bnd_dependencies(int ast)
676676
if (!ast)
677677
return;
678678

679-
std = ENTSTDG(
680-
gbl.currsub); /* insert dependencies before dependent bnds exprs */
681679
switch (A_TYPEG(ast)) {
682680
case A_ID:
683681
sptr = A_SPTRG(ast);
684-
if (STYPEG(sptr) == ST_ARRAY && ADJARRG(sptr) && !ERLYSPECG(sptr)) {
682+
/* insert dependencies before dependent bnds exprs */
683+
std = CONSTRUCTSYMG(sptr) ? BLOCK_ENTRY_STD(sptr) : ENTSTDG(gbl.currsub);
684+
if (STYPEG(sptr) == ST_ARRAY && ADJARRG(sptr) && !EARLYSPECG(sptr)) {
685685
ad = AD_DPTR(DTYPEG(sptr));
686686
ndims = AD_NUMDIM(ad);
687687
for (i = 0; i < ndims; i++) {
688688
if (A_TYPEG(AD_LWAST(ad, i)) != A_CNST) {
689689
bndsptr = A_SPTRG(AD_LWAST(ad, i));
690-
if (!ERLYSPECG(bndsptr)) {
690+
if (!EARLYSPECG(bndsptr)) {
691691
std = add_stmt_after(
692692
mk_assn_stmt(AD_LWAST(ad, i), AD_LWBD(ad, i), astb.bnd.dtype),
693693
std);
694-
ERLYSPECP(bndsptr, 1);
694+
EARLYSPECP(bndsptr, 1);
695695
gen_early_bnd_dependencies(AD_LWBD(ad, i));
696696
}
697697
early_spec_gend = TRUE;
698698
}
699699
if (A_TYPEG(AD_UPAST(ad, i)) != A_CNST) {
700700
bndsptr = A_SPTRG(AD_UPAST(ad, i));
701-
if (!ERLYSPECG(bndsptr)) {
701+
if (!EARLYSPECG(bndsptr)) {
702702
std = add_stmt_after(
703703
mk_assn_stmt(AD_UPAST(ad, i), AD_UPBD(ad, i), astb.bnd.dtype),
704704
std);
705-
ERLYSPECP(bndsptr, 1);
705+
EARLYSPECP(bndsptr, 1);
706706
gen_early_bnd_dependencies(AD_UPBD(ad, i));
707707
}
708708
early_spec_gend = TRUE;
709709
}
710710
}
711711
}
712712
if (ADJLENG(sptr)) {
713-
if (!ERLYSPECG(sptr)) {
713+
if (!EARLYSPECG(sptr)) {
714714
int rhs, cvlen;
715715
dtype = DDTG(DTYPEG(sptr));
716716
if (!CVLENG(sptr)) {
@@ -723,12 +723,12 @@ gen_early_bnd_dependencies(int ast)
723723
std = add_stmt_after(
724724
mk_assn_stmt(mk_id(CVLENG(sptr)), rhs, DTYPEG(cvlen)), std);
725725
add_to_early_bnd_list(rhs);
726-
ERLYSPECP(CVLENG(sptr), 1);
726+
EARLYSPECP(CVLENG(sptr), 1);
727727
}
728728
early_spec_gend = TRUE;
729729
}
730730
if (early_spec_gend) {
731-
ERLYSPECP(sptr, 1);
731+
EARLYSPECP(sptr, 1);
732732
}
733733
break;
734734
case A_FUNC:
@@ -754,7 +754,7 @@ gen_early_bnd_dependencies(int ast)
754754
static void
755755
gen_early_str_len()
756756
{
757-
int sptr;
757+
SPTR sptr;
758758
int ast;
759759
int std;
760760
int dtype;
@@ -778,11 +778,16 @@ gen_early_str_len()
778778
rhs = DTY(dtype + 1);
779779
rhs = mk_convert(rhs, DTYPEG(cvlen));
780780
rhs = ast_intr(I_MAX, DTYPEG(cvlen), 2, rhs, mk_cval(0, DTYPEG(cvlen)));
781-
entry_point = add_stmt_after(
782-
mk_assn_stmt(mk_id(CVLENG(sptr)), rhs, DTYPEG(cvlen)), entry_point);
781+
if (CONSTRUCTSYMG(sptr))
782+
(void)add_stmt_before(
783+
mk_assn_stmt(mk_id(CVLENG(sptr)), rhs, DTYPEG(cvlen)),
784+
BLOCK_ENDPROLOG_STD(sptr));
785+
else
786+
entry_point = add_stmt_after(
787+
mk_assn_stmt(mk_id(CVLENG(sptr)), rhs, DTYPEG(cvlen)), entry_point);
783788
add_to_early_bnd_list(rhs);
784-
ERLYSPECP(sptr, 1);
785-
ERLYSPECP(CVLENG(sptr), 1);
789+
EARLYSPECP(sptr, 1);
790+
EARLYSPECP(CVLENG(sptr), 1);
786791
}
787792
}
788793
for (i = erly_bnds_depd.avl; i; --i) {
@@ -805,31 +810,41 @@ gen_early_array_bnds(int sptr)
805810
int bndsptr;
806811
bndsptr = A_SPTRG(AD_LWAST(ad, i));
807812
if (early_specification_stmt_needed(AD_LWBD(ad, i))) {
808-
if (!ERLYSPECG(bndsptr)) {
809-
entry_point = add_stmt_after(
810-
mk_assn_stmt(AD_LWAST(ad, i), AD_LWBD(ad, i), astb.bnd.dtype),
811-
entry_point);
813+
if (!EARLYSPECG(bndsptr)) {
814+
if (CONSTRUCTSYMG(sptr))
815+
(void)add_stmt_before(
816+
mk_assn_stmt(AD_LWAST(ad, i), AD_LWBD(ad, i), astb.bnd.dtype),
817+
BLOCK_ENDPROLOG_STD(sptr));
818+
else
819+
entry_point = add_stmt_after(
820+
mk_assn_stmt(AD_LWAST(ad, i), AD_LWBD(ad, i), astb.bnd.dtype),
821+
entry_point);
812822
add_to_early_bnd_list(AD_LWBD(ad, i));
813-
ERLYSPECP(bndsptr, 1);
823+
EARLYSPECP(bndsptr, 1);
814824
}
815825
AD_LWBD(ad, i) = AD_LWAST(ad, i);
816826
early_bnd_emitted = TRUE;
817827
}
818828
bndsptr = A_SPTRG(AD_UPAST(ad, i));
819829
if (early_specification_stmt_needed(AD_UPBD(ad, i))) {
820-
if (!ERLYSPECG(bndsptr)) {
821-
entry_point = add_stmt_after(
822-
mk_assn_stmt(AD_UPAST(ad, i), AD_UPBD(ad, i), astb.bnd.dtype),
823-
entry_point);
830+
if (!EARLYSPECG(bndsptr)) {
831+
if (CONSTRUCTSYMG(sptr))
832+
(void)add_stmt_before(
833+
mk_assn_stmt(AD_UPAST(ad, i), AD_UPBD(ad, i), astb.bnd.dtype),
834+
BLOCK_ENDPROLOG_STD(sptr));
835+
else
836+
entry_point = add_stmt_after(
837+
mk_assn_stmt(AD_UPAST(ad, i), AD_UPBD(ad, i), astb.bnd.dtype),
838+
entry_point);
824839
add_to_early_bnd_list(AD_UPBD(ad, i));
825-
ERLYSPECP(bndsptr, 1);
840+
EARLYSPECP(bndsptr, 1);
826841
}
827842
AD_UPBD(ad, i) = AD_UPAST(ad, i);
828843
early_bnd_emitted = TRUE;
829844
}
830845
}
831846
if (early_bnd_emitted) {
832-
ERLYSPECP(sptr, 1);
847+
EARLYSPECP(sptr, 1);
833848
}
834849
for (i = erly_bnds_depd.avl; i; --i) {
835850
gen_early_bnd_dependencies(erly_bnds_depd.base[i - 1]);
@@ -871,6 +886,10 @@ add_bound_assignments(int sym)
871886
int tmp;
872887
int zbaseast;
873888
int insertstd = 0;
889+
int save_entry_point = entry_point;
890+
891+
if (CONSTRUCTSYMG(sym))
892+
entry_point = STD_PREV(BLOCK_ENDPROLOG_STD(sym));
874893

875894
dtype = DTYPEG(sym);
876895
ad = AD_DPTR(dtype);
@@ -932,6 +951,9 @@ add_bound_assignments(int sym)
932951
ast_visit(tmp, tmp); /* mark id ast as visited */
933952
}
934953
}
954+
955+
if (CONSTRUCTSYMG(sym))
956+
entry_point = save_entry_point;
935957
}
936958

937959
static void

0 commit comments

Comments
 (0)