new copyright; att/bsd/shared
[unix-history] / usr / src / usr.bin / f77 / libI77 / wrtfmt.c
index 0d94b25..c06d737 100644 (file)
@@ -1,6 +1,15 @@
-/*
-char id_wrtfmt[] = "@(#)wrtfmt.c       1.5";
+/*-
+ * Copyright (c) 1980 The Regents of the University of California.
+ * All rights reserved.
  *
  *
+ * %sccs.include.proprietary.c%
+ */
+
+#ifndef lint
+static char sccsid[] = "@(#)wrtfmt.c   5.2 (Berkeley) %G%";
+#endif /* not lint */
+
+/*
  * formatted write routines
  */
 
  * formatted write routines
  */
 
@@ -8,6 +17,7 @@ char id_wrtfmt[] = "@(#)wrtfmt.c       1.5";
 #include "format.h"
 
 extern char *icvt();
 #include "format.h"
 
 extern char *icvt();
+extern char *s_init;
 
 #define abs(x) (x<0?-x:x)
 
 
 #define abs(x) (x<0?-x:x)
 
@@ -20,20 +30,23 @@ w_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
        case IM:
                return(wrt_IM(ptr,p->p1,p->p2,len));
        case L:
        case IM:
                return(wrt_IM(ptr,p->p1,p->p2,len));
        case L:
-               return(wrt_L(ptr,p->p1));
+               return(wrt_L(ptr,p->p1,len));
        case A:
        case A:
-               p->p1 = len;    /* cheap trick */
+               return(wrt_AW(ptr,len,len));
        case AW:
                return(wrt_AW(ptr,p->p1,len));
        case D:
        case AW:
                return(wrt_AW(ptr,p->p1,len));
        case D:
+               return(wrt_E(ptr,p->p1,p->p2,2,len,'d'));
        case DE:
        case DE:
-               return(wrt_E(ptr,p->p1,p->p2,p->p3,len,'d'));
+               return(wrt_E(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len,'d'));
        case E:
        case E:
+               return(wrt_E(ptr,p->p1,p->p2,2,len,'e'));
        case EE:
        case EE:
-               return(wrt_E(ptr,p->p1,p->p2,p->p3,len,'e'));
+               return(wrt_E(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len,'e'));
        case G:
        case G:
+               return(wrt_G(ptr,p->p1,p->p2,2,len));
        case GE:
        case GE:
-               return(wrt_G(ptr,p->p1,p->p2,p->p3,len));
+               return(wrt_G(ptr,p->p1,(p->p2)&0xff,((p->p2)>>8)&0xff,len));
        case F:
                return(wrt_F(ptr,p->p1,p->p2,len));
        default:
        case F:
                return(wrt_F(ptr,p->p1,p->p2,len));
        default:
@@ -56,29 +69,34 @@ w_ned(p,ptr) char *ptr; struct syl *p;
                return(OK);
        case TL:
                cursor -= p->p1;
                return(OK);
        case TL:
                cursor -= p->p1;
+               if ((recpos + cursor) < 0) cursor = -recpos;    /* ANSI req'd */
                tab = YES;
                return(OK);
        case TR:
        case X:
                cursor += p->p1;
                tab = YES;
                return(OK);
        case TR:
        case X:
                cursor += p->p1;
-               tab = (p->op == TR);
+               /* tab = (p->op == TR); this would implement destructive X */
+               tab = YES;
                return(OK);
        case APOS:
                return(OK);
        case APOS:
-               return(wrt_AP(p->p1));
+               return(wrt_AP(&s_init[p->p1]));
        case H:
        case H:
-               return(wrt_H(p->p1,p->p2));
+               return(wrt_H(p->p1,&s_init[p->p2]));
        default:
                return(errno=F_ERFMT);
        }
 }
 
        default:
                return(errno=F_ERFMT);
        }
 }
 
+LOCAL
 wr_mvcur()
 {      int n;
        if(tab) return((*dotab)());
 wr_mvcur()
 {      int n;
        if(tab) return((*dotab)());
+       if (cursor < 0) return(errno=F_ERSEEK);
        while(cursor--) PUT(' ')
        return(cursor=0);
 }
 
        while(cursor--) PUT(' ')
        return(cursor=0);
 }
 
+LOCAL
 wrt_IM(ui,w,m,len) uint *ui; ftnlen len;
 {      int ndigit,sign,spare,i,xsign,n;
        long x;
 wrt_IM(ui,w,m,len) uint *ui; ftnlen len;
 {      int ndigit,sign,spare,i,xsign,n;
        long x;
@@ -109,6 +127,7 @@ wrt_IM(ui,w,m,len) uint *ui; ftnlen len;
        return(OK);
 }
 
        return(OK);
 }
 
+LOCAL
 wrt_AP(p)
 {      char *s,quote;
        int n;
 wrt_AP(p)
 {      char *s,quote;
        int n;
@@ -123,6 +142,7 @@ wrt_AP(p)
        return(OK);
 }
 
        return(OK);
 }
 
+LOCAL
 wrt_H(a,b)
 {      char *s=(char *)b;
        int n;
 wrt_H(a,b)
 {      char *s=(char *)b;
        int n;
@@ -131,14 +151,19 @@ wrt_H(a,b)
        return(OK);
 }
 
        return(OK);
 }
 
-wrt_L(l,len) ftnint *l;
+wrt_L(l,width,len) uint *l; ftnlen len;
 {      int i,n;
 {      int i,n;
-       for(i=0;i<len-1;i++) PUT(' ')
-       if(*l) PUT('t')
+       for(i=0;i<width-1;i++) PUT(' ')
+       if(len == sizeof (short))
+               i = l->is;
+       else
+               i = l->il;
+       if(i) PUT('t')
        else PUT('f')
        return(OK);
 }
 
        else PUT('f')
        return(OK);
 }
 
+LOCAL
 wrt_AW(p,w,len) char * p; ftnlen len;
 {      int n;
        while(w>len)
 wrt_AW(p,w,len) char * p; ftnlen len;
 {      int n;
        while(w>len)
@@ -157,7 +182,10 @@ wrt_E(p,w,d,e,len,expch) ufloat *p; ftnlen len; char expch;
 
        if((len==sizeof(float)?p->pf:p->pd)==0.0)
        {
 
        if((len==sizeof(float)?p->pf:p->pd)==0.0)
        {
+               n = cblank;
+               cblank = 1;     /* force '0' fill */
                wrt_F(p,w-(e+2),d,len);
                wrt_F(p,w-(e+2),d,len);
+               cblank = n;
                PUT(expch)
                PUT('+')
 /*             for(i=0;i<(e-1);i++)PUT(' ')
                PUT(expch)
                PUT('+')
 /*             for(i=0;i<(e-1);i++)PUT(' ')
@@ -166,13 +194,19 @@ deleted           PUT('0')
 /* added */    for(i=0;i<e;i++) PUT('0')
                return(OK);
        }
 /* added */    for(i=0;i<e;i++) PUT('0')
                return(OK);
        }
-       dd = d + scale;
+       if (scale > 0) {        /* insane ANSI requirement */
+               dd = d + 1;
+               d = dd - scale;
+       } else
+               dd = d + scale;
+       if (dd <= 0 || d < 0) goto E_badfield;
        s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign);
        delta = 3+e;
        if(sign||cplus) delta++;
        pad=w-(delta+d)-(scale>0? scale:0);
        s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign);
        delta = 3+e;
        if(sign||cplus) delta++;
        pad=w-(delta+d)-(scale>0? scale:0);
-       if(pad<0)
-       {       for(i=0;i<w;i++) PUT('*')
+       if(pad<0) {
+E_badfield:
+               for(i=0;i<w;i++) PUT('*')
                return(OK);
        }
        for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ')
                return(OK);
        }
        for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ')
@@ -213,6 +247,7 @@ deleted             PUT('0')
        return(OK);
 }
 
        return(OK);
 }
 
+LOCAL
 wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
 {      double uplim = 1.0, x;
        int i,oldscale,n,j,ne;
 wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
 {      double uplim = 1.0, x;
        int i,oldscale,n,j,ne;