« back to all changes in this revision
Viewing changes to Web/prod.web
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Yann Dirson
- Date: 2002-01-04 23:20:22 UTC
- Revision ID: james.westby@ubuntu.com-20020104232022-330ad4iyzpvb5bm4
Tags: upstream-1.62
Import upstream version 1.62
- files added:
- Boot
- Boot/amiga
- Boot/ibm
- Boot/ibm/mvs
- Boot/ibm/pc
- Boot/ibm/pc/gnu
- Boot/ibm/pc/microsoft
- Boot/misc
- Boot/unix
- Boot/unix/ansi
- Boot/unix/dsu
- Boot/unix/sgi
- Boot/unix/sun
- Boot/unix/sun/cc
- Boot/unix/sun/gcc
- Boot/vax
- Demos
- Manual
- Web
added
removed
Web/prod.web
1
@z --- prod.web ---
2
3
FWEB version 1.62 (September 25, 1998)
4
5
Based on version 0.5 of S. Levy's CWEB [copyright (C) 1987 Princeton University]
6
7
@x-----------------------------------------------------------------------------
8
9
\Title{PROD.WEB} % Productions for the FWEAVE processor.
10
11
@c
12
13
@* INTRODUCTION.
14
In order to accomodate memory-starved personal computers, the productions
15
have been split off from the main part of \FWEAVE.
16
17
@d _PROD_h
18
19
@A
20
@<Possibly split into parts@>@;
21
22
@<Include files@>@;
23
@<Typedef declarations@>@;
24
@<Prototypes@>@;
25
@<Global variables@>@;
26
27
/* For PC's, the file is split into two compilable parts using the
28
compiler-line macro |part|, which must equal either~1 or~2. */
29
#if(part != 2)
30
@<Part 1@>@;
31
#endif /* Part 1 */
32
33
#if(part != 1)
34
@<Part 2@>@;
35
#endif /* Part 2 */
36
37
@I typedefs.hweb
38
39
@
40
@<Include...@>=
41
#include "map.h"
42
43
@ The function prototypes must appear before the global variables.
44
@<Proto...@>=
45
46
#include "p_type.h"
47
48
@I xrefs.hweb
49
@I tokens.hweb
50
51
@* PARSING. The most intricate part of \.{WEAVE} is its mechanism for
52
converting \cee-like code into \TeX\ code, and we might as well plunge into
53
this aspect of the program now. A ``bottom up'' approach is used to parse
54
the \cee-like material, since \.{WEAVE} must deal with fragmentary
55
constructions whose overall ``part of speech'' is not known.
56
57
At the lowest level, the input is represented as a sequence of entities
58
that we shall call {\it scraps}, where each scrap of information consists
59
of two parts, its {\it category} and its {\it translation}. The category is
60
essentially a syntactic class, and the translation is a token list that
61
represents \TeX\ code. Rules of syntax and semantics tell us how to combine
62
adjacent scraps into larger ones, and if we are lucky an entire \cee\ text
63
that starts out as hundreds of small scraps will join together into one
64
gigantic scrap whose translation is the desired \TeX\ code. If we are
65
unlucky, we will be left with several scraps that don't combine; their
66
translations will simply be output, one by one.
67
68
The combination rules are given as context-sensitive productions that are
69
applied from left to right. Suppose that we are currently working on the
70
sequence of scraps $s_1\,s_2\ldots s_n$. We try first to find the longest
71
production that applies to an initial substring $s_1\,s_2\ldots\,$; but if
72
no such productions exist, we find to find the longest production
73
applicable to the next substring $s_2\,s_3\ldots\,$; and if that fails, we
74
try to match $s_3\,s_4\ldots\,$, etc.
75
76
A production applies if the category codes have a given pattern. For
77
example, one of the productions is $$\hbox{|expr| |binop| |expr| $\RA$
78
|expr|}$$ and it means that three consecutive scraps whose respective
79
categories are |expr|, |binop|, and |expr| are con\-verted to one scraps
80
whose category is |expr|. The scraps are simply concatenated. The case of
81
$$\hbox{|expr| |comma| |expr| $\RA$ |expr|}$$ is only slightly more
82
complicated: here the resulting |expr| scrap consists not only of the three
83
original scraps, but also of the tokens~|opt| and~9 between the |comma| and
84
the following |expr|. In the \TeX\ file, this will specify an additional
85
thin space after the comma, followed by an optional line break with penalty~90.
86
87
At each opportunity the longest possible production is applied: for
88
example, if the current sequence of scraps is |struct_like| |expr| |lbrace|
89
this is transformed into a |struct_hd| by rule~31, but if the sequence is
90
|struct_like| |expr| followed by anything other than |lbrace| only two
91
scraps are used (by rule~32) to form an |int_like|.
92
93
@I ccodes.hweb
94
95
@ For debugging, we need to append a newline to the output of certain
96
routines so the output gets flushed.
97
98
@d DFLUSH if(dflush) puts("");
99
100
@<Glob...@>=
101
102
IN_PROD boolean dflush PSET(NO); // Turn this on from debugger.
103
104
@ The following function symbolically prints out a category. (In using the
105
|OUT1| macro, we take advantage of the fact that the \.{\#}~operator does
106
not put a second set of quotes around a string. By enclosing the |name|
107
arguments in quotes, we keep \FWEAVE\ from getting confused about the part
108
of speech under discussion; it's not used to seeing a reserved word in the
109
location of an argument.)
110
111
@m OUT(cs) case cs: printf(#*cs); @~ break@;
112
@m OUT1(cs,name) case cs: printf(#*name); @~ break@;
113
114
@<Part 1@>=
115
#ifdef DEBUG
116
117
@[SRTN
118
prn_cat FCN((c))
119
eight_bits c C1("Category.")@;
120
{
121
switch(c)
122
{
123
OUT1(language_scrap,"@@L");
124
OUT(expr);
125
OUT1(exp_op,"^^");
126
OUT1(_EXPR,$_EXPR); @~ OUT1(EXPR_,$EXPR_); @~ OUT1(_EXPR_,$_EXPR_);
127
OUT(new_like);
128
OUT(stmt);
129
OUT(decl);
130
OUT(decl_hd);
131
OUT1(Decl_hd,$Decl_hd);
132
OUT(struct_hd);
133
OUT(functn);
134
OUT(fn_decl);
135
OUT(fcn_hd);
136
OUT1(else_like,"else");
137
OUT1(ELSE_like,ELSE);
138
OUT(if_hd);
139
OUT(IF_top);
140
OUT(else_hd);
141
OUT(for_hd);
142
OUT(unop);
143
OUT1(UNOP,$UNOP_ @e);
144
OUT(binop);
145
OUT1(BINOP,@e $_BINOP_ @e);
146
OUT(unorbinop);
147
OUT1(semi,";");
148
OUT1(colon,":");
149
OUT1(comma,`,`);
150
OUT1(COMMA,@e $_COMMA_ @e);
151
OUT1(question,"?");
152
OUT(tag);
153
OUT(cast);
154
OUT1(lpar,"(");
155
OUT1(rpar,")");
156
OUT1(lbracket,"[");
157
OUT1(rbracket,"]");
158
OUT1(lbrace,"{");
159
OUT1(rbrace,"}");
160
OUT(common_hd);
161
OUT(read_hd);
162
OUT1(slash_like,"slash");
163
OUT1(private_like, "private");
164
OUT(slashes);
165
OUT1(lproc,"#{");
166
OUT(LPROC);
167
OUT1(rproc,"#}");
168
OUT1(ignore_scrap,"ignore");
169
170
OUT1(define_like,define);
171
OUT(no_order);
172
OUT1(do_like,"do");
173
OUT1(while_do, "while");
174
OUT1(Rdo_like,Rdo);
175
OUT1(if_like,"if");
176
OUT1(IF_like,IF);
177
OUT1(for_like,"for");
178
OUT1(program_like,program);
179
OUT1(int_like,int);
180
OUT(modifier);
181
OUT1(huge_like,"huge");
182
OUT1(CASE_like,CASE);
183
OUT1(case_like,"case");
184
OUT1(sizeof_like,sizeof @e);
185
OUT1(op_like,"op");
186
OUT1(proc_like,"proc");
187
OUT1(class_like,"class");
188
OUT1(struct_like,"struct");
189
OUT1(typedef_like,"typedef");
190
OUT1(imp_reserved,"imp_rsrvd");
191
OUT1(extern_like,"extern");
192
OUT1(common_like,common);
193
OUT1(read_like,read);
194
OUT1(entry_like,entry);
195
OUT1(implicit_like,implicit);
196
OUT(implicit_hd);
197
OUT(built_in);
198
OUT1(endif_like,endif);
199
OUT1(end_like,end);
200
OUT1(END_like,END);
201
OUT(END_stmt);
202
OUT1(go_like,go);
203
OUT1(newline,"\n");
204
OUT(label);
205
OUT(space);
206
OUT1(until_like,until);
207
OUT(template);
208
OUT(langle);
209
OUT(rangle);
210
OUT(tstart);
211
OUT(tlist);
212
OUT(namespace);
213
OUT(virtual);
214
OUT1(reference,ref);
215
OUT1(kill_newlines, killnl);
216
217
OUT1(0,zero);
218
default: printf("UNKNOWN(%i)", c); @~ break;
219
}
220
221
DFLUSH;
222
}
223
224
#endif /* |DEBUG| */
225
226
@I output.hweb
227
228
@ Here is a table of all the productions. The reader can best get a feel for
229
@^productions, table of@>
230
how they work by trying them out by hand on small examples; no amount of
231
explanation will be as effective as watching the rules in action. Parsing
232
can also be watched by debugging with~`\.{@@2}' or by using the
233
command-line option ``\.{-2}''. [Please see file
234
\.{examples/prod.web}.]
235
236
@i scraps.hweb
237
238
@ This dummy module keeps \FTANGLE\ from complaining. (It's needed only by
239
\FWEAVE.)
240
241
242
@<Rest of |trans_plus| union@>=
243
244
@ The following functions prints a token list. It is intended to be called
245
from the debugger.
246
247
@<Part 1@>=
248
#ifdef DEBUG
249
250
SRTN
251
prn_text FCN((p))
252
text_pointer p C1("The token list.")@;
253
{
254
token_pointer j; /* index into |tok_mem| */
255
sixteen_bits r; /* remainder of token after the flag has been stripped off */
256
257
if (p>=text_ptr)
258
printf("BAD");
259
else for (j=*p; j<*(p+1); j++)
260
{
261
r = (sixteen_bits)(*j % id_flag);
262
263
switch (*j/id_flag)
264
{
265
case 1: printf("\\\\{"); prn_id((name_dir+r)); printf("}"); break;
266
/* |id_flag| */
267
case 2: printf("\\&{"); prn_id((name_dir+r)); printf("}"); break;
268
/* |res_flag| */
269
case 3: printf("<"); prn_id((name_dir+r)); printf(">"); break;
270
/* |mod_flag| */
271
case 4: printf("[[%d]]",r); break; /* |tok_flag| */
272
case 5: printf("|[[%d]]|",r); break; /* |inner_tok_flag| */
273
default: @<Print token |r| in symbolic form@>;
274
}
275
}
276
277
DFLUSH;
278
}
279
280
SRTN
281
prn_trans FCN((p))
282
scrap_pointer p C1("")@;
283
{
284
prn_text(indirect(p->trans));
285
}
286
287
#endif /* |DEBUG| */
288
289
@
290
@<Print token |r|...@>=
291
292
switch (r)
293
{
294
case math_bin: printf("\\mathbin}"); @~ break;
295
case math_rel: printf("\\mathrel}"); @~ break;
296
case big_cancel: printf("[ccancel]"); @~ break;
297
case cancel: printf("[cancel]"); @~ break;
298
case indent: printf("[indent]"); @~ break;
299
case outdent: printf("[outdent]"); @~ break;
300
case backup: printf("[backup]"); @~ break;
301
case opt: printf("[opt]"); @~ break;
302
case break_space: printf("[break]"); @~ break;
303
case force: printf("[force]"); @~ break;
304
case big_force: printf("[fforce]"); @~ break;
305
case end_translation: printf("[quit]"); @~ break;
306
default: putxchar(XCHR(r));
307
}
308
309
@ The production rules listed above are embedded directly into the
310
\.{WEAVE} program, since it is easier to do this than to write an
311
interpretive system that would handle production systems in general.
312
Several macros are defined here so that the program for each production is
313
fairly short.
314
315
All of our productions conform to the general notion that some~|k|
316
consecutive scraps starting at some position~|j| are to be replaced by a
317
single scrap of some category~|c| whose translations is composed from the
318
translations of the disappearing scraps. After this production has been
319
applied, the production pointer~|pp| should change by an amount~|d|. Such a
320
production can be represented by the quadruple |(j,k,c,d)|. For example,
321
the production `|expr@,comma@,expr| $\RA$ |expr|' would be represented by
322
`|(pp,3,expr,-2)|'; in this case the pointer |pp| should decrease by~2
323
after the production has been applied, because some productions with |expr|
324
in their second or third positions might now match, but no productions have
325
|expr| in the fourth position of their left-hand sides. Note that the value
326
of~|d| is determined by the whole collection of productions, not by an
327
individual one. The determination of~|d| has been done by hand in each
328
case, based on the full set of productions but not on the grammar of the
329
language or on the rules for constructing the initial scraps.
330
331
We also attach a serial number of each production, so that additional
332
information is available when debugging. For example, the program below
333
contains the statement `|REDUCE(pp,3,expr,-2,4)|' when it implements the
334
production just mentioned.
335
336
Before calling |reduce|, the program should have appended the tokens of the
337
new translation to the |tok_mem| array. We commonly want to append copies
338
of several existing translations, and macros are defined to simplify these
339
common cases. For example, |b_app2(pp)| will append the translations of
340
two consecutive scraps, |pp->trans| and |(pp+1)->trans|, to the current
341
token list. If the entire new translation is formed in this way, we write
342
`|SQUASH(j,k,c,d)|' instead of `|REDUCE(j,k,c,d)|'. For example,
343
`|SQUASH(pp,3,expr,-2,3)|' is an abbreviation for `|b_app3(pp);
344
REDUCE(pp,3,math,-2,3)|'.
345
346
The code below is an exact translation of the production rules into~C
347
using such macros, and the reader should have no difficulty understanding
348
the format by comparing the code with the symbolic productions as they were
349
listed earlier.
350
351
To understand the routines that append tokens or scraps in detail, we must
352
discuss the concept of \It{mathness}. This is used to determine how to
353
enclose things in dollar signs---i.e., what things should be treated in
354
math mode.
355
356
Routines such as |app| or |app_str| append stuff to the list without
357
changing the mathness.
358
359
Routines such as |b_app| or |b_app1| (the 'b' stands for 'big')
360
provisionally change the mathness depending on what's come before and
361
what's being appended.
362
363
Three flags handle the mathness. |cur_mathness| is the mathness at this
364
point in the construction. |ini_mathness| is the initial mathness of the
365
stuff that's been appended so far. |last_mathness| is the mathness of the
366
last stuff that's been appended. (|cur_mathness| and |last_mathness| appear
367
to be redundant, but we're not changing the code right now.)
368
369
The next macros \It{big\_appn} append $n$~consective tokens.
370
371
@D b_app2(a) b_app1(a); @~ b_app1(a+1)
372
@D b_app3(a) b_app2(a); @~ b_app1(a+2)
373
@D b_app4(a) b_app3(a); @~ b_app1(a+3)
374
375
@<Global...@>=
376
377
IN_PROD int cur_mathness, ini_mathness, last_mathness;
378
379
@ Append an entire string, converting to |ASCII| if necessary. (Don't
380
change the mathness.)
381
382
@<Part 1@>=@[
383
384
SRTN
385
app_str FCN((s))
386
CONST outer_char HUGE *s C1("String to be appended.")@;
387
{
388
while (*s)
389
app(XORD(*(s++)));
390
}
391
392
/* Append a string that's already Ascii. */
393
SRTN
394
app_ASCII_str FCN((s))
395
CONST ASCII HUGE *s C1("")@;
396
{
397
while(*s)
398
app(*s++);
399
}
400
401
@ Append a token, possibly changing the mathness.
402
403
@<Part 1@>=@[
404
405
SRTN
406
b_app FCN((a))
407
Token a C1("Token to be appended.")@;
408
{
409
if (a==@' ' || (a>=big_cancel && a<=big_force))
410
{/* Appending a non-math token, including a space. */
411
if (cur_mathness ==maybe_math)
412
ini_mathness=no_math;
413
else if (cur_mathness==yes_math)
414
{
415
#ifdef DBGM
416
app(@'4');
417
#endif
418
app(@'$'); // End math mode.
419
}
420
421
cur_mathness=last_mathness=no_math;
422
}
423
else
424
{ /* Append a math token. (Tokens can't be |maybe_math|.) */
425
if (cur_mathness==maybe_math)
426
ini_mathness=yes_math;
427
else if (cur_mathness==no_math)
428
{
429
app(@'$'); // Begin math mode.
430
#ifdef DBGM
431
app(@'3');
432
#endif
433
}
434
435
cur_mathness=last_mathness=yes_math;
436
}
437
438
app(a);
439
}
440
441
@ Append an entire scrap, possibly changing the mathness. The mathness for
442
scraps is stored in an |eight_bits| in the form |4*last_mathness +
443
ini_mathness|.
444
445
@d INI_MATHNESS(p) ((p)->mathness % 4)
446
/* Left boundary (|ini_mathness|) of the current scrap. */
447
@d LAST_MATHNESS(p) ((p)->mathness / 4)
448
/* Right boundary (|last_mathness|) */
449
450
@<Part 1@>=@[
451
452
SRTN
453
b_app1 FCN((a))
454
scrap_pointer a C1("Scrap to be appended.")@;
455
{
456
switch(INI_MATHNESS(a))
457
{
458
case no_math:
459
if (cur_mathness==maybe_math)
460
ini_mathness = no_math;
461
else if (cur_mathness==yes_math)
462
{
463
#ifdef DBGM
464
app(@'2');
465
#endif
466
APP_STR("$"); /* End math mode. (The braces take care of
467
ending the math part with something like a~$+$.) */
468
}
469
470
cur_mathness = last_mathness = LAST_MATHNESS(a);
471
break;
472
473
case yes_math:
474
if (cur_mathness==maybe_math)
475
ini_mathness=yes_math;
476
else if (cur_mathness==no_math)
477
{
478
APP_STR("$"); /* Begin math mode. (The braces take care
479
of beginning the math part with something like a~$+$.) */
480
#ifdef DBGM
481
app(@'1');
482
#endif
483
}
484
485
cur_mathness = last_mathness = LAST_MATHNESS(a);
486
break;
487
488
case maybe_math:
489
break; // No changes in mathness.
490
}
491
492
app(a->trans + tok_flag - tok_start);
493
}
494
495
@ Let us consider the big switch for productions now, before looking at its
496
context. We want to design the program so that this switch works, so we
497
might as well not keep ourselves in suspense about exactly what code needs
498
to be provided with a proper environment.
499
500
\Ratfor\ and \Fortran\ are treated as two dialects of the same language,
501
because almost all of the rules are the same. The most important exception
502
is in the \&{if} statements.
503
504
The first thing we do is to process any language scrap. Such scraps begin
505
with |begin_language|, then the language number as the next token. We use
506
that token to reset the language.
507
508
If it's not a language scrap, we gobble up any |ignore_scrap|. For reasons
509
that are now obscure, we regress by $-2$ after that. This doesn't work
510
quite right; the logic of some of the |if| statements gets screwed up if
511
there's a comment in the wrong place.
512
513
@<Match a production at |pp|, or increase |pp| if there is no match@>=
514
{
515
if(cat0 == language_scrap)
516
{
517
language = lan_enum(get_language(pp->trans)); /* Get language from
518
language~\#. */
519
ini0_language(); // Reset params like |auto_semi|.
520
SQUASH(pp,1,ignore_scrap,-1,0);
521
}
522
else if(cat1==ignore_scrap) SQUASH(pp,2,cat0,-2,0);//Gobble an |ignore_scrap|.
523
@% else if(cat0==ignore_scrap) SQUASH(pp,2,cat1,0,0); // Screws language cmd.
524
else switch(language)
525
{
526
case NO_LANGUAGE:
527
CONFUSION("match production",
528
"Language hasn't been defined yet");
529
530
case C:
531
case C_PLUS_PLUS:
532
C_productions();
533
break;
534
535
case RATFOR:
536
case RATFOR_90:
537
if(!RAT_OK("(translate)"))
538
CONFUSION("match production",
539
"Language shouldn't be Ratfor here");
540
541
case FORTRAN:
542
case FORTRAN_90:
543
R_productions();
544
break;
545
546
case LITERAL:
547
V_productions();
548
break;
549
550
case TEX:
551
X_productions();
552
break;
553
554
case NUWEB_OFF:
555
case NUWEB_ON:
556
CONFUSION("match a production","Invalid language");
557
}
558
559
pp++; // if no match was found, we move to the right and try again.
560
}
561
562
@
563
@<Part 1@>=@[
564
int
565
get_language FCN((xp))
566
text_pointer xp C1("")@;
567
{
568
token_pointer tp,tp1;
569
570
tp = *xp;
571
tp1 = *(xp+1) - 1; /* The |-1| is because we should always have the
572
combination |begin_language| followed by the language number. */
573
574
while(tp < tp1)
575
if(*tp++ == begin_language) return *tp;
576
577
return CONFUSION("get_language",
578
"Can't find |begin_language| token in language_scrap");
579
}
580
581
@* PRODUCTIONS for C. The productions have been made into individual
582
functions to accomodate memory-starved pc's.
583
584
@<Part 1@>=@[
585
586
SRTN
587
C_productions(VOID)
588
{
589
switch (pp->cat)
590
{
591
case ignore_scrap: @<CASES for |ignore_scrap| (C)@>@; break;
592
case built_in: @<CASES for |built_in| (R)@>@; @~ break;
593
case expr: @<CASES for |expr| (C)@>@; @~ break;
594
case exp_op: @<CASES for |exp_op| (R)@>@; @~ break;
595
case _EXPR: @<CASES for |_EXPR| (C)@>@; @~ break;
596
case _EXPR_: @<CASES for |_EXPR_| (C)@>@; @~ break;
597
case EXPR_: @<CASES for |EXPR_| (C)@>@; @~ break;
598
case new_like: @<CASES for |new_like| (C)@>@; @~ break;
599
case lpar: @<CASES for |lpar| (C)@>@; @~ break;
600
case lbracket: @<CASES for |lbracket| (C)@>@; @~ break;
601
case rbracket: @<CASES for |rbracket| (C)@>@; @~ break;
602
case question: @<CASES for |question| (C)@>@; @~ break;
603
case unop: @<CASES for |unop| (C)@>@; @~ break;
604
case UNOP: @<CASES for |UNOP| (C)@>@; @~ break;
605
case unorbinop: @<CASES for |unorbinop| (C)@>@; @~ break;
606
case binop: @<CASES for |binop| (C)@>@; @~ break;
607
case BINOP: @<CASES for |BINOP| (C)@>@; @~ break;
608
case COMMA: @<CASES for |COMMA| (C)@>@; @~ break;
609
case cast: @<CASES for |cast| (C)@>@; @~ break;
610
case sizeof_like: @<CASES for |sizeof_like| (C)@>@; @~ break;
611
case int_like: @<CASES for |int_like| (C)@>@; @~ break;
612
case extern_like: @<CASES for |extern_like| (C)@>@; @~ break;
613
case modifier: @<CASES for |modifier| (C)@>@; @~ break;
614
case huge_like: @<CASES for |huge_like| (C)@>@; @~ break;
615
case decl_hd: @<CASES for |decl_hd| (C)@>@; @~ break;
616
case decl: @<CASES for |decl| (C)@>@; @~ break;
617
case typedef_like: @<CASES for |typedef_like| (C)@>@; @~ break;
618
case imp_reserved: @<CASES for |imp_reserved| (C)@>@; @~ break;
619
case op_like: @<CASES for |op_like| (C)@>@; @~ break;
620
case class_like: @<CASES for |class_like| (C)@>@; @~ break;
621
case struct_like: @<CASES for |struct_like| (C)@>@; @~ break;
622
case struct_hd: @<CASES for |struct_hd| (C)@>@; @~ break;
623
case fn_decl: @<CASES for |fn_decl| (C)@>@; @~ break;
624
case functn: @<CASES for |functn| (C)@>@; @~ break;
625
case lbrace: @<CASES for |lbrace| (C)@>@; @~ break;
626
case do_like: @<CASES for |do_like| (C)@>@; @~ break;
627
case while_do: @<CASES for |while_do| (C)@>@; @~ break;
628
case if_like: @<CASES for |if_like| (C)@>@; @~ break;
629
case IF_like: @<CASES for |IF_like| (C)@>@; @~ break;
630
case IF_top: @<CASES for |IF_top| (C)@>@; @~ break;
631
case for_like: @<CASES for |for_like| (C)@>@; @~ break;
632
case for_hd: @<CASES for |for_hd| (C)@>@; @~ break;
633
case else_like: @<CASES for |else_like| (C)@>@; @~ break;
634
@#if(0)
635
case ELSE_like: @<CASES for |ELSE_like| (C)@>@; @~ break;
636
@#endif
637
case if_hd: @<CASES for |if_hd| (C)@>@; @~ break;
638
case else_hd: @<CASES for |else_hd| (C)@>@; @~ break;
639
case case_like: @<CASES for |case_like| (C)@>@; @~ break;
640
case stmt: @<CASES for |stmt| (C)@>@; @~ break;
641
case tag: @<CASES for |tag| (C)@>@; @~ break;
642
case semi: @<CASES for |semi| (C)@>@; @~ break;
643
case lproc: @<CASES for |lproc| (C)@>@; @~ break;
644
case LPROC: @<CASES for |LPROC| (C)@>@; @~ break;
645
case space: @<CASES for |space| (C)@>@; @~ break;
646
647
case template: @<CASES for |template| (C++)@>@; @~ break;
648
case langle: @<CASES for |langle| (C++)@>@; @~ break;
649
case rangle: @<CASES for |rangle| (C++)@>@; @~ break;
650
case tstart: @<CASES for |tstart| (C++)@>@; @~ break;
651
case tlist: @<CASES for |tlist| (C++)@>@; @~ break;
652
653
case virtual: @<CASES for |virtual| (C++)@>@; @~ break;
654
case reference: @<CASES for |reference| (C++)@>@; @~ break;
655
case namespace: @<CASES for |namespace| (C++)@>@; @~ break;
656
657
case kill_newlines: @<CASES for |kill_newlines| (C++)@>@; @~ break;
658
}
659
}
660
661
@ In~C, new specifier names can be defined via |typedef|, and we want
662
to make the parser recognize future ocurrences of the identifier thus
663
defined as specifiers. This is done by the procedure |make_reserved|,
664
which changes the |ilk| of the relevant identifier. (One difficulty with
665
this solution is that it is implemented in phase~2, so if one uses an
666
identifier before it is actually |typedef|'d, it won't typeset properly. In
667
these cases, an explicit~\.{@@f} is required as well.)
668
669
The original \CWEB\ design of |make_reserved| didn't handle a situation such as
670
|typedef int (*I)()|, because |I|~was inside parentheses. The procedure has
671
been augmented to handle this situation by following the indirection chain
672
to the bitter end.
673
674
@<Part 1@>=@[
675
676
SRTN
677
make_reserved FCN((p)) /* Make the first identifier in |p->trans| like
678
|int| */
679
scrap_pointer p C1("")@;
680
{
681
sixteen_bits tok_value = first_id(p->trans);
682
// The first identifier, plus its flag.
683
name_pointer pname = name_dir + tok_value - id_flag;
684
685
if(!tok_value || tok_value==@'(')
686
return; // Emergency return; no identifier found.
687
688
if(DEFINED_TYPE(pname) == M_MACRO || DEFINED_TYPE(pname) == D_MACRO)
689
return; // Don't |typedef| macro names.
690
691
/* Change categories of all future occurrences of the identifier. */
692
for (; p<=scrp_ptr; p++)
693
{
694
if (p->cat==expr)
695
{
696
if (**(p->trans)==tok_value)
697
{
698
p->cat=int_like;
699
**(p->trans)+=res_flag-id_flag; // Mark as reserved.
700
}
701
}
702
}
703
704
pname->ilk = int_like;
705
pname->reserved_word |= (boolean)language;
706
707
if(mark_defined.typedef_name)
708
{
709
pname->defined_in(language) = module_count;
710
SET_TYPE(pname,TYPEDEF_NAME);
711
}
712
}
713
714
@ This function hunts through a translation until it finds the first
715
identifier, if there is one.
716
717
@d FIRST_ID(p) ( ((tok0=first_id(p->trans)) && tok0!=@'(') ? name_dir + tok0 -
718
id_flag : name_dir) // Ptr to actual id.
719
720
@<Glob...@>=
721
722
IN_PROD sixteen_bits tok0;
723
724
@ This function considers a token list between~|pk| and~|pk1|; it returns
725
the first (flagged) identifier token it finds, or 0~if there's none.
726
Because each component of the token list may itself be a token list, this
727
routine is called recursively.
728
729
@<Part 1@>=@[
730
731
sixteen_bits
732
first_id FCN((t))
733
text_pointer t C1("Pointer to start of token list")@;
734
{
735
token_pointer pk = *t; // Start of end.
736
token_pointer pk1 = *(t+1); // End of list.
737
sixteen_bits tok_value; // Current element.
738
739
for(; pk < pk1; pk++)
740
{
741
tok_value = *pk;
742
743
if(tok_value > inner_tok_flag) tok_value -= (inner_tok_flag -
744
tok_flag);
745
746
if(tok_value <= tok_flag)
747
{ // It's an ordinary (non-flagged) token.
748
if( tok_value >= id_flag && tok_value < res_flag)
749
return tok_value; // Found identifier.
750
else if(tok_value == @'(') return tok_value; // STOP!!!
751
}
752
else
753
{ // Flagged token; use indirection.
754
t = tok_start + (int)(tok_value - tok_flag); /* Flagged token
755
corresponds to a |text_pointer|; |*t|~points to beginning of translation. */
756
tok_value = first_id(t);// Check that translation recursively.
757
if(tok_value) return tok_value;
758
}
759
}
760
761
return 0; // Really couldn't find anything!
762
}
763
764
@ In the following situations we want to mark the occurrence of an
765
identifier as a definition: when |make_reserved| has just been used; after
766
a specifier, as in |char **argv|; before a colon, as in |found:|; and in
767
the declaration of a function, as in |main(){@t\dots@>;}|. This is
768
accomplished by the invocation of |make_underlined| at appropriate times.
769
Since, in the declaration of a function, we only find out that the
770
identifier is being defined after it has been swallowed up by an |expr|, we
771
must hunt through an indirection chain.
772
773
@<Part 1@>=@[
774
775
name_pointer
776
make_underlined FCN((p)) /* underline the entry for the first
777
identifier in |p->trans| */
778
scrap_pointer p C1("")@;
779
{
780
sixteen_bits tok_value; /* the name of this identifier, plus its flag */
781
782
tok_value=**(p->trans);
783
784
if (tok_value>inner_tok_flag) tok_value-=(inner_tok_flag-tok_flag);
785
786
if (tok_value>tok_flag) {
787
do
788
{ /* Follow an indirection chain to a real identifier. {\bf
789
Watch the 16-bit arithmetic!} */
790
tok_value=**(tok_start +
791
(int)(tok_value-tok_flag)); /* {\bf Don't
792
remove the parens!} */
793
}
794
while(tok_value > tok_flag);
795
796
if (tok_value<id_flag || tok_value>=res_flag) return NULL; /* shouldn't
797
happen */
798
799
xref_switch=def_flag; underline_xref(tok_value-id_flag+name_dir);
800
}
801
802
if (tok_value<id_flag || tok_value>=res_flag) return NULL;
803
// shouldn't happen!
804
805
xref_switch=def_flag; return underline_xref(tok_value-id_flag+name_dir);
806
}
807
808
@ We cannot use |new_xref| to underline a cross-reference at this point
809
because this would just make a new cross-reference at the end of the list.
810
We actually have to search through the list for the existing
811
cross-reference.
812
813
@<Part 1@>=@[
814
815
name_pointer
816
underline_xref FCN((p))
817
name_pointer p C1("")@;
818
{
819
xref_pointer q = (xref_pointer)p->xref; /* Pointer to cross-reference
820
being examined */
821
xref_pointer r; /* Temporary pointer for permuting cross-references */
822
sixteen_bits m; /* Cross-reference value to be installed */
823
sixteen_bits n; /* Cross-reference value being examined */
824
extern boolean strt_off;
825
826
if (no_xref || (strt_off && !index_hidden))
827
return p;
828
829
xref_switch = def_flag;
830
m = (sixteen_bits)(module_count + xref_switch);
831
832
while (q != xmem)
833
{
834
n=q->num;
835
836
if (n==m) return p; /* Same status; need to do nothing. */
837
else if (m==n+def_flag) /* Module numbers match; update to
838
defined. */
839
{
840
q->num=m; return p;
841
}
842
else if (n>=def_flag && n<m) break;
843
844
q=q->xlink;
845
}
846
847
@<Insert new cross-reference at |q|, not at beginning of list@>;
848
849
return p;
850
}
851
852
@ Record the module at which an identifier was defined. A global variable
853
distinguishes between |INNER| and |OUTER| modes.
854
855
@<Glob...@>=
856
857
IN_PROD PARSING_MODE translate_mode; // Set by |translate|.
858
859
@
860
@<Part 1@>=@[
861
862
SRTN
863
defined_at FCN((p))
864
name_pointer p C1("")@;
865
{
866
extern boolean ok_to_define;
867
868
if(ok_to_define && translate_mode==OUTER && p > name_dir)
869
{
870
sixteen_bits mod_defined = p->defined_in(language);
871
872
if(mod_defined && mod_defined != module_count && language!=C_PLUS_PLUS)
873
{
874
if(msg_level >= WARNINGS)
875
{
876
printf("\n! (FWEAVE): Implicit phase 2 declaration of `");
877
prn_id(p);
878
printf("' at %s \
879
repeats or conflicts with declaration at %s.\n",
880
(char *)MOD_TRANS(module_count),
881
(char *)MOD_TRANS(mod_defined));
882
mfree();
883
}
884
mark_harmless;
885
}
886
else if(mark_defined.fcn_name)
887
{
888
p->defined_in(language) = module_count;
889
SET_TYPE(p,FUNCTION_NAME);
890
}
891
}
892
}
893
894
@ We get to this module only when the identifier is one letter long, so it
895
didn't get a non-underlined entry during phase one. But it may have got
896
some explicitly underlined entries in later modules, so in order to
897
preserve the numerical order of the entries in the index, we have to insert
898
the new cross-reference not at the beginning of the list (namely, at
899
|p->xref|), but rather right before~|q|.
900
901
@<Insert new cross-reference at |q|...@>=
902
903
append_xref(0); /* This number doesn't matter */
904
xref_ptr->xlink = (xref_pointer)p->xref;
905
r = xref_ptr; p->xref = (ASCII *)xref_ptr;
906
907
while (r->xlink!=q) {r->num=r->xlink->num; r=r->xlink;}
908
909
r->num=m; /* Everything from |q| on is left undisturbed */
910
911
@ Now comes the code that tries to match each production that starts with a
912
particular type of scrap. Whenever a match is discovered, the |squash| or
913
|reduce| procedures will cause the appropriate action to be performed,
914
followed by |goto found|.
915
916
@D cat0 pp->cat
917
@D cat1 (pp+1)->cat
918
@D cat2 (pp+2)->cat
919
@D cat3 (pp+3)->cat
920
@D cat4 (pp+4)->cat
921
@D cat5 (pp+5)->cat
922
923
@d indent_force b_app(indent); @~ b_app(force)@;
924
925
/* Append $m$~things, followed by a space, followed by $n$~things. */
926
@m PP_PP(m,n) b_app##m(pp); @~ b_app(@' '); @~ b_app##n(pp+m)@;
927
928
@<CASES for |ignore_scrap| (C)@>=
929
930
#if FCN_CALLS
931
C_ignore_scrap();
932
#else
933
@<Cases for |ignore_scrap| (C)@>@;
934
#endif
935
936
@
937
@<Part 1@>=
938
939
#if FCN_CALLS
940
@[SRTN C_ignore_scrap(VOID)
941
{
942
@<Cases for |ignore_scrap| (C)@>@;
943
}
944
#endif
945
946
@
947
@<Cases for |ignore_scrap| (C)@>=
948
{
949
switch(cat1)
950
{
951
case stmt:
952
case functn:
953
SQUASH(pp,2,cat1,0,1);
954
break;
955
}
956
}
957
958
@ Ordinary expressions.
959
@<CASES for |expr| (C)@>=
960
#if FCN_CALLS
961
C_expr();
962
#else
963
@<Cases for |expr| (C)@>@;
964
#endif
965
966
@
967
@<Part 1@>=
968
#if FCN_CALLS
969
@[SRTN C_expr(VOID)
970
{
971
@<Cases for |expr| (C)@>@;
972
}
973
#endif
974
975
@
976
977
@d OPT9 APP_SPACE; app(opt); app(@'9')@;
978
979
@<Cases for |expr| (C)@>=
980
{
981
if (cat1==lbrace || ((!Cpp) && cat1==int_like))
982
{ /* ``|f(x) {}|'' or ``|f(x) float x;|'' (old-style) */
983
defined_at(make_underlined(pp)); /* Recognized function name;
984
remember current module number. */
985
in_function = YES;
986
SQUASH(pp, 1, fn_decl, 0, 111);
987
}
988
else if (cat1==unop)
989
SQUASH(pp,2,expr,-2,2); /* ``|x--|'' */
990
else if (cat1==binop)
991
{
992
if(cat2==expr)
993
SQUASH(pp,3,expr,-2,3); /* ``|x + y|'' */
994
else if(cat2==decl_hd)
995
SQUASH(pp, 3, tstart, 0, 6061);
996
/* Trap for ``|@c++ A<int>|'', with |A| undefined. */
997
}
998
else if (cat1==unorbinop && cat2==expr)
999
{
1000
sixteen_bits *s = *(pp+1)->trans;
1001
b_app1(pp);
1002
1003
/* If the translation of the next scrap begins with an escape character, we
1004
assume we're seeing \.{\\amp}. */
1005
if( (s[0] == (sixteen_bits)@'\\') && s[1] == (sixteen_bits)@'a'
1006
&& s[2] == (sixteen_bits)@'m')
1007
{
1008
APP_SPACE; b_app1(pp+1); @~ APP_SPACE; /* ``|x & y|'' */
1009
}
1010
else b_app1(pp+1); /* ``|x*y|'' */
1011
1012
b_app1(pp+2);
1013
REDUCE(pp,3,expr,-2,3000);
1014
}
1015
else if (cat1==comma)
1016
{
1017
if((cat2==expr || cat2==int_like)) /* ``|x,y|'' or ``|x,char|'' */
1018
{
1019
b_app2(pp);
1020
OPT9;
1021
b_app1(pp+2); REDUCE(pp,3,cat2,-2,4);
1022
}
1023
else if(cat2==space)
1024
SQUASH(pp, 3, expr, -2, 88); // Macros.
1025
}
1026
else if (cat1==expr)
1027
SQUASH(pp,2,expr,-2,5); /* ``|f(x)|'' */
1028
else if (cat1==semi)
1029
SQUASH(pp,2,stmt,-1,6); /* ``|x;|'' */
1030
else if (cat1==colon) /* ``|label:|'' */
1031
{
1032
if(!Cpp || in_function)
1033
{ /* Ordinary C tag. */
1034
make_underlined (pp); /* Label name. */
1035
SQUASH(pp,2,tag,0,7);
1036
}
1037
else if(cat2==expr || cat2==int_like)
1038
{ /* Put the spaces in explicitly in case we're not in math
1039
mode at the time. */
1040
b_app1(pp); @~ b_app(@' '); @~ b_app1(pp+1); @~ b_app(@' ');
1041
@~ b_app1(pp+2);
1042
REDUCE(pp,3,expr,-2,701);
1043
/* \Cpp: ``|@c++ derived() : base()|'' */
1044
}
1045
}
1046
else if(cat1==space)
1047
SQUASH(pp,2,expr,-2,8); /* For use in macros. */
1048
}
1049
1050
@ The next several cases are for symbols that are formatted like operators.
1051
These need to get explicit spaces to set them off from their surroundings.
1052
1053
@<Bracket with spaces@>=
1054
1055
APP_SPACE; @~ b_app1(pp); @~ APP_SPACE;
1056
1057
@ Name as unary operator: ``\.{\$UNOP\_\ }''.
1058
@<CASES for |UNOP| (C)@>=
1059
#if FCN_CALLS
1060
C_UNOP();
1061
#else
1062
@<Cases for |UNOP| (C)@>@;
1063
#endif
1064
1065
@
1066
@<Part 1@>=
1067
#if FCN_CALLS
1068
@[SRTN C_UNOP(VOID)
1069
{
1070
@<Cases for |UNOP| (C)@>@;
1071
}
1072
#endif
1073
1074
@
1075
@<Cases for |UNOP| (C)@>=
1076
{
1077
b_app1(pp); @~ APP_SPACE;
1078
REDUCE(pp,1,unop,-1,4443);
1079
}
1080
1081
@ Name as binary operator: ``\.{\ \$\_BINOP\_\ }''.
1082
@<CASES for |BINOP| (C)@>=
1083
#if FCN_CALLS
1084
C_BINOP();
1085
#else
1086
@<Cases for |BINOP| (C)@>@;
1087
#endif
1088
1089
@
1090
@<Part 1@>=
1091
#if FCN_CALLS
1092
@[SRTN C_BINOP(VOID)
1093
{
1094
@<Cases for |BINOP| (C)@>@;
1095
}
1096
#endif
1097
1098
@
1099
@<Cases for |BINOP| (C)@>=
1100
{
1101
@<Bracket with spaces@>;
1102
REDUCE(pp,1,binop,-1,4444);
1103
}
1104
1105
@ Name as comma: ``\.{\ \$\_COMMA\_\ }''.
1106
@<CASES for |COMMA| (C)@>=
1107
#if FCN_CALLS
1108
C_COMMA();
1109
#else
1110
@<Cases for |COMMA| (C)@>@;
1111
#endif
1112
1113
@
1114
@<Part 1@>=
1115
#if FCN_CALLS
1116
@[SRTN C_COMMA(VOID)
1117
{
1118
@<Cases for |COMMA| (C)@>@;
1119
}
1120
#endif
1121
1122
@
1123
@<Cases for |COMMA| (C)@>=
1124
{
1125
@<Bracket with spaces@>;
1126
REDUCE(pp,1,comma,-1,4445);
1127
}
1128
1129
@ Expression with space to left: ``\.{\ \$\_EXPR}''.
1130
@<CASES for |_EXPR| (C)@>=
1131
#if FCN_CALLS
1132
C__E();
1133
#else
1134
@<Cases for |_EXPR| (C)@>@;
1135
#endif
1136
1137
@
1138
@<Part 1@>=
1139
#if FCN_CALLS
1140
@[SRTN C__E(VOID)
1141
{
1142
@<Cases for |_EXPR| (C)@>@;
1143
}
1144
#endif
1145
1146
@
1147
@<Cases for |_EXPR| (C)@>=
1148
{
1149
APP_SPACE; @~ b_app1(pp);
1150
REDUCE(pp,1,expr,-2,4446);
1151
}
1152
1153
@ Expression with spaces on both sides: ``\.{\ \$\_EXPR\_\ }''.
1154
@<CASES for |_EXPR_| (C)@>=
1155
#if FCN_CALLS
1156
C__E_();
1157
#else
1158
@<Cases for |_EXPR_| (C)@>@;
1159
#endif
1160
1161
@
1162
@<Part 1@>=
1163
#if FCN_CALLS
1164
@[SRTN C__E_(VOID)
1165
{
1166
@<Cases for |_EXPR_| (C)@>@;
1167
}
1168
#endif
1169
1170
@
1171
@<Cases for |_EXPR_| (C)@>=
1172
{
1173
@<Bracket with spaces@>;
1174
REDUCE(pp,1,expr,-2,4447);
1175
}
1176
1177
@ Expression with space to right: ``\.{\$EXPR\_\ }''.
1178
@<CASES for |EXPR_| (C)@>=
1179
#if FCN_CALLS
1180
C_E_();
1181
#else
1182
@<Cases for |EXPR_| (C)@>@;
1183
#endif
1184
1185
@
1186
@<Part 1@>=
1187
#if FCN_CALLS
1188
@[SRTN C_E_(VOID)
1189
{
1190
@<Cases for |EXPR_| (C)@>@;
1191
}
1192
#endif
1193
1194
@
1195
@<Cases for |EXPR_| (C)@>=
1196
{
1197
b_app1(pp); @~ APP_SPACE;
1198
REDUCE(pp,1,expr,-2,4448);
1199
}
1200
1201
@ There are right and wrong ways of inserting a real space. What we want to
1202
do is to insert the macro \.{\\\ } (which works either in or out of math mode)
1203
without changing the mathness.
1204
1205
@d APP_SPACE APP_STR("\\ ")
1206
1207
@ The next stuff handles C~preprocessing (not very well).
1208
@<Glob...@>=
1209
1210
IN_PROD boolean active_space PSET(NO);
1211
IN_PROD boolean in_LPROC PSET(NO);
1212
IN_PROD boolean expanded_lproc PSET(NO);
1213
1214
@ In \Cpp, the syntax for |new| and |delete| is unusual.
1215
@<CASES for |new_like| (C)@>=
1216
#if FCN_CALLS
1217
C_new_like();
1218
#else
1219
@<Cases for |new_like| (C)@>@;
1220
#endif
1221
1222
@
1223
@<Part 1@>=
1224
#if FCN_CALLS
1225
@[SRTN C_new_like(VOID)
1226
{
1227
@<Cases for |new_like| (C)@>@;
1228
}
1229
#endif
1230
1231
@
1232
@<Cases for |new_like| (C)@>=
1233
{
1234
if(cat1==lbracket && cat2==rbracket)
1235
{ /* |@c++ delete [] expr| */
1236
PP_PP(1, 1); @~@<Append thickspace@>; @~ b_app1(pp+2);
1237
b_app(@' ');
1238
REDUCE(pp, 3, expr, -2, 910);
1239
}
1240
else if(cat1==decl_hd || cat1==expr)
1241
{ /* \Cpp: |@c++ new int| or |@c++ new class(20)| */
1242
PP_PP(1,1);
1243
if(cat1==decl_hd)
1244
{
1245
OUTDENT;
1246
}
1247
REDUCE(pp,2,expr,-2,909);
1248
}
1249
}
1250
1251
@ The \CWEB\ code didn't work right here. The present attempt is a mess.
1252
1253
@<CASES for |lproc| (C)@>=
1254
#if FCN_CALLS
1255
C_lproc();
1256
#else
1257
@<Cases for |lproc| (C)@>@;
1258
#endif
1259
1260
@
1261
@<Part 1@>=
1262
#if FCN_CALLS
1263
@[SRTN C_lproc(VOID)
1264
{
1265
@<Cases for |lproc| (C)@>@;
1266
}
1267
#endif
1268
1269
@ |lproc| signals the beginning of a preprocessor statement. |rproc|
1270
signals the end.
1271
1272
@<Glob...@>=
1273
1274
extern boolean did_arg;
1275
1276
@
1277
@<Cases for |lproc| (C)@>=
1278
{
1279
expanded_lproc = YES;
1280
1281
if(!in_LPROC)
1282
active_space = YES;
1283
1284
if(cat1==define_like)
1285
make_underlined(pp+3); /* ``\.{\#\ define\ M}'' */
1286
1287
if (cat1==else_like || cat1==if_like ||cat1==define_like)
1288
SQUASH(pp, 2, lproc, 0, 10); /* ``\.{\#\ define}'' $\to$
1289
``\.{\#define}'' */
1290
else if (cat1==rproc)
1291
{
1292
expanded_lproc = active_space = in_LPROC = NO;
1293
SQUASH(pp, 2, ignore_scrap, -1, 11);
1294
}
1295
else if(cat1==expr)
1296
#if 0
1297
SQUASH(pp, 1, LPROC, 0, 12); /* ``|#if(0)|'' (??) */
1298
#endif
1299
{
1300
PP_PP(1, 1);
1301
1302
if(cat2==lpar)
1303
did_arg = NO;
1304
else
1305
{
1306
b_app(@' '); /* ``|#define x|'' */
1307
did_arg = YES;
1308
}
1309
1310
REDUCE(pp, 2, LPROC, 0, 12);
1311
}
1312
else if (cat1==space)
1313
{
1314
if(cat2==lpar)
1315
SQUASH(pp, 1, lproc, PLUS 2, 1332); // \.{if\ (x)}
1316
/* Following stuff for \&{\#define}.
1317
Absorb the identifier: ``\&{\#define M}'' */
1318
else if(cat3==lpar)
1319
SQUASH(pp,1,lproc,PLUS 3,1333); /* Expand the parens. */
1320
else if(cat3==expr)
1321
SQUASH(pp,4,LPROC,0,13); /* |expr| should be
1322
``|()|''; get them too. */
1323
else if(cat3==space || cat3==ignore_scrap || cat3==rproc)
1324
SQUASH(pp,3,LPROC,0,14); /* Just the identifier. */
1325
}
1326
expanded_lproc = NO;
1327
}
1328
1329
@
1330
@<CASES for |LPROC| (C)@>=
1331
#if FCN_CALLS
1332
C_LPRC();
1333
#else
1334
@<Cases for |LPROC| (C)@>@;
1335
#endif
1336
1337
@
1338
@<Part 1@>=
1339
#if FCN_CALLS
1340
@[SRTN C_LPRC(VOID)
1341
{
1342
@<Cases for |LPROC| (C)@>@;
1343
}
1344
#endif
1345
1346
@
1347
@<Cases for |LPROC| (C)@>=
1348
{
1349
active_space = NO; in_LPROC = YES;
1350
1351
if(cat1==space)
1352
{
1353
b_app1(pp);
1354
b_app(@' ');
1355
REDUCE(pp, 2, LPROC, 0, 20);
1356
}
1357
else if(!did_arg && cat1==expr)
1358
{
1359
SQUASH(pp, 2, LPROC, 0, 24);
1360
did_arg = YES;
1361
}
1362
else if(cat1==rproc)
1363
{
1364
in_LPROC = NO;
1365
SQUASH(pp, 2, ignore_scrap, -1, 21);
1366
}
1367
else if(cat2==rproc)
1368
{
1369
in_LPROC = NO;
1370
SQUASH(pp, 3, ignore_scrap, -1, 22);
1371
}
1372
1373
#if(0)
1374
if(cat3==lpar && cat4==expr && cat5==rpar)
1375
if (cat2==rproc)
1376
{
1377
b_app1(pp); b_app(@' '); b_app2(pp+1);
1378
REDUCE(pp,3,ignore_scrap,-1,53);
1379
}
1380
else if (cat2==expr && cat3==rproc)
1381
{
1382
b_app1(pp); b_app(@' '); b_app1(pp+1); b_app(@' ');
1383
b_app2(pp+2); REDUCE(pp,4,ignore_scrap,-1,53);
1384
}
1385
#endif
1386
}
1387
1388
@
1389
@<CASES for |space| (C)@>=
1390
#if FCN_CALLS
1391
C_space();
1392
#else
1393
@<Cases for |space| (C)@>@;
1394
#endif
1395
1396
@
1397
@<Part 1@>=
1398
#if FCN_CALLS
1399
@[SRTN C_space(VOID)
1400
{
1401
@<Cases for |space| (C)@>@;
1402
}
1403
#endif
1404
1405
@
1406
@<Cases for |space| (C)@>=
1407
{
1408
if(active_space)
1409
{
1410
if(expanded_lproc)
1411
SQUASH(pp,1,space,-1,5336);
1412
else
1413
SQUASH(pp,1,space,1,5335);
1414
}
1415
else
1416
REDUCE(pp,1,ignore_scrap,-1,5334);
1417
}
1418
1419
@
1420
@<CASES for |question| (C)@>=
1421
#if FCN_CALLS
1422
C_question();
1423
#else
1424
@<Cases for |question| (C)@>@;
1425
#endif
1426
1427
@
1428
@<Part 1@>=
1429
#if FCN_CALLS
1430
@[SRTN C_question(VOID)
1431
{
1432
@<Cases for |question| (C)@>@;
1433
}
1434
#endif
1435
1436
@
1437
@<Cases for |question| (C)@>=
1438
{
1439
if (cat1==expr && cat2==colon) SQUASH(pp,3,binop,-2,30); /* ``|i==1 ? YES :
1440
NO|'' */
1441
}
1442
1443
@
1444
@<CASES for |int_like| (C)@>=
1445
#if FCN_CALLS
1446
C_int_like();
1447
#else
1448
@<Cases for |int_like| (C)@>@;
1449
#endif
1450
1451
@
1452
@<Part 1@>=
1453
#if FCN_CALLS
1454
@[SRTN C_int_like(VOID)
1455
{
1456
@<Cases for |int_like| (C)@>@;
1457
}
1458
#endif
1459
1460
@
1461
@<Cases for |int_like| (C)@>=
1462
{
1463
if(cat1==unop)
1464
{
1465
if(cat2==expr || cat2==int_like)
1466
SQUASH(pp,3,expr,-2,35); /* \Cpp: |@c++ class::f| or
1467
constructor: |@c++ class::class| */
1468
else if(cat2==op_like)
1469
SQUASH(pp,1,int_like,PLUS 2,36); /* \Cpp: Expand |@c++ operator|
1470
construction. */
1471
}
1472
else if (cat1==int_like|| cat1==struct_like)
1473
{ /* ``|extern int|'' or ``|@c++ typedef int bool|''. */
1474
PP_PP(1,1);
1475
REDUCE(pp,2,cat1,0,40);
1476
}
1477
else if(cat1==reference)
1478
SQUASH(pp, 2, int_like, -2, 43); // |@c++ int &ref;|
1479
else if (cat1==expr || cat1==unorbinop || cat1==semi)
1480
{ /* ``|int i|'' or ``|int *|'' */
1481
b_app1(pp);
1482
1483
if(cat1!=semi)
1484
app(@'~');
1485
1486
#if 0
1487
INDENT; /* Start long declaration. (Note: Whenever we leave
1488
|decl_hd|, we must |OUTDENT|.) */
1489
#endif
1490
1491
REDUCE(pp,1,decl_hd,-1,41);
1492
}
1493
else if(cat1==comma)
1494
{
1495
b_app1(pp);
1496
#if 0
1497
INDENT;
1498
#endif
1499
REDUCE(pp,1,decl_hd,-2,42); /* Function prototype: |int,|. */
1500
}
1501
else if(cat1==rpar)
1502
{
1503
b_app1(pp);
1504
#if 0
1505
INDENT;
1506
#endif
1507
REDUCE(pp,1,decl_hd,-2,502);
1508
}
1509
else if(Cpp && cat1==lpar && !in_prototype)
1510
{ // The \Cpp\ is a KLUDGE. Consider ``|int (*f)()|''.
1511
b_app1(pp);
1512
@<Append thinspace@>@;
1513
REDUCE(pp,1,expr,-2,5021); /* \Cpp\ constructor: ``|@c++ base()|'';
1514
or ``|@c++ int(x)|''. */
1515
}
1516
else if(cat1==binop && cat2==expr)
1517
SQUASH(pp,3,int_like,-2,5022); /* \Cpp\ initializer: |@c++ base = 0| */
1518
else if(cat1 == langle)
1519
SQUASH(pp, 1, int_like, PLUS 1, 5997); // |@c++ int<24>|
1520
else if(cat1 == rangle)
1521
{
1522
b_app1(pp);
1523
#if 0
1524
INDENT;
1525
#endif
1526
REDUCE(pp,1,decl_hd,-2,5998);
1527
}
1528
else if(cat1 == class_like)
1529
{ // \Cpp: |@c++ friend class|.
1530
PP_PP(1,1);
1531
REDUCE(pp, 2, class_like, 0, 5995);
1532
}
1533
else if(cat1 == tlist)
1534
SQUASH(pp, 2, int_like, -2, 5999);
1535
else if(cat1 == namespace)
1536
{ /* |@c++ using namespace| */
1537
PP_PP(1,1);
1538
REDUCE(pp, 2, namespace, 0, 5996);
1539
}
1540
}
1541
1542
@ We need a special case for |extern|, because of constructions like |@c+
1543
extern "C"| in \Cpp.
1544
1545
@<CASES for |extern_like| (C)@>=
1546
#if FCN_CALLS
1547
C_ext_like();
1548
#else
1549
@<Cases for |extern_like| (C)@>@;
1550
#endif
1551
1552
@
1553
@<Part 1@>=
1554
#if FCN_CALLS
1555
@[SRTN C_ext_like(VOID)
1556
{
1557
@<Cases for |extern_like| (C)@>@;
1558
}
1559
#endif
1560
1561
@
1562
@<Cases for |extern_like| (C)@>=
1563
{
1564
if(Cpp &&cat1==expr)
1565
{ /* |@c++ extern "C"| */
1566
PP_PP(1,1);
1567
if(cat2==lbrace || cat2==kill_newlines)
1568
REDUCE(pp, 2, fn_decl, 0, 5025); // ``|@c++ extern "C" {}|''.
1569
else
1570
REDUCE(pp, 2, int_like, 0, 5023);
1571
// ``|@c++ extern "C" int fcn();|''
1572
}
1573
else
1574
SQUASH(pp,1,int_like,0,5024);
1575
}
1576
1577
@ A case related but not identical to |int_like| is |modifier|, which is
1578
used for things like |const| and |volatile|. The difficulty is that it may
1579
come first in the declaration, but it need not. Compare |const char c| and
1580
|char const c|; also |char *const p| and |const char *p|.
1581
1582
@<CASES for |modifier| (C)@>=
1583
#if FCN_CALLS
1584
C_modifier();
1585
#else
1586
@<Cases for |modifier| (C)@>@;
1587
#endif
1588
1589
@
1590
@<Part 1@>=
1591
#if FCN_CALLS
1592
@[SRTN C_modifier(VOID)
1593
{
1594
@<Cases for |modifier| (C)@>@;
1595
}
1596
#endif
1597
1598
@
1599
@<Cases for |modifier| (C)@>=
1600
{
1601
if(cat1==int_like || cat1==struct_like || cat1==class_like)
1602
SQUASH(pp, 1, cat1, -2, 503);
1603
else if(pp == lo_ptr)
1604
SQUASH(pp, 1, expr, 0, 5040);
1605
else if(cat1==comma || cat1==semi || cat1==lbrace || cat1==kill_newlines)
1606
SQUASH(pp, 1, _EXPR, 0, 5042);
1607
/* |@c++ int f() const, g();| or @c++ int f() const;| or
1608
|@c++ int f() const {}|. */
1609
else
1610
SQUASH(pp, 1, EXPR_, 0, 5041);
1611
}
1612
1613
@ Personal computers have a strange syntax with the |HUGE| operator. We
1614
must deal with declarations such as |char HUGE *p;|.
1615
@<CASES for |huge_like| (C)@>=
1616
#if FCN_CALLS
1617
C_huge_like();
1618
#else
1619
@<Cases for |huge_like| (C)@>@;
1620
#endif
1621
1622
@
1623
@<Part 1@>=
1624
#if FCN_CALLS
1625
@[SRTN C_huge_like(VOID)
1626
{
1627
@<Cases for |huge_like| (C)@>@;
1628
}
1629
#endif
1630
1631
@
1632
@<Cases for |huge_like| (C)@>=
1633
{
1634
if(cat1==unorbinop)
1635
{
1636
b_app1(pp); @~ APP_SPACE; @~ b_app1(pp+1);
1637
REDUCE(pp,2,unorbinop,-1,505);
1638
}
1639
}
1640
1641
@
1642
@<CASES for |virtual| (C++)@>=
1643
#if FCN_CALLS
1644
C_virtual();
1645
#else
1646
@<Cases for |virtual| (C++)@>@;
1647
#endif
1648
1649
@
1650
@<Part 1@>=
1651
#if FCN_CALLS
1652
@[SRTN C_virtual(VOID)
1653
{
1654
@<Cases for |virtual| (C++)@>@;
1655
}
1656
#endif
1657
1658
@
1659
@<Cases for |virtual| (C++)@>=
1660
{
1661
b_app1(pp);
1662
1663
if(cat1==unop)
1664
APP_SPACE; // |@c++ virtual ~base();|
1665
1666
REDUCE(pp,1,int_like,0,506);
1667
}
1668
1669
@
1670
@<CASES for |reference| (C++)@>=
1671
#if FCN_CALLS
1672
C_reference();
1673
#else
1674
@<Cases for |reference| (C++)@>@;
1675
#endif
1676
1677
@
1678
@<Part 1@>=
1679
#if FCN_CALLS
1680
@[SRTN C_reference(VOID)
1681
{
1682
@<Cases for |reference| (C++)@>@;
1683
}
1684
#endif
1685
1686
@ If we can't figure out that an ampersand is a reference, treat it just
1687
like an asterisk.
1688
@<Cases for |reference| (C++)@>=
1689
{
1690
SQUASH(pp, 1, unorbinop, -1, 507);
1691
}
1692
1693
@ With the advent of ANSI~C, we have to deal with function prototypes,
1694
which look very much like casts.
1695
1696
@d INDENT if(!indented)
1697
{
1698
b_app(indent);
1699
indented = YES;
1700
}
1701
1702
@d OUTDENT if(indented)
1703
{
1704
b_app(outdent);
1705
indented = NO;
1706
}
1707
1708
@<Glob...@>=
1709
1710
IN_PROD int in_prototype PSET(NO);
1711
// This is used as a numerical counter.
1712
IN_PROD int indented PSET(NO);
1713
1714
@ For \Cpp, it becomes necessary to know whether one is inside or outside
1715
of a function.
1716
1717
@<Glob...@>=
1718
1719
IN_PROD boolean in_function PSET(NO);
1720
1721
@ A |decl_hd| is something like ``|int i|''.
1722
1723
@<CASES for |decl_hd| (C)@>=
1724
#if FCN_CALLS
1725
C_decl_hd();
1726
#else
1727
@<Cases for |decl_hd| (C)@>@;
1728
#endif
1729
1730
@
1731
@<Part 1@>=
1732
#if FCN_CALLS
1733
@[SRTN C_decl_hd(VOID)
1734
{
1735
@<Cases for |decl_hd| (C)@>@;
1736
}
1737
#endif
1738
1739
@
1740
@<Cases for |decl_hd| (C)@>=
1741
{
1742
if(cat1==rpar)
1743
{
1744
if((pp-1)->cat==lpar)
1745
SQUASH(pp,1,decl_hd,-1,4990); // ``|(int i)|''.
1746
else if((pp-2)->cat==decl_hd)
1747
SQUASH(pp,1,decl_hd,-2,4991); // ``|(int i, int j)|''.
1748
else if((pp-3)->cat==decl_hd)
1749
SQUASH(pp, 1, decl_hd, -3, 4992);
1750
}
1751
else if(cat1==decl_hd)
1752
SQUASH(pp,2,decl_hd,0,50); // ``|(int,int)|''
1753
else if(cat1==comma)
1754
{
1755
if(cat2==decl_hd)
1756
{ /* For function prototype. */
1757
b_app2(pp); @~ OPT9;
1758
b_app1(pp+2);
1759
REDUCE(pp,3,decl_hd,0,501);
1760
}
1761
else if(cat2==ignore_scrap && cat3==decl_hd)
1762
{ /* For function prototype with comment. */
1763
b_app2(pp); @~ OPT9;
1764
b_app2(pp+2);
1765
REDUCE(pp,4,decl_hd,0,504);
1766
}
1767
#if 0
1768
else if(Cpp && (cat2==decl || cat2==stmt))
1769
SQUASH(pp, 3, stmt, -2, 508);
1770
/* ``|@c++ for(int i=0, int j=0;;)|'' or ``|@c++
1771
for(int i=0, int j=0, int k=0;;)|''. */
1772
#endif
1773
else
1774
{ /* ``|int i,|'' */
1775
if(cat2==ignore_scrap && (cat3==int_like || cat3==struct_like ||
1776
cat3==modifier) )
1777
{/* Function prototype, with intervening comment. */
1778
b_app1(pp);
1779
if((pp-3)->cat != decl_hd && (pp-2)->cat != decl_hd
1780
&& cat3 != modifier)
1781
in_prototype++;
1782
REDUCE(pp,1,decl_hd,PLUS 3,5221);
1783
}
1784
else if(cat2==int_like || cat2==struct_like || cat2==modifier)
1785
{ /* Function prototype. */
1786
b_app1(pp);
1787
if((pp-3)->cat != decl_hd && (pp-2)->cat != decl_hd
1788
&& cat2 != modifier)
1789
in_prototype++; /* The |modifier| clause is to
1790
prevent a situation like |(int, const int)| from thinking it's two levels
1791
of prototypes. */
1792
REDUCE(pp,1,decl_hd,PLUS 2,52);
1793
}
1794
else
1795
{ /* Expecting list of something. */
1796
b_app2(pp); app(@'~');
1797
1798
#if 0
1799
if(Cpp)
1800
REDUCE(pp, 2, decl_hd, -2, 540);
1801
// ``|@c++ int i=0, int j=0|'' (e.g., in |for|)
1802
else
1803
#endif
1804
REDUCE(pp,2,decl_hd,-1,54); // ``|int i,j|''
1805
}
1806
}
1807
}
1808
else if (cat1==unorbinop)
1809
{ /* ``|int **p|'' */
1810
b_app1(pp);
1811
b_app(@'{');
1812
b_app1(pp+1);
1813
b_app(@'}');
1814
REDUCE(pp,2,decl_hd,-1,55);
1815
}
1816
else if (cat1==expr)
1817
{ /* ``|int i|'' or ``|int i, j|'' */
1818
make_underlined(pp+1);
1819
SQUASH(pp,2,decl_hd,-1,56); /* The |-1| is to pick up a left
1820
paren for function prototype. */
1821
}
1822
else if ((cat1==binop||cat1==colon
1823
||cat1==expr /* (for initializations) */
1824
) && cat2==expr && (cat3==comma || cat3==semi || cat3==rpar))
1825
#if 0
1826
if(cat1==binop)
1827
{
1828
PP_PP(1,2);
1829
REDUCE(pp,3,decl_hd,-1,5660);
1830
}
1831
else
1832
#endif
1833
SQUASH(pp,3,decl_hd,-1,5661);
1834
else if(cat1==int_like && (cat2==unop || cat2==langle))
1835
SQUASH(pp, 1, decl_hd, PLUS 1, 5662);
1836
/* \Cpp: ``|@c++ void *int::fcn()|'' or ``|@c++ void
1837
*int<int>::fcn()|'' */
1838
else if (cat1==lbrace || (cat1==int_like &&
1839
((pp-1)->trans == NULL || **(pp-1)->trans != @'('))) /*
1840
Recognize beginning of function: ``|float f() {}|'' or ``|float f(x) float
1841
x|'' */
1842
{
1843
b_app1(pp);
1844
#if 0
1845
OUTDENT;
1846
#endif
1847
in_function = YES;
1848
defined_at(FIRST_ID(pp));
1849
REDUCE(pp,1,fn_decl,0,58);
1850
}
1851
else if (cat1==semi)
1852
{ /* ``|int i;|'' */
1853
b_app2(pp);
1854
#if 0
1855
OUTDENT; /* Finish long declaration. */
1856
#endif
1857
#if 0
1858
if(Cpp)
1859
REDUCE(pp, 2, decl, -2, 594);
1860
// ``|@c++ for(int i=0, int j=0;;)|''
1861
else
1862
#endif
1863
REDUCE(pp,2,decl,-1,59);
1864
}
1865
else if(Cpp && cat1==int_like && cat2==unop)
1866
SQUASH(pp,1,decl_hd,PLUS 1,590); /* \Cpp: |@c++ void *class::f| */
1867
else if(Cpp && cat1 == rangle)
1868
SQUASH(pp, 1, decl_hd, -2, 591); /* \Cpp: end of template. */
1869
else if(Cpp && cat1 == struct_like)
1870
SQUASH(pp, 2, decl_hd, -1, 593);
1871
/* \Cpp: |@c++ template<class C1, class C2>|. */
1872
}
1873
1874
@ A |decl| is a |decl_hd| followed by a semicolon---i.e., a complete
1875
statement.
1876
1877
@<CASES for |decl| (C)@>=
1878
#if FCN_CALLS
1879
C_decl();
1880
#else
1881
@<Cases for |decl| (C)@>@;
1882
#endif
1883
1884
@
1885
@<Part 1@>=
1886
#if FCN_CALLS
1887
@[SRTN C_decl(VOID)
1888
{
1889
@<Cases for |decl| (C)@>@;
1890
}
1891
#endif
1892
1893
@
1894
@<Cases for |decl| (C)@>=
1895
{
1896
if(Cpp)
1897
{
1898
if(cat1==functn)
1899
{
1900
b_app1(pp); @~ b_app(big_force);
1901
b_app1(pp+1);
1902
REDUCE(pp,2,functn,-1,61);
1903
}
1904
else
1905
SQUASH(pp,1,stmt,-1,611); // E.g., ``|@c++ for(int i=0;;)|''
1906
}
1907
else
1908
{
1909
if (cat1==decl)
1910
{ /* ``|int i; float x;|'' */
1911
b_app1(pp); @~ b_app(force);
1912
b_app1(pp+1);
1913
REDUCE(pp,2,decl,-1,60);
1914
}
1915
else if (cat1==stmt || cat1==functn)
1916
{ /* ``|int i; x=0;|'' or ``|int i; f(){}|'' */
1917
b_app1(pp); @~ b_app(big_force);
1918
b_app1(pp+1);
1919
REDUCE(pp,2,cat1,-1,61);
1920
}
1921
}
1922
}
1923
1924
@ A |fn_decl| is the beginning of a function.
1925
1926
@<CASES for |fn_decl| (C)@>=
1927
#if FCN_CALLS
1928
C_fn_decl();
1929
#else
1930
@<Cases for |fn_decl| (C)@>@;
1931
#endif
1932
1933
@
1934
@<Part 1@>=
1935
#if FCN_CALLS
1936
@[SRTN C_fn_decl(VOID)
1937
{
1938
@<Cases for |fn_decl| (C)@>@;
1939
}
1940
#endif
1941
1942
@
1943
@<Cases for |fn_decl| (C)@>=
1944
{
1945
if(cat1 == semi && Cpp)
1946
{ /* |@c++ using namespace X;| */
1947
b_app2(pp);
1948
REDUCE(pp, 2, stmt, -1, 72);
1949
}
1950
else if (cat1==decl)
1951
{ /* ``|f(x) float x;|'' */
1952
b_app1(pp);
1953
b_app(indent); @~ indent_force;
1954
b_app1(pp+1); /* Accrete old-style declarations. */
1955
b_app(outdent); @~ b_app(outdent);
1956
REDUCE(pp,2,fn_decl,0,70);
1957
}
1958
else if (cat1==stmt)
1959
{ /* ``|f(){}|'' */
1960
#if(0)
1961
b_app(backup); /* Beginning of function. */
1962
#endif
1963
b_app1(pp); @~ b_app(force);
1964
b_app(indent);
1965
b_app1(pp+1); /* Function body */
1966
b_app(outdent);
1967
in_function = kill_nl = NO;
1968
REDUCE(pp,2,functn,-1,71);
1969
}
1970
}
1971
1972
@ Deal with a complete function. Handle ``|f(){} g(){}|'' or ``|f(){}
1973
extern int i;|''.
1974
@<CASES for |functn| (C)@>=
1975
#if FCN_CALLS
1976
C_functn();
1977
#else
1978
@<Cases for |functn| (C)@>@;
1979
#endif
1980
1981
@
1982
@<Part 1@>=
1983
#if FCN_CALLS
1984
@[SRTN C_functn(VOID)
1985
{
1986
@<Cases for |functn| (C)@>@;
1987
}
1988
#endif
1989
1990
@ The |stmt| clause takes care of \Cpp\ constructions like |@c++ try{}
1991
catch(){}|.
1992
@<Cases for |functn| (C)@>=
1993
{
1994
if (cat1==functn || cat1==decl || cat1==stmt)
1995
{
1996
b_app1(pp); @~ b_app(big_force);
1997
b_app1(pp+1); REDUCE(pp,2,cat1,-1,80); /* |-1| for \Cpp */
1998
}
1999
}
2000
2001
@ Handle syntaxes like ``|typedef int I;|'' or ``|typedef int
2002
(**f[])();|''.
2003
@<CASES for |typedef_like| (C)@>=
2004
#if FCN_CALLS
2005
C_typedef_like();
2006
#else
2007
@<Cases for |typedef_like| (C)@>@;
2008
#endif
2009
2010
@
2011
@<Part 1@>=
2012
#if FCN_CALLS
2013
@[SRTN C_typedef_like(VOID)
2014
{
2015
@<Cases for |typedef_like| (C)@>@;
2016
}
2017
#endif
2018
2019
@
2020
@<Glob...@>=
2021
2022
IN_PROD boolean typedefing PSET(NO); // Are we inside a |typedef|?
2023
2024
@
2025
@<Cases for |typedef_like| (C)@>=
2026
{
2027
if (cat1==decl_hd && (cat2==expr || cat2 == int_like))
2028
{
2029
make_underlined(pp+2); make_reserved(pp+2); /* NEEDS TO BE IMPROVED! */
2030
b_app2(pp+1);
2031
REDUCE(pp+1,2,decl_hd,0,90);
2032
}
2033
else if(cat1==decl)
2034
{
2035
PP_PP(1,1);
2036
REDUCE(pp,2,decl,-1,91);
2037
}
2038
else if(cat1==semi)
2039
SQUASH(pp, 2, stmt, -1, 94);
2040
/* ``|typedef|''. */
2041
else if(cat1==stmt)
2042
{
2043
PP_PP(1,1);
2044
REDUCE(pp, 2, stmt, -1, 95);
2045
/* ``|typedef int I[3]|''. (|I| is defined in first pass.) */
2046
}
2047
2048
}
2049
2050
@
2051
@<CASES for |imp_reserved| (C)@>=
2052
#if FCN_CALLS
2053
C_imp_reserved();
2054
#else
2055
@<Cases for |imp_reserved| (C)@>@;
2056
#endif
2057
2058
@
2059
@<Part 1@>=
2060
#if FCN_CALLS
2061
@[SRTN C_imp_reserved(VOID)
2062
{
2063
@<Cases for |imp_reserved| (C)@>@;
2064
}
2065
#endif
2066
2067
@ The special type |imp_reserved| is needed for forward referencing, but
2068
when it's encountered within a |typedef| it should be interpreted as an
2069
expression.
2070
@<Cases for |imp_reserved| (C)@>=
2071
{
2072
if(typedefing) SQUASH(pp,1,expr,-2,92);
2073
else SQUASH(pp,1,int_like,-2,93);
2074
}
2075
2076
@ In \Cpp, operator overloading has a somewhat unusual syntax, in that
2077
constructions like |operator -=| plays the role of a function name.
2078
2079
@d MAX_OP_TOKENS 5 /* Maximum \# of tokens that could conceivably make up
2080
the function name. */
2081
2082
@<CASES for |op_like| (C)@>=
2083
#if FCN_CALLS
2084
C_op_like();
2085
#else
2086
@<Cases for |op_like| (C)@>@;
2087
#endif
2088
2089
@
2090
@<Part 1@>=
2091
#if FCN_CALLS
2092
@[SRTN C_op_like(VOID)
2093
{
2094
@<Cases for |op_like| (C)@>@;
2095
}
2096
#endif
2097
2098
@
2099
@<Cases for |op_like| (C)@>=
2100
{
2101
short n;
2102
// The actual number of tokens that make up the effective function name.
2103
2104
if((cat1==lpar && cat2==rpar) || (cat1==lbracket && cat2==rbracket))
2105
{ /* |@c++ operator ()()| is a special case because it begins with
2106
left paren. |@c++ operator []()| is handled as a special case because we
2107
now have the categories |lbracket| and |rbracket|, and |lbracket| doesn't
2108
regress when it's reduced to |lpar|. */
2109
APP_STR("\\Woperator");
2110
b_app(@'{');
2111
b_app1(pp+1); // |lpar| or |lbracket|
2112
@<Append thinspace@>@;
2113
b_app1(pp+2); // |rpar| or |rbracket|
2114
b_app(@'}');
2115
n = 3;
2116
}
2117
else
2118
{ /* We'll search for the obligatory left paren that indicates the
2119
argument list. */
2120
scrap_pointer q;
2121
int k; /* Counter. */
2122
2123
/* If the paren is missing, we could end up appending the entire rest of
2124
the code, so we limit the search. */
2125
for(q = pp+1; q <= scrp_ptr && q-pp <= MAX_OP_TOKENS; q++)
2126
if(q->cat == lpar)
2127
break;
2128
2129
n = (q->cat == lpar) ? PTR_DIFF(short, q, pp) : 0;
2130
2131
/* Append all the tokens between |operator| and left paren. */
2132
if(n > 0)
2133
{
2134
text_pointer xp;
2135
token_pointer tp,tp1;
2136
2137
#if 0
2138
b_app1(pp); // |@c++ operator|; really \.{\\Woperator}.
2139
b_app(@'{'); /* Braces prevent possible spurious blanks
2140
before the left paren. */
2141
#endif
2142
APP_STR("\\Woperator");
2143
b_app(@'{');
2144
2145
id_first = id_loc = mod_text + 1;
2146
2147
for(k=1; k<n; k++)
2148
{
2149
b_app1(pp+k);
2150
2151
xp = indirect((pp+k)->trans);
2152
tp = *xp;
2153
tp1 = *(xp+1);
2154
while(tp < tp1)
2155
*id_loc++ = (ASCII)(*tp++);
2156
}
2157
2158
underline_xref(id_lookup(id_first,id_loc,0));
2159
2160
b_app(@'}');
2161
}
2162
}
2163
2164
if(n > 0)
2165
REDUCE(pp, n, expr, -2, 6666);
2166
else
2167
{
2168
APP_STR("\\Woperatoro");
2169
REDUCE(pp, 1, expr, -2, 6668);
2170
}
2171
}
2172
2173
@ |@c++ class| is almost like |struct|, but it has to reserve the class name.
2174
(Note that it might have been declared earlier, hence the |int_like| option.)
2175
2176
@<CASES for |class_like| (C)@>=
2177
#if FCN_CALLS
2178
C_class_like();
2179
#else
2180
@<Cases for |class_like| (C)@>@;
2181
#endif
2182
2183
@
2184
@<Part 1@>=
2185
#if FCN_CALLS
2186
@[SRTN C_class_like(VOID)
2187
{
2188
@<Cases for |class_like| (C)@>@;
2189
}
2190
#endif
2191
2192
@
2193
@<Cases for |class_like| (C)@>=
2194
{
2195
if(cat1==expr || cat1==int_like)
2196
{ /* \Cpp: |@c++ class A| */
2197
make_underlined(pp+1); @~ make_reserved(pp+1);
2198
2199
PP_PP(1,1);
2200
2201
if((pp-1)->cat == tstart || (pp-1)->cat == decl_hd
2202
|| (pp-1)->cat == lpar)
2203
REDUCE(pp, 2, decl_hd, -1, 8998);
2204
else
2205
REDUCE(pp, 2, struct_like, 0, 8999);
2206
}
2207
else if(cat1==lbrace)
2208
SQUASH(pp, 1, struct_like, 0, 8987);
2209
// |@c++ class{}| or |@c++ struct{}|.
2210
}
2211
2212
@ Deal with beginning of a structure.
2213
2214
@<CASES for |struct_like| (C)@>=
2215
#if FCN_CALLS
2216
C_struct_like();
2217
#else
2218
@<Cases for |struct_like| (C)@>@;
2219
#endif
2220
2221
@
2222
@<Part 1@>=
2223
#if FCN_CALLS
2224
@[SRTN C_struct_like(VOID)
2225
{
2226
@<Cases for |struct_like| (C)@>@;
2227
}
2228
#endif
2229
2230
@
2231
@c++
2232
@f base int
2233
@f derived int
2234
@<Cases for |struct_like| (C)@>=
2235
{
2236
if (cat1==lbrace)
2237
{ /* ``|struct {int i;} S;|'' or \Cpp: ``|@c++ class A{int i;};|'' */
2238
b_app1(pp); @~ indent_force;
2239
b_app1(pp+1); REDUCE(pp,2,struct_hd,0,100);
2240
}
2241
else if (cat1==expr)
2242
{ /* Structure name: ``|struct s|'' */
2243
if (cat2==lbrace) /* ``|struct s {}|'' */
2244
{
2245
/* In \Cpp, this construction defines a new type. */
2246
if(Cpp)
2247
{make_underlined(pp+1); @~ make_reserved(pp+1);}
2248
2249
PP_PP(1,1);
2250
indent_force;
2251
b_app1(pp+2);
2252
REDUCE(pp,3,struct_hd,0,101);
2253
}
2254
else
2255
{ /* ``|struct s ss|'' */
2256
PP_PP(1, 1);
2257
REDUCE(pp,2,int_like,-1,102);
2258
}
2259
}
2260
else if(cat1==colon && cat2==int_like && Cpp)
2261
{ /* |@c++ class A: base| */
2262
if(cat3==langle)
2263
SQUASH(pp, 1, struct_like, PLUS 3, 1023);
2264
else
2265
{
2266
b_app1(pp); @~ b_app(@' '); @~ b_app1(pp+1); @~ b_app(@' '); @~
2267
b_app1(pp+2);
2268
REDUCE(pp,3,struct_like,0,1021);
2269
}
2270
}
2271
else if(cat1==comma && cat2==int_like && Cpp)
2272
{ /* |@c++ class A: base, base | */
2273
if(cat3==langle)
2274
SQUASH(pp, 1, struct_like, PLUS 3, 1024);
2275
else
2276
{
2277
PP_PP(2, 1);
2278
REDUCE(pp,3,struct_like,0,1022);
2279
}
2280
}
2281
else if(cat1==tlist)
2282
SQUASH(pp, 2, struct_like, 0, 1025); // \Cpp: |@c++ class A<int>|.
2283
else if(cat1==semi)
2284
SQUASH(pp,2,decl,-1,103); /* \Cpp: |@c++ class base;| */
2285
else if(cat1 == rangle)
2286
SQUASH(pp, 1, decl_hd, -2, 592); /* \Cpp: end of template. */
2287
}
2288
2289
@ Handle ``|enum{red,yellow}|;''.
2290
@<CASES for |struct_hd| (C)@>=
2291
#if FCN_CALLS
2292
C_str_hd();
2293
#else
2294
@<Cases for |struct_hd| (C)@>@;
2295
#endif
2296
2297
@
2298
@<Part 1@>=
2299
#if FCN_CALLS
2300
@[SRTN C_str_hd(VOID)
2301
{
2302
@<Cases for |struct_hd| (C)@>@;
2303
}
2304
#endif
2305
2306
@
2307
@<Cases for |struct_hd| (C)@>=
2308
{
2309
if ((cat1==decl || cat1==stmt
2310
|| cat1==expr /* (For enum) */
2311
|| cat1==functn /* \Cpp */
2312
) && cat2==rbrace)
2313
{
2314
b_app1(pp); /* ``|struct {|'' */
2315
@<Append a body@>@;
2316
b_app1(pp+2); /* ``|}|'' */
2317
b_app(outdent);
2318
@#if 0
2319
b_app(break_space);
2320
@#endif
2321
REDUCE(pp,3,int_like,-1,110);
2322
}
2323
else if(cat1==rbrace)
2324
{
2325
b_app1(pp); @~ @<Append thin...@>@; b_app1(pp+1);
2326
b_app(outdent);
2327
REDUCE(pp,2,int_like,-1,1101);
2328
}
2329
}
2330
2331
@
2332
@<CASES for |lpar| (C)@>=
2333
#if FCN_CALLS
2334
C_lpar();
2335
#else
2336
@<Cases for |lpar| (C)@>@;
2337
#endif
2338
2339
@
2340
@<Part 1@>=
2341
#if FCN_CALLS
2342
@[SRTN C_lpar(VOID)
2343
{
2344
@<Cases for |lpar| (C)@>@;
2345
}
2346
#endif
2347
2348
@
2349
@<Cases for |lpar| (C)@>=
2350
{
2351
if (cat2==rpar && (cat1==expr || cat1==unorbinop))
2352
SQUASH(pp,3,expr,-2,120); /* ``|(x)|'' or ``|(*)|''*/
2353
else if (cat1==rpar)
2354
{ /* ``|()|''. This looks better with a bit of extra space between
2355
the parens. */
2356
b_app1(pp); @~ @<Append thickspace@>; @~ b_app1(pp+1);
2357
REDUCE(pp,2,expr,-2,121);
2358
}
2359
else if ((cat1==decl_hd) && cat2==rpar)
2360
{ /* Function prototype or cast, like ``|typedef (*T)|'' where |T|
2361
was |typedef|d on the first pass. */
2362
b_app3(pp);
2363
2364
OUTDENT;
2365
2366
if(in_prototype)
2367
in_prototype--;
2368
2369
REDUCE(pp,3,cast,-1,122);
2370
}
2371
else if (cat1==stmt)
2372
{ /* ``|for(x;y;z)|'' */
2373
b_app2(pp); b_app(@' '); REDUCE(pp,2,lpar,0,123);
2374
}
2375
else if(cat1==for_like && cat2==rpar)
2376
SQUASH(pp,3,expr,-2,1201); /* Macros: |(for)| */
2377
}
2378
2379
@
2380
@<CASES for |lbracket| (C)@>=
2381
#if FCN_CALLS
2382
C_lbracket();
2383
#else
2384
@<Cases for |lbracket| (C)@>@;
2385
#endif
2386
2387
@
2388
@<Part 1@>=
2389
#if FCN_CALLS
2390
@[SRTN C_lbracket(VOID)
2391
{
2392
@<Cases for |lbracket| (C)@>@;
2393
}
2394
#endif
2395
2396
@
2397
@<Cases for |lbracket| (C)@>=
2398
{
2399
if(active_brackets)
2400
{
2401
b_app(@'\\');
2402
APP_STR("WXA{");
2403
}
2404
else b_app1(pp);
2405
2406
REDUCE(pp,1,lpar,0,5000);
2407
}
2408
2409
@
2410
@<CASES for |rbracket| (C)@>=
2411
#if FCN_CALLS
2412
C_rbracket();
2413
#else
2414
@<Cases for |rbracket| (C)@>@;
2415
#endif
2416
2417
@
2418
@<Part 1@>=
2419
#if FCN_CALLS
2420
@[SRTN C_rbracket(VOID)
2421
{
2422
@<Cases for |rbracket| (C)@>@;
2423
}
2424
#endif
2425
2426
@
2427
@<Cases for |rbracket| (C)@>=
2428
{
2429
if(active_brackets)
2430
{
2431
text_pointer t = indirect(pp->trans);
2432
2433
if(**t == @']') **t = @'}';
2434
}
2435
2436
b_app1(pp);
2437
2438
REDUCE(pp,1,rpar,-5,5001);
2439
}
2440
2441
@
2442
@<CASES for |kill_newlines| (C++)@>=
2443
#if FCN_CALLS
2444
C_killnl();
2445
#else
2446
@<Cases for |kill_newlines| (C++)@>@;
2447
#endif
2448
2449
@
2450
@<Part 1@>=
2451
#if FCN_CALLS
2452
@[SRTN C_killnl(VOID)
2453
{
2454
@<Cases for |kill_newlines| (C++)@>@;
2455
}
2456
#endif
2457
2458
@ The |kill_nl| flag is intended to make prettier short functions for such
2459
things as simple \Cpp\ constructors. The scrap of ilk |kill_newlines| is
2460
appended by \.{@@\{}.
2461
2462
@<Glob...@>=
2463
IN_PROD boolean kill_nl PSET(NO);
2464
2465
@
2466
@<Append a |force| or thinspace@>=
2467
{
2468
if(kill_nl)
2469
@<Append thinspace@>@;
2470
else
2471
b_app(force);
2472
}
2473
2474
@
2475
@<Cases for |kill_newlines| (C++)@>=
2476
{
2477
kill_nl = YES;
2478
SQUASH(pp, 1, lbrace, -2, 8888);
2479
}
2480
2481
@
2482
@<CASES for |lbrace| (C)@>=
2483
#if FCN_CALLS
2484
C_lbrace();
2485
#else
2486
@<Cases for |lbrace| (C)@>@;
2487
#endif
2488
2489
@
2490
@<Part 1@>=
2491
#if FCN_CALLS
2492
@[SRTN C_lbrace(VOID)
2493
{
2494
@<Cases for |lbrace| (C)@>@;
2495
}
2496
#endif
2497
2498
@
2499
@<Cases for |lbrace| (C)@>=
2500
{
2501
if (cat1==rbrace) /* ``|{}|'' */
2502
{
2503
b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
2504
REDUCE(pp,2,stmt,-1,130);
2505
}
2506
else if ((cat1==stmt || cat1==decl || cat1==functn) && cat2==rbrace)
2507
/* ``|{x;}|'' or \dots\ or \Cpp: |@c++ main(){try{}catch(){}}| */
2508
{
2509
b_app(force);
2510
b_app1(pp); /* ``|{|'' */
2511
2512
@<Append a body@>@;
2513
2514
b_app1(pp+2); /* ``|}|'' */
2515
2516
REDUCE(pp,3,stmt,-1,131);
2517
}
2518
else if (cat1==expr)
2519
{
2520
if (cat2==rbrace)
2521
SQUASH(pp,3,expr,-2,132); /* ``|enum{red}|'' */
2522
else if (cat2==comma && cat3==rbrace)
2523
SQUASH(pp,4,expr,-2,132);
2524
}
2525
}
2526
2527
@
2528
@<Append a body@>=
2529
{
2530
@<Append a |force| or thinspace@>@;
2531
2532
b_app1(pp+1); /* Body */
2533
2534
@<Append a |force| or thinspace@>@;
2535
2536
kill_nl = NO;
2537
}
2538
2539
@
2540
@<CASES for |unop| (C)@>=
2541
#if FCN_CALLS
2542
C__unop();
2543
#else
2544
@<Cases for |unop| (C)@>@;
2545
#endif
2546
2547
@
2548
@<Part 1@>=
2549
#if FCN_CALLS
2550
@[SRTN C__unop(VOID)
2551
{
2552
@<Cases for |unop| (C)@>@;
2553
}
2554
#endif
2555
2556
@
2557
@<Cases for |unop| (C)@>=
2558
{
2559
if (cat1==expr)
2560
SQUASH(pp,2,expr,-2,140); /* ``|!x|'' or ``|++x|'' */
2561
else if(cat1==int_like)
2562
SQUASH(pp,2,int_like,0,141); /* \Cpp\ destructor:
2563
``|@c++ ~base|'' */
2564
}
2565
2566
@
2567
@<CASES for |unorbinop| (C)@>=
2568
#if FCN_CALLS
2569
C_unorbinop();
2570
#else
2571
@<Cases for |unorbinop| (C)@>@;
2572
#endif
2573
2574
@
2575
@<Part 1@>=
2576
#if FCN_CALLS
2577
@[SRTN C_unorbinop(VOID)
2578
{
2579
@<Cases for |unorbinop| (C)@>@;
2580
}
2581
#endif
2582
2583
@
2584
@<Cases for |unorbinop| (C)@>=
2585
{
2586
if(cat1==expr || (cat1==int_like && !(cat2 == lpar || cat2 == unop)) )
2587
{ /* ``|*p|'' or ``|&x|''; ``|typedef
2588
(*T)|'' where |T| was |typedef|d on the first pass. Not
2589
\Cpp: ``|@c++ x + int(i)|'' or ``|@c++ x + base::y|''. */
2590
b_app(@'{'); @~b_app1(pp); @~ b_app(@'}');
2591
b_app1(pp+1);
2592
REDUCE(pp,2,cat1,-2,150);
2593
}
2594
else if (cat1==binop)
2595
@<Reduce cases like |*=|@>@;
2596
}
2597
2598
@
2599
@<Reduce cases like |*=|@>=
2600
{
2601
b_app(math_bin);
2602
b_app1(pp);
2603
b_app(@'{'); @~ b_app1(pp+1); @~ b_app(@'}');
2604
b_app(@'}'); /* End |math_bin| */
2605
REDUCE(pp,2,binop,-1,151);
2606
}
2607
2608
@
2609
@<CASES for |cast| (C)@>=
2610
#if FCN_CALLS
2611
C_cast();
2612
#else
2613
@<Cases for |cast| (C)@>@;
2614
#endif
2615
2616
@
2617
@<Part 1@>=
2618
#if FCN_CALLS
2619
@[SRTN C_cast(VOID)
2620
{
2621
@<Cases for |cast| (C)@>@;
2622
}
2623
#endif
2624
2625
@
2626
@<Cases for |cast| (C)@>=
2627
{
2628
if (cat1==expr) /* ``|(int *)p|'' */
2629
{
2630
b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
2631
REDUCE(pp,2,expr,-2,160);
2632
}
2633
else if(cat1 == unorbinop || cat1 == reference)
2634
SQUASH(pp, 1, cast, PLUS 1, 162); // ``|(int *)&prms|''.
2635
else
2636
SQUASH(pp,1,expr,-2,161); // Turn function prototype into expression.
2637
}
2638
2639
@
2640
@<CASES for |sizeof_like| (C)@>=
2641
#if FCN_CALLS
2642
C_sizeof_like();
2643
#else
2644
@<Cases for |sizeof_like| (C)@>@;
2645
#endif
2646
2647
@
2648
@<Part 1@>=
2649
#if FCN_CALLS
2650
@[SRTN C_sizeof_like(VOID)
2651
{
2652
@<Cases for |sizeof_like| (C)@>@;
2653
}
2654
#endif
2655
2656
@
2657
@<Cases for |sizeof_like| (C)@>=
2658
{
2659
if (cat1==cast)
2660
SQUASH(pp,2,expr,-2,170); /* ``|sizeof (int *)|'' */
2661
else if (cat1==expr)
2662
SQUASH(pp,2,expr,-2,171); /* ``|sizeof(x)|'' */
2663
}
2664
2665
@
2666
@<CASES for |binop| (C)@>=
2667
#if FCN_CALLS
2668
C__binop();
2669
#else
2670
@<Cases for |binop| (C)@>@;
2671
#endif
2672
2673
@
2674
@<Part 1@>=
2675
#if FCN_CALLS
2676
@[SRTN C__binop(VOID)
2677
{
2678
@<Cases for |binop| (C)@>@;
2679
}
2680
#endif
2681
2682
@
2683
@<Cases for |binop| (C)@>=
2684
{
2685
if (cat1==binop)
2686
@<Reduce cases like |+=|@>@; /* ``|+=|'' */
2687
else if(cat1==space)
2688
{
2689
b_app1(pp); // We eat the space in this macro situation.
2690
REDUCE(pp, 2, binop, -1, 181); // |#if(a == b)|.
2691
}
2692
else if(Cpp && cat1==decl_hd)
2693
SQUASH(pp, 2, tstart, 0, 6063);
2694
/* Trap for ``|@c++ A<int>|'', with |A| undefined. See
2695
also Rule 6061. */
2696
}
2697
2698
@
2699
@<Reduce cases like |+=|@>=
2700
{
2701
b_app(math_bin); b_app1(pp);
2702
b_app(@'{'); @~ b_app1(pp+1); @~ b_app(@'}');
2703
b_app(@'}'); /* End |math_bin| */
2704
REDUCE(pp,2,binop,-1,180);
2705
}
2706
2707
@
2708
@<CASES for |do_like| (C)@>=
2709
#if FCN_CALLS
2710
C_do_like();
2711
#else
2712
@<Cases for |do_like| (C)@>@;
2713
#endif
2714
2715
@
2716
@<Part 1@>=
2717
#if FCN_CALLS
2718
@[SRTN C_do_like(VOID)
2719
{
2720
@<Cases for |do_like| (C)@>@;
2721
}
2722
#endif
2723
2724
@
2725
@<Cases for |do_like| (C)@>=
2726
{
2727
if (cat1==stmt)
2728
if(cat2==for_like)
2729
{
2730
cat2 = while_do;
2731
SQUASH(pp, 1, do_like, PLUS 2, 191);
2732
}
2733
else if(cat2==expr && cat3==semi)
2734
{ /* ``|do {} while(flag);|'' */
2735
b_app1(pp); // ``\&{do}''
2736
indent_force;
2737
b_app1(pp+1); // stmt
2738
b_app(outdent);
2739
b_app(force);
2740
b_app2(pp+2); // ``\&{while}\dots''
2741
REDUCE(pp,4,stmt,-1,190);
2742
}
2743
}
2744
2745
@
2746
@<CASES for |while_do| (C)@>=
2747
#if FCN_CALLS
2748
C_wh_do();
2749
#else
2750
@<Cases for |while_do| (C)@>@;
2751
#endif
2752
2753
@
2754
@<Part 1@>=
2755
#if FCN_CALLS
2756
@[SRTN C_wh_do(VOID)
2757
{
2758
@<Cases for |while_do| (C)@>@;
2759
}
2760
#endif
2761
2762
@
2763
@<Cases for |while_do| (C)@>=
2764
{
2765
b_app1(pp);
2766
@<Append thinspace@>;
2767
REDUCE(pp, 1, expr, 0, 192);
2768
}
2769
2770
@ Identifiers that are |for_like| must in normal usage be followed by a
2771
parenthesized expression. However, since they might be used in isolation in
2772
a macro argument, we allow a default possibility.
2773
2774
@<CASES for |for_like| (C)@>=
2775
#if FCN_CALLS
2776
C_for_like();
2777
#else
2778
@<Cases for |for_like| (C)@>@;
2779
#endif
2780
2781
@
2782
@<Part 1@>=
2783
#if FCN_CALLS
2784
@[SRTN C_for_like(VOID)
2785
{
2786
@<Cases for |for_like| (C)@>@;
2787
}
2788
#endif
2789
2790
@
2791
@<Cases for |for_like| (C)@>=
2792
{
2793
if (cat1==expr)
2794
{ /* ``\&{for}\dots'' */
2795
b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
2796
b_app(@' '); // Unnecessary? (Space at end of |for| line?)
2797
2798
if(cat2==semi)
2799
{ /* ``|for(;;);|'' */
2800
if(!auto_semi || (auto_semi && cat3==semi))
2801
{
2802
indent_force;
2803
b_app1(pp+2); // Semi on separate line.
2804
b_app(outdent);
2805
REDUCE(pp,3,stmt,-2,200); /* The $-2$ is for the
2806
\&{do} case. Also get here from Ratfor's \&{until}. */
2807
}
2808
else
2809
REDUCE(pp,3,for_hd,0,2011); // Eat the |auto_semi|.
2810
}
2811
else
2812
REDUCE(pp,2,for_hd,0,201); // Eat the arguments.
2813
}
2814
else if(cat1 != lpar)
2815
SQUASH(pp,1,expr,0,2010); // Default possiblity.
2816
}
2817
2818
@
2819
@<CASES for |for_hd| (C)@>=
2820
#if FCN_CALLS
2821
C_forhd();
2822
#else
2823
@<Cases for |for_hd| (C)@>@;
2824
#endif
2825
2826
@
2827
@<Part 1@>=
2828
#if FCN_CALLS
2829
@[SRTN C_forhd(VOID)
2830
{
2831
@<Cases for |for_hd| (C)@>@;
2832
}
2833
#endif
2834
2835
@
2836
@<Cases for |for_hd| (C)@>=
2837
{
2838
if (cat1==stmt)
2839
{ /* ``|for(;;) x;|'' */
2840
b_app1(pp);
2841
indent_force;
2842
b_app1(pp+1);
2843
b_app(outdent);
2844
REDUCE(pp,2,stmt,-1,210);
2845
}
2846
}
2847
2848
@ Begin an \&{if} statement by just absorbing the argument in parentheses.
2849
We check to see if there's a comment coming up, and set a flag. We have to
2850
do that here because |ignore_scrap| is digested before the big switch.
2851
2852
@<CASES for |if_like| (C)@>=
2853
#if FCN_CALLS
2854
C_if_like();
2855
#else
2856
@<Cases for |if_like| (C)@>@;
2857
#endif
2858
2859
@
2860
@<Part 1@>=
2861
#if FCN_CALLS
2862
@[SRTN C_if_like(VOID)
2863
{
2864
@<Cases for |if_like| (C)@>@;
2865
}
2866
#endif
2867
2868
@
2869
@<Cases for |if_like| (C)@>=
2870
{
2871
if (cat1==lpar && cat2==expr && cat3==rpar) /* ``|if(x)|'' */
2872
{
2873
b_app1(pp); @<Append thinspace@>; b_app3(pp+1);
2874
#if(0)
2875
cmnt_after_IF = (cat4==ignore_scrap); /* Comment coming up? */
2876
#endif
2877
REDUCE(pp,4,IF_like,0,220);
2878
}
2879
}
2880
2881
@ We need a flag to tell us whether a comment (really, |ignore_scrap|)
2882
follows an |if(x)| construction. If so, we'll put even simple statements on
2883
the next line, properly indented. (Not working yet!)
2884
2885
@<Glob...@>=
2886
2887
@#if(0)
2888
IN_PROD cmnt_after_IF PSET(NO);
2889
@#endif
2890
2891
@ Attach |stmt| to |if(x)|. Statements get indented on next line.
2892
If there's no \&{else} following, we're done.
2893
2894
@<CASES for |IF_like| (C)@>=
2895
#if FCN_CALLS
2896
C_IF();
2897
#else
2898
@<Cases for |IF_like| (C)@>@;
2899
#endif
2900
2901
@
2902
@<Part 1@>=
2903
#if FCN_CALLS
2904
@[SRTN C_IF(VOID)
2905
{
2906
@<Cases for |IF_like| (C)@>@;
2907
}
2908
#endif
2909
2910
@
2911
@<Cases for |IF_like| (C)@>=
2912
{
2913
if(cat1==stmt
2914
|| cat1==lbrace || cat1==if_like || cat1==for_like || cat1==do_like
2915
|| cat1==Rdo_like
2916
#if(0)
2917
|| cmnt_after_IF
2918
#endif
2919
)
2920
SQUASH(pp,1,if_hd,0,230); // |if_hd| does the indenting.
2921
#if(0)
2922
else if(cat1==stmt)
2923
{ /* Attach simple statement. */
2924
PP_PP(1,1);
2925
REDUCE(pp,2,IF_top,-1,231);
2926
}
2927
#endif
2928
}
2929
2930
@ The purpose here is to take a complete statement and indent it on the
2931
next line.
2932
@<CASES for |if_hd| (C)@>=
2933
#if FCN_CALLS
2934
C_if_hd();
2935
#else
2936
@<Cases for |if_hd| (C)@>@;
2937
#endif
2938
2939
@
2940
@<Part 1@>=
2941
#if FCN_CALLS
2942
@[SRTN C_if_hd(VOID)
2943
{
2944
@<Cases for |if_hd| (C)@>@;
2945
}
2946
#endif
2947
2948
@
2949
@<Cases for |if_hd| (C)@>=
2950
{
2951
if (cat1==stmt) /* ``|if(x) {}|'' */
2952
{
2953
b_app1(pp); /* ``|if(x)|'' */
2954
indent_force;
2955
b_app1(pp+1); /* ``|{}|'' */
2956
b_app(outdent);
2957
REDUCE(pp,2,IF_top,-1,233);
2958
}
2959
else if(cat1==IF_top && cat2==else_like)
2960
SQUASH(pp,1,if_hd,2,234);
2961
}
2962
2963
@
2964
@<CASES for |else_hd| (C)@>=
2965
#if FCN_CALLS
2966
C_els_hd();
2967
#else
2968
@<Cases for |else_hd| (C)@>@;
2969
#endif
2970
2971
@
2972
@<Part 1@>=
2973
#if FCN_CALLS
2974
@[SRTN C_els_hd(VOID)
2975
{
2976
@<Cases for |else_hd| (C)@>@;
2977
}
2978
#endif
2979
2980
@
2981
@<Cases for |else_hd| (C)@>=
2982
{
2983
if (cat1==stmt) /* ``|if(x) {}|'' */
2984
{
2985
b_app1(pp); /* ``|if(x)|'' */
2986
indent_force;
2987
b_app1(pp+1); /* ``|{}|'' */
2988
b_app(outdent);
2989
REDUCE(pp,2,ELSE_like,-1,241);
2990
}
2991
}
2992
2993
@
2994
@<CASES for |else_like| (C)@>=
2995
#if FCN_CALLS
2996
C_else();
2997
#else
2998
@<Cases for |else_like| (C)@>@;
2999
#endif
3000
3001
@
3002
@<Part 1@>=
3003
#if FCN_CALLS
3004
@[SRTN C_else(VOID)
3005
{
3006
@<Cases for |else_like| (C)@>@;
3007
}
3008
#endif
3009
3010
@
3011
@<Cases for |else_like| (C)@>=
3012
{
3013
if(cat1==if_like) /* ``|else if|'' */
3014
{
3015
PP_PP(1,1);
3016
REDUCE(pp,2,if_like,0,235);
3017
}
3018
else if(cat1==stmt || cat1==lbrace || cat1==for_like || cat1==do_like)
3019
SQUASH(pp,1,else_hd,0,236); /* ``|else {}|'' */
3020
#if 0 /* The following puts simple statement on same line. */
3021
else if(cat1==stmt) /* ``|else z;|'' */
3022
{
3023
PP_PP(1,1);
3024
REDUCE(pp,2,ELSE_like,-1,237);
3025
}
3026
#endif
3027
}
3028
3029
@ This is commented out above.
3030
@<CASES for |ELSE_like| (C)@>=
3031
#if FCN_CALLS
3032
C_ELS();
3033
#else
3034
@<Cases for |ELSE_like| (C)@>@;
3035
#endif
3036
3037
@
3038
@<Part 1@>=
3039
#if FCN_CALLS
3040
@[SRTN C_ELS(VOID)
3041
{
3042
@<Cases for |ELSE_like| (C)@>@;
3043
}
3044
#endif
3045
3046
@
3047
@<Cases for |ELSE_like| (C)@>=
3048
3049
@
3050
@<CASES for |IF_top| (C)@>=
3051
#if FCN_CALLS
3052
C_IF_top();
3053
#else
3054
@<Cases for |IF_top| (C)@>@;
3055
#endif
3056
3057
@
3058
@<Part 1@>=
3059
#if FCN_CALLS
3060
@[SRTN C_IF_top(VOID)
3061
{
3062
@<Cases for |IF_top| (C)@>@;
3063
}
3064
#endif
3065
3066
@
3067
@<Cases for |IF_top| (C)@>=
3068
{
3069
if(cat1==else_like || cat1==else_hd || cat1==space)
3070
SQUASH(pp,1,IF_top,1,242); /* Expand ahead. */
3071
else if(cat1==IF_top)
3072
{
3073
b_app1(pp); /* \&{if}\dots */
3074
b_app(force);
3075
b_app1(pp+1); /* \&{else if}\dots */
3076
REDUCE(pp,2,IF_top,-1,238);
3077
}
3078
else if(cat1==ELSE_like)
3079
{
3080
b_app1(pp); /* \&{if} */
3081
b_app(force);
3082
b_app1(pp+1); /* \&{else} */
3083
REDUCE(pp,2,stmt,-1,239);
3084
}
3085
else if(cat1==IF_like && (cat2==expr || cat2==stmt))
3086
SQUASH(pp,1,IF_top,1,241);
3087
else
3088
SQUASH(pp,1,stmt,-1,240);
3089
}
3090
3091
@
3092
@<CASES for |stmt| (C)@>=
3093
#if FCN_CALLS
3094
C_stmt();
3095
#else
3096
@<Cases for |stmt| (C)@>@;
3097
#endif
3098
3099
@
3100
@<Part 1@>=
3101
#if FCN_CALLS
3102
@[SRTN C_stmt(VOID)
3103
{
3104
@<Cases for |stmt| (C)@>@;
3105
}
3106
#endif
3107
3108
@
3109
@<Cases for |stmt| (C)@>=
3110
{
3111
if (cat1==stmt || (Cpp && cat1==decl)) /* ``|x; y;|'' */
3112
{
3113
b_app1(pp);
3114
3115
@<Append a |force| or thinspace@>@;
3116
3117
b_app1(pp+1);
3118
3119
REDUCE(pp,2,stmt,-1,250);
3120
}
3121
else if (cat1==functn)
3122
{
3123
b_app1(pp); @~ b_app(big_force);
3124
b_app1(pp+1);
3125
REDUCE(pp,2,stmt,-1,251);
3126
}
3127
}
3128
3129
@
3130
@<CASES for |case_like| (C)@>=
3131
#if FCN_CALLS
3132
C_case_like();
3133
#else
3134
@<Cases for |case_like| (C)@>@;
3135
#endif
3136
3137
@
3138
@<Part 1@>=
3139
#if FCN_CALLS
3140
@[SRTN C_case_like(VOID)
3141
{
3142
@<Cases for |case_like| (C)@>@;
3143
}
3144
#endif
3145
3146
@
3147
@<Cases for |case_like| (C)@>=
3148
{
3149
if (cat1==semi)
3150
SQUASH(pp,2,stmt,-1,260); /* |return;| */
3151
else if (cat1==colon)
3152
SQUASH(pp,2,tag,-1,261); /* |default:| or \Cpp: |@c++ public:| */
3153
else if (cat1==expr)
3154
{
3155
if (cat2==semi) /* |return x;| */
3156
{
3157
PP_PP(1,2);
3158
REDUCE(pp,3,stmt,-1,262);
3159
}
3160
else if (cat2==colon) /* |case one:| */
3161
{
3162
PP_PP(1,2);
3163
REDUCE(pp,3,tag,-1,263);
3164
}
3165
}
3166
else if(cat1==int_like)
3167
{ /* \Cpp: |@c++ public base| */
3168
PP_PP(1,1);
3169
REDUCE(pp,2,int_like,-2,264);
3170
}
3171
}
3172
3173
@
3174
@<CASES for |tag| (C)@>=
3175
#if FCN_CALLS
3176
C_tag();
3177
#else
3178
@<Cases for |tag| (C)@>@;
3179
#endif
3180
3181
@
3182
@<Part 1@>=
3183
#if FCN_CALLS
3184
@[SRTN C_tag(VOID)
3185
{
3186
@<Cases for |tag| (C)@>@;
3187
}
3188
#endif
3189
3190
@
3191
@<Cases for |tag| (C)@>=
3192
{
3193
if (cat1==tag) /* ``|case one: case two:|'' */
3194
{
3195
b_app1(pp);
3196
b_app(force);
3197
b_app(backup);
3198
b_app1(pp+1); REDUCE(pp,2,tag,-1,270);
3199
}
3200
else if (cat1==stmt || cat1==decl || cat1==functn) /* ``|case one:
3201
break;|'' or \Cpp: ``|@c++ public: int constructor();|'' */
3202
{
3203
b_app(big_force);
3204
b_app(backup); @~ b_app1(pp); @~ b_app(force);
3205
b_app1(pp+1);
3206
REDUCE(pp,2,cat1,-1,271);
3207
}
3208
}
3209
3210
@ To help distinguish a null statement, we preface the semicolon by a space.
3211
@<CASES for |semi| (C)@>=
3212
#if FCN_CALLS
3213
C_semi();
3214
#else
3215
@<Cases for |semi| (C)@>@;
3216
#endif
3217
3218
@
3219
@<Part 1@>=
3220
#if FCN_CALLS
3221
@[SRTN C_semi(VOID)
3222
{
3223
@<Cases for |semi| (C)@>@;
3224
}
3225
#endif
3226
3227
@
3228
@<Cases for |semi| (C)@>=
3229
{
3230
b_app(@' '); @~ b_app1(pp);
3231
REDUCE(pp,1,stmt,-1,280);
3232
}
3233
3234
@
3235
@<CASES for |template| (C++)@>=
3236
#if FCN_CALLS
3237
C_template();
3238
#else
3239
@<Cases for |template| (C++)@>@;
3240
#endif
3241
3242
@
3243
@<Part 1@>=
3244
#if FCN_CALLS
3245
@[SRTN C_template(VOID)
3246
{
3247
@<Cases for |template| (C++)@>@;
3248
}
3249
#endif
3250
3251
@
3252
@<Cases for |template| (C++)@>=
3253
{
3254
if(cat1 == langle)
3255
SQUASH(pp, 1, template, PLUS 1, 6000);
3256
else if(cat1 == tlist)
3257
{
3258
PP_PP(1, 1); @~ b_app(force);
3259
REDUCE(pp, 2, int_like, 0, 6001);
3260
}
3261
}
3262
3263
@
3264
@<CASES for |langle| (C++)@>=
3265
#if FCN_CALLS
3266
C_langle();
3267
#else
3268
@<Cases for |langle| (C++)@>@;
3269
#endif
3270
3271
@
3272
@<Part 1@>=
3273
#if FCN_CALLS
3274
@[SRTN C_langle(VOID)
3275
{
3276
@<Cases for |langle| (C++)@>@;
3277
}
3278
#endif
3279
3280
@ If the |langle| isn't grabbed up by |template|, it's just an ordinary
3281
binary operator.
3282
@<Cases for |langle| (C++)@>=
3283
{
3284
if((pp-1)->cat == template || (pp-1)->cat == int_like || (pp-1)->cat ==
3285
struct_like)
3286
{
3287
b_app(@'\\');
3288
APP_STR("WLA "); // \.{\\WLA} $\equiv$ `$\WLA$'.
3289
REDUCE(pp, 1, tstart, 0, 6050); // Begining of template parameter list.
3290
}
3291
else if(cat1 == decl_hd && cat2 == rangle)
3292
{
3293
b_app(@'\\');
3294
APP_STR("WLA ");
3295
b_app1(pp+1);
3296
b_app(@'\\');
3297
APP_STR("WRA ");
3298
REDUCE(pp, 3, expr, -1, 6053); // |@c++ f<int, int>|.
3299
}
3300
else if(cat1 == int_like)
3301
SQUASH(pp, 1, langle, PLUS 1, 6054); // |@c++ f<int>|.
3302
else
3303
SQUASH(pp, 1, binop, -1, 6051);
3304
}
3305
3306
@
3307
@<CASES for |rangle| (C++)@>=
3308
#if FCN_CALLS
3309
C_rangle();
3310
#else
3311
@<Cases for |rangle| (C++)@>@;
3312
#endif
3313
3314
@
3315
@<Part 1@>=
3316
#if FCN_CALLS
3317
@[SRTN C_rangle(VOID)
3318
{
3319
@<Cases for |rangle| (C++)@>@;
3320
}
3321
#endif
3322
3323
@ If the |rangle| isn't grabbed up by |template|, it's just an ordinary
3324
binary operator.
3325
@<Cases for |rangle| (C++)@>=
3326
{
3327
if((pp-1)->cat == decl_hd)
3328
SQUASH(pp, 1, rangle, -2, 6055);
3329
else
3330
SQUASH(pp, 1, binop, -1, 6052);
3331
}
3332
3333
@
3334
@<CASES for |tstart| (C++)@>=
3335
#if FCN_CALLS
3336
C_tstart();
3337
#else
3338
@<Cases for |tstart| (C++)@>@;
3339
#endif
3340
3341
@
3342
@<Part 1@>=
3343
#if FCN_CALLS
3344
@[SRTN C_tstart(VOID)
3345
{
3346
@<Cases for |tstart| (C++)@>@;
3347
}
3348
#endif
3349
3350
@
3351
@<Cases for |tstart| (C++)@>=
3352
{
3353
if(cat2 == rangle && (cat1==int_like || cat1==decl_hd || cat1==expr
3354
|| cat1==unorbinop))
3355
{
3356
b_app2(pp);
3357
b_app(@'\\');
3358
APP_STR("WRA "); // Closing of template.
3359
OUTDENT;
3360
REDUCE(pp, 3, tlist, -1, 6060);
3361
}
3362
}
3363
3364
@
3365
@<CASES for |tlist| (C++)@>=
3366
#if FCN_CALLS
3367
C_tlist();
3368
#else
3369
@<Cases for |tlist| (C++)@>@;
3370
#endif
3371
3372
@
3373
@<Part 1@>=
3374
#if FCN_CALLS
3375
@[SRTN C_tlist(VOID)
3376
{
3377
@<Cases for |tlist| (C++)@>@;
3378
}
3379
#endif
3380
3381
@
3382
@<Cases for |tlist| (C++)@>=
3383
3384
@
3385
@<CASES for |namespace| (C++)@>=
3386
#if FCN_CALLS
3387
C_namespace();
3388
#else
3389
@<Cases for |namespace| (C++)@>@;
3390
#endif
3391
3392
@
3393
@<Part 1@>=
3394
#if FCN_CALLS
3395
@[SRTN C_namespace(VOID)
3396
{
3397
@<Cases for |namespace| (C++)@>@;
3398
}
3399
#endif
3400
3401
@
3402
@<Cases for |namespace| (C++)@>=
3403
{
3404
if(cat1==expr || cat1==int_like)
3405
{ /* \Cpp: |@c++ namespace A| */
3406
make_underlined(pp+1); @~ make_reserved(pp+1);
3407
3408
PP_PP(1,1);
3409
3410
REDUCE(pp, 2, fn_decl, 0, 7901);
3411
}
3412
else if(cat1==lbrace)
3413
SQUASH(pp, 1, fn_decl, 0, 7902); // |@c++ namespace{}|
3414
}
3415
3416
@
3417
@<Glob...@>=
3418
3419
IN_PROD boolean forward_exp PSET(NO);
3420
3421
@* PRODUCTIONS for RATFOR and FORTRAN.
3422
Note that in some cases we use the C~rules for \RATFOR\ as well.
3423
3424
@<Part 2@>=@[
3425
3426
SRTN
3427
R_productions(VOID)
3428
{
3429
switch (pp->cat)
3430
{
3431
case ignore_scrap: @<CASES for |ignore_scrap| (C)@>@; break;
3432
case expr: @<CASES for |expr| (R)@>@; @~ break;
3433
case key_wd: @<CASES for |key_wd| (R)@>@; @~ break;
3434
case exp_op: @<CASES for |exp_op| (R)@>@; @~ break;
3435
case _EXPR: @<CASES for |_EXPR| (C)@>@; @~ break;
3436
case _EXPR_: @<CASES for |_EXPR_| (C)@>@; @~ break;
3437
case EXPR_: @<CASES for |EXPR_| (C)@>@; @~ break;
3438
case lpar: @<CASES for |lpar| (R)@>@; @~ break;
3439
case lbracket: @<CASES for |lbracket| (C)@>@; @~ break;
3440
case rbracket: @<CASES for |rbracket| (C)@>@; @~ break;
3441
case unop: @<CASES for |unop| (R)@>@; @~ break;
3442
case UNOP: @<CASES for |UNOP| (C)@>@; @~ break;
3443
case unorbinop: @<CASES for |unorbinop| (R)@>@; @~ break;
3444
case binop: @<CASES for |binop| (R)@>@; @~ break;
3445
case BINOP: @<CASES for |BINOP| (C)@>@; @~ break;
3446
case slash_like: @<CASES for |slash_like| (R)@>@; @~ break;
3447
case colon: @<CASES for |colon| (R)@>@; @~ break;
3448
case program_like: @<CASES for |program_like| (R)@>@; @~ break;
3449
case struct_like: @<CASES for |struct_like| (R)@>@; @~ break;
3450
case struct_hd: @<CASES for |struct_hd| (R)@>@; @~ break;
3451
case op_like: @<CASES for |op_like| (R)@>@; @~ break;
3452
case proc_like: @<CASES for |proc_like| (R)@>@; @~ break;
3453
case private_like: @<CASES for |private_like| (R)@>@; @~ break;
3454
case int_like: @<CASES for |int_like| (R)@>@; @~ break;
3455
case decl_hd: @<CASES for |decl_hd| (R)@>@; @~ break;
3456
case decl: @<CASES for |decl| (R)@>@; @~ break;
3457
case fn_decl: @<CASES for |fn_decl| (C)@>@; @~ break;
3458
case fcn_hd: @<CASES for |fcn_hd| (R)@>@; @~ break;
3459
case functn: @<CASES for |functn| (R)@>@; @~ break;
3460
case lbrace: @<CASES for |lbrace| (R)@>@; @~ break;
3461
case do_like: @<CASES for |do_like| (R)@>@; @~ break;
3462
case until_like: @<CASES for |until_like| (R)@>@; @~ break;
3463
case Rdo_like: @<CASES for |Rdo_like| (R)@>@; @~ break;
3464
case if_like: @<CASES for |if_like| (R)@>@; @~ break;
3465
case IF_like: @<CASES for |IF_like| (C)@>@; @~ break; /* The C form serves
3466
both. */
3467
case IF_top: @<CASES for |IF_top| (C)@>@; @~ break;
3468
case endif_like: @<CASES for |endif_like| (R)@>@; @~ break;
3469
case end_like: @<CASES for |end_like| (R)@>@; @~ break;
3470
case END_like: @<CASES for |END_like| (R)@>@; @~ break;
3471
case go_like: @<CASES for |go_like| (R)@>@; @~ break;
3472
case for_like: @<CASES for |for_like| (C)@>@; @~ break;
3473
case for_hd: @<CASES for |for_hd| (C)@>@; @~ break; /* C serves both. */
3474
case else_like: @<CASES for |else_like| (R)@>@; @~ break;
3475
case else_hd: @<CASES for |else_hd| (C)@>@; @~ break;
3476
@#if(0)
3477
case ELSE_like: @<CASES for |ELSE_like| (C)@>@; @~ break; /* C serves
3478
both. */
3479
@#endif
3480
case if_hd: @<CASES for |if_hd| (R)@>@; @~ break;
3481
case CASE_like: @<CASES for |CASE_like| (R)@>@; @~ break;
3482
case case_like: @<CASES for |case_like| (R)@>@; @~ break;
3483
case stmt: @<CASES for |stmt| (R)@>@; @~ break;
3484
case tag: @<CASES for |tag| (R)@>@; @~ break;
3485
case label: @<CASES for |label| (R)@>@; @~ break;
3486
case semi: @<CASES for |semi| (R)@>@; @~ break;
3487
3488
case common_like: @<CASES for |common_like| (R)@>@; @~ break;
3489
case common_hd: @<CASES for |common_hd| (R)@>@; @~ break;
3490
case read_like: @<CASES for |read_like| (R)@>@; @~ break;
3491
case read_hd: @<CASES for |read_hd| (R)@>@; @~ break;
3492
case entry_like: @<CASES for |entry_like| (R)@>@; @~ break;
3493
case implicit_like: @<CASES for |implicit_like| (R)@>@; @~ break;
3494
case implicit_hd: @<CASES for |implicit_hd| (R)@>@; @~ break;
3495
case assign_like: @<CASES for |assign_like| (R)@>@; @~ break;
3496
case define_like: @<CASES for |define_like| (R)@>@; @~ break;
3497
case built_in: @<CASES for |built_in| (R)@>@; @~ break;
3498
case no_order: @<CASES for |no_order| (R)@>@; @~ break;
3499
case newline: @<CASES for |newline| (R)@>@; @~ break;
3500
case COMMA: @<CASES for |COMMA| (C)@>@; @~ break;
3501
3502
}
3503
}
3504
3505
@
3506
@<CASES for |expr| (R)@>=
3507
#if FCN_CALLS
3508
R_expr();
3509
#else
3510
@<Cases for |expr| (R)@>@;
3511
#endif
3512
3513
@
3514
@<Part 2@>=
3515
#if FCN_CALLS
3516
@[SRTN R_expr(VOID)
3517
{
3518
@<Cases for |expr| (R)@>@;
3519
}
3520
#endif
3521
3522
@
3523
@<Cases for |expr| (R)@>=
3524
{
3525
if (cat1==unop) SQUASH(pp,2,expr,-2,2);
3526
else if ((cat1==binop || cat1==unorbinop || cat1==colon) && cat2==expr)
3527
/* Here we have to worry about constructions such as `|@r #:0|'. */
3528
if(cat1==colon && (*pp->trans)[1]==(sixteen_bits)@'#')
3529
{
3530
b_app1(pp);
3531
APP_STR("\\Colon");
3532
b_app1(pp+2);
3533
REDUCE(pp,3,expr,-2,3333);
3534
}
3535
else if(cat1==binop && **(pp+1)->trans == (sixteen_bits)@'/')
3536
SQUASH(pp, 1, expr, PLUS 1, 3334);
3537
else
3538
SQUASH(pp,3,expr,-2,3); /* ``|@r x = y|'' or ``|@r x + y|'' or
3539
``|@r dimension a(0:100)|'' */
3540
else if (cat1==comma && (cat2==expr || cat2==end_like))
3541
{ /* Note |end_like|; keyword in I/O. */
3542
b_app2(pp);
3543
OPT9;
3544
b_app1(pp+2); REDUCE(pp,3,expr,-2,4);
3545
}
3546
else if (cat1==expr) SQUASH(pp,2,expr,-2,5); /* ``|@r f(x)|'' */
3547
else if (cat1==semi) SQUASH(pp,2,stmt,-2,6); /* ``|@r x=y;|'' */
3548
else if (cat1==colon && cat2==unorbinop &&
3549
(cat3==rpar || (active_brackets && cat3==rbracket)))
3550
SQUASH(pp,3,expr,-2,299); /* ``|@r 0:*|'' */
3551
else if (cat1==colon && cat2!= lpar) /* label */
3552
{
3553
make_underlined (pp); SQUASH(pp,2,tag,0,7);
3554
}
3555
else if (cat1==comma && cat2==int_like) /* For macro usage. */
3556
{
3557
b_app2(pp);
3558
OPT9;
3559
b_app1(pp+2); REDUCE(pp,3,int_like,-2,4444);
3560
}
3561
}
3562
3563
@ This route may be unused now.
3564
@<CASES for |key_wd| (R)@>=
3565
#if FCN_CALLS
3566
R_key_wd();
3567
#else
3568
@<Cases for |key_wd| (R)@>@;
3569
#endif
3570
3571
@
3572
@<Part 2@>=
3573
#if FCN_CALLS
3574
@[SRTN R_key_wd(VOID)
3575
{
3576
@<Cases for |key_wd| (R)@>@;
3577
}
3578
#endif
3579
3580
@
3581
@<Cases for |key_wd| (R)@>=
3582
{
3583
SQUASH(pp,1,expr,-2,4445);
3584
}
3585
3586
@ Exponentiation. We have to watch out for constructions like \.{x\^(a+b)},
3587
which must be typeset |@r x^(a+b)|, and also the construction
3588
\.{x\^y(z)}, which must be typeset |@r x^y(z)|.
3589
3590
@<CASES for |exp_op| (R)@>=
3591
#if FCN_CALLS
3592
R_exp_op();
3593
#else
3594
@<Cases for |exp_op| (R)@>@;
3595
#endif
3596
3597
@
3598
@<Part 2@>=
3599
#if FCN_CALLS
3600
@[SRTN R_exp_op(VOID)
3601
{
3602
@<Cases for |exp_op| (R)@>@;
3603
}
3604
#endif
3605
3606
@
3607
@<Cases for |exp_op| (R)@>=
3608
{
3609
if(cat1==lpar) SQUASH(pp,1,exp_op,PLUS 1,2995); /* ``|@r x^(a+b)|'' */
3610
else if(cat1==expr)
3611
if(cat2==lpar) SQUASH(pp,1,exp_op,PLUS 2,2996); /* Expand array
3612
argument. */
3613
else if(cat2==expr) SQUASH(pp,1,exp_op,PLUS 1,2997); /* The expr is
3614
the result of expanding the array argument. */
3615
else
3616
{ /* It's now of the form |@r x^expr|; insert braces around
3617
argument so \TeX\ understands. */
3618
b_app1(pp);
3619
b_app(@'{'); @~ b_app1(pp+1); @~ b_app(@'}');
3620
REDUCE(pp,2,expr,-1,2998);
3621
}
3622
}
3623
3624
@ Keep track of where we are in the nested hierarchy of \Fortran\ program
3625
units; for helping with |@r9 contains|.
3626
@<Glob...@>=
3627
3628
IN_PROD int fcn_level PSET(0);
3629
3630
@ When we recognize the beginning of a program unit, we increment a counter.
3631
@<CASES for |program_like| (R)@>=
3632
#if FCN_CALLS
3633
R_program_like();
3634
#else
3635
@<Cases for |program_like| (R)@>@;
3636
#endif
3637
3638
@
3639
@<Part 2@>=
3640
#if FCN_CALLS
3641
@[SRTN R_program_like(VOID)
3642
{
3643
@<Cases for |program_like| (R)@>@;
3644
}
3645
#endif
3646
3647
@
3648
@<Cases for |program_like| (R)@>=
3649
3650
if(is_FORTRAN_(language))
3651
{
3652
if(cat1==expr && cat2==semi)
3653
{
3654
fcn_level++;
3655
b_app1(pp); @~ b_app(@' ');
3656
b_app(indent); @~ b_app2(pp+1); @~ b_app(outdent);
3657
defined_at(make_underlined(pp+1));
3658
REDUCE(pp,3,fcn_hd,-1,2999);
3659
}
3660
else if(cat1==no_order)
3661
{ // |@r block data|
3662
PP_PP(1,1);
3663
REDUCE(pp,2,program_like,0,2997);
3664
}
3665
else if(cat1==semi)
3666
{ // |@r block data;|
3667
fcn_level++;
3668
b_app1(pp);
3669
REDUCE(pp,2,fcn_hd,-1,2996);
3670
}
3671
else if(cat1==proc_like)
3672
{ // |@n9 module procedure|
3673
PP_PP(1, 1);
3674
REDUCE(pp, 2, int_like, 0, 2887);
3675
}
3676
}
3677
else
3678
{
3679
fcn_level++;
3680
SQUASH(pp,1,int_like,-1,2998);
3681
}
3682
3683
@
3684
@<CASES for |fcn_hd| (R)@>=
3685
#if FCN_CALLS
3686
R_fcn_hd();
3687
#else
3688
@<Cases for |fcn_hd| (R)@>@;
3689
#endif
3690
3691
@
3692
@<Part 2@>=
3693
#if FCN_CALLS
3694
@[SRTN R_fcn_hd(VOID)
3695
{
3696
@<Cases for |fcn_hd| (R)@>@;
3697
}
3698
#endif
3699
3700
@
3701
@<Cases for |fcn_hd| (R)@>=
3702
{
3703
if(cat1==END_stmt)
3704
{
3705
b_app1(pp); @~ b_app(force);
3706
b_app1(pp+1);
3707
REDUCE(pp,2,functn,-1,7172);
3708
}
3709
else if(cat1==stmt && cat2==END_stmt)
3710
{
3711
b_app1(pp); @~ b_app(force);
3712
b_app(indent);
3713
b_app1(pp+1); /* Body */
3714
3715
if(fcn_level==0)
3716
{
3717
if(containing)
3718
b_app(big_force);
3719
3720
while(containing)
3721
{
3722
#if(0)
3723
b_app(outdent);
3724
#endif
3725
containing--;
3726
}
3727
}
3728
3729
b_app(outdent);
3730
b_app(force);
3731
3732
b_app1(pp+2);
3733
REDUCE(pp,3,functn,-1,7171);
3734
}
3735
}
3736
3737
@ The |@r9 module procedure| statement doesn't have an |end| statement.
3738
@<CASES for |proc_like| (R)@>=
3739
#if FCN_CALLS
3740
R_proc_like();
3741
#else
3742
@<Cases for |proc_like| (R)@>@;
3743
#endif
3744
3745
@
3746
@<Part 2@>=
3747
#if FCN_CALLS
3748
@[SRTN R_proc_like(VOID)
3749
{
3750
@<Cases for |proc_like| (R)@>@;
3751
}
3752
#endif
3753
3754
@
3755
@<Cases for |proc_like| (R)@>=
3756
3757
if(fcn_level == 0) {/* Error message */}
3758
else fcn_level--;
3759
3760
SQUASH(pp,1,int_like,-1,2989);
3761
3762
@ Here we handle Fortran--90's |@r9 private|, |@r9 public|, and |@r9
3763
sequence| statements.
3764
@<CASES for |private_like| (R)@>=
3765
#if FCN_CALLS
3766
R_private_like();
3767
#else
3768
@<Cases for |private_like| (R)@>@;
3769
#endif
3770
3771
@
3772
@<Part 2@>=
3773
#if FCN_CALLS
3774
@[SRTN R_private_like(VOID)
3775
{
3776
@<Cases for |private_like| (R)@>@;
3777
}
3778
#endif
3779
3780
@
3781
@<Cases for |private_like| (R)@>=
3782
{
3783
if(cat1 == (eight_bits)(language==FORTRAN_90 ? semi : colon) )
3784
{
3785
app(backup);
3786
b_app2(pp);
3787
REDUCE(pp,2,decl,-1,2988);
3788
}
3789
else SQUASH(pp,1,int_like,-2,2987);
3790
}
3791
3792
@
3793
@<CASES for |int_like| (R)@>=
3794
#if FCN_CALLS
3795
R_int_like();
3796
#else
3797
@<Cases for |int_like| (R)@>@;
3798
#endif
3799
3800
@
3801
@<Part 2@>=
3802
#if FCN_CALLS
3803
@[SRTN R_int_like(VOID)
3804
{
3805
@<Cases for |int_like| (R)@>@;
3806
}
3807
#endif
3808
3809
@
3810
@<Cases for |int_like| (R)@>=
3811
{
3812
if(cat1==lbrace)
3813
{
3814
b_app(indent);
3815
b_app1(pp);
3816
REDUCE(pp,1,decl_hd,0,940); /* ``|@r block data{}|'' */
3817
}
3818
else if(cat1==unorbinop && cat2==expr)
3819
{ /* ``|@r character*(*)|'' */
3820
b_app1(pp);
3821
b_app(@'{'); @~ b_app2(pp+1); @~ b_app(@'}');
3822
REDUCE(pp,3,int_like,-1,941);
3823
}
3824
else if (cat1==int_like || cat1==no_order) /* ``|@r double precision|'' or
3825
F88 things like ``|@r integer, pointer|''; |no_order| takes
3826
care of \&{data} in |@r block data|. */
3827
{
3828
PP_PP(1,1);
3829
REDUCE(pp,2,cat0,0,40);
3830
}
3831
else if(cat1==comma)
3832
SQUASH(pp,2,int_like,0,9001); /* F88: ``|@r logical,|'' */
3833
else if(cat1==binop)
3834
{ /* F88: ``|@r integer :: i|'' */
3835
b_app2(pp);
3836
b_app(indent);
3837
REDUCE(pp,2,decl_hd,0,9002);
3838
}
3839
else if(cat1==slashes)
3840
{
3841
b_app1(pp);
3842
b_app(@' ');
3843
b_app(indent);
3844
REDUCE(pp,1,decl_hd,0,9002);
3845
}
3846
else if(cat1==expr && **indirect((pp+1)->trans)==@'(')
3847
{
3848
b_app1(pp); @~ @<Append thinspace@>@; @~ b_app1(pp+1);
3849
REDUCE(pp,2,int_like,0,9003); /* ``|@r integer (KIND=4)|'' */
3850
}
3851
else if (cat1==expr || cat1==semi)
3852
{
3853
b_app1(pp);
3854
3855
if(cat1 != semi) app(@'~');
3856
3857
b_app(indent); /* Start long declaration. */
3858
3859
REDUCE(pp,1,decl_hd,0,41); /* JAK: -1 changed to 0 */
3860
}
3861
else if(cat1 == rbrace)
3862
SQUASH(pp, 1, decl, -1, 411);
3863
/* See \.{ratfor} example |@r9 module procedure element;|. */
3864
}
3865
3866
@
3867
@<CASES for |struct_like| (R)@>=
3868
#if FCN_CALLS
3869
R_struct_like();
3870
#else
3871
@<Cases for |struct_like| (R)@>@;
3872
#endif
3873
3874
@
3875
@<Part 2@>=
3876
#if FCN_CALLS
3877
@[SRTN R_struct_like(VOID)
3878
{
3879
@<Cases for |struct_like| (R)@>@;
3880
}
3881
#endif
3882
3883
@
3884
@<Cases for |struct_like| (R)@>=
3885
if(cat1==lpar)
3886
{
3887
b_app1(pp);
3888
#if(0)
3889
@<Append thinspace@>@; /* Looks nicer with a bit of space. */
3890
#endif
3891
REDUCE(pp,1,int_like,0,9075); /* \FORTRAN-88 declaration:
3892
``|@r9 type(triangle)|''. */
3893
}
3894
else if(cat1==comma && cat2==int_like)
3895
{ /* ``|@r9 type, private|'' */
3896
b_app2(pp); @~ b_app(@' '); @~ b_app1(pp+2);
3897
REDUCE(pp,3,struct_like,0,90750);
3898
}
3899
else if(cat1==binop && **(pp+1)->trans != (sixteen_bits)@'/')
3900
SQUASH(pp,2,struct_like,0,90751); /* ``|@r9 type, public::|'' The
3901
|!=| precluded the VAX |@n9 structure /stuff/| declaration. */
3902
else if(cat1==expr || cat1==slashes || cat1==struct_like)
3903
{ /* ``|@r9 type person|'', ``|@r9 type /vaxstruct/|'', or ``|@r9
3904
interface operator|'' */
3905
PP_PP(1,1);
3906
make_underlined(pp+1);
3907
REDUCE(pp,2,language==FORTRAN_90 ? struct_hd : struct_like,0,9076);
3908
}
3909
else if(cat1==semi)
3910
SQUASH(pp,1,struct_hd,0,9077); /* |@r9 interface| */
3911
else if (cat1==lbrace) /* ``|@r9 type person {integer i;};|'' */
3912
{
3913
b_app1(pp); @~ indent_force;
3914
b_app1(pp+1); REDUCE(pp,2,struct_hd,0,100);
3915
}
3916
3917
@
3918
@<CASES for |struct_hd| (R)@>=
3919
#if FCN_CALLS
3920
R_str_hd();
3921
#else
3922
@<Cases for |struct_hd| (R)@>@;
3923
#endif
3924
3925
@
3926
@<Part 2@>=
3927
#if FCN_CALLS
3928
@[SRTN R_str_hd(VOID)
3929
{
3930
@<Cases for |struct_hd| (R)@>@;
3931
}
3932
#endif
3933
3934
@
3935
@<Cases for |struct_hd| (R)@>=
3936
if(is_FORTRAN_(language))
3937
{
3938
if(cat1==expr)
3939
{
3940
b_app1(pp); @~ @<Append thinspace@>@; b_app1(pp+1); /* ``|@r9
3941
interface operator(.not.)|'' */
3942
REDUCE(pp,2,struct_hd,0,90760);
3943
}
3944
else if(cat1==semi)
3945
{
3946
fcn_level++;
3947
b_app2(pp);
3948
b_app(indent);
3949
REDUCE(pp,2,struct_hd,0,90770);
3950
}
3951
else if(cat1==decl || cat1==functn)
3952
{
3953
b_app1(pp);
3954
b_app(force);
3955
b_app1(pp+1);
3956
REDUCE(pp,2,struct_hd,0,9078);
3957
}
3958
else if(cat1==END_stmt)
3959
{
3960
b_app1(pp);
3961
b_app(outdent);
3962
b_app(force);
3963
b_app1(pp+1);
3964
REDUCE(pp,2,decl,-1,9079);
3965
}
3966
}
3967
else @<Cases for |struct_hd| (C)@>@;
3968
3969
@
3970
@<CASES for |op_like| (R)@>=
3971
#if FCN_CALLS
3972
R_op_like();
3973
#else
3974
@<Cases for |op_like| (R)@>@;
3975
#endif
3976
3977
@
3978
@<Part 2@>=
3979
#if FCN_CALLS
3980
@[SRTN R_op_like(VOID)
3981
{
3982
@<Cases for |op_like| (R)@>@;
3983
}
3984
#endif
3985
3986
@
3987
@<Cases for |op_like| (R)@>=
3988
@B
3989
short n;
3990
3991
if(cat1==lpar)
3992
{ /* We'll search for the obligatory right paren that terminates
3993
the list. */
3994
scrap_pointer q;
3995
int k; /* Counter. */
3996
3997
/* If the paren is missing, we could end up appending the entire rest of
3998
the code, so we limit the search. */
3999
for(q=pp+2; q <= scrp_ptr && q-pp < MAX_OP_TOKENS; q++)
4000
if(q->cat == rpar) break;
4001
4002
n = (q->cat == rpar) ? PTR_DIFF(short, q, pp) : 0;
4003
4004
if(n > 0)
4005
{
4006
b_app1(pp); @~ b_app(@' '); /* |@r9 operator| */
4007
b_app1(pp+1); /* Left paren. */
4008
b_app(@'{');
4009
APP_STR("\\optrue");
4010
4011
for(k=2; k<n; k++)
4012
b_app1(pp+k);
4013
4014
APP_STR("\\opfalse"); /* We need this here in case we
4015
encounter an operator that \FWEAVE\ doesn't know how to overload. */
4016
b_app(@'}');
4017
b_app1(pp+k);
4018
4019
REDUCE(pp,n+1,expr,-2,6667);
4020
}
4021
}
4022
}
4023
4024
@
4025
@<CASES for |decl_hd| (R)@>=
4026
#if FCN_CALLS
4027
R_dcl_hd();
4028
#else
4029
@<Cases for |decl_hd| (R)@>@;
4030
#endif
4031
4032
@
4033
@<Part 2@>=
4034
#if FCN_CALLS
4035
@[SRTN R_dcl_hd(VOID)
4036
{
4037
@<Cases for |decl_hd| (R)@>@;
4038
}
4039
#endif
4040
4041
@
4042
@<Cases for |decl_hd| (R)@>=
4043
if (cat1==comma)
4044
{ /* ``|@r integer i,j|'' */
4045
b_app2(pp); b_app(@' '); REDUCE(pp,2,decl_hd,0,54);
4046
}
4047
else if (cat1==expr)
4048
{
4049
make_underlined(pp+1);
4050
4051
if(**(pp+2)->trans == (sixteen_bits)@'=')
4052
{ // Initialization coming up.
4053
SQUASH(pp,1,decl_hd,PLUS 1,55);
4054
}
4055
else
4056
{
4057
SQUASH(pp,2,decl_hd,0,56);
4058
}
4059
}
4060
else if(cat1==slashes)
4061
{ /* |@r integer i/1/| */
4062
SQUASH(pp,2,decl_hd,0,57);
4063
}
4064
@#if 0
4065
else if(cat1==binop && cat2==expr && (cat3==comma || cat3==semi))
4066
{
4067
PP_PP(1,2);
4068
REDUCE(pp,3,decl_hd,-1,5660); /* Initialization */
4069
}
4070
@#endif
4071
else if (cat1==lbrace || cat1==int_like || cat1==implicit_like)
4072
/* |@r subroutine f {}| or |@r function f(x) real x;| or |@r
4073
program main implicit none;| */
4074
{
4075
b_app1(pp);
4076
b_app(outdent); /* Turn off |indent|. */
4077
defined_at(FIRST_ID(pp));
4078
REDUCE(pp,1,fn_decl,0,58);
4079
}
4080
else if (cat1==semi && (!auto_semi || (auto_semi && cat2 != lbrace)))
4081
{
4082
b_app2(pp);
4083
b_app(outdent); /* Finish long declaration. */
4084
REDUCE(pp,2,
4085
(eight_bits)(intermingle ? (intermingle=NO,ignore_scrap) : decl),
4086
-1,59);
4087
}
4088
else if(cat1==built_in)
4089
{ /* |@r9 use a, only| */
4090
PP_PP(1,1);
4091
REDUCE(pp,2,decl_hd,0,5901);
4092
}
4093
#if(0)
4094
else if(cat1==lpar && cat2==expr) make_underlined(pp+2); /* For
4095
|$decl_hd|. */
4096
#endif
4097
4098
@
4099
@<CASES for |decl| (R)@>=
4100
#if FCN_CALLS
4101
R_decl();
4102
#else
4103
@<Cases for |decl| (R)@>@;
4104
#endif
4105
4106
@
4107
@<Part 2@>=
4108
#if FCN_CALLS
4109
@[SRTN R_decl(VOID)
4110
{
4111
@<Cases for |decl| (R)@>@;
4112
}
4113
#endif
4114
4115
@
4116
@<Cases for |decl| (R)@>=
4117
if(is_FORTRAN_(language) && cat1==END_like) SQUASH(pp,1,stmt,-1,960);
4118
/* `` |@r program main; end;|'' */
4119
else if (cat1==decl)
4120
{
4121
b_app1(pp); @~ b_app(force);
4122
b_app1(pp+1);
4123
REDUCE(pp,2,decl,-1,60);
4124
}
4125
else if (cat1==stmt || cat1==functn)
4126
{
4127
b_app1(pp); @~ b_app(big_force);
4128
b_app1(pp+1); REDUCE(pp,2,cat1,-1,61);
4129
}
4130
4131
@ |@r subroutine f1{} subroutine f2{}|.
4132
@<CASES for |functn| (R)@>=
4133
#if FCN_CALLS
4134
R_functn();
4135
#else
4136
@<Cases for |functn| (R)@>@;
4137
#endif
4138
4139
@
4140
@<Part 2@>=
4141
#if FCN_CALLS
4142
@[SRTN R_functn(VOID)
4143
{
4144
@<Cases for |functn| (R)@>@;
4145
}
4146
#endif
4147
4148
@
4149
@<Cases for |functn| (R)@>=
4150
4151
if (cat1==functn || (is_RATFOR_(language) && (cat1==decl || cat1==stmt)))
4152
{
4153
b_app1(pp); @~ b_app(big_force);
4154
b_app1(pp+1); REDUCE(pp,2,cat1,0,80);
4155
}
4156
else if(free_Fortran && cat1==semi)
4157
{ /* Handle possible auto-inserted pseudo-semi after function. */
4158
b_app2(pp);
4159
REDUCE(pp, 2, functn, 0, 8088);
4160
}
4161
#if(0)
4162
else if(cat1==END_like)
4163
{
4164
b_app1(pp);
4165
REDUCE(pp,1,stmt,-1,9050);
4166
}
4167
#endif
4168
4169
@
4170
@<CASES for |lpar| (R)@>=
4171
#if FCN_CALLS
4172
R_lpar();
4173
#else
4174
@<Cases for |lpar| (R)@>@;
4175
#endif
4176
4177
@
4178
@<Part 2@>=
4179
#if FCN_CALLS
4180
@[SRTN R_lpar(VOID)
4181
{
4182
@<Cases for |lpar| (R)@>@;
4183
}
4184
#endif
4185
4186
@
4187
@<Cases for |lpar| (R)@>=
4188
4189
if (cat1==expr && cat2==rpar)
4190
SQUASH(pp,3,expr,-2,120); /* ``|@r (x)|'' */
4191
else if(cat1==expr && cat2==colon && cat3==rpar) /* ``|@r (lower:)|'' */
4192
{
4193
b_app3(pp); @~ @<Append thinspace@>; @~ b_app1(pp+3);
4194
REDUCE(pp,4,expr,-2,9120);
4195
}
4196
else if(cat1==colon && cat2 != comma) /* ``|@r (:x)|''; watch out for
4197
deferred-shape-spec-lists. */
4198
{
4199
b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
4200
REDUCE(pp,2,lpar,0,9121);
4201
}
4202
else if (cat1==rpar) /* ``|@r ()|'' */
4203
{
4204
b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
4205
REDUCE(pp,2,expr,-2,121);
4206
}
4207
else if (cat1==stmt) /* `` |@r for(x;y;z)|'' */
4208
{
4209
b_app2(pp); b_app(@' '); REDUCE(pp,2,lpar,0,123);
4210
}
4211
4212
@
4213
@<CASES for |colon| (R)@>=
4214
#if FCN_CALLS
4215
R_colon();
4216
#else
4217
@<Cases for |colon| (R)@>@;
4218
#endif
4219
4220
@
4221
@<Part 2@>=
4222
#if FCN_CALLS
4223
@[SRTN R_colon(VOID)
4224
{
4225
@<Cases for |colon| (R)@>@;
4226
}
4227
#endif
4228
4229
@
4230
@<Cases for |colon| (R)@>=
4231
4232
if(cat1==expr || cat1==unorbinop)
4233
SQUASH(pp,2,expr,-2,9500); /* ``|@r (:upper)|'' */
4234
else if(cat1==comma && cat2==colon)
4235
SQUASH(pp,3,colon,-2,9502);
4236
/* Deferred-shape-spec-list: |@n9 (:,:,:)|.
4237
|colon| used to be |expr| */
4238
else
4239
SQUASH(pp,1,expr,0,9501); /* |@r (:)| */
4240
4241
@
4242
@<CASES for |lbrace| (R)@>=
4243
#if FCN_CALLS
4244
R_lbrace();
4245
#else
4246
@<Cases for |lbrace| (R)@>@;
4247
#endif
4248
4249
@
4250
@<Part 2@>=
4251
#if FCN_CALLS
4252
@[SRTN R_lbrace(VOID)
4253
{
4254
@<Cases for |lbrace| (R)@>@;
4255
}
4256
#endif
4257
4258
@
4259
@<Cases for |lbrace| (R)@>=
4260
if (cat1==rbrace) /* ``|@r {}|'' */
4261
{
4262
b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
4263
REDUCE(pp,2,stmt,-2,130);
4264
}
4265
else if ((cat1==stmt || cat1==decl) && cat2==rbrace) /* ``|@r {x;}|'' */
4266
{
4267
b_app(force);
4268
b_app1(pp); @~ b_app(force);
4269
b_app1(pp+1); @~ b_app(force);
4270
b_app1(pp+2);
4271
REDUCE(pp,3,stmt,-2,131);
4272
}
4273
4274
@
4275
@<CASES for |unop| (R)@>=
4276
#if FCN_CALLS
4277
R_unop();
4278
#else
4279
@<Cases for |unop| (R)@>@;
4280
#endif
4281
4282
@
4283
@<Part 2@>=
4284
#if FCN_CALLS
4285
@[SRTN R_unop(VOID)
4286
{
4287
@<Cases for |unop| (R)@>@;
4288
}
4289
#endif
4290
4291
@
4292
@<Cases for |unop| (R)@>=
4293
4294
if (cat1==expr) SQUASH(pp,2,expr,-2,33); /* ``|@r !flag|'' */
4295
4296
@
4297
@<CASES for |unorbinop| (R)@>=
4298
#if FCN_CALLS
4299
R_unorbinop();
4300
#else
4301
@<Cases for |unorbinop| (R)@>@;
4302
#endif
4303
4304
@
4305
@<Part 2@>=
4306
#if FCN_CALLS
4307
@[SRTN R_unorbinop(VOID)
4308
{
4309
@<Cases for |unorbinop| (R)@>@;
4310
}
4311
#endif
4312
4313
@
4314
@<Cases for |unorbinop| (R)@>=
4315
4316
if (cat1==expr) /* ``|@r +1.0|'' */
4317
{
4318
b_app(@'{'); @~ b_app1(pp); @~ b_app(@'}');
4319
b_app1(pp+1);
4320
REDUCE(pp,2,expr,-2,140);
4321
}
4322
else if(cat1==binop)
4323
@<Reduce cases like |*=|@>@;
4324
else if (cat1== comma || cat1==rpar)
4325
SQUASH(pp,1,expr,-2,141); /* ``|@r *,|'' or ``|@r *)|'' */
4326
4327
@
4328
@<Append thinspace@>=
4329
{
4330
b_app(@'\\'); @~ b_app(@',');
4331
}
4332
4333
@
4334
@<Append thickspace@>=
4335
{
4336
b_app(@'\\'); @~ b_app(@';');
4337
}
4338
4339
@
4340
@<CASES for |slash_like| (R)@>=
4341
#if FCN_CALLS
4342
R_slash_like();
4343
#else
4344
@<Cases for |slash_like| (R)@>@;
4345
#endif
4346
4347
@
4348
@<Part 2@>=
4349
#if FCN_CALLS
4350
@[SRTN R_slash_like(VOID)
4351
{
4352
@<Cases for |slash_like| (R)@>@;
4353
}
4354
#endif
4355
4356
@
4357
@<Cases for |slash_like| (R)@>=
4358
if(cat1==slash_like)
4359
{ // The slash already has braces around it (appended by \FWEAVE).ac
4360
b_app1(pp);
4361
@<Append thinspace@>;
4362
b_app1(pp+1);
4363
REDUCE(pp,2,slashes,-1,1801);
4364
}
4365
else if(cat1==expr && cat2==slash_like)
4366
SQUASH(pp,3,slashes,-1,1802);
4367
4368
@
4369
@<CASES for |binop| (R)@>=
4370
#if FCN_CALLS
4371
R_binop();
4372
#else
4373
@<Cases for |binop| (R)@>@;
4374
#endif
4375
4376
@
4377
@<Part 2@>=
4378
#if FCN_CALLS
4379
@[SRTN R_binop(VOID)
4380
{
4381
@<Cases for |binop| (R)@>@;
4382
}
4383
#endif
4384
4385
@
4386
@<Cases for |binop| (R)@>=
4387
{
4388
sixteen_bits tok = **pp->trans;
4389
4390
if(cat1==binop)
4391
{ /* ``|@r / /|'' */
4392
if(tok == (sixteen_bits)@'/')
4393
{
4394
if(**(pp+1)->trans == tok)
4395
@<Append empty slashes@>@;
4396
else
4397
{
4398
APP_STR("\\WSl");
4399
REDUCE(pp, 1, binop, -1, 1803);
4400
}
4401
}
4402
else
4403
@<Reduce cases like |+=|@>@;
4404
}
4405
else
4406
{
4407
if(tok == (sixteen_bits)@'/')
4408
{
4409
if(cat1==expr && cat2==binop && **(pp+2)->trans == tok)
4410
@<Append full slashes@>@; // |@n common/dia/|
4411
else
4412
{
4413
APP_STR("\\WSl");
4414
REDUCE(pp, 1, binop, -1, 1804);
4415
}
4416
}
4417
}
4418
}
4419
4420
@
4421
@<Append empty slashes@>=
4422
{
4423
b_app(@'{');
4424
b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
4425
b_app(@'}');
4426
REDUCE(pp,2,slashes,-1,180);
4427
}
4428
4429
@
4430
@<Append full slashes@>=
4431
{
4432
#if 0
4433
b_app(@'{');
4434
b_app1(pp); /* |'/'| */
4435
b_app(@'}');
4436
#endif
4437
4438
make_underlined(pp+1); /* Index common block name. */
4439
APP_STR("\\WCMN");
4440
b_app1(pp+1); /* expr/common-block name */
4441
4442
#if 0
4443
b_app(@'{');
4444
b_app1(pp+2); /* |'/'| */
4445
b_app(@'}');
4446
#endif
4447
4448
REDUCE(pp,3,slashes,-1,9181);
4449
}
4450
4451
@
4452
@<Glob...@>=
4453
4454
IN_PROD text_pointer label_text_ptr[50];
4455
4456
@ Follow translations until one gets down to the actual tokens.
4457
4458
@<Part 2@>=@[
4459
4460
text_pointer
4461
indirect FCN((t))
4462
text_pointer t C1("")@;
4463
{
4464
Token tok_value;
4465
4466
if(t==NULL) return t;
4467
4468
tok_value = **t;
4469
4470
if(tok_value <= tok_flag) return t;
4471
4472
if(tok_value > inner_tok_flag) tok_value -= (inner_tok_flag - tok_flag);
4473
4474
if(tok_value > tok_flag)
4475
do
4476
{
4477
Token tok_value0 = tok_value;
4478
4479
t = tok_start + (int)(tok_value - tok_flag);
4480
tok_value = **t;
4481
4482
if(tok_value == tok_value0) return t; /* Emergency return;
4483
otherwise infinite loop. */
4484
}
4485
while(tok_value > tok_flag);
4486
4487
return t;
4488
}
4489
4490
@ The following compares the texts of two translations, and is needed for
4491
labeled loops in Fortran.
4492
@<Part 2@>=@[
4493
boolean
4494
compare_text FCN((t0,t1))
4495
text_pointer t0 C0("")@;
4496
text_pointer t1 C1("")@;
4497
{
4498
token_pointer p0,p0_end,p1;
4499
4500
if(t0==NULL || t1==NULL) return NO;
4501
4502
t0 = indirect(t0); t1 = indirect(t1);
4503
4504
p0 = *t0; @~ p0_end = *(t0+1);
4505
p1 = *t1;
4506
4507
while(p0 < p0_end)
4508
{
4509
if(*p0 == @':') return YES; /* Ends label */
4510
if(*p0++ != *p1++) return NO;
4511
}
4512
4513
return YES;
4514
}
4515
4516
@ Return the value of a token that may be buried deep in indirection chains.
4517
@<Part 2@>=@[
4518
sixteen_bits
4519
tok_val FCN((p))
4520
scrap_pointer p C1("")@;
4521
{
4522
sixteen_bits tok_value;
4523
4524
tok_value = **(p->trans);
4525
4526
if(tok_value > inner_tok_flag)
4527
tok_value -= (inner_tok_flag- tok_flag);
4528
4529
if(tok_value > tok_flag)
4530
do
4531
{
4532
tok_value = **(tok_start + (int)(tok_value - tok_flag));
4533
}
4534
while(tok_value > tok_flag);
4535
4536
return tok_value;
4537
}
4538
4539
@
4540
@<CASES for |Rdo_like| (R)@>=
4541
#if FCN_CALLS
4542
R_Rdo_like();
4543
#else
4544
@<Cases for |Rdo_like| (R)@>@;
4545
#endif
4546
4547
@
4548
@<Part 2@>=
4549
#if FCN_CALLS
4550
@[SRTN R_Rdo_like(VOID)
4551
{
4552
@<Cases for |Rdo_like| (R)@>@;
4553
}
4554
#endif
4555
4556
@
4557
@<Cases for |Rdo_like| (R)@>=
4558
4559
if(is_FORTRAN_(language))
4560
{
4561
if(cat1==for_like) /* \&{do} \&{while} */
4562
{
4563
PP_PP(1,1);
4564
REDUCE(pp,2,Rdo_like,0,9600);
4565
}
4566
else if(cat1==expr && ( (cat2==expr && cat3==binop) || cat2==if_like) )
4567
{ /* ``|@r do 10 i=@e|'' */
4568
label_text_ptr[indent_level] = (pp+1)->trans; /* Pointer to
4569
a |token_pointer|---namely, index into |tok_start|. */
4570
b_app1(pp); // |@n do|
4571
b_app(@' ');
4572
b_app1(pp+1); // Loop number.
4573
REDUCE(pp,2,Rdo_like,0,9601); /* Swallow only the loop number. */
4574
}
4575
else if(cat1==stmt) /* ``|@r do i=1,10;|'' */
4576
{
4577
loop_num[indent_level++] = ++max_loop_num;
4578
4579
b_app1(pp); /* \&{do} */
4580
b_app(@' ');
4581
b_app1(pp+1); /* $i=1,10;$ */
4582
app_loop_num(max_loop_num);
4583
4584
b_app(indent);
4585
REDUCE(pp,2,stmt,-2,9602);
4586
}
4587
}
4588
/* \Ratfor. */
4589
else if(cat1==stmt || (cat1==expr && cat2==lbrace)) /* ``|@r do i=1,10;|''
4590
or ``|@r do i=1,10{|'' */
4591
{
4592
PP_PP(1,1);
4593
REDUCE(pp,2,for_hd,0,9603);
4594
}
4595
4596
@ The following flag handles the option |@r until| in a ``|@r
4597
repeat{}until|'' construction.
4598
4599
@<Glob...@>=
4600
4601
IN_PROD boolean found_until PSET(NO);
4602
4603
@ We have to be slightly tricky here, because in ``|@r repeat{}until|'' the
4604
\&{until} is optional.
4605
@<CASES for |do_like| (R)@>=
4606
#if FCN_CALLS
4607
R_do_like();
4608
#else
4609
@<Cases for |do_like| (R)@>@;
4610
#endif
4611
4612
@
4613
@<Part 2@>=
4614
#if FCN_CALLS
4615
@[SRTN R_do_like(VOID)
4616
{
4617
@<Cases for |do_like| (R)@>@;
4618
}
4619
#endif
4620
4621
@
4622
@<Cases for |do_like| (R)@>=
4623
4624
if(cat1==stmt)
4625
{
4626
if(cat2==until_like)
4627
{
4628
found_until = YES;
4629
SQUASH(pp,1,do_like,PLUS 2,9190); /* ``|@r repeat
4630
{} until @e@;|''; expand the \&{until}. */
4631
}
4632
else
4633
{
4634
b_app1(pp);
4635
indent_force;
4636
b_app1(pp+1);
4637
b_app(outdent);
4638
b_app(force);
4639
4640
if(found_until && cat2==stmt) /* Get here by expanding the
4641
\&{until}. */
4642
{
4643
found_until = NO;
4644
b_app1(pp+2); REDUCE(pp,3,stmt,-2,9191);
4645
}
4646
else REDUCE(pp,2,stmt,-2,9192); /* ``|@r repeat {}|'';
4647
no bottom. */
4648
}
4649
}
4650
4651
@ Get here from above by expanding the |@r until|.
4652
@<CASES for |until_like| (R)@>=
4653
#if FCN_CALLS
4654
R_until_like();
4655
#else
4656
@<Cases for |until_like| (R)@>@;
4657
#endif
4658
4659
@
4660
@<Part 2@>=
4661
#if FCN_CALLS
4662
@[SRTN R_until_like(VOID)
4663
{
4664
@<Cases for |until_like| (R)@>@;
4665
}
4666
#endif
4667
4668
@
4669
@<Cases for |until_like| (R)@>=
4670
4671
SQUASH(pp,1,for_like,0,9195);
4672
4673
@
4674
@<Glob...@>=
4675
4676
IN_PROD int indent_level PSET(0); // Indent level.
4677
IN_PROD int loop_num[50], max_loop_num PSET(0);
4678
4679
@
4680
@<CASES for |if_like| (R)@>=
4681
#if FCN_CALLS
4682
R_if_like();
4683
#else
4684
@<Cases for |if_like| (R)@>@;
4685
#endif
4686
4687
@
4688
@<Part 2@>=
4689
#if FCN_CALLS
4690
@[SRTN R_if_like(VOID)
4691
{
4692
@<Cases for |if_like| (R)@>@;
4693
}
4694
#endif
4695
4696
@
4697
@<Cases for |if_like| (R)@>=
4698
4699
if(cat1==CASE_like)
4700
{
4701
PP_PP(1,1); /* |@r9 select case| */
4702
REDUCE(pp,2,if_like,0,9196);
4703
}
4704
else
4705
if(is_FORTRAN_(language))
4706
{
4707
if(cat1==expr)
4708
{
4709
boolean if_form;
4710
4711
if( (if_form=BOOLEAN(cat2==built_in && cat3==semi)) || cat2==semi)
4712
{ /* ``|@n if(x) then;|'' or ``|@n where(x); |'' */
4713
short n; /* Number to append. Things are annoying because the |@n if|
4714
and |@n where| statements aren't completely symmetrical. */
4715
4716
loop_num[indent_level++] = ++max_loop_num;
4717
4718
b_app1(pp); /* \&{if} */
4719
@<Append thinspace@>;
4720
b_app1(pp+1); /* $(x)$ */
4721
b_app(@' ');
4722
4723
if(if_form)
4724
{
4725
n = 4;
4726
b_app2(pp+2); /* \&{then}; */
4727
}
4728
else
4729
{ /* |@n where| */
4730
n = 3;
4731
b_app1(pp+2); /* semi */
4732
}
4733
4734
app_loop_num(max_loop_num);
4735
b_app(indent);
4736
REDUCE(pp,n,stmt,-2,9800);
4737
}
4738
else if(cat2==stmt) /* ``|@n if(x) a=b;|'' */
4739
{
4740
b_app1(pp); /* \&{if} */
4741
@<Append thinspace@>;
4742
b_app1(pp+1); /* $(x)$ */
4743
app(@' ');
4744
b_app(cancel);
4745
b_app1(pp+2); /* Statement */
4746
REDUCE(pp,3,stmt,-2,9801);
4747
}
4748
else
4749
{
4750
b_app1(pp);
4751
@<Append thinspace@>;
4752
b_app1(pp+1);
4753
REDUCE(pp,2,if_hd,0,9802);
4754
}
4755
}
4756
}
4757
/* RATFOR\ */
4758
else @<Cases for |if_like| (C)@>@;
4759
4760
4761
@ Attach a comment with the loop number.
4762
4763
@<Part 2@>=@[
4764
4765
SRTN
4766
app_loop_num FCN((n))
4767
int n C1("Loop number.")@;
4768
{
4769
char loop_id[100];
4770
4771
if(!block_nums) return; // We're not supposed to number the blocks/loops.
4772
4773
sprintf(loop_id,"\\Wblock{%d}",n); /* Output the block number. */
4774
@.\\Wc@>
4775
APP_STR(loop_id);
4776
}
4777
4778
@ For the |@r go| keyword, we just have to handle optional white space.
4779
@<CASES for |go_like| (R)@>=
4780
#if FCN_CALLS
4781
R_go_like();
4782
#else
4783
@<Cases for |go_like| (R)@>@;
4784
#endif
4785
4786
@
4787
@<Part 2@>=
4788
#if FCN_CALLS
4789
@[SRTN R_go_like(VOID)
4790
{
4791
@<Cases for |go_like| (R)@>@;
4792
}
4793
#endif
4794
4795
@
4796
@<Cases for |go_like| (R)@>=
4797
4798
if(cat1==built_in) /* ``|@r go to|'' */
4799
{
4800
b_app1(pp); /* \&{go} */
4801
b_app(@' ');
4802
b_app1(pp+1); /* \&{to} */
4803
REDUCE(pp,2,case_like,0,9850); /* \&{goto} */
4804
}
4805
else SQUASH(pp,1,expr,-2,9851);
4806
4807
@ The keyword |@r end| has two possible meanings: end a loop, or end a
4808
function.
4809
@<CASES for |end_like| (R)@>=
4810
#if FCN_CALLS
4811
R_end_like();
4812
#else
4813
@<Cases for |end_like| (R)@>@;
4814
#endif
4815
4816
@
4817
@<Part 2@>=
4818
#if FCN_CALLS
4819
@[SRTN R_end_like(VOID)
4820
{
4821
@<Cases for |end_like| (R)@>@;
4822
}
4823
#endif
4824
4825
@
4826
@<Cases for |end_like| (R)@>=
4827
if(cat1==Rdo_like || cat1==if_like) /* ``|@r end do|'' or ``|@r end if|'' */
4828
{
4829
b_app1(pp); /* \&{end} */
4830
b_app(@' ');
4831
b_app1(pp+1); /* \&{do} or \&{if} */
4832
REDUCE(pp,2,endif_like,0,9860); /* Now turned into \&{enddo} or
4833
\&{endif} */
4834
}
4835
else
4836
{
4837
fcn_level--;
4838
SQUASH(pp,1,END_like,-1,9861); /* \&{end} of function. */
4839
}
4840
4841
@ \Fortran-90??
4842
4843
@<CASES for |END_like| (R)@>=
4844
#if FCN_CALLS
4845
R_END();
4846
#else
4847
@<Cases for |END_like| (R)@>@;
4848
#endif
4849
4850
@
4851
@<Part 2@>=
4852
#if FCN_CALLS
4853
@[SRTN R_END(VOID)
4854
{
4855
@<Cases for |END_like| (R)@>@;
4856
}
4857
#endif
4858
4859
@
4860
@<Cases for |END_like| (R)@>=
4861
{
4862
if(cat1==program_like || cat1==struct_like)
4863
{
4864
PP_PP(1,1);
4865
4866
if(cat2==expr)
4867
{
4868
b_app(@' '); @~ b_app1(pp+2);
4869
REDUCE(pp,3,END_like,0,9860);
4870
}
4871
else
4872
REDUCE(pp,2,END_like,0,9861);
4873
}
4874
else if(cat1==semi)
4875
SQUASH(pp,2,END_stmt,-2,9862);
4876
}
4877
4878
@ Handle end of loop. Note that in \Fortran-90, the \It{if-construct-name}
4879
is optional.
4880
4881
@<CASES for |endif_like| (R)@>=
4882
#if FCN_CALLS
4883
R_endif_like();
4884
#else
4885
@<Cases for |endif_like| (R)@>@;
4886
#endif
4887
4888
@
4889
@<Part 2@>=
4890
#if FCN_CALLS
4891
@[SRTN R_endif_like(VOID)
4892
{
4893
@<Cases for |endif_like| (R)@>@;
4894
}
4895
#endif
4896
4897
@
4898
@<Cases for |endif_like| (R)@>=
4899
{
4900
short n;
4901
boolean no_construct_name;
4902
4903
if((no_construct_name=BOOLEAN(cat1==semi)) || (cat1==expr && cat2==semi) )
4904
{
4905
b_app(outdent);
4906
b_app(force);
4907
4908
if(no_construct_name)
4909
{
4910
n = 2;
4911
b_app2(pp); /* \&{endif}; or \&{enddo}; */
4912
}
4913
else
4914
{ /* Include \It{if-construct-name} */
4915
n = 3;
4916
PP_PP(1,2);
4917
}
4918
4919
if(--indent_level < 0)
4920
indent_level = 0;
4921
4922
app_loop_num(loop_num[indent_level]);
4923
REDUCE(pp,n,stmt,-2,9880);
4924
}
4925
}
4926
4927
@
4928
@<CASES for |if_hd| (R)@>=
4929
#if FCN_CALLS
4930
R_if_hd();
4931
#else
4932
@<Cases for |if_hd| (R)@>@;
4933
#endif
4934
4935
@
4936
@<Part 2@>=
4937
#if FCN_CALLS
4938
@[SRTN R_if_hd(VOID)
4939
{
4940
@<Cases for |if_hd| (R)@>@;
4941
}
4942
#endif
4943
4944
@
4945
@<Cases for |if_hd| (R)@>=
4946
4947
if(is_FORTRAN_(language))
4948
{
4949
if (cat1==stmt)
4950
{
4951
#if 0
4952
b_app1(pp); @~ b_app(break_space); @~ b_app1(pp+1);
4953
#endif
4954
b_app1(pp);
4955
indent_force;
4956
b_app1(pp+1);
4957
b_app(outdent);
4958
REDUCE(pp,2,stmt,-2,9900);
4959
}
4960
}
4961
else
4962
@<Cases for |if_hd| (C)@>@;
4963
4964
@
4965
@<CASES for |else_like| (R)@>=
4966
#if FCN_CALLS
4967
R_else_like();
4968
#else
4969
@<Cases for |else_like| (R)@>@;
4970
#endif
4971
4972
@
4973
@<Part 2@>=
4974
#if FCN_CALLS
4975
@[SRTN R_else_like(VOID)
4976
{
4977
@<Cases for |else_like| (R)@>@;
4978
}
4979
#endif
4980
4981
@
4982
@<Cases for |else_like| (R)@>=
4983
4984
if(is_FORTRAN_(language))
4985
{
4986
if(cat1==if_like) /* ``|@n else if|'' */
4987
{
4988
b_app1(pp); /* \&{else} */
4989
b_app(@' ');
4990
b_app1(pp+1); /* \&{if} */
4991
REDUCE(pp,2,else_like,0,9910); /* \&{elseif} */
4992
}
4993
else if(cat1==semi) /* \&{else}; */
4994
{
4995
b_app(outdent);
4996
b_app(force);
4997
b_app2(pp); /* \&{else} or \&{elseif} */
4998
app_loop_num(loop_num[indent_level-1]);
4999
b_app(indent);
5000
REDUCE(pp,2,stmt,-2,9911);
5001
}
5002
else if(cat1==expr && cat2==built_in && cat3==semi) /* ``|@n else if(x)
5003
then;|'' */
5004
{
5005
b_app(outdent);
5006
b_app(force);
5007
5008
b_app1(pp); /* \&{elseif} */
5009
@<Append thinspace@>;
5010
b_app1(pp+1); /* $(x)$ */
5011
b_app(@' ');
5012
b_app2(pp+2); /* \&{then}; */
5013
app_loop_num(loop_num[indent_level-1]);
5014
5015
b_app(indent);
5016
REDUCE(pp,4,stmt,-2,9912);
5017
}
5018
}
5019
/* \Ratfor\ */
5020
else @<Cases for |else_like| (C)@>@;
5021
5022
@
5023
@<CASES for |stmt| (R)@>=
5024
#if FCN_CALLS
5025
R_stmt();
5026
#else
5027
@<Cases for |stmt| (R)@>@;
5028
#endif
5029
5030
@
5031
@<Part 2@>=
5032
#if FCN_CALLS
5033
@[SRTN R_stmt(VOID)
5034
{
5035
@<Cases for |stmt| (R)@>@;
5036
}
5037
#endif
5038
5039
@
5040
@<Cases for |stmt| (R)@>=
5041
5042
@#if 0
5043
if(is_FORTRAN_(language) && cat1==program_like)
5044
SQUASH(pp, 1, functn, PLUS 1, 9960);
5045
else
5046
if(is_FORTRAN_(language) && (cat1==END_like && cat2==semi) ) /* Finally
5047
recognized a function. */
5048
SQUASH(pp,1,stmt,-1,99661);
5049
{
5050
#if(0)
5051
b_app(indent); /* The function body will be indented. */
5052
b_app(backup); /* But not the first line of function. */
5053
#endif
5054
b_app1(pp); /* The body. */
5055
5056
if(fcn_level==0)
5057
{
5058
if(containing) b_app(big_force);
5059
while(containing)
5060
{
5061
#if(0)
5062
b_app(outdent);
5063
#endif
5064
containing--;
5065
}
5066
}
5067
5068
/* The \&{end} statement. */
5069
b_app(force);
5070
b_app(outdent);
5071
b_app2(pp+1);
5072
5073
REDUCE(pp,3,functn,-1,9961);
5074
}
5075
else
5076
@#endif
5077
if(cat1==stmt || (free_Fortran && cat1==decl))
5078
{
5079
b_app1(pp);
5080
b_app(break_space);
5081
b_app(force);
5082
b_app1(pp+1);
5083
REDUCE(pp,2,stmt,-2,2501);
5084
}
5085
else if (cat1==functn)
5086
{
5087
b_app1(pp); @~ b_app(big_force);
5088
b_app1(pp+1);
5089
REDUCE(pp,2,stmt,-2,2511);
5090
}
5091
5092
@
5093
@<CASES for |CASE_like| (R)@>=
5094
#if FCN_CALLS
5095
R_CASE();
5096
#else
5097
@<Cases for |CASE_like| (R)@>@;
5098
#endif
5099
5100
@
5101
@<Part 2@>=
5102
#if FCN_CALLS
5103
@[SRTN R_CASE(VOID)
5104
{
5105
@<Cases for |CASE_like| (R)@>@;
5106
}
5107
#endif
5108
5109
@
5110
@<Cases for |CASE_like| (R)@>=
5111
5112
if(is_FORTRAN_(language))
5113
{
5114
b_app(backup);
5115
b_app1(pp);
5116
REDUCE(pp,1,case_like,0,9258);
5117
}
5118
else SQUASH(pp,1,case_like,0,9259);
5119
5120
@
5121
@<CASES for |case_like| (R)@>=
5122
#if FCN_CALLS
5123
R_case_like();
5124
#else
5125
@<Cases for |case_like| (R)@>@;
5126
#endif
5127
5128
@
5129
@<Part 2@>=
5130
#if FCN_CALLS
5131
@[SRTN R_case_like(VOID)
5132
{
5133
@<Cases for |case_like| (R)@>@;
5134
}
5135
#endif
5136
5137
@
5138
@<Cases for |case_like| (R)@>=
5139
if(cat1==read_like) /* ``|@r call open|'' */
5140
{
5141
b_app1(pp); /* \&{call} */
5142
b_app(@' ');
5143
b_app1(pp+1); /* \&{close}, \&{open}, etc. */
5144
REDUCE(pp,2,case_like,0,9260);
5145
}
5146
else if (cat1==semi) SQUASH(pp,2,stmt,-2,260); /* ``|@r return;|'' */
5147
else if (cat1==colon) @<Append an ordinary colon@>@;
5148
else if (cat1==expr && cat2==semi)
5149
{ /* ``|@r return 1;|'' */
5150
PP_PP(1,2);
5151
REDUCE(pp,3,stmt,-2,262);
5152
}
5153
else if ((cat1==expr || cat1==label) && cat2==colon)
5154
{ /* ``|@r case 1:|'' */
5155
PP_PP(1,1);
5156
APP_STR("\\Colon\\ ");
5157
REDUCE(pp,3,tag,-1,263);
5158
}
5159
5160
@
5161
@<Append an ordinary colon@>=
5162
{
5163
b_app1(pp); @~ APP_STR("\\Colon\\ ");
5164
REDUCE(pp,2,tag,-1,261);
5165
}
5166
5167
@
5168
@<CASES for |tag| (R)@>=
5169
#if FCN_CALLS
5170
R_tag();
5171
#else
5172
@<Cases for |tag| (R)@>@;
5173
#endif
5174
5175
@
5176
@<Part 2@>=
5177
#if FCN_CALLS
5178
@[SRTN R_tag(VOID)
5179
{
5180
@<Cases for |tag| (R)@>@;
5181
}
5182
#endif
5183
5184
@
5185
@<Cases for |tag| (R)@>=
5186
5187
if (cat1==tag) /* ``|@r case 1: case 2:|'' */
5188
{
5189
b_app1(pp); @~ b_app(force);
5190
b_app(backup);
5191
b_app1(pp+1); REDUCE(pp,2,tag,-1,270);
5192
}
5193
else if (cat1==stmt || cat1==END_like) /* ``|@r 10 continue;|'' */
5194
{
5195
boolean end_of_loop;
5196
5197
end_of_loop = NO;
5198
5199
/* Unwind indent levels for labeled loops. */
5200
while(indent_level > 0 &&
5201
compare_text(pp->trans,label_text_ptr[indent_level-1]) )
5202
{
5203
--indent_level;
5204
b_app(outdent);
5205
end_of_loop = YES;
5206
}
5207
5208
if(is_FORTRAN_(language) && Fortran_label)
5209
{ /* ``|@n EXIT: continue@;|'' */
5210
b_app(force);
5211
APP_STR("\\Wlbl{"); @~ b_app1(pp); @~ app(@'}');
5212
@.\\Wlbl@>
5213
}
5214
else
5215
{ /* Label on separate line. */
5216
b_app(big_force);
5217
b_app(backup);
5218
b_app1(pp); /* Tag (Includes colon.) */
5219
b_app(force);
5220
}
5221
5222
b_app1(pp+1); /* Stmt. */
5223
5224
if(end_of_loop)
5225
app_loop_num(loop_num[indent_level]);
5226
5227
REDUCE(pp,2,cat1,-2,271);
5228
}
5229
5230
5231
@
5232
@<CASES for |label| (R)@>=
5233
#if FCN_CALLS
5234
R_label();
5235
#else
5236
@<Cases for |label| (R)@>@;
5237
#endif
5238
5239
@
5240
@<Part 2@>=
5241
#if FCN_CALLS
5242
@[SRTN R_label(VOID)
5243
{
5244
@<Cases for |label| (R)@>@;
5245
}
5246
#endif
5247
5248
@
5249
@<Cases for |label| (R)@>=
5250
if(cat1==colon)
5251
{
5252
b_app1(pp);
5253
REDUCE(pp,2,label,0,9270); /* Swallow the colon. (Numerical
5254
statement labels won't have any.) Then, for all labels, we put a colon in
5255
during the next block. */
5256
}
5257
else if(cat1==stmt || cat1==END_like)
5258
{
5259
b_app1(pp); @~ APP_STR("\\Colon\\ ");
5260
5261
if(is_FORTRAN_(language) && Fortran_label)
5262
b_app(cancel);
5263
5264
REDUCE(pp,1,tag,0,9271); /* Convert the label into a tag. Don't
5265
swallow the statement. */
5266
}
5267
5268
@
5269
@<CASES for |semi| (R)@>=
5270
#if FCN_CALLS
5271
R_semi();
5272
#else
5273
@<Cases for |semi| (R)@>@;
5274
#endif
5275
5276
@
5277
@<Part 2@>=
5278
#if FCN_CALLS
5279
@[SRTN R_semi(VOID)
5280
{
5281
@<Cases for |semi| (R)@>@;
5282
}
5283
#endif
5284
5285
@
5286
@<Cases for |semi| (R)@>=
5287
if(is_RATFOR_(language) && auto_semi)
5288
{ /* Just throw away semi. */
5289
text_pointer t;
5290
5291
t = indirect(pp->trans);
5292
5293
if(**t == @';') **t = 0;
5294
SQUASH(pp,1,ignore_scrap,-1,9280);
5295
}
5296
else
5297
{
5298
b_app(@' '); b_app1(pp); REDUCE(pp,1,stmt,-2,280);
5299
}
5300
5301
@
5302
@<CASES for |common_like| (R)@>=
5303
#if FCN_CALLS
5304
R_common_like();
5305
#else
5306
@<Cases for |common_like| (R)@>@;
5307
#endif
5308
5309
@
5310
@<Part 2@>=
5311
#if FCN_CALLS
5312
@[SRTN R_common_like(VOID)
5313
{
5314
@<Cases for |common_like| (R)@>@;
5315
}
5316
#endif
5317
5318
@
5319
@<Glob...@>=
5320
5321
@
5322
@<Cases for |common_like| (R)@>=
5323
if(cat1==expr || cat1==slashes || cat1==semi)
5324
{ /* ``|@r common x| or |@r common/dia/|'' */
5325
#if 0
5326
b_app1(pp);
5327
#if 0
5328
if(cat1 != semi)
5329
b_app(@' ');
5330
#endif
5331
b_app(indent);
5332
REDUCE(pp,1,common_hd,0,9950);
5333
#endif
5334
SQUASH(pp, 1, common_hd, 0, 9950);
5335
}
5336
5337
@
5338
@<CASES for |common_hd| (R)@>=
5339
#if FCN_CALLS
5340
R_cmn_hd();
5341
#else
5342
@<Cases for |common_hd| (R)@>@;
5343
#endif
5344
5345
@
5346
@<Part 2@>=
5347
#if FCN_CALLS
5348
@[SRTN R_cmn_hd(VOID)
5349
{
5350
@<Cases for |common_hd| (R)@>@;
5351
}
5352
#endif
5353
5354
@
5355
@<Cases for |common_hd| (R)@>=
5356
5357
#if 0
5358
if(cat1== expr)
5359
SQUASH(pp,2,common_hd,0,9951); /* ``|@r common x|'' */
5360
else if(cat1==slashes) /* ``|@r common/dia/|'' */
5361
{
5362
b_app1(pp);
5363
b_app(@' ');
5364
b_app1(pp+1);
5365
b_app(@' ');
5366
REDUCE(pp,2,common_hd,0,9952);
5367
}
5368
else if(cat1==comma) /* ``|@r common x,y|'' */
5369
{
5370
b_app2(pp);
5371
b_app(@' ');
5372
REDUCE(pp,2,common_hd,0,9953);
5373
}
5374
5375
if(cat1 == expr)
5376
{
5377
b_app1(pp);
5378
OPT9;
5379
b_app1(pp+1);
5380
REDUCE(pp,2,common_hd,0,9951); /* ``|@r common x|'' */
5381
}
5382
else if(cat1==slashes)
5383
{ /* ``|@r common/dia/|'' */
5384
SQUASH(pp,2,common_hd,0,9952);
5385
}
5386
else if(cat1==comma) /* ``|@r common x,y|'' */
5387
{
5388
SQUASH(pp,2,common_hd,0,9953);
5389
}
5390
else if(cat1==semi)
5391
{
5392
b_app2(pp);
5393
b_app(outdent);
5394
REDUCE(pp,2,decl,-1,9954); /* ``|@r common x;|'' */
5395
}
5396
#endif
5397
if(cat1 == slashes)
5398
SQUASH(pp, 2, int_like, 0, 9952); // `` |@4 common/dia/|''
5399
else
5400
SQUASH(pp, 1, int_like, 0, 9951); // ``|@r common x|''
5401
5402
@
5403
@<CASES for |read_like| (R)@>=
5404
#if FCN_CALLS
5405
R_read_like();
5406
#else
5407
@<Cases for |read_like| (R)@>@;
5408
#endif
5409
5410
@
5411
@<Part 2@>=
5412
#if FCN_CALLS
5413
@[SRTN R_read_like(VOID)
5414
{
5415
@<Cases for |read_like| (R)@>@;
5416
}
5417
#endif
5418
5419
@
5420
@<Cases for |read_like| (R)@>=
5421
5422
if(cat1==lpar && cat2==expr && cat3==rpar) /* |@r read(6,100)| */
5423
{
5424
b_app1(pp);
5425
@<Append thinspace@>;
5426
b_app3(pp+1);
5427
b_app(@' ');
5428
REDUCE(pp,4,read_hd,0,9960);
5429
}
5430
else if(cat1==expr && cat2==comma) /* ``|@r TYPE 100, i@;|'' */
5431
{
5432
b_app1(pp);
5433
b_app(@' ');
5434
b_app2(pp+1);
5435
b_app(@' ');
5436
REDUCE(pp,3,read_hd,0,9961);
5437
}
5438
else if(cat1==expr || cat1==unorbinop) /* ``|@r TYPE *|'' */
5439
{
5440
PP_PP(1,1);
5441
5442
if(cat2==expr) b_app(@' '); /* Takes care of |"TYPE 100 i"|. */
5443
5444
REDUCE(pp,2,read_hd,0,9962);
5445
}
5446
else if(cat1==semi) SQUASH(pp,1,read_hd,0,9963);
5447
5448
5449
@
5450
@<CASES for |read_hd| (R)@>=
5451
#if FCN_CALLS
5452
R_rd_hd();
5453
#else
5454
@<Cases for |read_hd| (R)@>@;
5455
#endif
5456
5457
@
5458
@<Part 2@>=
5459
#if FCN_CALLS
5460
@[SRTN R_rd_hd(VOID)
5461
{
5462
@<Cases for |read_hd| (R)@>@;
5463
}
5464
#endif
5465
5466
@
5467
@<Cases for |read_hd| (R)@>=
5468
if(cat1==comma) /* ``|@r read(6,100),|'' */
5469
{
5470
b_app2(pp);
5471
b_app(@' ');
5472
REDUCE(pp,2,read_hd,0,9965);
5473
}
5474
else if(cat1==expr)
5475
{
5476
if(cat2==comma || cat2==semi)
5477
SQUASH(pp,2,read_hd,0,9966); /* ``|@r write(6,100) i,j@;|'' */
5478
}
5479
else if(cat1==semi && cat2==read_like) /* Two I/O statements back-to-back. */
5480
{
5481
b_app1(pp);
5482
@#if 0
5483
b_app(big_cancel);
5484
@#endif
5485
b_app1(pp+1);
5486
b_app(force);
5487
b_app1(pp+2);
5488
REDUCE(pp,3,read_like,0,9967);
5489
}
5490
else if(cat1==semi)
5491
{
5492
b_app1(pp);
5493
@#if 0
5494
b_app(big_cancel); /* Supposed to kill off preceding blanks. */
5495
@#endif
5496
b_app1(pp+1);
5497
REDUCE(pp,2,stmt,-2,9968);
5498
}
5499
5500
@
5501
5502
@f implicit_none implicit
5503
5504
@<CASES for |implicit_like| (R)@>=
5505
#if FCN_CALLS
5506
R_implicit_like();
5507
#else
5508
@<Cases for |implicit_like| (R)@>@;
5509
#endif
5510
5511
@
5512
@<Part 2@>=
5513
#if FCN_CALLS
5514
@[SRTN R_implicit_like(VOID)
5515
{
5516
@<Cases for |implicit_like| (R)@>@;
5517
}
5518
#endif
5519
5520
@
5521
@<Cases for |implicit_like| (R)@>=
5522
if(cat1==int_like || cat1==expr) /* ``|@r implicit integer|'' or
5523
``|@r implicit none|'' */
5524
{
5525
b_app1(pp);
5526
b_app(@' ');
5527
b_app(indent); /* Start possible long declaration. */
5528
REDUCE(pp,1,implicit_hd,0,9970);
5529
}
5530
else if(cat1==semi)
5531
{ /* ``|@r implicit_none;|''. */
5532
b_app1(pp);
5533
b_app(indent);
5534
REDUCE(pp,1,implicit_hd,0,99700);
5535
}
5536
5537
@
5538
@<CASES for |implicit_hd| (R)@>=
5539
#if FCN_CALLS
5540
R_imp_hd();
5541
#else
5542
@<Cases for |implicit_hd| (R)@>@;
5543
#endif
5544
5545
@
5546
@<Part 2@>=
5547
#if FCN_CALLS
5548
@[SRTN R_imp_hd(VOID)
5549
{
5550
@<Cases for |implicit_hd| (R)@>@;
5551
}
5552
#endif
5553
5554
@
5555
@<Cases for |implicit_hd| (R)@>=
5556
if(cat1==unorbinop && cat2==expr)
5557
{ /* ``|@r implicit real*8|'' */
5558
b_app1(pp);
5559
b_app(@'{'); @~ b_app2(pp+1); @~ b_app(@'}');
5560
@<Append thinspace@>;
5561
REDUCE(pp,3,implicit_hd,0,9971);
5562
}
5563
else if(cat1==expr) SQUASH(pp,2,implicit_hd,0,9972); /* ``|@r implicit
5564
integer(a-h)|'' */
5565
else if(cat1==comma || cat1==int_like)
5566
{
5567
b_app2(pp);
5568
5569
if(cat2 != unorbinop)
5570
if(cat2==int_like) b_app(@' '); /* ``|@r implicit real x,
5571
integer i|'' */
5572
else @<Append thinspace@>;
5573
5574
REDUCE(pp,2,implicit_hd,0,9973);
5575
}
5576
else if(cat1==semi) SQUASH(pp,1,decl_hd,0,9974); /* ``|@r implicit
5577
integer(a-h);|'' */
5578
5579
@
5580
@<CASES for |assign_like| (R)@>=
5581
#if FCN_CALLS
5582
R_assign_like();
5583
#else
5584
@<Cases for |assign_like| (R)@>@;
5585
#endif
5586
5587
@
5588
@<Part 2@>=
5589
#if FCN_CALLS
5590
@[SRTN R_assign_like(VOID)
5591
{
5592
@<Cases for |assign_like| (R)@>@;
5593
}
5594
#endif
5595
5596
@
5597
@<Cases for |assign_like| (R)@>=
5598
if(cat1==expr && cat2==built_in && cat3==expr) /* ``|@r assign 100 to k|'' */
5599
{
5600
b_app1(pp);
5601
b_app(@' ');
5602
b_app1(pp+1);
5603
b_app(@' ');
5604
b_app1(pp+2);
5605
b_app(@' ');
5606
b_app1(pp+3);
5607
REDUCE(pp,4,expr,0,9980);
5608
}
5609
5610
@ The following flag is used in \FORTRAN-90 to determine whether a |@r9
5611
contains| is in force, and what level in the block structure we're in.
5612
5613
@<Glob...@>=
5614
5615
IN_PROD int containing PSET(0);
5616
5617
@
5618
@<CASES for |entry_like| (R)@>=
5619
#if FCN_CALLS
5620
R_entry_like();
5621
#else
5622
@<Cases for |entry_like| (R)@>@;
5623
#endif
5624
5625
@
5626
@<Part 2@>=
5627
#if FCN_CALLS
5628
@[SRTN R_entry_like(VOID)
5629
{
5630
@<Cases for |entry_like| (R)@>@;
5631
}
5632
#endif
5633
5634
@
5635
@<Cases for |entry_like| (R)@>=
5636
if(cat1==expr && cat2==semi) /* ``|@r entry E(x);|'' */
5637
{
5638
b_app(big_force);
5639
b_app(backup); @~ PP_PP(1,2); @~ b_app(force);
5640
REDUCE(pp,3,stmt,-2,9990);
5641
}
5642
else if(cat1== (eight_bits)(language==FORTRAN_90 ? semi : colon))
5643
{ /* ``|@r9 contains:|'' */
5644
b_app(big_force);
5645
b_app(backup); @~ b_app2(pp); @~ b_app(force);
5646
5647
containing++;
5648
#if(0)
5649
b_app(indent);
5650
#endif
5651
REDUCE(pp,2,stmt,-2,9991);
5652
}
5653
5654
@
5655
@<CASES for |define_like| (R)@>=
5656
#if FCN_CALLS
5657
R_define_like();
5658
#else
5659
@<Cases for |define_like| (R)@>@;
5660
#endif
5661
5662
@
5663
@<Part 2@>=
5664
#if FCN_CALLS
5665
@[SRTN R_define_like(VOID)
5666
{
5667
@<Cases for |define_like| (R)@>@;
5668
}
5669
#endif
5670
5671
@
5672
@<Cases for |define_like| (R)@>=
5673
if(cat1==expr)
5674
{
5675
b_app(force);
5676
b_app(backup); @~ b_app2(pp); @~ b_app(force);
5677
REDUCE(pp,2,ignore_scrap,-1,9995);
5678
}
5679
5680
@ \&{data} statements can be intermixed with everything. (VAX). For such
5681
statements, we raise a flag.
5682
5683
@<CASES for |no_order| (R)@>=
5684
#if FCN_CALLS
5685
R_no_order();
5686
#else
5687
@<Cases for |no_order| (R)@>@;
5688
#endif
5689
5690
@
5691
@<Part 2@>=
5692
#if FCN_CALLS
5693
@[SRTN R_no_order(VOID)
5694
{
5695
@<Cases for |no_order| (R)@>@;
5696
}
5697
#endif
5698
5699
@
5700
@<Cases for |no_order| (R)@>=
5701
intermingle = YES;
5702
b_app(force);
5703
b_app1(pp); @~ b_app(@' ');
5704
REDUCE(pp,1,int_like,0,9996);
5705
5706
5707
@
5708
@<CASES for |built_in| (R)@>=
5709
#if FCN_CALLS
5710
R_built_in();
5711
#else
5712
@<Cases for |built_in| (R)@>@;
5713
#endif
5714
5715
@
5716
@<Part 2@>=
5717
#if FCN_CALLS
5718
@[SRTN R_built_in(VOID)
5719
{
5720
@<Cases for |built_in| (R)@>@;
5721
}
5722
#endif
5723
5724
@
5725
@<Cases for |built_in| (R)@>=
5726
{
5727
b_app1(pp);
5728
@<Append thinspace@>;
5729
REDUCE(pp,1,expr,-2,9998);
5730
}
5731
5732
@
5733
@<CASES for |newline| (R)@>=
5734
#if FCN_CALLS
5735
R_newline();
5736
#else
5737
@<Cases for |newline| (R)@>@;
5738
#endif
5739
5740
@
5741
@<Part 2@>=
5742
#if FCN_CALLS
5743
@[SRTN R_newline(VOID)
5744
{
5745
@<Cases for |newline| (R)@>@;
5746
}
5747
#endif
5748
5749
@
5750
@<Cases for |newline| (R)@>=
5751
SQUASH(pp,1,ignore_scrap,-1,9999);
5752
5753
@* PRODUCTIONS for LITERAL.
5754
@<Part 2@>=@[
5755
SRTN
5756
V_productions(VOID)
5757
{
5758
switch(pp->cat)
5759
{
5760
case expr: @<Cases for |expr| (M)@>@; @~ break;
5761
case stmt: @<Cases for |stmt| (M)@>@; @~ break;
5762
}
5763
}
5764
5765
@
5766
@<Cases for |expr| (M)@>=
5767
5768
@
5769
@<Cases for |stmt| (M)@>=
5770
5771
@* PRODUCTIONS for TEX. The productions have been made into individual
5772
functions to accomodate memory-starved pc's.
5773
@<Part 2@>=@[
5774
SRTN
5775
X_productions(VOID)
5776
{
5777
switch (pp->cat)
5778
{
5779
case expr: @<Cases for |expr| (X)@>@; @~ break;
5780
case stmt: @<Cases for |stmt| (X)@>@; @~ break;
5781
}
5782
}
5783
5784
@
5785
@<Cases for |expr| (X)@>=
5786
{
5787
if(cat1==expr) SQUASH(pp,2,expr,0,5);
5788
else if(cat1==semi)
5789
{
5790
b_app1(pp);
5791
REDUCE(pp,2,stmt,-1,6);
5792
}
5793
}
5794
5795
@
5796
@<Cases for |stmt| (X)@>=
5797
{
5798
if(cat1==stmt)
5799
{
5800
b_app1(pp);
5801
b_app(force);
5802
b_app1(pp+1);
5803
REDUCE(pp,2,stmt,-1,250);
5804
}
5805
}
5806
5807
@* CHANGING the SCRAP LIST; APPLYING the PRODUCTIONS.
5808
The `|reduce|' procedure makes the appropriate changes to the scrap list.
5809
5810
@<Typed...@>=
5811
5812
typedef unsigned long RULE_NO; // Rule number for the productions.
5813
5814
@
5815
@d REDUCE(j,k,c,d,n) reduce(j,k,(eight_bits)(c),d,(RULE_NO)(n))
5816
@<Part 2@>=@[
5817
SRTN
5818
reduce FCN((j,k,c,d,n))
5819
scrap_pointer j C0("")@;
5820
short k C0("Number of items to be reduced.")@;
5821
eight_bits c C0("Reduce to this type.")@;
5822
short d C0("Move by this amount.")@;
5823
RULE_NO n C1("Rule number.")@;
5824
{
5825
scrap_pointer i, i1; /* Pointers into scrap memory */
5826
5827
/* Store the translation. */
5828
j->cat=c; j->trans=text_ptr;
5829
j->mathness= (eight_bits)(4*last_mathness+ini_mathness);
5830
freeze_text;
5831
5832
/* More stuff to the left, overwriting the $k$~items that have been
5833
reduced. */
5834
if (k>1)
5835
{
5836
for (i=j+k, i1=j+1; i<=lo_ptr; i++, i1++)
5837
{
5838
i1->cat=i->cat; i1->trans=i->trans;
5839
i1->mathness=i->mathness;
5840
}
5841
5842
lo_ptr=lo_ptr-k+1;
5843
}
5844
5845
@<Change |pp| to $\max(|scrp_base|,|pp+d|)$@>;
5846
5847
#ifdef DEBUG
5848
@<Print a snapshot of the scrap list if debugging @>;
5849
#endif /* |DEBUG| */
5850
5851
pp--; /* we next say |pp++| */
5852
}
5853
5854
@
5855
@<Change |pp| to $\max...@>=
5856
5857
if (pp+d>=scrp_base) pp=pp+d;
5858
else pp=scrp_base;
5859
5860
@ The |squash| procedure takes advantage of the simplification that occurs
5861
when |k=1|.
5862
5863
@d SQUASH(j,k,c,d,n) squash(j,k,c,d,(RULE_NO)(n))
5864
5865
@<Part 2@>=@[
5866
SRTN
5867
squash FCN((j,k,c,d,n))
5868
scrap_pointer j C0("")@;
5869
short k C0("Number to be squashed.")@;
5870
eight_bits c C0("Make it this type.")@;
5871
short d C0("Move by this amount.")@;
5872
RULE_NO n C1("Rule number.")@;
5873
{
5874
scrap_pointer i; /* pointers into scrap memory */
5875
5876
if (k==1)
5877
{
5878
j->cat=c; @<Change |pp|...@>;
5879
5880
#ifdef DEBUG
5881
@<Print a snapshot...@>;
5882
#endif /* |DEBUG| */
5883
5884
pp--; /* we next say |pp++| */
5885
return;
5886
}
5887
5888
for (i=j; i<j+k; i++) b_app1(i);
5889
5890
reduce(j,k,c,d,n);
5891
}
5892
5893
@ Here now is the code that applies productions as long as possible. It
5894
requires two local labels (|found| and |done|), as well as a local
5895
variable~(|i|).
5896
5897
@<Reduce the scraps using the productions until no more rules apply@>=
5898
{
5899
in_prototype = indented = NO;
5900
5901
WHILE()
5902
{
5903
@<Make sure the entries |pp| through |pp+3| of |cat| are defined@>;
5904
5905
if (tok_ptr+8>tok_m_end)
5906
{
5907
if (tok_ptr>mx_tok_ptr) mx_tok_ptr=tok_ptr;
5908
OVERFLW("tokens","tw");
5909
}
5910
5911
if(text_ptr+4>tok_end)
5912
{
5913
if (text_ptr>mx_text_ptr) mx_text_ptr=text_ptr;
5914
OVERFLW("texts",ABBREV(max_texts));
5915
}
5916
5917
if(pp>lo_ptr)
5918
break;
5919
5920
@<Match a production...@>;
5921
ini_mathness=cur_mathness=last_mathness=maybe_math;
5922
}
5923
}
5924
5925
@ If we get to the end of the scrap list, category codes equal to zero are
5926
stored, since zero does not match anything in a production.
5927
5928
@<Make sure the entries...@>=
5929
5930
if (lo_ptr<pp+3)
5931
{
5932
while (hi_ptr<=scrp_ptr && lo_ptr!=pp+3)
5933
{
5934
(++lo_ptr)->cat=hi_ptr->cat; lo_ptr->mathness=(hi_ptr)->mathness;
5935
lo_ptr->trans=(hi_ptr++)->trans;
5936
}
5937
5938
for (i=lo_ptr+1;i<=pp+3;i++) i->cat=0;
5939
}
5940
5941
@
5942
@d MAX_CYCLES 500
5943
@<Check for infinite loop@>=
5944
{
5945
static RULE_NO last_rule = ULONG_MAX;
5946
static int ncycles = 0;
5947
5948
if(n && n == last_rule)
5949
{
5950
if(ncycles++ > MAX_CYCLES)
5951
{
5952
CONFUSION("reduce", "Infinite production loop, rule %lu", n);
5953
}
5954
}
5955
else
5956
{
5957
last_rule = n;
5958
ncycles = 0;
5959
}
5960
}
5961
5962
@
5963
@<Print a snapsh...@>=
5964
@B
5965
scrap_pointer k; /* pointer into |scrap_info| */
5966
5967
@b
5968
@<Check for infinite loop@>@;
5969
5970
if (tracing==VERBOSE)
5971
{
5972
printf("%5lu", n); // The rule number.
5973
5974
if(in_prototype)
5975
printf(".%i", in_prototype);
5976
5977
printf(": ");
5978
5979
for (k=scrp_base; k<=lo_ptr; k++)
5980
{
5981
if (k==pp)
5982
putxchar('*'); // Current one.
5983
else
5984
putxchar(' ');
5985
5986
prn_math(k);
5987
}
5988
5989
if (hi_ptr<=scrp_ptr) printf("..."); /* indicate that more is
5990
coming */
5991
5992
@<Print the last translation@>@;
5993
5994
}
5995
}
5996
5997
@
5998
@<Part 1@>=
5999
6000
SRTN
6001
prn_math FCN((k))
6002
scrap_pointer k C1("")@;
6003
{
6004
if (INI_MATHNESS(k) == yes_math)
6005
putxchar('+');
6006
else if (INI_MATHNESS(k) == no_math)
6007
putxchar('-');
6008
6009
prn_cat(k->cat);
6010
6011
if (LAST_MATHNESS(k) == yes_math)
6012
putxchar('+');
6013
else if (LAST_MATHNESS(k) == no_math)
6014
putxchar('-');
6015
6016
DFLUSH@;
6017
}
6018
6019
@ For debugging, it's helpful to see the translation of the last several scraps
6020
that's printed explicitly.
6021
@<Print the last trans...@>=
6022
{
6023
printf(" ==\"");
6024
6025
if(lo_ptr > scrp_base)
6026
{
6027
prn_trans(lo_ptr-1); // The second-to-last scrap.
6028
printf("\" \"");
6029
}
6030
6031
prn_trans(lo_ptr); // Last scrap.
6032
puts("\"");
6033
}
6034
6035
@ The |translate| function assumes that scraps have been stored in
6036
positions |scrp_base| through |scrp_ptr| of |cat| and |trans|. It appends
6037
a |terminator| scrap and begins to apply productions as much as possible.
6038
The result is a token list containing the translation of the given sequence
6039
of scraps.
6040
6041
After calling |translate|, we will have |text_ptr+3<=max_texts| and
6042
|tok_ptr+6<=max_toks|, so it will be possible to create up to three token
6043
lists with up to six tokens without checking for overflow. Before calling
6044
|translate|, we should have |text_ptr<max_texts| and
6045
|scrp_ptr<max_scraps|, since |translate| might add a new text and a new
6046
scrap before it checks for overflow.
6047
6048
@<Part 2@>=@[
6049
text_pointer
6050
translate FCN((mode0))
6051
PARSING_MODE mode0 C1("")@;
6052
{
6053
LANGUAGE saved_language = language;
6054
scrap_pointer i, /* index into |cat| */
6055
j; /* runs through final scraps */
6056
6057
translate_mode = mode0;
6058
6059
pp=scrp_base; lo_ptr=pp-1; hi_ptr=pp;
6060
@<If tracing, print an indication of where we are@>;
6061
@<Reduce the scraps...@>@;
6062
@<Combine the irreducible scraps that remain@>;
6063
6064
language = saved_language;
6065
return text_ptr-1;
6066
}
6067
6068
@ If the initial sequence of scraps does not reduce to a single scrap, we
6069
concatenate the translations of all remaining scraps, separated by blank
6070
spaces, with dollar signs surrounding the translations of scraps whose
6071
category code is |max_math| or less.
6072
6073
@<Combine the irreducible...@>=
6074
{
6075
EXTERN int math_flag;
6076
6077
@<If semi-tracing, show the irreducible scraps@>;
6078
6079
for (j=scrp_base; j<=lo_ptr; j++)
6080
{
6081
if (j!=scrp_base)
6082
app(@' '); // Separate scraps by blanks.
6083
6084
if ((INI_MATHNESS(j) == yes_math) && math_flag==NO)
6085
{
6086
app(@'$');
6087
#ifdef DBGM
6088
app(@'7');
6089
#endif
6090
}
6091
6092
if ((INI_MATHNESS(j) == no_math) && math_flag==YES)
6093
{
6094
app(@' ');
6095
6096
#ifdef DBGM
6097
app(@'8');
6098
#endif
6099
app(@'$');
6100
}
6101
6102
app1(j);
6103
6104
if ((LAST_MATHNESS(j) == yes_math) && math_flag==NO)
6105
{
6106
#ifdef DBGM
6107
app(@'9');
6108
#endif
6109
app(@'$');
6110
}
6111
6112
if ((LAST_MATHNESS(j) == no_math) && math_flag==YES)
6113
{
6114
app(@'$');
6115
#ifdef DBGM
6116
app(@'0');
6117
#endif
6118
app(@' ');
6119
}
6120
6121
if (tok_ptr+6>tok_m_end) OVERFLW("tokens","tw");
6122
}
6123
6124
freeze_text;
6125
}
6126
6127
@
6128
@<If semi-tracing, show the irreducible scraps@>=
6129
6130
#ifdef DEBUG
6131
{
6132
scrap_pointer scrap0 = scrp_base;
6133
6134
while(scrap0->cat == ignore_scrap) scrap0++;
6135
6136
if (lo_ptr>scrap0 && tracing==BRIEF)
6137
{
6138
CLR_PRINTF(ALWAYS, warning,
6139
("\nIrreducible scrap sequence in %s:",
6140
MOD_TRANS(module_count)));
6141
mfree();
6142
mark_harmless;
6143
6144
for (j=scrap0; j<=lo_ptr; j++)
6145
{
6146
printf(" "); prn_cat(j->cat);
6147
}
6148
}
6149
}
6150
#endif /* |DEBUG| */
6151
6152
@ Print a header for each section of translated code.
6153
@d OUT_WIDTH 40
6154
@<If tracing,...@>=
6155
6156
#ifdef DEBUG
6157
if (tracing==VERBOSE)
6158
{
6159
CLR_PRINTF(ALWAYS, warning,
6160
("\nTracing after l. %u (language = %s): ",
6161
cur_line,languages[lan_num(language)]));
6162
mark_harmless;
6163
6164
if (loc>=cur_buffer+OUT_WIDTH)
6165
{
6166
printf("...");
6167
ASCII_write(loc-OUT_WIDTH,OUT_WIDTH);
6168
}
6169
else ASCII_write(cur_buffer,loc-cur_buffer);
6170
6171
puts("");
6172
}
6173
#endif /* |DEBUG| */
6174
6175
@* INDEX.
Loggerhead is a web-based interface for Breezy
Version: 2.0.1