← Back to branch summary

~ubuntu-branches/ubuntu/trusty/libf2c2/trusty

« back to all changes in this revision

Viewing changes to libI77/wrtfmt.c

  • Committer: Bazaar Package Importer
  • Author(s): Alan Bain
  • Date: 2008-05-19 22:50:54 UTC
  • mfrom: (2.1.4 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080519225054-jlymia0wdvvfq7dg
Tags: 20061008-4
Remove CVS directory left in source package

Show diffs side-by-side

added added

removed removed

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