Merge pull request #266 from ThePortlandGroup/nv_stage

Pull 2017-10-10T17-30 Recent NVIDIA Changes

Author: sscalpone

runtime/flang/ldread.c

@@ -1468,7 +1468,7 @@ read_record(void)
 {
   if (internal_file) {
     if (n_irecs == 0)
-      return FIO_EEOF;
+      return 0;
     if (accessed)
       in_recp += rec_len;
     n_irecs--;

runtime/flangrti/erfc_scaled.c

@@ -19,11 +19,7 @@
 #pragma global - Mx, 6, 0x100
 
 #include "mthdecls.h"
-#if defined(TARGET_WIN) || defined(win32) || defined(TARGET_OSX)
 #include <float.h>
-#else
-#include <values.h>
-#endif
 
 #define pi 3.1415926535897932384626434
 #define sqrtpi 1.77245385090551602729

runtime/flangrti/erfc_scaledf.c

@@ -19,11 +19,7 @@
 #pragma global - Mx, 6, 0x100
 
 #include "mthdecls.h"
-#if defined(TARGET_WIN) || defined(win32) || defined(TARGET_OSX)
 #include <float.h>
-#else
-#include <values.h>
-#endif
 
 #define pi 3.1415926535897932384626434f
 #define sqrtpi 1.77245385090551602729f

tools/flang1/flang1exe/rest.c

@@ -1573,13 +1573,6 @@ transform_call(int std, int ast)
             int newargt2, astnew, func;
             int sdsc_mem = get_member_descriptor(sptr);
 
-            if (SCOPEG(sptrsdsc) != stb.curr_scope) {
-              /* localize this descriptor */
-              sptrsdsc = insert_dup_sym(sptrsdsc);
-              SDSCP(sptr, sptrsdsc);
-              SCOPEP(sptrsdsc, stb.curr_scope); 
-            }
-
             newargt2 = mk_argt(2);
             ARGT_ARG(newargt2, 0) = mk_id(sptrsdsc);
 

tools/flang1/flang1exe/semant3.c

@@ -1271,10 +1271,8 @@ semant3(int rednum, SST *top)
       dtype = DTY(dtype + 1);
     if (DTY(dtype) == TY_DERIVED) {
       int mem;
-      sptr1 = resolve_sym_aliases(SST_SYMG(RHS(rhstop))); /* FS#18393 */
-      if (STYPEG(sptr1) != ST_PROC && STYPEG(sptr1) != ST_ENTRY &&
-          STYPEG(sptr1) != ST_USERGENERIC && STYPEG(sptr1) != ST_UNKNOWN)
-        goto normal_cvar_ref_component;
+      sptr1 = SST_SYMG(RHS(rhstop));
+      sptr1 = resolve_sym_aliases(sptr1);
       switch (A_TYPEG(SST_ASTG(RHS(1)))) {
       case A_ID:
       case A_LABEL:
@@ -1292,7 +1290,7 @@ semant3(int rednum, SST *top)
         dtype = DTY(dtype + 1);
       mem = 0;
       sptr1 = get_implementation(dtype, sptr1, 0, &mem);
-      if (sptr1)
+      if (sptr1 > NOSYM)
         sptr1 = BINDG(mem);
 
       if (sptr1 &&
@@ -1313,7 +1311,7 @@ semant3(int rednum, SST *top)
         if (!NOPASSG(mem))
           push_tbp_arg(itemp);
 
-          i = NMPTRG(mem);
+        i = NMPTRG(mem);
         ast = SST_ASTG(RHS(1));
         ast = mkmember(dtype, ast, i);
         if (ast) {

tools/flang1/flang1exe/semfunc.c

@@ -760,7 +760,7 @@ need_tmp_retval(int func_sptr, int param_dummy)
 static int 
 gen_finalized_result(int fval, int func_sptr)
 {
-  if (!ALLOCATTRG(fval) && !POINTERG(fval) && has_finalized_component(fval)) {
+  if (!ALLOCATTRG(fval) && !POINTERG(fval) && has_finalized_component(fval)) { 
     /* Need to finalize the function result after it's assigned to LHS.
      * If the result is allocatable, then finalization is handled during
      * automatic deallocation (i.e., the runtime call to dealloc_poly03, 
@@ -769,8 +769,8 @@ gen_finalized_result(int fval, int func_sptr)
      * whether such objects are finalized). 
      */
     int std  = add_stmt(mk_stmt(A_CONTINUE, 0));
-    if (STYPEG(fval) == ST_UNKNOWN || STYPEG(fval) == ST_IDENT) { 
 
+    if (STYPEG(fval) == ST_UNKNOWN || STYPEG(fval) == ST_IDENT) { 
       fval = getsymbol(SYMNAME(fval));
       if (STYPEG(fval) == ST_PROC) {
         /* function result variable name same as its function */
@@ -783,10 +783,12 @@ gen_finalized_result(int fval, int func_sptr)
       SCP(fval, SC_LOCAL);
       DTYPEP(fval, DTYPEG(func_sptr));
       DCLDP(fval, 1); 
+      init_derived_type(fval, 0, std);
+      std = add_stmt(mk_stmt(A_CONTINUE, 0));
     }
     gen_finalization_for_sym(fval, std, 0);
-  }
-  return fval; 
+   }
+   return fval; 
 }
 
 /** \brief Write ILMs to call a function.

tools/flang2/docs/xflag.n

@@ -3796,6 +3796,8 @@ Allow character strings in CUDA Fortran
 Allow some formatted print statements in CUDA Fortran, EXPERIMENTAL
 .XB 0x20000:
 Don't allow statements between the DO loops of a cuf kernels do construct
+.XB 0x40000:
+reserved
 
 .XF "138:"
 vect prefetch limit

tools/flang2/flang2exe/cg.h

@@ -52,7 +52,7 @@
   if (c)        \
     ;           \
   else          \
-  asrt_failed(__FILE__, __LINE__)
+  fprintf(stderr, "asrt failed. line %d, file %s\n", __LINE__, __FILE__)
 #else
 #define asrt(c)
 #endif
@@ -61,6 +61,9 @@
 
 #define FIRST_AILI(bih) cg.bih_info[bih].first_aili
 
+#define IL_OPMASK_LD    IL_LD    /* (20 Sept 17): temporary */
+#define IL_OPMASK_ST    IL_ST    /* (20 Sept 17): temporary */
+
 /*---------------------------------------------------
  * Support for 64-bit integers (via scutil functions)
  *-------------------------------------------------*/
@@ -330,7 +333,7 @@ struct bih_info {
   int pre_first_lili;      /* first LILI in this block;  used during PRE */
   int first_lili;          /* first LILI in the EBB containing this block*/
   int last_lili;           /* last LILI in the EBB containing this block */
-  int pressure[4];         /* register pressures for this block */
+  int pressure[6];         /* register pressures for this block */
 };
 
 /*-------------------------------
@@ -537,7 +540,7 @@ typedef struct AILI {
   short rc_sptr;          /* sptr for a memop of a spill */
   CC_RELATION cc;         /* condition code ... one of CC_RELATION values */
   int number;             /* this AILI # */
-  short pressure[4];      /* OPT2 reg assignment: reg pressures for this aili */
+  short pressure[6];      /* OPT2 reg assignment: reg pressures for this AILI */
   struct AILI *prev;      /* pointer to previous aili in list */
   struct AILI *next;      /* pointer to next aili in list */
   short branch_num;       /* if XBIT_TREGION_CSE, 1 means AILI is in the 'if'
@@ -570,7 +573,7 @@ typedef struct RCAND {
   OPRND *regop;      /* pointer to the corresponding OP_REG operand */
   int nme;           /* names table entry for corresp. variable */
   int next;          /* used to form various lists of candidates */
-  REGCLASS regclass; /* REG_GP or REG_XM */
+  REGCLASS regclass; /* REG_GP, REG_XM or REG_OPMASK */
   AILI *first_use;   /* beginning of the candidate's live interval */
   AILI *last_use;    /* end of this candidate's live interval */
   struct live_range_item *live_range;

tools/flang2/flang2exe/iliutil.c

@@ -11683,50 +11683,60 @@ jsrsearch(int ilix)
 int
 alt_qjsr(int ilix)
 {
+  int altx, j, noprs;
+  ILI_OP opc;
+
   if (ILI_ALT(ilix)) {
-    if (IL_TYPE(ILI_OPC(ILI_ALT(ilix))) == ILTY_DEFINE)
+    altx = ILI_ALT(ilix);
+    opc  = ILI_OPC(altx);
+    if (IL_TYPE(opc) == ILTY_DEFINE)
       return 1;
-    {
-      /*
-       * A bug (asrt) occurred with the 32-bit cg where the BIH_QJSR
-       * flag was not set, but the block contained a QJSR -- alt_qjsr(),
-       * when called from flow(, is supposed to detect qjsrs alt ili.
-       * There are just a few cases where the ALT ILI does not
-       * immediately reference a QJSR, but it's an ILI whose operand
-       * is a QJSR; an example of this is a 64-bit relational fo
-       * something like
-       *     if ( i8 .gt. 0 )
-       * 49   QJSR          342~<__mth_i_kcmpz>    48^
-       * 50   DFRIR          49^ ir( 1)
-       * 51   ICMPZ          50^    gt
-       * 52   KCMPZ          47^    gt     51^-alt
-       * ...
-       * The solution for now is to check just one level below the
-       * ALT -- this isn't general at all, so the next time the bug
-       * occurs, may have to implement a complete fix (i.e., just
-       * call the 'new' routine, qjsr_in(), above);
-       */
-      int altx;
-      ILI_OP opc;
-      int noprs, j;
-      altx = ILI_ALT(ilix);
-      opc = ILI_OPC(altx);
-      noprs = IL_OPRS(opc);
-      for (j = 1; j <= noprs; ++j) {
-        if (IL_ISLINK(opc, j)) {
-          if (IL_TYPE(ILI_OPC(ILI_OPND(altx, j))) == ILTY_DEFINE)
-            return 1;
-        }
+
+    /* In a few cases a QJSR's result ILI (namely a 'define' ILI such
+     * as IL_DFRDP, etc) is not 'altx' itself but rather an operand of
+     * 'altx'.  For example, if the C99 ABI is used on x86 then a
+     * complex*16 function result is returned in a pair of registers,
+     * %xmm0 and %xmm1, and the ILI 'altx' is
+     * IL_DPDP2DCMPLX( IL_DFRDP(...), IL_DFRDP(...) ).  Also on x86-32
+     * a 64-bit condition such as:
+     *
+     *     if (i8 .gt. 0)
+     * 
+     * gives rise to ILIs such as:
+     *
+     * 49   QJSR          342~<__mth_i_kcmpz>    48^
+     * 50   DFRIR          49^ ir( 1)
+     * 51   ICMPZ          50^    gt
+     * 52   KCMPZ          47^    gt     51^-alt
+     *
+     * The solution for now is to check whether any operand of 'altx'
+     * is a define ILI.
+     *
+     * This deals with the cases that we're currently aware of, but if
+     * a situation arises in which the define ILI is more deeply
+     * nested in 'altx's ILI tree then we'll have to implement a
+     * complete fix, e.g. by calling 'qjsr_in()'.  Note, if this
+     * function fails to detect a QJSR ILI that is present in 'altx's
+     * ILI tree then the x86 native CG may indicate this by generating
+     * the warning ICE "gen_lilis: BIH_QJSR needs to be set for bih
+     * <bih_number>".
+     */
+    noprs = IL_OPRS(opc);
+    for (j = 1; j <= noprs; ++j) {
+      if (IL_ISLINK(opc, j)  &&
+          IL_TYPE(ILI_OPC(ILI_OPND(altx, j))) == ILTY_DEFINE) {
+        return 1;
       }
     }
   }
+
   switch (ILI_OPC(ilix)) {
   case IL_FSINCOS:
   case IL_DSINCOS:
     return 1;
   }
   return 0;
-}
+} /* end alt_qjsr(int ilix) */
 
 /** \brief Look for 'QJSR' in this tree
  */