Skip to content
Permalink
Browse files

Front-end support for real(2)

This change contains the majority of infrastructure
to support real2 handling in the frontend.

Adding ILMs and ILIs for real2 operations:
ILM: R2HF, HF2R, HFLD, HFST, HFCON, HFADD, HFMUL, HFSUB,
     HFDIV, HFNEG, HFFUNC, HFCMP, HFAIF
ILI: HFADD, HFNEG, HFSUB, HFMUL, HFDIV, HFCMP, DFRHP,
     HFCON, LDHP, HP2SP, SP2HP, STHP, ARGHP, CSEHP,
     HFCMPZ, HFCJMP, HFCJMPZ
  • Loading branch information...
gklimowicz committed Jun 12, 2019
1 parent d75521f commit a4012a93a3d9efebe5de1289d8900decf515fb2b
@@ -1,5 +1,5 @@
.\"/*
.\" * Copyright (c) 2010-2018, NVIDIA CORPORATION. All rights reserved.
.\" * Copyright (c) 2010-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.
@@ -28,3 +28,4 @@ We have one spot for the preinclude file in the gbl. structure. This is not
a user visible switch.
.MS F 704 "Compilation aborted due to previous errors."
Compilation will abort immediately in case of Severe or Fatal error.
.MS F 705 "Half precision implementation missing support - $"
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2002-2018, NVIDIA CORPORATION. All rights reserved.
* Copyright (c) 2002-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.
@@ -1511,11 +1511,11 @@ F90_Desc *I8(__fort_inherit_template)(F90_Desc *d, __INT_T rank,

proc *__fort_defaultproc(int rank);

proc *__fort_localproc();
proc *__fort_localproc(void);

int __fort_myprocnum();
int __fort_myprocnum(void);

int __fort_is_ioproc();
int __fort_is_ioproc(void);

int I8(__fort_owner)(F90_Desc *d, __INT_T *gidx);

@@ -1716,7 +1716,7 @@ void __fort_initndx( int nd, int *cnts, int *ncnts, int *strs, int *nstrs,

int __fort_findndx( int cpu, int nd, int low, int *nstrs, int *mults);

void __fort_barrier();
void __fort_barrier(void);

void __fort_par_unlink(char *fn);

@@ -1,5 +1,5 @@
/*
* Copyright (c) 1995-2018, NVIDIA CORPORATION. All rights reserved.
* Copyright (c) 1995-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.
@@ -62,6 +62,7 @@ typedef enum {
__INT2 = 24, /**< Fortran integer*2 */
__INT4 = 25, /**< Fortran integer*4, integer */
__INT8 = 26, /**< Fortran integer*8 */
__REAL2 = 45, /**< Fortran real*2, half */
__REAL4 = 27, /**< Fortran real*4, real */
__REAL8 = 28, /**< Fortran real*8, double precision */
__REAL16 = 29, /**< Fortran real*16 */
@@ -91,7 +92,7 @@ typedef enum {
* runtime descriptor types cannot change. Therefore, new values will
* be added after any current values.
*/
#define __NTYPES 45
#define __NTYPES 46

} _DIST_TYPE;

@@ -152,6 +153,8 @@ typedef unsigned int __INT4_UT;
typedef long __INT8_T; /* 26 __INT8 integer*8 */
typedef unsigned long __INT8_UT;

typedef unsigned short __REAL2_T; /* 45 __REAL2 real*2 */

typedef float __REAL4_T; /* 27 __REAL4 real*4 */

typedef double __REAL8_T; /* 28 __REAL8 real*8 */
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2015, NVIDIA CORPORATION. All rights reserved.
* Copyright (c) 2015-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.
@@ -20,6 +20,35 @@

extern int __hpf_lcpu;

void
checkh_(short* res, short* exp, int* np)
{
int i;
int n = *np;
int tests_passed = 0;
int tests_failed = 0;

for (i = 0; i < n; i++) {
if (exp[i] & (~ res[i])) {
tests_failed ++;
if( tests_failed < 100 )
printf(
"test number %d FAILED. res %u(%04x) exp %u(%04x)\n",
i+1,res[i], res[i], exp[i], exp[i] );
} else {
tests_passed ++;
}
}
if (tests_failed == 0) {
printf(
"%3d tests completed. %d tests PASSED. %d tests failed.\n",
n, tests_passed, tests_failed);
} else {
printf("%3d tests completed. %d tests passed. %d tests FAILED.\n",
n, tests_passed, tests_failed);
}
}

void
check_(int* res, int* exp, int* np)
{
@@ -1199,6 +1199,7 @@ int
alignment(DTYPE dtype)
{
TY_KIND ty = get_ty_kind(dtype);
int align_val;

switch (ty) {
case TY_DWORD:
@@ -1221,6 +1222,7 @@ alignment(DTYPE dtype)
case TY_CHAR:
case TY_NCHAR:
case TY_PTR:
case TY_HALF:
return dtypeinfo[ty].align;
case TY_INT8:
case TY_LOG8:
@@ -1229,7 +1231,8 @@ alignment(DTYPE dtype)
return dtypeinfo[ty].align;

case TY_ARRAY:
return alignment((int)DTY(dtype + 1));
align_val = alignment((int)DTY(dtype + 1));
return align_val;

case TY_STRUCT:
case TY_UNION:
@@ -1300,6 +1303,7 @@ bits_in(DTYPE dtype)
case TY_INT8:
case TY_LOG8:
case TY_PTR:
case TY_HALF:
return dtypeinfo[ty].bits;

default:
@@ -2676,6 +2680,7 @@ dlen(int ty)
case TY_LOG128:
case TY_FLOAT128:
case TY_CMPLX128:
case TY_HALF:
return 1;

case TY_CHAR:
@@ -2745,6 +2750,7 @@ _dmp_dent(DTYPE dtypeind, FILE *outfile)
case TY_LOG128:
case TY_FLOAT128:
case TY_CMPLX128:
case TY_HALF:
retval = 1;
break;

@@ -3400,6 +3406,7 @@ typedef enum {
__INT2 = 24, /* F integer*2 */
__INT4 = 25, /* F integer*4, integer */
__INT8 = 26, /* F integer*8 */
__REAL2 = 45, /* F real*2, half */
__REAL4 = 27, /* F real*4, real */
__REAL8 = 28, /* F real*8, double precision */
__REAL16 = 29, /* F real*16 */
@@ -3423,9 +3430,10 @@ typedef enum {
__QREAL16 = 41, /* F real(16) */
__QCPLX32 = 42, /* F complex(32) */
__POLY = 43, /* F polymorphic variable */
__PROCPTR = 44, /* F procedure pointer descriptor */

/* number of data types */
__NTYPES = 44 /* MUST BE LAST */
__NTYPES = 46 /* MUST BE LAST */

} _pghpf_type;

@@ -3438,7 +3446,7 @@ int ty_to_lib[] = {
__INT2, /* TY_SINT */
__INT4, /* TY_INT */
__INT8, /* TY_INT8 */
__REAL4, /* TY_HALF */
__REAL2, /* TY_HALF */
__REAL4, /* TY_REAL */
__REAL8, /* TY_DBLE */
__REAL16, /* TY_QUAD */
@@ -3761,17 +3769,19 @@ get_len_set_parm(int sptr, DTYPE dtype, int *val)
void
chkstruct(DTYPE dtype)
{
int m, m_prev = NOSYM, m_next = NOSYM;
ISZ_T symlk;

if (DTY(dtype) == TY_STRUCT || DTY(dtype) == TY_DERIVED) {
int offset = 0; /* byte offset from beginning of struct */
int maxa = 0; /* maximum alignment req'd by any member */
int distmem = 0; /* any distributed members? */
int ptrmem = 0; /* any pointer members? */
int m;
ISZ_T symlk;

for (m = DTY(dtype + 1); m != NOSYM; m = symlk) {
for (m = DTY(dtype + 1); m != NOSYM; m_prev = m, m = symlk) {
int oldoffset, a;
symlk = SYMLKG(m);
m_next = symlk;
if (DTYPEG(m) == DT_NONE) {
continue; /* Occurs w/ empty typedef */
}
@@ -3833,10 +3843,11 @@ chkstruct(DTYPE dtype)
*/
int maxa = 0;
ISZ_T size = 1;
int m;
assert(DTY(dtype) == TY_UNION && DTY(dtype + 1), "chkstruct:bad dt", dtype,
3);
for (m = DTY(dtype + 1); m != NOSYM; m = SYMLKG(m)) {
for (m = DTY(dtype + 1); m != NOSYM; m_prev = m, m = symlk) {
symlk = SYMLKG(m);
m_next = symlk;
ISZ_T s = size_of_var(m);
int a = alignment_of_var(m);
if (s > size)
@@ -1826,83 +1826,84 @@ semant2(int rednum, SST *top)
ast_conval(top);
}
break;

/*
* <constant> ::= <real> |
*/

case CONSTANT3:
case CONSTANT4:
SST_DTYPEP(LHS, DT_REAL4);
/* value set by scan */
ast_conval(top);
break;
/*
* <constant> ::= <double> |
*/
case CONSTANT4:
case CONSTANT5:
SST_DTYPEP(LHS, DT_REAL8);
/* value set by scan */
ast_cnst(top);
break;
/*
* <constant> ::= <quad> |
*/
case CONSTANT5:
case CONSTANT6:
SST_DTYPEP(LHS, DT_QUAD);
/* value set by scan */
ast_cnst(top);
break;
/*
* <constant> ::= <complex> |
*/
case CONSTANT6:
case CONSTANT7:
SST_DTYPEP(LHS, DT_CMPLX8);
/* value set by scan */
ast_cnst(top);
break;
/*
* <constant> ::= <dcomplex> |
*/
case CONSTANT7:
case CONSTANT8:
SST_DTYPEP(LHS, DT_CMPLX16);
/* value set by scan */
ast_cnst(top);
break;
/*
* <constant> ::= <qcomplex> |
*/
case CONSTANT8:
case CONSTANT9:
SST_DTYPEP(LHS, DT_QCMPLX);
/* value set by scan */
ast_cnst(top);
break;
/*
* <constant> ::= <nondec const> |
*/
case CONSTANT9:
case CONSTANT10:
SST_DTYPEP(LHS, DT_WORD);
/* value set by scan */
ast_conval(top);
break;
/*
* <constant> ::= <nonddec const> |
*/
case CONSTANT10:
case CONSTANT11:
SST_DTYPEP(LHS, DT_DWORD);
/* value set by scan */
ast_cnst(top);
break;
/*
* <constant> ::= <Hollerith> |
*/
case CONSTANT11:
case CONSTANT12:
SST_DTYPEP(LHS, DT_HOLL);
/* value set by scan */
ast_cnst(top);
break;
/*
* <constant> ::= <log const> |
*/
case CONSTANT12:
case CONSTANT13:
if (DTY(stb.user.dt_log) == TY_LOG8) {
if ((INT)SST_CVALG(RHS(1)) == SCFTN_FALSE)
val[0] = val[1] = 0;
@@ -1924,7 +1925,7 @@ semant2(int rednum, SST *top)
/*
* <constant> ::= <log kind const> |
*/
case CONSTANT13:
case CONSTANT14:
/* token value of <log kind const> is an ST_CONST entry */
sptr = SST_CVALG(RHS(1));
dtype = DTYPEG(sptr);
@@ -1939,13 +1940,13 @@ semant2(int rednum, SST *top)
/*
* <constant> ::= <char literal>
*/
case CONSTANT14:
case CONSTANT15:
break;

/*
* <constant> ::= <kanji string> |
*/
case CONSTANT15:
case CONSTANT16:
/* compute number of Kanji chars in string: */
sptr = SST_SYMG(RHS(1)); /* ST_CONST/TY_CHAR */
i = string_length(DTYPEG(sptr)); /* length of string const */
@@ -1960,7 +1961,7 @@ semant2(int rednum, SST *top)
/*
* <constant> ::= <elp> <expression> <cmplx comma> <expression> )
*/
case CONSTANT16:
case CONSTANT17:
/*
* special production to allow complex constants to be formed from
* "general" real & imag expressions which evaluate to constants.
@@ -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.
@@ -6149,6 +6149,8 @@ getWriteByDtypeRtn(int dtype, FormatType fmttyp)
rtlRtn = (fmttyp == FT_LIST_DIRECTED) ? RTE_f90io_sc_i_ldw
: RTE_f90io_sc_i_fmt_write;
break;
case DT_BLOG:
case DT_SLOG:
case DT_LOG4:
rtlRtn = (fmttyp == FT_LIST_DIRECTED) ? RTE_f90io_sc_i_ldw
: RTE_f90io_sc_i_fmt_write;

0 comments on commit a4012a9

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