Merge pull request #137 from ThePortlandGroup/nv_stage

Pull 2017-07-13T10-32 Recent NVIDIA Changes

Author: sscalpone

README.md

@@ -3,6 +3,14 @@ Flang
 
 Flang is a Fortran compiler targeting LLVM.
 
+We have a flang-compiler channel on Slack.  Slack is invitation only but anyone can join.  Here's the link:
+
+https://join.slack.com/t/flang-compiler/shared_invite/MjExOTEyMzQ3MjIxLTE0OTk4NzQyNzUtODQzZWEyMjkwYw
+
+## Building Flang
+
+We build Flang on Intel x86-64 and OpenPOWER hardware running either Ubuntu or Red Hat.
+
 ## Prerequisites
 
 Building LLVM requires fairly modern compiler toolchain and CMake, check [Getting started with LLVM](http://llvm.org/releases/4.0.0/docs/GettingStarted.html#host-c-toolchain-both-compiler-and-standard-library) and [Building LLVM with CMake][llvm-cmake] for the full list. 

tools/flang1/flang1exe/pgifeat.h

@@ -47,9 +47,9 @@
 #define PG_LM_PLATFORM
 #define TARGET_64BIT 1
 
-                 /*
-                  * 64-bit CPU targets
-                  */
+/*
+ * 64-bit CPU targets
+ */
 #define TARGET_PTRSIZE 8
 
 #if !defined(TARGET_WIN)
@@ -59,6 +59,8 @@
 #define TARGET_LONGSIZE 4
 #endif
 
+/* Uniform structure assigments/moves ILI */
+#define USE_GSMOVE XBIT(2,0x800000)
 
 /* ETLS and threadprivate related features */
 /* By default, prevent ETLS/TLS threadprivate usage */

tools/flang1/flang1exe/semgnr.c

@@ -49,6 +49,7 @@ static void get_type_rank(SST *, int *, int *);
 static ITEM *make_list(SST *, SST *);
 static int resolve_operator(int, SST *, SST *);
 static int find_operator(int, SST *, SST *, LOGICAL);
+static bool queue_generic_tbp_once(SPTR gnr);
 
 /* macros used by the arg scoring routines */
 #define UNIT_SZ 3 /**< bits necessary to hold the max *_MATCH value */
@@ -111,19 +112,25 @@ static struct optabstruct {
 };
 #define OPTABSIZE 29
 
-static int generic_tbp_scope = 0;
-
-static int
-queue_generic_tbp_once()
+/** \brief Determines if we should (re)generate generic type bound procedure
+ *  (tbp) bindings based on scope. This should only be done once per scope.
+ *
+ *  \param gnr is the SPTR of the symbol to check or 0 if N/A.
+ *
+ *  \return true if we should (re)generate generic tbp bindings, else false.
+ */
+static bool 
+queue_generic_tbp_once(SPTR gnr)
 {
-  int rslt;
-  rslt = (generic_tbp_scope != stb.curr_scope);
-  generic_tbp_scope = stb.curr_scope;
-  return rslt;
+  if (GNCNTG(gnr) == 0 || gbl.internal > 1) {
+    static int generic_tbp_scope = 0;
+    bool rslt = (generic_tbp_scope != stb.curr_scope);
+    generic_tbp_scope = stb.curr_scope;
+    return rslt;
+  }
+  return false;
 }
 
-#define QUEUE_GENERIC_TBP_ONCE (queue_generic_tbp_once())
-
 void
 check_generic(int gnr)
 {
@@ -148,7 +155,7 @@ generic_tbp_call(int gnr, SST *stktop, ITEM *list, ITEM *chevlist)
   if (DBGBIT(3, 256))
     fprintf(gbl.dbgfil, "user generic, call %s\n", SYMNAME(gnr));
 #endif
-  if (GNCNTG(gnr) == 0 && QUEUE_GENERIC_TBP_ONCE) {
+  if (queue_generic_tbp_once(gnr)) {
     queue_tbp(0, 0, 0, 0, TBP_COMPLETE_GENERIC);
   }
 
@@ -194,7 +201,7 @@ generic_tbp_func(int gnr, SST *stktop, ITEM *list)
     fprintf(gbl.dbgfil, "user generic %s\n", SYMNAME(gnr));
 #endif
 
-  if (GNCNTG(gnr) == 0 && QUEUE_GENERIC_TBP_ONCE) {
+  if (queue_generic_tbp_once(gnr)) {
     queue_tbp(0, 0, 0, 0, TBP_COMPLETE_GENERIC);
   }
 
@@ -352,7 +359,7 @@ find_best_generic(int gnr, ITEM *list, int arg_cnt, int try_device,
     if (GNCNTG(sptrgen) == 0 && GTYPEG(sptrgen)) {
       continue; /* Could be an overloaded type */
     }
-    if (GNCNTG(sptrgen) == 0 && QUEUE_GENERIC_TBP_ONCE) {
+    if (queue_generic_tbp_once(sptrgen)) {
       queue_tbp(0, 0, 0, 0, TBP_COMPLETE_GENERIC);
     }
     if (GNCNTG(sptrgen) == 0 && !IS_TBP(sptrgen)) {
@@ -840,7 +847,7 @@ defined_operator(int opr, SST *stktop, SST *lop, SST *rop)
   if (DBGBIT(3, 256))
     fprintf(gbl.dbgfil, "user operator %s\n", SYMNAME(opr));
 #endif
-  if (QUEUE_GENERIC_TBP_ONCE)
+  if (queue_generic_tbp_once(0))
     queue_tbp(0, 0, 0, 0, TBP_COMPLETE_GENERIC);
   if (STYPEG(opr) != ST_OPERATOR) {
     i = findByNameStypeScope(SYMNAME(opr), ST_OPERATOR, stb.curr_scope);
@@ -1068,7 +1075,7 @@ is_intrinsic_opr(int val, SST *stktop, SST *lop, SST *rop, int tkn_alias)
   if (opr) {
     func = resolve_operator(opr, lop, rop);
     if (!func && /*IN_MODULE*/ sem.mod_cnt && sem.which_pass) {
-      if (QUEUE_GENERIC_TBP_ONCE)
+      if (queue_generic_tbp_once(0))
         queue_tbp(0, 0, 0, 0, TBP_COMPLETE_GENERIC);
       func = resolve_operator(opr, lop, rop);
     }
@@ -1357,7 +1364,7 @@ check_defined_io2(char *proc, int silentmode, int chk_dtype)
         continue;
       if (GNCNTG(sptrgen) == 0 && GTYPEG(sptrgen))
         continue;
-      if (GNCNTG(sptrgen) == 0 && QUEUE_GENERIC_TBP_ONCE) {
+      if (queue_generic_tbp_once(sptrgen)) {
         queue_tbp(0, 0, 0, 0, TBP_COMPLETE_GENERIC);
       }
 

tools/flang2/docs/xflag.n

@@ -228,6 +228,8 @@ Fill in BIH_LINENO with line numbers on inlined blocks.
 don't use SMOVEI/SMOVES instead of SMOVE in exp_rte.c
 .XB 0x400000
 F90 pointer optimizations.
+.XB 0x800000
+Use GSMOVE in exp_rte.c
 
 .XF "3:" 
 Used to turn on/off various dual-op/dual-inst/pipelined ops.

tools/flang2/flang2exe/exp_ftn.c

@@ -3605,6 +3605,8 @@ exp_misc(ILM_OP opc, ILM *ilmp, int curilm)
       }
     }
     mkrtemp_init();
+    hostsptr = 0;
+    devsptr = 0;
     break;
 
   case IM_ENTRY:

tools/flang2/flang2exe/exp_rte.c

@@ -59,6 +59,7 @@ static void cp_byval_mem_arg(int);
 static int allochartmp(int lenili);
 static int block_str_move(STRDESC *, STRDESC *);
 static int getchartmp(int ili);
+static void _exp_smove(int, int, int, int, DTYPE);
 
 void arg_is_refd(int); /* FIXME? move from llassem.c? */
 
@@ -132,6 +133,21 @@ getstrlen64(STRDESC *str)
   return il;
 }
 
+/*
+ * Generating GSMOVE ILI is under XBIT(2,0x800000). When the XBIT is not
+ * set, _exp_smove() will proceed as before; in particular, chk_block() is
+ * called to add terminal ILI to the block current to the expander.   When
+ * the XBIT is set, the GSMOVE ili are transformed sometime after the expander,
+ * but we still want the code in _exp_smove() to do the work. However, we
+ * cannot call chk_block() to add the terminal ILI; we must use 'addilt'.
+ * So, define and use a function pointer, p_chk_block, which calls either
+ * chk_block() or a new local addilit routine, gsmove_chk_block().  In this
+ * case, the current ilt is saved as the file static, gsmove_ilt.
+ */
+static void (*p_chk_block)(int) = chk_block;
+static void gsmove_chk_block(int);
+static int  gsmove_ilt;
+
 /* aux.curr_entry->flags description:
  *     Initialized to 0 by exp_end
  * NA      0x1  -  need to save argument registers  (set by exp_end).
@@ -4202,6 +4218,61 @@ expand_smove(int destilm, int srcilm, DTYPE dtype)
   }
   dest_addr = ILI_OF(destilm);
   src_addr = ILI_OF(srcilm);
+  if (USE_GSMOVE) {
+     int ilix;
+     ilix = ad5ili(IL_GSMOVE, src_addr, dest_addr, src_nme, dest_nme, dtype);
+     chk_block(ilix);
+  }
+  else {
+    _exp_smove(dest_nme, src_nme, dest_addr, src_addr, dtype);
+  }
+}
+
+/** \brief Transform the GSMOVE ILI created by expand_smove()
+  */
+void
+exp_remove_gsmove(void)
+{
+  int bihx, iltx, ilix;
+  p_chk_block = gsmove_chk_block;
+  for (bihx = gbl.entbih; bihx; bihx = BIH_NEXT(bihx)) {
+    int next_ilt;
+    LOGICAL any_gsmove = FALSE;
+    rdilts(bihx);
+    for (iltx = ILT_NEXT(0); iltx; ) {
+      next_ilt = ILT_NEXT(iltx);
+      ilix = ILT_ILIP(iltx);
+      if (ILI_OPC(ilix) == IL_GSMOVE) {
+        int src_addr  = ILI_OPND(ilix, 1);
+        int dest_addr = ILI_OPND(ilix, 2);
+        int src_nme   = ILI_OPND(ilix, 3);
+        int dest_nme  = ILI_OPND(ilix, 4);
+        DTYPE dtype   = ILI_OPND(ilix, 5);
+        any_gsmove = TRUE;
+        gsmove_ilt = iltx;
+        _exp_smove(dest_nme, src_nme, dest_addr, src_addr, dtype);
+        ILT_NEXT(gsmove_ilt) = next_ilt;
+        ILT_PREV(next_ilt) = gsmove_ilt;
+	delilt(iltx);
+      }
+      iltx = next_ilt;
+    }
+    wrilts(bihx);
+    if (DBGBIT(10,2) && any_gsmove) {
+      fprintf(gbl.dbgfil, "\n***** After remove gsmove *****\n");
+      dump_one_block(gbl.dbgfil, bihx, NULL);
+    }
+  }
+  p_chk_block = chk_block;
+}
+
+static void
+_exp_smove(int dest_nme, int src_nme, int dest_addr, int src_addr, DTYPE dtype)
+{
+  ISZ_T n;        /* number of bytes left to copy		*/
+  int i;
+  INT offset; /* number of bytes from begin addr 	*/
+
   n = size_of(dtype);
   offset = 0;
 
@@ -4211,10 +4282,10 @@ expand_smove(int destilm, int srcilm, DTYPE dtype)
   if (n > TEST_BOUND) {
 
     if (XBIT(2, 0x200000)) {
-      chk_block(ad4ili(IL_SMOVE, src_addr, dest_addr, ad_aconi(n / SMOVE_CHUNK),
+      p_chk_block(ad4ili(IL_SMOVE, src_addr, dest_addr, ad_aconi(n / SMOVE_CHUNK),
                        dest_nme));
     } else {
-      chk_block(ad4ili(IL_SMOVEI, ad2ili(IL_SMOVES, src_addr, src_nme),
+      p_chk_block(ad4ili(IL_SMOVEI, ad2ili(IL_SMOVES, src_addr, src_nme),
                        dest_addr, n, dest_nme));
     }
     smove_flag = 1; /* structure move in this function */
@@ -4255,7 +4326,7 @@ expand_smove(int destilm, int srcilm, DTYPE dtype)
         ilip = ad4ili(IL_STKR, ilix, ilip, dest_nme, siz);
       else
         ilip = ad4ili(IL_ST, ilix, ilip, dest_nme, siz);
-      chk_block(ilip);
+      p_chk_block(ilip);
 
       offset += skip;
       n -= skip;
@@ -5317,6 +5388,15 @@ exp_reset_argregs(int ir, int fr)
 {
 }
 
+/**
+ * \brief Create & add an ILT for an ILI when transforming GSMOVE ILI
+ */
+static void
+gsmove_chk_block(int ili)
+{
+  gsmove_ilt = addilt(gsmove_ilt, ili);
+}
+
 /*------------------------------------------------------------------*/
 
 #undef ILM_OPC

tools/flang2/flang2exe/expand.c

@@ -68,7 +68,7 @@ static int efunc(char *);
  * Initialize global data structures
  */
 void
-ds_init()
+ds_init(void)
 {
   int i;
   ili_init();
@@ -94,7 +94,7 @@ ds_init()
 } /* ds_init */
 
 void
-exp_init()
+exp_init(void)
 {
   /*
    * Allocate the space necessary to hold the auxiliary information for ILM
@@ -155,7 +155,7 @@ exp_init()
  * clean up allocated space when the program isn't compiled
  */
 void
-exp_cleanup()
+exp_cleanup(void)
 {
   if (rgsetb.stg_base)
     EXP_FREE(rgsetb);

tools/flang2/flang2exe/expand.h

@@ -267,6 +267,7 @@ void exp_qjsr(char *, int, ILM *, int);
 void exp_estmt(int);
 void exp_label(int);
 void expand_smove(int, int, DTYPE);
+void exp_remove_gsmove(void);
 void exp_load(ILM_OP, ILM *, int);
 void exp_store(ILM_OP, ILM *, int);
 void exp_misc(ILM_OP, ILM *, int);

tools/flang2/flang2exe/iliutil.c

@@ -1363,9 +1363,10 @@ ldst_msz(DTYPE dtype, ILI_OP *ld, ILI_OP *st, MSZ* siz)
     *ld = IL_LDDP;
     *st = IL_STDP;
     break;
+  default:
+    break;
   }
 
-
 }
 
 

tools/flang2/flang2exe/pgifeat.h

@@ -47,9 +47,9 @@
 #define PG_LM_PLATFORM
 #define TARGET_64BIT 1
 
-                 /*
-                  * 64-bit CPU targets
-                  */
+/*
+ * 64-bit CPU targets
+ */
 #define TARGET_PTRSIZE 8
 
 #if !defined(TARGET_WIN)
@@ -59,6 +59,8 @@
 #define TARGET_LONGSIZE 4
 #endif
 
+/* Uniform structure assigments/moves ILI */
+#define USE_GSMOVE XBIT(2,0x800000)
 
 /* ETLS and threadprivate related features */
 /* By default, prevent ETLS/TLS threadprivate usage */