G-format compilers for Ultrix/Unix Vaxes (3 of 4)

sources-request at panda.UUCP sources-request at panda.UUCP
Mon Nov 11 07:04:19 AEST 1985


Mod.sources:  Volume 3, Issue 39
Submitted by: J.D.Aplevich <decvax!watmath!watdcsu!aplevich>


#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	gfloat
# This archive created: Wed Oct 30 10:33:37 1985
export PATH; PATH=/bin:$PATH
if test ! -d 'gfloat'
then
	mkdir 'gfloat'
fi
cd 'gfloat'
if test ! -d 'f77'
then
	mkdir 'f77'
fi
cd 'f77'
if test ! -d 'src'
then
	mkdir 'src'
fi
cd 'src'
if test ! -d 'f77pass1'
then
	mkdir 'f77pass1'
fi
cd 'f77pass1'
if test -f 'bb.c.diff'
then
	echo shar: over-writing existing file "'bb.c.diff'"
fi
cat << \SHAR_EOF > 'bb.c.diff'
*** ../f77/src/f77pass1/bb.c.orig	Tue Oct 29 15:15:44 1985
--- ../f77/src/f77pass1/bb.c	Tue Oct 29 15:22:15 1985
***************
*** 717,722
                   }
                else  if( ISINT(type) )
                     fprintf(diagfile," ci= %d\n",p->constblock.const.ci); 
                else if( ISREAL(type) )
                     fprintf(diagfile," cd[0]= %e\n",p->constblock.const.cd[0]);
                else fprintf(diagfile," cd[0]= %e  cd[1]= %e\n",

--- 717,726 -----
                   }
                else  if( ISINT(type) )
                     fprintf(diagfile," ci= %d\n",p->constblock.const.ci); 
+ #ifdef GFLOAT
+               else if( ISREAL(type) && type==TYREAL)
+                    fprintf(diagfile," cr[0]= %e\n",p->constblock.const.cr[0]);
+ #endif GFLOAT
                else if( ISREAL(type) )
                     fprintf(diagfile," cd[0]= %e\n",p->constblock.const.cd[0]);
                else fprintf(diagfile," cd[0]= %e  cd[1]= %e\n",
SHAR_EOF
chmod +x 'bb.c.diff'
if test -f 'conv.c.diff'
then
	echo shar: over-writing existing file "'conv.c.diff'"
fi
cat << \SHAR_EOF > 'conv.c.diff'
*** ../f77/src/f77pass1/conv.c.orig	Tue Oct 29 15:15:46 1985
--- ../f77/src/f77pass1/conv.c	Tue Oct 29 15:22:23 1985
***************
*** 53,59
  
  
  /*  The following constants are used to check the limits of  */
! /*  conversions.  Dmaxword is the largest double precision   */
  /*  number which can be converted to a two-byte integer      */
  /*  without overflow.  Dminword is the smallest double       */
  /*  precision value which can be converted to a two-byte     */

--- 53,61 -----
  
  
  /*  The following constants are used to check the limits of  */
! /*  conversions.			                     */
! 
! /*  Dmaxword is the largest double precision   	             */
  /*  number which can be converted to a two-byte integer      */
  /*  without overflow.  Dminword is the smallest double       */
  /*  precision value which can be converted to a two-byte     */
***************
*** 57,66
  /*  number which can be converted to a two-byte integer      */
  /*  without overflow.  Dminword is the smallest double       */
  /*  precision value which can be converted to a two-byte     */
! /*  integer without overflow.  Dmaxint and dminint are the   */
! /*  analogous values for four-byte integers.                 */
! 
! 
  LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  

--- 59,66 -----
  /*  number which can be converted to a two-byte integer      */
  /*  without overflow.  Dminword is the smallest double       */
  /*  precision value which can be converted to a two-byte     */
! /*  integer without overflow.                                */
! #ifndef GFLOAT
  LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  #else GFLOAT
***************
*** 63,68
  
  LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  
  LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };

--- 63,72 -----
  #ifndef GFLOAT
  LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
+ #else GFLOAT
+ LOCAL long dmaxword[] = { 0xffdf40ff, 0xffffffff };
+ LOCAL long dminword[] = { 0x0010c100, 0x00000000 };
+ #endif GFLOAT
  
  /*  Dmaxint and dminint are the limits for double values     */
  /*  converted to four-byte integers.                         */
***************
*** 64,69
  LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  
  LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  

--- 68,79 -----
  LOCAL long dminword[] = { 0x0010c100, 0x00000000 };
  #endif GFLOAT
  
+ /*  Dmaxint and dminint are the limits for double values     */
+ /*  converted to four-byte integers.                         */
+ #ifdef GFLOAT
+ LOCAL long dmaxint[]  = { 0xffff41ff, 0xffffffdf };
+ LOCAL long dminint[]  = { 0x0000c200, 0xffff0010 };
+ #else GFLOAT
  LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  #endif GFLOAT
***************
*** 66,71
  
  LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  
  LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };

--- 76,82 -----
  #else GFLOAT
  LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
+ #endif GFLOAT
  
  #ifndef GFLOAT
  LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
***************
*** 67,72
  LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  
  LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  

--- 78,84 -----
  LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  #endif GFLOAT
  
+ #ifndef GFLOAT
  LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  #else GFLOAT
***************
*** 69,74
  
  LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  
  
  

--- 81,89 -----
  #ifndef GFLOAT
  LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
+ #else GFLOAT
+ LOCAL long dmaxreal[] = { 0xffff47f7, 0xffffffff };
+ LOCAL long dminreal[] = { 0xffffc7f7, 0xffffffff };
  
  /*  Fmaxword and fminword are limits for float to short.     */
  LOCAL long fmaxword[] = { 0xff7f47ff };
***************
*** 70,75
  LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  
  
  
  /*  The routines which follow are used to convert  */

--- 85,98 -----
  LOCAL long dmaxreal[] = { 0xffff47f7, 0xffffffff };
  LOCAL long dminreal[] = { 0xffffc7f7, 0xffffffff };
  
+ /*  Fmaxword and fminword are limits for float to short.     */
+ LOCAL long fmaxword[] = { 0xff7f47ff };
+ LOCAL long fminword[] = { 0x00ffc800 };
+ 
+ /*  Fmaxint and fminint are the limits for float to int.     */
+ LOCAL long fmaxint[]  = { 0xffff4fff };
+ LOCAL long fminint[]  = { 0x0000d000 };
+ #endif GFLOAT
  
  
  /*  The routines which follow are used to convert  */
***************
*** 188,193
    register long *rp;
    register double *minp;
    register double *maxp;
    realvalue x;
  
    switch (cp->vtype)

--- 211,220 -----
    register long *rp;
    register double *minp;
    register double *maxp;
+ #ifdef GFLOAT
+   register float *minpf;
+   register float *maxpf;
+ #endif GFLOAT
    realvalue x;
  
    switch (cp->vtype)
***************
*** 222,227
        break;
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:

--- 249,255 -----
        break;
  
      case TYREAL:
+ #ifndef GFLOAT
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
***************
*** 223,228
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        minp = (double *) dminword;

--- 251,257 -----
      case TYREAL:
  #ifndef GFLOAT
      case TYDREAL:
+ #endif GFLOAT
      case TYCOMPLEX:
  #ifdef GFLOAT
        minpf = (float *) fminword;
***************
*** 224,229
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        minp = (double *) dminword;
        maxp = (double *) dmaxword;

--- 253,290 -----
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
+ #ifdef GFLOAT
+       minpf = (float *) fminword;
+       maxpf = (float *) fmaxword;
+       rp = (long *) &(cp->const.cr[0]);
+       x.q.word1 = rp[0];
+       if (x.f.sign == 1 && x.f.exp == 0)
+ 	{
+ 	  if (badvalue <= 1)
+ 	    {
+ 	      badvalue = 2;
+ 	      err(reserved);
+ 	    }
+ 	  p = errnode();
+ 	}
+       else if ((float) x.q.word1 >= *minpf && (float) x.q.word1 <= *maxpf)
+ 	{
+ 	  p = (expptr) mkconst(TYSHORT);
+ 	  p->constblock.const.ci = x.q.word1;
+ 	}
+       else
+ 	{
+ 	  if (badvalue <= 1)
+ 	    {
+ 	      badvalue = 2;
+ 	      err(toobig);
+ 	    }
+ 	  p = errnode();
+ 	}
+       break;
+ 
+     case TYDREAL:
+ #endif GFLOAT
      case TYDCOMPLEX:
        minp = (double *) dminword;
        maxp = (double *) dmaxword;
***************
*** 230,235
        rp = (long *) &(cp->const.cd[0]);
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
        if (x.f.sign == 1 && x.f.exp == 0)
  	{
  	  if (badvalue <= 1)

--- 291,297 -----
        rp = (long *) &(cp->const.cd[0]);
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
+ #ifndef GFLOAT
        if (x.f.sign == 1 && x.f.exp == 0)
  #else GFLOAT
        if (x.g.sign == 1 && x.g.exp == 0)
***************
*** 231,236
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
        if (x.f.sign == 1 && x.f.exp == 0)
  	{
  	  if (badvalue <= 1)
  	    {

--- 293,301 -----
        x.q.word2 = rp[1];
  #ifndef GFLOAT
        if (x.f.sign == 1 && x.f.exp == 0)
+ #else GFLOAT
+       if (x.g.sign == 1 && x.g.exp == 0)
+ #endif GFLOAT
  	{
  	  if (badvalue <= 1)
  	    {
***************
*** 302,307
    register long *rp;
    register double *minp;
    register double *maxp;
    realvalue x;
  
    switch (cp->vtype)

--- 367,376 -----
    register long *rp;
    register double *minp;
    register double *maxp;
+ #ifdef GFLOAT
+   register float *minpf;
+   register float *maxpf;
+ #endif GFLOAT
    realvalue x;
  
    switch (cp->vtype)
***************
*** 323,328
        break;
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:

--- 392,398 -----
        break;
  
      case TYREAL:
+ #ifndef GFLOAT
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
***************
*** 324,329
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        minp = (double *) dminint;

--- 394,400 -----
      case TYREAL:
  #ifndef GFLOAT
      case TYDREAL:
+ #endif GFLOAT
      case TYCOMPLEX:
  #ifdef GFLOAT
        minpf = (float *) fminint;
***************
*** 325,330
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        minp = (double *) dminint;
        maxp = (double *) dmaxint;

--- 396,432 -----
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
+ #ifdef GFLOAT
+       minpf = (float *) fminint;
+       maxpf = (float *) fmaxint;
+       x.q.word1 = *((long *) &cp->const.cr[0]);
+       if (x.f.sign == 1 && x.f.exp == 0)
+ 	{
+ 	  if (badvalue <= 1)
+ 	    {
+ 	      badvalue = 2;
+ 	      err(reserved);
+ 	    }
+ 	  p = errnode();
+ 	}
+       else if (cp->const.cr[0] >= *minpf && cp->const.cr[0] <= *maxpf)
+ 	{
+ 	  p = (expptr) mkconst(TYLONG);
+ 	  p->constblock.const.ci = cp->const.cr[0];
+ 	}
+       else
+ 	{
+ 	  if (badvalue <= 1)
+ 	    {
+ 	      badvalue = 2;
+ 	      err(toobig);
+ 	    }
+ 	  p = errnode();
+ 	}
+       break;
+ 
+     case TYDREAL:
+ #endif GFLOAT
      case TYDCOMPLEX:
        minp = (double *) dminint;
        maxp = (double *) dmaxint;
***************
*** 331,336
        rp = (long *) &(cp->const.cd[0]);
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
        if (x.f.sign == 1 && x.f.exp == 0)
  	{
  	  if (badvalue <= 1)

--- 433,439 -----
        rp = (long *) &(cp->const.cd[0]);
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
+ #ifndef GFLOAT
        if (x.f.sign == 1 && x.f.exp == 0)
  #else GFLOAT
        if (x.g.sign == 1 && x.g.exp == 0)
***************
*** 332,337
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
        if (x.f.sign == 1 && x.f.exp == 0)
  	{
  	  if (badvalue <= 1)
  	    {

--- 435,443 -----
        x.q.word2 = rp[1];
  #ifndef GFLOAT
        if (x.f.sign == 1 && x.f.exp == 0)
+ #else GFLOAT
+       if (x.g.sign == 1 && x.g.exp == 0)
+ #endif GFLOAT
  	{
  	  if (badvalue <= 1)
  	    {
***************
*** 403,408
    register double *minp;
    register double *maxp;
    realvalue x;
    float y;
  
    switch (cp->vtype)

--- 509,515 -----
    register double *minp;
    register double *maxp;
    realvalue x;
+ #ifndef GFLOAT
    float y;
  #endif GFLOAT
  
***************
*** 404,409
    register double *maxp;
    realvalue x;
    float y;
  
    switch (cp->vtype)
      {

--- 511,517 -----
    realvalue x;
  #ifndef GFLOAT
    float y;
+ #endif GFLOAT
  
    switch (cp->vtype)
      {
***************
*** 418,423
      case TYSHORT:
      case TYLONG:
        p = (expptr) mkconst(TYREAL);
        p->constblock.const.cd[0] = cp->const.ci;
        break;
  

--- 526,532 -----
      case TYSHORT:
      case TYLONG:
        p = (expptr) mkconst(TYREAL);
+ #ifndef GFLOAT
        p->constblock.const.cd[0] = cp->const.ci;
  #else GFLOAT
        p->constblock.const.cr[0] = cp->const.ci;
***************
*** 419,424
      case TYLONG:
        p = (expptr) mkconst(TYREAL);
        p->constblock.const.cd[0] = cp->const.ci;
        break;
  
      case TYREAL:

--- 528,536 -----
        p = (expptr) mkconst(TYREAL);
  #ifndef GFLOAT
        p->constblock.const.cd[0] = cp->const.ci;
+ #else GFLOAT
+       p->constblock.const.cr[0] = cp->const.ci;
+ #endif GFLOAT
        break;
  
      case TYREAL:
***************
*** 422,427
        break;
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:

--- 534,540 -----
        break;
  
      case TYREAL:
+ #ifndef GFLOAT
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
***************
*** 423,428
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        minp = (double *) dminreal;

--- 536,542 -----
      case TYREAL:
  #ifndef GFLOAT
      case TYDREAL:
+ #endif GFLOAT
      case TYCOMPLEX:
  #ifdef GFLOAT
        p = (expptr) mkconst(TYREAL);
***************
*** 424,429
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        minp = (double *) dminreal;
        maxp = (double *) dmaxreal;

--- 538,550 -----
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
+ #ifdef GFLOAT
+       p = (expptr) mkconst(TYREAL);
+       p->constblock.const.cr[0] = cp->const.cr[0];
+       break;
+ 
+     case TYDREAL:
+ #endif GFLOAT
      case TYDCOMPLEX:
        minp = (double *) dminreal;
        maxp = (double *) dmaxreal;
***************
*** 430,435
        rp = (long *) &(cp->const.cd[0]);
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
        if (x.f.sign == 1 && x.f.exp == 0)
  	{
  	  p = (expptr) mkconst(TYREAL);

--- 551,557 -----
        rp = (long *) &(cp->const.cd[0]);
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
+ #ifndef GFLOAT
        if (x.f.sign == 1 && x.f.exp == 0)
  #else GFLOAT
        if (x.g.sign == 1 && x.g.exp == 0)
***************
*** 431,436
        x.q.word1 = rp[0];
        x.q.word2 = rp[1];
        if (x.f.sign == 1 && x.f.exp == 0)
  	{
  	  p = (expptr) mkconst(TYREAL);
  	  rp = (long *) &(p->constblock.const.cd[0]);

--- 553,561 -----
        x.q.word2 = rp[1];
  #ifndef GFLOAT
        if (x.f.sign == 1 && x.f.exp == 0)
+ #else GFLOAT
+       if (x.g.sign == 1 && x.g.exp == 0)
+ #endif GFLOAT
  	{
  	  p = (expptr) mkconst(TYREAL);
  #ifndef GFLOAT
***************
*** 433,438
        if (x.f.sign == 1 && x.f.exp == 0)
  	{
  	  p = (expptr) mkconst(TYREAL);
  	  rp = (long *) &(p->constblock.const.cd[0]);
  	  rp[0] = x.q.word1;
  	}

--- 558,564 -----
  #endif GFLOAT
  	{
  	  p = (expptr) mkconst(TYREAL);
+ #ifndef GFLOAT
  	  rp = (long *) &(p->constblock.const.cd[0]);
  	  rp[0] = x.q.word1;
  #else GFLOAT
***************
*** 435,440
  	  p = (expptr) mkconst(TYREAL);
  	  rp = (long *) &(p->constblock.const.cd[0]);
  	  rp[0] = x.q.word1;
  	}
        else if (x.d >= *minp && x.d <= *maxp)
  	{

--- 561,570 -----
  #ifndef GFLOAT
  	  rp = (long *) &(p->constblock.const.cd[0]);
  	  rp[0] = x.q.word1;
+ #else GFLOAT
+ /* Gfloat: Assume that IEEE standard hardware handles exceptions */
+ 	  p->constblock.const.cr[0] = x.d;
+ #endif GFLOAT
  	}
        else if (x.d >= *minp && x.d <= *maxp)
  	{
***************
*** 439,444
        else if (x.d >= *minp && x.d <= *maxp)
  	{
  	  p = (expptr) mkconst(TYREAL);
  	  y = x.d;
  	  p->constblock.const.cd[0] = y;
  	}

--- 569,575 -----
        else if (x.d >= *minp && x.d <= *maxp)
  	{
  	  p = (expptr) mkconst(TYREAL);
+ #ifndef GFLOAT
  	  y = x.d;
  	  p->constblock.const.cd[0] = y;
  #else GFLOAT
***************
*** 441,446
  	  p = (expptr) mkconst(TYREAL);
  	  y = x.d;
  	  p->constblock.const.cd[0] = y;
  	}
        else
  	{

--- 572,580 -----
  #ifndef GFLOAT
  	  y = x.d;
  	  p->constblock.const.cd[0] = y;
+ #else GFLOAT
+ 	  p->constblock.const.cr[0] = x.d;
+ #endif GFLOAT
  	}
        else
  	{
***************
*** 517,522
        p->constblock.const.cd[0] = cp->const.ci;
        break;
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:

--- 651,657 -----
        p->constblock.const.cd[0] = cp->const.ci;
        break;
  
+ #ifndef GFLOAT
      case TYREAL:
      case TYCOMPLEX:
  #endif GFLOAT
***************
*** 518,524
        break;
  
      case TYREAL:
-     case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDREAL);

--- 653,658 -----
  
  #ifndef GFLOAT
      case TYREAL:
      case TYCOMPLEX:
  #endif GFLOAT
      case TYDREAL:
***************
*** 520,525
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDREAL);
        longp = (long *) &(cp->const.cd[0]);

--- 654,661 -----
  #ifndef GFLOAT
      case TYREAL:
      case TYCOMPLEX:
+ #endif GFLOAT
+     case TYDREAL:
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDREAL);
  #ifndef GFLOAT
***************
*** 522,527
      case TYCOMPLEX:
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDREAL);
        longp = (long *) &(cp->const.cd[0]);
        rp = (long *) &(p->constblock.const.cd[0]);
        rp[0] = longp[0];

--- 658,664 -----
      case TYDREAL:
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDREAL);
+ #ifndef GFLOAT
        longp = (long *) &(cp->const.cd[0]);
        rp = (long *) &(p->constblock.const.cd[0]);
        rp[0] = longp[0];
***************
*** 526,531
        rp = (long *) &(p->constblock.const.cd[0]);
        rp[0] = longp[0];
        rp[1] = longp[1];
        break;
  
      case TYLOGICAL:

--- 663,671 -----
        rp = (long *) &(p->constblock.const.cd[0]);
        rp[0] = longp[0];
        rp[1] = longp[1];
+ #else GFLOAT
+       p->constblock.const.cd[0] = cp->const.cd[0];
+ #endif GFLOAT
        break;
  
  #ifdef GFLOAT
***************
*** 528,533
        rp[1] = longp[1];
        break;
  
      case TYLOGICAL:
        if (badvalue <= 1)
  	{

--- 668,681 -----
  #endif GFLOAT
        break;
  
+ #ifdef GFLOAT
+     case TYREAL:
+     case TYCOMPLEX:
+       p = (expptr) mkconst(TYDREAL);
+       p->constblock.const.cd[0] = cp->const.cr[0];
+       break;
+ 
+ #endif GFLOAT
      case TYLOGICAL:
        if (badvalue <= 1)
  	{
***************
*** 576,581
    register long *rp;
    register double *minp;
    register double *maxp;
    realvalue re, im;
    int overflow;
    float x;

--- 724,733 -----
    register long *rp;
    register double *minp;
    register double *maxp;
+ #ifdef GFLOAT
+   register float *minpf;
+   register float *maxpf;
+ #endif GFLOAT
    realvalue re, im;
    int overflow;
    float x;
***************
*** 598,603
        break;
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:

--- 750,756 -----
        break;
  
      case TYREAL:
+ #ifndef GFLOAT
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
***************
*** 599,604
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        overflow = 0;

--- 752,758 -----
      case TYREAL:
  #ifndef GFLOAT
      case TYDREAL:
+ #endif GFLOAT
      case TYCOMPLEX:
  #ifdef GFLOAT
        overflow = 0;
***************
*** 600,605
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        overflow = 0;
        minp = (double *) dminreal;

--- 754,768 -----
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
+ #ifdef GFLOAT
+       overflow = 0;
+       p = (expptr) mkconst(TYCOMPLEX);
+       p->constblock.const.cr[0] = cp->const.cr[0];
+       p->constblock.const.cr[1] = cp->const.cr[1];
+       break;
+ 
+     case TYDREAL:
+ #endif GFLOAT
      case TYDCOMPLEX:
        overflow = 0;
        minp = (double *) dminreal;
***************
*** 609,614
        re.q.word2 = rp[1];
        im.q.word1 = rp[2];
        im.q.word2 = rp[3];
        if (((re.f.sign == 0 || re.f.exp != 0) &&
  	   (re.d < *minp || re.d > *maxp))       ||
  	  ((im.f.sign == 0 || re.f.exp != 0) &&

--- 772,778 -----
        re.q.word2 = rp[1];
        im.q.word1 = rp[2];
        im.q.word2 = rp[3];
+ #ifndef GFLOAT
        if (((re.f.sign == 0 || re.f.exp != 0) &&
  #else GFLOAT
        if (((re.g.sign == 0 || re.g.exp != 0) &&
***************
*** 610,615
        im.q.word1 = rp[2];
        im.q.word2 = rp[3];
        if (((re.f.sign == 0 || re.f.exp != 0) &&
  	   (re.d < *minp || re.d > *maxp))       ||
  	  ((im.f.sign == 0 || re.f.exp != 0) &&
  	   (im.d < *minp || re.d > *maxp)))

--- 774,782 -----
        im.q.word2 = rp[3];
  #ifndef GFLOAT
        if (((re.f.sign == 0 || re.f.exp != 0) &&
+ #else GFLOAT
+       if (((re.g.sign == 0 || re.g.exp != 0) &&
+ #endif GFLOAT
  	   (re.d < *minp || re.d > *maxp))       ||
  #ifndef GFLOAT
  	  ((im.f.sign == 0 || re.f.exp != 0) &&
***************
*** 611,616
        im.q.word2 = rp[3];
        if (((re.f.sign == 0 || re.f.exp != 0) &&
  	   (re.d < *minp || re.d > *maxp))       ||
  	  ((im.f.sign == 0 || re.f.exp != 0) &&
  	   (im.d < *minp || re.d > *maxp)))
  	{

--- 778,784 -----
        if (((re.g.sign == 0 || re.g.exp != 0) &&
  #endif GFLOAT
  	   (re.d < *minp || re.d > *maxp))       ||
+ #ifndef GFLOAT
  	  ((im.f.sign == 0 || re.f.exp != 0) &&
  #else GFLOAT
  	  ((im.g.sign == 0 || re.g.exp != 0) &&
***************
*** 612,617
        if (((re.f.sign == 0 || re.f.exp != 0) &&
  	   (re.d < *minp || re.d > *maxp))       ||
  	  ((im.f.sign == 0 || re.f.exp != 0) &&
  	   (im.d < *minp || re.d > *maxp)))
  	{
  	  if (badvalue <= 1)

--- 780,788 -----
  	   (re.d < *minp || re.d > *maxp))       ||
  #ifndef GFLOAT
  	  ((im.f.sign == 0 || re.f.exp != 0) &&
+ #else GFLOAT
+ 	  ((im.g.sign == 0 || re.g.exp != 0) &&
+ #endif GFLOAT
  	   (im.d < *minp || re.d > *maxp)))
  	{
  	  if (badvalue <= 1)
***************
*** 624,629
        else
  	{
  	  p = (expptr) mkconst(TYCOMPLEX);
  	  if (re.f.sign == 1 && re.f.exp == 0)
  	    re.q.word2 = 0;
  	  else

--- 795,801 -----
        else
  	{
  	  p = (expptr) mkconst(TYCOMPLEX);
+ #ifndef GFLOAT
  	  if (re.f.sign == 1 && re.f.exp == 0)
  	    re.q.word2 = 0;
  	  else
***************
*** 643,648
  	  rp[1] = re.q.word2;
  	  rp[2] = im.q.word1;
  	  rp[3] = im.q.word2;
  	}
        break;
  

--- 815,824 -----
  	  rp[1] = re.q.word2;
  	  rp[2] = im.q.word1;
  	  rp[3] = im.q.word2;
+ #else GFLOAT
+           p->constblock.const.cr[0] = cp->const.cd[0];
+           p->constblock.const.cr[0] = cp->const.cd[1];
+ #endif GFLOAT
  	}
        break;
  
***************
*** 711,716
        break;
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:

--- 887,893 -----
        break;
  
      case TYREAL:
+ #ifndef GFLOAT
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
***************
*** 712,717
  
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDCOMPLEX);

--- 889,895 -----
      case TYREAL:
  #ifndef GFLOAT
      case TYDREAL:
+ #endif GFLOAT
      case TYCOMPLEX:
  #ifdef GFLOAT
        p = (expptr) mkconst(TYDCOMPLEX);
***************
*** 713,718
      case TYREAL:
      case TYDREAL:
      case TYCOMPLEX:
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDCOMPLEX);
        longp = (long *) &(cp->const.cd[0]);

--- 891,904 -----
      case TYDREAL:
  #endif GFLOAT
      case TYCOMPLEX:
+ #ifdef GFLOAT
+       p = (expptr) mkconst(TYDCOMPLEX);
+       p->constblock.const.cd[0] = cp->const.cr[0];
+       p->constblock.const.cd[1] = cp->const.cr[1];
+       break;
+ 
+     case TYDREAL:
+ #endif GFLOAT
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDCOMPLEX);
  #ifndef GFLOAT
***************
*** 715,720
      case TYCOMPLEX:
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDCOMPLEX);
        longp = (long *) &(cp->const.cd[0]);
        rp = (long *) &(p->constblock.const.cd[0]);
        rp[0] = longp[0];

--- 901,907 -----
  #endif GFLOAT
      case TYDCOMPLEX:
        p = (expptr) mkconst(TYDCOMPLEX);
+ #ifndef GFLOAT
        longp = (long *) &(cp->const.cd[0]);
        rp = (long *) &(p->constblock.const.cd[0]);
        rp[0] = longp[0];
***************
*** 721,726
        rp[1] = longp[1];
        rp[2] = longp[2];
        rp[3] = longp[3];
        break;
  
      case TYLOGICAL:

--- 908,917 -----
        rp[1] = longp[1];
        rp[2] = longp[2];
        rp[3] = longp[3];
+ #else GFLOAT
+       p->constblock.const.cd[0] = cp->const.cd[0];
+       p->constblock.const.cd[1] = cp->const.cd[1];
+ #endif GFLOAT
        break;
  
      case TYLOGICAL:
SHAR_EOF
chmod +x 'conv.c.diff'
if test -f 'expr.c.diff'
then
	echo shar: over-writing existing file "'expr.c.diff'"
fi
cat << \SHAR_EOF > 'expr.c.diff'
*** ../f77/src/f77pass1/expr.c.orig	Tue Oct 29 15:15:54 1985
--- ../f77/src/f77pass1/expr.c	Tue Oct 29 15:22:42 1985
***************
*** 151,157
  register Constp p;
  
  p = mkconst(t);
! p->const.cd[0] = d;
  return( (expptr) p );
  }
  

--- 151,162 -----
  register Constp p;
  
  p = mkconst(t);
! #ifdef GFLOAT
! if (t==TYREAL)
! 	p->const.cr[0] = d;
! else
! #endif GFLOAT
! 	p->const.cd[0] = d;
  return( (expptr) p );
  }
  
***************
*** 241,246
  	p = mkconst( (rtype==TYDREAL||itype==TYDREAL) ? TYDCOMPLEX : TYCOMPLEX);
  	if( ISINT(rtype) )
  		p->const.cd[0] = realp->constblock.const.ci;
  	else	p->const.cd[0] = realp->constblock.const.cd[0];
  	if( ISINT(itype) )
  		p->const.cd[1] = imagp->constblock.const.ci;

--- 246,255 -----
  	p = mkconst( (rtype==TYDREAL||itype==TYDREAL) ? TYDCOMPLEX : TYCOMPLEX);
  	if( ISINT(rtype) )
  		p->const.cd[0] = realp->constblock.const.ci;
+ #ifdef GFLOAT
+ 	else if (rtype==TYREAL || itype==TYREAL) 
+ 		p->const.cr[0] = realp->constblock.const.cr[0];
+ #endif GFLOAT
  	else	p->const.cd[0] = realp->constblock.const.cd[0];
  	if( ISINT(itype) )
  		p->const.cd[1] = imagp->constblock.const.ci;
***************
*** 244,249
  	else	p->const.cd[0] = realp->constblock.const.cd[0];
  	if( ISINT(itype) )
  		p->const.cd[1] = imagp->constblock.const.ci;
  	else	p->const.cd[1] = imagp->constblock.const.cd[0];
  	}
  else

--- 253,262 -----
  	else	p->const.cd[0] = realp->constblock.const.cd[0];
  	if( ISINT(itype) )
  		p->const.cd[1] = imagp->constblock.const.ci;
+ #ifdef GFLOAT
+ 	else if (rtype==TYREAL || itype==TYREAL) 
+ 		p->const.cr[1] = imagp->constblock.const.cr[0];
+ #endif GFLOAT
  	else	p->const.cd[1] = imagp->constblock.const.cd[0];
  	}
  else
***************
*** 2255,2261
  			lv->ci = rv->ccp[0];
  		else if( ISINT(rt) )
  			lv->ci = rv->ci;
! 		else	lv->ci = rv->cd[0];
  		break;
  
  	case TYCOMPLEX:

--- 2268,2278 -----
  			lv->ci = rv->ccp[0];
  		else if( ISINT(rt) )
  			lv->ci = rv->ci;
! #ifdef GFLOAT
! 		else if (rt==TYREAL || rt==TYCOMPLEX)
!        			lv->ci = rv->cr[0]; /* should test */
! #endif GFLOAT
!   		else	lv->ci = rv->cd[0];
  		break;
  
  	case TYCOMPLEX: 
***************
*** 2258,2264
  		else	lv->ci = rv->cd[0];
  		break;
  
! 	case TYCOMPLEX:
  	case TYDCOMPLEX:
  		switch(rt)
  			{

--- 2275,2305 -----
    		else	lv->ci = rv->cd[0];
  		break;
  
! 	case TYCOMPLEX: 
! #ifdef GFLOAT
! 		switch(rt)
! 			{
! 			case TYSHORT:
! 			case TYLONG:
! 				/* fall through and do real assignment of
! 				   first element */
! 			case TYREAL:
! 			case TYDREAL:
! 				lv->cr[1] = 0; break;
! 			case TYCOMPLEX:
! 				lv->cr[1] = rv->cr[1]; break;
! 			case TYDCOMPLEX: /* should check range here */
! 				lv->cr[1] = rv->cd[1]; break;
! 			}
! 	case TYREAL:
! 		if( ISINT(rt) )
! 			lv->cr[0] = rv->ci;
! 		else if (rt==TYREAL || rt==TYCOMPLEX) 
! 			lv->cr[0] = rv->cr[0];
! 		else	lv->cr[0] = rv->cd[0]; /* should test range */
! 		break;
! 
! #endif GFLOAT
  	case TYDCOMPLEX:
  		switch(rt)
  			{
***************
*** 2270,2276
  			case TYREAL:
  			case TYDREAL:
  				lv->cd[1] = 0; break;
! 			case TYCOMPLEX:
  			case TYDCOMPLEX:
  				lv->cd[1] = rv->cd[1]; break;
  			}

--- 2311,2320 -----
  			case TYREAL:
  			case TYDREAL:
  				lv->cd[1] = 0; break;
! 			case TYCOMPLEX: 
! #ifdef GFLOAT
! 				lv->cd[1] = rv->cr[1]; break;
! #endif GFLOAT
  			case TYDCOMPLEX:
  				lv->cd[1] = rv->cd[1]; break;
  			}
***************
*** 2274,2280
  			case TYDCOMPLEX:
  				lv->cd[1] = rv->cd[1]; break;
  			}
! 
  	case TYREAL:
  	case TYDREAL:
  		if( ISINT(rt) )

--- 2318,2324 -----
  			case TYDCOMPLEX:
  				lv->cd[1] = rv->cd[1]; break;
  			}
! #ifndef GFLOAT
  	case TYREAL:
  #endif GFLOAT
  	case TYDREAL:
***************
*** 2276,2281
  			}
  
  	case TYREAL:
  	case TYDREAL:
  		if( ISINT(rt) )
  			lv->cd[0] = rv->ci;

--- 2320,2326 -----
  			}
  #ifndef GFLOAT
  	case TYREAL:
+ #endif GFLOAT
  	case TYDREAL:
  		if( ISINT(rt) )
  			lv->cd[0] = rv->ci;
***************
*** 2279,2284
  	case TYDREAL:
  		if( ISINT(rt) )
  			lv->cd[0] = rv->ci;
  		else	lv->cd[0] = rv->cd[0];
  		break;
  

--- 2324,2333 -----
  	case TYDREAL:
  		if( ISINT(rt) )
  			lv->cd[0] = rv->ci;
+ #ifdef GFLOAT
+ 		else if (rt==TYREAL || rt==TYCOMPLEX) 
+ 			lv->cd[0] = rv->cr[0];
+ #endif GFLOAT
  		else	lv->cd[0] = rv->cd[0];
  		break;
  
***************
*** 2300,2306
  		p->const.ci = - p->const.ci;
  		break;
  
! 	case TYCOMPLEX:
  	case TYDCOMPLEX:
  		p->const.cd[1] = - p->const.cd[1];
  		/* fall through and do the real parts */

--- 2349,2362 -----
  		p->const.ci = - p->const.ci;
  		break;
  
! 	case TYCOMPLEX: 
! #ifdef GFLOAT
! 		p->const.cr[1] = - p->const.cr[1];
! 		/* fall through and do the real parts */
! 	case TYREAL:
! 		p->const.cr[0] = - p->const.cr[0];
! 		break;
! #endif GFLOAT
  	case TYDCOMPLEX:
  		p->const.cd[1] = - p->const.cd[1];
  		/* fall through and do the real parts */
***************
*** 2304,2309
  	case TYDCOMPLEX:
  		p->const.cd[1] = - p->const.cd[1];
  		/* fall through and do the real parts */
  	case TYREAL:
  	case TYDREAL:
  		p->const.cd[0] = - p->const.cd[0];

--- 2360,2366 -----
  	case TYDCOMPLEX:
  		p->const.cd[1] = - p->const.cd[1];
  		/* fall through and do the real parts */
+ #ifndef GFLOAT
  	case TYREAL:
  #endif GFLOAT
  	case TYDREAL:
***************
*** 2305,2310
  		p->const.cd[1] = - p->const.cd[1];
  		/* fall through and do the real parts */
  	case TYREAL:
  	case TYDREAL:
  		p->const.cd[0] = - p->const.cd[0];
  		break;

--- 2362,2368 -----
  		/* fall through and do the real parts */
  #ifndef GFLOAT
  	case TYREAL:
+ #endif GFLOAT
  	case TYDREAL:
  		p->const.cd[0] = - p->const.cd[0];
  		break;
***************
*** 2329,2335
  	case TYLONG:
  		powp->ci = 1;
  		break;
! 	case TYCOMPLEX:
  	case TYDCOMPLEX:
  		powp->cd[1] = 0;
  	case TYREAL:

--- 2387,2399 -----
  	case TYLONG:
  		powp->ci = 1;
  		break;
! 	case TYCOMPLEX: 
! #ifdef GFLOAT
! 		powp->cr[1] = 0;
! 	case TYREAL:
! 		powp->cr[0] = 1;
! 		break;
! #endif GFLOAT
  	case TYDCOMPLEX:
  		powp->cd[1] = 0;
  #ifndef GFLOAT
***************
*** 2332,2337
  	case TYCOMPLEX:
  	case TYDCOMPLEX:
  		powp->cd[1] = 0;
  	case TYREAL:
  	case TYDREAL:
  		powp->cd[0] = 1;

--- 2396,2402 -----
  #endif GFLOAT
  	case TYDCOMPLEX:
  		powp->cd[1] = 0;
+ #ifndef GFLOAT
  	case TYREAL:
  #endif GFLOAT
  	case TYDREAL:
***************
*** 2333,2338
  	case TYDCOMPLEX:
  		powp->cd[1] = 0;
  	case TYREAL:
  	case TYDREAL:
  		powp->cd[0] = 1;
  		break;

--- 2398,2404 -----
  		powp->cd[1] = 0;
  #ifndef GFLOAT
  	case TYREAL:
+ #endif GFLOAT
  	case TYDREAL:
  		powp->cd[0] = 1;
  		break;
***************
*** 2383,2388
  
  /* do constant operation cp = a op b */
  
  
  LOCAL consbinop(opcode, type, cp, ap, bp)
  int opcode, type;

--- 2449,2457 -----
  
  /* do constant operation cp = a op b */
  
+ #ifdef GFLOAT
+ struct rcomplex { double real, imag; };
+ #endif GFLOAT
  
  LOCAL consbinop(opcode, type, cp, ap, bp)
  int opcode, type;
***************
*** 2390,2395
  {
  int k;
  double temp;
  
  switch(opcode)
  	{

--- 2459,2467 -----
  {
  int k;
  double temp;
+ #ifdef GFLOAT
+ struct rcomplex fr, ar, br;
+ #endif GFLOAT
  
  switch(opcode)
  	{
***************
*** 2401,2406
  				cp->ci = ap->ci + bp->ci;
  				break;
  			case TYCOMPLEX:
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] + bp->cd[1];
  			case TYREAL:

--- 2473,2484 -----
  				cp->ci = ap->ci + bp->ci;
  				break;
  			case TYCOMPLEX:
+ #ifdef GFLOAT
+ 				cp->cr[1] = ap->cr[1] + bp->cr[1];
+ 			case TYREAL:
+ 				cp->cr[0] = ap->cr[0] + bp->cr[0];
+ 				break;
+ #endif GFLOAT
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] + bp->cd[1];
  #ifndef GFLOAT
***************
*** 2403,2408
  			case TYCOMPLEX:
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] + bp->cd[1];
  			case TYREAL:
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] + bp->cd[0];

--- 2481,2487 -----
  #endif GFLOAT
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] + bp->cd[1];
+ #ifndef GFLOAT
  			case TYREAL:
  #endif GFLOAT
  			case TYDREAL:
***************
*** 2404,2409
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] + bp->cd[1];
  			case TYREAL:
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] + bp->cd[0];
  				break;

--- 2483,2489 -----
  				cp->cd[1] = ap->cd[1] + bp->cd[1];
  #ifndef GFLOAT
  			case TYREAL:
+ #endif GFLOAT
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] + bp->cd[0];
  				break;
***************
*** 2417,2423
  			case TYLONG:
  				cp->ci = ap->ci - bp->ci;
  				break;
! 			case TYCOMPLEX:
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] - bp->cd[1];
  			case TYREAL:

--- 2497,2509 -----
  			case TYLONG:
  				cp->ci = ap->ci - bp->ci;
  				break;
! 			case TYCOMPLEX: 
! #ifdef GFLOAT
! 				cp->cr[1] = ap->cr[1] - bp->cr[1];
! 			case TYREAL:
! 				cp->cr[0] = ap->cr[0] - bp->cr[0];
! 				break;
! #endif GFLOAT
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] - bp->cd[1];
  #ifndef GFLOAT
***************
*** 2420,2425
  			case TYCOMPLEX:
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] - bp->cd[1];
  			case TYREAL:
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] - bp->cd[0];

--- 2506,2512 -----
  #endif GFLOAT
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] - bp->cd[1];
+ #ifndef GFLOAT
  			case TYREAL:
  #endif GFLOAT
  			case TYDREAL:
***************
*** 2421,2426
  			case TYDCOMPLEX:
  				cp->cd[1] = ap->cd[1] - bp->cd[1];
  			case TYREAL:
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] - bp->cd[0];
  				break;

--- 2508,2514 -----
  				cp->cd[1] = ap->cd[1] - bp->cd[1];
  #ifndef GFLOAT
  			case TYREAL:
+ #endif GFLOAT
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] - bp->cd[0];
  				break;
***************
*** 2434,2440
  			case TYLONG:
  				cp->ci = ap->ci * bp->ci;
  				break;
! 			case TYREAL:
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] * bp->cd[0];
  				break;

--- 2522,2532 -----
  			case TYLONG:
  				cp->ci = ap->ci * bp->ci;
  				break;
! 			case TYREAL: 
! #ifdef GFLOAT
! 				cp->cr[0] = ap->cr[0] * bp->cr[0];
! 				break;
! #endif GFLOAT
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] * bp->cd[0];
  				break;
***************
*** 2439,2444
  				cp->cd[0] = ap->cd[0] * bp->cd[0];
  				break;
  			case TYCOMPLEX:
  			case TYDCOMPLEX:
  				temp = ap->cd[0] * bp->cd[0] -
  					    ap->cd[1] * bp->cd[1] ;

--- 2531,2544 -----
  				cp->cd[0] = ap->cd[0] * bp->cd[0];
  				break;
  			case TYCOMPLEX:
+ #ifdef GFLOAT
+ 				temp = ap->cr[0] * bp->cr[0] -
+ 					    ap->cr[1] * bp->cr[1] ;
+ 				cp->cr[1] = ap->cr[0] * bp->cr[1] +
+ 					    ap->cr[1] * bp->cr[0] ;
+ 				cp->cr[0] = temp;
+ 				break;
+ #endif GFLOAT
  			case TYDCOMPLEX:
  				temp = ap->cd[0] * bp->cd[0] -
  					    ap->cd[1] * bp->cd[1] ;
***************
*** 2455,2461
  			case TYLONG:
  				cp->ci = ap->ci / bp->ci;
  				break;
! 			case TYREAL:
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] / bp->cd[0];
  				break;

--- 2555,2565 -----
  			case TYLONG:
  				cp->ci = ap->ci / bp->ci;
  				break;
! 			case TYREAL: 
! #ifdef GFLOAT
! 				cp->cr[0] = ap->cr[0] / bp->cr[0];
! 				break;
! #endif GFLOAT
  			case TYDREAL:
  				cp->cd[0] = ap->cd[0] / bp->cd[0];
  				break;
***************
*** 2460,2465
  				cp->cd[0] = ap->cd[0] / bp->cd[0];
  				break;
  			case TYCOMPLEX:
  			case TYDCOMPLEX:
  				zdiv(cp,ap,bp);
  				break;

--- 2564,2579 -----
  				cp->cd[0] = ap->cd[0] / bp->cd[0];
  				break;
  			case TYCOMPLEX:
+ #ifdef GFLOAT
+ 				ar.real = ap->cr[0];
+  				ar.imag = ap->cr[1];
+ 				br.real = bp->cr[0];
+ 				br.imag = bp->cr[1];
+ 				zdiv(fr,ar,br);
+ 				cp->cr[0] = fr.real; /* should test */
+ 				cp->cr[1] = fr.imag;
+ 				break;
+ #endif GFLOAT
  			case TYDCOMPLEX:
  				zdiv(cp,ap,bp);
  				break;
***************
*** 2486,2492
  					k = 0;
  				else	k = 1;
  				break;
! 			case TYREAL:
  			case TYDREAL:
  				if(ap->cd[0] < bp->cd[0])
  					k = -1;

--- 2600,2606 -----
  					k = 0;
  				else	k = 1;
  				break;
! 			case TYREAL: /*assume this works for G format floats */
  			case TYDREAL:
  				if(ap->cd[0] < bp->cd[0])
  					k = -1;
***************
*** 2494,2500
  					k = 0;
  				else	k = 1;
  				break;
! 			case TYCOMPLEX:
  			case TYDCOMPLEX:
  				if(ap->cd[0] == bp->cd[0] &&
  				   ap->cd[1] == bp->cd[1] )

--- 2608,2621 -----
  					k = 0;
  				else	k = 1;
  				break;
! 			case TYCOMPLEX: 
! #ifdef GFLOAT
! 				if(ap->cr[0] == bp->cr[0] &&
! 				   ap->cr[1] == bp->cr[1] )
! 					k = 0;
! 				else	k = 1;
! 				break;
! #endif GFLOAT
  			case TYDCOMPLEX:
  				if(ap->cd[0] == bp->cd[0] &&
  				   ap->cd[1] == bp->cd[1] )
***************
*** 2547,2553
  		if(p->constblock.const.ci < 0) return(-1);
  		return(0);
  
! 	case TYREAL:
  	case TYDREAL:
  		if(p->constblock.const.cd[0] > 0) return(1);
  		if(p->constblock.const.cd[0] < 0) return(-1);

--- 2668,2679 -----
  		if(p->constblock.const.ci < 0) return(-1);
  		return(0);
  
! 	case TYREAL: 
! #ifdef GFLOAT
! 		if(p->constblock.const.cr[0] > 0) return(1);
! 		if(p->constblock.const.cr[0] < 0) return(-1);
! 		return(0);
! #endif GFLOAT
  	case TYDREAL:
  		if(p->constblock.const.cd[0] > 0) return(1);
  		if(p->constblock.const.cd[0] < 0) return(-1);
***************
*** 2553,2559
  		if(p->constblock.const.cd[0] < 0) return(-1);
  		return(0);
  
! 	case TYCOMPLEX:
  	case TYDCOMPLEX:
  		return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
  

--- 2679,2687 -----
  		if(p->constblock.const.cd[0] < 0) return(-1);
  		return(0);
  
! 	case TYCOMPLEX: 
! #ifdef GFLOAT
! 	return(p->constblock.const.cr[0]!=0 || p->constblock.const.cr[1]!=0);
  	case TYDCOMPLEX:
  	return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
  #else GFLOAT
***************
*** 2555,2561
  
  	case TYCOMPLEX:
  	case TYDCOMPLEX:
! 		return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
  
  	default:
  		badtype( "conssgn", p->constblock.vtype);

--- 2683,2693 -----
  #ifdef GFLOAT
  	return(p->constblock.const.cr[0]!=0 || p->constblock.const.cr[1]!=0);
  	case TYDCOMPLEX:
! 	return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
! #else GFLOAT
! 	case TYDCOMPLEX:
! 	return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
! #endif GFLOAT
  
  	default:
  		badtype( "conssgn", p->constblock.vtype);
SHAR_EOF
chmod +x 'expr.c.diff'
if test -f 'defs.h.diff'
then
	echo shar: over-writing existing file "'defs.h.diff'"
fi
cat << \SHAR_EOF > 'defs.h.diff'
*** ../f77/src/f77pass1/defs.h.orig	Tue Oct 29 15:15:49 1985
--- ../f77/src/f77pass1/defs.h	Tue Oct 29 15:22:31 1985
***************
*** 367,372
  	char *ccp;
  	ftnint ci;
  	double cd[2];
  	};
  
  struct Constblock

--- 367,375 -----
  	char *ccp;
  	ftnint ci;
  	double cd[2];
+ #ifdef GFLOAT
+         float cr[4];
+ #endif GFLOAT
  	};
  
  struct Constblock
SHAR_EOF
chmod +x 'defs.h.diff'
chdir ..
chdir ..
chdir ..
chdir ..
#	End of shell archive
exit 0



More information about the Mod.sources mailing list