![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lwrite.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libI77|
Return to lwrite.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libI77 |
1.1 ! root 1: /* ! 2: * Copyright (c) 1980 Regents of the University of California. ! 3: * All rights reserved. The Berkeley software License Agreement ! 4: * specifies the terms and conditions for redistribution. ! 5: * ! 6: * @(#)lwrite.c 5.1 6/7/85 ! 7: */ ! 8: ! 9: /* ! 10: * list directed write ! 11: */ ! 12: ! 13: #include "fio.h" ! 14: #include "lio.h" ! 15: ! 16: int l_write(), t_putc(); ! 17: LOCAL char lwrt[] = "list write"; ! 18: ! 19: s_wsle(a) cilist *a; ! 20: { ! 21: int n; ! 22: reading = NO; ! 23: if(n=c_le(a,WRITE)) return(n); ! 24: putn = t_putc; ! 25: lioproc = l_write; ! 26: line_len = LINE; ! 27: curunit->uend = NO; ! 28: leof = NO; ! 29: if(!curunit->uwrt && ! nowwriting(curunit)) err(errflag, errno, lwrt) ! 30: return(OK); ! 31: } ! 32: ! 33: LOCAL ! 34: t_putc(c) char c; ! 35: { ! 36: if(c=='\n') recpos=0; ! 37: else recpos++; ! 38: putc(c,cf); ! 39: return(OK); ! 40: } ! 41: ! 42: e_wsle() ! 43: { int n; ! 44: PUT('\n') ! 45: return(OK); ! 46: } ! 47: ! 48: l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len; ! 49: { ! 50: int i,n; ! 51: ftnint x; ! 52: float y,z; ! 53: double yd,zd; ! 54: float *xx; ! 55: double *yy; ! 56: for(i=0;i< *number; i++) ! 57: { ! 58: switch((int)type) ! 59: { ! 60: case TYSHORT: ! 61: x=ptr->flshort; ! 62: goto xint; ! 63: case TYLONG: ! 64: x=ptr->flint; ! 65: xint: ERR(lwrt_I(x)); ! 66: break; ! 67: case TYREAL: ! 68: ERR(lwrt_F(ptr->flreal)); ! 69: break; ! 70: case TYDREAL: ! 71: ERR(lwrt_D(ptr->fldouble)); ! 72: break; ! 73: case TYCOMPLEX: ! 74: xx= &(ptr->flreal); ! 75: y = *xx++; ! 76: z = *xx; ! 77: ERR(lwrt_C(y,z)); ! 78: break; ! 79: case TYDCOMPLEX: ! 80: yy = &(ptr->fldouble); ! 81: yd= *yy++; ! 82: zd = *yy; ! 83: ERR(lwrt_DC(yd,zd)); ! 84: break; ! 85: case TYLOGICAL: ! 86: if(len == sizeof(short)) ! 87: x = ptr->flshort; ! 88: else ! 89: x = ptr->flint; ! 90: ERR(lwrt_L(x)); ! 91: break; ! 92: case TYCHAR: ! 93: ERR(lwrt_A((char *)ptr,len)); ! 94: break; ! 95: default: ! 96: fatal(F_ERSYS,"unknown type in lwrite"); ! 97: } ! 98: ptr = (flex *)((char *)ptr + len); ! 99: } ! 100: return(OK); ! 101: } ! 102: ! 103: LOCAL ! 104: lwrt_I(in) ftnint in; ! 105: { int n; ! 106: char buf[16],*p; ! 107: sprintf(buf," %ld",(long)in); ! 108: if(n=chk_len(LINTW)) return(n); ! 109: for(p=buf;*p;) PUT(*p++) ! 110: return(OK); ! 111: } ! 112: ! 113: LOCAL ! 114: lwrt_L(ln) ftnint ln; ! 115: { int n; ! 116: if(n=chk_len(LLOGW)) return(n); ! 117: return(wrt_L(&ln,LLOGW)); ! 118: } ! 119: ! 120: LOCAL ! 121: lwrt_A(p,len) char *p; ftnlen len; ! 122: { int i,n; ! 123: if(n=chk_len(LSTRW)) return(n); ! 124: PUT(' ') ! 125: PUT(' ') ! 126: for(i=0;i<len;i++) PUT(*p++) ! 127: return(OK); ! 128: } ! 129: ! 130: LOCAL ! 131: lwrt_F(fn) float fn; ! 132: { int d,n; float x; ufloat f; ! 133: if(fn==0.0) return(lwrt_0()); ! 134: f.pf = fn; ! 135: d = width(fn); ! 136: if(n=chk_len(d)) return(n); ! 137: if(d==LFW) ! 138: { ! 139: scale = 0; ! 140: for(d=LFD,x=abs(fn);x>=1.0;x/=10.0,d--); ! 141: return(wrt_F(&f,LFW,d,(ftnlen)sizeof(float))); ! 142: } ! 143: else ! 144: { ! 145: scale = 1; ! 146: return(wrt_E(&f,LEW,LED-scale,LEE,(ftnlen)sizeof(float),'E')); ! 147: } ! 148: } ! 149: ! 150: LOCAL ! 151: lwrt_D(dn) double dn; ! 152: { int d,n; double x; ufloat f; ! 153: if(dn==0.0) return(lwrt_0()); ! 154: f.pd = dn; ! 155: d = dwidth(dn); ! 156: if(n=chk_len(d)) return(n); ! 157: if(d==LDFW) ! 158: { ! 159: scale = 0; ! 160: for(d=LDFD,x=abs(dn);x>=1.0;x/=10.0,d--); ! 161: return(wrt_F(&f,LDFW,d,(ftnlen)sizeof(double))); ! 162: } ! 163: else ! 164: { ! 165: scale = 1; ! 166: return(wrt_E(&f,LDEW,LDED-scale,LDEE,(ftnlen)sizeof(double),'D')); ! 167: } ! 168: } ! 169: ! 170: LOCAL ! 171: lwrt_C(a,b) float a,b; ! 172: { int n; ! 173: if(n=chk_len(LCW)) return(n); ! 174: PUT(' ') ! 175: PUT(' ') ! 176: PUT('(') ! 177: if(n=lwrt_F(a)) return(n); ! 178: PUT(',') ! 179: if(n=lwrt_F(b)) return(n); ! 180: PUT(')') ! 181: return(OK); ! 182: } ! 183: ! 184: LOCAL ! 185: lwrt_DC(a,b) double a,b; ! 186: { int n; ! 187: if(n=chk_len(LDCW)) return(n); ! 188: PUT(' ') ! 189: PUT(' ') ! 190: PUT('(') ! 191: if(n=lwrt_D(a)) return(n); ! 192: PUT(',') ! 193: if(n=lwrt_D(b)) return(n); ! 194: PUT(')') ! 195: return(OK); ! 196: } ! 197: ! 198: LOCAL ! 199: lwrt_0() ! 200: { int n; char *z = " 0."; ! 201: if(n=chk_len(4)) return(n); ! 202: while(*z) PUT(*z++) ! 203: return(OK); ! 204: } ! 205: ! 206: LOCAL ! 207: chk_len(w) ! 208: { int n; ! 209: if(recpos+w > line_len) PUT('\n') ! 210: return(OK); ! 211: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.