~ubuntu-branches/ubuntu/raring/texlive-bin/raring

« back to all changes in this revision

Viewing changes to utils/pmx/pmx-2.6.17/libf2c/fmt.c

  • Committer: Package Import Robot
  • Author(s): Norbert Preining
  • Date: 2012-05-30 11:02:05 UTC
  • mfrom: (4.1.20 sid)
  • Revision ID: package-import@ubuntu.com-20120530110205-9gb0n01ahjs4g15y
Tags: 2012.20120530-1
* new upstream snapshot (svn 26726)
  exporting kpse_cnf_get (Closes: #675109)
* cnf.h is again installed, don't install it via libkpathsea-dev.install
* patch handling:
  . removed: 41_maketexmf, 12_fix_epstopdf_invocation
    both included upstream or not needed anymore
  . new: set-e-fmtutil part of set-e-in-various-scripts that still 
    applies
  . disabled: 57_texconfig_papersizes_for_upstream,
    58_texconfig_papersizes_use_ucf, superseeded by 55_texconfig_stuff
  . disabled: set-e-in-various-scripts: split into set-e-fmtutil
    and a disabled part for texconfig

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
#include "f2c.h"
2
 
#include "fio.h"
3
 
#include "fmt.h"
4
 
#ifdef __cplusplus
5
 
extern "C" {
6
 
#endif
7
 
#define skip(s) while(*s==' ') s++
8
 
#ifdef interdata
9
 
#define SYLMX 300
10
 
#endif
11
 
#ifdef pdp11
12
 
#define SYLMX 300
13
 
#endif
14
 
#ifdef vax
15
 
#define SYLMX 300
16
 
#endif
17
 
#ifndef SYLMX
18
 
#define SYLMX 300
19
 
#endif
20
 
#define GLITCH '\2'
21
 
        /* special quote character for stu */
22
 
extern flag f__cblank,f__cplus; /*blanks in I and compulsory plus*/
23
 
static struct syl f__syl[SYLMX];
24
 
int f__parenlvl,f__pc,f__revloc;
25
 
 
26
 
 static
27
 
#ifdef KR_headers
28
 
char *ap_end(s) char *s;
29
 
#else
30
 
char *ap_end(char *s)
31
 
#endif
32
 
{       char quote;
33
 
        quote= *s++;
34
 
        for(;*s;s++)
35
 
        {       if(*s!=quote) continue;
36
 
                if(*++s!=quote) return(s);
37
 
        }
38
 
        if(f__elist->cierr) {
39
 
                errno = 100;
40
 
                return(NULL);
41
 
        }
42
 
        f__fatal(100, "bad string");
43
 
        /*NOTREACHED*/ return 0;
44
 
}
45
 
 static int
46
 
#ifdef KR_headers
47
 
op_gen(a,b,c,d)
48
 
#else
49
 
op_gen(int a, int b, int c, int d)
50
 
#endif
51
 
{       struct syl *p= &f__syl[f__pc];
52
 
        if(f__pc>=SYLMX)
53
 
        {       fprintf(stderr,"format too complicated:\n");
54
 
                sig_die(f__fmtbuf, 1);
55
 
        }
56
 
        p->op=a;
57
 
        p->p1=b;
58
 
        p->p2.i[0]=c;
59
 
        p->p2.i[1]=d;
60
 
        return(f__pc++);
61
 
}
62
 
#ifdef KR_headers
63
 
static char *f_list();
64
 
static char *gt_num(s,n,n1) char *s; int *n, n1;
65
 
#else
66
 
static char *f_list(char*);
67
 
static char *gt_num(char *s, int *n, int n1)
68
 
#endif
69
 
{       int m=0,f__cnt=0;
70
 
        char c;
71
 
        for(c= *s;;c = *s)
72
 
        {       if(c==' ')
73
 
                {       s++;
74
 
                        continue;
75
 
                }
76
 
                if(c>'9' || c<'0') break;
77
 
                m=10*m+c-'0';
78
 
                f__cnt++;
79
 
                s++;
80
 
        }
81
 
        if(f__cnt==0) {
82
 
                if (!n1)
83
 
                        s = 0;
84
 
                *n=n1;
85
 
                }
86
 
        else *n=m;
87
 
        return(s);
88
 
}
89
 
 
90
 
 static
91
 
#ifdef KR_headers
92
 
char *f_s(s,curloc) char *s;
93
 
#else
94
 
char *f_s(char *s, int curloc)
95
 
#endif
96
 
{
97
 
        skip(s);
98
 
        if(*s++!='(')
99
 
        {
100
 
                return(NULL);
101
 
        }
102
 
        if(f__parenlvl++ ==1) f__revloc=curloc;
103
 
        if(op_gen(RET1,curloc,0,0)<0 ||
104
 
                (s=f_list(s))==NULL)
105
 
        {
106
 
                return(NULL);
107
 
        }
108
 
        skip(s);
109
 
        return(s);
110
 
}
111
 
 
112
 
 static int
113
 
#ifdef KR_headers
114
 
ne_d(s,p) char *s,**p;
115
 
#else
116
 
ne_d(char *s, char **p)
117
 
#endif
118
 
{       int n,x,sign=0;
119
 
        struct syl *sp;
120
 
        switch(*s)
121
 
        {
122
 
        default:
123
 
                return(0);
124
 
        case ':': (void) op_gen(COLON,0,0,0); break;
125
 
        case '$':
126
 
                (void) op_gen(NONL, 0, 0, 0); break;
127
 
        case 'B':
128
 
        case 'b':
129
 
                if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
130
 
                else (void) op_gen(BN,0,0,0);
131
 
                break;
132
 
        case 'S':
133
 
        case 's':
134
 
                if(*(s+1)=='s' || *(s+1) == 'S')
135
 
                {       x=SS;
136
 
                        s++;
137
 
                }
138
 
                else if(*(s+1)=='p' || *(s+1) == 'P')
139
 
                {       x=SP;
140
 
                        s++;
141
 
                }
142
 
                else x=S;
143
 
                (void) op_gen(x,0,0,0);
144
 
                break;
145
 
        case '/': (void) op_gen(SLASH,0,0,0); break;
146
 
        case '-': sign=1;
147
 
        case '+':       s++;    /*OUTRAGEOUS CODING TRICK*/
148
 
        case '0': case '1': case '2': case '3': case '4':
149
 
        case '5': case '6': case '7': case '8': case '9':
150
 
                if (!(s=gt_num(s,&n,0))) {
151
 
 bad:                   *p = 0;
152
 
                        return 1;
153
 
                        }
154
 
                switch(*s)
155
 
                {
156
 
                default:
157
 
                        return(0);
158
 
                case 'P':
159
 
                case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
160
 
                case 'X':
161
 
                case 'x': (void) op_gen(X,n,0,0); break;
162
 
                case 'H':
163
 
                case 'h':
164
 
                        sp = &f__syl[op_gen(H,n,0,0)];
165
 
                        sp->p2.s = s + 1;
166
 
                        s+=n;
167
 
                        break;
168
 
                }
169
 
                break;
170
 
        case GLITCH:
171
 
        case '"':
172
 
        case '\'':
173
 
                sp = &f__syl[op_gen(APOS,0,0,0)];
174
 
                sp->p2.s = s;
175
 
                if((*p = ap_end(s)) == NULL)
176
 
                        return(0);
177
 
                return(1);
178
 
        case 'T':
179
 
        case 't':
180
 
                if(*(s+1)=='l' || *(s+1) == 'L')
181
 
                {       x=TL;
182
 
                        s++;
183
 
                }
184
 
                else if(*(s+1)=='r'|| *(s+1) == 'R')
185
 
                {       x=TR;
186
 
                        s++;
187
 
                }
188
 
                else x=T;
189
 
                if (!(s=gt_num(s+1,&n,0)))
190
 
                        goto bad;
191
 
                s--;
192
 
                (void) op_gen(x,n,0,0);
193
 
                break;
194
 
        case 'X':
195
 
        case 'x': (void) op_gen(X,1,0,0); break;
196
 
        case 'P':
197
 
        case 'p': (void) op_gen(P,1,0,0); break;
198
 
        }
199
 
        s++;
200
 
        *p=s;
201
 
        return(1);
202
 
}
203
 
 
204
 
 static int
205
 
#ifdef KR_headers
206
 
e_d(s,p) char *s,**p;
207
 
#else
208
 
e_d(char *s, char **p)
209
 
#endif
210
 
{       int i,im,n,w,d,e,found=0,x=0;
211
 
        char *sv=s;
212
 
        s=gt_num(s,&n,1);
213
 
        (void) op_gen(STACK,n,0,0);
214
 
        switch(*s++)
215
 
        {
216
 
        default: break;
217
 
        case 'E':
218
 
        case 'e':       x=1;
219
 
        case 'G':
220
 
        case 'g':
221
 
                found=1;
222
 
                if (!(s=gt_num(s,&w,0))) {
223
 
 bad:
224
 
                        *p = 0;
225
 
                        return 1;
226
 
                        }
227
 
                if(w==0) break;
228
 
                if(*s=='.') {
229
 
                        if (!(s=gt_num(s+1,&d,0)))
230
 
                                goto bad;
231
 
                        }
232
 
                else d=0;
233
 
                if(*s!='E' && *s != 'e')
234
 
                        (void) op_gen(x==1?E:G,w,d,0);  /* default is Ew.dE2 */
235
 
                else {
236
 
                        if (!(s=gt_num(s+1,&e,0)))
237
 
                                goto bad;
238
 
                        (void) op_gen(x==1?EE:GE,w,d,e);
239
 
                        }
240
 
                break;
241
 
        case 'O':
242
 
        case 'o':
243
 
                i = O;
244
 
                im = OM;
245
 
                goto finish_I;
246
 
        case 'Z':
247
 
        case 'z':
248
 
                i = Z;
249
 
                im = ZM;
250
 
                goto finish_I;
251
 
        case 'L':
252
 
        case 'l':
253
 
                found=1;
254
 
                if (!(s=gt_num(s,&w,0)))
255
 
                        goto bad;
256
 
                if(w==0) break;
257
 
                (void) op_gen(L,w,0,0);
258
 
                break;
259
 
        case 'A':
260
 
        case 'a':
261
 
                found=1;
262
 
                skip(s);
263
 
                if(*s>='0' && *s<='9')
264
 
                {       s=gt_num(s,&w,1);
265
 
                        if(w==0) break;
266
 
                        (void) op_gen(AW,w,0,0);
267
 
                        break;
268
 
                }
269
 
                (void) op_gen(A,0,0,0);
270
 
                break;
271
 
        case 'F':
272
 
        case 'f':
273
 
                if (!(s=gt_num(s,&w,0)))
274
 
                        goto bad;
275
 
                found=1;
276
 
                if(w==0) break;
277
 
                if(*s=='.') {
278
 
                        if (!(s=gt_num(s+1,&d,0)))
279
 
                                goto bad;
280
 
                        }
281
 
                else d=0;
282
 
                (void) op_gen(F,w,d,0);
283
 
                break;
284
 
        case 'D':
285
 
        case 'd':
286
 
                found=1;
287
 
                if (!(s=gt_num(s,&w,0)))
288
 
                        goto bad;
289
 
                if(w==0) break;
290
 
                if(*s=='.') {
291
 
                        if (!(s=gt_num(s+1,&d,0)))
292
 
                                goto bad;
293
 
                        }
294
 
                else d=0;
295
 
                (void) op_gen(D,w,d,0);
296
 
                break;
297
 
        case 'I':
298
 
        case 'i':
299
 
                i = I;
300
 
                im = IM;
301
 
 finish_I:
302
 
                if (!(s=gt_num(s,&w,0)))
303
 
                        goto bad;
304
 
                found=1;
305
 
                if(w==0) break;
306
 
                if(*s!='.')
307
 
                {       (void) op_gen(i,w,0,0);
308
 
                        break;
309
 
                }
310
 
                if (!(s=gt_num(s+1,&d,0)))
311
 
                        goto bad;
312
 
                (void) op_gen(im,w,d,0);
313
 
                break;
314
 
        }
315
 
        if(found==0)
316
 
        {       f__pc--; /*unSTACK*/
317
 
                *p=sv;
318
 
                return(0);
319
 
        }
320
 
        *p=s;
321
 
        return(1);
322
 
}
323
 
 static
324
 
#ifdef KR_headers
325
 
char *i_tem(s) char *s;
326
 
#else
327
 
char *i_tem(char *s)
328
 
#endif
329
 
{       char *t;
330
 
        int n,curloc;
331
 
        if(*s==')') return(s);
332
 
        if(ne_d(s,&t)) return(t);
333
 
        if(e_d(s,&t)) return(t);
334
 
        s=gt_num(s,&n,1);
335
 
        if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
336
 
        return(f_s(s,curloc));
337
 
}
338
 
 
339
 
 static
340
 
#ifdef KR_headers
341
 
char *f_list(s) char *s;
342
 
#else
343
 
char *f_list(char *s)
344
 
#endif
345
 
{
346
 
        for(;*s!=0;)
347
 
        {       skip(s);
348
 
                if((s=i_tem(s))==NULL) return(NULL);
349
 
                skip(s);
350
 
                if(*s==',') s++;
351
 
                else if(*s==')')
352
 
                {       if(--f__parenlvl==0)
353
 
                        {
354
 
                                (void) op_gen(REVERT,f__revloc,0,0);
355
 
                                return(++s);
356
 
                        }
357
 
                        (void) op_gen(GOTO,0,0,0);
358
 
                        return(++s);
359
 
                }
360
 
        }
361
 
        return(NULL);
362
 
}
363
 
 
364
 
 int
365
 
#ifdef KR_headers
366
 
pars_f(s) char *s;
367
 
#else
368
 
pars_f(char *s)
369
 
#endif
370
 
{
371
 
        f__parenlvl=f__revloc=f__pc=0;
372
 
        if(f_s(s,0) == NULL)
373
 
        {
374
 
                return(-1);
375
 
        }
376
 
        return(0);
377
 
}
378
 
#define STKSZ 10
379
 
int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
380
 
flag f__workdone, f__nonl;
381
 
 
382
 
 static int
383
 
#ifdef KR_headers
384
 
type_f(n)
385
 
#else
386
 
type_f(int n)
387
 
#endif
388
 
{
389
 
        switch(n)
390
 
        {
391
 
        default:
392
 
                return(n);
393
 
        case RET1:
394
 
                return(RET1);
395
 
        case REVERT: return(REVERT);
396
 
        case GOTO: return(GOTO);
397
 
        case STACK: return(STACK);
398
 
        case X:
399
 
        case SLASH:
400
 
        case APOS: case H:
401
 
        case T: case TL: case TR:
402
 
                return(NED);
403
 
        case F:
404
 
        case I:
405
 
        case IM:
406
 
        case A: case AW:
407
 
        case O: case OM:
408
 
        case L:
409
 
        case E: case EE: case D:
410
 
        case G: case GE:
411
 
        case Z: case ZM:
412
 
                return(ED);
413
 
        }
414
 
}
415
 
#ifdef KR_headers
416
 
integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
417
 
#else
418
 
integer do_fio(ftnint *number, char *ptr, ftnlen len)
419
 
#endif
420
 
{       struct syl *p;
421
 
        int n,i;
422
 
        for(i=0;i<*number;i++,ptr+=len)
423
 
        {
424
 
loop:   switch(type_f((p= &f__syl[f__pc])->op))
425
 
        {
426
 
        default:
427
 
                fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
428
 
                        p->op,f__fmtbuf);
429
 
                err(f__elist->cierr,100,"do_fio");
430
 
        case NED:
431
 
                if((*f__doned)(p))
432
 
                {       f__pc++;
433
 
                        goto loop;
434
 
                }
435
 
                f__pc++;
436
 
                continue;
437
 
        case ED:
438
 
                if(f__cnt[f__cp]<=0)
439
 
                {       f__cp--;
440
 
                        f__pc++;
441
 
                        goto loop;
442
 
                }
443
 
                if(ptr==NULL)
444
 
                        return((*f__doend)());
445
 
                f__cnt[f__cp]--;
446
 
                f__workdone=1;
447
 
                if((n=(*f__doed)(p,ptr,len))>0)
448
 
                        errfl(f__elist->cierr,errno,"fmt");
449
 
                if(n<0)
450
 
                        err(f__elist->ciend,(EOF),"fmt");
451
 
                continue;
452
 
        case STACK:
453
 
                f__cnt[++f__cp]=p->p1;
454
 
                f__pc++;
455
 
                goto loop;
456
 
        case RET1:
457
 
                f__ret[++f__rp]=p->p1;
458
 
                f__pc++;
459
 
                goto loop;
460
 
        case GOTO:
461
 
                if(--f__cnt[f__cp]<=0)
462
 
                {       f__cp--;
463
 
                        f__rp--;
464
 
                        f__pc++;
465
 
                        goto loop;
466
 
                }
467
 
                f__pc=1+f__ret[f__rp--];
468
 
                goto loop;
469
 
        case REVERT:
470
 
                f__rp=f__cp=0;
471
 
                f__pc = p->p1;
472
 
                if(ptr==NULL)
473
 
                        return((*f__doend)());
474
 
                if(!f__workdone) return(0);
475
 
                if((n=(*f__dorevert)()) != 0) return(n);
476
 
                goto loop;
477
 
        case COLON:
478
 
                if(ptr==NULL)
479
 
                        return((*f__doend)());
480
 
                f__pc++;
481
 
                goto loop;
482
 
        case NONL:
483
 
                f__nonl = 1;
484
 
                f__pc++;
485
 
                goto loop;
486
 
        case S:
487
 
        case SS:
488
 
                f__cplus=0;
489
 
                f__pc++;
490
 
                goto loop;
491
 
        case SP:
492
 
                f__cplus = 1;
493
 
                f__pc++;
494
 
                goto loop;
495
 
        case P: f__scale=p->p1;
496
 
                f__pc++;
497
 
                goto loop;
498
 
        case BN:
499
 
                f__cblank=0;
500
 
                f__pc++;
501
 
                goto loop;
502
 
        case BZ:
503
 
                f__cblank=1;
504
 
                f__pc++;
505
 
                goto loop;
506
 
        }
507
 
        }
508
 
        return(0);
509
 
}
510
 
 
511
 
 int
512
 
en_fio(Void)
513
 
{       ftnint one=1;
514
 
        return(do_fio(&one,(char *)NULL,(ftnint)0));
515
 
}
516
 
 
517
 
 VOID
518
 
fmt_bg(Void)
519
 
{
520
 
        f__workdone=f__cp=f__rp=f__pc=f__cursor=0;
521
 
        f__cnt[0]=f__ret[0]=0;
522
 
}
523
 
#ifdef __cplusplus
524
 
}
525
 
#endif