Skip to content
Permalink
Browse files

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.)
  • Loading branch information...
gklimowicz committed Oct 25, 2019
1 parent 249b986 commit d2d64f083b004dc215c052dd22c3108008ee46da
@@ -397,7 +397,7 @@ left (e.g. '1234567890abcdef1'x will be '234567890abcdef1'x).
.MS S 116 "Illegal use of pointer-based variable $ $"
.MS S 117 "Statement not allowed within a $ definition"
The statement may not appear in a STRUCTURE or derived type definition.
.MS S 118 "Statement not allowed in DO, IF, or WHERE block"
.MS S 118 "Statement not allowed in BLOCK, DO, IF, WHERE, or other executable construct"
.MS I 119 "Redundant specification for $"
Data type of indicated symbol specified more than once.
.MS I 120 "Label $ is defined but never referenced"
@@ -1531,3 +1531,5 @@ Starting from 1100, Reserved for OpenMP GPU
.MS S 1215 "OpenACC data clause expected after $."
.MS S 1216 "Expression in assignment statement contains type bound procedure name $. This may be a function call that's missing parentheses."
.MS S 1217 "Left hand side of polymorphic assignment must be allocatable - $"
.MS S 1218 "$ statement may not appear in a BLOCK construct."
.MS S 1219 "Unimplemented feature: $."
@@ -29,15 +29,15 @@ subroutine foo()
subroutine bar(this)
class(obj) :: this

!block
block
type t
contains
procedure, nopass :: foo
end type
type(t) :: o

call o%foo()
!end block
end block
end subroutine

end module
@@ -31,7 +31,7 @@ subroutine foo2(i)

subroutine bar()
use mod
!block
block
type t
contains
procedure, nopass :: foo
@@ -41,7 +41,7 @@ subroutine bar()
type(t) :: o

call o%func(-99)
!end block
end block
end subroutine

use mod
@@ -33,7 +33,7 @@ subroutine foo2(i)

subroutine bar(this)
class(obj) :: this
!block
block
type t
contains
procedure, nopass :: foo
@@ -43,7 +43,7 @@ subroutine bar(this)
type(t) :: o

call o%func(-99)
!end block
end block
end subroutine

end module
@@ -2322,6 +2322,7 @@ print_ast(int ast)
print_ast(A_ENDLABG(ast));
}
A_TYPEP(ast, A_DO);
put_string(" ");
print_ast(ast);
A_TYPEP(ast, A_MP_PDO);
break;
@@ -1,5 +1,5 @@
/*
* Copyright (c) 1994-2018, NVIDIA CORPORATION. All rights reserved.
* Copyright (c) 1994-2019, NVIDIA CORPORATION. All rights reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -35,7 +35,6 @@
#include "pd.h"
#include "rtlRtns.h"

static int exit_point;
static int entry_point;
static int par; /* in OpenMp parallel region */
static int cs; /* in OpenMp critical section */
@@ -88,6 +87,7 @@ bblock()
INT ent_cnt;
int ent_select_id;
int has_kernel = 0;
ITEM *itemp;

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

sem.temps_reset = TRUE;
entry_point = 0;
last_std = STD_PREV(0);
last_std = STD_LAST;

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

/*
* gen_auto_dealloc();
*/
{
ITEM *itemp;
if (sem.type_initialize) {
int std2;
for (itemp = sem.auto_dealloc; itemp; itemp = itemp->next) {
gen_conditional_dealloc_for_sym(itemp->t.sptr, gbl.exitstd);
for (std2 = ENTSTDG(gbl.currsub); STD_LINENO(std2) == 0;
std2 = STD_NEXT(std2))
;
std2 = STD_PREV(std2);
for (itemp = sem.type_initialize; itemp; itemp = itemp->next) {
int stdx = CONSTRUCTSYMG(itemp->t.sptr) ?
BLOCK_ENTRY_STD(itemp->t.sptr) : std2;
gen_type_initialize_for_sym(itemp->t.sptr, stdx, 0, 0);
}
}

std2 = gbl.exitstd;
for (itemp = sem.auto_finalize; itemp; itemp = itemp->next) {
std2 = gen_finalization_for_sym(itemp->t.sptr, gbl.exitstd, 0);
}
gbl.exitstd = std2;

if (sem.type_initialize) {
int std;
for (std = ENTSTDG(gbl.currsub); STD_LINENO(std) == 0;
std = STD_NEXT(std))
;
std = STD_PREV(std);
for (itemp = sem.type_initialize; itemp; itemp = itemp->next) {
gen_type_initialize_for_sym(itemp->t.sptr, std, 0, 0);
}
}
for (itemp = sem.alloc_mem_initialize; itemp; itemp = itemp->next) {
gen_alloc_mem_initialize_for_sym(itemp->t.sptr, ENTSTDG(gbl.currsub));
}
for (itemp = sem.alloc_mem_initialize; itemp; itemp = itemp->next) {
int stdx = CONSTRUCTSYMG(itemp->t.sptr) ?
BLOCK_ENTRY_STD(itemp->t.sptr) : ENTSTDG(gbl.currsub);
gen_alloc_mem_initialize_for_sym(itemp->t.sptr, stdx);
}

for (itemp = sem.auto_dealloc; itemp; itemp = itemp->next) {
int stdx = CONSTRUCTSYMG(itemp->t.sptr) ?
STD_PREV(BLOCK_EXIT_STD(itemp->t.sptr)) : gbl.exitstd;
gen_conditional_dealloc_for_sym(itemp->t.sptr, stdx);
}

for (itemp = sem.auto_finalize; itemp; itemp = itemp->next) {
int stdx = CONSTRUCTSYMG(itemp->t.sptr) ?
STD_PREV(BLOCK_EXIT_STD(itemp->t.sptr)) : gbl.exitstd;
gen_finalization_for_sym(itemp->t.sptr, stdx, 0);
}

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

std = ENTSTDG(
gbl.currsub); /* insert dependencies before dependent bnds exprs */
switch (A_TYPEG(ast)) {
case A_ID:
sptr = A_SPTRG(ast);
if (STYPEG(sptr) == ST_ARRAY && ADJARRG(sptr) && !ERLYSPECG(sptr)) {
/* insert dependencies before dependent bnds exprs */
std = CONSTRUCTSYMG(sptr) ? BLOCK_ENTRY_STD(sptr) : ENTSTDG(gbl.currsub);
if (STYPEG(sptr) == ST_ARRAY && ADJARRG(sptr) && !EARLYSPECG(sptr)) {
ad = AD_DPTR(DTYPEG(sptr));
ndims = AD_NUMDIM(ad);
for (i = 0; i < ndims; i++) {
if (A_TYPEG(AD_LWAST(ad, i)) != A_CNST) {
bndsptr = A_SPTRG(AD_LWAST(ad, i));
if (!ERLYSPECG(bndsptr)) {
if (!EARLYSPECG(bndsptr)) {
std = add_stmt_after(
mk_assn_stmt(AD_LWAST(ad, i), AD_LWBD(ad, i), astb.bnd.dtype),
std);
ERLYSPECP(bndsptr, 1);
EARLYSPECP(bndsptr, 1);
gen_early_bnd_dependencies(AD_LWBD(ad, i));
}
early_spec_gend = TRUE;
}
if (A_TYPEG(AD_UPAST(ad, i)) != A_CNST) {
bndsptr = A_SPTRG(AD_UPAST(ad, i));
if (!ERLYSPECG(bndsptr)) {
if (!EARLYSPECG(bndsptr)) {
std = add_stmt_after(
mk_assn_stmt(AD_UPAST(ad, i), AD_UPBD(ad, i), astb.bnd.dtype),
std);
ERLYSPECP(bndsptr, 1);
EARLYSPECP(bndsptr, 1);
gen_early_bnd_dependencies(AD_UPBD(ad, i));
}
early_spec_gend = TRUE;
}
}
}
if (ADJLENG(sptr)) {
if (!ERLYSPECG(sptr)) {
if (!EARLYSPECG(sptr)) {
int rhs, cvlen;
dtype = DDTG(DTYPEG(sptr));
if (!CVLENG(sptr)) {
@@ -723,12 +723,12 @@ gen_early_bnd_dependencies(int ast)
std = add_stmt_after(
mk_assn_stmt(mk_id(CVLENG(sptr)), rhs, DTYPEG(cvlen)), std);
add_to_early_bnd_list(rhs);
ERLYSPECP(CVLENG(sptr), 1);
EARLYSPECP(CVLENG(sptr), 1);
}
early_spec_gend = TRUE;
}
if (early_spec_gend) {
ERLYSPECP(sptr, 1);
EARLYSPECP(sptr, 1);
}
break;
case A_FUNC:
@@ -754,7 +754,7 @@ gen_early_bnd_dependencies(int ast)
static void
gen_early_str_len()
{
int sptr;
SPTR sptr;
int ast;
int std;
int dtype;
@@ -778,11 +778,16 @@ gen_early_str_len()
rhs = DTY(dtype + 1);
rhs = mk_convert(rhs, DTYPEG(cvlen));
rhs = ast_intr(I_MAX, DTYPEG(cvlen), 2, rhs, mk_cval(0, DTYPEG(cvlen)));
entry_point = add_stmt_after(
mk_assn_stmt(mk_id(CVLENG(sptr)), rhs, DTYPEG(cvlen)), entry_point);
if (CONSTRUCTSYMG(sptr))
(void)add_stmt_before(
mk_assn_stmt(mk_id(CVLENG(sptr)), rhs, DTYPEG(cvlen)),
BLOCK_ENDPROLOG_STD(sptr));
else
entry_point = add_stmt_after(
mk_assn_stmt(mk_id(CVLENG(sptr)), rhs, DTYPEG(cvlen)), entry_point);
add_to_early_bnd_list(rhs);
ERLYSPECP(sptr, 1);
ERLYSPECP(CVLENG(sptr), 1);
EARLYSPECP(sptr, 1);
EARLYSPECP(CVLENG(sptr), 1);
}
}
for (i = erly_bnds_depd.avl; i; --i) {
@@ -805,31 +810,41 @@ gen_early_array_bnds(int sptr)
int bndsptr;
bndsptr = A_SPTRG(AD_LWAST(ad, i));
if (early_specification_stmt_needed(AD_LWBD(ad, i))) {
if (!ERLYSPECG(bndsptr)) {
entry_point = add_stmt_after(
mk_assn_stmt(AD_LWAST(ad, i), AD_LWBD(ad, i), astb.bnd.dtype),
entry_point);
if (!EARLYSPECG(bndsptr)) {
if (CONSTRUCTSYMG(sptr))
(void)add_stmt_before(
mk_assn_stmt(AD_LWAST(ad, i), AD_LWBD(ad, i), astb.bnd.dtype),
BLOCK_ENDPROLOG_STD(sptr));
else
entry_point = add_stmt_after(
mk_assn_stmt(AD_LWAST(ad, i), AD_LWBD(ad, i), astb.bnd.dtype),
entry_point);
add_to_early_bnd_list(AD_LWBD(ad, i));
ERLYSPECP(bndsptr, 1);
EARLYSPECP(bndsptr, 1);
}
AD_LWBD(ad, i) = AD_LWAST(ad, i);
early_bnd_emitted = TRUE;
}
bndsptr = A_SPTRG(AD_UPAST(ad, i));
if (early_specification_stmt_needed(AD_UPBD(ad, i))) {
if (!ERLYSPECG(bndsptr)) {
entry_point = add_stmt_after(
mk_assn_stmt(AD_UPAST(ad, i), AD_UPBD(ad, i), astb.bnd.dtype),
entry_point);
if (!EARLYSPECG(bndsptr)) {
if (CONSTRUCTSYMG(sptr))
(void)add_stmt_before(
mk_assn_stmt(AD_UPAST(ad, i), AD_UPBD(ad, i), astb.bnd.dtype),
BLOCK_ENDPROLOG_STD(sptr));
else
entry_point = add_stmt_after(
mk_assn_stmt(AD_UPAST(ad, i), AD_UPBD(ad, i), astb.bnd.dtype),
entry_point);
add_to_early_bnd_list(AD_UPBD(ad, i));
ERLYSPECP(bndsptr, 1);
EARLYSPECP(bndsptr, 1);
}
AD_UPBD(ad, i) = AD_UPAST(ad, i);
early_bnd_emitted = TRUE;
}
}
if (early_bnd_emitted) {
ERLYSPECP(sptr, 1);
EARLYSPECP(sptr, 1);
}
for (i = erly_bnds_depd.avl; i; --i) {
gen_early_bnd_dependencies(erly_bnds_depd.base[i - 1]);
@@ -871,6 +886,10 @@ add_bound_assignments(int sym)
int tmp;
int zbaseast;
int insertstd = 0;
int save_entry_point = entry_point;

if (CONSTRUCTSYMG(sym))
entry_point = STD_PREV(BLOCK_ENDPROLOG_STD(sym));

dtype = DTYPEG(sym);
ad = AD_DPTR(dtype);
@@ -932,6 +951,9 @@ add_bound_assignments(int sym)
ast_visit(tmp, tmp); /* mark id ast as visited */
}
}

if (CONSTRUCTSYMG(sym))
entry_point = save_entry_point;
}

static void

0 comments on commit d2d64f0

Please sign in to comment.
You can’t perform that action at this time.