projects
/
unix-history
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
tags
|
clone url
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
new copyright; att/bsd/shared
[unix-history]
/
usr
/
src
/
usr.bin
/
f77
/
libI77
/
wrtfmt.c
diff --git
a/usr/src/usr.bin/f77/libI77/wrtfmt.c
b/usr/src/usr.bin/f77/libI77/wrtfmt.c
index
0d94b25
..
c06d737
100644
(file)
--- a/
usr/src/usr.bin/f77/libI77/wrtfmt.c
+++ b/
usr/src/usr.bin/f77/libI77/wrtfmt.c
@@
-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;