From 7b704871fdac058719f34a1e6b9de71ee76c5be4 Mon Sep 17 00:00:00 2001 From: kan Date: Fri, 11 Jul 2003 03:42:19 +0000 Subject: Gcc 3.3.1-pre 2003-07-11 libf2c bits. --- contrib/libf2c/libI77/wrtfmt.c | 675 ++++++++++++++++++++++------------------- 1 file changed, 355 insertions(+), 320 deletions(-) (limited to 'contrib/libf2c/libI77/wrtfmt.c') diff --git a/contrib/libf2c/libI77/wrtfmt.c b/contrib/libf2c/libI77/wrtfmt.c index 37006ba..0190f71 100644 --- a/contrib/libf2c/libI77/wrtfmt.c +++ b/contrib/libf2c/libI77/wrtfmt.c @@ -6,361 +6,396 @@ extern icilist *f__svic; extern char *f__icptr; - static int -mv_cur(Void) /* shouldn't use fseek because it insists on calling fflush */ +static int +mv_cur (void) /* shouldn't use fseek because it insists on calling fflush */ /* instead we know too much about stdio */ { - int cursor = f__cursor; - f__cursor = 0; - if(f__external == 0) { - if(cursor < 0) { - if(f__hiwater < f__recpos) - f__hiwater = f__recpos; - f__recpos += cursor; - f__icptr += cursor; - if(f__recpos < 0) - err(f__elist->cierr, 110, "left off"); - } - else if(cursor > 0) { - if(f__recpos + cursor >= f__svic->icirlen) - err(f__elist->cierr, 110, "recend"); - if(f__hiwater <= f__recpos) - for(; cursor > 0; cursor--) - (*f__putn)(' '); - else if(f__hiwater <= f__recpos + cursor) { - cursor -= f__hiwater - f__recpos; - f__icptr += f__hiwater - f__recpos; - f__recpos = f__hiwater; - for(; cursor > 0; cursor--) - (*f__putn)(' '); - } - else { - f__icptr += cursor; - f__recpos += cursor; - } - } - return(0); + int cursor = f__cursor; + f__cursor = 0; + if (f__external == 0) + { + if (cursor < 0) + { + if (f__hiwater < f__recpos) + f__hiwater = f__recpos; + f__recpos += cursor; + f__icptr += cursor; + if (f__recpos < 0) + err (f__elist->cierr, 110, "left off"); } - if (cursor > 0) { - if(f__hiwater <= f__recpos) - for(;cursor>0;cursor--) (*f__putn)(' '); - else if(f__hiwater <= f__recpos + cursor) { - cursor -= f__hiwater - f__recpos; - f__recpos = f__hiwater; - for(; cursor > 0; cursor--) - (*f__putn)(' '); - } - else { - f__recpos += cursor; - } + else if (cursor > 0) + { + if (f__recpos + cursor >= f__svic->icirlen) + err (f__elist->cierr, 110, "recend"); + if (f__hiwater <= f__recpos) + for (; cursor > 0; cursor--) + (*f__putn) (' '); + else if (f__hiwater <= f__recpos + cursor) + { + cursor -= f__hiwater - f__recpos; + f__icptr += f__hiwater - f__recpos; + f__recpos = f__hiwater; + for (; cursor > 0; cursor--) + (*f__putn) (' '); + } + else + { + f__icptr += cursor; + f__recpos += cursor; + } } - else if (cursor < 0) + return (0); + } + if (cursor > 0) + { + if (f__hiwater <= f__recpos) + for (; cursor > 0; cursor--) + (*f__putn) (' '); + else if (f__hiwater <= f__recpos + cursor) { - if(cursor + f__recpos < 0) - err(f__elist->cierr,110,"left off"); - if(f__hiwater < f__recpos) - f__hiwater = f__recpos; - f__recpos += cursor; + cursor -= f__hiwater - f__recpos; + f__recpos = f__hiwater; + for (; cursor > 0; cursor--) + (*f__putn) (' '); } - return(0); + else + { + f__recpos += cursor; + } + } + else if (cursor < 0) + { + if (cursor + f__recpos < 0) + err (f__elist->cierr, 110, "left off"); + if (f__hiwater < f__recpos) + f__hiwater = f__recpos; + f__recpos += cursor; + } + return (0); } - static int -#ifdef KR_headers -wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len; -#else -wrt_Z(Uint *n, int w, int minlen, ftnlen len) -#endif +static int +wrt_Z (Uint * n, int w, int minlen, ftnlen len) { - register char *s, *se; - register int i, w1; - static int one = 1; - static char hex[] = "0123456789ABCDEF"; - s = (char *)n; - --len; - if (*(char *)&one) { - /* little endian */ - se = s; - s += len; - i = -1; - } - else { - se = s + len; - i = 1; - } - for(;; s += i) - if (s == se || *s) - break; - w1 = (i*(se-s) << 1) + 1; - if (*s & 0xf0) - w1++; - if (w1 > w) - for(i = 0; i < w; i++) - (*f__putn)('*'); - else { - if ((minlen -= w1) > 0) - w1 += minlen; - while(--w >= w1) - (*f__putn)(' '); - while(--minlen >= 0) - (*f__putn)('0'); - if (!(*s & 0xf0)) { - (*f__putn)(hex[*s & 0xf]); - if (s == se) - return 0; - s += i; - } - for(;; s += i) { - (*f__putn)(hex[*s >> 4 & 0xf]); - (*f__putn)(hex[*s & 0xf]); - if (s == se) - break; - } - } - return 0; + register char *s, *se; + register int i, w1; + static int one = 1; + static char hex[] = "0123456789ABCDEF"; + s = (char *) n; + --len; + if (*(char *) &one) + { + /* little endian */ + se = s; + s += len; + i = -1; + } + else + { + se = s + len; + i = 1; + } + for (;; s += i) + if (s == se || *s) + break; + w1 = (i * (se - s) << 1) + 1; + if (*s & 0xf0) + w1++; + if (w1 > w) + for (i = 0; i < w; i++) + (*f__putn) ('*'); + else + { + if ((minlen -= w1) > 0) + w1 += minlen; + while (--w >= w1) + (*f__putn) (' '); + while (--minlen >= 0) + (*f__putn) ('0'); + if (!(*s & 0xf0)) + { + (*f__putn) (hex[*s & 0xf]); + if (s == se) + return 0; + s += i; + } + for (;; s += i) + { + (*f__putn) (hex[*s >> 4 & 0xf]); + (*f__putn) (hex[*s & 0xf]); + if (s == se) + break; } + } + return 0; +} - static int -#ifdef KR_headers -wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base; -#else -wrt_I(Uint *n, int w, ftnlen len, register int base) -#endif -{ int ndigit,sign,spare,i; - longint x; - char *ans; - if(len==sizeof(integer)) x=n->il; - else if(len == sizeof(char)) x = n->ic; +static int +wrt_I (Uint * n, int w, ftnlen len, register int base) +{ + int ndigit, sign, spare, i; + longint x; + char *ans; + if (len == sizeof (integer)) + x = n->il; + else if (len == sizeof (char)) + x = n->ic; #ifdef Allow_TYQUAD - else if (len == sizeof(longint)) x = n->ili; + else if (len == sizeof (longint)) + x = n->ili; #endif - else x=n->is; - ans=f__icvt(x,&ndigit,&sign, base); - spare=w-ndigit; - if(sign || f__cplus) spare--; - if(spare<0) - for(i=0;iis; + ans = f__icvt (x, &ndigit, &sign, base); + spare = w - ndigit; + if (sign || f__cplus) + spare--; + if (spare < 0) + for (i = 0; i < w; i++) + (*f__putn) ('*'); + else + { + for (i = 0; i < spare; i++) + (*f__putn) (' '); + if (sign) + (*f__putn) ('-'); + else if (f__cplus) + (*f__putn) ('+'); + for (i = 0; i < ndigit; i++) + (*f__putn) (*ans++); + } + return (0); } - static int -#ifdef KR_headers -wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base; -#else -wrt_IM(Uint *n, int w, int m, ftnlen len, int base) -#endif -{ int ndigit,sign,spare,i,xsign; - longint x; - char *ans; - if(sizeof(integer)==len) x=n->il; - else if(len == sizeof(char)) x = n->ic; +static int +wrt_IM (Uint * n, int w, int m, ftnlen len, int base) +{ + int ndigit, sign, spare, i, xsign; + longint x; + char *ans; + if (sizeof (integer) == len) + x = n->il; + else if (len == sizeof (char)) + x = n->ic; #ifdef Allow_TYQUAD - else if (len == sizeof(longint)) x = n->ili; + else if (len == sizeof (longint)) + x = n->ili; #endif - else x=n->is; - ans=f__icvt(x,&ndigit,&sign, base); - if(sign || f__cplus) xsign=1; - else xsign=0; - if(ndigit+xsign>w || m+xsign>w) - { for(i=0;i=m) - spare=w-ndigit-xsign; - else - spare=w-m-xsign; - for(i=0;iis; + ans = f__icvt (x, &ndigit, &sign, base); + if (sign || f__cplus) + xsign = 1; + else + xsign = 0; + if (ndigit + xsign > w || m + xsign > w) + { + for (i = 0; i < w; i++) + (*f__putn) ('*'); + return (0); + } + if (x == 0 && m == 0) + { + for (i = 0; i < w; i++) + (*f__putn) (' '); + return (0); + } + if (ndigit >= m) + spare = w - ndigit - xsign; + else + spare = w - m - xsign; + for (i = 0; i < spare; i++) + (*f__putn) (' '); + if (sign) + (*f__putn) ('-'); + else if (f__cplus) + (*f__putn) ('+'); + for (i = 0; i < m - ndigit; i++) + (*f__putn) ('0'); + for (i = 0; i < ndigit; i++) + (*f__putn) (*ans++); + return (0); } - static int -#ifdef KR_headers -wrt_AP(s) char *s; -#else -wrt_AP(char *s) -#endif -{ char quote; - int i; +static int +wrt_AP (char *s) +{ + char quote; + int i; - if(f__cursor && (i = mv_cur())) - return i; - quote = *s++; - for(;*s;s++) - { if(*s!=quote) (*f__putn)(*s); - else if(*++s==quote) (*f__putn)(*s); - else return(1); - } - return(1); + if (f__cursor && (i = mv_cur ())) + return i; + quote = *s++; + for (; *s; s++) + { + if (*s != quote) + (*f__putn) (*s); + else if (*++s == quote) + (*f__putn) (*s); + else + return (1); + } + return (1); } - static int -#ifdef KR_headers -wrt_H(a,s) char *s; -#else -wrt_H(int a, char *s) -#endif +static int +wrt_H (int a, char *s) { - int i; + int i; - if(f__cursor && (i = mv_cur())) - return i; - while(a--) (*f__putn)(*s++); - return(1); + if (f__cursor && (i = mv_cur ())) + return i; + while (a--) + (*f__putn) (*s++); + return (1); } -#ifdef KR_headers -wrt_L(n,len, sz) Uint *n; ftnlen sz; -#else -wrt_L(Uint *n, int len, ftnlen sz) -#endif -{ int i; - long x; - if(sizeof(long)==sz) x=n->il; - else if(sz == sizeof(char)) x = n->ic; - else x=n->is; - for(i=0;iil; + else if (sz == sizeof (char)) + x = n->ic; + else + x = n->is; + for (i = 0; i < len - 1; i++) + (*f__putn) (' '); + if (x) + (*f__putn) ('T'); + else + (*f__putn) ('F'); + return (0); } - static int -#ifdef KR_headers -wrt_A(p,len) char *p; ftnlen len; -#else -wrt_A(char *p, ftnlen len) -#endif +static int +wrt_A (char *p, ftnlen len) { - while(len-- > 0) (*f__putn)(*p++); - return(0); + while (len-- > 0) + (*f__putn) (*p++); + return (0); } - static int -#ifdef KR_headers -wrt_AW(p,w,len) char * p; ftnlen len; -#else -wrt_AW(char * p, int w, ftnlen len) -#endif +static int +wrt_AW (char *p, int w, ftnlen len) { - while(w>len) - { w--; - (*f__putn)(' '); - } - while(w-- > 0) - (*f__putn)(*p++); - return(0); + while (w > len) + { + w--; + (*f__putn) (' '); + } + while (w-- > 0) + (*f__putn) (*p++); + return (0); } - static int -#ifdef KR_headers -wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; -#else -wrt_G(ufloat *p, int w, int d, int e, ftnlen len) -#endif -{ double up = 1,x; - int i=0,oldscale,n,j; - x = len==sizeof(real)?p->pf:p->pd; - if(x < 0 ) x = -x; - if(x<.1) { - if (x != 0.) - return(wrt_E(p,w,d,e,len)); - i = 1; - goto have_i; - } - for(;i<=d;i++,up*=10) - { if(x>=up) continue; - have_i: - oldscale = f__scale; - f__scale = 0; - if(e==0) n=4; - else n=e+2; - i=wrt_F(p,w-n,d-i,len); - for(j=0;jpf : p->pd; + if (x < 0) + x = -x; + if (x < .1) + { + if (x != 0.) + return (wrt_E (p, w, d, e, len)); + i = 1; + goto have_i; + } + for (; i <= d; i++, up *= 10) + { + if (x >= up) + continue; + have_i: + oldscale = f__scale; + f__scale = 0; + if (e == 0) + n = 4; + else + n = e + 2; + i = wrt_F (p, w - n, d - i, len); + for (j = 0; j < n; j++) + (*f__putn) (' '); + f__scale = oldscale; + return (i); + } + return (wrt_E (p, w, d, e, len)); } -#ifdef KR_headers -w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len; -#else -w_ed(struct syl *p, char *ptr, ftnlen len) -#endif + +int +w_ed (struct syl * p, char *ptr, ftnlen len) { - int i; + int i; - if(f__cursor && (i = mv_cur())) - return i; - switch(p->op) - { - default: - fprintf(stderr,"w_ed, unexpected code: %d\n", p->op); - sig_die(f__fmtbuf, 1); - case I: return(wrt_I((Uint *)ptr,p->p1,len, 10)); - case IM: - return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,10)); + if (f__cursor && (i = mv_cur ())) + return i; + switch (p->op) + { + default: + fprintf (stderr, "w_ed, unexpected code: %d\n", p->op); + sig_die (f__fmtbuf, 1); + case I: + return (wrt_I ((Uint *) ptr, p->p1, len, 10)); + case IM: + return (wrt_IM ((Uint *) ptr, p->p1, p->p2.i[0], len, 10)); - /* O and OM don't work right for character, double, complex, */ - /* or doublecomplex, and they differ from Fortran 90 in */ - /* showing a minus sign for negative values. */ + /* O and OM don't work right for character, double, complex, */ + /* or doublecomplex, and they differ from Fortran 90 in */ + /* showing a minus sign for negative values. */ - case O: return(wrt_I((Uint *)ptr, p->p1, len, 8)); - case OM: - return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,8)); - case L: return(wrt_L((Uint *)ptr,p->p1, len)); - case A: return(wrt_A(ptr,len)); - case AW: - return(wrt_AW(ptr,p->p1,len)); - case D: - case E: - case EE: - return(wrt_E((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len)); - case G: - case GE: - return(wrt_G((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len)); - case F: return(wrt_F((ufloat *)ptr,p->p1,p->p2.i[0],len)); + case O: + return (wrt_I ((Uint *) ptr, p->p1, len, 8)); + case OM: + return (wrt_IM ((Uint *) ptr, p->p1, p->p2.i[0], len, 8)); + case L: + return (wrt_L ((Uint *) ptr, p->p1, len)); + case A: + return (wrt_A (ptr, len)); + case AW: + return (wrt_AW (ptr, p->p1, len)); + case D: + case E: + case EE: + return (wrt_E ((ufloat *) ptr, p->p1, p->p2.i[0], p->p2.i[1], len)); + case G: + case GE: + return (wrt_G ((ufloat *) ptr, p->p1, p->p2.i[0], p->p2.i[1], len)); + case F: + return (wrt_F ((ufloat *) ptr, p->p1, p->p2.i[0], len)); - /* Z and ZM assume 8-bit bytes. */ + /* Z and ZM assume 8-bit bytes. */ - case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len)); - case ZM: - return(wrt_Z((Uint *)ptr,p->p1,p->p2.i[0],len)); - } + case Z: + return (wrt_Z ((Uint *) ptr, p->p1, 0, len)); + case ZM: + return (wrt_Z ((Uint *) ptr, p->p1, p->p2.i[0], len)); + } } -#ifdef KR_headers -w_ned(p) struct syl *p; -#else -w_ned(struct syl *p) -#endif + +int +w_ned (struct syl * p) { - switch(p->op) - { - default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op); - sig_die(f__fmtbuf, 1); - case SLASH: - return((*f__donewrec)()); - case T: f__cursor = p->p1-f__recpos - 1; - return(1); - case TL: f__cursor -= p->p1; - if(f__cursor < -f__recpos) /* TL1000, 1X */ - f__cursor = -f__recpos; - return(1); - case TR: - case X: - f__cursor += p->p1; - return(1); - case APOS: - return(wrt_AP(p->p2.s)); - case H: - return(wrt_H(p->p1,p->p2.s)); - } + switch (p->op) + { + default: + fprintf (stderr, "w_ned, unexpected code: %d\n", p->op); + sig_die (f__fmtbuf, 1); + case SLASH: + return ((*f__donewrec) ()); + case T: + f__cursor = p->p1 - f__recpos - 1; + return (1); + case TL: + f__cursor -= p->p1; + if (f__cursor < -f__recpos) /* TL1000, 1X */ + f__cursor = -f__recpos; + return (1); + case TR: + case X: + f__cursor += p->p1; + return (1); + case APOS: + return (wrt_AP (p->p2.s)); + case H: + return (wrt_H (p->p1, p->p2.s)); + } } -- cgit v1.1