home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / octa21fs.zip / octave / f2c / libi77 / wrtfmt.c < prev    next >
C/C++ Source or Header  |  2000-01-15  |  8KB  |  372 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. extern int f__cursor;
  5. #ifdef KR_headers
  6. extern char *f__icvt();
  7. #else
  8. extern char *f__icvt(long, int*, int*, int);
  9. #endif
  10. int f__hiwater;
  11. icilist *f__svic;
  12. char *f__icptr;
  13. mv_cur(Void)    /* shouldn't use fseek because it insists on calling fflush */
  14.         /* instead we know too much about stdio */
  15. {
  16.     if(f__external == 0) {
  17.         if(f__cursor < 0) {
  18.             if(f__hiwater < f__recpos)
  19.                 f__hiwater = f__recpos;
  20.             f__recpos += f__cursor;
  21.             f__icptr += f__cursor;
  22.             f__cursor = 0;
  23.             if(f__recpos < 0)
  24.                 err(f__elist->cierr, 110, "left off");
  25.         }
  26.         else if(f__cursor > 0) {
  27.             if(f__recpos + f__cursor >= f__svic->icirlen)
  28.                 err(f__elist->cierr, 110, "recend");
  29.             if(f__hiwater <= f__recpos)
  30.                 for(; f__cursor > 0; f__cursor--)
  31.                     (*f__putn)(' ');
  32.             else if(f__hiwater <= f__recpos + f__cursor) {
  33.                 f__cursor -= f__hiwater - f__recpos;
  34.                 f__icptr += f__hiwater - f__recpos;
  35.                 f__recpos = f__hiwater;
  36.                 for(; f__cursor > 0; f__cursor--)
  37.                     (*f__putn)(' ');
  38.             }
  39.             else {
  40.                 f__icptr += f__cursor;
  41.                 f__recpos += f__cursor;
  42.             }
  43.             f__cursor = 0;
  44.         }
  45.         return(0);
  46.     }
  47.     if(f__cursor > 0) {
  48.         if(f__hiwater <= f__recpos)
  49.             for(;f__cursor>0;f__cursor--) (*f__putn)(' ');
  50.         else if(f__hiwater <= f__recpos + f__cursor) {
  51. #ifndef NON_UNIX_STDIO
  52.             if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
  53.                 f__cf->_ptr += f__hiwater - f__recpos;
  54.             else
  55. #endif
  56.                 (void) fseek(f__cf, (long) (f__hiwater - f__recpos), SEEK_CUR);
  57.             f__cursor -= f__hiwater - f__recpos;
  58.             f__recpos = f__hiwater;
  59.             for(; f__cursor > 0; f__cursor--)
  60.                 (*f__putn)(' ');
  61.         }
  62.         else {
  63. #ifndef NON_UNIX_STDIO
  64.             if(f__cf->_ptr + f__cursor < buf_end(f__cf))
  65.                 f__cf->_ptr += f__cursor;
  66.             else
  67. #endif
  68.                 (void) fseek(f__cf, (long)f__cursor, SEEK_CUR);
  69.             f__recpos += f__cursor;
  70.         }
  71.     }
  72.     if(f__cursor<0)
  73.     {
  74.         if(f__cursor+f__recpos<0) err(f__elist->cierr,110,"left off");
  75. #ifndef NON_UNIX_STDIO
  76.         if(f__cf->_ptr + f__cursor >= f__cf->_base)
  77.             f__cf->_ptr += f__cursor;
  78.         else
  79. #endif
  80.         if(f__curunit && f__curunit->useek)
  81.             (void) fseek(f__cf,(long)f__cursor,SEEK_CUR);
  82.         else
  83.             err(f__elist->cierr,106,"fmt");
  84.         if(f__hiwater < f__recpos)
  85.             f__hiwater = f__recpos;
  86.         f__recpos += f__cursor;
  87.         f__cursor=0;
  88.     }
  89.     return(0);
  90. }
  91.  
  92.  static int
  93. #ifdef KR_headers
  94. wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len;
  95. #else
  96. wrt_Z(Uint *n, int w, int minlen, ftnlen len)
  97. #endif
  98. {
  99.     register char *s, *se;
  100.     register i, w1;
  101.     static int one = 1;
  102.     static char hex[] = "0123456789ABCDEF";
  103.     s = (char *)n;
  104.     --len;
  105.     if (*(char *)&one) {
  106.         /* little endian */
  107.         se = s;
  108.         s += len;
  109.         i = -1;
  110.         }
  111.     else {
  112.         se = s + len;
  113.         i = 1;
  114.         }
  115.     for(;; s += i)
  116.         if (s == se || *s)
  117.             break;
  118.     w1 = (i*(se-s) << 1) + 1;
  119.     if (*s & 0xf0)
  120.         w1++;
  121.     if (w1 > w)
  122.         for(i = 0; i < w; i++)
  123.             (*f__putn)('*');
  124.     else {
  125.         if ((minlen -= w1) > 0)
  126.             w1 += minlen;
  127.         while(--w >= w1)
  128.             (*f__putn)(' ');
  129.         while(--minlen >= 0)
  130.             (*f__putn)('0');
  131.         if (!(*s & 0xf0)) {
  132.             (*f__putn)(hex[*s & 0xf]);
  133.             if (s == se)
  134.                 return 0;
  135.             s += i;
  136.             }
  137.         for(;; s += i) {
  138.             (*f__putn)(hex[*s >> 4 & 0xf]);
  139.             (*f__putn)(hex[*s & 0xf]);
  140.             if (s == se)
  141.                 break;
  142.             }
  143.         }
  144.     return 0;
  145.     }
  146.  
  147.  static int
  148. #ifdef KR_headers
  149. wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base;
  150. #else
  151. wrt_I(Uint *n, int w, ftnlen len, register int base)
  152. #endif
  153. {    int ndigit,sign,spare,i;
  154.     long x;
  155.     char *ans;
  156.     if(len==sizeof(integer)) x=n->il;
  157.     else if(len == sizeof(char)) x = n->ic;
  158. #ifdef Allow_TYQUAD
  159.     else if (len == sizeof(longint)) x = n->ili;
  160. #endif
  161.     else x=n->is;
  162.     ans=f__icvt(x,&ndigit,&sign, base);
  163.     spare=w-ndigit;
  164.     if(sign || f__cplus) spare--;
  165.     if(spare<0)
  166.         for(i=0;i<w;i++) (*f__putn)('*');
  167.     else
  168.     {    for(i=0;i<spare;i++) (*f__putn)(' ');
  169.         if(sign) (*f__putn)('-');
  170.         else if(f__cplus) (*f__putn)('+');
  171.         for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
  172.     }
  173.     return(0);
  174. }
  175.  static int
  176. #ifdef KR_headers
  177. wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base;
  178. #else
  179. wrt_IM(Uint *n, int w, int m, ftnlen len, int base)
  180. #endif
  181. {    int ndigit,sign,spare,i,xsign;
  182.     long x;
  183.     char *ans;
  184.     if(sizeof(integer)==len) x=n->il;
  185.     else if(len == sizeof(char)) x = n->ic;
  186.     else x=n->is;
  187.     ans=f__icvt(x,&ndigit,&sign, base);
  188.     if(sign || f__cplus) xsign=1;
  189.     else xsign=0;
  190.     if(ndigit+xsign>w || m+xsign>w)
  191.     {    for(i=0;i<w;i++) (*f__putn)('*');
  192.         return(0);
  193.     }
  194.     if(x==0 && m==0)
  195.     {    for(i=0;i<w;i++) (*f__putn)(' ');
  196.         return(0);
  197.     }
  198.     if(ndigit>=m)
  199.         spare=w-ndigit-xsign;
  200.     else
  201.         spare=w-m-xsign;
  202.     for(i=0;i<spare;i++) (*f__putn)(' ');
  203.     if(sign) (*f__putn)('-');
  204.     else if(f__cplus) (*f__putn)('+');
  205.     for(i=0;i<m-ndigit;i++) (*f__putn)('0');
  206.     for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
  207.     return(0);
  208. }
  209.  static int
  210. #ifdef KR_headers
  211. wrt_AP(s) char *s;
  212. #else
  213. wrt_AP(char *s)
  214. #endif
  215. {    char quote;
  216.     if(f__cursor && mv_cur()) return(mv_cur());
  217.     quote = *s++;
  218.     for(;*s;s++)
  219.     {    if(*s!=quote) (*f__putn)(*s);
  220.         else if(*++s==quote) (*f__putn)(*s);
  221.         else return(1);
  222.     }
  223.     return(1);
  224. }
  225.  static int
  226. #ifdef KR_headers
  227. wrt_H(a,s) char *s;
  228. #else
  229. wrt_H(int a, char *s)
  230. #endif
  231. {
  232.     if(f__cursor && mv_cur()) return(mv_cur());
  233.     while(a--) (*f__putn)(*s++);
  234.     return(1);
  235. }
  236. #ifdef KR_headers
  237. wrt_L(n,len, sz) Uint *n; ftnlen sz;
  238. #else
  239. wrt_L(Uint *n, int len, ftnlen sz)
  240. #endif
  241. {    int i;
  242.     long x;
  243.     if(sizeof(long)==sz) x=n->il;
  244.     else if(sz == sizeof(char)) x = n->ic;
  245.     else x=n->is;
  246.     for(i=0;i<len-1;i++)
  247.         (*f__putn)(' ');
  248.     if(x) (*f__putn)('T');
  249.     else (*f__putn)('F');
  250.     return(0);
  251. }
  252.  static int
  253. #ifdef KR_headers
  254. wrt_A(p,len) char *p; ftnlen len;
  255. #else
  256. wrt_A(char *p, ftnlen len)
  257. #endif
  258. {
  259.     while(len-- > 0) (*f__putn)(*p++);
  260.     return(0);
  261. }
  262.  static int
  263. #ifdef KR_headers
  264. wrt_AW(p,w,len) char * p; ftnlen len;
  265. #else
  266. wrt_AW(char * p, int w, ftnlen len)
  267. #endif
  268. {
  269.     while(w>len)
  270.     {    w--;
  271.         (*f__putn)(' ');
  272.     }
  273.     while(w-- > 0)
  274.         (*f__putn)(*p++);
  275.     return(0);
  276. }
  277.  
  278.  static int
  279. #ifdef KR_headers
  280. wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
  281. #else
  282. wrt_G(ufloat *p, int w, int d, int e, ftnlen len)
  283. #endif
  284. {    double up = 1,x;
  285.     int i,oldscale=f__scale,n,j;
  286.     x= len==sizeof(real)?p->pf:p->pd;
  287.     if(x < 0 ) x = -x;
  288.     if(x<.1) return(wrt_E(p,w,d,e,len));
  289.     for(i=0;i<=d;i++,up*=10)
  290.     {    if(x>=up) continue;
  291.         f__scale=0;
  292.         if(e==0) n=4;
  293.         else    n=e+2;
  294.         i=wrt_F(p,w-n,d-i,len);
  295.         for(j=0;j<n;j++) (*f__putn)(' ');
  296.         f__scale=oldscale;
  297.         return(i);
  298.     }
  299.     return(wrt_E(p,w,d,e,len));
  300. }
  301. #ifdef KR_headers
  302. w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
  303. #else
  304. w_ed(struct syl *p, char *ptr, ftnlen len)
  305. #endif
  306. {
  307.     if(f__cursor && mv_cur()) return(mv_cur());
  308.     switch(p->op)
  309.     {
  310.     default:
  311.         fprintf(stderr,"w_ed, unexpected code: %d\n", p->op);
  312.         sig_die(f__fmtbuf, 1);
  313.     case I:    return(wrt_I((Uint *)ptr,p->p1,len, 10));
  314.     case IM:
  315.         return(wrt_IM((Uint *)ptr,p->p1,p->p2,len,10));
  316.  
  317.         /* O and OM don't work right for character, double, complex, */
  318.         /* or doublecomplex, and they differ from Fortran 90 in */
  319.         /* showing a minus sign for negative values. */
  320.  
  321.     case O:    return(wrt_I((Uint *)ptr, p->p1, len, 8));
  322.     case OM:
  323.         return(wrt_IM((Uint *)ptr,p->p1,p->p2,len,8));
  324.     case L:    return(wrt_L((Uint *)ptr,p->p1, len));
  325.     case A: return(wrt_A(ptr,len));
  326.     case AW:
  327.         return(wrt_AW(ptr,p->p1,len));
  328.     case D:
  329.     case E:
  330.     case EE:
  331.         return(wrt_E((ufloat *)ptr,p->p1,p->p2,p->p3,len));
  332.     case G:
  333.     case GE:
  334.         return(wrt_G((ufloat *)ptr,p->p1,p->p2,p->p3,len));
  335.     case F:    return(wrt_F((ufloat *)ptr,p->p1,p->p2,len));
  336.  
  337.         /* Z and ZM assume 8-bit bytes. */
  338.  
  339.     case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len));
  340.     case ZM:
  341.         return(wrt_Z((Uint *)ptr,p->p1,p->p2,len));
  342.     }
  343. }
  344. #ifdef KR_headers
  345. w_ned(p) struct syl *p;
  346. #else
  347. w_ned(struct syl *p)
  348. #endif
  349. {
  350.     switch(p->op)
  351.     {
  352.     default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op);
  353.         sig_die(f__fmtbuf, 1);
  354.     case SLASH:
  355.         return((*f__donewrec)());
  356.     case T: f__cursor = p->p1-f__recpos - 1;
  357.         return(1);
  358.     case TL: f__cursor -= p->p1;
  359.         if(f__cursor < -f__recpos)    /* TL1000, 1X */
  360.             f__cursor = -f__recpos;
  361.         return(1);
  362.     case TR:
  363.     case X:
  364.         f__cursor += p->p1;
  365.         return(1);
  366.     case APOS:
  367.         return(wrt_AP(*(char **)&p->p2));
  368.     case H:
  369.         return(wrt_H(p->p1,*(char **)&p->p2));
  370.     }
  371. }
  372.