diff options
author | kan <kan@FreeBSD.org> | 2003-07-11 03:42:19 +0000 |
---|---|---|
committer | kan <kan@FreeBSD.org> | 2003-07-11 03:42:19 +0000 |
commit | b664230ac178e69c3c146968ee0c3300a4009f60 (patch) | |
tree | 01f695ddb223c95a40652601894e4291cdf92786 /contrib/libf2c/libI77/lwrite.c | |
parent | aa78059bdb419f0b5779c9b913f71eea20a91f56 (diff) | |
parent | 7b704871fdac058719f34a1e6b9de71ee76c5be4 (diff) | |
download | FreeBSD-src-b664230ac178e69c3c146968ee0c3300a4009f60.zip FreeBSD-src-b664230ac178e69c3c146968ee0c3300a4009f60.tar.gz |
This commit was generated by cvs2svn to compensate for changes in r117401,
which included commits to RCS files with non-trunk default branches.
Diffstat (limited to 'contrib/libf2c/libI77/lwrite.c')
-rw-r--r-- | contrib/libf2c/libI77/lwrite.c | 469 |
1 files changed, 222 insertions, 247 deletions
diff --git a/contrib/libf2c/libI77/lwrite.c b/contrib/libf2c/libI77/lwrite.c index bf209f4..b910ab1 100644 --- a/contrib/libf2c/libI77/lwrite.c +++ b/contrib/libf2c/libI77/lwrite.c @@ -6,297 +6,272 @@ ftnint L_len; int f__Aquote; - static VOID -donewrec(Void) +static void +donewrec (void) { - if (f__recpos) - (*f__donewrec)(); - } + if (f__recpos) + (*f__donewrec) (); +} - static VOID -#ifdef KR_headers -lwrt_I(n) longint n; -#else -lwrt_I(longint n) -#endif +static void +lwrt_I (longint n) { - char *p; - int ndigit, sign; + char *p; + int ndigit, sign; - p = f__icvt(n, &ndigit, &sign, 10); - if(f__recpos + ndigit >= L_len) - donewrec(); - PUT(' '); - if (sign) - PUT('-'); - while(*p) - PUT(*p++); + p = f__icvt (n, &ndigit, &sign, 10); + if (f__recpos + ndigit >= L_len) + donewrec (); + PUT (' '); + if (sign) + PUT ('-'); + while (*p) + PUT (*p++); } - static VOID -#ifdef KR_headers -lwrt_L(n, len) ftnint n; ftnlen len; -#else -lwrt_L(ftnint n, ftnlen len) -#endif +static void +lwrt_L (ftnint n, ftnlen len) { - if(f__recpos+LLOGW>=L_len) - donewrec(); - wrt_L((Uint *)&n,LLOGW, len); + if (f__recpos + LLOGW >= L_len) + donewrec (); + wrt_L ((Uint *) & n, LLOGW, len); } - static VOID -#ifdef KR_headers -lwrt_A(p,len) char *p; ftnlen len; -#else -lwrt_A(char *p, ftnlen len) -#endif +static void +lwrt_A (char *p, ftnlen len) { - int a; - char *p1, *pe; + int a; + char *p1, *pe; - a = 0; - pe = p + len; - if (f__Aquote) { - a = 3; - if (len > 1 && p[len-1] == ' ') { - while(--len > 1 && p[len-1] == ' '); - pe = p + len; - } - p1 = p; - while(p1 < pe) - if (*p1++ == '\'') - a++; - } - if(f__recpos+len+a >= L_len) - donewrec(); - if (a + a = 0; + pe = p + len; + if (f__Aquote) + { + a = 3; + if (len > 1 && p[len - 1] == ' ') + { + while (--len > 1 && p[len - 1] == ' '); + pe = p + len; + } + p1 = p; + while (p1 < pe) + if (*p1++ == '\'') + a++; + } + if (f__recpos + len + a >= L_len) + donewrec (); + if (a #ifndef OMIT_BLANK_CC - || !f__recpos + || !f__recpos #endif - ) - PUT(' '); - if (a) { - PUT('\''); - while(p < pe) { - if (*p == '\'') - PUT('\''); - PUT(*p++); - } - PUT('\''); - } - else - while(p < pe) - PUT(*p++); + ) + PUT (' '); + if (a) + { + PUT ('\''); + while (p < pe) + { + if (*p == '\'') + PUT ('\''); + PUT (*p++); + } + PUT ('\''); + } + else + while (p < pe) + PUT (*p++); } - static int -#ifdef KR_headers -l_g(buf, n) char *buf; double n; -#else -l_g(char *buf, double n) -#endif +static int +l_g (char *buf, double n) { #ifdef Old_list_output - doublereal absn; - char *fmt; + doublereal absn; + char *fmt; - absn = n; - if (absn < 0) - absn = -absn; - fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT; + absn = n; + if (absn < 0) + absn = -absn; + fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT; #ifdef USE_STRLEN - sprintf(buf, fmt, n); - return strlen(buf); + sprintf (buf, fmt, n); + return strlen (buf); #else - return sprintf(buf, fmt, n); + return sprintf (buf, fmt, n); #endif #else - register char *b, c, c1; + register char *b, c, c1; - b = buf; - *b++ = ' '; - if (n < 0) { - *b++ = '-'; - n = -n; - } - else - *b++ = ' '; - if (n == 0) { - *b++ = '0'; - *b++ = '.'; - *b = 0; - goto f__ret; - } - sprintf(b, LGFMT, n); - switch(*b) { + b = buf; + *b++ = ' '; + if (n < 0) + { + *b++ = '-'; + n = -n; + } + else + *b++ = ' '; + if (n == 0) + { + *b++ = '0'; + *b++ = '.'; + *b = 0; + goto f__ret; + } + sprintf (b, LGFMT, n); + switch (*b) + { #ifndef WANT_LEAD_0 - case '0': - while(b[0] = b[1]) - b++; - break; + case '0': + while (b[0] = b[1]) + b++; + break; #endif - case 'i': - case 'I': - /* Infinity */ - case 'n': - case 'N': - /* NaN */ - while(*++b); - break; + case 'i': + case 'I': + /* Infinity */ + case 'n': + case 'N': + /* NaN */ + while (*++b); + break; - default: - /* Fortran 77 insists on having a decimal point... */ - for(;; b++) - switch(*b) { - case 0: - *b++ = '.'; - *b = 0; - goto f__ret; - case '.': - while(*++b); - goto f__ret; - case 'E': - for(c1 = '.', c = 'E'; *b = c1; - c1 = c, c = *++b); - goto f__ret; - } - } - f__ret: - return b - buf; + default: + /* Fortran 77 insists on having a decimal point... */ + for (;; b++) + switch (*b) + { + case 0: + *b++ = '.'; + *b = 0; + goto f__ret; + case '.': + while (*++b); + goto f__ret; + case 'E': + for (c1 = '.', c = 'E'; (*b = c1); c1 = c, c = *++b); + goto f__ret; + } + } +f__ret: + return b - buf; #endif - } +} - static VOID -#ifdef KR_headers -l_put(s) register char *s; -#else -l_put(register char *s) -#endif +static void +l_put (register char *s) { -#ifdef KR_headers - register void (*pn)() = f__putn; -#else - register void (*pn)(int) = f__putn; -#endif - register int c; + register void (*pn) (int) = f__putn; + register int c; - while(c = *s++) - (*pn)(c); - } + while ((c = *s++)) + (*pn) (c); +} - static VOID -#ifdef KR_headers -lwrt_F(n) double n; -#else -lwrt_F(double n) -#endif +static void +lwrt_F (double n) { - char buf[LEFBL]; + char buf[LEFBL]; - if(f__recpos + l_g(buf,n) >= L_len) - donewrec(); - l_put(buf); + if (f__recpos + l_g (buf, n) >= L_len) + donewrec (); + l_put (buf); } - static VOID -#ifdef KR_headers -lwrt_C(a,b) double a,b; -#else -lwrt_C(double a, double b) -#endif +static void +lwrt_C (double a, double b) { - char *ba, *bb, bufa[LEFBL], bufb[LEFBL]; - int al, bl; + char *ba, *bb, bufa[LEFBL], bufb[LEFBL]; + int al, bl; - al = l_g(bufa, a); - for(ba = bufa; *ba == ' '; ba++) - --al; - bl = l_g(bufb, b) + 1; /* intentionally high by 1 */ - for(bb = bufb; *bb == ' '; bb++) - --bl; - if(f__recpos + al + bl + 3 >= L_len) - donewrec(); + al = l_g (bufa, a); + for (ba = bufa; *ba == ' '; ba++) + --al; + bl = l_g (bufb, b) + 1; /* intentionally high by 1 */ + for (bb = bufb; *bb == ' '; bb++) + --bl; + if (f__recpos + al + bl + 3 >= L_len) + donewrec (); #ifdef OMIT_BLANK_CC - else + else #endif - PUT(' '); - PUT('('); - l_put(ba); - PUT(','); - if (f__recpos + bl >= L_len) { - (*f__donewrec)(); + PUT (' '); + PUT ('('); + l_put (ba); + PUT (','); + if (f__recpos + bl >= L_len) + { + (*f__donewrec) (); #ifndef OMIT_BLANK_CC - PUT(' '); + PUT (' '); #endif - } - l_put(bb); - PUT(')'); + } + l_put (bb); + PUT (')'); } -#ifdef KR_headers -l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; -#else -l_write(ftnint *number, char *ptr, ftnlen len, ftnint type) -#endif + +int +l_write (ftnint * number, char *ptr, ftnlen len, ftnint type) { #define Ptr ((flex *)ptr) - int i; - longint x; - double y,z; - real *xx; - doublereal *yy; - for(i=0;i< *number; i++) + int i; + longint x; + double y, z; + real *xx; + doublereal *yy; + for (i = 0; i < *number; i++) + { + switch ((int) type) { - switch((int)type) - { - default: f__fatal(204,"unknown type in lio"); - case TYINT1: - x = Ptr->flchar; - goto xint; - case TYSHORT: - x=Ptr->flshort; - goto xint; + default: + f__fatal (204, "unknown type in lio"); + case TYINT1: + x = Ptr->flchar; + goto xint; + case TYSHORT: + x = Ptr->flshort; + goto xint; #ifdef Allow_TYQUAD - case TYQUAD: - x = Ptr->fllongint; - goto xint; + case TYQUAD: + x = Ptr->fllongint; + goto xint; #endif - case TYLONG: - x=Ptr->flint; - xint: lwrt_I(x); - break; - case TYREAL: - y=Ptr->flreal; - goto xfloat; - case TYDREAL: - y=Ptr->fldouble; - xfloat: lwrt_F(y); - break; - case TYCOMPLEX: - xx= &Ptr->flreal; - y = *xx++; - z = *xx; - goto xcomplex; - case TYDCOMPLEX: - yy = &Ptr->fldouble; - y= *yy++; - z = *yy; - xcomplex: - lwrt_C(y,z); - break; - case TYLOGICAL1: - x = Ptr->flchar; - goto xlog; - case TYLOGICAL2: - x = Ptr->flshort; - goto xlog; - case TYLOGICAL: - x = Ptr->flint; - xlog: lwrt_L(Ptr->flint, len); - break; - case TYCHAR: - lwrt_A(ptr,len); - break; - } - ptr += len; + case TYLONG: + x = Ptr->flint; + xint:lwrt_I (x); + break; + case TYREAL: + y = Ptr->flreal; + goto xfloat; + case TYDREAL: + y = Ptr->fldouble; + xfloat:lwrt_F (y); + break; + case TYCOMPLEX: + xx = &Ptr->flreal; + y = *xx++; + z = *xx; + goto xcomplex; + case TYDCOMPLEX: + yy = &Ptr->fldouble; + y = *yy++; + z = *yy; + xcomplex: + lwrt_C (y, z); + break; + case TYLOGICAL1: + x = Ptr->flchar; + goto xlog; + case TYLOGICAL2: + x = Ptr->flshort; + goto xlog; + case TYLOGICAL: + x = Ptr->flint; + xlog:lwrt_L (Ptr->flint, len); + break; + case TYCHAR: + lwrt_A (ptr, len); + break; } - return(0); + ptr += len; + } + return (0); } |