Skip to content
Permalink
Browse files

Fix a segfault with procedure dummy arguments

Fix a fault with procedure dummy arguments and interfaces.
Create a unique symbol for interfaces that are used in procedure
pointer declarations because the LLVM bridge uses the interface
as well as the argument ILI to generate arguments at a procedure
pointer call.  An interface symbol might turn into a procedure
symbol in the back-end.  Create a unique symbol so we can
mark it with a new field called IS_PROC_PTR_IFACE. This
field says that the symbol is used as an interface to a
procedure pointer. When the bridge sees this field set, it
knows to generate a closure pointer as the last argument at
the call-site.

This bug fix addresses Flang issue #577.
  • Loading branch information...
gklimowicz committed Nov 7, 2019
1 parent 4498b2b commit 9dd4ed032b4a2eaa3c6a31aacd4cae92695c22d5
@@ -1517,6 +1517,20 @@ tk_match_arg(int formal_dt, int actual_dt, LOGICAL flag)
}
}
else if (!eq_dtype2(f_dt, a_dt, flag)) {
if (DTY(f_dt) == TY_PTR && DTY(a_dt) == TY_PTR &&
DTY(DTY(f_dt + 1)) == TY_PROC && DTY(DTY(a_dt + 1)) == TY_PROC) {
/* eq_dtype2 checks equality of the procedure pointers.
* If they are not the same (including the same name), then
* it returns false. This is correct for an equality test.
* However, in this case, we don't care about the names being
* the same if all other attributes are equal.
*/
DTYPE d1 = DTY(f_dt + 1);
DTYPE d2 = DTY(a_dt + 1);
if (cmp_interfaces(DTY(d1 + 2), DTY(d2 + 2), FALSE)) {
return TRUE;
}
}
return FALSE;
}

@@ -140,6 +140,8 @@
* 20.1 -- 1.55
* All of 1.54 +
* pass elemental field for subprogram when emitting ST_ENTRY.
*
* For ST_PROC, pass IS_PROC_PTR_IFACE flag.
*/
#define VersionMajor 1
#define VersionMinor 55
@@ -4043,6 +4043,7 @@ lower_symbol(int sptr)
putbit("is_interface", IS_INTERFACEG(sptr));
putval("assocptr", ASSOC_PTRG(sptr));
putval("ptrtarget",PTR_TARGETG(sptr));
putbit("prociface", IS_PROC_PTR_IFACEG(sptr));
}

strip = 1;
@@ -4273,6 +4274,7 @@ lower_symbol(int sptr)
#endif
putval("assocptr", ASSOC_PTRG(sptr));
putval("ptrtarget", PTR_TARGETG(sptr));
putbit("prociface", IS_PROC_PTR_IFACEG(sptr));
strip = 1;
break;

@@ -4322,6 +4324,7 @@ lower_symbol(int sptr)
putbit("is_interface", 0);
putval("assocptr", 0);
putval("ptrtarget", 0);
putbit("prociface", 0);
strip = 1;
break;

@@ -4523,6 +4526,7 @@ lower_symbol(int sptr)
putval("descriptor", IS_PROC_DUMMYG(sptr) ? SDSCG(sptr) : 0);
putsym("assocptr", ASSOC_PTRG(sptr));
putsym("ptrtarget", PTR_TARGETG(sptr));
putbit("prociface", IS_PROC_PTR_IFACEG(sptr));
if (gbl.stbfil && DTY(DTYPEG(sptr) + 2)) {
if (fvalfirst) {
putsym(NULL, FVALG(sptr));
@@ -2479,7 +2479,7 @@ semant1(int rednum, SST *top)
* body should never contain a procedure defined by a subprogram,
* so this flag should never be set for an interface. Because
* getsym() does not have access to sem.interface, we reset the
* NTERNAL flag here.
* INTERNAL flag here.
*/
INTERNALP(sptr, 0);
}
@@ -11343,6 +11343,49 @@ semant1(int rednum, SST *top)
if (POINTERG(sptr)) {
attr |= ET_B(ET_POINTER);
}
if (!IS_PROC_DUMMYG(sptr) && IS_INTERFACEG(proc_interf_sptr) &&
!IS_PROC_PTR_IFACEG(proc_interf_sptr)) {
/* Create a unique symbol for the interface so it does not conflict with
* an external procedure symbol. For non-procedure dummy arguments,
* we need a unique symbol for the interface in order to preserve
* the interface flag (IS_PROC_PTR_IFACE). We need the interface flag in
* the back-end so we properly generate the procedure descriptor
* actual arguments on the call-site (when we call the procedure pointer).
* This is only needed by the LLVM back-end because the bridge uses the
* interface to generate the LLVM IR for the actual arguments.
*/
char * buf;
int len;
SPTR sym;

/* First, let's see if we aleady have a unique interface symbol */
len = strlen(SYMNAME(proc_interf_sptr)) + strlen("iface") + 1;
buf = getitem(0, len);
sprintf(buf,"%s$iface",SYMNAME(proc_interf_sptr));
sym = findByNameStypeScope(buf, ST_PROC, 0);
if (sym > NOSYM && !cmp_interfaces_strict(sym, proc_interf_sptr, 0)) {
/* The interface is not compatible. We will now try to find one that
* is compatible in the symbol table.
*/
SPTR sym2 = sym;
get_next_hash_link(sym2, 0);
while ((sym2=get_next_hash_link(sym2, 1)) > NOSYM) {
if (cmp_interfaces_strict(sym2, proc_interf_sptr, 0)) {
break;
}
}
sym = sym2;
}
if (sym <= NOSYM) {
/* We don't yet have a unique interface symbol, so create it now */
sym = get_next_sym(SYMNAME(proc_interf_sptr), "iface");
/* Propagate flags from the original symbol to the new symbol */
copy_sym_flags(sym, proc_interf_sptr);
HCCSYMP(sym, 1);
IS_PROC_PTR_IFACEP(sym, 1);
}
proc_interf_sptr = sym;
}
sptr = decl_procedure_sym(sptr, proc_interf_sptr, attr);
sptr =
setup_procedure_sym(sptr, proc_interf_sptr, attr, entity_attr.access);
@@ -2802,6 +2802,41 @@ cmp_interfaces_strict(SPTR sym1, SPTR sym2, cmp_interface_flags flag)
return true;
}

/** \brief Copy flags from one symbol to another symbol.
*
* This routine is the same as dup_sym() except it preserves the symbol's
* name, hash link, scope, and name pointer. In other words, it copies all but
* 4 flags from one symbol to another. The 4 flags that are not copied are
* the hashlk, symlk, scope, and nmptr.
*
* \param dest is the receiving symbol table pointer of the flags.
* \param src is the source symbol table pointer of the flags.
*/
void
copy_sym_flags(SPTR dest, SPTR src)
{

SYM *destSym;
SPTR hashlk;
SPTR symlk;
INT nmptr;
INT scope;

destSym = (stb.stg_base + dest);
hashlk = destSym->hashlk;
symlk = destSym->symlk;
nmptr = destSym->nmptr;
scope = destSym->scope;

*destSym = *(stb.stg_base + src);

destSym->hashlk = hashlk;
destSym->symlk = symlk;
destSym->nmptr = nmptr;
destSym->scope = scope;

}

/**
* replace contents of a symbol with values defining every field while ensuring
* values necessary for the hashing function are saved and restored.
@@ -414,6 +414,7 @@ LOGICAL is_arg_in_entry(int, int);
int resolve_sym_aliases(int);
LOGICAL is_procedure_ptr(int);
void proc_arginfo(int, int *, int *, int *);
void copy_sym_flags(SPTR, SPTR);
void dup_sym(int, struct SYM *);
int insert_dup_sym(int);
int get_align_desc(int, int);
@@ -1592,6 +1592,9 @@ for this symbol.
.lp
.ul
Flags
.FL IS_PROC_PTR_IFACE f117
This is set when this procedure symbol is used as an interface for a procedure
pointer. IS_INTERFACE should also be set in this case.
.FL SEPARATEMP
MODULE SUBROUTINE, MODULE FUNCTION for a separate module procedure.
.FL TBP_BOUND_TO_SMP f112
@@ -36,6 +36,8 @@
#include "cgmain.h"
#include "symfun.h"

static SPTR create_display_temp_arg(DTYPE ref_dtype);

/* debug switches:
-Mq,11,16 dump ili right before ILI -> LLVM translation
-Mq,12,16 provides dinit info, ilt trace, and some basic preprocessing info
@@ -233,6 +235,21 @@ gen_ref_arg(SPTR param_sptr, SPTR func_sptr, LL_Type *ref_dummy, int param_num,
addag_llvm_argdtlist(gblsym, param_num, param_sptr, llt);
}

/** \brief Create a procedure DUMMY argument to hold a closure/display pointer.
*
* \param ref_dtype is a dtype for the display argument.
*
* \return the symbol table pointer of the newly created display argument.
*/
static SPTR
create_display_temp_arg(DTYPE ref_dtype)
{
SPTR display_temp = getccsym('S', gbl.currsub, ST_VAR);
SCP(display_temp, SC_DUMMY);
DTYPEP(display_temp, ref_dtype);
return display_temp;
}

void
ll_process_routine_parameters(SPTR func_sptr)
{
@@ -325,14 +342,13 @@ ll_process_routine_parameters(SPTR func_sptr)
display_temp = aux.curr_entry->display;
DTYPEP(display_temp, ref_dtype); /* fake type */
} else {
display_temp = getccsym('S', gbl.currsub, ST_VAR);
/* we won't make type as at the time we generate the prototype, we don't
* know
* what members it has.
* know what members it has.
*/
SCP(display_temp, SC_DUMMY);
DTYPEP(display_temp, ref_dtype); /* fake type */
display_temp = create_display_temp_arg(ref_dtype);
}
} else if (IS_PROC_PTR_IFACEG(func_sptr)) {
display_temp = create_display_temp_arg(ref_dtype);
}

if (fval) {
@@ -2045,6 +2045,7 @@ read_symbol(void)
int alldefaultinit;
int tpalloc, procdummy, procdesc, has_opts;
SPTR assocptr, ptrtarget;
int prociface;
ISZ_T address, size;
SPTR sptr = getSptrVal("symbol");
bool has_alias = false;
@@ -2764,7 +2765,7 @@ read_symbol(void)
tpalloc = getbit("tpalloc");
assocptr = getSptrVal("assocptr");
ptrtarget = getSptrVal("ptrtarget");

prociface = getbit("prociface");
newsptr = get_or_create_symbol(sptr);

STYPEP(newsptr, stype);
@@ -2812,6 +2813,7 @@ read_symbol(void)
if (assocptr > NOSYM || ptrtarget > NOSYM) {
PTR_INITIALIZERP(newsptr, 1);
}
IS_PROC_PTR_IFACEP(newsptr, prociface);
break;

case ST_NML:
@@ -2944,6 +2946,7 @@ read_symbol(void)
descriptor = (sclass == SC_DUMMY) ? getSptrVal("descriptor") : SPTR_NULL;
assocptr = getSptrVal("assocptr");
ptrtarget = getSptrVal("ptrtarget");
prociface = getbit("prociface");

if (paramcount == 0) {
dpdsc = 0;
@@ -3123,6 +3126,7 @@ read_symbol(void)
if (assocptr > NOSYM || ptrtarget > NOSYM) {
PTR_INITIALIZERP(newsptr, 1);
}
IS_PROC_PTR_IFACEP(newsptr, prociface);
break;

case ST_GENERIC:
@@ -144,6 +144,8 @@
* 20.1 -- 1.55
* All of 1.54 +
* pass elemental field for subprogram when emitting ST_ENTRY.
*
* For ST_PROC, receive IS_PROC_PTR_IFACE flag.
*/

#include "gbldefs.h"
@@ -1507,6 +1507,8 @@ Set if this procedure has optional arguments.
.FL LIBSYM f111
Indicates that this is a routine symbol from a standard module, such as
ieee_arithmetic or iso_c_binding, that is resolved from a system library.
.FL IS_PROC_PTR_IFACE f125
Indicates that this symbol is used as an interface with a procedure pointer. IS_INTERFACE should also be set in this case.
.FL PTR_INITIALIZER f126
Set when this symbol is used as an initializer for a pointer. Assumes
ASSOC_PTR and/or PTR_TARGET are also set.

0 comments on commit 9dd4ed0

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