Merge pull request #268 from ThePortlandGroup/nv_stage

Pull 2017-10-11T18-10 Recent NVIDIA Changes

Author: sscalpone

runtime/flang/acos.c

@@ -15,10 +15,8 @@
  *
  */
 
-/** \file
- * Single precision acos interface  */
-
 #include "mthdecls.h"
+/*  -------------------- single precision functions:  */
 
 float
 __mth_i_acos(float f)

runtime/flang/amod.c

@@ -17,7 +17,9 @@
 
 #include "mthdecls.h"
 
+#if defined(WIN64)
 float __fmth_i_amod(float f, float g);
+#endif
 
 float
 __mth_i_amod(float f, float g)

runtime/flang/asin.c

@@ -15,9 +15,6 @@
  *
  */
 
-/** \file
- * Single precision asin interface  */
-
 #include "mthdecls.h"
 
 float

runtime/flang/atan2.c

@@ -15,9 +15,6 @@
  *
  */
 
-/** \file
- * Single precision atan2f interface  */
-
 #include "mthdecls.h"
 
 float

runtime/flang/dmod.c

@@ -17,7 +17,9 @@
 
 #include "mthdecls.h"
 
+#if defined(WIN64)
 double __fmth_i_dmod(double f, double g);
+#endif
 
 double
 __mth_i_dmod(double f, double g)

runtime/flang/kidim.c

@@ -18,7 +18,7 @@
 #include "mthdecls.h"
 
 _LONGLONG_T
-ftn_i_kidim(_LONGLONG_T i, _LONGLONG_T j)
+ftn_i_kidim(_LONGLONG_T i, long long j)
 {
   _LONGLONG_T h;
 

tools/flang1/flang1exe/error.c

@@ -38,9 +38,9 @@
 #include <string.h>
 
 static char *errfill(const char *, const char *, const char *);
-static void display_error(error_code_t ecode, enum error_severity sev, 
-                          int eline, const char *op1, const char *op2,
-                            int col, const char * srcFile);
+static void display_error(error_code_t ecode, enum error_severity sev,
+                          int eline, const char *op1, const char *op2, int col,
+                          const char *srcFile);
 
 static int ndiags[5];
 static int maxfilsev = 0;  /* max severity for entire source file */
@@ -84,8 +84,8 @@ error(error_code_t ecode, enum error_severity sev, int eline, const char *op1,
 }
 
 static void
-display_error(error_code_t ecode, enum error_severity sev, int eline, 
-              const char *op1, const char *op2, int col, const char * srcFile)
+display_error(error_code_t ecode, enum error_severity sev, int eline,
+              const char *op1, const char *op2, int col, const char *srcFile)
 {
   static char sevlett[5] = {'X', 'I', 'W', 'S', 'F'};
   char *formatstr;
@@ -115,7 +115,7 @@ display_error(error_code_t ecode, enum error_severity sev, int eline,
           formatstr = "%s-%c-%04d-%s (%s: %d.%d)";
         else
           formatstr = "%s-%c-%04d-%s (%s: %d)";
-      }else
+      } else
         formatstr = "%s-%c-%04d-%s (%s)";
     } else
       formatstr = "%s-%c-%04d-%s";
@@ -129,22 +129,22 @@ display_error(error_code_t ecode, enum error_severity sev, int eline,
 
     if (!XBIT(0, 0x40000000) && col <= 0 && srcFile == NULL)
       snprintf(&buff[1], sizeof(buff) - 1, formatstr, version.lang,
-               sevlett[sev], ecode, errfill(msgstr, op1, op2), 
-               gbl.curr_file, eline);
+               sevlett[sev], ecode, errfill(msgstr, op1, op2), gbl.curr_file,
+               eline);
     else {
       static char *sevtext[5] = {"X", "info", "warning", "error", "error"};
       if (col > 0 && (srcFile != NULL || gbl.curr_file != NULL)) {
         snprintf(&buff[1], sizeof(buff) - 1, "\n%s:%d:%d: %s %c%04d: %s",
                  (srcFile != NULL) ? srcFile : gbl.curr_file, eline, col,
-                 sevtext[sev], sevlett[sev], ecode, errfill(msgstr, op1, op2));                      
+                 sevtext[sev], sevlett[sev], ecode, errfill(msgstr, op1, op2));
       } else if (srcFile != NULL) {
-        snprintf(&buff[1], sizeof(buff) - 1, "\n%s:%d: %s %c%04d: %s",
-                 srcFile, eline, sevtext[sev], sevlett[sev],
-                 ecode, errfill(msgstr, op1, op2));
+        snprintf(&buff[1], sizeof(buff) - 1, "\n%s:%d: %s %c%04d: %s", srcFile,
+                 eline, sevtext[sev], sevlett[sev], ecode,
+                 errfill(msgstr, op1, op2));
       } else if (gbl.curr_file != NULL) {
         snprintf(&buff[1], sizeof(buff) - 1, "%s(%d) : %s %c%04d : %s",
-                 gbl.curr_file, eline, sevtext[sev], 
-                 sevlett[sev], ecode, errfill(msgstr, op1, op2));
+                 gbl.curr_file, eline, sevtext[sev], sevlett[sev], ecode,
+                 errfill(msgstr, op1, op2));
       } else
         snprintf(&buff[1], sizeof(buff) - 1, "%s : %s %c%04d : %s", "",
                  sevtext[sev], sevlett[sev], ecode, errfill(msgstr, op1, op2));
@@ -292,7 +292,7 @@ interrf(enum error_severity sev, const char *fmt, ...)
   va_start(ap, fmt);
   size = vsnprintf(NULL, 0, fmt, ap);
   va_end(ap);
-  NEW(buffer, char, size+1);
+  NEW(buffer, char, size + 1);
   va_start(ap, fmt);
   vsprintf(buffer, fmt, ap);
   va_end(ap);
@@ -335,9 +335,10 @@ dassert_err(const char *filename, int line, const char *expr, const char *txt)
   * Prints information on behalf of failed asrt.
   * \param file: filename: name of file where assertion failed.
   * \param line: line number where assertion failed
-  */ 
+  */
 void
-asrt_failed(const char *filename, int line) {
+asrt_failed(const char *filename, int line)
+{
   fprintf(stderr, "asrt failed. line %d, file %s\n", line, filename);
   /* Call interr so that we have a common place to set a breakpoint when
      running under a debugger. */
@@ -478,11 +479,11 @@ error_max_severity()
  * \param ptoken is the token string we are processing.
  *
  * \return the last substring, else NULL
- */ 
+ */
 char *
-getDeduceStr(char * ptoken)
+getDeduceStr(char *ptoken)
 {
-  char * lastToken;
+  char *lastToken;
   if (ptoken != NULL) {
     lastToken = strrchr(ptoken, ' ');
     if (lastToken != NULL) {
@@ -497,7 +498,7 @@ getDeduceStr(char * ptoken)
 /** \brief Construct and issue an "enhanced" error message.
  *
  * Construct error message and issue it to user terminal and to listing file
- * if appropriate. This is an "enhanced" error message which means we will 
+ * if appropriate. This is an "enhanced" error message which means we will
  * also display the source line, column number, and location of the error.
  *
  * Note: First five arguments are the same as function error().
@@ -511,82 +512,82 @@ getDeduceStr(char * ptoken)
  * \param op1        String to be expanded into error message * or 0
  *
  * \param op2        String to be expanded into error message * or 0
- * 
- * \param col        The column number where the error occurred at if 
+ *
+ * \param col        The column number where the error occurred at if
  *                   available, else 0.
  *
  * \param deduceCol  The operand to use (1 for op1, 2 for op2) to deduce the
  *                   the column number when the col argument is not available.
  *                   Setting this to 0 disables column deduction.
- *                   
+ *
  * \param uniqDeduct If set, this function will only deduce the column if
  *                   the operand specified in deduceCol only occurs once
  *                   in the source line. Otherwise, it will use the first
  *                   occurrence of the operand in the source line.
  *
  * \param deduceVal  If this is a non-NULL character pointer, then use this
  *                   string for column deduction instead of op1 or op2.
- *                 
+ *
  */
 void
-errWithSrc(error_code_t ecode, enum error_severity sev, int eline, 
-           const char *op1, const char *op2, int col, int deduceCol, 
+errWithSrc(error_code_t ecode, enum error_severity sev, int eline,
+           const char *op1, const char *op2, int col, int deduceCol,
            bool uniqDeduct, const char *deduceVal)
 {
   int i, len;
   char *srcFile = NULL;
-  char * srcLine = NULL;
-  int srcCol=0;
-  int contNo=0;
+  char *srcLine = NULL;
+  int srcCol = 0;
+  int contNo = 0;
 
-  if (!XBIT(1,1)) {
+  if (!XBIT(1, 1)) {
     /* Generate old error messages */
     display_error(ecode, sev, eline, op1, op2, 0, NULL);
     return;
   }
-  if (eline > 0) { 
-    srcLine = get_src_line(eline, &srcFile, col, &srcCol, &contNo); 
-    if (srcFile && (len=strlen(srcFile)) > 0) {
+  if (eline > 0) {
+    srcLine = get_src_line(eline, &srcFile, col, &srcCol, &contNo);
+    if (srcFile && (len = strlen(srcFile)) > 0) {
       /* trim trailing whitespace on srcFile */
-      char * cp;
-      for(cp = (srcFile + (len-1)); cp != srcFile; --cp) {
+      char *cp;
+      for (cp = (srcFile + (len - 1)); cp != srcFile; --cp) {
         if (!isspace(*cp))
           break;
       }
       if (cp != srcFile) {
-        *(cp+1) = '\0';
+        *(cp + 1) = '\0';
       }
-    } 
+    }
     if (deduceCol > 0) {
       /* try to deduce column number */
-      char * op;
-      char * srcLC = strdup(srcLine);
-      char * p;
+      char *op;
+      char *srcLC = strdup(srcLine);
+      char *p;
       if (deduceVal != NULL) {
         op = strdup(deduceVal);
       } else {
         op = strdup((deduceCol == 1) ? op1 : op2);
       }
       len = strlen(srcLC);
-      for(i=0; i < len; ++i) {
+      for (i = 0; i < len; ++i) {
         srcLC[i] = tolower(srcLC[i]);
       }
       len = strlen(op);
-      for(i=0; i < len; ++i) {
+      for (i = 0; i < len; ++i) {
         op[i] = tolower(op[i]);
       }
-      p = strstr(srcLC, op);
+      p = srcCol == 0 ? strstr(srcLC, op) : strstr(srcLC + (srcCol-1), op);
       col = 0;
       if (p != NULL) {
         if (uniqDeduct) {
-          char * q = strstr(p+1, op);
-          if (q == NULL) { 
+          char *q = strstr(p + 1, op);
+          if (q == NULL) {
             /* op only occurs once in srcLine, so we can deduce col */
-            col = (int)(p-srcLC)+1;
+            col = (int)(p - srcLC) + 1;
           }
         } else {
           /* found op in srcLine, so we can deduce col */
-          col = (int)(p-srcLC)+1;
+          col = (int)(p - srcLC) + 1;
         }
       }
       FREE(op);
@@ -595,41 +596,40 @@ errWithSrc(error_code_t ecode, enum error_severity sev, int eline,
   }
   if (!deduceCol || col == 0)
     col = srcCol;
-  display_error(ecode, sev, contNo+eline, op1, op2, col, srcFile);
+  display_error(ecode, sev, contNo + eline, op1, op2, col, srcFile);
   if (col > 0 && srcLine != NULL) {
     LOGICAL isLeadingChars;
     int numLeadingTabs;
     len = strlen(srcLine);
-    for(numLeadingTabs = i = 0, isLeadingChars = TRUE; i < len; ++i) {
-      if (i == (col-1)) {
+    for (numLeadingTabs = i = 0, isLeadingChars = TRUE; i < len; ++i) {
+      if (i == (col - 1)) {
         isLeadingChars = FALSE;
       }
       if (isLeadingChars && srcLine[i] == '\t') {
         /* Keep track of tabs that appear before column number. */
-        fputc('\t',stderr);
+        fputc('\t', stderr);
         ++numLeadingTabs;
       } else if (srcLine[i] == '\n') {
         break;
       } else {
-        fputc(srcLine[i],stderr);
+        fputc(srcLine[i], stderr);
       }
     }
-    fputc('\n',stderr);
+    fputc('\n', stderr);
 
     /* When we first computed col, we counted a tab as one space. So, we need
      * to subtract one from col as we print out the leading tabs.
      */
-    for(i=0; i < numLeadingTabs; ++i) {
-      fputc('\t',stderr);
+    for (i = 0; i < numLeadingTabs; ++i) {
+      fputc('\t', stderr);
     }
     col -= numLeadingTabs;
 
-    for(i=0; i < (col-1); ++i)
-      fputc(' ',stderr);
-    fputs("^\n",stderr);
-  }
-  else {
-    fputc('\n',stderr);
+    for (i = 0; i < (col - 1); ++i)
+      fputc(' ', stderr);
+    fputs("^\n", stderr);
+  } else {
+    fputc('\n', stderr);
   }
   FREE(srcLine);
   FREE(srcFile);

tools/flang1/flang1exe/lowerilm.c

@@ -2084,17 +2084,18 @@ lower_do_stmt(int std, int ast, int lineno, int label)
       ilm = compute_dotrip(std, FALSE, doinitilm, doendilm, doinc,
                            doincilm, dtype, dotrip);
     } else
-    ilm = compute_dotrip(std, doinitast == doincast, doinitilm, doendilm, doinc,
-                         doincilm, dtype, dotrip);
-
-    if (doinc == 0) {
-      /* convert and store in a temp */
-      doinc = dotemp('i', dtype, std);
-      lilm = lower_sptr(doinc, VarBase);
-      lower_typestore(dtype, lilm, doincilm);
+    {
+      ilm = compute_dotrip(std, doinitast == doincast, doinitilm, 
+                           doendilm, doinc, doincilm, dtype, dotrip);
+      if (doinc == 0) {
+        /* convert and store in a temp */
+        doinc = dotemp('i', dtype, std);
+        lilm = lower_sptr(doinc, VarBase);
+        lower_typestore(dtype, lilm, doincilm);
+      }
+      lilm = lower_sptr(dovar, VarBase);
+      lower_typestore(dtype, lilm, doinitilm);
     }
-    lilm = lower_sptr(dovar, VarBase);
-    lower_typestore(dtype, lilm, doinitilm);
     if (!XBIT(34, 0x8000000) && STD_ZTRIP(std) && A_M4G(ast)) {
       /* lower condition ilm */
       int tilm;
@@ -4938,14 +4939,14 @@ lower_stmt(int std, int ast, int lineno, int label)
       ilm = plower("oSniiii", "BTASKLOOP", lab, num, ilm, ilm2, ilm3, ilm4);
     }
     lower_end_stmt(std);
+    lower_push(STKTASK);
+    lower_push(lab); /* label */
     if (A_TYPEG(ast) == A_MP_TASKLOOP) {
       break;
     }
-    lower_push(STKTASK);
-    lower_push(lab); /* label */
 
 
-/* Note: Currentl we store endlabel in A_MP_TASK but A_MP_ETASKREG will pop it
+/* Note: Currently we store endlabel in A_MP_TASK but A_MP_ETASKREG will pop it
  *       This is OK because we always create ast in this order
  *       A_MP_TASK/A_MP_TASKREG - A_MP_ETASKREG/A_MP_ENDTASK
  *       The reason why we want to pop in A_MP_ETASKREG because that
@@ -5130,6 +5131,8 @@ lower_stmt(int std, int ast, int lineno, int label)
     --lowersym.task_depth;
     if (lowersym.parallel_depth == 0 && lowersym.task_depth == 0)
       lowersym.sc = SC_LOCAL;
+    lab = lower_pop();
+    lower_check_stack(STKTASK);
     lower_start_stmt(lineno, label, TRUE, std);
     ilm = plower("oL", "ETASKLOOP", lab);
     lower_end_stmt(std);