Relay-Version: version B 2.10.3 4.3bsd-beta 6/6/85; site seismo.CSS.GOV Posting-Version: version B 2.10.2 9/3/84; site panda.UUCP Path: seismo!harvard!talcott!panda!sources-request From: sources-request@panda.UUCP Newsgroups: mod.sources Subject: G-format compilers for Ultrix/Unix Vaxes (3 of 4) Message-ID: <1085@panda.UUCP> Date: 10 Nov 85 21:04:19 GMT Sender: jpn@panda.UUCP Lines: 1854 Approved: jpn@panda.UUCP Mod.sources: Volume 3, Issue 39 Submitted by: J.D.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