« back to all changes in this revision
Viewing changes to Web/fweave.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/fweave.web
1
@z --- fweave.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
10
\Title{FWEAVE.WEB} % The FWEAVE processor.
11
12
@c
13
14
@* INTRODUCTION. \WEAVE\ has a fairly straightforward outline. It
15
operates in three phases: first it inputs the source file and stores
16
cross-reference data, then it inputs the source once again and produces the
17
\TeX\ output file, and finally it sorts and outputs the index. It can be
18
compiled with the optional flag |DEBUG| (defined in \.{typedefs.web}).
19
20
Some compilers may not be able to handle a module this big. In that case,
21
compile this twice, defining from the compiler's command line the macro
22
|part| to have the value of either~1 or~2: e.g., `\.{-Dpart=1}'. See the make
23
file for complete details.
24
25
For the text of the modules that aren't printed out here, such as
26
\.{typedefs.web}, see \.{common.web}.
27
28
@m _FWEAVE_ // Identify the module for various \FWEB\ macros.
29
@d _FWEAVE_h
30
@d _FWEB_h
31
32
@A
33
@<Possibly split into parts@>@; // Defines |part|.
34
35
@<Include files@>@;
36
@<Typedef declarations@>@;
37
@<Prototypes@>@;
38
@<Global variables@>@;
39
40
/* For pc's, the file is split into three compilable parts using the
41
compiler-line macro |part|, which must equal either~1, 2, or~3. */
42
#if(part == 0 || part == 1)
43
@<Part 1@>@;
44
#endif // |Part == 1|
45
46
#if(part == 0 || part == 2)
47
@<Part 2@>@;
48
#endif // |part == 2|
49
50
#if(part == 0 || part == 3)
51
@<Part 3@>@;
52
#endif // |part == 3|
53
54
@ Here is the main program. See the user's manual for a detailed
55
description of the command line.
56
57
@<Part 1@>=@[
58
59
int main FCN((ac, av))
60
int ac C0("Number of command-line arguments.")@;
61
outer_char **av C1("Array of pointers to command-line arguments.")@;
62
{
63
/* --- Various initializations --- */
64
#if TIMING
65
ini_timer(); /* Start timing the run. */
66
#endif // |TIMING|
67
68
argc=ac; @~ argv=av; /* Remember the arguments as global variables. */
69
70
ini_program(weave);
71
72
common_init();
73
@<Set initial values@>;
74
75
/* --- Do the processing --- */
76
phase1(); /* read all the user's text and store the cross-references */
77
phase2(); /* read all the text again and translate it to \TeX\ form */
78
phase3(); /* output the cross-reference index */
79
80
return wrap_up(); /* We actually |exit| from here. */
81
}
82
83
@I typedefs.hweb
84
85
@ Here we open the \.{.tex} output file. This routine is called from
86
|common_init|.
87
88
@<Part 1@>=@[
89
90
SRTN
91
open_tex_file(VOID)
92
{
93
if(STRCMP(tex_fname, "stdout") == 0)
94
tex_file = stdout;
95
else
96
{
97
@<Open \.{.tex} file for reading, if it exists; check for valid
98
header@>@;
99
100
if((tex_file=FOPEN(tex_fname, "w"))==NULL)
101
{
102
FATAL(W,
103
"ABORTING: ",
104
"Can't open output file %s.",
105
tex_fname);
106
}
107
else
108
@<Print header information to beginning of output file@>@;
109
}
110
}
111
112
@ The following code is intended to catch the embarrassing situation when
113
\FWEAVE's output tries to overwrite an already existing \TeX\ file. For
114
example, one has a paper called \.{test.tex}, then later creates a file
115
\.{test.web} for entirely different purposes. Only if the existing file
116
has a valid header indicating it was created by \FWEAVE\ will we continue.
117
118
@<Open \.{.tex} file for reading...@>=
119
{
120
if(tex_file=FOPEN(tex_fname, "r"))
121
{
122
outer_char buf[80];
123
124
fgets((char *)buf, STRLEN(FWEAVE_HDR)+1, tex_file);
125
126
if(STRCMP(buf, FWEAVE_HDR))
127
{
128
if(!verify(OC("\n%c!!! Attempting to write FWEAVE's output \
129
into %s%s%s, a file apparently not created by FWEAVE. Continue"),
130
beep(1),
131
SSET_COLOR(out_file),
132
tex_fname,
133
SSET_COLOR(warning)))
134
FATAL(W,
135
"ABORTING: ",
136
"Didn't overwrite %s%s%s.",
137
SSET_COLOR(out_file),
138
tex_fname,
139
SSET_COLOR(fatal)
140
);
141
142
puts("");
143
}
144
145
fclose(tex_file);
146
}
147
}
148
149
150
@ The command line was formatted up with newlines; these must be followed
151
by a \TeX\ comment character.
152
153
@d FWEAVE_HDR "% FWEAVE"
154
155
@<Print header...@>=
156
{
157
fprintf(tex_file, "%s v%s (%s)\n\n",
158
FWEAVE_HDR, (char *)version, (char *)release_date);
159
}
160
161
162
@
163
@<Set init...@>=
164
165
@<Allocate dynamic memory@>@;
166
167
@ The function prototypes must appear before the global variables.
168
@<Proto...@>=
169
170
#include "w_type.h" /* Function prototypes for \FWEAVE. */
171
172
@i xrefs.hweb /* Declarations for cross-referencing. */
173
174
@
175
@<Alloc...@>=
176
177
ALLOC(xref_info,xmem,ABBREV(max_refs),max_refs,0);
178
xmem_end = xmem + max_refs - 1;
179
180
@
181
@<Set init...@>=
182
183
name_dir->xref = (XREF_POINTER)(xref_ptr=xmem);
184
xref_switch = mod_xref_switch = defd_switch = index_short = NO;
185
xmem->num = 0; // Cross-references to undefined modules.
186
187
@ A new cross-reference for an identifier is formed by calling |new_xref|,
188
which discards duplicate entries and ignores non-underlined references to
189
one-letter identifiers or reserved words.
190
191
If the user has sent the |no_xref| flag (the \.{-x} option of the command
192
line), it is unnecessary to keep track of cross-references for identifers.
193
If one were careful, one could probably make more changes around module~100
194
(??) to avoid a lot of identifier looking up.
195
196
@<Part 1@>=@[
197
198
SRTN
199
new_xref FCN((part0,p))
200
PART part0 C0("")@;
201
name_pointer p C1("")@;
202
{
203
xref_pointer q; // Pointer to previous cross-reference.
204
sixteen_bits m, n; // New and previous cross-reference value.
205
206
if(index_flag == NO)
207
{
208
SET_TYPE(p,DEFINED_TYPE(p) | 0x80);
209
index_flag = BOOLEAN(!(language==LITERAL));
210
}
211
212
/* Do nothing if we're not supposed to cross-reference. Also do nothing if
213
we're inside a \&{format} statement. This is a bit kludgy, but it works. */
214
if (!index_flag || !(output_on || index_hidden) || in_format
215
|| (unnamed_section && !xref_unnamed) )
216
return; /* The |output_on| flag here prevents index entries for
217
modules skipped with~\.{-i}. */
218
219
index_flag = BOOLEAN(!(language==LITERAL));
220
221
/* Say where the identifier is defined (but not if it's a reserved word). */
222
if(defd_switch && (part0 == DEFINITION
223
|| !(preprocessing
224
|| is_reserved(p) || is_intrinsic(p) || is_keyword(p))))
225
{
226
sixteen_bits mod_defined = p->defined_in(language);
227
228
if(mod_defined && mod_defined != module_count && language!=C_PLUS_PLUS)
229
{
230
err_print(W,"Identifier in %s was already explicitly \
231
or implicitly\n\
232
marked via @@[ as defined in %s",
233
MOD_TRANS(module_count), MOD_TRANS(mod_defined));
234
mark_harmless;
235
}
236
237
p->defined_in(language) = module_count;
238
defd_switch = NO;
239
}
240
241
if(defd_type != NEVER_DEFINED)
242
SET_TYPE(p,defd_type); // Used to be up in previous block.
243
244
defd_type = NEVER_DEFINED;
245
246
if ( xref_switch==NO
247
&& (is_reserved(p)
248
|| ((!(index_short || index_one)) && (length(p)==1))) )
249
return;
250
251
/* The following code needs to be attached to a flag. */
252
#if 0
253
if ( xref_switch==NO
254
&& (is_reserved(p)))
255
return;
256
#endif
257
258
if(index_short)
259
index_short = NO;
260
261
if(no_xref)
262
return; // The result of the \.{-x} flag.
263
264
m = module_count + xref_switch;
265
xref_switch = NO;
266
q = (xref_pointer)p->xref;
267
268
if(!(do_inside || all_includes || (quoted_includes && qtd_file)))
269
goto check_implicit; // Skip if reading an include file.
270
271
if (q != xmem)
272
{ /* There's already an entry. */
273
n = q->num;
274
275
if (n==m || n==m+def_flag)
276
goto check_implicit;
277
// Discard duplicates within the same module.
278
else if (m==n+def_flag)
279
{
280
q->num = m; /* Update the entry to be defined instead of
281
just used. */
282
goto check_implicit;
283
}
284
}
285
286
/* There's no entry yet; make a new cross-reference. */
287
append_xref(m);
288
289
/* Link in; highest module number is first. */
290
xref_ptr->xlink=q; p->xref = (XREF_POINTER)xref_ptr;
291
292
check_implicit:
293
if(typd_switch)
294
@<Execute an implicit \.{@@f}@>@;
295
}
296
297
@ When the |typd_switch| is on, due to an~\.{@@`}, we execute an implicit
298
format statement that formats~|p| as a reserved word.
299
@<Execute an implicit...@>=
300
{
301
NAME_INFO rs_wd;
302
name_pointer lhs = p, rhs = &rs_wd;
303
304
rhs->ilk = int_like;
305
rhs->reserved_word = rhs->Language = BOOLEAN(language);
306
rhs->intrinsic_word = rhs->keyword = NO;
307
308
@<Format the left-hand side@>@;
309
310
@#if 0
311
/* Mark as defined in this module. */
312
if(mark_defined.imp_reserved_name)
313
{
314
p->defined_in(language) = module_count;
315
SET_TYPE(p,IMPLICIT_RESERVED);
316
}
317
@#endif
318
319
/* Make all previous entries register as defined, not just used. */
320
for(q=(xref_pointer)p->xref; q>xmem; q = q->xlink)
321
if(q->num < def_flag) q->num += def_flag;
322
323
typd_switch = NO;
324
}
325
326
@ The cross-reference lists for module names are slightly different.
327
Suppose that a module name is defined in modules~$m_1$, \dots, $m_k$ and
328
used in modules~$n_1$, \dots, $n_l$. Then its list will contain
329
$m_1+|def_flag|$, $m_k+|def_flag|$, \dots, $m_2+|def_flag|$, $n_l$, \dots,
330
$n_1$, in this order. After Phase II, however, the order will be
331
$m_1+|def_flag|$, \dots, $m_k+|def_flag|$, $n_1$, \dots, $n_l$.
332
333
@<Part 1@>=@[
334
335
SRTN
336
new_mod_xref FCN((p))
337
name_pointer p C1("")@;
338
{
339
xref_pointer q,r; /* pointers to previous cross-references */
340
341
@#if(0)
342
if(!output_on) return; /* Don't bother with references if the module is
343
skipped with \.{-i}. */
344
@#endif
345
346
q = (xref_pointer)p->xref; r=xmem;
347
348
if (q>xmem)
349
{
350
if (mod_xref_switch==NO)
351
{ /* ``Used in module...'' Scan past all the definitions. */
352
while (q->num>=def_flag)
353
{
354
r=q;
355
q = q->xlink;
356
}
357
}
358
else
359
{ /* Defining...*/
360
if (q->num>=def_flag)
361
{
362
r=q;
363
q = q->xlink;
364
}
365
}
366
}
367
368
if(mod_xref_switch == NO)
369
{ /* Not defining. */
370
p->mod_info->params.uses++; // Count number of uses.
371
372
if(q->num == module_count)
373
return; // Discard duplicate ``used in'' xref.
374
}
375
376
append_xref(module_count+mod_xref_switch);
377
xref_ptr->xlink=q; mod_xref_switch=NO;
378
379
if (r==xmem)
380
p->xref = (XREF_POINTER)xref_ptr;
381
else
382
r->xlink=xref_ptr;
383
}
384
385
@i tokens.hweb /* Declarations for |token| storage. */
386
387
@
388
@<Alloc...@>=
389
390
ALLOC(Token,tok_mem,ABBREV(max_toks_w),max_toks,1);
391
tok_mem++; /* In some unusual circumstances, there may be references to
392
|tok_mem[-1]|, so be sure it exists. */
393
tok_m_end = tok_mem+max_toks-1; // End of |tok_mem|./
394
395
ALLOC(token_pointer,tok_start,ABBREV(max_texts),max_texts,0);
396
tok_end = tok_start+max_texts-1; // End of |tok_start|.
397
398
@
399
@<Set init...@>=
400
401
@<Initialize |tok_ptr|, |tok_start|, and |text_ptr|@>@;
402
mx_tok_ptr=tok_ptr; mx_text_ptr=text_ptr;
403
404
@
405
@<Initialize |tok_ptr|...@>=
406
{
407
tok_ptr = tok_mem + 1;
408
tok_start[0] = tok_start[1] = tok_ptr;
409
text_ptr = tok_start + 1;
410
}
411
412
@ The |names_match| function is called from |id_lookup| in \.{common.web}
413
when deciding whether to put a name into the table.
414
415
@<Part 1@>=@[
416
417
boolean
418
names_match FCN((p,first,l,t))
419
name_pointer p C0("Points to the proposed match.")@;
420
CONST ASCII HUGE *first C0("Position of first character of string.")@;
421
int l C0("Length of identifier.")@;
422
eight_bits t C1("Desired ilk.")@;
423
{
424
if (length(p)!=l) return NO; /* Speedy return. */
425
426
if ( (p->Language&(boolean)language) && (p->ilk!=t) && !(t==normal &&
427
is_reserved(p)))
428
return NO;
429
430
return (boolean)(!STRNCMP(first,p->byte_start,l));
431
}
432
433
@ The following two functions are used in initializations; they are called
434
from \.{common.web}.
435
436
@<Part 1@>=@[
437
438
SRTN
439
ini_p FCN((p,t))
440
name_pointer p C0("")@;
441
eight_bits t C1("")@;
442
{
443
CONST ASCII HUGE *k;
444
445
p->ilk=t; p->xref = (XREF_POINTER)xmem;
446
447
/* Check if identifier is all upper-case. */
448
p->info.upper_case = NO;
449
450
for(k = p->byte_start; k<byte_ptr; k++)
451
if(isAlpha(*k) && !isAupper(*k))
452
return;
453
454
p->info.upper_case = YES;
455
}
456
457
SRTN ini_node FCN((node))
458
CONST name_pointer node C1("")@;
459
{
460
node->xref = (XREF_POINTER)xmem;
461
462
@<Initialize |mod_info| and |Language|@>@;
463
}
464
465
@i ccodes.hweb /* Category codes for the reserved words. */
466
467
@* LEXICAL SCANNING. Let us now consider the subroutines that read the
468
\.{WEB} source file and break it into meaningful units. There are four such
469
procedures: |skip_limbo| simply skips to the next `\.{@@\ }' or `\.{@@*}'
470
that begins a module; |skip_TeX| passes over the \TeX\ text at the
471
beginning of a module; |copy_comment| passes over the \TeX\ text in a \cee\
472
comment; and |get_next|, which is the most interesting, gets the next token
473
of a \cee\ text. They all use the pointers |limit| and |loc| into the line
474
of input currently being studied.
475
476
Control codes in \.{WEB}, which begin with~`\.{@@}', are converted into a
477
numeric code designed to simplify \WEAVE's logic; for example, larger
478
numbers are given to the control codes that denote more significant
479
milestones, and the code of |new_module| should be the largest of all. Some
480
of these numeric control codes take the place of ASCII control codes that
481
will not otherwise appear in the output of the scanning routines.
482
@^ASCII code@>
483
484
The following table shows the assignments:
485
$$\def\:{\char\count255\global\advance\count255 by 1}
486
\def\Hrule{\noalign{\hrule}}\def\HHrule{\noalign{\hrule height2pt}}
487
\def\Width{60pt}
488
\count255='40
489
\vbox{
490
\hbox{\hbox to \Width{\it\hfill0\/\hfill}%
491
\hbox to \Width{\it\hfill1\/\hfill}%
492
\hbox to \Width{\it\hfill2\/\hfill}%
493
\hbox to \Width{\it\hfill3\/\hfill}%
494
\hbox to \Width{\it\hfill4\/\hfill}%
495
\hbox to \Width{\it\hfill5\/\hfill}%
496
\hbox to \Width{\it\hfill6\/\hfill}%
497
\hbox to \Width{\it\hfill7\/\hfill}}
498
\vskip 4pt
499
\hrule
500
\def\!{\vrule height 10.5pt depth 4.5pt}
501
\halign{\hbox to 0pt{\hskip -24pt\WO{\~#}\hfill}&\!
502
\hbox to \Width{\hfill$#$\hfill\!}&
503
&\hbox to \Width{\hfill$#$\hfill\!}\cr
504
00&\\{ignore}&\WMM &\\{verbatim}&\\{force\_line}&\WW &** &\WCC &\\{bell}\cr\Hrule
505
01&\dots &\\{begin\_cmnt}&\\{lf} &\WPP &\\{ff} &\\{cr}
506
&\\{begin\_lang} &\\{cmpd\_assgn} \cr\Hrule
507
02&\WGG &\WLS &\WLL &\.{.DOT.}&; &\WSR &\WSlSl & \cr\Hrule
508
03&\\{stmt\_label}&\WMG &\WI &\WL &\WNN &\WG &\WS &\WV \cr\HHrule
509
04& &\WR & &\# & &\WMOD &\amp & \cr\Hrule
510
05& & &\ast &+ & &- & &/ \cr\Hrule
511
06& & & & & & & & \cr\Hrule
512
07& & & & &< &= &> &? \cr\Hrule
513
10&\Wcp &\Wcm &\Wcs &\Wcv &\Wcd &\Wcx &\Wca &\Wco \cr\Hrule
514
11&\Wcg &\Wcl & & & & & & \cr\Hrule
515
12& & & & & & & & \cr\Hrule
516
13& & & & & & &\^ & \cr\Hrule
517
14& & & & & & & & \cr\Hrule
518
15& & & & & & & & \cr\Hrule
519
16& & & & & & & & \cr\Hrule
520
17& & & & &\WOR &\.{@@\$}&\.{@@\_},\WTL&\\{param}\cr\HHrule
521
20&\.{L$l$}&\.{C} &\.{R} &\.{N} &\.{M} &\.{X} & & \cr\Hrule
522
21&\WNP &\WNC &\.{\#<}&\WPtr &\WCC & & &
523
\cr\Hrule
524
22& & & & & & & & \cr\Hrule
525
23&\\{constant}&\\{stringg}&\\{identifier}&\.{@@\^}&\.{@@9} &\.{@@.} &\.{@@t} &\.{@@'} \cr\Hrule
526
24&\.{@@\&}&\.{@@,} &\.{@@\char'174}&\.{@@/} &\.{@@\#} &\.{@@~} &\.{@@;}& \cr\Hrule
527
25&\.{@@(} &\.{@@)} &\.{\ } &\\{copy\_mode}&\\{toggle\_output}&\.{@@e}&\.{@@:}&
528
\cr\Hrule
529
26& & &\.{@@!} & & &\.{@@0} &\.{@@1} &\.{@@2} \cr\Hrule
530
27&\.{@@f} &\.{@@\%}& & &\.{@@l} &\.{@@o} &\.{@@d} &\.{@@m} \cr\Hrule
531
30&\.{@@\#ifdef}&\.{@@\#ifndef}&\.{@@\#if}&\.{@@\#else}&\.{@@\#elif}&\.{@@\#endif}
532
&\.{@@\#pragma} &\.{@@\#undef}\cr\Hrule
533
31&\.{@@a} &\.{@@<} &\.{@@\ }& & & & & \cr\Hrule
534
32& & & & & & & & \cr\Hrule
535
33& & & & & & & & \cr\Hrule
536
34& & & & & & & &
537
\cr\Hrule
538
35& & & & & & & &
539
\cr\Hrule
540
36& & & & & & & &
541
\cr\Hrule
542
37& & & & & & &\\{begin\_cmnt0}& \cr}
543
\hrule width 480pt}$$
544
545
546
@d ignore 0 // Control code of no interest to \WEAVE.
547
@d verbatim OCTAL(2) // Extended |ASCII| alpha will not appear.
548
@d force_line OCTAL(3) // Extended |ASCII| beta will not appear.
549
550
@d begin_comment0 HEX(FE) // Sent from |input_ln|.
551
@d begin_comment1 HEX(FD)
552
@d begin_comment OCTAL(11) // |ASCII| tab mark will not appear.
553
554
@d compound_assignment OCTAL(17) // Things like `\.{*=}'.
555
@% @d param OCTAL(177) // |ASCII| delete will not appear.
556
557
/* Language codes. */
558
@d L_switch OCTAL(200) // The generic language switch \.{@@L$l$}.
559
@d begin_C OCTAL(201)
560
@d begin_RATFOR OCTAL(202)
561
@d begin_FORTRAN OCTAL(203)
562
@d begin_LITERAL OCTAL(204)
563
@d begin_TEX OCTAL(205)
564
565
@d begin_nuweb OCTAL(206) // Strictly speaking, not a language code.
566
567
/* More two-byte combinations that couldn't be fitted below printable
568
|ASCII|. */
569
@d dont_expand OCTAL(210) // Control code for `\.{\#!}'.
570
@d auto_label OCTAL(211) // Control code for `\.{\#:}'.
571
@d all_variable_args OCTAL(212) // Control code for `\.{\#.}'.
572
@d macro_module_name OCTAL(213) // Control code for `\.{\#<\dots@@>}'.
573
@d eq_gt OCTAL(214) // Control code for `\.{=>}'.
574
@d colon_colon OCTAL(215) /* Control code for `\.{::}'. */
575
576
/* Control codes for \FWEB\ commands beginning with \.{@@}. */
577
578
/* The following two codes will be intercepted without confusion, because
579
they're processed immediately after an \.{@@}, not returned from
580
|next_control|. */
581
@d switch_math_flag OCTAL(175)
582
@d underline OCTAL(176)
583
584
@d next_expr OCTAL(226) // Control code for `\.{@@E}' */
585
@d next_reserved OCTAL(227) // Control code for `\.{@@R}' */
586
587
@d xref_roman OCTAL(233) /* control code for `\.{@@\^}' */
588
@d xref_wildcard OCTAL(234) /* control code for `\.{@@9}' */
589
@d xref_typewriter OCTAL(235) /* control code for `\.{@@.}' */
590
@d TeX_string OCTAL(236) /* control code for `\.{@@t}' */
591
@d ascii_constant OCTAL(237) /* control code for `\.{@@'}' */
592
@d join OCTAL(240) /* control code for `\.{@@\&}' */
593
@d thin_space OCTAL(241) /* control code for `\.{@@,}' */
594
@d math_break OCTAL(242) /* control code for `\.{@@\char'174}' */
595
@d line_break OCTAL(243) /* control code for `\.{@@/}' */
596
@d ln_break_outdent OCTAL(244) // Control code for `\.{@@\\}'.
597
598
@d big_line_break OCTAL(245) /* control code for `\.{@@\#}' */
599
@d no_line_break OCTAL(246) /* control code for `\.{@@~}' */
600
@d pseudo_semi OCTAL(247) /* control code for `\.{@@;}' */
601
@d defd_at OCTAL(250) // Control code for `\.['.
602
603
@d begin_meta OCTAL(251) /* Control code for |"@@("|. */
604
@d end_meta OCTAL(252) /* Control code for |"@@)"|. */
605
606
@d macro_space OCTAL(253) /* Space token during preprocessing. */
607
@d copy_mode OCTAL(254) /* Are we copying comments? */
608
609
@d toggle_output OCTAL(255) // Turns on and off Weave's output.
610
@d turn_output_on OCTAL(255) // Appended to the scraps for code.
611
@d turn_output_off OCTAL(256)
612
@d Turn_output_on OCTAL(257)
613
@d Turn_output_off OCTAL(260)
614
615
@d left_preproc OCTAL(261) // Begins a preprocessor command.
616
@d right_preproc OCTAL(262) // Ends a preprocessor command.
617
618
@d Cont_Char OCTAL(263) // Represents continuation char.\ during preprocessing.
619
620
@d Compiler_Directive OCTAL(264) /* Control code for `\.{@@?}' */
621
@d new_output_file OCTAL(265) // Control code for `\.{@@o}'.
622
623
@d implicit_reserved OCTAL(266) // Control code for `\.{@@]}'.
624
625
@d trace OCTAL(267) /* control code for `\.{@@0}', `\.{@@1}', and `\.{@@2}' */
626
627
/* 270 and 271 are related to |trace| above and are introduced implicitly. */
628
629
@d invisible_cmnt OCTAL(272) /* Control code for `\.{@@\%}' */
630
631
@d pseudo_expr OCTAL(273) /* Control code for `\.{@@e}' */
632
@d pseudo_colon OCTAL(274) /* Control code for `\.{@@:}' */
633
634
@d begin_bp OCTAL(275) // Control code for `\.{@@B}'.
635
@d insert_bp OCTAL(276) // Control code for `\.{@@b}'.
636
637
@d no_index OCTAL(277) // Control code for `\.{@@-}'.
638
@d yes_index OCTAL(300) // Control code for `\.{@@~}'.
639
640
@d no_mac_expand OCTAL(301) // Control code for `\.{@@!}'.
641
@d protect_code OCTAL(302) // Control code for `\.{@@p}'.
642
@d set_line_info OCTAL(303) // Control code for `\.{@@q}'.
643
644
@d short_fcn OCTAL(304) // Control code for `\.{@@\lb}'.
645
@d keyword_name OCTAL(305) // Control code for `\.{@@k}'.
646
647
/* Definition section begun by codes $\ge$~|formatt|. */
648
@d formatt OCTAL(310) /* control code for `\.{@@f}' */
649
650
@d limbo_text OCTAL(313) /* Control code for `\.{@@l}' */
651
@d op_def OCTAL(314) /* Control code for `\.{@@v}' */
652
@d macro_def OCTAL(315) // Control code for `\.{@@w}'.
653
654
@d definition OCTAL(320) /* control code for `\.{@@d}' */
655
@d undefinition OCTAL(321) // Control code for `\.{@@u}'.
656
@d WEB_definition OCTAL(322) /* Control code for `\.{@@M}' */
657
658
/* --- Preprocessor commands --- */
659
@d m_ifdef OCTAL(330)
660
@d m_ifndef OCTAL(331)
661
@d m_if OCTAL(332)
662
@d m_else OCTAL(333)
663
@d m_elif OCTAL(334)
664
@d m_endif OCTAL(335)
665
@d m_for OCTAL(336)
666
@d m_endfor OCTAL(337)
667
@d m_line OCTAL(340)
668
@d m_undef OCTAL(341)
669
670
/* --- Module names --- */
671
@d begin_code OCTAL(350) /* control code for `\.{@@a}' */
672
@d module_name OCTAL(351) /* control code for `\.{@@<}' */
673
674
/* --- Beginning of new module --- */
675
@d new_module OCTAL(352) /* control code for `\.{@@\ }' and `\.{@@*}' */
676
677
/* For more tokens beginning with |OCTAL(360)|, see \.{output.web}. */
678
679
@ Control codes are converted from ASCII to \WEAVE's internal
680
representation by means of the table |ccode|. Codes that are used only by
681
\FTANGLE\ get the special code~|ignore| (see \.{typedefs.hweb}; these are
682
just skipped. Codes that are used by neither processor are initialized
683
to~|'0xFF'|; that can be used to trigger an error message.
684
685
@<Global...@>=
686
687
IN_STYLE eight_bits ccode[128];
688
/* Meaning of an |ASCII| char following '\.{@@}'. */
689
690
@ The control codes are set up in \.{style.web}.
691
692
@m TANGLE_ONLY(d,c) INI_CCODE(d,USED_BY_OTHER)
693
@m WEAVE_ONLY(d,c) INI_CCODE(d,c)
694
695
@<Set ini...@>=
696
697
zero_ccodes(); // See \.{style.web}.
698
ccode[@'/'] = line_break; /* The commenting style is also fundamental, and
699
for technical convenience the \.{@@/} command is also inviolate. */
700
701
@<Set the changable codes@>@;
702
prn_codes();
703
704
@ Here are the default values for the things that are allowed to be
705
changed.
706
@<Set the changable...@>=
707
{
708
SAME_CCODE(" \t*", new_module); // Either space, tab, or asterisk.
709
710
SAME_CCODE("aA", begin_code);
711
SAME_CCODE("<", module_name);
712
713
SAME_CCODE("dD", definition);
714
SAME_CCODE("uU", undefinition);
715
SAME_CCODE("mM", WEB_definition);
716
SAME_CCODE("fF", formatt);
717
718
WEAVE_ONLY("\001", toggle_output); // This command is for internal use only!
719
720
SAME_CCODE("'\"", ascii_constant);
721
REASSIGNABLE("=", verbatim);
722
WEAVE_ONLY("\\", ln_break_outdent);
723
724
REASSIGNABLE("tT", TeX_string);
725
726
SAME_CCODE("L", L_switch);
727
SAME_CCODE("c", begin_C);
728
SAME_CCODE("r", begin_RATFOR);
729
SAME_CCODE("n", begin_FORTRAN);
730
SAME_CCODE("N", begin_nuweb);
731
SAME_CCODE("x", begin_TEX);
732
733
SAME_CCODE("&", join);
734
WEAVE_ONLY("_", underline);
735
WEAVE_ONLY("[", defd_at);
736
WEAVE_ONLY("`]", implicit_reserved);
737
738
SAME_CCODE("%", invisible_cmnt);
739
SAME_CCODE("?", Compiler_Directive);
740
SAME_CCODE("{", short_fcn);
741
SAME_CCODE("kK", keyword_name);
742
743
WEAVE_ONLY("$", switch_math_flag);
744
745
WEAVE_ONLY("E", next_expr);
746
WEAVE_ONLY("R", next_reserved);
747
748
REASSIGNABLE("^", xref_roman);
749
REASSIGNABLE(".", xref_typewriter);
750
REASSIGNABLE("9", xref_wildcard);
751
752
{
753
char temp[3];
754
755
sprintf(temp, ";%c", XCHR(interior_semi));
756
WEAVE_ONLY(temp, pseudo_semi);
757
}
758
759
WEAVE_ONLY("e", pseudo_expr);
760
WEAVE_ONLY(":", pseudo_colon);
761
762
SAME_CCODE("l", limbo_text);
763
SAME_CCODE("vV", op_def);
764
SAME_CCODE("wW", macro_def);
765
766
WEAVE_ONLY(",", thin_space);
767
WEAVE_ONLY("|", math_break);
768
SAME_CCODE("#", big_line_break);
769
WEAVE_ONLY("~", no_line_break);
770
771
SAME_CCODE("(", begin_meta);
772
SAME_CCODE(")", end_meta);
773
774
SAME_CCODE("oO", new_output_file);
775
776
SAME_CCODE("B", begin_bp);
777
TANGLE_ONLY("}b", insert_bp);
778
SAME_CCODE("!", no_mac_expand);
779
TANGLE_ONLY("q", set_line_info);
780
781
WEAVE_ONLY("-", no_index);
782
WEAVE_ONLY("+", yes_index);
783
784
WEAVE_ONLY("p", protect_code);
785
786
@<Special control codes allowed only when debugging@>@;
787
}
788
789
@ If \WEAVE\ is compiled with debugging commands, one can write~\.{@@2},
790
\.{@@1}, and~\.{@@0} to turn tracing fully on, partly on, and off,
791
respectively.
792
@<Special control codes...@>=
793
794
#if(DEBUG)
795
WEAVE_ONLY("012",trace);
796
#endif /* |DEBUG| */
797
798
@ At this point |loc|~is positioned after a language command like~\.{@@c},
799
or on the~$l$ in~\.{@@L$l$}.
800
801
@f @<Cases to set |language| and |break|@> case
802
803
@<Cases to set |language| and |break|@>=
804
805
@<Specific language cases@>:
806
loc--; /* Position to letter after \.{@@}. Falls
807
through to general case |L_switch|. */
808
809
case L_switch:
810
@<Set the |language| and maybe kill rest of line@>@;
811
break;
812
813
case begin_nuweb:
814
nuweb_mode = !NUWEB_MODE;
815
816
if(module_count == 0)
817
global_params = params;
818
break;
819
820
@
821
@<Set the |language| and maybe kill...@>=
822
{
823
@<Set |language|@>@;
824
825
if(module_count == 0)
826
global_params = params;
827
828
ini0_language();
829
@<Kill rest of line; no |auto_semi|@>@;
830
}
831
832
@ The |skip_limbo| routine is used on the first pass to skip through
833
portions of the input that are not in any modules, i.e., that precede the
834
first module. Language commands may be encountered at any time; these reset
835
the current language from whatever was specified on the command line. When
836
the first module is found, the global language is set to the current
837
language.
838
839
After this procedure has been called, the value of |input_has_ended| will
840
tell whether or not a module has actually been found.
841
842
@<Part 1@>=@[
843
844
SRTN
845
skip_limbo(VOID)
846
{
847
WHILE()
848
{
849
if (loc > limit && !get_line())
850
return;
851
852
*(limit+1) = @'@@'; // Guard character.
853
854
/* Look for '@@', then skip two chars. */
855
while (*loc != @'@@')
856
loc++;
857
858
/* |loc| now on the \.{@@}. */
859
if(loc++ <= limit)
860
switch(ccode[*loc++])
861
{ /* Process any language change
862
commands; skip any other @@~commands. */
863
@<Cases to set |language| and |break|@>@:@;
864
865
case invisible_cmnt:
866
loc = limit + 1;
867
break;
868
869
case new_module:
870
return; // End of limbo section.
871
}
872
873
@#if(0) // Old code.
874
if (loc <=limit) if (ccode[*loc++]==new_module) return;
875
@#endif
876
}
877
}
878
879
@ The |skip_TeX| routine is used on the first pass to skip through the
880
\TeX\ code at the beginning of a module. It returns the next control code
881
or~`\v' found in the input. A |new_module| is assumed to exist at the very
882
end of the file.
883
884
@<Part 1@>=@[
885
886
eight_bits
887
skip_TeX(VOID)
888
{
889
WHILE()
890
{
891
if (loc>limit && !get_line())
892
return new_module;
893
894
*(limit+1)=@'@@'; // Marker to curtail the scan.
895
896
while (*loc!=@'@@' && *loc!=@'|')
897
loc++;
898
899
if (*loc++ ==@'|')
900
return @'|'; // Have hit beginning of code mode.
901
902
if (loc<=limit)
903
{
904
SET_CASE(*loc);
905
return ccode[*(loc++)];
906
}
907
}
908
909
DUMMY_RETURN(0);
910
}
911
912
@* INPUTTING the NEXT TOKEN.
913
As stated above, \.{WEAVE}'s most interesting lexical scanning routine is the
914
|get_next| function that inputs the next token of \cee\ input. However,
915
|get_next| is not especially complicated.
916
917
The result of |get_next| is either an ASCII code for some special
918
character, or it is a special code representing a pair of characters (e.g.,
919
`\.{!=}'), or it is the numeric value computed by the |ccode| table, or it
920
is one of the following special codes:
921
922
\yskip\hang |identifier|: In this case the global variables |id_first| and
923
|id_loc| will have been set to the beginning and ending-plus-one locations
924
in the buffer, as required by the |id_lookup| routine.
925
926
\yskip\hang |string|: The string will have been copied into the array
927
|mod_text|; |id_first| and |id_loc| are set as above (now they are
928
pointers into |mod_text|).
929
930
\yskip\hang |constant|: The constant is copied into |mod_text|, with slight
931
modifications; |id_first| and |id_loc| are set.
932
933
\yskip\noindent Furthermore, some of the control codes cause |get_next| to
934
take additional actions:
935
936
\yskip\hang |xref_roman|, |xref_wildcard|, |xref_typewriter|, |TeX_string|,
937
|verbatim|: The values of |id_first| and |id_loc| will have been set to the
938
beginning and ending-plus-one locations in the buffer.
939
940
941
\yskip\hang |module_name|: In this case the global variable |cur_module| will
942
point to the |byte_start| entry for the module name that has just been scanned.
943
944
\yskip\noindent If |get_next| sees `\.{@@\_}' it sets |xref_switch| to
945
|def_flag| and goes on to the next token.
946
947
\yskip\noindent If |get_next| sees `\.{@@\$}' it sets |math_flag| to
948
|!math_flag| and goes on to the next token.
949
950
@d constant OCTAL(230) /* \cee\ string or \.{WEB} precomputed string */
951
@d stringg OCTAL(231) /* \cee\ string or \.{WEB} precomputed string */
952
@d identifier OCTAL(232) /* \cee\ identifier or reserved word */
953
954
@<Global...@>=
955
956
EXTERN name_pointer cur_module; // Name of module just scanned.
957
EXTERN int math_flag SET(NO);
958
EXTERN boolean chk_end SET(YES); // Do we check for end of line?
959
EXTERN boolean last_was_cmnt SET(NO); /* Helps with interchanging
960
semicolons and comments. */
961
EXTERN boolean lst_ampersand SET(NO); /* For continuations in
962
free-form syntax \Fortran-90. */
963
EXTERN boolean eat_blank_lines SET(NO); // For Nuweb mode.
964
EXTERN boolean just_inserted SET(NO); // For inserting extra token by |get_next|.
965
EXTERN boolean empty_line SET(NO); // Status of last line read.
966
967
EXTERN ASCII c; // The current character for |get_next|.
968
969
@ As one might expect, |get_next| consists mostly of a big switch that
970
branches to the various special cases that can arise. This function has
971
been broken into multiple function calls to |prs_TeX_code| and
972
|prs_regular_code| in order to make it fit on personal computers.
973
974
@<Part 1@>=@[
975
976
eight_bits
977
get_next(VOID) /* produces the next input token */
978
{
979
boolean terminate = NO;
980
char terminator[2];
981
GOTO_CODE pcode; // Return from the parsing functions. 0~means |continue|.
982
983
WHILE()
984
{
985
@<Check if we're at the id part of a preprocessor command@>;
986
@<Check if we're at the end of a preprocessor command@>;
987
988
chk_end = YES;
989
990
@<Get another line of input if necessary@>@;
991
@<Get next character; skip blanks and tabs@>@;
992
993
/* Handle an (effectively) empty line. (Don't move this statement upwards.) */
994
if(limit == cur_buffer || (at_beginning && loc > limit))
995
{
996
empty_line = YES;
997
return big_line_break;
998
}
999
1000
switch(language)
1001
{
1002
case TEX:
1003
if((pcode=prs_TeX_code()) == MORE_PARSE)
1004
break;
1005
else if((int)pcode < 0)
1006
CONFUSION("prs_TEX_code", "Negative pcode %i", pcode);
1007
else
1008
goto found_something;
1009
1010
default:
1011
if((pcode=prs_regular_code(MORE_PARSE)) == MORE_PARSE)
1012
break;
1013
else if((int)pcode < 0)
1014
CONFUSION("prs_regular_code",
1015
"Negative pcode %i", pcode);
1016
else
1017
goto found_something;
1018
}
1019
}
1020
1021
found_something:
1022
/* We need the following stuff to handle the |INNER| parsing mode properly.
1023
(|at_beginning| doesn't correspond to physical beginning of line, so can't
1024
be reset by |get_line()|.) */
1025
if(!preprocessing)
1026
switch((eight_bits)pcode)
1027
{
1028
case begin_language:
1029
break;
1030
1031
default:
1032
at_beginning = NO;
1033
break;
1034
}
1035
1036
return (eight_bits)pcode;
1037
}
1038
1039
@ Get another line of input if necessary. We raise the special flag
1040
|at_beginning| to help us with statement labels and preprocessor commands.
1041
Normally this flag is set when we get a new line. However, it must also be
1042
set after we enter code mode by encountering vertical bars.
1043
1044
@<Get another line...@>=
1045
{
1046
if (loc>limit)
1047
{
1048
if(terminate)
1049
{
1050
terminator[0] = *limit; terminator[1] = *(limit+1);
1051
}
1052
1053
@<Insert a semicolon at end of free-format \Fortran-90 line @>@;
1054
1055
empty_line = NO;
1056
1057
if(!get_line())
1058
return new_module; // End of file.
1059
1060
if(eat_blank_lines)
1061
{ /* Avoid empty stuff at end of module in Nuweb mode. */
1062
@<Skip blank lines@>@;
1063
eat_blank_lines = NO;
1064
}
1065
1066
if(parsing_mode == OUTER)
1067
at_beginning = YES; // Start of new line.
1068
1069
if(terminate)
1070
{
1071
*limit = terminator[0]; *(limit+1) = terminator[1];
1072
terminate = NO;
1073
}
1074
}
1075
else if(parsing_mode == OUTER)
1076
at_beginning = NO;
1077
}
1078
1079
@ Doing auto-semi insertion for free-format \Fortran-90 turns out to be
1080
surprisingly easy. Fundamentally, the end-of-line wants a semicolon. If
1081
the line ends while scanning a long comment, the comment is absorbed by
1082
other code, not the |get_line| immediately following this segment. Both
1083
long and short comments become an |ignore| scrap, so can be followed by the
1084
pseudo-semi at the end of the line terminating the comment.
1085
1086
@<Insert a semi...@>=
1087
{
1088
if(just_inserted)
1089
just_inserted = NO;
1090
else
1091
{
1092
if(free_Fortran && auto_semi && !empty_line && the_part==CODE)
1093
{
1094
just_inserted = YES;
1095
return auto_pseudo_semis ? ccode[@';'] : @';';
1096
/* Insert pseudo-semi or semicolon at eol. */
1097
}
1098
}
1099
}
1100
1101
@ In Nuweb mode, blank lines at the end of the module are significant,
1102
unless `\.{@@\%\%}' is used. That turns on |eat_blank_lines|.
1103
1104
@<Skip blank lines@>=
1105
{
1106
while(loc >= limit)
1107
if(!get_line())
1108
{
1109
eat_blank_lines = NO;
1110
return new_module;
1111
}
1112
}
1113
1114
@ Here we obtain the next character, advancing~|loc| in the process.
1115
Depending on the situation, we also skip blanks and tabs.
1116
1117
@<Get next char...@>=
1118
1119
if(preprocessing)
1120
@<Compress string of blanks into one; if any found, return
1121
|macro_space|@>@;
1122
else
1123
@<Skip white space at beginning of line@>@;
1124
1125
if(c==cont_char && loc==limit)
1126
{
1127
if(preprocessing || free_Fortran)
1128
loc--; /* IFFY */
1129
else
1130
loc++;
1131
1132
terminate = YES;
1133
continue;
1134
}
1135
1136
@
1137
@<Compress string of blanks...@>=
1138
{
1139
do
1140
{
1141
if((c=*loc++) != @' ' || c != tab_mark)
1142
break;
1143
}
1144
while(loc < limit);
1145
1146
if(c==@' ' || c==tab_mark)
1147
return macro_space;
1148
}
1149
1150
@
1151
@<Skip white space at beg...@>=
1152
{
1153
if(language==TEX)
1154
c = *loc++;
1155
else
1156
{
1157
ASCII HUGE *loc0 = loc; // Remember starting point for nuweb mode.
1158
1159
do
1160
{ /* Skip beginning white space. */
1161
c = *loc++;
1162
}
1163
while(loc<=limit && (c==@' ' || c==tab_mark) );
1164
1165
if(nuweb_mode)
1166
{
1167
if(!(c == @'@@' && *loc == @'#'))
1168
{ /* Go back to beginning. */
1169
loc = loc0;
1170
c = *loc++;
1171
if(phase == 1 && c == tab_mark)
1172
c = @' ';
1173
}
1174
}
1175
}
1176
}
1177
1178
1179
@ \TeX\ syntax differs significantly from that of the other languages.
1180
First of all, \TeX\ comments (beginning with~'\.\%') are always short. Next,
1181
in phase~1, we must look at the text identifier by identifier in order to make
1182
cross-references properly. In phase~2, however, we can absorb whole
1183
collections of identifiers, until a comment or control code comes along.
1184
1185
In order to deal with changing category codes, we translate letters through
1186
the array~|TeX|, which contains the most up-to-date category codes.
1187
1188
@<Part 1@>=@[
1189
GOTO_CODE
1190
prs_TeX_code(VOID)
1191
{
1192
GOTO_CODE icode; // Return code from |get_control_code|.
1193
1194
if(loc>limit)
1195
return @';';
1196
1197
if (c==@'@@')
1198
{ // The next call takes care of a branch to |mistake|.
1199
if((icode=get_control_code()) == GOTO_MISTAKE)
1200
return prs_regular_code(GOTO_MISTAKE);
1201
else
1202
return icode;
1203
}
1204
else if(TeX[c] == TeX_comment)
1205
{
1206
long_comment = YES; // Since we may concatenate lines.
1207
return begin_comment;
1208
}
1209
else if(c == @'|' && parsing_mode == INNER)
1210
return @'|';
1211
else
1212
if(phase==1)
1213
{
1214
if(TeX[c] == TeX_escape)
1215
@<Get \TeX\ identifier@>@;
1216
else
1217
return MORE_PARSE;
1218
}
1219
else
1220
@<Get \TeX\ string@>@;
1221
1222
@% return MORE_PARSE; // This means to continue to top of |get_next|.
1223
}
1224
1225
@ If the identifier doesn't begin with a letter, it's a single-character
1226
macro such as~`\.{\\<}'.
1227
1228
@<Get \TeX\ identifier@>=
1229
{
1230
id_first = id_loc = mod_text + 1;
1231
1232
*id_loc++ = *(loc-1); // The beginning backslash.
1233
1234
if(TeX[*loc] != TeX_letter)
1235
{ /* Single-character macro, such as~`\.{\\<}'. */
1236
if(*loc == @'@@')
1237
{
1238
if(*(loc+1) != @'@@') ERR_PRINT(W,"You should say `\\@@@@'");
1239
else loc++;
1240
}
1241
*id_loc++ = *loc++; // The single character.
1242
}
1243
else while(TeX[*loc] == TeX_letter)
1244
{ /* Scan over the macro name. */
1245
if(*loc == @'@@')
1246
{
1247
if(*(loc+1) != @'@@') ERR_PRINT(W,"You should say `@@@@'");
1248
else loc++;
1249
}
1250
*id_loc++ = *loc++;
1251
}
1252
1253
return identifier;
1254
}
1255
1256
@ \TeX\ strings are everything on a single line, up to a comment or, if
1257
we're inside vertical bars, up to a terminating bar. It looks nicer if we
1258
leave spaces alone instead of displaying them as~`\.{\ }'.
1259
1260
@d ordinary_space 01 /* Inserted after ctrl sequences, to avoid many
1261
visible spcs. */
1262
1263
@<Get \TeX\ string@>=
1264
{
1265
loc--;
1266
id_first = id_loc = mod_text + 1;
1267
1268
while(loc < limit)
1269
{
1270
if(*loc == @'@@')
1271
if(*(loc+1)==@'@@') *id_loc++ = *loc++;
1272
else break; // Scan ended by control code.
1273
1274
if(TeX[*loc] == TeX_comment) break;
1275
if(*loc==@'|' && parsing_mode==INNER) break; // End of internal mode.
1276
1277
if(TeX[*loc] == TeX_escape)
1278
{
1279
if(TeX[*(loc+1)] != TeX_letter)
1280
{ // One-character control sequence.
1281
if(*(loc+1) == @'@@')
1282
if(*(loc+2) != @'@@')
1283
ERR_PRINT(W,"You should say \\@@@@");
1284
else *id_loc++ = *loc++;
1285
1286
*id_loc++ = *loc++;
1287
}
1288
else
1289
{ // Ordinary control sequence.
1290
do
1291
*id_loc++ = *loc++;
1292
while (TeX[*loc] == TeX_letter);
1293
1294
while (loc < limit)
1295
{
1296
if(TeX[*loc] != TeX_space) break;
1297
1298
*id_loc++ = ordinary_space;
1299
loc++;
1300
}
1301
1302
continue;
1303
}
1304
}
1305
1306
*id_loc++ = *loc++;
1307
}
1308
1309
return stringg;
1310
}
1311
1312
@ Parse everything but \TeX.
1313
@<Part 1@>=@[
1314
1315
GOTO_CODE
1316
prs_regular_code FCN((iswitch))
1317
GOTO_CODE iswitch C1("")@;
1318
{
1319
GOTO_CODE icode; // Return code from |get_control_code|.
1320
1321
switch(iswitch)
1322
{
1323
case GOTO_MISTAKE: goto mistake;
1324
case GOTO_GET_IDENTIFIER: goto get_identifier;
1325
default: break;
1326
}
1327
1328
/* --- ELLIPSIS: `\.{...}' --- */
1329
if(c==@'.' && *loc==@'.' && *(loc+1)==@'.')
1330
{
1331
++loc;
1332
compress(ellipsis);
1333
}
1334
1335
/* --- DOT CONSTANT: `\.{.FALSE.}' --- */
1336
else if(FORTRAN_LIKE(language) && dot_constants &&
1337
(c == wt_style.dot_delimiter.begin) && !isDigit(*loc))
1338
@<Get a dot constant@>@;
1339
1340
/* --- CONSTANT: `\.{123}', `\.{.1}', or `\.{\\135}' --- */
1341
else if (isDigit(c) || c==@'\\' || c==@'.' || (upcoming_kind && c==@'_'))
1342
@<Get a constant@>@;
1343
1344
/* --- BOZ-CONSTANT --- */
1345
else if (in_data && Fortran88 && (*loc==@'"' || *loc==@'\'') &&
1346
(c==@'B' || c==@'O' || c==@'Z') )
1347
return get_string(*loc++,c);
1348
1349
/* --- IDENTIFIER --- */
1350
else if (is_identifier(c))
1351
@<Get an identifier@>@;
1352
1353
/* --- STRING: `\.{"abc"}', `\.{'\\n'}', `\.{<file\_name>}' --- */
1354
else if (c==@'\'' || c==@'"'
1355
|| (sharp_include_line && !in_comment &&
1356
(c==@'(' || (C_LIKE(language) && c==@'<') ) ))
1357
return get_string(c,'\0');
1358
1359
/* --- CONTROL CODE --- */
1360
else if (c==@'@@')
1361
{
1362
if((icode=get_control_code()) == GOTO_MISTAKE)
1363
goto mistake;
1364
else
1365
return icode;
1366
}
1367
1368
/* --- WHITE SPACE --- */
1369
/* Blanks were skipped above. */
1370
else if (c==@' ' || c==tab_mark)
1371
@#if(0)
1372
if(preprocessing) /* What is this statement for? */
1373
{
1374
id_first = mod_text + 1;
1375
id_loc = id_first + 1;
1376
*id_first = c;
1377
return stringg;
1378
}
1379
else /* JAK to here */
1380
@#endif
1381
if(nuweb_mode)
1382
return c; @%(c==tab_mark ? bell : c);
1383
else
1384
return MORE_PARSE; // Ignore spaces and tabs; continue.
1385
1386
/* --- C PREPROCESSOR STATEMENT: `\.{\#include}' --- */
1387
if (c==@'#' && at_beginning && C_LIKE(language))
1388
@<Raise preprocessor flag@>@;
1389
/* If |'#'| is first character in line, it's a C~preprocessor statement. */
1390
1391
/* --- END A |@r format| STATEMENT: `\.{format(\dots);}' --- */
1392
else if (in_format && c==@';')
1393
{ /* End a |@r format| statement. */
1394
in_format = NO;
1395
return end_format_stmt;
1396
}
1397
1398
/* --- TWO-SYMBOL OPERATOR --- */
1399
mistake: @<Compress two-symbol operator@>@;
1400
return (eight_bits)c;
1401
}
1402
1403
@ For FORTRAN, we allow ``dot constants'', like ~\.{.true.}\ or~\.{.or.}.
1404
This routine scans between the dots, then looks up the identifier in a
1405
table to see if it's valid and to get its token translation. This procedure
1406
has a tendency to run away if an unexpected dot finds its way into the
1407
input (either because of a syntactical mistake, or because \Weave\ is
1408
missing the relevant rule). Thus, we limit the search to no more than
1409
|MAX_DOT_LENGTH == 31| characters, the maximum possible length of a dot
1410
constant.
1411
1412
@<Get a dot constant@>=
1413
@B
1414
ASCII HUGE *p0;
1415
int n;
1416
int dcode;
1417
ASCII dot_end = wt_style.dot_delimiter.end;
1418
1419
@b
1420
/* At this point, |loc| is positioned to the first position after the dot. */
1421
for(p0=loc, n=0; n<MAX_DOT_LENGTH; n++,loc++)
1422
if(*loc == dot_end || !isAlpha(*loc))
1423
break; // Found end of dot constant, or something not allowed.
1424
1425
if(*loc != dot_end)
1426
{/* Didn't find end. */
1427
loc = p0; // Reset position back to beginning.
1428
goto mistake;
1429
}
1430
1431
if((dcode=dot_code(dots,uppercase(p0,n),loc,dot_const)) != 0)
1432
{
1433
if(Fortran88)
1434
upcoming_kind = BOOLEAN(loc[1] == @'_');
1435
1436
compress(dcode); // Search for match in table.
1437
}
1438
1439
/* Invalid dot constant. */
1440
loc = p0;
1441
goto mistake;
1442
}
1443
1444
@ Because preprocessor commands do not fit in with the rest of the syntax
1445
of C, we have to deal with them separately. One solution [Levy] is to enclose
1446
such commands between special markers. Thus, when a~'\.\#' is seen as the
1447
first character of a line, |get_next| returns a special code
1448
\\{left\_preproc} and raises a flag |preprocessing|.
1449
1450
(Unfortunately, Levy's solution didn't work in certain situations, and when
1451
the preprocessor language was installed a different method was adopted.
1452
Thus, parts of the code are asymmetrical. This should eventually be
1453
improved, but it was considered more important to make it work at all.)
1454
1455
@
1456
@<Raise prep...@>=
1457
@B
1458
IN_COMMON ASCII HUGE *pinclude, HUGE *ppragma;
1459
/* Strings for tokens |include| and |pragma|. */
1460
1461
@b
1462
preprocessing = YES;
1463
@<Check if next token is |include| or |pragma|@>;
1464
return left_preproc;
1465
}
1466
1467
@ An additional complication is the freakish use of~'\.<' and~'\.>' to delimit
1468
a file name in lines that start with \&{\#include}. We must treat this file
1469
name as a string, and use the flag |sharp_include_line| to help.
1470
1471
Also, |#pragma|s can have arbitrary syntax, so we don't want to typeset it
1472
as usual. For those, we set |sharp_pragma_line|. (Not yet used for anything.)
1473
1474
@<Check if next token is |include|...@>=
1475
{
1476
/* According to ANSI, white space may be skipped at beginning of line. */
1477
while (*loc==@' ' || *loc==@'\t')
1478
loc++;
1479
1480
if(STRNCMP(loc, pinclude, 7)==0)
1481
sharp_include_line = YES;
1482
else if(STRNCMP(loc, ppragma, 7) == 0)
1483
sharp_pragma_line = YES;
1484
}
1485
1486
@ Since the preprocessor has different reserved words than C~itself, we
1487
include the preprocessor token with the identifier if it's first on a
1488
preprocessor line.
1489
1490
@<Check if we're at the id...@>=
1491
{
1492
if(preprocessing && at_beginning)
1493
{
1494
at_beginning = NO;
1495
1496
/* Preprocessor directives can have white space between the '\.\#' and the
1497
name. */
1498
for( ; loc < limit; loc++)
1499
if(!(*loc==@' ' || *loc==tab_mark))
1500
break;
1501
1502
*(loc-1) = @'#'; /* Now we're positioned on an identifier beginning
1503
with~|'#'|, with no intervening blanks. */
1504
1505
return (eight_bits)prs_regular_code(GOTO_GET_IDENTIFIER);
1506
}
1507
}
1508
1509
@ When we get to the end of a preprocessor line, we lower the flag and send
1510
a code \\{right\_preproc}, unless the last character was the continuation
1511
character'~\.\\'.
1512
1513
@<Check if we're at the end...@>=
1514
1515
chk_the_end:
1516
if(chk_end)
1517
{
1518
/* Continue to next line; also (for \Fortran) skip all lines that have
1519
continuation character in column~1. */
1520
while (*loc==cont_char && loc==limit-1 && (preprocessing || free_Fortran))
1521
if (!get_line())
1522
return new_module; // Still in preprocessor mode.
1523
else if(preprocessing)
1524
return Cont_Char; /* For C, ensure that the escape character is
1525
printed and a new line is begun. */
1526
1527
/* Now we've gotten to the end of line, but it's not continued. */
1528
if (loc>=limit)
1529
if(preprocessing)
1530
{
1531
chk_end=preprocessing=sharp_include_line=sharp_pragma_line=NO;
1532
return right_preproc;
1533
}
1534
else if(Fortran88
1535
&& parsing_mode == OUTER
1536
&& (auto_semi && !free_Fortran) && (limit > cur_buffer)
1537
&& !(limit[0] == @'@@' && limit[1] == @'m'))
1538
{
1539
loc = limit + 1;
1540
chk_end = NO;
1541
if(last_was_cmnt)
1542
{ // Comment has already been appended.
1543
last_was_cmnt = NO;
1544
if(lst_ampersand)
1545
{ // Deal with continuation before comment.
1546
lst_ampersand = NO;
1547
chk_end = YES;
1548
if(!get_line())
1549
{
1550
ERR_PRINT(W,"Section ended in middle of Fortran-90 continuation");
1551
return new_module;
1552
}
1553
APP_STR("\\indent");
1554
goto chk_the_end;
1555
}
1556
continue;
1557
}
1558
@% else return @'\n'; // or @';' ??? or nothing???
1559
}
1560
}
1561
1562
@ The following code assigns values to the combinations~\.{++}, \.{--},
1563
\.{->}, \.{>=}, \.{<=}, \.{==}, \.{<<}, \.{>>}, \.{!=}, and~\.{\&\&}. (For
1564
FORTRAN, we also have~\.{//} and~\.{\^}.) The compound assignment
1565
operators in~C are indexed, all under the aegis of |compound_assignment|.
1566
1567
@d compress(c) if (loc++<=limit) return (eight_bits)c@;
1568
1569
@d COMPOUND(c,n) if(loc <= limit) {loc += n; assignment_token=c;
1570
return (eight_bits)compound_assignment;}
1571
1572
@d CA_START OCTAL(100) /* The index into |op| is |CA_START + assignment_token|,
1573
where |assignment_token| is one of the following. See |valid_op()| for
1574
further details. */
1575
@d plus_eq 0
1576
@d minus_eq 01
1577
@d star_eq 02
1578
@d slash_eq 03
1579
@d mod_eq 04
1580
@d xor_eq 05
1581
@d and_eq 06
1582
@d or_eq 07
1583
@d gt_gt_eq 010
1584
@d lt_lt_eq 011
1585
@d or_or_or 012
1586
1587
@<Glob...@>=
1588
1589
EXTERN eight_bits assignment_token; /* The particular one of the above
1590
compound assignment tokens. */
1591
1592
@
1593
@<Compress two...@>=
1594
1595
switch(c)
1596
{
1597
case (ASCII)begin_comment0:// Comment sent from FORTRAN or Ratfor |input_ln|.
1598
long_comment = YES;
1599
return begin_comment;
1600
1601
case (ASCII)begin_comment1: // As above, but short comment.
1602
long_comment = NO;
1603
return begin_comment;
1604
1605
case @'\\':
1606
if(*loc==@'/' && !in_format && FORTRAN_LIKE(language))
1607
{
1608
compress(slash_slash); // `\.{\\/}' $\to$ `|@r \/|'.
1609
}
1610
break;
1611
1612
case @'/':
1613
@<Cases for \.{\slashstar}, \.{//}, \.{/)}, and~\.{/=}@>@;
1614
break;
1615
1616
case @'(':
1617
if(*loc == @'/' && !in_format) compress(left_array);
1618
break;
1619
1620
case @'+':
1621
if (*loc==@'+') {compress(plus_plus); // `\.{++}' $\to$ `|++|'.
1622
}
1623
else if(*loc==@'=') {COMPOUND(plus_eq,1);
1624
// `\.{+=}' $\to$ `|+=|'.
1625
}
1626
break;
1627
1628
case @'-':
1629
if (*loc==@'-') {compress(minus_minus); // `\.{--}' $\to$ `|--|'.
1630
}
1631
else if (*loc==@'>') {compress(minus_gt);
1632
// `\.{->}' $\to$ `|->|'.
1633
}
1634
else if(*loc==@'=') {COMPOUND(minus_eq,1);
1635
// `\.{-=}' $\to$ `|-=|'.
1636
}
1637
break;
1638
1639
case @'=':
1640
if (*loc==@'=') {compress(eq_eq); // `\.{==}' $\to$ `|==|'.
1641
}
1642
else if(*loc==@'>') {compress(eq_gt);
1643
// `\.{=>}' $\to$ `$\WPtr$'.
1644
} /* \FORTRAN-88's pointer assignment statement. */
1645
break;
1646
1647
case @'>':
1648
if (*loc==@'=') {compress(gt_eq); // `\.{>=}' $\to$ `|>=|'.
1649
}
1650
else if (*loc==@'>')
1651
if(*(loc+1)==@'=') {COMPOUND(gt_gt_eq,2);
1652
// `\.{>>=}' $\to$ `|>>=|'.
1653
}
1654
else {compress(gt_gt); // `\.{>>}' $\to$ `|>>|'.
1655
}
1656
break;
1657
1658
case @'<':
1659
if (*loc==@'=') {compress(lt_eq); // `\.{<=}' $\to$ `|<=|'.
1660
}
1661
else if (*loc==@'<')
1662
if(*(loc+1)==@'=')
1663
{COMPOUND(lt_lt_eq,2);
1664
// `\.{<<=}' $\to$ `|<<=|'.
1665
}
1666
else {compress(lt_lt); // `\.{<<}' $\to$ `|<<|'.
1667
}
1668
else if(*loc==@'>') {compress(not_eq);
1669
// `\.{<>}' $\to$ `|!=|'.
1670
} /* \FORTRAN-88 */
1671
break;
1672
1673
case @'%':
1674
if(*loc==@'=') {COMPOUND(mod_eq,1); // `\.{\%=}' $\to$ `|%=|'.
1675
}
1676
break;
1677
1678
case @'&':
1679
if (*loc==@'&') {compress(and_and); // `\.{\&\&}' $\to$ `|&&|'.
1680
}
1681
else if(*loc==@'=')
1682
{
1683
COMPOUND(and_eq,1); // `\.{\&=}' $\to$ `|&=|'.
1684
}
1685
break;
1686
1687
case @'|':
1688
if (*loc==@'|')
1689
{
1690
if(*(loc+1)==@'|')
1691
{
1692
COMPOUND(or_or_or,2); // `\.{\vb\vb\vb}' $\to$ `|||||'.
1693
}
1694
else compress(or_or); // `\.{\vb\vb}' $\to$ `||| |'.
1695
}
1696
else if(*loc==@'=' && !FORTRAN_LIKE(language))
1697
{
1698
COMPOUND(or_eq,1); // `\.{\vertbar=}' $\to$ `||=|'.
1699
}
1700
break;
1701
1702
case @'!':
1703
if(!in_format && (point_comments || *loc == @'!') )
1704
{
1705
if(*loc != @'!') loc--;
1706
long_comment = NO;
1707
compress(begin_comment); // \.{! Comment} or \.{!! Comment}.
1708
}
1709
else if (*loc==@'=') {compress(not_eq); // `\.{!=}' $\to$ `|!=|'.
1710
}
1711
break;
1712
1713
case @'*':
1714
if(FORTRAN_LIKE(language) && (*loc == @'*') )
1715
{compress(star_star); // `\.{x**y}' $\to$ `|@r x**y|'.
1716
} /* Exponentiation. */
1717
else if(*loc==@'=') {COMPOUND(star_eq,1); // `\.{*=}' $\to$ `|*=|'.
1718
}
1719
break;
1720
1721
case @'^':
1722
if(*loc == @'^') {compress(star_star);}
1723
else if(FORTRAN_LIKE(language) && (loc < limit) )
1724
return star_star; // `\.{x\^y}' $\to$ `|@r x^y|'.
1725
else if(*loc==@'=') {COMPOUND(xor_eq,1); // `\.{\^=}' $\to$ `|^=|'.
1726
}
1727
break;
1728
1729
case @':':
1730
if(*loc==@':') compress(colon_colon); // `\.{::}' $\to$ `|::|'.
1731
break;
1732
1733
case @'#':
1734
@<Cases for \.{\#\#}, \.{\#!}, \.{\#:}, \.{\#.}, and~\.{\#<}@>@;
1735
break;
1736
}
1737
1738
1739
@
1740
@<Cases for \.{\slashstar}...@>=
1741
1742
if (*loc==@'*')
1743
{
1744
long_comment = YES;
1745
compress(begin_comment); // \.{\slashstar\dots/starslash}
1746
}
1747
else if(*loc == @'/')
1748
{
1749
if(C_LIKE(language) || language==TEX || (Cpp_comments &&
1750
!in_format && FORTRAN_LIKE(language)))
1751
{ /* Short comments are recognized in both~C and
1752
\Cpp, and also in |TEX|. */
1753
long_comment = NO; /* \Cpp-style comment. */
1754
compress(begin_comment); // \.{//\dots}
1755
}
1756
else if(!in_format)
1757
{
1758
compress(slash_slash); /* Concatenation
1759
operator~|@r \/|. Multiple slashes in |format| statements are just left
1760
alone. */
1761
}
1762
}
1763
else if(*loc == @')' && !in_format)
1764
{compress(right_array); // `\.{/)}' $\to$ `$\WSR$'.
1765
}
1766
else if(*loc == @'=')
1767
{COMPOUND(slash_eq,1); // `\.{(/}' $\to$ `$\WLS$'.
1768
}
1769
1770
@
1771
@<Cases for \.{\#\#}...@>=
1772
1773
switch(*loc)
1774
{
1775
case @'#':
1776
compress(paste); // `\.{\#\#}' $\to$ token `\.{\#\#}'.
1777
break;
1778
1779
case @'!':
1780
compress(dont_expand); // `\.{\#!}' $\to$ token `\.{\#!}'.
1781
break;
1782
1783
case @':':
1784
compress(auto_label); // `\.{\#:}' $\to$ token `\.{\#:}'.
1785
break;
1786
1787
case @'.':
1788
compress(all_variable_args); // `\.{\#.}' $\to$ token `\.{\#.}'.
1789
break;
1790
1791
case @'<':
1792
loc++;
1793
mac_mod_name = YES;
1794
@<Scan the module name and make |cur_module| point to it@>;
1795
return macro_module_name;
1796
1797
case @'\'':
1798
case @'"':
1799
if(phase == 1) loc++; // Skip over so string scanner doesn't complain.
1800
break;
1801
}
1802
1803
@ Different conventions are followed by \TeX\ and \cee\ to express octal
1804
and hexadecimal numbers; it is reasonable to stick to each convention
1805
withing its realm. Thus the \cee\ part of a \.{WEB} file has octals
1806
introduced by~\.0 and hexadecimals by~\.{0x}---e.g., \.{0377} or
1807
\.{0xFF}---but \.{WEAVE} will print in italics or typewriter font,
1808
respectively, and introduced by single or double quotes---e.g., |0377| or
1809
|0xFF|. \FWEB\ also adds binary constants, written as \.{0b10101} and
1810
printed as |0b10101|. In order to simplify the \TeX\ macro used to print
1811
such constants, we replace some of the characters. (If you don't like the
1812
way these constants look, you can easily change the macro; see
1813
\.{fwebmac.tex}.)
1814
1815
Notice that in this section and the next, |id_first| and |id_loc| are
1816
pointers into the array |mod_text|, not into |cur_buffer|.
1817
1818
The next definitions correspond to the macros in \.{fwebmac.tex}.
1819
1820
@d BINARY_CODE @'&' /* `\.{0b10101}' $\to$ `|0b10101|' */
1821
@d OCTAL_CODE @'~' /* `\.{0377}' $\to$ `|0377|' */
1822
@d HEX_CODE @'`' /* `\.{0xabc}' $\to$ `|0xabc|' */
1823
1824
@d CONSTANT_CODE @'#' // Various kinds of constants.
1825
@d FLOAT_CODE @'0' // `\.{50000F}' $\to$ `|50000F|'.
1826
@d LONG_CODE @'1' /* `\.{50000L}' $\to$ `|50000L|' */
1827
@d UNSIGNED_CODE @'2' // `\.{50000U}' $\to$ `|50000U|'.
1828
@d ULONG_CODE @'3' // `\.{50000UL}' $\to$ `|50000UL|'.
1829
1830
@d EXP_CODE @'^' /* `\.{(x+y)\^(a+b)}' $\to$ `|@r (x+y)^(a+b)|' */
1831
@d HOLLERITH_CODE @'%' /* `\.{5Hhello}' $\to$ `|@r 5Hhello|' */
1832
1833
@<Get a constant@>=
1834
@B
1835
boolean decimal_point = NO;
1836
ASCII prec_char;
1837
1838
@b
1839
id_first = id_loc = mod_text + 1;
1840
1841
if(Fortran88)
1842
{
1843
*id_loc++ = @' ';
1844
/* Might be replaced later by a left brace, if there' a
1845
kind parameter. */
1846
if(upcoming_kind)
1847
{
1848
loc--; // Position on underscore.
1849
upcoming_kind = NO;
1850
1851
}
1852
}
1853
1854
if(c != @'_')
1855
if (c==@'\\')
1856
{ /* Probably octal---e.g., `\.{\\107}' */
1857
ASCII *loc0;
1858
1859
if(*loc == @'/')
1860
goto mistake; // It's really `\.{\\/}'.
1861
1862
*id_loc++ = OCTAL_CODE; // \.{WEBMAC} control code for octal.
1863
loc0 = loc;
1864
1865
while (isOdigit(*loc))
1866
*id_loc++ = *loc++;
1867
1868
if(loc == loc0)
1869
return (eight_bits)c; // Not octal!
1870
}
1871
else if (c==@'0')
1872
@<Get an octal, hex, or binary constant@>@;
1873
else
1874
@<Get a decimal or Hollerith constant@>@;
1875
1876
@<Post-process constant@>@;
1877
1878
if(!decimal_point && at_beginning &&
1879
((is_FORTRAN_(language) && !last_was_continued) ||
1880
(is_RATFOR_(language) && *loc == @':')))
1881
return stmt_label;
1882
1883
return constant;
1884
}
1885
1886
@
1887
@<Get an octal, hex...@>=
1888
{
1889
if (*loc==@'x' || *loc==@'X')
1890
{ /* Hex---e.g., `\.{0xABC}' */
1891
*id_loc++ = HEX_CODE; /* \.{WEBMAC} code for hex. */
1892
loc++;
1893
while (isXdigit(*loc))
1894
*id_loc++ = *loc++;
1895
}
1896
else if(*loc==@'b' || *loc==@'B') /* Binary */
1897
{
1898
*id_loc++ = BINARY_CODE; /* \.{WEBMAC} code for binary. */
1899
loc++;
1900
while(isBdigit(*loc))
1901
*id_loc++ = *loc++;
1902
}
1903
else if (isOdigit(*loc)) /* Octal---e.g., `\.{011}' */
1904
{
1905
*id_loc++ = OCTAL_CODE;
1906
while (isOdigit(*loc))
1907
*id_loc++=*loc++;
1908
}
1909
else
1910
goto dec; // Decimal constant.
1911
}
1912
1913
@ Decimal (\.{1.0e-5}) or \FORTRAN\ Hollerith constant (|@R 3Habc|).
1914
1915
@<Get a decimal...@>=
1916
{
1917
if (c==@'.' && !isDigit(*loc))
1918
goto mistake; // Isn't a constant like~`|.1|'.
1919
1920
dec:
1921
*id_loc++ = c;
1922
while (isDigit(*loc) || *loc==@'.')
1923
*id_loc++ = *loc++;
1924
/* Optimistically, we'll include the decimal point with the constant.
1925
However, in \Fortran\ we have to check for the possibility that it's an
1926
integer followed by a dot constant. We do this immediately below. */
1927
1928
decimal_point = BOOLEAN(*(loc-1) == @'.');
1929
1930
if(FORTRAN_LIKE(language))
1931
if(decimal_point) /* Check for dot constant. */
1932
{
1933
if(is_dot()) /* It's an integer constant
1934
followed by a dot constant. */
1935
{
1936
id_loc--;
1937
loc--;
1938
return constant;
1939
}
1940
}
1941
else if(*loc == @'h' || *loc == @'H')
1942
@<Copy Hollerith constant@>;
1943
1944
if(in_format)
1945
return constant;
1946
1947
prec_char = *loc;
1948
1949
if (prec_char==@'e' || prec_char==@'E' || (FORTRAN_LIKE(language) &&
1950
(prec_char==@'d' || prec_char==@'D' ||
1951
prec_char==@'q' || prec_char==@'Q')))
1952
@<Get the exponent field@>@;
1953
}
1954
1955
@ Process the exponent part of a floating-point constant such as
1956
\.{1.5e-10} |@e = 1.5e-10|.
1957
1958
@<Get the expon...@>=
1959
{
1960
*id_loc++ = EXP_CODE; // Control character for WEB power of ten.
1961
*id_loc++ = A_TO_UPPER(prec_char);
1962
1963
loc++; // Skip past the exponent character.
1964
1965
if (*loc==@'+' || *loc==@'-')
1966
*id_loc++ = *loc++;
1967
1968
while (isDigit(*loc))
1969
*id_loc++ = *loc++;
1970
}
1971
1972
@ Hollerith constants have the form \.{3Habc}.
1973
@<Copy Hol...@>=
1974
@B
1975
int k,n;
1976
1977
@b
1978
*id_loc = '\0'; /* Temporarily make a true terminated string. */
1979
n = ATOI(id_first); /* Convert the string to an integer constant. */
1980
*id_loc++ = HOLLERITH_CODE; /* Control character for WEB Hollerith macro. */
1981
++loc; /* Skip the |'H'|. */
1982
1983
for(k=0; k<n; ++k) /* Copy the actual string. */
1984
*id_loc++ = *loc++;
1985
1986
return constant;
1987
}
1988
1989
@ We don't yet handle correctly things like~\.{50UL}; it comes out like~|50UL|.
1990
1991
@<Post-process...@>=
1992
1993
if (C_LIKE(language))
1994
{
1995
switch(*loc)
1996
{
1997
case @'l':
1998
case @'L':
1999
*id_loc++ = CONSTANT_CODE;
2000
loc++;
2001
if(*loc == @'u' || *loc == @'U')
2002
{
2003
*id_loc++ = ULONG_CODE;
2004
loc++;
2005
}
2006
else
2007
*id_loc++ = LONG_CODE;
2008
break;
2009
2010
case @'u':
2011
case @'U':
2012
*id_loc++ = CONSTANT_CODE;
2013
loc++;
2014
if(*loc == @'l' || *loc == @'L')
2015
{
2016
*id_loc++ = ULONG_CODE;
2017
loc++;
2018
}
2019
else *id_loc++ = UNSIGNED_CODE;
2020
break;
2021
2022
case @'f':
2023
case @'F':
2024
*id_loc++ = CONSTANT_CODE;
2025
*id_loc++ = FLOAT_CODE;
2026
loc++;
2027
break;
2028
}
2029
}
2030
else if(Fortran88)
2031
@<Absorb optional kind-param@>@;
2032
2033
@ In \Fortran-90, there can be optional kind parameters after a constant,
2034
started off by an underscore. Example: |@r9 50_4| or |@n9 1.2e45_high|.
2035
2036
@<Absorb optional kind-param@>=
2037
{
2038
if(*loc == @'_')
2039
{
2040
*id_first = @'{';
2041
// Make basic number a group, so is subscripted correctly.
2042
2043
*id_loc++ = @'}';
2044
2045
while(is_kind(*loc))
2046
*id_loc++ = *loc++;
2047
}
2048
else
2049
id_first++; // Kill off the tentative blank at beginning.
2050
}
2051
2052
@ Code strings and character constants, delimited by double and single
2053
quotes, respectively, can contain newlines or instances of their own
2054
delimiters if they are protected by a backslash (for~C) or if the delimiter
2055
is repeated (for \FORTRAN). We follow this convention, but do not allow
2056
the string to be longer than |longest_name|. Special codes are inserted
2057
every |NBREAK| characters so that \TeX\ can break the strings. (The count
2058
is restarted after commas, which are also treated as discretionary breaks.)
2059
2060
@d discretionary_break OCTAL(177)
2061
@d NBREAK 25 // \bf Put into style file?
2062
2063
@<Glob...@>=
2064
2065
EXTERN boolean insert_breaks SET(YES); /* No breaks inserted during limbo
2066
text processing. */
2067
2068
@ Here we absorb a string. Examples: \.{"abc"}, \.{'\\n'}, or
2069
\.{<file\_name>}.
2070
2071
@<Part 1@>=@[
2072
2073
eight_bits
2074
get_string FCN((c,boz))
2075
ASCII c C0("What started the string")@;
2076
ASCII boz C1("The boz character, or 0.")@;
2077
{
2078
ASCII delim = c; /* what started the string */
2079
ASCII right_delim = c;
2080
int level,kount;
2081
boolean equal_delims;
2082
2083
id_first = mod_text + 1;
2084
id_loc = mod_text;
2085
2086
/* ???? */
2087
if (delim==@'\'' && *(loc-2)==@'@@') {*++id_loc=@'@@'; *++id_loc=@'@@';}
2088
*++id_loc=delim;
2089
2090
@<Determine the right matching delimiter@>@;
2091
2092
kount = 0; /* How far since last discretionary line break command. */
2093
2094
WHILE()
2095
{ /* Scan for end of string. */
2096
if (loc>=limit) @<Check for continued string@>@;
2097
2098
if ((c=*loc++)==delim) @<Handle left-hand delimiter@>@;
2099
2100
if(c==right_delim)
2101
if(--level == 0)
2102
{
2103
if (++id_loc<=mod_end) *id_loc=c;
2104
break; /* Found end of string for unequal delims. */
2105
}
2106
2107
/* Handle a final backslash. */
2108
if ((c==cont_char) &&
2109
(C_LIKE(language) || (is_FORTRAN_(language) && free_form_input)))
2110
if (loc>=limit) continue;
2111
else if (++id_loc<=mod_end)
2112
{
2113
*id_loc = c; c=*loc++;
2114
}
2115
2116
/* Store the character. */
2117
if (++id_loc<=mod_end) *id_loc=c;
2118
2119
@<Insert discretionary line-break commands@>@;
2120
} /* End of \&{while}. */
2121
2122
if (id_loc>=mod_end)
2123
{
2124
SET_COLOR(error);
2125
printf("\n! String too long: ");
2126
@.String too long@>
2127
ASCII_write(mod_text+1,25);
2128
printf("...");
2129
mark_error;
2130
}
2131
2132
id_loc++;
2133
2134
@<Check for boz constant@>@;
2135
2136
return stringg;
2137
}
2138
2139
@
2140
@<Determine the right...@>=
2141
{
2142
switch(delim)
2143
{
2144
case @'<':
2145
right_delim=@'>'; // for file names in |#include| lines.
2146
break;
2147
2148
case @'(':
2149
right_delim = @')'; // For m4 \&{include} or related functions.
2150
sharp_include_line = NO;
2151
break;
2152
2153
case @'[':
2154
right_delim = @']'; // For auto insertions in macro definitions.
2155
break;
2156
}
2157
2158
level = 1; // For searching for balanced delimiters.
2159
2160
equal_delims = BOOLEAN(right_delim==delim);
2161
}
2162
2163
@
2164
@<Check for continued string@>=
2165
{
2166
if( (equal_delims || chk_ifelse) && *(limit-1)!=cont_char)
2167
{
2168
err_print(W,"String %s with %s'%s%c'%s didn't end",
2169
BTRANS,
2170
SSET_COLOR(character),
2171
delim==@'\'' ? "\\" : "",
2172
XCHR(delim),
2173
SSET_COLOR(error));
2174
loc=limit; break;
2175
@.String didn't end@>
2176
}
2177
2178
if(!get_line())
2179
{
2180
err_print(W,"Input ended in middle of string beginning with \
2181
'\\%c'",XCHR(delim));
2182
loc=cur_buffer;
2183
break;
2184
@.Input ended in middle of string@>
2185
}
2186
else
2187
{
2188
/* Now the continuation of the string is in the buffer. If appropriate,
2189
skip over beginning white space and backslash. */
2190
if(bslash_continued_strings)
2191
{
2192
for(; loc < limit; loc++)
2193
if(*loc != @' ' && *loc != tab_mark) break;
2194
2195
if(*loc == cont_char) loc++; /* Move past the backslash. */
2196
else err_print(W,"Inserted '\\%c' at beginning of continued \
2197
string",XCHR(cont_char));
2198
}
2199
}
2200
}
2201
2202
@
2203
@<Handle left-hand delim...@>=
2204
{
2205
level++;
2206
2207
if (++id_loc<=mod_end) *id_loc=c;
2208
2209
if(!equal_delims) continue;
2210
2211
if(FORTRAN_LIKE(language) && (*loc == delim) )
2212
++loc; /* Copy over repeated delimiter. */
2213
else break; /* Found end of string. */
2214
}
2215
2216
@ Insert discretionary line-break command every |NBREAK|
2217
characters. Since the string macro also inserts discretionary breaks after
2218
commas, we reset the counter to~0 after a comma. As one annoyance, we don't
2219
want to insert a break immediately after an~`\.{@@}', because the output
2220
routines would otherwise get confused.
2221
@<Insert discretionary line-break...@>=
2222
2223
if(insert_breaks)
2224
if(c == @',') kount = 0;
2225
else if(++kount >= NBREAK && c != @'@@' && ++id_loc<=mod_end)
2226
{
2227
kount = 0;
2228
*id_loc = discretionary_break;
2229
}
2230
2231
@ In \Fortran-90, we have \It{boz-constants}---binary, octal, or
2232
hexadecimal constants that look like~`\.{B'011'}', `\.{O'077'}',
2233
or~`\.{Z'FF'}'. (The single quotes may be replaced by double quotes.)
2234
These constants may appear only in |@r data| statements.
2235
2236
@<Check for boz...@>=
2237
{
2238
if(FORTRAN_LIKE(language))
2239
if(boz)
2240
@<Handle boz constant@>@;
2241
else
2242
@<Handle VAX extensions of hex or octal constants@>@;
2243
}
2244
2245
@ At this point we already know we're dealing with a boz constant.
2246
@<Handle boz...@>=
2247
{
2248
switch(boz)
2249
{
2250
case @'B':
2251
*id_first = BINARY_CODE;
2252
break;
2253
2254
case @'O':
2255
*id_first = OCTAL_CODE;
2256
break;
2257
2258
case @'Z':
2259
*id_first = HEX_CODE;
2260
break;
2261
}
2262
2263
id_loc--;
2264
return constant;
2265
}
2266
2267
@ Handle the VAX extensions of hex or octal
2268
constants---e.g., \.{'abc'X} or \.{'123'O}.
2269
@<Handle VAX exten...@>=
2270
{
2271
if(*loc==@'X' || *loc==@'x')
2272
{
2273
*id_first = HEX_CODE; /* Overwrite opening delimiter. */
2274
@<Finish VAX hex/octal constant.@>@;
2275
}
2276
else if(*loc==@'O' || *loc==@'o')
2277
{
2278
*id_first = OCTAL_CODE; /* Octal */
2279
@<Finish VAX hex...@>@;
2280
}
2281
}
2282
2283
@
2284
@<Finish VAX hex...@>=
2285
2286
loc++; /* Skip the ending signifier. */
2287
id_loc--; /* Forget closing delimiter. */
2288
return constant;
2289
2290
@
2291
@<Glob...@>=
2292
2293
EXTERN boolean doing_cdir SET(NO);
2294
2295
@ After an \.{@@}~sign has been scanned, the next character tells us
2296
whether there is more work to do. Note that lower- and upper-case control
2297
codes are generally treated as variants of the same fundamental code; to
2298
distinguish them, we set the |upper_case_code| flag. When the code is in
2299
upper case, it does not automatically issue an implicit~\.{@@[}, for example.
2300
2301
@<Part 1@>=@[
2302
2303
GOTO_CODE
2304
get_control_code(VOID)
2305
{
2306
eight_bits cc; // The |ccode| value.
2307
2308
@b
2309
c = *loc++;
2310
SET_CASE(c); // Set the |upper_case_code| flag.
2311
2312
/* Deflect a verbatim comment beginning with `\.{@@\slashstar}'. */
2313
if( (c==@'/' && (*loc==@'*' || *loc==@'/')) ||
2314
c==(ASCII)begin_comment0 || c==(ASCII)begin_comment1)
2315
return GOTO_MISTAKE;
2316
2317
if(c == @'>' && mod_level == 0)
2318
{
2319
ERR_PRINT(W, "Unmatched `@@>' ignored");
2320
return MORE_PARSE;
2321
}
2322
2323
switch(cc = ccode[c])
2324
{
2325
case no_index:
2326
index_flag = NO;
2327
return MORE_PARSE;
2328
2329
case yes_index:
2330
INDEX_SHORT;
2331
return MORE_PARSE;
2332
2333
case defd_at:
2334
if(mark_defined.generic_name)
2335
{
2336
defd_switch = YES; // `\.{@@[}'.
2337
defd_type = GENERIC_NAME;
2338
} // \bf NOTE: Falls through.
2339
2340
case underline:
2341
xref_switch = def_flag; // `\.{@@\_}'
2342
return MORE_PARSE;
2343
2344
case implicit_reserved:
2345
if(mark_defined.imp_reserved_name)
2346
{
2347
typd_switch = defd_switch = YES; // `\.{@@`}'.
2348
defd_type = IMPLICIT_RESERVED;
2349
xref_switch = def_flag;
2350
}
2351
return MORE_PARSE;
2352
2353
case switch_math_flag: math_flag=!math_flag; // `\.{@@\$}'
2354
return MORE_PARSE;
2355
2356
#ifdef DEBUG
2357
case trace: tracing=c-@'0'; // `\.{@@0}', `\.{@@1}', `\.{@@2}'
2358
return MORE_PARSE;
2359
#endif /* |DEBUG| */
2360
2361
/* For language switches, we set the |language|, then
2362
send back a single code |begin_language|. When we process this, we'll then
2363
append another 8-bit code with the language number itself. */
2364
2365
@<Specific language cases@>:
2366
loc--; // Falls through to general case below.
2367
2368
case L_switch:
2369
{
2370
@<Set the |language|...@>@;
2371
return begin_language; // `\.{@@L$l$}'
2372
}
2373
2374
case begin_nuweb:
2375
ERR_PRINT(W,"@@N ignored; must appear before beginning of code part");
2376
return MORE_PARSE;
2377
2378
case xref_roman: case xref_wildcard: case xref_typewriter:
2379
case TeX_string: case keyword_name:
2380
@<Scan to the next \.{@@>}; |return cc|@>@;
2381
/* `\.{@@\^\dots@@>}', `\.{@@9\dots@@>}', `\.{@@.\dots@@>}', and
2382
`\.{@@t\dots@@>}'. */
2383
2384
case module_name:
2385
mac_mod_name = NO; // Used as a flag for macro processing.
2386
@<Scan the module name and make |cur_module| point to it@>@;
2387
return module_name; // `\.{@@<\dots@@>}'
2388
2389
case new_output_file:
2390
@<Scan the output file name@>@;
2391
return cc;
2392
2393
case invisible_cmnt:
2394
if(*loc == @'%')
2395
eat_blank_lines = YES;
2396
loc = limit + 1; // Skip the line.
2397
return MORE_PARSE; // `\.{@@\%}
2398
2399
case Compiler_Directive:
2400
long_comment = NO;
2401
doing_cdir = YES;
2402
return begin_comment; // `\.{@@!}' or `\.{@@?}'
2403
2404
case verbatim: @<Scan a verbatim string@>@; // `\.{@@=\dots@@>}'
2405
2406
case ascii_constant: return get_string(c,'\0'); // `\.{@@'\dots'}'
2407
2408
case big_line_break: // `\.{@@\#}'
2409
if(loc >= limit)
2410
return cc;
2411
2412
@<Process possible pre...@>; // In \.{typedefs.web}.
2413
return cc;
2414
2415
case begin_bp:
2416
return @'{'; // Ought to improve this, to mark the debugging locations.
2417
2418
case USED_BY_NEITHER:
2419
if(phase==1)
2420
err_print(W,"Invalid `@@%c' ignored",XCHR(c));
2421
2422
return ignore;
2423
2424
case USED_BY_OTHER:
2425
if(c == @'q')
2426
loc++; // Skip the~0 or~1 after the \.{@@q}.
2427
2428
return cc;
2429
2430
default: return cc;
2431
}
2432
}
2433
2434
@ The occurrence of a module name sets |xref_switch| to zero, because the
2435
module name might (for example) follow \&{int}.
2436
2437
@<Scan the module name...@>=
2438
@B
2439
ASCII HUGE *k; // Pointer into |mod_text|.
2440
static ASCII ell[] = @"...";
2441
static ASCII bad_mod_name[] = @"!!! {\\it Incompatible} !!!";
2442
2443
@b
2444
@<Put module name into |mod_text|@>@;
2445
2446
if (k-mod_text > 3 && STRNCMP(k-2,ell,3)==0)
2447
cur_module = prefix_lookup(mod_text+1,k-3);
2448
else cur_module = mod_lookup(mod_text+1,k);
2449
2450
if(!cur_module)
2451
cur_module = mod_lookup(bad_mod_name,bad_mod_name+STRLEN(bad_mod_name)-1);
2452
2453
if(cur_module)
2454
{
2455
@#if 0
2456
language = (LANGUAGE)cur_module->Language;
2457
@#endif
2458
params = cur_module->mod_info->params;// Restore state for this module.
2459
frz_params();
2460
}
2461
2462
xref_switch = NO;
2463
2464
/* The actual return value can be either |module_name| or
2465
|macro_module_name| and is put in explicitly right after the use of this
2466
module in the code. */
2467
}
2468
2469
@ Module names are placed into the |mod_text| array with consecutive
2470
spaces, tabs, and carriage-returns replaced by single spaces. There will be
2471
no spaces at the beginning or the end. (We set |mod_text[0]=' '| to
2472
facilitate this, since the |mod_lookup| routine uses |mod_text[1]| as the
2473
first character of the name.)
2474
2475
@<Set init...@>=
2476
2477
mod_text[0] = @' ';
2478
2479
@ Here we copy the text of the module name, stripping off white space from
2480
the front and back. Also, we convert any real semicolons into interior
2481
semis. This helps out with language switches between \Fortran\ and~C, for
2482
example. If the global language were~C, then a module name that should be
2483
read in \Fortran\ will be first be absorbed in~C because the parser doesn't
2484
know yet which language it will be.
2485
2486
@<Put module name...@>=
2487
{
2488
mod_level = 1;
2489
2490
k = mod_text;
2491
2492
WHILE()
2493
{
2494
if (loc>limit && !get_line())
2495
{
2496
ERR_PRINT(W,"Input ended in section name");
2497
@.Input ended in section name@>
2498
loc=cur_buffer+1; break;
2499
}
2500
2501
c = *loc;
2502
@<If end of name, |break|@>;
2503
loc++;
2504
2505
if (k<mod_end) k++;
2506
2507
switch(c)
2508
{
2509
case @' ':
2510
case tab_mark:
2511
c=@' '; if (*(k-1)==@' ') k--; // Compress white space.
2512
break;
2513
2514
case @';':
2515
c = interior_semi;
2516
break;
2517
}
2518
2519
*k = c;
2520
}
2521
2522
if (k>=mod_end)
2523
{
2524
SET_COLOR(warning);
2525
printf("\n! Section name too long: ");
2526
@.Section name too long@>
2527
ASCII_write(mod_text+1,25);
2528
printf("...");
2529
mark_harmless;
2530
}
2531
2532
if (*k==@' ' && k>mod_text)
2533
k--; // Trailing blanks.
2534
}
2535
2536
@
2537
@<If end of name,...@>=
2538
2539
if (c==@'@@')
2540
{
2541
c = *(loc+1);
2542
2543
if (c==@'>')
2544
{
2545
if(--mod_level == 0)
2546
{
2547
loc+=2; break;
2548
}
2549
}
2550
else if(c==@'<') mod_level++;
2551
2552
if (ccode[c]==new_module)
2553
{
2554
ERR_PRINT(W,"Section name didn't end"); break;
2555
@.Section name didn't end@>
2556
}
2557
2558
*(++k) = @'@@'; loc++; // Now |c==*loc| again.
2559
}
2560
2561
2562
@ This fragment is used for skipping over control text, such as
2563
`\.{@@t\dots@@>}'.
2564
2565
@<Scan to the next...@>=
2566
{
2567
cc = ccode[*(loc-1)]; /* Is this statement redundant? */
2568
id_first=loc; *(limit+1)=@'@@';
2569
2570
while(*loc != @'@@')
2571
loc++;
2572
2573
id_loc = loc;
2574
2575
if (loc++ > limit)
2576
{
2577
ERR_PRINT(W,"Control text didn't end");
2578
loc = limit;
2579
return cc;
2580
@.Control text didn't end@>
2581
}
2582
2583
if (*loc++!=@'>')
2584
ERR_PRINT(W,"Control codes are forbidden in control text");
2585
@.Control codes are forbidden...@>
2586
2587
return cc;
2588
}
2589
2590
@ At the present point in the program we have |*(loc-1)=verbatim|; we set
2591
|id_first| to the beginning of the string itself, and |id_loc| to its
2592
ending-plus-one location in the buffer. We also set~|loc| to the position
2593
just after the ending delimiter.
2594
2595
@<Scan a verbatim string@>=
2596
{
2597
id_first=loc++;
2598
2599
*(limit+1)=@'@@'; *(limit+2)=@'>';
2600
2601
while (*loc!=@'@@' || *(loc+1)!=@'>') loc++;
2602
2603
if (loc>=limit) ERR_PRINT(W,"Verbatim string didn't end");
2604
@.Verbatim string didn't end@>
2605
2606
id_loc=loc; loc+=2;
2607
2608
return (verbatim);
2609
}
2610
2611
@* PHASE ONE PROCESSING.
2612
We now have accumulated enough subroutines to make it possible to carry out
2613
\.{WEAVE}'s first pass over the source file. If everything works right,
2614
both phase one and phase two of \.{WEAVE} will assign the same numbers to
2615
modules, and these numbers will agree with what \.{TANGLE} does.
2616
2617
The global variable |next_control| often contains the most recent output of
2618
|get_next|; in interesting cases, this will be the control code that ended
2619
a module or part of a module.
2620
2621
@<Global...@>=
2622
2623
EXTERN eight_bits next_control; /* control code waiting to be acting upon */
2624
2625
@ The overall processing strategy in phase one has the following
2626
straightforward outline.
2627
2628
@<Part 1@>=@[
2629
2630
SRTN
2631
phase1(VOID)
2632
{
2633
LANGUAGE language0=language;
2634
2635
phase = 1;
2636
the_part = LIMBO;
2637
2638
rst_input();
2639
reading(web_file_name,(boolean)(tex_file==stdout));
2640
module_count = 0;
2641
skip_limbo(); // Skip stuff before any module (but process language commands).
2642
change_exists = NO;
2643
2644
/* Remember the language to put into force at the beginning of each module.
2645
|language| may have been set from the command line, by default (nothing on
2646
the command line), or by explicit~\.{@@c}, \.{@@r}, \.{@@n},
2647
or~\.{@@L$l$} commands during the limbo phase. */
2648
chk_override(language0);
2649
fin_language(); /* Make sure all flags are initialized properly. */
2650
global_params = params;
2651
2652
while (!input_has_ended)
2653
@<Store cross-reference data for the current module@>;
2654
2655
chngd_module[module_count]=change_exists;
2656
/* the index changes if anything does */
2657
2658
@<Print error messages about unused or undefined module names, or modules
2659
with multiple uses@>@;
2660
}
2661
2662
@
2663
@<Store cross-reference data...@>=
2664
{
2665
the_part = TEX_;
2666
2667
if (++module_count==(sixteen_bits)max_modules)
2668
OVERFLW("section numbers",ABBREV(max_modules));
2669
2670
chngd_module[module_count]=NO; // It will become |YES| if any line changes.
2671
2672
progress();
2673
2674
/* All modules start off in the global language. */
2675
params = global_params;
2676
frz_params();
2677
2678
@<Store cross-references in the \TeX\ part of a module@>;
2679
@<Store cross-references in the definition part of a module@>;
2680
@<Store cross-references in the \cee\ part of a module@>;
2681
2682
if(chngd_module[module_count])
2683
change_exists=YES;
2684
2685
typd_switch = defd_switch = NO; // Don't propagate beyond one module.
2686
}
2687
2688
@ The |C_xref| subroutine stores references to identifiers in \cee\ text
2689
material beginning with the current value of |next_control| and continuing
2690
until |next_control| is~`\.\{' or~`\v', or until the next ``milestone'' is
2691
passed (i.e., |next_control>=formatt|). If |next_control>=formatt| when
2692
|C_xref| is called, nothing will happen; but if |next_control="|"| upon
2693
entry, the procedure assumes that this is the~`\v' preceding \cee\ text
2694
that is to be processed.
2695
2696
The program uses the fact that our internal code numbers satisfy the
2697
relations |xref_roman=identifier+roman| and |xref_wildcard=identifier
2698
+wildcard| and |xref_typewriter=identifier+typewriter| and |normal=0|.
2699
2700
@<Part 1@>=@[
2701
2702
SRTN
2703
C_xref FCN((part0,mode0))
2704
PART part0 C0("")@;
2705
PARSING_MODE mode0 C1("")@;
2706
{
2707
PARAMS outer_params;
2708
PARSE_PARAMS parse_params0;
2709
name_pointer p; /* a referenced name */
2710
2711
parsing_mode = mode0;
2712
2713
if(parsing_mode == INNER)
2714
{
2715
outer_params = params; /* Store whole structure. */
2716
parse_params0 = parse_params;
2717
}
2718
2719
if(language == LITERAL)
2720
if(next_control == @'|')
2721
{
2722
@<Skip a verbatim scrap@>@;
2723
goto end_xref;
2724
}
2725
else
2726
next_control = begin_meta;
2727
2728
do_inside = YES;
2729
2730
while (next_control<formatt)
2731
{
2732
switch(next_control)
2733
{
2734
case begin_language:
2735
@<Handle a possible language switch in the middle of the module@>@;
2736
break;
2737
2738
case toggle_output:
2739
@<Toggle output@>@;
2740
break;
2741
2742
case begin_meta:
2743
if(language == LITERAL)
2744
@<Skip over literal text@>@;
2745
else
2746
@<Skip over meta-comment@>@;
2747
break;
2748
2749
case xref_roman:
2750
case xref_wildcard:
2751
case xref_typewriter:
2752
p = id_lookup(id_first, id_loc,
2753
(eight_bits)(next_control-identifier));
2754
2755
{ /* User entries should be insensitive to \.{@@a} vs.\
2756
\.{@@A}. */
2757
boolean defd0 = defd_switch;
2758
2759
defd_switch = NO;
2760
index_flag = YES;
2761
new_xref(part0, p);
2762
defd_switch = defd0;
2763
}
2764
2765
break;
2766
2767
case identifier:
2768
p = id_lookup(id_first, id_loc,
2769
(eight_bits)(next_control-identifier));
2770
2771
new_xref(part0, p);
2772
2773
if(part0 == DEFINITION)
2774
defd_switch = NO; /* Prevent the implicit~\.{@@[}
2775
from propagating beyond the first identifier. */
2776
2777
if(C_LIKE(language) && parsing_mode == OUTER)
2778
{
2779
if(p->ilk == typedef_like)
2780
@<Mark \&{typedef} variable@>@;
2781
else if(p->ilk == class_like)
2782
@<Mark \&{class} variable@>@;
2783
}
2784
break;
2785
2786
case stringg:
2787
if(sharp_include_line && phase == 1 && read_iformats
2788
&& C_LIKE(language))
2789
get_iformats();
2790
2791
break;
2792
}
2793
2794
next_control = get_next();
2795
2796
if( next_control==@'|' || next_control==begin_comment)
2797
break;
2798
}
2799
2800
end_xref:
2801
if(parsing_mode==INNER)
2802
{
2803
params = outer_params;
2804
frz_params();
2805
parse_params = parse_params0;
2806
parsing_mode = OUTER;
2807
}
2808
}
2809
2810
@ This is executed during cross-referencing in literal mode when a '\v' is
2811
encountered during skipping \TeX.
2812
2813
@<Skip a verbatim scrap@>=
2814
{
2815
WHILE()
2816
{
2817
if(loc < limit)
2818
{
2819
if(*loc == @'|')
2820
{
2821
next_control = *loc++;
2822
break;
2823
}
2824
2825
loc++;
2826
}
2827
else if(!get_line())
2828
{
2829
ERR_PRINT(W, "Missing '|'. File ended while skipping a \
2830
verbatim scrap");
2831
next_control = @'|';
2832
break;
2833
}
2834
}
2835
}
2836
2837
@
2838
@<Glob...@>=
2839
2840
IN_COMMON outer_char wbprefix[MAX_FILE_NAME_LENGTH];
2841
// Possible directory prefix for the web file name.
2842
EXTERN boolean do_inside; // Cross-reference stuff inside a \&{typedef}?
2843
EXTERN boolean qtd_file; // Is the include file quoted?
2844
2845
#ifndef L_tmpnam
2846
#define L_tmpnam 25
2847
#endif
2848
2849
EXTERN outer_char temp_in[L_tmpnam], temp_out[L_tmpnam];
2850
// Names of temporary files used in |get_iformats|.
2851
2852
@ To scan an include file for |typedef| and/or |@c++ class| statements, we
2853
use two temporary files whose names are |temp_in| and |temp_out|. These
2854
are created once, the first time |get_iformats| is called (so we don't call
2855
|tmpnam| possible many times). The include command is written into
2856
|temp_in|. By means of issuing a |system| command, the C preprocessor
2857
expands that command and writes its results to |temp_out|. Then \FWEAVE\
2858
parses that file, cross-referencing only the |typedef| and/or |@c++ class|
2859
variables.
2860
2861
Presently, this only works for the \.{gcc} and \.{g++} compilers.
2862
2863
@<Part 1@>=@[
2864
2865
SRTN
2866
get_iformats(VOID)
2867
{
2868
int n, new_depth;
2869
outer_char file_name[256];
2870
FILE *ftemp_in;
2871
PART part0 = CODE;
2872
2873
if(!temp_in[0])
2874
mktmp(temp_in,
2875
language==C ? wt_style.output_ext.C_ : wt_style.output_ext.Cpp_);
2876
2877
if((ftemp_in = FOPEN(temp_in, "w")) == NULL)
2878
{
2879
printf("\n! Can't open temporary file `%s'", temp_in);
2880
mark_harmless;
2881
read_iformats = NO;
2882
return;
2883
}
2884
2885
if(!temp_out[0])
2886
mktmp(temp_out, (outer_char *)"");
2887
/* We don't open the output file here, as \.{cpp} may not
2888
write into it if it's open. */
2889
2890
preprocessing = sharp_include_line = NO;
2891
2892
/* Copy include file name, include delimiters. */
2893
STRNCPY(file_name, id_first, n=PTR_DIFF(int, id_loc, id_first));
2894
file_name[n] = '\0';
2895
to_outer((ASCII HUGE *)file_name);
2896
2897
qtd_file = BOOLEAN(file_name[0] == '"');
2898
// Is this file name quoted (i.e., look locally)?
2899
2900
/* Write the include file command to temporary file, so the preprocessor
2901
can read it. */
2902
fprintf(ftemp_in, "#include %s\n", file_name);
2903
fclose(ftemp_in);
2904
2905
@<Create a command to run the preprocessor, then execute it@>@;
2906
2907
@<Deflect the input file to be \.{temp\_out}@>@;
2908
2909
if(new_depth != incl_depth || !get_line())
2910
goto restore; // No file, or nothing in it.
2911
2912
do_inside = NO;
2913
// This flag says to not xref stuff inside braces of \&{typedef}.
2914
2915
next_control = get_next();
2916
2917
/* Parse the preprocessed include file until EOF is reached and the
2918
|incl_depth| changes. */
2919
while(new_depth == incl_depth)
2920
{
2921
name_pointer p;
2922
2923
switch(next_control)
2924
{
2925
case identifier:
2926
p=id_lookup(id_first,id_loc,
2927
(eight_bits)(next_control-identifier));
2928
2929
if(p->ilk == typedef_like)
2930
@<Mark \&{typedef} variable@>@;
2931
else if(p->ilk == class_like)
2932
@<Mark \&{class} variable@>@;
2933
2934
break;
2935
}
2936
2937
next_control=get_next();
2938
}
2939
2940
end_xref:
2941
restore:
2942
preprocessing = sharp_include_line = YES;
2943
}
2944
2945
@ We'll use \.{gcc} as the preprocessor to scan the C include files.
2946
2947
@<Create...@>=
2948
{
2949
outer_char *temp, *temp_I;
2950
BUF_SIZE temp_len, ntemp;
2951
IN_COMMON outer_char *extra_args;
2952
2953
@<Build the \.{-I} options into |temp_I|@>@;
2954
2955
temp = GET_MEM("temp", ntemp=temp_len + STRLEN(RUN_CPP) + 4 + 3*3 + temp_len
2956
+ sizeof(temp_out) + sizeof(temp_in) + 3, outer_char);
2957
2958
sprintf((char *)temp, "\n%s -P%s %s -o %s %s",
2959
#if 0
2960
language==C ? "gcc" : "g++",
2961
#endif
2962
RUN_CPP,
2963
temp_I,
2964
extra_args ? (char *)extra_args : "",
2965
temp_out, temp_in);
2966
2967
if(!rmv_files)
2968
puts((char *)temp);
2969
// Echo the |system| command that runs the preprocessor.
2970
2971
system((CONST char *)temp);
2972
2973
FREE_MEM(temp_I, "temp_I", temp_len, outer_char);
2974
FREE_MEM(temp, "temp", ntemp, outer_char);
2975
}
2976
2977
@ By this time, the |FWEB_HDR_INCLUDES| environment variables has been
2978
read, and possibly accreted to by the \.{-I}~options preceding~\.{-H}. We
2979
tell the preprocessor to look first in the |wbprefix| directory, then in
2980
the |FWEB_HDR_INCLUDES|, then in the current directory. Note the use of
2981
the \.{-I.}~command of \.{gcc}, which looks in the directory current when
2982
the compiler was invoked.)
2983
2984
@<Build...@>=
2985
{
2986
IN_COMMON INCL_PATHS hdr_incl;
2987
outer_char *p, *p1;
2988
2989
temp_len = STRLEN(wbprefix) + hdr_incl.size + 3*(hdr_incl.num + 2) + 1;
2990
// Factor of 3 is for \.{\ -I}; of 2 adds web prefix and current dir.
2991
2992
temp_I = GET_MEM("temp_I", temp_len, outer_char);
2993
2994
if(*wbprefix)
2995
sprintf((char *)temp_I, " -I%s", wbprefix);
2996
2997
if(hdr_incl.list)
2998
for(p=hdr_incl.list; (p1=(outer_char *)STRCHR(p, ':')) != NULL;
2999
p = p1 + 1)
3000
{
3001
*p1 = '\0';
3002
STRCAT(temp_I, " -I");
3003
STRCAT(temp_I, p);
3004
*p1 = ':';
3005
}
3006
3007
STRCAT(temp_I, " -I."); // Finally, the current directory.
3008
}
3009
3010
@ The following commands are borrowed with slight modifications from
3011
\.{common.web}.
3012
3013
@<Deflect...@>=
3014
{
3015
if(++incl_depth >= (int)max_include_depth)
3016
{
3017
incl_depth--;
3018
err_print(C, "Too many nested includes; %d allowed. \
3019
Increase with `-yid'.", max_include_depth);
3020
@.Too many nested includes@>
3021
goto restore;
3022
}
3023
3024
{ /* No change file name specified; obtain it from the last level. */
3025
INPUT_PRMS *p_lower = &prms[incl_depth-1];
3026
INPUT_PRMS0 *p0_lower = &p_lower->change;
3027
3028
STRCPY(change_file_name,p0_lower->File_name);
3029
change_file = p0_lower->File;
3030
change_params = p_lower->input_params;
3031
}
3032
3033
STRCPY(cur_file_name, temp_out);
3034
new_depth = incl_depth;
3035
3036
{
3037
IN_COMMON INCL_PATHS incl;
3038
3039
/* Is |incl.list| the right thing to have here? Does it matter? */
3040
if(ini_input_prms(CUR_FILE, incl.list, NO))
3041
{
3042
if(cur_prms.change->File != prms[incl_depth-1].change.File)
3043
{}
3044
else *cur_prms.change = prms[incl_depth-1].change;
3045
// Still using the old change file.
3046
3047
cur_line = 0;
3048
prn_where = YES;
3049
/* Instead of printing the names of the temporary files, we print the
3050
include file name itself. */
3051
CLR_PRINTF(SHORT_INFO, include_file, (" (%s", file_name));
3052
/* Tell the terminal where we're reading from. */
3053
}
3054
else
3055
{ /* Failed to open include file. */
3056
incl_depth--;
3057
}
3058
}
3059
}
3060
3061
@ The following is called from |wrap_up()| in \.{common.web}.
3062
3063
@<Part 1@>=@[
3064
3065
SRTN
3066
cls_files(VOID)
3067
{
3068
if(read_iformats && rmv_files)
3069
{
3070
remove((CONST char *)temp_in);
3071
remove((CONST char *)temp_out);
3072
}
3073
}
3074
3075
@ Make a temporary file name, and append an extension. We use |tempnam| if
3076
possible, because it gives more control over the directory. Otherwise, we
3077
use the ANSI |tmpnam|.
3078
3079
@<Part 1@>=@[
3080
3081
outer_char *
3082
mktmp FCN((file_name, ext))
3083
outer_char *file_name C0("")@;
3084
outer_char *ext C1("")@;
3085
{
3086
outer_char *buffer;
3087
3088
#if(HAVE_TEMPNAM)
3089
extern char *tempnam();
3090
3091
if(!*wbprefix)
3092
STRCPY(wbprefix,"./");
3093
3094
buffer = (outer_char *)tempnam((char *)wbprefix, "FTMP");
3095
// Non-|ANSI|, but more control over directory.
3096
#else
3097
buffer = (outer_char *)tmpnam(NULL); // |ANSI| routine.
3098
#endif
3099
3100
STRCPY(file_name, buffer);
3101
3102
if(*ext)
3103
{
3104
STRCAT(file_name, ".");
3105
STRCAT(file_name, ext);
3106
}
3107
3108
return file_name;
3109
}
3110
3111
3112
@ When an include line of the form |#include <test.h>| is sensed in C or
3113
\Cpp, we would like to open the related file \.{test.H} and process it for
3114
format commands. (Processing \.{test.h} would format and cross-reference
3115
many variables that the user wouldn't care to know about.) See ``Push
3116
stack'' code in \.{common.web}.
3117
3118
@d change_params prms[incl_depth].input_params
3119
3120
@<Unused@>=
3121
3122
SRTN
3123
get_iformats(VOID)
3124
{
3125
outer_char temp[100], HUGE *period;
3126
int n;
3127
int new_depth;
3128
3129
preprocessing = sharp_include_line = NO;
3130
3131
STRNCPY(temp, id_first+1, n=PTR_DIFF(int, id_loc, id_first)-2);
3132
temp[n] = '\0';
3133
to_outer((ASCII HUGE *)temp);
3134
3135
if(!(period = (outer_char HUGE *)STRRCHR(temp, '.')))
3136
goto restore;
3137
3138
period[1] = '\0';
3139
STRCAT(temp, w_style.misc.include_ext);
3140
3141
if(++incl_depth >= (int)max_include_depth)
3142
{
3143
incl_depth--;
3144
err_print(C, "Too many nested includes; %d allowed. \
3145
Increase with `-yid'.", max_include_depth);
3146
@.Too many nested includes@>
3147
goto restore;
3148
}
3149
3150
{ /* No change file name specified; obtain it from the
3151
last level. */
3152
INPUT_PRMS *p_lower = &prms[incl_depth-1];
3153
INPUT_PRMS0 *p0_lower = &p_lower->change;
3154
3155
STRCPY(change_file_name,p0_lower->File_name);
3156
change_file = p0_lower->File;
3157
change_params = p_lower->input_params;
3158
}
3159
3160
STRCPY(cur_file_name, temp);
3161
new_depth = incl_depth;
3162
3163
{
3164
IN_COMMON INCL_PATHS incl;
3165
3166
if(ini_input_prms(CUR_FILE,incl.list,NO))
3167
{
3168
if(cur_prms.change->File != prms[incl_depth-1].change.File)
3169
{}
3170
else *cur_prms.change = prms[incl_depth-1].change;
3171
// Still using the old change file.
3172
3173
cur_line = 0;
3174
prn_where = YES;
3175
CLR_PRINTF(SHORT_INFO, include_file,
3176
(" (%s", (char *)cur_file_name));
3177
/* Tell the terminal where we're reading from. */
3178
}
3179
else
3180
{ /* Failed to open include file. */
3181
incl_depth--;
3182
}
3183
}
3184
3185
if(new_depth != incl_depth || !get_line())
3186
goto restore;
3187
3188
next_control = get_next();
3189
3190
while(new_depth == incl_depth)
3191
{
3192
switch(next_control)
3193
{
3194
case formatt:
3195
pr_format(NO, NO);
3196
break;
3197
3198
default:
3199
ERR_PRINT(W, "Invalid command in #include file");
3200
break;
3201
}
3202
}
3203
3204
restore:
3205
preprocessing = sharp_include_line = YES;
3206
}
3207
3208
@ At this point, we've sensed an explicit \.{@@(}.
3209
3210
@<Skip over meta-comment@>=
3211
{
3212
WHILE()
3213
{
3214
if(!get_line())
3215
{
3216
ERR_PRINT(W,"Input ended during meta-comment");
3217
break;
3218
}
3219
3220
if(loc[0] == @'@@' && loc[1] == @')')
3221
{ /* Sensed end-meta. */
3222
get_line();
3223
break;
3224
}
3225
}
3226
}
3227
3228
@ Here we're scanning an implicit (literal) |begin_meta|.
3229
3230
@<Skip over literal text@>=
3231
{
3232
WHILE()
3233
{
3234
if(loc > limit && !get_line())
3235
{
3236
next_control = new_module;
3237
break;
3238
}
3239
3240
if(loc[0] == @'@@')
3241
switch(loc[1])
3242
{
3243
case @'.':
3244
case @'^':
3245
case @'9':
3246
case @'*':
3247
case @' ':
3248
case @'<':
3249
goto done_meta;
3250
3251
case @'@@':
3252
loc += 2;
3253
}
3254
else
3255
loc++;
3256
}
3257
3258
done_meta:;
3259
}
3260
3261
@ For the forward-referencing facility, we need to format the variable of a
3262
\&{typedef} during phase~1. We mark the first variable we come to that isn't
3263
reserved and isn't enclosed by braces. (We must format identifiers even if
3264
they're inside braces.)
3265
@<Mark \&{typedef} variable@>=
3266
{
3267
int brace_level = 0;
3268
boolean typedefd_it = NO;
3269
3270
/* First, we scan over a possible |struct|. */
3271
while((next_control=get_next()) == identifier)
3272
if((p=id_lookup(id_first,id_loc,0))->ilk != struct_like)
3273
{
3274
new_xref(part0,p); // Structure name: ``|typedef struct s@;|''.
3275
next_control = get_next(); // Don't repeat the structure name.
3276
break;
3277
}
3278
3279
while(next_control <=module_name)
3280
{
3281
switch(next_control)
3282
{
3283
case @'{':
3284
case @'<':
3285
brace_level++;
3286
break;
3287
3288
case @'}':
3289
case @'>':
3290
if(brace_level-- == 0)
3291
{
3292
err_print(W, "Extra '%c' in typedef",
3293
XCHR(next_control));
3294
goto done;
3295
}
3296
break;
3297
3298
case identifier:
3299
p = id_lookup(id_first,id_loc,0);
3300
3301
if(brace_level == 0 && !typedefd_it)
3302
{
3303
if(is_reserved(p))
3304
break;
3305
3306
defd_switch = BOOLEAN(mark_defined.typedef_name);
3307
defd_type = TYPEDEF_NAME;
3308
typd_switch = YES;
3309
INDEX_SHORT;
3310
new_xref(part0,p);
3311
}
3312
else if(do_inside)
3313
new_xref(part0,p);
3314
3315
if(brace_level == 0 && !typedefd_it)
3316
typedefd_it = YES; /* Don't do any more (e.g., array
3317
dimensions). (But this means one can't yet do |BB| in |typedef int AA, BB@;|.) */
3318
break;
3319
3320
case formatt:
3321
case limbo_text:
3322
case op_def:
3323
case macro_def:
3324
case definition:
3325
case undefinition:
3326
case WEB_definition:
3327
case begin_code:
3328
case new_output_file:
3329
case protect_code:
3330
case keyword_name:
3331
CANT_DO(typedef);
3332
break;
3333
3334
case module_name:
3335
if(cur_module) new_mod_xref(cur_module);
3336
next_control = get_next();
3337
if(next_control == @'=')
3338
{
3339
ERR_PRINT(W,"'=' not allowed after @@<...@@> \
3340
inside typedef; check typedef syntax. Inserted ';'");
3341
next_control = @';';
3342
}
3343
continue;
3344
3345
case @';':
3346
if(brace_level == 0) goto done; // End of |typedef|.
3347
break;
3348
3349
case begin_comment:
3350
@<Handle a comment@>@;
3351
break;
3352
}
3353
3354
next_control = get_next();
3355
}
3356
3357
done:
3358
defd_switch = typd_switch = NO; // Just in case we screwed up.
3359
3360
if(next_control == new_module)
3361
{
3362
ERR_PRINT(W,"Module ended during typedef");
3363
goto end_xref;
3364
}
3365
}
3366
3367
@
3368
3369
@d CANT_DO(part) cant_do(OC(#part))
3370
3371
@<Part 1@>=@[
3372
SRTN
3373
cant_do FCN((the_part))
3374
outer_char *the_part C1("")@;
3375
{
3376
err_print(W, "You can't do that inside %s text", the_part);
3377
}
3378
3379
@ Similarly, \&{class} variables should be formatted during phase~1.
3380
@<Mark \&{class}...@>=
3381
{
3382
if((next_control=get_next()) == identifier)
3383
{
3384
p = id_lookup(id_first,id_loc,0);
3385
3386
defd_switch = BOOLEAN(mark_defined.typedef_name);
3387
defd_type = TYPEDEF_NAME;
3388
typd_switch = YES;
3389
INDEX_SHORT;
3390
3391
new_xref(part0,p);
3392
typd_switch = NO;
3393
}
3394
}
3395
3396
@ The |language| has already been set inside |get_next()| when we get to here.
3397
3398
@<Handle a possible language switch...@>=
3399
3400
switch(language)
3401
{
3402
case NO_LANGUAGE:
3403
CONFUSION("handle possible language switch",
3404
"A language hasn't been defined yet");
3405
3406
case FORTRAN:
3407
case FORTRAN_90:
3408
case RATFOR:
3409
case RATFOR_90:
3410
if(mode0 == OUTER && !free_form_input)
3411
@<Set up column mode@>@;
3412
break;
3413
3414
case TEX:
3415
if(mode0 == OUTER) @<Set up col...@>@;
3416
break;
3417
3418
case C:
3419
case C_PLUS_PLUS:
3420
case LITERAL:
3421
column_mode = NO;
3422
break;
3423
3424
case NUWEB_OFF:
3425
case NUWEB_ON:
3426
CONFUSION("handle possible language switch",
3427
"Langage %i is invalid", language);
3428
}
3429
3430
3431
@ The |outr_xref| subroutine is like |C_xref| but it begins with
3432
|next_control!='|'| and ends with |next_control>=formatt|. Thus, it handles
3433
\cee\ text with embedded comments.
3434
3435
@<Part 1@>=@[
3436
3437
SRTN
3438
outr_xref FCN((part0)) /* extension of |C_xref| */
3439
PART part0 C1("")@;
3440
{
3441
while (next_control<formatt)
3442
if(next_control != begin_comment)
3443
C_xref(part0, OUTER);
3444
else
3445
@<Handle a comment@>@;
3446
}
3447
3448
@ Deal with a comment inside C~text.
3449
@<Handle a comment@>=
3450
{
3451
int bal; // Brace level in comment.
3452
3453
bal = copy_comment(1); next_control = @'|';
3454
3455
doing_cdir = NO;
3456
3457
while (bal>0)
3458
{ /* Inside comment. */
3459
in_comment = YES;
3460
C_xref(part0,INNER);
3461
3462
if (next_control==@'|')
3463
bal = copy_comment(bal);
3464
else
3465
bal = 0; // An error message will occur in phase 2.
3466
}
3467
}
3468
3469
@ In the \TeX\ part of a module, cross-reference entries are made only for
3470
the identifiers in \cee\ texts enclosed in~\Cb, or for control texts
3471
enclosed in \.{@@\^}$\,\ldots\,$\.{@@>} or \.{@@.}$\,\ldots\,$\.{@@>} or
3472
\.{@@9}$\,\ldots\,$\.{@@>}.
3473
3474
@<Store cross-references in the \T...@>=
3475
{
3476
the_part = TEX_;
3477
3478
do_inside = YES; // So don't eliminate the user cross-references.
3479
3480
WHILE()
3481
{
3482
switch (next_control=skip_TeX())
3483
{
3484
@<Specific language cases@>:
3485
loc--; // Falls through to general case below.
3486
3487
case L_switch:
3488
{
3489
@<Set the |language|...@>;
3490
continue;
3491
}
3492
3493
case begin_nuweb:
3494
nuweb_mode = !NUWEB_MODE;
3495
continue;
3496
3497
case toggle_output:
3498
@<Toggle output@>@;
3499
continue;
3500
3501
case underline:
3502
xref_switch = def_flag;
3503
continue;
3504
3505
#ifdef DEBUG
3506
case trace: tracing=next_control-@'0'; continue;
3507
#endif /* |DEBUG| */
3508
3509
case @'|':
3510
while(next_control <= module_name)
3511
{
3512
C_xref(TEX_,INNER);
3513
3514
if(next_control == @'|' || next_control == new_module)
3515
break;
3516
3517
next_control = get_next();
3518
3519
if(next_control == @'|')
3520
break;
3521
}
3522
3523
break;
3524
3525
case xref_roman: case xref_wildcard: case xref_typewriter:
3526
case macro_module_name: case module_name:
3527
case keyword_name:
3528
loc-=2; next_control=get_next(); // Scan to \.{@@>}.
3529
3530
if( !(next_control==module_name ||
3531
next_control==macro_module_name) )
3532
new_xref(TEX_,id_lookup(id_first,id_loc,
3533
(eight_bits)(next_control-identifier)));
3534
break;
3535
3536
case invisible_cmnt:
3537
loc = limit + 1;
3538
break;
3539
}
3540
3541
if (next_control>=formatt)
3542
break;
3543
}
3544
}
3545
3546
@ During the definition and \cee\ parts of a module, cross-references are
3547
made for all identifiers except reserved words; however, the identifiers in
3548
a format definition are referenced even if they are reserved. The \TeX\
3549
code in comments is, of course, ignored, except for \cee\ portions enclosed
3550
in~\Cb; the text of a module name is skipped entirely, even if it contains
3551
\Cb~constructions.
3552
3553
The variables |lhs| and |rhs| point to the respective identifiers involved
3554
in a format definition.
3555
3556
@<Global...@>=
3557
3558
EXTERN name_pointer lhs, rhs; /* pointers to |byte_start| for format
3559
identifiers */
3560
3561
@ When we get to the following code we have |next_control>=formatt|.
3562
3563
@d KILL_XREFS(name) no_xref |= !defn_mask.name
3564
@d INDEX_SHORT index_short = index_flag = YES // Implicit \.{@@~}.
3565
3566
@<Store cross-references in the d...@>=
3567
{
3568
boolean no_xref0 = no_xref;
3569
3570
the_part = DEFINITION;
3571
3572
while (next_control<begin_code)
3573
{ /* |formatt| or |definition| or |WEB_definition| or \.{@@\#...}
3574
command. */
3575
switch(next_control)
3576
{
3577
case WEB_definition:
3578
if(mark_defined.WEB_macro && lower_case_code)
3579
defd_switch = YES; // Implied \.{@@[}.
3580
3581
xref_switch = def_flag; /* Implied \.{@@\_} */
3582
defd_type = M_MACRO;
3583
3584
KILL_XREFS(macros);
3585
INDEX_SHORT;
3586
break;
3587
3588
case m_undef:
3589
KILL_XREFS(macros);
3590
INDEX_SHORT;
3591
break;
3592
3593
case definition:
3594
if(mark_defined.outer_macro && mark_defined.outer_macro)
3595
defd_switch = YES; // Implied \.{@@[}.
3596
3597
xref_switch = def_flag; /* Implied \.{@@\_} */
3598
defd_type = D_MACRO;
3599
3600
KILL_XREFS(outer_macros);
3601
INDEX_SHORT;
3602
break;
3603
3604
case undefinition:
3605
KILL_XREFS(outer_macros);
3606
INDEX_SHORT;
3607
break;
3608
3609
case m_ifdef:
3610
case m_ifndef:
3611
INDEX_SHORT;
3612
break;
3613
}
3614
3615
switch(next_control)
3616
{
3617
case formatt:
3618
pr_format(YES, YES);
3619
break;
3620
3621
case limbo_text:
3622
@<Absorb limbo text@>@;
3623
break;
3624
3625
case op_def:
3626
@<Overload an operator@>@;
3627
break;
3628
3629
case macro_def:
3630
@<Overload an identifier@>@;
3631
break;
3632
3633
case invisible_cmnt:
3634
loc = limit + 1; // Skip the line.
3635
3636
default:
3637
next_control=get_next();
3638
break;
3639
}
3640
3641
outr_xref(DEFINITION);
3642
no_xref = no_xref0;
3643
}
3644
}
3645
3646
@ The syntax of a format definition is ``\.{@@f\ new\_name\ old\_name}'' or
3647
``\.{@@f\ `\{\ 10}''. Error messages for improper format definitions of
3648
the first kind will be issued in phase two; for the second kind, in phase
3649
one. For the first kind, our job in phase one is to define the |ilk| of a
3650
properly formatted identifier, and to fool the |new_xref| routine into
3651
thinking that the identifier on the right-hand side of the format
3652
definition is not a reserved word. For the second kind, we must actually
3653
change the category code of a \TeX\ character, and that must be done in
3654
phase one so future identifiers can be resolved properly.
3655
3656
@<Part 1@>=@[
3657
3658
SRTN
3659
pr_format FCN((xref_lhs, xref_rhs))
3660
boolean xref_lhs C0("")@;
3661
boolean xref_rhs C1("")@;
3662
{
3663
eight_bits last_control,rhs_ilk;
3664
LANGUAGE saved_language = language;
3665
3666
if(upper_case_code)
3667
KILL_XREFS(Formats);
3668
else
3669
KILL_XREFS(formats);
3670
3671
INDEX_SHORT;
3672
3673
if(language==TEX)
3674
language = C;
3675
3676
last_control = next_control = get_next(); /* Identifier or module name to be
3677
formatted, or |ASCII| character. */
3678
3679
if (next_control==identifier || next_control==module_name)
3680
@<Process an identifier or module name@>@;
3681
else if(next_control==@'`')
3682
@<Change a category code@>@;
3683
3684
if(saved_language==TEX)
3685
language = saved_language;
3686
}
3687
3688
@ Here we deal with format commands of the form ``\.{@@f\ new\_name\
3689
old\_name}''.
3690
3691
@<Process an identifier...@>=
3692
{
3693
if(next_control==identifier)
3694
{
3695
lhs=id_lookup(id_first, id_loc, normal);
3696
lhs->ilk=normal;
3697
3698
if(xref_lhs)
3699
new_xref(DEFINITION,lhs);
3700
}
3701
else
3702
lhs = cur_module;
3703
3704
next_control=get_next();
3705
3706
if (next_control==identifier)
3707
{ /* Format the lhs like this one. */
3708
rhs=id_lookup(id_first, id_loc,normal);
3709
3710
if(lhs != NULL)
3711
{
3712
if(last_control==identifier)
3713
@<Format the left-hand side@>@;
3714
else
3715
lhs->mod_ilk = rhs->ilk;
3716
// We're formatting a module name.
3717
}
3718
3719
/* Take care of the possibility that the rhs may not yet have been
3720
encountered. */
3721
if(xref_rhs)
3722
{
3723
rhs_ilk = rhs->ilk;
3724
rhs->ilk=normal;
3725
3726
new_xref(DEFINITION,rhs);
3727
3728
rhs->ilk=rhs_ilk;
3729
}
3730
3731
next_control=get_next();
3732
}
3733
}
3734
3735
@ Set the appropriate format bit.
3736
@<Format the left-hand side@>=
3737
{
3738
lhs->ilk = rhs->ilk;
3739
3740
/* First turn off the old lhs bit (retaining all others), then add in the
3741
new bit for the current language. */
3742
#define RST_BIT(field) lhs->field = BOOLEAN(lhs->field & ~(boolean)language)\
3743
| (rhs->field & (boolean)language)
3744
3745
RST_BIT(reserved_word);
3746
RST_BIT(Language);
3747
RST_BIT(intrinsic_word);
3748
RST_BIT(keyword);
3749
3750
#undef RST_BIT
3751
}
3752
3753
@ Here we consider format commands of the form ``\.{@@f\ `\{\ 10}''.
3754
|get_TeX|~leaves the (|outer_char|) constant string between
3755
[|id_first|,|id_loc|).
3756
@<Change a category code@>=
3757
{
3758
if((next_control = get_TeX()) != constant)
3759
ERR_PRINT(W,"Invalid @@f command: \
3760
One of the representations `a, `\\a, or `^^M is required");
3761
else
3762
{
3763
int c = TeX_char(); // Convert the |ASCII| code in |id_first|.
3764
3765
next_control = get_next(); // Now expecting integer category code.
3766
3767
if(next_control != constant) ERR_PRINT(W,"Invalid category code");
3768
else
3769
{
3770
TeX_CATEGORY cat;
3771
3772
TERMINATE(id_loc,0);
3773
cat = (TeX_CATEGORY)ATOI(id_first);
3774
// Numerical value of new cat code.
3775
3776
if((int)cat < 0 || (int)cat > 15)
3777
ERR_PRINT(W,"Category code must be between 0 and 15");
3778
else TeX[c] = cat; // Change the category code.
3779
3780
next_control = get_next();
3781
}
3782
}
3783
}
3784
3785
@ We require a special routine to obtain an |ASCII| character in \TeX's
3786
representation after a~'\.`'. On entry, |loc|~is positioned after
3787
the~'\.`'. The possible representations are~`\.{a}', `\.{\\a}',
3788
or~`\.{\^\^M}'.
3789
3790
@<Part 1@>=@[
3791
3792
eight_bits
3793
get_TeX(VOID)
3794
{
3795
if(loc >= limit)
3796
{
3797
ERR_PRINT(W,"@@f line ends prematurely");
3798
return ignore;
3799
}
3800
3801
id_first = id_loc = mod_text + 1;
3802
3803
if(*loc == @'\\') *id_loc++ = *loc++;
3804
else if(*loc == @'^' && *(loc+1) == @'^')
3805
{ // \TeX's way of representing control characters.
3806
*id_loc++ = *loc++; @~ *id_loc++ = *loc++;
3807
}
3808
3809
if(*loc == @'@@')
3810
if(*(loc+1) == @'@@') loc++;
3811
else ERR_PRINT(W,"You should say `@@@@");
3812
3813
*id_loc++ = *loc++; // Position to next non-processed character.
3814
*id_loc = '\0';
3815
3816
id_first = esc_buf(id_loc+1,mod_end,id_first,YES);
3817
to_outer(id_first);
3818
3819
return constant;
3820
}
3821
3822
@ Here we convert the constant obtained in the previous routine into an
3823
|ASCII| character.
3824
@<Part 1@>=@[
3825
3826
int
3827
TeX_char(VOID)
3828
{
3829
int c;
3830
3831
while(*id_first == @'\\') id_first++;
3832
3833
if(*id_first == @'^' && *(id_first+1) == @'^')
3834
{
3835
c = *(id_first+2);
3836
if(c >= 64) c -= 64;
3837
else c += 64;
3838
}
3839
else c = *id_first;
3840
3841
return c;
3842
}
3843
3844
@ Limbo text commands have the form ``\.{@@l\ "abc\\ndef"}'', and must be
3845
absorbed during phase one so they can be dumped out at the beginning of
3846
phase two.
3847
3848
@<Absorb limbo text@>=
3849
{
3850
LANGUAGE language0 = language;
3851
3852
KILL_XREFS(limbo);
3853
3854
if(language==TEX)
3855
language = C; // In order to absorb strings properly.
3856
3857
insert_breaks = NO; // We want the string to be absorbed completely literally.
3858
3859
if((next_control = get_next()) != stringg)
3860
ERR_PRINT(W,"String must follow @@l");
3861
else
3862
{ // Begin by stripping off delimiting quotes.
3863
for(id_first++,id_loc--; id_first<id_loc; )
3864
{
3865
if(*id_first==@'@@')
3866
{
3867
if(*(id_first+1)==@'@@')
3868
id_first++;
3869
else
3870
ERR_PRINT(W,"Double @@ should be used in strings");
3871
}
3872
3873
/* Deal with escape sequences. */
3874
if(*id_first == @'\\')
3875
{
3876
id_first++;
3877
/* Splitting the following line before |HUGE| led to compiler problem with
3878
VAX/VMS. */
3879
app_tok(esc_achar(
3880
(CONST ASCII HUGE*HUGE*)&id_first))@;
3881
}
3882
else
3883
app_tok(*id_first++);
3884
}
3885
3886
freeze_text; /* We'll know we've collected stuff because |text_ptr|
3887
will be advanced. */
3888
}
3889
3890
insert_breaks = YES;
3891
3892
language = language0;
3893
}
3894
3895
@ The syntax of an operator-overloading command is
3896
``\.{@@v\ .IN.\ "\\in"\ +}''.
3897
3898
@<Overload an op...@>=
3899
{
3900
OPERATOR HUGE *p,HUGE *p1;
3901
3902
KILL_XREFS(v);
3903
3904
/* Look at the first field, which should be an operator or a dot-op. */
3905
next_control = get_next();
3906
3907
if(next_control == identifier)
3908
ERR_PRINT(W,"For future compatibility, please use syntax `.NAME.' for \
3909
overloading dot operators");
3910
3911
if(!(p=valid_op(next_control)))
3912
ERR_PRINT(W,"Operator after @@v is invalid");
3913
else
3914
{
3915
if(get_next() != stringg)
3916
ERR_PRINT(W,"Second argument (replacement text) \
3917
of @@v must be a quoted string");
3918
else
3919
{
3920
int k = language_num;
3921
OP_INFO HUGE *q = p->info + k;
3922
int n = PTR_DIFF(int, id_loc, id_first) - 2; /* Don't count the
3923
string delimiters. */
3924
outer_char HUGE *s;
3925
3926
if(q->defn) FREE_MEM(q->defn,"q->defn",STRLEN(q->defn)+1,
3927
outer_char);
3928
q->defn = GET_MEM("q->defn",n+1,outer_char);
3929
3930
*(id_loc-1) = '\0'; // Kill off terminating quote.
3931
3932
for(s=q->defn,id_first++; *id_first; s++)
3933
if(*id_first == @'\\')
3934
{
3935
id_first++;
3936
*s = XCHR(esc_achar((CONST ASCII HUGE
3937
*HUGE*)&id_first));
3938
}
3939
else *s = XCHR(*id_first++);
3940
3941
overloaded[k] = q->overloaded = YES;
3942
3943
/* There may be several representations with the same name. */
3944
for(p1=op; p1<op_ptr; p1++)
3945
{
3946
if(p1==p || !p1->op_name) continue;
3947
3948
if(STRCMP(p1->op_name,p->op_name) == 0)
3949
{
3950
OP_INFO HUGE *q1 = p1->info + k;
3951
3952
if(q1->defn) FREE_MEM(q1->defn,"q1->defn",
3953
STRLEN(q1->defn)+1,outer_char);
3954
q1->defn = GET_MEM("q1->defn",n+1,outer_char);
3955
STRCPY(q1->defn,q->defn);
3956
q1->overloaded = YES;
3957
}
3958
}
3959
3960
/* Get the new category and set it. If the last construction isn't
3961
recognized as a valid operator, the category is set to |expr|. */
3962
p = valid_op(next_control=get_next());
3963
3964
q->cat = (p ? p->info[k].cat : (eight_bits)expr);
3965
}
3966
}
3967
}
3968
3969
@ The syntax for overloading an identifier is ``\.{@@w\ \It{id}\
3970
"\dots"}'', or the string replacement text can be replaced by~'\..', which
3971
means just prepend a backslash to make it into a macro name.
3972
3973
@d QUICK_FORMAT @'.' // The shorthand for overloading like itself.
3974
3975
@<Overload an id...@>=
3976
{
3977
if((next_control=get_next()) != identifier)
3978
ERR_PRINT(W,"Identifier must follow @@w");
3979
else
3980
{
3981
name_pointer p = id_lookup(id_first,id_loc,normal);
3982
int n,offset;
3983
WV_MACRO HUGE *w;
3984
ASCII HUGE *s;
3985
ASCII HUGE *id_first0, HUGE *id_loc0;
3986
3987
/* Index the identifier (but not defined). Force short identifiers to be
3988
indexed. */
3989
KILL_XREFS(w);
3990
INDEX_SHORT;
3991
new_xref(DEFINITION, p);
3992
3993
/* Remember the first identifier. */
3994
id_first0 = id_first;
3995
id_loc0 = id_loc;
3996
3997
switch(next_control=get_next())
3998
{
3999
case @'\\':
4000
if((next_control = get_next()) != identifier)
4001
{
4002
ERR_PRINT(W,"Identifier must follow '\\'");
4003
break;
4004
}
4005
4006
next_control = ignore; /* We don't want to put the
4007
identifier into the index. */
4008
goto quick_code;
4009
4010
4011
case QUICK_FORMAT:
4012
id_first = id_first0;
4013
id_loc = id_loc0;
4014
4015
quick_code:
4016
offset = 1;
4017
n = PTR_DIFF(int, id_loc, id_first) + 1;
4018
*id_loc = '\0';
4019
goto fmt_like_string;
4020
4021
case stringg:
4022
{
4023
offset = 0;
4024
n = PTR_DIFF(int, id_loc, id_first) - 2; // Don't count quotes.
4025
*(id_loc-1) = '\0';
4026
id_first++; // Skip over opening quote.
4027
4028
fmt_like_string:
4029
p->wv_macro = w = GET_MEM("wv_macro",1,WV_MACRO);
4030
w->text = GET_MEM("w->text",n+1,outer_char);
4031
4032
if(offset) *w->text = @'\\';
4033
4034
for(s=w->text + offset; *id_first; s++)
4035
if(*id_first == @'\\')
4036
{
4037
id_first++;
4038
*s = esc_achar((CONST ASCII HUGE
4039
*HUGE*)&id_first);
4040
}
4041
else *s = *id_first++;
4042
4043
w->len = PTR_DIFF(unsigned, s, w->text);
4044
4045
w->cat = (eight_bits)(upper_case_code ? 0 : expr); // Temporary
4046
}
4047
break;
4048
4049
default:
4050
ERR_PRINT(W,"Second argument (replacement text) \
4051
of @@w must be either a quoted string or '.' or have the form \\name");
4052
break;
4053
}
4054
}
4055
}
4056
4057
@ Finally, when the \TeX\ and definition parts have been treated, we have
4058
|next_control>=begin_code|.
4059
4060
@<Glob...@>=
4061
4062
EXTERN boolean unnamed_section SET(NO);
4063
4064
@
4065
@<Store cross-references in the \cee...@>=
4066
{
4067
the_part = CODE;
4068
4069
if (next_control<=module_name)
4070
{ /* |begin_code| or |module_name| */
4071
boolean beginning_module = YES;
4072
4073
if(next_control==begin_code)
4074
{
4075
boolean nuweb_mode0 = nuweb_mode;
4076
4077
unnamed_section = YES;
4078
4079
params = global_params;
4080
nuweb_mode = nuweb_mode0;
4081
frz_params();
4082
4083
mod_xref_switch = NO;
4084
4085
if(mark_defined.fcn_name && lower_case_code)
4086
{
4087
defd_switch = YES; // Implicit \.{@@[}.
4088
defd_type = FUNCTION_NAME;
4089
}
4090
}
4091
else
4092
{
4093
unnamed_section = NO;
4094
mod_xref_switch = def_flag;
4095
}
4096
4097
4098
do
4099
{
4100
if (next_control==module_name && cur_module)
4101
new_mod_xref(cur_module);
4102
4103
if(beginning_module)
4104
{
4105
if(mod_xref_switch)
4106
next_control = get_next();
4107
else
4108
next_control = @'='; // For |begin_code|.
4109
4110
if(next_control==@'=')
4111
if( !nuweb_mode && ((FORTRAN_LIKE(language) && !free_form_input)
4112
|| (language==TEX)) )
4113
@<Set up column mode@>@;
4114
4115
beginning_module = NO;
4116
}
4117
else next_control = get_next();
4118
4119
outr_xref(CODE);
4120
}
4121
while (next_control<=module_name)
4122
; // Hunt for new module.
4123
4124
column_mode = NO; // Turn off the FORTRAN verbatim input mode.
4125
unnamed_section = NO; // Don't deflect cross-references.
4126
}
4127
}
4128
4129
@ After phase one has looked at everything, we want to check that each
4130
module name was both defined and used. The variable |cur_xref| will point
4131
to cross-references for the current module name of interest.
4132
4133
@d IS_ON(flag, bits) ((flag) & (bits))
4134
4135
@d NEVER_USED 1
4136
@d MULTIPLE_USES 2
4137
4138
@<Global...@>=
4139
4140
EXTERN xref_pointer cur_xref; /* temporary cross-reference pointer */
4141
IN_COMMON boolean mod_warning_flag;
4142
4143
@ The following recursive procedure
4144
walks through the tree of module names and prints out anomalies.
4145
@^recursion@>
4146
4147
@<Part 1@>=@[
4148
4149
int
4150
mod_check FCN((p))
4151
name_pointer p C1("Print anomalies in subtree |p|.")@;
4152
{
4153
int status = 0;
4154
4155
struct
4156
{
4157
int never_defined:1, never_used:1, multiple_uses:1;
4158
} anomalies;
4159
4160
anomalies.never_defined = anomalies.never_used = anomalies.multiple_uses = NO;
4161
4162
if (p)
4163
{
4164
short n_uses;
4165
4166
status |= mod_check(p->llink);
4167
4168
cur_xref = (xref_pointer)p->xref;
4169
4170
if(cur_xref->num <def_flag)
4171
anomalies.never_defined = YES;
4172
4173
while (cur_xref->num >= def_flag)
4174
cur_xref = cur_xref->xlink;
4175
4176
if(cur_xref==xmem)
4177
anomalies.never_used = YES;
4178
4179
n_uses = p->mod_info->params.uses;
4180
4181
if(n_uses > 1)
4182
anomalies.multiple_uses = YES;
4183
4184
if(anomalies.never_defined || anomalies.never_used
4185
|| anomalies.multiple_uses)
4186
{
4187
boolean warning_printed = NO;
4188
4189
SET_COLOR(warning);
4190
4191
if(anomalies.never_defined)
4192
{
4193
SET_COLOR(error);
4194
warning_printed = mod_warn(p, OC("never defined"));
4195
@.Never defined: <section name>@>
4196
mark_error;
4197
}
4198
4199
if(anomalies.never_used && IS_ON(mod_warning_flag, NEVER_USED))
4200
{
4201
if(warning_printed)
4202
printf("; ");
4203
else
4204
warning_printed = mod_warn(p, OC("never used"));
4205
}
4206
@.Never used: <section name>@>
4207
4208
if(anomalies.multiple_uses
4209
&& IS_ON(mod_warning_flag, MULTIPLE_USES))
4210
{
4211
if(warning_printed)
4212
printf("; ");
4213
else
4214
{
4215
warning_printed
4216
= mod_warn(p, OC("multiple uses"));
4217
4218
printf(" (%i)", n_uses);
4219
}
4220
}
4221
@.Multiple uses: <section name>@>
4222
4223
if(warning_printed)
4224
{
4225
printf("."), fflush(stdout);
4226
status = warning_printed;
4227
}
4228
}
4229
4230
status |= mod_check(p->rlink);
4231
}
4232
4233
return status;
4234
}
4235
4236
@
4237
@<Part 1@>=@[
4238
int
4239
mod_warn FCN((p, msg))
4240
name_pointer p C0("")@;
4241
outer_char *msg C1("")@;
4242
{
4243
printf("\n%c! ", beep(1));
4244
SET_COLOR(md_name);
4245
printf("<");
4246
prn_id(p);
4247
printf(">");;
4248
set_color(color0.last);
4249
printf(": ");
4250
printf((char *)msg);
4251
mark_harmless;
4252
return YES;
4253
}
4254
4255
@ Start off at the top of the tree.
4256
4257
@<Print error messages about un...@>=
4258
{
4259
if(mod_check(root) && msg_level < SHORT_INFO)
4260
new_line;
4261
else
4262
fflush(stdout);
4263
}
4264
4265
@* LOW-LEVEL OUTPUT ROUTINES.
4266
The \TeX\ output is supposed to appear in lines at most |line_length|
4267
characters long, so we place it into an output buffer. During the output
4268
process, |out_line| will hold the current line number of the line about to
4269
be output.
4270
4271
@d CHECK_OPEN // This is defined differently in \FTANGLE.
4272
4273
@<Global...@>=
4274
4275
EXTERN BUF_SIZE line_length;
4276
EXTERN ASCII HUGE *out_buf; // Assembled characters.
4277
EXTERN ASCII HUGE *out_end; // End of |out_buf|.
4278
4279
EXTERN ASCII HUGE *out_ptr; // Points to last character in |out_buf|.
4280
EXTERN LINE_NUMBER out_line; // number of next line to be output.
4281
4282
@
4283
@<Alloc...@>=
4284
4285
ALLOC(ASCII,out_buf,ABBREV(line_length),line_length,1); /* assembled
4286
characters */
4287
out_end = out_buf+line_length; /* end of |out_buf| */
4288
4289
@ The |flush_buffer| routine empties the buffer up to a given breakpoint,
4290
and moves any remaining characters to the beginning of the next line. If
4291
the |per_cent| parameter is |YES|, a |'%'|~is appended to the line that is
4292
being output; in this case the breakpoint~|b| should be strictly less than
4293
|out_end|. If the |per_cent| parameter is |NO|, trailing blanks are
4294
suppressed. The characters emptied from the buffer form a new line of
4295
output.
4296
4297
The same caveat that applies to |ASCII_write| applies to |c_line_write|. (??)
4298
4299
@d OUT_FILE tex_file
4300
@d C_LINE_WRITE(n)
4301
fflush(tex_file),FWRITE(out_buf+1,n,tex_file)
4302
@d ASCII_LINE_WRITE(n)
4303
fflush(tex_file),ASCII_file_write(tex_file,out_buf+1,(size_t)(n))@;
4304
@d TEX_PUTXCHAR(c) PUTC(c) // Send an |outer_char| to the \.{TEX} file.
4305
@d TEX_NEW_LINE PUTC('\n') // A newline to the \.{TEX} file.
4306
@d TEX_PRINTF(s) fprintf(tex_file,s) // A string to the \.{TEX} file.
4307
4308
@<Part 1@>=@[
4309
4310
SRTN
4311
flush_buffer FCN((b, per_cent))
4312
ASCII HUGE *b C0("")@;
4313
boolean per_cent C1("Outputs from |out_buf+1| to |b|, \
4314
where |b<=out_ptr|.")@;
4315
{
4316
ASCII HUGE *j;
4317
ASCII HUGE *out_start;
4318
4319
if(output_on)
4320
{
4321
out_start = out_buf + 1;
4322
j = b; // Pointer into |out_buffer|.
4323
4324
/* Remove trailing blanks. */
4325
if(!per_cent)
4326
while (j>out_buf && *j==@' ')
4327
j--;
4328
4329
ASCII_LINE_WRITE(j-out_buf);
4330
4331
if (per_cent)
4332
TEX_PUTXCHAR('%');
4333
4334
if(*b != @'\n')
4335
TEX_NEW_LINE; // Nuweb mode has explicit newlines.
4336
4337
out_line++;
4338
4339
if (b<out_ptr)
4340
{
4341
if(*out_start == @'%')
4342
out_start++;
4343
4344
STRNCPY(out_start, b+1, PTR_DIFF(size_t,out_ptr,b));
4345
}
4346
4347
out_ptr -= b - out_start + 1;
4348
}
4349
else
4350
out_ptr = out_buf;
4351
}
4352
4353
@ When we are copying \TeX\ source material, we retain line breaks that
4354
occur in the input, except that an empty line is not output when the \TeX\
4355
source line was nonempty. For example, a line of the \TeX\ file that
4356
contains only an index cross-reference entry will not be copied. The
4357
|fin_line| routine is called just before |get_line| inputs a new line,
4358
and just after a line break token has been emitted during the output of
4359
translated \cee\ text.
4360
4361
@<Part 1@>=@[
4362
4363
SRTN
4364
fin_line(VOID) /* do this at the end of a line */
4365
{
4366
ASCII HUGE *k; // Pointer into |cur_buffer|.
4367
4368
if (out_ptr>out_buf)
4369
flush_buffer(out_ptr, NO); // Something nontrivial in line.
4370
else
4371
{
4372
/* Don't output an empty line when \TeX\ source line is nonempty. */
4373
for (k=cur_buffer; k<=limit; k++)
4374
if (*k!=@' ' && *k!=tab_mark)
4375
return;
4376
4377
flush_buffer(out_buf, NO); // Empty line.
4378
}
4379
}
4380
4381
@ In particular, the |fin_line| procedure is called near the very
4382
beginning of phase two. We initialize the output variables in a slightly
4383
tricky way so that the first line of the output file will be `\.{\\input
4384
fwebmac}'. This is the default. However, occasionally, one may need to
4385
load other macro packages before \.{fwebmac}. To prevent this first line to
4386
be generated, use the command line option~``\.{-w}''. To change the name
4387
of the default, way ``\.{-wnew\_name}''---for example, ``\.{-wfmac.sty}''.
4388
4389
@<Set init...@>=
4390
{
4391
out_ptr = out_buf; out_line = 1;
4392
4393
if(input_macros)
4394
{
4395
4396
TEX_PRINTF("%% --- FWEB's macro package ---\n\\input ");
4397
OUT_STR(*fwebmac ? fwebmac : w_style.misc.macros); /* The command
4398
line overrides the style file. */
4399
}
4400
}
4401
4402
@ When the `\.{@@I}'~command is used in conjunction with the command-line
4403
option `\.{-i}', we process the incoming text, but don't write it out. We
4404
need an output flag to tell us when output is allowed.
4405
4406
@<Glob...@>=
4407
4408
EXTERN boolean output_on SET(YES);
4409
4410
@ When we wish to append one character~|c| to the output buffer, we write
4411
`|out(c)|'; this will cause the buffer to be emptied if it was already
4412
full. |c|~is assumed to be of type |ASCII|. If we want to append more
4413
than one character at once, we say |OUT_STR(s)|, where |s|~is a string
4414
containing the characters, or |out_del_str(s,t)| (``output a delimited
4415
string''), where~|s| and~|t| point to the same array of characters (stored
4416
as 16-bit tokens); characters from~|s| to~|t-1|, inclusive, are output. The
4417
|out_str| routine takes an |outer_char| string as an argument, since this
4418
is typically used as a print statement from inside the code.
4419
4420
A line break will occur at a space or after a single-nonletter \TeX\
4421
control sequence.
4422
4423
@d out(c)
4424
{
4425
if(out_ptr >= out_end)
4426
break_out();
4427
*(++out_ptr) = (ASCII)(c);
4428
}
4429
4430
@d OUT_STR(s) out_str(OC(s))
4431
4432
@<Part 1@>=@[
4433
4434
SRTN
4435
out_del_tokens FCN((s, t)) /* output |ASCII| tokens from |s| to |t-1|. */
4436
token_pointer s C0("")@;
4437
token_pointer t C1("")@;
4438
{
4439
if(!output_on)
4440
return; // Skip output.
4441
4442
while (s < t)
4443
out(*s++);
4444
}
4445
4446
SRTN
4447
out_del_str FCN((s, t)) /* output |ASCII| characters from |s| to |t-1|. */
4448
ASCII HUGE *s C0("")@;
4449
ASCII HUGE *t C1("")@;
4450
{
4451
if(!output_on)
4452
return; // Skip output.
4453
4454
while (s < t)
4455
out(*s++);
4456
}
4457
4458
SRTN
4459
out_str FCN((s)) /* output |outer_char| characters from |s| to end of string */
4460
CONST outer_char HUGE *s C1("")@;
4461
{
4462
if(!output_on)
4463
return; // Skip output.
4464
4465
while (*s)
4466
out(XORD(*s++));
4467
}
4468
4469
@ Here we write an |outer_char| file name. We have to watch out for special
4470
characters.
4471
@<Part 1@>=@[
4472
4473
SRTN
4474
out_fname FCN((s))
4475
CONST outer_char HUGE *s C1("File name to be written.")@;
4476
{
4477
ASCII a;
4478
4479
while(*s)
4480
{
4481
a = XORD(*s++);
4482
4483
switch(a)
4484
{
4485
@<Special string cases@>:
4486
out(@'\\');
4487
break;
4488
}
4489
out(a);
4490
}
4491
}
4492
4493
@ Escape and output an |ASCII| string.
4494
@<Part 1@>=@[
4495
4496
SRTN
4497
out_atext FCN((s))
4498
CONST ASCII HUGE *s C1("ASCII text to be written.")@;
4499
{
4500
while(*s)
4501
{
4502
switch(*s)
4503
{
4504
@<Special string cases@>:
4505
out(@'\\');
4506
break;
4507
}
4508
out(*s++);
4509
}
4510
}
4511
4512
@ The |break_out| routine is called just before the output buffer is about
4513
to overflow. To make this routine a little faster, we initialize position~0
4514
of the output buffer to~'\.\\'; this character isn't really output.
4515
4516
@<Set init...@>=
4517
4518
out_buf[0] = @'\\';
4519
4520
@ A long line is broken at a blank space or a newline (which may enter from
4521
a limbo string), or just before a backslash that isn't preceded by another
4522
backslash or a newline. In the latter case, a~|'%'| is output at the break.
4523
4524
@<Part 1@>=@[
4525
4526
SRTN
4527
break_out(VOID) /* finds a way to break the output line */
4528
{
4529
ASCII HUGE *k = out_ptr; /* pointer into |out_buf| */
4530
boolean is_tex_comment = BOOLEAN(*(out_buf+1) == @'%');
4531
4532
if(nuweb_mode)
4533
WHILE()
4534
{
4535
if(k==out_buf)
4536
@<Print warning message, break the line, and |return|@>;
4537
4538
if(STRNCMP(k, "\\WEM ", 4) == 0)
4539
{ /* |ASCII|/|outer_char| conflict! */
4540
flush_buffer(k+=4, NO);
4541
break;
4542
}
4543
4544
if(*(k--) == @'\n')
4545
{
4546
flush_buffer(++k, NO);
4547
break;
4548
}
4549
}
4550
else
4551
WHILE()
4552
{
4553
if (k==out_buf)
4554
@<Print warning message, break the line, and |return|@>;
4555
4556
if (*k==@' ')
4557
{
4558
flush_buffer(k, NO);
4559
break;
4560
}
4561
4562
if (*k==@'\n' && k[-1] != @'\n')
4563
{/* Get the per-cent sign before the newline. */
4564
*k = @'%';
4565
flush_buffer(k, NO); // Kill off the newline.
4566
break;
4567
}
4568
4569
if (*(k--)==@'\\' && *k!=@'\\' && *k != @'\n')
4570
{ /* we've decreased |k| */
4571
flush_buffer(k, YES);
4572
break;
4573
}
4574
}
4575
4576
if(is_tex_comment)
4577
*(++out_ptr) = @'%';
4578
}
4579
4580
@ We get to this module only in unusual cases that the entire output line
4581
consists of a string of backslashes followed by a string of nonblank
4582
non-backslashes. In such cases it is almost always safe to break the line
4583
by putting a~|'%'| just before the last character.
4584
4585
@<Print warning message...@>=
4586
{
4587
SET_COLOR(warning);
4588
printf("\n! Line had to be broken (output l. %u):\n",out_line);
4589
@.Line had to be broken@>
4590
ASCII_write(out_buf+1, out_ptr-out_buf-1);
4591
new_line;
4592
mark_harmless;
4593
flush_buffer(out_ptr-1, YES);
4594
return;
4595
}
4596
4597
@ Here is a macro that outputs a module number in decimal notation. The
4598
number to be converted by |out_mod| is known to be less than |def_flag|, so
4599
it cannot have more than five decimal digits. If the module is changed, we
4600
output~`\.{\\*}' just after the number.
4601
4602
@<Part 1@>=@[
4603
4604
SRTN
4605
out_mod FCN((n,encap))
4606
sixteen_bits n C0("Module number.")@;
4607
boolean encap C1("Encapsulate?")@;
4608
{
4609
char s[100];
4610
4611
if(encap)
4612
sprintf(s,"%s%s%u%s",
4613
(char *)w_style.indx.encap_prefix,
4614
(char *)w_style.indx.encap_infix
4615
,n
4616
, (char *)w_style.indx.encap_suffix);
4617
else
4618
sprintf(s, "%u", n);
4619
4620
OUT_STR(s);
4621
4622
if(chngd_module[n])
4623
OUT_STR("\\*");
4624
4625
if(makeindex && phase==3)
4626
{
4627
if(encap)
4628
fprintf(mx_file, "%c%u%c",
4629
(char)w_style.indx.m_arg_open
4630
,n
4631
, (char)w_style.indx.m_arg_close);
4632
else
4633
fprintf(mx_file, "%u", n); // Shouldn't occur.
4634
}
4635
}
4636
4637
@ The |out_name| procedure is used to output an identifier or index entry,
4638
enclosing it in braces. When we're outputting an identifier, we must escape
4639
the various special characters that may sneak in. Index entries are treated
4640
literally.
4641
4642
@d IDENTIFIER YES
4643
@d INDEX_ENTRY NO
4644
4645
@<Part 1@>=@[
4646
4647
SRTN
4648
out_name FCN((m_temp, surround,nis_id, p))
4649
outer_char *m_temp C0("Buffer")@;
4650
boolean surround C0("Surround with braces?")@;
4651
boolean is_id C0("Flag to distinguish identifier/index entry.")@;
4652
name_pointer p C1("The name to be output.")@;
4653
{
4654
ASCII HUGE *k, HUGE *k_end=(p+1)->byte_start; // Pointers into |byte_mem|.
4655
boolean multi_char,non_TeX_macro;
4656
sixteen_bits mod_defined;
4657
4658
if(!output_on)
4659
return; // Skip output.
4660
4661
multi_char = BOOLEAN(k_end - p->byte_start > 1);
4662
4663
if(multi_char && surround)
4664
out(@'{');// Multiple-letter identifiers are enclosed in braces.
4665
4666
non_TeX_macro = BOOLEAN(is_id && *p->byte_start == @'\\' && language != TEX);
4667
4668
if(non_TeX_macro)
4669
out(@'$'); /* \Cpp\ macros (such as those like \.{\\Wcp} that would
4670
arise from |@c++ operator +=()|) must be in math mode. */
4671
4672
for (k=p->byte_start; k<k_end; k++)
4673
{
4674
if(is_id)
4675
switch(*k)
4676
{ /* Escape the special characters in identifiers. */
4677
case @'\\':
4678
case @'{': case @'}':
4679
/* A non-\TeX\ identifier can result from the translation of an operator
4680
name in \Cpp. For that, we shouldn't escape the opening backslash. We
4681
also assume that any braces following that macro should be interpreted
4682
literally. */
4683
if(non_TeX_macro)
4684
break;
4685
4686
@<Other string cases@>:
4687
out(@'\\');
4688
}
4689
4690
out(*k);
4691
}
4692
4693
if(non_TeX_macro)
4694
out(@'$');
4695
4696
if(multi_char && surround)
4697
out(@'}');
4698
4699
if(m_temp && makeindex)
4700
{
4701
int n = out_ptr + 1 - m_start;
4702
4703
STRNCPY(m_temp, m_start, n);
4704
m_temp[n] = '\0';
4705
}
4706
4707
if(p->wv_macro)
4708
@<Output the overloaded translation@>@;
4709
4710
/* Should do all languages here. (Sorted!). */
4711
if(subscript_fcns && (mod_defined = p->defined_in(language)))
4712
{
4713
char temp[100];
4714
4715
if(output_protect)
4716
OUT_STR("\\protect");
4717
4718
sprintf(temp,"\\WIN%d{%d}",DEFINED_TYPE(p),
4719
mod_defined==module_count ? 0 : mod_defined);
4720
OUT_STR(temp);
4721
}
4722
}
4723
4724
@
4725
@<Output the overlo...@>=
4726
{
4727
WV_MACRO HUGE *w = p->wv_macro;
4728
ASCII HUGE *s = w->text;
4729
4730
OUT_STR("\\WTeX{");
4731
4732
while(*s)
4733
out(*s++);
4734
4735
out(@'}');
4736
}
4737
4738
@ The following can occur in identifiers recognized by \FWEB.
4739
@<Special identifier cases@>=
4740
4741
case @'_':
4742
case @'$':
4743
case @'%':
4744
case @'#':
4745
case @'\\':
4746
out(@'\\')@;
4747
4748
@* ROUTINES THAT COPY \TeX\ MATERIAL. During phase two, we use the
4749
subroutines |copy_limbo| and |copy_TeX| in place of the analogous
4750
|skip_limbo| and |skip_TeX| that were used in phase one. The routine
4751
|copy_comment| serves for both phases.
4752
4753
The |copy_limbo| routine, for example, begins by outputting two kinds of
4754
\TeX\ code that it has constructed or collected. First, it writes out
4755
\TeX\ definitions for user-defined dot constants; second, it writes out any
4756
limbo text that it collected during phase one. Then it takes \TeX\
4757
material that is not part of any module and transcribes it almost verbatim
4758
to the output file. No `\.{@@}'~signs should occur in such material except
4759
in `\.{@@@@}'~pairs; such pairs are replaced by singletons.
4760
4761
@<Part 2@>=@[
4762
4763
SRTN
4764
copy_limbo(VOID)
4765
{
4766
ASCII c;
4767
4768
@<Output default definitions for user-defined dot constants@>@;
4769
@<Output any limbo text definitions@>@;
4770
4771
OUT_STR("\n% --- Beginning of user's limbo section ---");
4772
flush_buffer(out_ptr, NO);
4773
4774
WHILE()
4775
{
4776
if (loc>limit && (fin_line(), !get_line()))
4777
break;
4778
4779
*(limit+1)=@'@@';
4780
4781
while (*loc!=@'@@')
4782
out(*(loc++)); // Copy verbatim to output.
4783
4784
if (loc++<=limit)
4785
{
4786
c=*loc++; // Character after `\.{@@}'.
4787
4788
if (ccode[c]==new_module)
4789
break; // Recognized beginning of first section.
4790
4791
if (c!=@'z' && c!=@'Z')
4792
switch(ccode[c])
4793
{
4794
@<Cases to set |language| and |break|@>@:@;
4795
4796
case toggle_output:
4797
out_skip();
4798
break;
4799
4800
case invisible_cmnt:
4801
loc = limit + 1; // Skip entire rest of line.
4802
break;
4803
4804
case @'@@':
4805
out(@'@@'); // $\.{@@@@} \to \.{@@}$.
4806
break;
4807
4808
case keyword_name:
4809
loc-=2; get_next(); /* skip to \.{@@>} */
4810
@<Output an RCS-like keyword@>@;
4811
break;
4812
4813
default:
4814
ERR_PRINT(W,"Double @@ required \
4815
outside of sections");
4816
@.Double \AT! required...@>
4817
}
4818
}
4819
}
4820
4821
@<Output the end of limbo section@>@;
4822
}
4823
4824
@ By the beginning of phase~2, we know about any user-defined operators in
4825
\Fortran-90 via the \.{@@v}~command. Here we output default (empty)
4826
definitions of the associated
4827
macros. The user can override these in his limbo section.
4828
4829
@<Output default def...@>=
4830
{
4831
int k;
4832
OPERATOR *p;
4833
4834
/* An extra blank line after \.{\\input fwebmac.sty}. */
4835
for(k=0; k<NUM_LANGUAGES; k++)
4836
if(overloaded[k])
4837
{
4838
flush_buffer(out_ptr, NO);
4839
break;
4840
}
4841
4842
for(k=0; k<NUM_LANGUAGES; k++)
4843
if(overloaded[k])
4844
{
4845
flush_buffer(out_ptr, NO);
4846
4847
OUT_STR("% --- Overloaded operator definitions from @@v for '");
4848
OUT_STR(lang_codes[k]);
4849
OUT_STR("' ---");
4850
flush_buffer(out_ptr, NO);
4851
4852
for(p=op; p<op_ptr; p++)
4853
{
4854
OP_INFO HUGE *q = p->info + k;
4855
4856
if(q->overloaded)
4857
@<Define to \TeX\ an overloaded operator@>@;
4858
}
4859
4860
flush_buffer(out_ptr, NO);
4861
}
4862
}
4863
4864
@ This fragment produces output of the form
4865
``\.{\\newbinop\{abc\}\{C\{def\}}''. See \.{fwebmac.web} to learn how such
4866
macros are defined.
4867
4868
@<Define to \TeX\ ...@>=
4869
@B
4870
#define TEMP_LEN 1000
4871
4872
outer_char temp[TEMP_LEN], outer_op_name[100];
4873
4874
OUT_STR("\\new");
4875
4876
switch(q->cat)
4877
{
4878
case unorbinop:
4879
case binop:
4880
OUT_STR("binop"); @~ break;
4881
4882
case unop:
4883
OUT_STR("unop"); @~ break;
4884
4885
default:
4886
OUT_STR("op"); @~ break;
4887
}
4888
4889
STRCPY(outer_op_name,p->op_name); @~ to_outer((ASCII *)outer_op_name);
4890
SPRINTF(TEMP_LEN,temp,`"{%s}{%s}{%s} ",outer_op_name,lang_codes[k],q->defn`);
4891
OUT_STR(temp);
4892
4893
#undef TEMP_LEN
4894
}
4895
4896
@ Limbo text material is collected from all \.{@@l}~commands, then output
4897
verbatim here, at the beginning of phase two. We begin by writing out any
4898
default material from the style file entry \.{limbo}.
4899
@<Output any limbo text...@>=
4900
{
4901
text_pointer t = tok_start + 1;
4902
4903
/* Default material. */
4904
if(*w_style.misc.limbo_begin)
4905
{
4906
flush_buffer(out_ptr, NO);
4907
OUT_STR("% --- Limbo text from style-file parameter `limbo.begin' ---");
4908
fin_line();
4909
OUT_STR(w_style.misc.limbo_begin);
4910
flush_buffer(out_ptr, NO);
4911
}
4912
4913
/* If there were any \.{@@l}~commands, they were stored in phase~1; output
4914
them now. */
4915
if(text_ptr > t)
4916
{
4917
flush_buffer(out_ptr, NO);
4918
OUT_STR("% --- Limbo text from @@l ---"); // Header line.
4919
fin_line();
4920
}
4921
4922
/* Actual text. */
4923
for(; t<text_ptr; t++)
4924
{
4925
out_del_tokens(*t, *(t+1));
4926
flush_buffer(out_ptr, NO);
4927
}
4928
4929
@<Initialize |tok_ptr|...@>@;
4930
}
4931
4932
@
4933
@<Output the end of limbo...@>=
4934
{
4935
if(*w_style.misc.limbo_end)
4936
{
4937
flush_buffer(out_ptr, NO);
4938
OUT_STR("% --- Limbo text from style-file parameter `limbo.end' ---");
4939
fin_line();
4940
OUT_STR(w_style.misc.limbo_end);
4941
flush_buffer(out_ptr, NO);
4942
}
4943
}
4944
4945
@
4946
@<Unused@>=
4947
4948
if(Fortran88)
4949
{
4950
DOTS *d;
4951
4952
flush_buffer(out_ptr, NO);
4953
4954
for(d=dots + PREDEFINED_DOTS; d->code; d++)
4955
if(d->code == dot_const)
4956
fprintf(tex_file,"\\newdot{%s}{} ",d->symbol);
4957
4958
if(d-dots > PREDEFINED_DOTS + 1) flush_buffer(out_ptr, NO);
4959
}
4960
4961
@ A fragment that toggles the output switch. This is used in conjunction
4962
with the \.{@@i}~command, which is translated into a |toggle_output|.
4963
4964
@<Glob...@>=
4965
4966
EXTERN boolean strt_off SET(NO), ending_off SET(NO);
4967
4968
@
4969
@<Toggle output@>=
4970
{
4971
static int outer_include_depth;
4972
4973
if(output_on)
4974
{
4975
if(phase==2)
4976
{
4977
flush_buffer(out_ptr, NO);
4978
}
4979
outer_include_depth = incl_depth;
4980
output_on = NO;
4981
}
4982
else if(incl_depth <= outer_include_depth)
4983
{
4984
output_on = YES;
4985
}
4986
}
4987
4988
@ While appending code text, store the state of the output.
4989
@
4990
@<Store the output switch@>=
4991
{
4992
if(output_on) app(Turn_output_on);
4993
else
4994
{
4995
app(force); /* If we don't do this, output is turned off before the
4996
contents of the last line are printed. */
4997
app(turn_output_off);
4998
}
4999
5000
app_scrap(ignore_scrap,no_math);
5001
}
5002
5003
@ While appending code text, store the state of the output.
5004
@
5005
@<Store output switch and \.{\\Wskipped}@>=
5006
{
5007
if(output_on) app(Turn_output_on);
5008
else
5009
{
5010
app(force);
5011
app(Turn_output_off);
5012
}
5013
5014
app_scrap(ignore_scrap,no_math);
5015
}
5016
5017
@ The |copy_TeX| routine processes the \TeX\ code at the beginning of a
5018
module; for example, the words you are now reading were copied in this way.
5019
It returns the next control code or~`\v' found in the input. Lines that
5020
consist of all spaces are made empty; spaces between the beginning of a
5021
line and an \.{@@}~command are stripped away. (Unlike the original design,
5022
we leave tab marks in, since some users use those as active characters.)
5023
This makes the test for empty lines in |fin_line| work.
5024
5025
@<Part 2@>=@[
5026
eight_bits
5027
copy_TeX(VOID)
5028
{
5029
ASCII c; // Current character being copied.
5030
5031
WHILE()
5032
{
5033
if (loc>limit)
5034
{
5035
@<Delete run of spaces between beginning of line and
5036
present position@>@;
5037
fin_line();
5038
5039
if(!get_line())
5040
return new_module; // End of file.
5041
}
5042
5043
*(limit+1)=@'@@';
5044
5045
scan:
5046
while ((c=*(loc++))!=@'|' && c!=@'@@')
5047
{
5048
if(c==interior_semi)
5049
c = @';';
5050
out(c); // Copy \TeX\ verbatim to output.
5051
5052
#if(0)
5053
if (out_ptr==out_buf+1 && (c==@' '
5054
|| c==tab_mark
5055
)) out_ptr--;
5056
#endif
5057
}
5058
5059
if (c==@'|')
5060
return @'|'; // Beginning of code mode.
5061
5062
if (loc<=limit)
5063
{ /* Found an \.{@@}. */
5064
eight_bits cc;
5065
5066
if(*loc == @'@@')
5067
{
5068
out(@'@@');
5069
loc++;
5070
goto scan;
5071
}
5072
5073
@<Delete run of spaces...@>@;
5074
5075
SET_CASE(*loc);
5076
5077
if( (cc = ccode[*(loc++)]) != big_line_break)
5078
return cc;
5079
5080
if(loc >= limit)
5081
return cc;
5082
5083
@<Process possible pre...@>; // An `\.{@@\#\dots}' command.
5084
return cc; // A |big_line_break| command.
5085
}
5086
}
5087
5088
DUMMY_RETURN(ignore);
5089
}
5090
5091
@ If there are only spaces between the beginning of the output buffer and
5092
the present position |out_ptr|, delete those spaces.
5093
@<Delete run of spaces...@>=
5094
{
5095
ASCII HUGE *b;
5096
5097
for(b=out_buf+1; b<=out_ptr; b++)
5098
if(*b != @' ')
5099
break;
5100
5101
if(b > out_ptr)
5102
out_ptr = out_buf;
5103
}
5104
5105
@ A flag lets us know when we're processing a comment.
5106
@<Glob...@>=
5107
5108
EXTERN boolean in_comment;
5109
5110
@ The |copy_comment| function issues a warning if more braces are opened
5111
than closed, and in the case of a more serious error it supplies enough
5112
braces to keep \TeX\ from complaining about unbalanced braces. (Because of
5113
a bug inherited from \CWEB, this doesn't work right if there is a
5114
construction such as~`\.{\\\{}' in the comment.) Instead of copying the
5115
\TeX\ material into the output buffer, this function copies it into the
5116
token memory. The abbreviation |app_tok(t)| is used to append token~|t| to
5117
the current token list, and it also makes sure that it is possible to
5118
append at least one further token without overflow.
5119
5120
@d app_tok(c) {if (tok_ptr+2>tok_m_end)
5121
OVERFLW("tokens",ABBREV(max_toks_w));
5122
app(c);}
5123
5124
@<Part 2@>=@[
5125
5126
int
5127
copy_comment FCN((bal)) /* copies \TeX\ code in comments */
5128
int bal C1("Brace balance.")@;
5129
{
5130
ASCII c; //* Current character being copied.
5131
char terminator[2];
5132
token_pointer tok_ptr0 = tok_ptr;
5133
5134
in_comment = YES;
5135
5136
terminator[0] = *limit; @~ terminator[1] = *(limit+1);
5137
5138
*limit = @' '; /* Space to implement continued line. Short commands will
5139
be ended by this space. */
5140
5141
/* Especially when it comes to stars and asterisks, we need to know when
5142
we're copying \TeX. Since this is actually going into token memory instead
5143
of being transcribed directly to the output, we append the |copy_mode| flag
5144
to help us know where we are. For this to work properly, one must return
5145
only from the bottom of this function, because we append another
5146
|copy_mode| at the bottom. */
5147
if(phase == 2)
5148
app_tok(copy_mode);
5149
5150
WHILE()
5151
{
5152
if(loc > limit)
5153
@<Continue comment if necessary@>@;
5154
5155
// Get the next character. Convert a run of tabs into one tab.
5156
if(language==TEX)
5157
c = *loc++;
5158
else do
5159
c = *(loc++);
5160
while(c == tab_mark);
5161
5162
if (c==@'|') break; // Found beginning of code mode.
5163
5164
if (c==@'*' && *loc==@'/' && long_comment)
5165
{
5166
loc++; // Position after `\.{\starslash}'.
5167
5168
@<Finish comment and |break|@>;
5169
}
5170
5171
/* It looks better in the \.{tex} file if tabs are replaced by spaces.
5172
Presumably this won't harm anything else. */
5173
if (phase==2)
5174
@<Append comment text@>@;
5175
5176
@<Copy special things when |c=='@@', '\\', '{', '}'|@>;
5177
}
5178
5179
if(phase == 2)
5180
app_tok(copy_mode); // Negate the copying mode.
5181
5182
*limit = terminator[0]; @~ *(limit+1) = terminator[1];
5183
5184
if(!long_comment && *limit == @'@@' && loc > limit)
5185
loc = limit;
5186
5187
in_comment = NO;
5188
return bal;
5189
}
5190
5191
@
5192
@<Continue comment if nec...@>=
5193
{
5194
if(!(long_comment || language==TEX))
5195
{ // End of short comment.
5196
if((auto_semi && !free_Fortran) && *(tok_ptr-2) == @';'
5197
&& *(tok_ptr-1) == @' ')
5198
tok_ptr -= 2;
5199
5200
/* Strip trailing spaces. */
5201
while(*(tok_ptr-1) == @' ')
5202
tok_ptr--;
5203
5204
/* If the last space happened to be escaped, kill the escape. */
5205
if(*(tok_ptr-1) == @'\\' && *(tok_ptr-2) != @'\\')
5206
tok_ptr--;
5207
5208
/* Kill the trailing end-of-comment. */
5209
if(*(tok_ptr-2)==@'*' && *(tok_ptr-1)==@'/')
5210
tok_ptr -= 2;
5211
5212
@<Finish comment and |break|@>@;
5213
}
5214
5215
if (!get_line())
5216
{
5217
if(language!=TEX)
5218
ERR_PRINT(W,"Input ended in mid-comment");
5219
@.Input ended in mid-comment@>
5220
loc=cur_buffer+1; @<Clear |bal| and |break|@>;
5221
}
5222
5223
/* For \TeX, we concatenate adjacent lines that all begin with comment
5224
characters. */
5225
if(language==TEX)
5226
{
5227
if(loc==limit) @<Finish comment...@>@;
5228
5229
for(;loc <= limit; loc++)
5230
if(*loc!=@' ' && *loc!=tab_mark) break;
5231
5232
if(loc > limit) continue;
5233
5234
if(TeX[*loc] == TeX_comment) loc++;
5235
else
5236
{ // Unskip the white space.
5237
loc = cur_buffer;
5238
@<Finish comment...@>@;
5239
}
5240
}
5241
}
5242
5243
@ During phase~2, we must actually append the text character by character.
5244
That's essentially straightforward, but a few replacements are made.
5245
5246
@<Append comment text@>=
5247
switch(c)
5248
{
5249
case tab_mark:
5250
if(language==TEX)
5251
APP_STR("\\quad ");
5252
else
5253
app_tok(@' ');
5254
5255
break;
5256
5257
case interior_semi:
5258
app_tok(@';');
5259
break;
5260
5261
case @'%':
5262
if(language==TEX)
5263
app_tok(@'\\');
5264
5265
app_tok(c);
5266
break;
5267
5268
default:
5269
/* Basically, we just append the present character here. However, compiler
5270
directives need to be escaped. */
5271
if(doing_cdir)
5272
switch(c)
5273
{
5274
@<Special string cases@>:
5275
app_tok(@'\\');
5276
}
5277
5278
app_tok(c);
5279
break;
5280
}
5281
5282
@ This fragment finishes off a comment, ensuring that braces are properly
5283
balanced.
5284
@<Finish comment...@>=
5285
5286
if(bal==1)
5287
{
5288
if (phase==2)
5289
{
5290
if(language==TEX) @<Check for a null \TeX\ comment@>@;
5291
app_tok(@'}');
5292
}
5293
bal = 0;
5294
break;
5295
}
5296
else
5297
{
5298
ERR_PRINT(W,"Braces don't balance in comment");
5299
@.Braces don't balance in comment@>
5300
@<Clear |bal| and |break|@>;
5301
}
5302
5303
@
5304
@<Check for a null ...@>=
5305
{
5306
token_pointer t;
5307
5308
for(t=tok_ptr-1; t>tok_ptr0; t--)
5309
if(*t != @' ') break;
5310
5311
if(t == tok_ptr0 && *(t-4)==@'\\' && *(t-3)==@'W' && *(t-2)==@'C' &&
5312
*(t-1)==@'{')
5313
*(tok_ptr0-2) = @'x'; // Change \.{\\WC} to \.{\\Wx}.
5314
}
5315
5316
5317
@
5318
@<Copy special things when |c=='@@'...@>=
5319
5320
if (c==@'@@')
5321
{
5322
if (*(loc++)!=@'@@')
5323
{
5324
ERR_PRINT(W,"Illegal use of @@ in comment");
5325
@.Illegal use of \AT!...@>
5326
loc-=2;
5327
5328
if (phase==2)
5329
tok_ptr--;
5330
5331
@<Clear |bal|...@>;
5332
}
5333
}
5334
else if (c==@'\\' && *loc!=@'@@' && phase==2)
5335
app_tok(*(loc++))@;
5336
else if (c==@'{')
5337
bal++;
5338
else if (c==@'}')
5339
bal--;
5340
5341
@ When the comment has terminated abruptly due to an error, we output
5342
enough right braces to keep \TeX\ happy.
5343
5344
@<Clear |bal|...@>=
5345
5346
app_tok(@' '); /* this is done in case the previous character was~`\.\\' */
5347
5348
while (bal-- >0) app_tok(@'}');
5349
5350
bal = 0;
5351
break;
5352
5353
@i scraps.hweb /* Declarations related to the scraps and productions. */
5354
5355
@
5356
@<Alloc...@>=
5357
5358
ALLOC(scrap,scrp_info,ABBREV(max_scraps),max_scraps,0);
5359
scrp_end=scrp_info+max_scraps -1; /* end of |scrp_info| */
5360
5361
@
5362
@<Set init...@>=
5363
5364
scrp_base=scrp_info+1;
5365
5366
mx_scr_ptr=scrp_ptr=scrp_info;
5367
5368
@* INITIALIZING the SCRAPS. If we are going to use the powerful production
5369
mechanism just developed, we must get the scraps set up in the first place,
5370
given a \cee\ text. A table of the initial scraps corresponding to \cee\
5371
tokens appeared above in the section on parsing; our goal now is to
5372
implement that table. We shall do this by implementing a subroutine called
5373
|C_parse| that is analogous to the |C_xref| routine used during phase one.
5374
5375
Like |C_xref|, the |C_parse| procedure starts with the current value of
5376
|next_control| and it uses the operation |next_control=get_next()| repeatedly
5377
to read \cee\ text until encountering the next~`\v' or comment, or until
5378
|next_control>=formatt|. The scraps corresponding to what it reads are
5379
appended into the |cat| and |trans| arrays, and |scrp_ptr| is advanced.
5380
5381
@<Glob...@>=
5382
5383
EXTERN boolean scanning_meta SET(NO);
5384
5385
@
5386
@<Part 2@>=@[
5387
5388
SRTN
5389
C_parse FCN((mode0)) /* Creates scraps from \cee\ tokens */
5390
PARSING_MODE mode0 C1("")@;
5391
{
5392
name_pointer p; // Identifier designator.
5393
LANGUAGE language0 = language; // Save the incoming language.
5394
PARSE_PARAMS parse_params0;
5395
5396
parse_params0 = parse_params; // Save parsing state.
5397
5398
parsing_mode = mode0;
5399
5400
5401
if(parsing_mode == INNER)
5402
{ // Start fresh for parsing interior code.
5403
at_beginning = YES;
5404
preprocessing = NO;
5405
}
5406
5407
while (next_control<formatt)
5408
{
5409
if(nuweb_mode && parsing_mode == INNER)
5410
@<Append a verbatim scrap@>@;
5411
else
5412
{
5413
@<Append the scrap appropriate to |next_control|@>;
5414
next_control = get_next();
5415
}
5416
5417
if (next_control==@'|' || next_control==begin_comment)
5418
break;
5419
5420
5421
if(next_control == begin_language && !ok_to_define
5422
&& parsing_mode == OUTER)
5423
return;
5424
}
5425
5426
/* If the language has changed, append stuff to restore it. */
5427
if(language != language0)
5428
{
5429
app_tok(begin_language);
5430
app(lan_num(language0));
5431
app_scrap(ignore_scrap,no_math);
5432
}
5433
5434
if(parsing_mode == INNER)
5435
parse_params = parse_params0; // Restore incoming values.
5436
}
5437
5438
@ This fragment is a simple kludge; it doesn't handle various cases
5439
gracefully, such as `\.{||}'.
5440
5441
@<Append a verbatim s...@>=
5442
{
5443
WHILE()
5444
{
5445
if(tok_ptr == tok_m_end)
5446
OVERFLW("tokens", ABBREV(max_toks_w));
5447
5448
if(loc < limit)
5449
{
5450
if(*loc == @'|')
5451
{
5452
next_control = *loc++;
5453
break;
5454
}
5455
5456
app(*loc++);
5457
}
5458
else if(!get_line())
5459
{
5460
ERR_PRINT(W, "Missing '|'. File ended while appending a \
5461
verbatim scrap");
5462
next_control = @'|';
5463
break;
5464
}
5465
else
5466
app(@' '); // Instead of newline.
5467
}
5468
5469
if(scrp_ptr == scrp_end)
5470
OVERFLW("scraps", ABBREV(max_scraps));
5471
5472
app_scrap(ignore_scrap, no_math);
5473
}
5474
5475
@ The following macro is used to append a scrap whose tokens have just
5476
been appended. Note that mathness is stored in the form $4(\hbox{\it right
5477
boundary}) + \hbox{\it left boundary}$. Thus, noting that $5b = 4b + b$,
5478
we see that the construction~$5b$ makes the left- and right-hand boundaries
5479
equal.
5480
5481
@d app_scrap(c,b)@/
5482
(++scrp_ptr)->cat = (eight_bits)(c);
5483
scrp_ptr->trans = text_ptr;
5484
scrp_ptr->mathness = (eight_bits)(5*(b)); /* Make left and right
5485
boundaries equal. */
5486
freeze_text@;
5487
5488
@<Part 2@>=@[
5489
5490
SRTN
5491
set_language FCN((language0))
5492
LANGUAGE language0 C1("")@;
5493
{
5494
char language_line[50];
5495
5496
language = language0;
5497
5498
app_tok(begin_language);
5499
app(lan_num(language));
5500
5501
if(parsing_mode == OUTER)
5502
{
5503
sprintf(language_line,"\\LANGUAGE{%s}",
5504
(char *)LANGUAGE_CODE(language));
5505
APP_STR(language_line);
5506
@.\\LANGUAGE@>
5507
}
5508
5509
app_scrap(language_scrap,no_math);
5510
}
5511
5512
@ Operator overloading.
5513
@<Glob...@>=
5514
5515
EXTERN boolean overloaded[NUM_LANGUAGES];
5516
5517
EXTERN BUF_SIZE op_entries; /* Length for dynamic array. */
5518
EXTERN OPERATOR HUGE *op, HUGE *op_end; /* Dynamic array of entries for
5519
operator overloading. */
5520
EXTERN OPERATOR HUGE *op_ptr; /* Next open position in |OP|. */
5521
5522
@ Initializing operators is conveniently handled by macros.
5523
5524
/* Initialize an ordinary operator such as~`\.+'. */
5525
@d INIT_OP(op_code,op_name,lang,op_macro,cat)
5526
init_op((eight_bits)(op_code),OC(op_name),(int)(lang),OC(op_macro),
5527
NO,cat,(CONST outer_char *)NULL)
5528
5529
/* Initialize a compound assignment operator such as~`\.{+=}'. */
5530
@d INIT_CA(ca_index,op_name,lang,op_macro,cat)
5531
assignment_token = ca_index;
5532
INIT_OP(compound_assignment,OC(op_name),(int)(lang),OC(op_macro),cat)@;
5533
5534
/* Initialize a dot operator such as~`\.{.NE.}'. */
5535
@d INIT_DOT(op_name,lang,op_macro,cat)
5536
init_op((eight_bits)identifier,OC(op_name),(int)(lang),OC(op_macro),
5537
NO,cat,(CONST outer_char *)NULL)
5538
5539
@d ONLY_C_like ((int)C | (int)C_PLUS_PLUS)
5540
@d ALL_BUT_C_like (~ONLY_C_like)
5541
@d ALL_BUT_Cpp ((int)C | ONLY_N_like | (int)LITERAL)
5542
5543
@d ONLY_N_like ((int)FORTRAN | (int)FORTRAN_90 | (int)RATFOR | (int)(RATFOR_90))
5544
@d ALL_BUT_N_like (~ONLY_N_like)
5545
5546
@d ALL_LANGUAGES (ONLY_C_like | ONLY_N_like | (int)LITERAL)
5547
5548
5549
@<Alloc...@>=
5550
{
5551
int l;
5552
5553
for(l=0; l<NUM_LANGUAGES; l++)
5554
overloaded[l] =NO;
5555
5556
ALLOC(OPERATOR,op,ABBREV(op_entries),op_entries,0);
5557
op_end = op + op_entries;
5558
op_ptr = op + 128; /* The first 128 are for direct indexing. */
5559
5560
@<Initialize ordinary operators@>;
5561
@<Initialize compound assignment operators@>;
5562
}
5563
5564
@
5565
@<Initialize ordinary op...@>=
5566
5567
INIT_OP(@'!',"NOT",ALL_LANGUAGES,"\\WR",unop); // `|!|'
5568
INIT_DOT("NOT",ALL_BUT_C_like,"\\WR",unop);
5569
@.\\WR@> @..NOT.@>
5570
5571
INIT_OP(@'%',"MOD",ALL_LANGUAGES,"\\WMOD",binop); // `|%|'
5572
@.\\MOD@>
5573
5574
INIT_OP(@'&',"LAND",C,"\\amp",unorbinop); /* `|&|'. */
5575
INIT_OP(@'&',"LAND",C_PLUS_PLUS,"\\amp",reference);
5576
@.\\amp@>
5577
INIT_OP(@'&',"LAND",ALL_BUT_C_like,"\\WAND",binop); // `|@r &|'
5578
@.\\AND@>
5579
5580
INIT_OP(@'+',"PLUS",ALL_LANGUAGES,"+",unorbinop); // `|+|'
5581
INIT_OP(@'-',"MINUS",ALL_LANGUAGES,"-",unorbinop); // `|-|'
5582
5583
INIT_OP(@'*',"STAR",ALL_LANGUAGES,"\\ast",unorbinop); // `|*|'
5584
@.\\ast@>
5585
5586
/* \TeX's slash is an ordinary operator, not a binary operator. Hence the
5587
need for \.{\\WSl}. But in \Fortran\ it's used in funny ways, like for |@n
5588
common| blocks, so it must be converted to a binary operator later. */
5589
INIT_OP(@'/',"SLASH",ALL_BUT_N_like,"\\WSl", binop); // `|/|'
5590
INIT_OP(@'/',"SLASH",ONLY_N_like,"/", binop); // `|/|'
5591
5592
INIT_OP(@'<',"LT",ALL_BUT_Cpp,"<",binop); // `|<|'
5593
INIT_OP(@'<',"LT",C_PLUS_PLUS,"<",langle); // `|<|'
5594
INIT_DOT("LT",ALL_BUT_C_like,"<",binop);
5595
@..LT.@>
5596
5597
INIT_OP(@'=',"EQUALS",ALL_LANGUAGES,"=",binop); // `|=|'
5598
5599
INIT_OP(@'>',"GT",ALL_BUT_Cpp,">",binop); // `|>|'
5600
INIT_OP(@'>',"GT",C_PLUS_PLUS,">",rangle); // `|>|'
5601
INIT_DOT("GT",ALL_BUT_C_like,">",binop);
5602
@..GT.@>
5603
5604
INIT_OP(@'?',"QUESTION",ONLY_C_like,"\\?",question); // `|?|'
5605
@.\\?@>
5606
INIT_OP(@'^',"CARET",ALL_LANGUAGES,"\\Caret",binop); // `|x^y|'
5607
@.\\\^@>
5608
5609
INIT_OP(@'|',"OR",ALL_LANGUAGES,"\\WOR",binop); // `$\WOR$'
5610
@.\\OR@>
5611
INIT_OP(@'~',"TILDE",ONLY_C_like,"\\TLD",unop);
5612
@.\\TL@>
5613
5614
INIT_OP(not_eq,"NE",ALL_LANGUAGES,"\\WI",binop); /* `|!=|' */
5615
INIT_DOT("NE",ALL_BUT_C_like,"\\WI",binop);
5616
@.\\WI@> @..NE.@>
5617
5618
INIT_OP(lt_eq,"LE",ALL_LANGUAGES,"\\WL",binop); /* `|<=|' */
5619
INIT_DOT("LE",ALL_BUT_C_like,"\\WL",binop);
5620
@.\\WL@> @..LE.@>
5621
5622
INIT_OP(gt_eq,"GE",ALL_LANGUAGES,"\\WG",binop); /* `|>=|' */
5623
INIT_DOT("GE",ALL_BUT_C_like,"\\WG",binop);
5624
@.\\WG@>
5625
5626
INIT_OP(eq_eq,"EQ",ALL_LANGUAGES,"\\WS",binop); /* `|==|' */
5627
INIT_DOT("EQ",ALL_BUT_C_like,"\\WS",binop);
5628
@.\\WS@> @..EQ.@>
5629
5630
INIT_OP(and_and,"AND",ALL_LANGUAGES,"\\WW",binop); /* `|&&|' */
5631
INIT_DOT("AND",ALL_BUT_C_like,"\\WW",binop);
5632
@.\\WW@> @..AND.@>
5633
5634
INIT_OP(or_or,"OR",ALL_LANGUAGES,"\\WV",binop); /* `||| |' */
5635
INIT_DOT("OR",ALL_BUT_C_like,"\\WOR",binop);
5636
@.\\WV@> @..OR.@>
5637
5638
INIT_OP(plus_plus,"PP",ALL_LANGUAGES,"\\WPP",unop); // `|++|'
5639
@.\\PP@>
5640
INIT_OP(minus_minus,"MM",ALL_LANGUAGES,"\\WMM",unop); // `|--|'
5641
@.\\MM@>
5642
5643
INIT_OP(minus_gt,"EQV",ONLY_C_like,"\\WMG",binop); /* `|->|' */
5644
@.\\MG@>
5645
INIT_OP(minus_gt,"EQV",ALL_BUT_C_like,"\\WEQV",binop); /* `|@r .eqv.|' */
5646
INIT_DOT("EQV",ALL_BUT_C_like,"\\WEQV",binop);
5647
@.\\EQV@> @..EQV.@>
5648
5649
INIT_OP(gt_gt, "RSHIFT",ONLY_C_like,"\\WGG",binop); // `|>>|'
5650
@.\\GG@>
5651
INIT_OP(lt_lt,"LSHIFT",ONLY_C_like,"\\WLL",binop); // `|<<|'
5652
@.\\LL@>
5653
INIT_OP(star_star,"EE",ALL_LANGUAGES,"\\WEE",exp_op); /* `\.{**}' */
5654
@.\\EE@>
5655
INIT_OP(slash_slash,"SlSl",ALL_BUT_C_like,"\\WSlSl",binop); /* `|@r \/|' */
5656
@.\\SlSl@>
5657
5658
INIT_OP(ellipsis,"NEQV",ALL_BUT_C_like,"\\WNEQV",binop); // `|@r .NEQV.|'
5659
INIT_DOT("NEQV",ALL_BUT_C_like,"\\WNEQV",binop);
5660
INIT_DOT("XOR",ALL_BUT_C_like,"\\WNEQV",binop);
5661
@..NEQV.@> @..XOR.@>
5662
5663
INIT_DOT("FALSE",ALL_BUT_C_like,"\\WFALSE",expr); // `|@r .false.|'
5664
@..FALSE.@>
5665
INIT_DOT("TRUE",ALL_BUT_C_like,"\\WTRUE",expr)@; // `|@r .true.|'
5666
@..TRUE.@>
5667
5668
@
5669
@<Initialize compound...@>=
5670
5671
INIT_CA(plus_eq,"Wcp",ALL_LANGUAGES,"\\Wcp",binop); // `|+=|'
5672
@.\\Wcp@>
5673
INIT_CA(minus_eq,"Wcm",ALL_LANGUAGES,"\\Wcm",binop); // `|-=|'
5674
@.\\Wcm@>
5675
INIT_CA(star_eq,"Wcs",ALL_LANGUAGES,"\\Wcs",binop); // `|*=|'
5676
@.\\Wcs@>
5677
INIT_CA(slash_eq,"Wcv",ALL_LANGUAGES,"\\Wcv",binop); // `|/=|'
5678
@.\\Wcv@>
5679
INIT_CA(mod_eq,"Wcd",ONLY_C_like,"\\Wcd",binop); // `|%=|'
5680
@.\\Wcd@>
5681
INIT_CA(xor_eq,"Wcx",ONLY_C_like,"\\Wcx",binop); // `|^=|'
5682
@.\\Wcx@>
5683
INIT_CA(and_eq,"Wca",ONLY_C_like,"\\Wca",binop); // `|&=|'
5684
@.\\Wca@>
5685
INIT_CA(or_eq,"Wco",ONLY_C_like,"\\Wco",binop); // `||=|'
5686
@.\\Wco@>
5687
INIT_CA(gt_gt_eq,"Wcg",ONLY_C_like,"\\Wcg",binop); // `|>>=|'
5688
@.\\Wcg@>
5689
INIT_CA(lt_lt_eq,"Wcl",ONLY_C_like,"\\Wcl",binop)@; // `|<<=|'
5690
@.\\Wcl@>
5691
5692
@ Initializing an operator involves several possibilities. If the
5693
operator's code is less than~128, the info is put directly into the
5694
corresponding table position. Otherwise, as for a new dot constant, we
5695
search through the positions $>= 128$ and insert it at the first available
5696
slot.
5697
@<Part 3@>=@[
5698
5699
SRTN
5700
init_op FCN((op_code,op_name,lang,op_macro,overload,cat,defn))
5701
eight_bits op_code C0("The operator")@;
5702
CONST outer_char op_name[] C0("Fortran-like name of the operator")@;
5703
int lang C0("Union of all allowable languages for this def")@;
5704
CONST outer_char op_macro[] C0("Default macro expansion")@;
5705
boolean overload C0("Do we overload?")@;
5706
eight_bits cat C0("Category code")@;
5707
CONST outer_char defn[] C1("Replacement text for overloaded macro")@;
5708
{
5709
OPERATOR HUGE *p;
5710
int k,l;
5711
5712
/* The dot constants won't be in the table yet. Just put them there. */
5713
if(op_code == identifier) p = op_ptr++; // Next free position for a dot op.
5714
else if(!(p=valid_op(op_code)))
5715
{
5716
err_print(W,"Invalid op code %d",op_code);
5717
return;
5718
}
5719
5720
p->op_name = GET_MEM("op name",STRLEN(op_name)+1,ASCII);
5721
STRCPY(p->op_name,op_name);
5722
to_ASCII((outer_char *)p->op_name);
5723
5724
/* Access the languages by bit-shifting with~|l|. */
5725
for(k=0,l=1; k<NUM_LANGUAGES; k++,l<<=1)
5726
if(lang & l)
5727
{
5728
OP_INFO HUGE *q = p->info + k;
5729
5730
q->op_macro = op_macro;
5731
overloaded[k] |= (q->overloaded = overload);
5732
q->cat = cat;
5733
if(defn) q->defn = (outer_char HUGE *)defn;
5734
}
5735
}
5736
5737
@ A storage variable.
5738
@<Glob...@>=
5739
5740
EXTERN eight_bits last_control;
5741
5742
@ Here we translate |next_control| into text characters, which are stored
5743
in memory.
5744
5745
@<Append the scrap appropriate to |next_control|@>=
5746
{
5747
room_for(6,4,4); // Is there enough room? (Check and justify these numbers!!!)
5748
5749
if(next_control)
5750
lst_ampersand = NO;
5751
5752
switch (next_control)
5753
5754
{
5755
case macro_module_name: @<Append a module name@>@; break;
5756
5757
case stmt_label:
5758
case stringg: case constant: case verbatim: @<Append a string or constant@>;
5759
break;
5760
5761
case begin_format_stmt: in_format = YES;
5762
case identifier: @<Append an identifier scrap@>; break;
5763
case TeX_string: @<Append a \TeX\ string scrap@>; break;
5764
case begin_language: @<Append scraps for |begin_language|@>; break;
5765
5766
case new_output_file: @<Append the output file name@>@; break;
5767
5768
case toggle_output:
5769
@<Toggle output@>@;
5770
@<Store output switch and \.{\\Wskipped}@>@;
5771
break;
5772
5773
#if 0
5774
case macro_space: app(@' '); app_scrap(space,maybe_math); break;
5775
#endif
5776
case macro_space: app_scrap(ignore_scrap, maybe_math); break;
5777
5778
@<Cases involving single ASCII characters@>@:@;
5779
@<Cases involving nonstandard ASCII characters@>@:@;
5780
@<Cases involving special \WEB\ commands@>@:@;
5781
5782
default: app(next_control); app_scrap(ignore_scrap, maybe_math); break;
5783
}
5784
}
5785
5786
@ Check against possible overflow.
5787
5788
@<Part 3@>=@[
5789
5790
SRTN
5791
room_for FCN((ntokens,ntexts,nscraps))
5792
int ntokens C0("")@;
5793
int ntexts C0("")@;
5794
int nscraps C1("")@;
5795
{
5796
if(tok_ptr+ntokens>tok_m_end)
5797
{
5798
if (tok_ptr>mx_tok_ptr) mx_tok_ptr=tok_ptr;
5799
OVERFLW("tokens",ABBREV(max_toks_w));
5800
}
5801
5802
if(text_ptr+ntexts>tok_end)
5803
{
5804
if (text_ptr>mx_text_ptr) mx_text_ptr=text_ptr;
5805
OVERFLW("texts",ABBREV(max_texts));
5806
}
5807
5808
if (scrp_ptr+nscraps>scrp_end)
5809
{
5810
if (scrp_ptr>mx_scr_ptr) mx_scr_ptr=scrp_ptr;
5811
OVERFLW("scraps",ABBREV(max_scraps));
5812
}
5813
}
5814
5815
@ Some nonstandard ASCII characters may have entered \.{WEAVE} by means of
5816
standard ones. They are converted to \TeX\ control sequences so that it is
5817
possible to keep \.{WEAVE} from stepping beyond standard ASCII.
5818
5819
@<Cases involving nonstandard...@>=
5820
5821
/* Overloaded operators can be defined dynamically in \FORTRAN-88. These
5822
are generically labelled by |dot_const|. The |dot_code| routine fills the
5823
structure |dot_op| with the macro name and category corresponding to the
5824
operator. */
5825
case dot_const:
5826
next_control = identifier;
5827
id_first = dot_op.name + 1;
5828
id_loc = id_first + STRLEN(id_first);
5829
app_overload();
5830
break;
5831
5832
case eq_gt: APP_STR("\\WPtr"); /* `$\WPtr$' */ app_scrap(binop,yes_math);
5833
break;
5834
@.\\WPtr@>
5835
5836
case ellipsis:
5837
if(C_LIKE(language))
5838
{
5839
APP_STR("\\dots"); /* `|...|' */
5840
@.\\dots@>
5841
app_scrap(int_like,maybe_math);
5842
}
5843
else app_overload();
5844
5845
break;
5846
5847
case not_eq:
5848
case lt_eq:
5849
case gt_eq:
5850
case eq_eq:
5851
case and_and:
5852
case or_or:
5853
case plus_plus:
5854
case minus_minus:
5855
case minus_gt:
5856
case gt_gt:
5857
case lt_lt:
5858
case star_star:
5859
case slash_slash:
5860
case compound_assignment:
5861
app_overload(); @~ break;
5862
5863
case paste: APP_STR("\\WNN"); /* `|##|' */ app_scrap(ignore_scrap,maybe_math);
5864
break;
5865
@.\\NN@>
5866
5867
case dont_expand: APP_STR("\\WNP"); /* `|#!|' */
5868
app_scrap(ignore_scrap,maybe_math);
5869
break;
5870
@.\\NP@>
5871
5872
case auto_label: APP_STR("\\WNC"); /* `|#:|' */
5873
app_scrap(ignore_scrap,maybe_math);
5874
break;
5875
@.\\NC@>
5876
5877
case all_variable_args:
5878
APP_STR("\\WND"); // `|#.|
5879
app_scrap(expr,maybe_math);
5880
break;
5881
@.\\ND@>
5882
5883
case colon_colon:
5884
if(C_LIKE(language))
5885
{
5886
@.\\CC@>
5887
APP_STR("\\WCC"); // `|a::b|'
5888
app_scrap(unop,yes_math);
5889
}
5890
else
5891
{
5892
APP_STR("\\WCF"); // `|@r a::b|'
5893
@.\\CF@>
5894
app_scrap(binop,yes_math);
5895
}
5896
break;
5897
5898
case left_array:
5899
APP_STR("\\WLS"); // `|@r (/|'
5900
@.\\LS@>
5901
app_scrap(lpar,yes_math);
5902
break;
5903
5904
case right_array:
5905
APP_STR("\\WSR"); // `|@r /)|'
5906
@.\\SR@>
5907
app_scrap(rpar,yes_math);
5908
break;
5909
5910
@
5911
@<Glob...@>=
5912
5913
EXTERN boolean did_arg;
5914
5915
@
5916
@<Cases involving special...@>=
5917
5918
case force_line: APP_STR("\\]"); app_scrap(ignore_scrap,yes_math); break;
5919
case thin_space: APP_STR("\\,"); app_scrap(ignore_scrap,yes_math); break;
5920
5921
case math_break:
5922
app(opt); @~ APP_STR("0");
5923
app_scrap(ignore_scrap,yes_math);
5924
break;
5925
5926
case line_break:
5927
APP_STR("\\WBK"); // Used to be |app(force)|.
5928
app_scrap(ignore_scrap,no_math);
5929
break;
5930
5931
case ln_break_outdent:
5932
app(force);
5933
#if 0
5934
app(out_force); /* Makes the |indent| command come after the
5935
beginning of the line; useful for beginnings of functions. */
5936
#endif
5937
APP_STR("\\WBKo");
5938
app_scrap(ignore_scrap, no_math);
5939
break;
5940
5941
case left_preproc:
5942
app(force);
5943
if(parsing_mode==OUTER)
5944
APP_STR("\\4"); // Backspace for beauty.
5945
app_scrap(lproc, no_math);
5946
did_arg = NO;
5947
break;
5948
5949
case right_preproc:
5950
app(force);
5951
app_scrap(rproc, no_math);
5952
did_arg = YES;
5953
break;
5954
5955
case no_mac_expand:
5956
APP_STR("\\WTLD"); app_scrap(expr, maybe_math); break;
5957
5958
case begin_meta:
5959
@<Process |begin_meta|@>@;
5960
break;
5961
5962
case end_meta:
5963
if( !nuweb_mode && ((FORTRAN_LIKE(language) && !free_form_input)
5964
|| (language==TEX)) )
5965
@<Set up column mode@>@;
5966
5967
get_line();
5968
APP_STR(w_style.misc.meta.code.end);
5969
app(force);
5970
app_scrap(ignore_scrap,no_math);
5971
scanning_meta = NO;
5972
break;
5973
5974
@.\\WBM@>
5975
@.\\WEM@>
5976
5977
case big_line_break: app(big_force); app_scrap(ignore_scrap,no_math); break;
5978
case no_line_break: app(big_cancel); @~ APP_STR("\\ ");@~ app(big_cancel);
5979
app_scrap(ignore_scrap,no_math); break;
5980
5981
case pseudo_expr: app_scrap(expr,maybe_math); @~ break;
5982
case pseudo_semi: app_scrap(semi,maybe_math); @~ break;
5983
case pseudo_colon: app_scrap(colon,maybe_math); @~ break;
5984
5985
case join: APP_STR("\\WJ"); app_scrap(ignore_scrap,no_math); break;
5986
@.\\WJ@>
5987
5988
case protect_code:
5989
CANT_DO(code);
5990
@.You can't do that...@>
5991
break;
5992
5993
case short_fcn:
5994
APP_STR("\\{");
5995
app_scrap(kill_newlines, yes_math);
5996
break;
5997
5998
case keyword_name:
5999
APP_STR("\\WRCS");
6000
app(@'0' + upper_case_code);
6001
app(@'{');
6002
6003
@<Strip white space from around RCS-like keyword@>@;
6004
*id_loc = '\0';
6005
app_ASCII_str(id_first);
6006
6007
app(@'}');
6008
6009
app_scrap(expr, yes_math);
6010
break;
6011
6012
case next_expr:
6013
the_type = ORDINARY_ID;
6014
break;
6015
6016
case next_reserved:
6017
the_type = RESERVED_WD;
6018
break;
6019
6020
@
6021
@<Process |begin_meta|@>=
6022
{
6023
if(!nuweb_mode)
6024
app(force);
6025
6026
app(toggle_meta);
6027
APP_STR(w_style.misc.meta.code.begin);
6028
6029
column_mode = NO;
6030
scanning_meta = YES;
6031
6032
WHILE()
6033
{
6034
if(loc >= limit) // !!!!!
6035
{
6036
app(@'\n');
6037
if(!get_line())
6038
break;
6039
}
6040
6041
while(loc < limit)
6042
{
6043
if(*loc == @'@@')
6044
@<Check for end of meta-comment and |goto
6045
done_meta@;| if necessary@>@;
6046
app(*loc++);
6047
}
6048
}
6049
6050
done_meta:
6051
APP_STR(w_style.misc.meta.code.end);
6052
app(toggle_meta);
6053
6054
if(!nuweb_mode)
6055
app(force);
6056
6057
app_scrap(ignore_scrap,no_math);
6058
scanning_meta = NO;
6059
}
6060
6061
@
6062
@<Check for end of meta-comment...@>=
6063
{
6064
switch(ccode[*(loc+1)])
6065
{
6066
case @'@@':
6067
loc++;
6068
break;
6069
6070
case end_meta:
6071
if( !nuweb_mode && ((FORTRAN_LIKE(language) && !free_form_input)
6072
|| (language==TEX)) )
6073
@<Set up column mode@>@;
6074
6075
get_line();
6076
goto done_meta;
6077
6078
case invisible_cmnt:
6079
if(*(loc+2) == @'%')
6080
eat_blank_lines = YES;
6081
6082
app(@'\n');
6083
get_line();
6084
6085
if(eat_blank_lines)
6086
{
6087
eat_blank_lines = NO;
6088
6089
while(loc >= limit)
6090
if(!get_line())
6091
goto done_meta;
6092
}
6093
6094
continue;
6095
6096
case new_module:
6097
goto done_meta; // !!!!!
6098
6099
case line_break:
6100
if(loc[2] == @'*' || loc[2] == @'/')
6101
{ /* Verbatim comment. */
6102
loc++;
6103
break;
6104
}
6105
6106
/* Falls through! */
6107
6108
case thin_space:
6109
case no_line_break: case join:
6110
case pseudo_semi: case pseudo_expr: case pseudo_colon:
6111
case Compiler_Directive:
6112
case no_index: case yes_index:
6113
case begin_bp: case insert_bp:
6114
loc += 2;
6115
continue;
6116
6117
case big_line_break:
6118
break; // To handle preprocessor statements easily.
6119
6120
default:
6121
if(nuweb_mode)
6122
goto done_meta; // !!!!!
6123
6124
break;
6125
}
6126
}
6127
6128
@
6129
@<Cases involving single...@>=
6130
6131
case @'\\':
6132
APP_STR("\\WttBS");
6133
app_scrap(ignore_scrap,no_math);
6134
break;
6135
6136
case Cont_Char:
6137
APP_STR("\\WttBS");
6138
app(force);
6139
app_scrap(ignore_scrap, no_math);
6140
break;
6141
6142
case @'\n':
6143
app(@' ');
6144
app_scrap(newline,maybe_math);
6145
break;
6146
6147
case @'/':
6148
if(in_format)
6149
{
6150
app(next_control);
6151
app_scrap(expr,no_math); /* ``|@r format(//e10.5/f5.2)|'' */
6152
}
6153
else if(in_data)
6154
{
6155
app(@'{'); @~ app(next_control); @~ app(@'}');
6156
app_scrap(slash_like,maybe_math);
6157
}
6158
else
6159
{
6160
app_overload(); /* ``|a/b|'' */
6161
}
6162
break;
6163
6164
case @'.':
6165
app(next_control); app_scrap(binop,yes_math); break;
6166
6167
case @'+':/* Handle \FORTRAN's |@r +1.0|; now also ANSI~C: ``|x = +2.5;|'' */
6168
case @'<':
6169
case @'>':
6170
case @'=':
6171
case @'%':
6172
case @'!':
6173
case @'~':
6174
case @'-':
6175
case @'*':
6176
case @'|':
6177
case @'?':
6178
case @'^':
6179
app_overload(); @~ break;
6180
6181
case @'&':
6182
lst_ampersand = YES;
6183
app_overload(); @~ break;
6184
6185
case @'#':
6186
switch(*loc)
6187
{
6188
case @'\'':
6189
APP_STR("\\WNq");
6190
loc++;
6191
break;
6192
6193
case @'"':
6194
APP_STR("\\WNQ");
6195
loc++;
6196
break;
6197
6198
default:
6199
APP_STR("\\#");
6200
break;
6201
}
6202
6203
app_scrap(expr,maybe_math);
6204
break;
6205
6206
case ignore: case xref_roman: case xref_wildcard:
6207
case xref_typewriter: break;
6208
6209
case @'(': app(next_control); app_scrap(lpar, yes_math); break; // !!!
6210
case @')': app(next_control);
6211
app_scrap(rpar, yes_math);
6212
if(preprocessing && !did_arg)
6213
{
6214
app(@' ');
6215
app_scrap(ignore_scrap, no_math);
6216
did_arg = YES;
6217
}
6218
break; // !!!
6219
6220
case @'[': app(next_control); app_scrap(lbracket,yes_math); break;
6221
case @']': app(next_control); app_scrap(rbracket,yes_math); break;
6222
6223
case @'{': APP_STR("\\{"); app_scrap(lbrace,yes_math); break;
6224
case @'}': APP_STR("\\}"); app_scrap(rbrace,yes_math); break;
6225
6226
case @',': app(@','); app_scrap(comma,yes_math); break; // !!!
6227
6228
case interior_semi:
6229
in_data = NO;
6230
app(@';');
6231
app_scrap(semi,maybe_math);
6232
break;
6233
6234
case end_format_stmt:
6235
in_format = NO; /* Falls through to the next case,
6236
which appends the semi. */
6237
6238
case @';':
6239
in_data = NO;
6240
6241
if(!is_FORTRAN_(language) || prn_semis)
6242
app(@';');
6243
6244
app_scrap(semi,maybe_math);
6245
break;
6246
6247
case @':':
6248
app(@':');
6249
app_scrap(colon,maybe_math);
6250
break;
6251
6252
case @'`':
6253
@#if 0
6254
if(!ok_to_define)
6255
{
6256
APP_STR("\\WLQx"); app_scrap(expr,maybe_math);
6257
}
6258
else
6259
{
6260
q_protected = BOOLEAN(!q_protected);
6261
app(q_protected ? @'{' : @'}');
6262
app_scrap(expr,yes_math);
6263
}
6264
@#endif
6265
APP_STR("\\WLQx"); app_scrap(expr,maybe_math);
6266
break;
6267
6268
@
6269
@<Append scraps for |begin_language|@>=
6270
6271
switch(language)
6272
{
6273
case NO_LANGUAGE:
6274
CONFUSION("append scraps for begin_language",
6275
"A language hasn't been defined yet");
6276
6277
case C:
6278
case C_PLUS_PLUS:
6279
case LITERAL:
6280
column_mode = NO; @~ break;
6281
6282
case FORTRAN:
6283
case FORTRAN_90:
6284
case RATFOR:
6285
case RATFOR_90:
6286
if(mode0==OUTER && !free_form_input) @<Set up column mode@>@;
6287
break;
6288
6289
case TEX:
6290
if(mode0==OUTER) @<Set up col...@>@;
6291
break;
6292
6293
case NUWEB_OFF:
6294
case NUWEB_ON:
6295
CONFUSION("append scraps for begin_language",
6296
"Language %i is invalid", language);
6297
}
6298
6299
set_language(language);
6300
break@;
6301
6302
@ The following function returns a pointer to an |OPERATOR| structure, or
6303
|NULL| if there's something invalid about the operator. Identifiers must
6304
be searched for explicitly. If an identifier isn't there, it's put into
6305
the table.
6306
@<Part 3@>=@[
6307
6308
OPERATOR HUGE *
6309
valid_op FCN((op_code))
6310
eight_bits op_code C1("")@;
6311
{
6312
int n = 0;
6313
OPERATOR HUGE *p;
6314
6315
switch(op_code)
6316
{
6317
case @'/':
6318
case @'+':
6319
case @'<':
6320
case @'>':
6321
case @'=':
6322
case @'%':
6323
case @'!':
6324
case @'~':
6325
case @'-':
6326
case @'*':
6327
case @'&':
6328
case @'|':
6329
case @'?':
6330
case @'^':
6331
case ellipsis:
6332
case not_eq:
6333
case lt_eq:
6334
case gt_eq:
6335
case eq_eq:
6336
case and_and:
6337
case or_or:
6338
case plus_plus:
6339
case minus_minus:
6340
case minus_gt:
6341
case gt_gt:
6342
case lt_lt:
6343
case star_star:
6344
case slash_slash:
6345
p = op + op_code;
6346
if(p >= op + 128) CONFUSION("valid_op",
6347
"Operator 0x%x is out of range", op_code);
6348
return p;
6349
6350
case compound_assignment:
6351
if(assignment_token==or_or_or)
6352
return op + @'|';
6353
6354
p = op + CA_START + assignment_token;
6355
if(p >= op + 128) CONFUSION("valid_op",
6356
"Compound assignment operator 0x%x is out of range",
6357
op + assignment_token);
6358
return p;
6359
6360
case dot_const:
6361
if(!FORTRAN_LIKE(language)) return NULL;
6362
id_first = dot_op.name + 1;
6363
id_loc = id_first + STRLEN(id_first);
6364
6365
case identifier:
6366
if(!FORTRAN_LIKE(language)) return NULL; /* Can do names only in
6367
\Fortran. */
6368
@<Add an operator to the table, if necessary, and |return p@;|@>@;
6369
}
6370
6371
return NULL;
6372
}
6373
6374
@
6375
@<Add an operator...@>=
6376
{
6377
ASCII id[255];
6378
6379
STRNCPY(id,id_first,n=PTR_DIFF(int,id_loc,id_first));
6380
id[n] = '\0'; // Make into proper string.
6381
6382
for(p=op+128; p<op_ptr; p++)
6383
if(STRCMP(p->op_name,id) == 0) return p;
6384
6385
if(op_ptr >= op_end) OVERFLW("op table","op");
6386
6387
p->op_name = GET_MEM("op name",n+1,ASCII);
6388
STRCPY(p->op_name,id);
6389
op_ptr++;
6390
return p;
6391
}
6392
6393
@ The form in which operators are appended depends on whether they have
6394
been overloaded with an \.{@@v}~command or not. If they have not, they are
6395
are appended as a straight macro name, such as the translation of
6396
`\.{.FALSE.}' into `\.{\\WFALSE}'. If they have been overloaded, they are
6397
appended instead as a construction such as `\.{\\Wop\{FALSE\}\{N\}}';
6398
the output limbo section will then contain an automatically generated
6399
definition such as `\.{\\newop\{FALSE\}\{N\}\{\\\{.FALSE.\}\}}'. This
6400
defines the macro \.{\\\_FALSE\_N} to have the definition specified in the
6401
\.{@@v}~command.
6402
6403
@<Part 3@>=@[
6404
6405
SRTN
6406
app_overload(VOID)
6407
{
6408
int ln = language_num;
6409
OPERATOR HUGE *p = valid_op(next_control);
6410
OP_INFO HUGE *q = p->info + ln;
6411
char temp[10];
6412
6413
if(overload_ops && q->overloaded)
6414
{
6415
switch(q->cat)
6416
{
6417
case unorbinop:
6418
case binop:
6419
APP_STR("\\Wb{"); @~ break;
6420
6421
case unop:
6422
APP_STR("\\Wu{"); @~ break;
6423
6424
default:
6425
APP_STR(" \\Wop{"); @~ break;
6426
}
6427
6428
app_ASCII_str(p->op_name);
6429
sprintf(temp,"}{%s}",lang_codes[ln]);
6430
APP_STR(temp);
6431
}
6432
else if(q->op_macro)
6433
APP_STR(q->op_macro);
6434
else
6435
{
6436
err_print(W, "Unidentifiable operator or dot constant in language \
6437
%s. Missing @@v?",
6438
languages[ln]);
6439
APP_STR("\\Wunknown{");
6440
app(wt_style.dot_delimiter.begin);
6441
app_ASCII_str(p->op_name);
6442
app(wt_style.dot_delimiter.end);
6443
app(@'}');
6444
app_scrap(binop,yes_math);
6445
return;
6446
}
6447
6448
app_scrap(q->cat,yes_math);
6449
}
6450
6451
@ The following code must use |app_tok| instead of |app| in order to
6452
protect against overflow. Note that |tok_ptr+1<=max_toks| after |app_tok|
6453
has been used, so another |app| is legitimate before testing again.
6454
6455
Many of the special characters in a string must be prefixed by '\.\\' so that
6456
\TeX\ will print them properly.
6457
@^special string characters@>
6458
6459
@<Append a string or...@>=
6460
6461
if(next_control == stmt_label && !isDigit(*id_first))
6462
{/* Identifier as statement label. */
6463
p = id_lookup(id_first,id_loc,normal);
6464
APP_FLAG(id, p, name_dir);
6465
app_scrap(label,no_math);
6466
}
6467
else
6468
{
6469
if (next_control==constant || next_control==stmt_label)
6470
APP_STR("\\WO{");
6471
@.\\WO@>
6472
else if (next_control==stringg)
6473
@<Append commands for beginning of string@>@;
6474
@.\\.@>
6475
else APP_STR("\\={");
6476
@.\\=@>
6477
6478
@<Append the basic string@>@;
6479
6480
if(next_control==stmt_label)
6481
{app_scrap(label,no_math);}
6482
else
6483
{app_scrap(expr,yes_math);}
6484
}
6485
6486
@
6487
@<Append commands for beginning of string@>=
6488
{
6489
APP_STR(pfrmt->typewritr);
6490
app_tok(@'{');
6491
}
6492
6493
@ Here we append the string material within [|id_first|,|id_loc|). This is
6494
basically straightforward; however, commas are replaced by~`\.{\\1}' (which
6495
will be treated as a comma followed by a discretionary break), the
6496
|discretionary_break| code is replaced by~`\.{\\2}' (which will be treated
6497
as a discretionary break), the |ordinary_space| code is replaced
6498
by~`\.{\\2}' (which is treated as an ordinary space, not~`\.{\ }'), and the
6499
|tab_mark| code (which will be present only in \TeX\ mode) is replaced
6500
by~`\.{\\3}', which is defined in \.{fwebmac.web} to be several spaces.
6501
6502
@<Append the basic str...@>=
6503
{
6504
app_tok(verbatim);
6505
// For toggling string state so can handle higher-order chars.
6506
6507
while (id_first<id_loc)
6508
{
6509
switch (*id_first)
6510
{
6511
case @',': *id_first = @'1'; app(@'\\'); break;
6512
6513
case ordinary_space:
6514
*id_first = @'2'; app(@'\\'); break;
6515
6516
case tab_mark:
6517
*id_first = @'3'; app(@'\\'); break;
6518
6519
case discretionary_break: *id_first = @'0'; // Falls through!
6520
6521
@<Special string cases@>:
6522
app(@'\\'); break;
6523
6524
case @'@@': if (*(id_first+1)==@'@@') id_first++;
6525
else err_print(W,"Double %s@@%s should be used in strings",
6526
SSET_COLOR(character), SSET_COLOR(error));
6527
@.Double \AT! should be used...@>
6528
}
6529
6530
app_tok(*id_first++);
6531
}
6532
6533
/* End the macro. */
6534
app_tok(verbatim);
6535
// For toggling string state so can handle higher-order chars.
6536
app(@'}');
6537
}
6538
6539
@ Here are the characters that are special to \TeX\ and therefore need to
6540
be escaped within a string.
6541
6542
@f @<Special string cases@> default
6543
@f @<Special \TeX\ cases@> default
6544
@f @<Other string cases@> default
6545
6546
@<Special string cases@>=
6547
6548
@<Special \TeX\ cases@>:
6549
@<Other string cases@>@: @;
6550
6551
@
6552
@<Special \TeX\ cases@>=
6553
6554
case @'\\':case @'{': case @'}'@: @;
6555
6556
@
6557
@<Other string cases@>=
6558
case @' ':case @'#':case @'%':case @'$':case @'^':case @'`':
6559
case @'~': case @'&': case @'_'@: @;
6560
6561
@ This fragment appends the text collected inside `\.{@@t\dots@@>}'. That
6562
text is placed inside an \.{\\hbox} and treated as an ordinary expression.
6563
6564
@<Append a \TeX\ string scrap@>=
6565
6566
APP_STR("\\hbox{"); while (id_first<id_loc) app_tok(*id_first++);
6567
app(@'}'); app_scrap(expr,maybe_math);
6568
6569
@ Ordinary identifiers are just treated as expressions, unless \.{@@R} was
6570
invoked just before. The commands \.{@@R} and \.{@@E} set |the_type|.
6571
6572
@<Glob...@>=
6573
6574
EXTERN boolean the_type SET(NO_TYPE);
6575
6576
@
6577
@<Append an identifier scrap@>=
6578
{
6579
p = id_lookup(id_first, id_loc, normal);
6580
6581
@#if 0
6582
if (p->ilk==normal || !(p->reserved_word & (boolean)language) )
6583
{
6584
APP_FLAG(id, p, name_dir);
6585
app_scrap(expr,maybe_math); /* not a reserved word */
6586
}
6587
else
6588
{
6589
APP_FLAG(res, p, name_dir);
6590
app_scrap(p->ilk,maybe_math);
6591
}
6592
@#endif
6593
6594
if(p->wv_macro)
6595
{
6596
WV_MACRO HUGE *w = p->wv_macro;
6597
ASCII HUGE *s = w->text;
6598
6599
if(w->cat)
6600
{
6601
APP_STR(pfrmt->id);
6602
app(@'{');
6603
}
6604
6605
while(*s)
6606
app_tok(*s++);
6607
6608
if(w->cat)
6609
app(@'}');
6610
6611
app_scrap(p->ilk ? p->ilk : expr, w->cat ? maybe_math : yes_math);
6612
}
6613
else if ( (p->reserved_word & (boolean)language) && the_type != ORDINARY_ID
6614
|| the_type == RESERVED_WD)
6615
{
6616
eight_bits the_ilk;
6617
6618
APP_FLAG(res, p, name_dir);
6619
6620
the_ilk = (the_type == RESERVED_WD) ? int_like : p->ilk;
6621
6622
app_scrap(the_ilk == normal ? expr : the_ilk,
6623
the_ilk < max_math ? yes_math : maybe_math);
6624
/* See the inverse construction in \.{reserved}:|save_words|. The last
6625
|yes_math| should only be relevant for |@c++ new, delete|. */
6626
}
6627
else
6628
{
6629
if(upcoming_kind)
6630
{
6631
APP_STR("\\WKINDCHAR");
6632
}
6633
6634
APP_FLAG(id, p, name_dir);
6635
app_scrap(expr, upcoming_kind ? yes_math : maybe_math);
6636
// Not a reserved word.
6637
6638
upcoming_kind = NO;
6639
}
6640
6641
the_type = NO_TYPE;
6642
}
6643
6644
@
6645
@<Output an RCS-like keyword@>=
6646
{
6647
ASCII *id_start, *id_end;
6648
6649
@<Strip white space from around RCS-like keyword@>@;
6650
6651
id_start = id_end = mod_text + 1;
6652
6653
x_keyword(&id_end, mod_end, id_first, id_loc, NO, NO,
6654
upper_case_code ? WEB_FILE : CUR_FILE);
6655
6656
out_del_str(id_start, id_end);
6657
}
6658
6659
@
6660
@<Strip white...@>=
6661
{
6662
while(IS_WHITE(*id_first))
6663
id_first++;
6664
6665
while(IS_WHITE(id_loc[-1]))
6666
id_loc--;
6667
}
6668
6669
@
6670
@<Append the output file...@>=
6671
{
6672
APP_STR(upper_case_code ? "\\WOut{" : "\\Wout{");
6673
6674
*id_loc = '\0'; // Terminate file name.
6675
6676
/* Store current (and possibly global) file names. (These names shouldn't
6677
be escaped yet!) */
6678
was_opened(id_first, upper_case_code, ¶ms.OUTPUT_FILE_NAME, NULL);
6679
6680
if(upper_case_code)
6681
was_opened(id_first, upper_case_code,
6682
&global_params.OUTPUT_FILE_NAME, NULL);
6683
6684
/* Now escape the buffer and append it. */
6685
id_first = esc_buf(mod_text+1, mod_end, id_first, YES);
6686
6687
while(*id_first)
6688
app_tok(*id_first++);
6689
6690
app(@'}');
6691
6692
@%if(nuweb_mode)
6693
app(force);
6694
6695
app_scrap(ignore_scrap,no_math);
6696
6697
if(nuweb_mode)
6698
{ /* !!!!! */
6699
next_control = begin_meta;
6700
continue;
6701
}
6702
}
6703
6704
@ When the~`\ttv' that introduces \cee\ text is sensed, a call on
6705
|C_translate| will return a pointer to the \TeX\ translation of that text.
6706
If scraps exist in |scrp_info|, they are unaffected by this translation
6707
process.
6708
6709
@<Part 2@>=@[
6710
6711
text_pointer
6712
C_translate(VOID)
6713
{
6714
text_pointer p; // Points to the translation.
6715
scrap_pointer save_base; // Holds original value of |scrp_base|.
6716
PARAMS outer_params;
6717
PARSE_PARAMS parse_params0;
6718
6719
outer_params = params;
6720
parse_params0 = parse_params;
6721
6722
save_base = scrp_base;
6723
scrp_base = scrp_ptr+1; // Empty work space after last existing scrap.
6724
6725
/* We enclose code fragments with the \TeX\ macro~\.{\\WCD\{\dots\}}. */
6726
if(output_protect)
6727
APP_STR("\\protect");
6728
6729
APP_STR("\\WCD{"); app_scrap(ignore_scrap,no_math);
6730
6731
if(nuweb_mode)
6732
{
6733
APP_STR("{\\tt ");
6734
app_scrap(ignore_scrap, no_math);
6735
}
6736
6737
while(next_control <= module_name)
6738
{
6739
C_parse(INNER); // Get the scraps together.
6740
6741
if(next_control == @'|')
6742
break;
6743
6744
@<Emit the scrap for a module name if present@>;
6745
6746
if(next_control == @'|')
6747
break;
6748
}
6749
6750
app_tok(cancel); app_scrap(ignore_scrap,maybe_math);
6751
// Place a |cancel| token as a final ``comment''.
6752
6753
if(nuweb_mode)
6754
app(@'}');
6755
#if 0
6756
else
6757
app_scrap(semi, maybe_math); /* Append a pseudo-semicolon to try to
6758
force the code fragments to reduce to full statements. */
6759
#endif
6760
6761
if(output_protect)
6762
{
6763
app(protect_code);
6764
app_scrap(ignore_scrap, no_math);
6765
}
6766
6767
app(@'}'); app_scrap(ignore_scrap,no_math);
6768
6769
if (next_control != @'|')
6770
ERR_PRINT(W, "Missing '|' after code text. \
6771
(@@ commands that begin definition part, code part, or new module are not \
6772
allowed within |...|.)");
6773
@.Missing '|'...@>
6774
6775
p = translate(INNER); // Make the translation.
6776
6777
if (scrp_ptr>mx_scr_ptr)
6778
mx_scr_ptr=scrp_ptr;
6779
6780
scrp_ptr = scrp_base-1; // Restore old |scrp_ptr|.
6781
scrp_base = save_base; // Scrap the scraps.
6782
6783
params = outer_params;
6784
frz_params();
6785
6786
parse_params = parse_params0;
6787
6788
return p;
6789
}
6790
6791
@ The |outr_parse| routine is to |C_parse| as |outr_xref| is to |C_xref|:
6792
it constructs a sequence of scraps for \cee\ text until
6793
|next_control>=formatt|. Thus, it takes care of embedded comments.
6794
6795
@<Part 2@>=@[
6796
6797
SRTN
6798
outr_parse(VOID) /* makes scraps from \cee\ tokens and comments */
6799
{
6800
int bal; // Brace level in comment.
6801
text_pointer p, q; // Partial comments. |p|: Stuff before `\Cb'; |q|: `\Cb'.
6802
6803
while (next_control<formatt)
6804
{
6805
if (next_control != begin_comment)
6806
C_parse(OUTER);
6807
else
6808
@<Append a comment or compiler directive@>@;
6809
}
6810
}
6811
6812
@
6813
@<Append a comment...@>=
6814
{ // Append a comment/compiler directive.
6815
if(doing_cdir)
6816
@<Begin a compiler directive@>@;
6817
else
6818
@<Append a regular comment@>@;
6819
6820
bal = copy_comment(1); // Closing brace is inserted here.
6821
next_control = ignore;
6822
6823
if(doing_cdir && bal > 0)
6824
ERR_PRINT(W,"Can't have vertical bars in @@! compiler directives");
6825
6826
doing_cdir = NO;
6827
6828
/* Handle code mode inside comments. */
6829
while (bal > 0)
6830
{
6831
in_comment = YES;
6832
p=text_ptr; freeze_text;
6833
6834
q = C_translate();
6835
/* at this point we have |tok_ptr+7<=max_toks| */
6836
APP_FLAG(tok,p,tok_start); APP_FLAG(inner_tok,q,tok_start);
6837
6838
if (next_control==@'|')
6839
{
6840
bal = copy_comment(bal);
6841
next_control = ignore;
6842
}
6843
else
6844
bal = 0; // An error has been reported.
6845
}
6846
6847
app(force); app_scrap(ignore_scrap,no_math); /* the full comment
6848
becomes a scrap */
6849
}
6850
6851
@ Compiler directives are begun by the style-file text \.{cdir.start}. For
6852
example, `\.{@@!abc}' $\to$ `\.{\#pragma\ abc}'.
6853
6854
@<Begin a compiler dir...@>=
6855
{
6856
outer_char HUGE *s = t_style.cdir_start[language_num];
6857
int n = 2*STRLEN(s) + 1;
6858
/* The factor of~2 counts possible escapes, and the 1 takes care of |'\0'|. */
6859
ASCII HUGE *temp = GET_MEM("temp_cdir",n,ASCII);
6860
ASCII HUGE *start = GET_MEM("start_cdir",n,ASCII);
6861
6862
STRCPY(start,s);
6863
to_ASCII((outer_char HUGE *)start);
6864
6865
room_for(9+n,3,1); /* Tokens: */
6866
6867
app(force);
6868
APP_STR("\\WCDIR{");
6869
esc_buf(temp,temp+n,start,YES); @~ APP_STR(to_outer(temp));
6870
@.\\WCDIR@>
6871
FREE_MEM(temp,"temp_cdir",n,ASCII);
6872
FREE_MEM(start,"start_cdir",n,ASCII);
6873
}
6874
6875
@
6876
@<Append a regular comment@>=
6877
{
6878
room_for(8,3,1); /* Tokens: `\.{;{ }\ { }\\{ }W{ }C\{{ }\}{ }\It{force}}'. */
6879
6880
if(Fortran88)
6881
{
6882
if(free_Fortran && lst_ampersand)
6883
{
6884
scrp_ptr--; // Kill off the \.{\&}.
6885
}
6886
else if(!at_beginning && (auto_semi && !free_Fortran))
6887
{
6888
app(@';');
6889
}
6890
last_was_cmnt = YES;
6891
}
6892
6893
app(break_space);
6894
APP_STR(long_comment ? "\\WC{" : "\\Wc{"); // Long/short comment.
6895
@.\\WC@> @.\\Wc@>
6896
}
6897
6898
@* OUTPUT of TOKENS. So far our programs have only built up multi-layered
6899
token lists in \.{WEAVE}'s internal memory; we have to figure out how to
6900
get them into the desired final form. The job of converting token lists to
6901
characters in the \TeX\ output file is not difficult, although it is an
6902
implicitly recursive process. Three main considerations had to be kept in
6903
mind when this part of \.{WEAVE} was designed: (a)~There are two modes of
6904
output, |outer| mode that translates tokens like |force| into line-breaking
6905
control sequences, and |inner| mode, intended for code between~\Cb, that
6906
ignores them except that blank
6907
spaces take the place of line breaks. (b)~The |cancel| instruction applies
6908
to adjacent token or tokens that are output, and this cuts across levels of
6909
recursion since `|cancel|' occurs at the beginning or end of a token list
6910
on one level. (c)~The \TeX\ output file will be semi-readable if line
6911
breaks are inserted after the result of tokens like |break_space| and
6912
|force|. (d)~The final line break should be suppressed, and there should
6913
be no |force| token output immediately after `\.{\\WY\\WP}'.
6914
6915
@i output.hweb
6916
6917
@ The output process uses a stack to keep track of what is going on at
6918
different ``levels'' as the token lists are being written out. Entries on
6919
this stack have three parts:
6920
6921
\yskip\hang |end_field| is the |tok_mem| location where the token list of a
6922
particular level will end;
6923
6924
\yskip\hang |tok_field| is the |tok_mem| location from which the next token
6925
on a particular level will be read;
6926
6927
\yskip\hang |mode_field| is the current mode, either |inner| or |outer|.
6928
6929
\yskip\noindent The current values of these quantities are referred to
6930
quite frequently, so they are stored in a separate place instead of in the
6931
|stack| array. We call the current values |cur_end|, |cur_tok|, and
6932
|cur_mode|.
6933
6934
The global variable |stck_ptr| tells how many levels of output are
6935
currently in progress. The end of output occurs when an |end_translation|
6936
token is found, so the stack is never empty except when we first begin the
6937
output process.
6938
6939
@d inner 0 /* Value of |mode| for \cee\ texts within \TeX\ texts */
6940
@d outer 1 /* Value of |mode| for \cee\ texts in modules */
6941
6942
@<Typed...@>=
6943
6944
typedef int mode;
6945
6946
typedef struct {
6947
token_pointer end_field; /* Ending location of token list */
6948
token_pointer tok_field; /* Present location within token list */
6949
boolean mode_field; /* Interpretation of control tokens */
6950
} output_state;
6951
6952
typedef output_state HUGE *stack_pointer;
6953
6954
@
6955
@d cur_end cur_state.end_field /* Current ending location in |tok_mem| */
6956
@d cur_tok cur_state.tok_field /* Location of next output token in |tok_mem| */
6957
@d cur_mode cur_state.mode_field /* Current mode of interpretation */
6958
@d ini_stack stck_ptr=stack;cur_mode=outer@; /* Initialize the stack */
6959
6960
@<Global...@>=
6961
6962
EXTERN output_state cur_state; /* |cur_end|, |cur_tok|, |cur_mode| */
6963
6964
EXTERN BUF_SIZE stck_size;
6965
EXTERN output_state HUGE *stack; /* Dynamic array of info for non-current
6966
levels */
6967
EXTERN stack_pointer stck_end; /* End of |stack| */
6968
6969
EXTERN stack_pointer stck_ptr; /* First unused location in the output
6970
state stack */
6971
EXTERN stack_pointer mx_stck_ptr; /* Largest value assumed by |stck_ptr| */
6972
6973
@
6974
@<Alloc...@>=
6975
6976
ALLOC(output_state,stack,ABBREV(stck_size_w),stck_size,0);
6977
stck_end=stack+stck_size-1; /* End of |stack| */
6978
6979
@
6980
@<Set init...@>=
6981
6982
mx_stck_ptr=stack;
6983
6984
@ To insert token-list |p| into the output, the |push_level| subroutine is
6985
called; it saves the old level of output and gets a new one going. The
6986
value of |cur_mode| is not changed.
6987
6988
@<Part 2@>=@[
6989
6990
SRTN
6991
push_level FCN((p)) /* Suspends the current level */
6992
text_pointer p C1("")@;
6993
{
6994
if (stck_ptr==stck_end) OVERFLW("stack levels",ABBREV(stck_size_w));
6995
6996
if (stck_ptr>stack) { /* save current state */
6997
stck_ptr->end_field=cur_end;
6998
stck_ptr->tok_field=cur_tok;
6999
stck_ptr->mode_field=cur_mode;
7000
}
7001
7002
stck_ptr++;
7003
7004
if (stck_ptr>mx_stck_ptr) mx_stck_ptr=stck_ptr;
7005
7006
cur_tok=*p; cur_end=*(p+1);
7007
}
7008
7009
@ Conversely, the |pop_level| routine restores the conditions that were in
7010
force when the current level was begun. This subroutine will never be
7011
called when |stck_ptr=1|.
7012
7013
@<Part 2@>=@[
7014
7015
SRTN
7016
pop_level(VOID)
7017
{
7018
cur_end=(--stck_ptr)->end_field;
7019
cur_tok=stck_ptr->tok_field; cur_mode=stck_ptr->mode_field;
7020
}
7021
7022
@ The |get_output| function returns the next byte of output that is not a
7023
reference to a token list. It returns the values |identifier| or |res_word|
7024
or |mod_name| if the next token is to be an identifier (typeset in
7025
italics), a reserved word (typeset in boldface) or a module name (typeset
7026
by a complex routine that might generate additional levels of output). In
7027
these cases |cur_name| points to the identifier or module name in question.
7028
7029
@<Global...@>=
7030
7031
EXTERN name_pointer cur_name;
7032
7033
@
7034
@d res_word OCTAL(201) /* Returned by |get_output| for reserved words */
7035
@d mod_name OCTAL(200) /* Returned by |get_output| for module names */
7036
7037
@<Part 2@>=@[
7038
eight_bits
7039
get_output(VOID) /* Returns the next token of output */
7040
{
7041
sixteen_bits a; /* Current item read from |tok_mem| */
7042
7043
restart: while (cur_tok==cur_end) pop_level(); /* Get back to unfinished
7044
level. */
7045
7046
a=*(cur_tok++);
7047
7048
if (a>=0400)
7049
{
7050
cur_name=a % id_flag + name_dir;
7051
7052
switch (a / id_flag)
7053
{
7054
case 2: return res_word; /* |a==res_flag+cur_name| */
7055
case 3: return mod_name; /* |a==mod_flag+cur_name| */
7056
case 4: push_level(a % id_flag + tok_start); goto restart;
7057
/* |a==tok_flag+cur_name| */
7058
case 5: push_level(a % id_flag + tok_start); cur_mode=inner;
7059
goto restart;
7060
/* |a==inner_tok_flag+cur_name| */
7061
default: return identifier; /* |a==id_flag+cur_name| */
7062
}
7063
}
7064
7065
/* If we get here, it's a single-byte token. */
7066
return (eight_bits)a;
7067
}
7068
7069
@ The real work associated with token output is done by |make_output|.
7070
This procedure appends an |end_translation| token to the current token
7071
list, and then it repeatedly calls |get_output| and feeds characters to the
7072
output buffer until reaching the |end_translation| sentinel. It is possible
7073
for |make_output| to be called recursively, since a module name may include
7074
embedded \cee\ text; however, the depth of recursion never exceeds one
7075
level, since module names cannot be inside of module names.
7076
7077
A procedure called |output_C| does the scanning, translation, and output of
7078
\cee\ text within `\Cb'~brackets, and this procedure uses |make_output| to
7079
output the current token list. Thus, the recursive call of |make_output|
7080
actually occurs when |make_output| calls |output_C| while outputting the
7081
name of a module.
7082
@^recursion@>
7083
7084
@<Part 2@>=@[
7085
7086
SRTN
7087
output_C(VOID) /* Outputs the current token list */
7088
{
7089
token_pointer save_tok_ptr;
7090
text_pointer save_text_ptr;
7091
eight_bits save_next_control; /* Values to be restored */
7092
text_pointer p; /* Translation of the \cee\ text */
7093
7094
save_tok_ptr=tok_ptr; save_text_ptr=text_ptr;
7095
save_next_control=next_control;
7096
7097
next_control=ignore; p=C_translate();
7098
APP_FLAG(inner_tok,p,tok_start);
7099
scanning_meta = NO;
7100
7101
make_output(); /* output the list */
7102
7103
if (text_ptr>mx_text_ptr) mx_text_ptr=text_ptr;
7104
if (tok_ptr>mx_tok_ptr) mx_tok_ptr=tok_ptr;
7105
7106
text_ptr=save_text_ptr; tok_ptr=save_tok_ptr; /* Forget the tokens */
7107
next_control=save_next_control; /* Restore |next_control| to original
7108
state */
7109
}
7110
7111
@ Here is \.{WEAVE}'s major output handler.
7112
7113
@<Part 3@>=@[
7114
7115
SRTN
7116
make_output(VOID) /* outputs the equivalents of tokens */
7117
{
7118
eight_bits a; // Current output byte.
7119
eight_bits b; // Next output byte.
7120
int c; // Count of |indent| and |outdent| tokens.
7121
boolean copying = NO; // Are we copying the \TeX\ part of a comment?
7122
7123
app(end_translation); // Append a sentinel.
7124
freeze_text; push_level(text_ptr-1);
7125
7126
WHILE()
7127
{
7128
a = get_output();
7129
7130
reswitch: switch(a)
7131
{
7132
case ignore: continue; // In case a null sneaks in.
7133
7134
case verbatim:
7135
while((a=get_output()) != verbatim)
7136
out(a);
7137
continue;
7138
7139
case begin_language:
7140
language = lan_enum(get_output()); /* The byte after
7141
|begin_language| contains the language number. */
7142
continue;
7143
7144
@<Cases for turning output on or off@>@:@;
7145
7146
case out_force:
7147
continue;
7148
7149
case end_translation:
7150
return;
7151
7152
case identifier: case res_word:
7153
if(output_on)
7154
@<Output an identifier@>@;
7155
break;
7156
7157
case mod_name:
7158
if(output_on)
7159
@<Output a module name@>@; @~ break;
7160
7161
case math_bin: case math_rel:
7162
@<Output a \.{\\math} operator@>; @~ break;
7163
7164
case toggle_meta:
7165
scanning_meta = BOOLEAN(!scanning_meta);
7166
break;
7167
7168
case cancel:
7169
c=0; while ((a=get_output())>=indent && a<=big_force)
7170
{
7171
if (a==indent) c++; if (a==outdent) c--;
7172
}
7173
@<Output saved |indent| or |outdent| tokens@>;
7174
goto reswitch;
7175
7176
case big_cancel:
7177
c=0;
7178
while (((a=get_output())>=indent || a==@' ') && a<=big_force)
7179
{
7180
if (a==indent) c++; if (a==outdent) c--;
7181
}
7182
@<Output saved...@>;
7183
goto reswitch;
7184
7185
case indent: case outdent: case opt: case backup: case break_space:
7186
case force: case big_force:
7187
@<Output a control,
7188
look ahead in case of line breaks, possibly |goto reswitch@;|@>; break;
7189
7190
case interior_semi:
7191
if(output_on) out(';');
7192
break;
7193
7194
case @'*':
7195
if(!(copying || nuweb_mode))
7196
{
7197
OUT_STR("\\ast "); // Special macro for asterisks in code mode.
7198
@.\\ast@>
7199
break;
7200
}
7201
/* If |copying|, the asterisk case falls through to the default. */
7202
7203
default:
7204
if(output_on)
7205
{
7206
out(a); // Otherwise |a| is an |ASCII| character.
7207
7208
if(scanning_meta && a=='\n')
7209
flush_buffer(out_ptr, NO);
7210
}
7211
}
7212
}
7213
}
7214
7215
@
7216
@<Output contents of a string@>=
7217
{
7218
}
7219
7220
@
7221
@<Cases for turning output on...@>=
7222
7223
case protect_code:
7224
output_protect = BOOLEAN(!output_protect); @~ break;
7225
7226
case copy_mode:
7227
copying = BOOLEAN(!copying); @~ break;
7228
7229
case turn_output_off:
7230
@% OUT_STR("OFF"); // For debugging.
7231
output_on = NO;
7232
break;
7233
7234
case turn_output_on:
7235
@% OUT_STR("ON"); // For debugging.
7236
output_on = YES;
7237
break;
7238
7239
case Turn_output_off:
7240
skip_file();
7241
strt_off = YES;
7242
@% OUT_STR("OFF"); // For debugging.
7243
output_on = NO;
7244
break;
7245
7246
case Turn_output_on:
7247
strt_off = NO;
7248
@% OUT_STR("ON"); // For debugging.
7249
output_on = YES;
7250
break;
7251
7252
7253
@
7254
@<Part 3@>=@[
7255
SRTN
7256
skip_file(VOID)
7257
{
7258
#define TEMP_LEN (MAX_FILE_NAME_LENGTH + 11)
7259
7260
outer_char temp[TEMP_LEN], temp1[TEMP_LEN];
7261
7262
esc_file_name(temp1, TEMP_LEN, prms[1].web.File_name);
7263
SPRINTF(TEMP_LEN, temp, `"\\Wskipped{%s}", temp1`);
7264
OUT_STR(temp);
7265
fin_line();
7266
7267
#undef TEMP_LEN
7268
}
7269
7270
@
7271
@<Part 3@>=@[
7272
SRTN
7273
out_skip(VOID)
7274
{
7275
@<Toggle output@>;
7276
7277
if(!output_on)
7278
{
7279
output_on = YES;
7280
OUT_STR("\\WY\\WP");
7281
skip_file();
7282
output_on = NO;
7283
}
7284
}
7285
7286
@
7287
7288
@<Output an identifier@>=
7289
{
7290
if(nuweb_mode)
7291
{
7292
ASCII HUGE *k;
7293
7294
for(k=cur_name->byte_start; k<(cur_name+1)->byte_start; k++)
7295
{
7296
out(*k);
7297
}
7298
}
7299
else
7300
@<Format and output an identifier@>@;
7301
}
7302
7303
7304
@ An identifier of length one does not have to be enclosed in braces, and
7305
it looks slightly better if set in a math-italic font instead of a
7306
(slightly narrower) text-italic font. Thus we output `\.{\\\char'174a}' but
7307
`\.{\\]\{aa\}}'.
7308
7309
@d ALL_UC (all_uc && length(cur_name) > 1)
7310
7311
7312
@<Format and output an id...@>=
7313
{
7314
boolean all_uc = cur_name->info.upper_case;
7315
7316
if(output_protect)
7317
OUT_STR("\\protect");
7318
7319
if (a==identifier)
7320
{
7321
if(is_intrinsic(cur_name))
7322
OUT_STR(pfrmt->intrinsic);
7323
/* Intrinsic function---e.g., |fopen|. */
7324
@.\\\AT!@>
7325
else if(is_keyword(cur_name))
7326
OUT_STR(ALL_UC ? pfrmt->KEYWORD : pfrmt->keyword);
7327
/* Fortran keyword---e.g., |@r BLOCKSIZE|. */
7328
@.\\.@>
7329
else if (length(cur_name)==1)
7330
OUT_STR(pfrmt->short_id);
7331
/* One-character identifier---e.g., |a|. */
7332
@.\\|@>
7333
else
7334
@<Output the appropriate identifier prefix@>@;
7335
}
7336
else
7337
OUT_STR(ALL_UC ? pfrmt->RESERVED : pfrmt->reserved);
7338
/* Reserved word---e.g., |float|. */
7339
@.\\\&@>
7340
7341
out_name(NULL, YES, IDENTIFIER, cur_name);
7342
}
7343
7344
@ Some people prefer macros to be formatted differently from ordinary
7345
identifiers.
7346
@<Output the appro...@>=
7347
switch(DEFINED_TYPE(cur_name))
7348
{
7349
case D_MACRO:
7350
OUT_STR(ALL_UC ? pfrmt->ID_OUTER : pfrmt->id_outer);
7351
// E.g., |NON_TEX_MACRO|.
7352
break;
7353
7354
case M_MACRO:
7355
OUT_STR(ALL_UC ? pfrmt->ID_INNER : pfrmt->id_inner); // E.g., |_FWEAVE_|.
7356
break;
7357
7358
default:
7359
OUT_STR(ALL_UC ? pfrmt->ID: pfrmt->id);
7360
// Longer ordinary identifier---e.g., |out|.
7361
break;
7362
@.\\\\@>
7363
}
7364
7365
@ Here |a|~will only be |math_bin| or |math_rel|.
7366
@<Output a \....@>=
7367
7368
OUT_STR(a==math_bin ? "\\mathbin{" : "\\mathrel{");
7369
@.\\mathbin@>
7370
@.\\mathrel@>
7371
7372
@ The current mode does not affect the behavior of \.{WEAVE}'s output routine
7373
except when we are outputting control tokens.
7374
7375
@<Output a control...@>=
7376
7377
if (a<break_space)
7378
{ /* $a \in \{|indent|, |outdent|, |opt|, or |backup|\}$. */
7379
if (cur_mode==outer)
7380
{
7381
if(output_on)
7382
{
7383
out(@'\\'); @~ out(a-cancel+@'0'); /* As an example,
7384
$|backup| = |0345| - |0341| + \.{'0'} = \.{'4'} \to \.{\\4}$. */
7385
}
7386
if (a==opt)
7387
{
7388
if(output_on)
7389
{
7390
out(get_output());
7391
} // |opt| is followed by a digit.
7392
else
7393
get_output();
7394
}
7395
}
7396
else if(a == opt)
7397
b = get_output(); // Ignore digit following |opt|.
7398
}
7399
else
7400
@<Look ahead for strongest line break, |goto reswitch@;|@>;
7401
/* Here $a \in \{|break_space|,|force|,|big_force|\}$. */
7402
7403
@ If several of the tokens |break_space|, |force|, |big_force| occur in a
7404
row, possibly mixed with blank spaces (which are ignored), the largest one
7405
is used. A line break also occurs in the output file, except at the very
7406
end of the translation. The very first line break is suppressed (i.e., a
7407
line break that follows `\.{\\WY\\WP}').
7408
7409
@<Look ahead for st...@>=
7410
{
7411
boolean save_mode; /* value of |cur_mode| before a sequence of breaks */
7412
7413
b=a; save_mode=cur_mode; c=0;
7414
7415
WHILE()
7416
{
7417
a = get_output();
7418
7419
if (a==cancel || a==big_cancel)
7420
{
7421
@<Output saved |indent| or |outdent| tokens@>;
7422
goto reswitch; // |cancel| overrides everything.
7423
}
7424
7425
if ((a!=@' ' && a<indent) || a==backup || a > big_force)
7426
@<Output something; |goto reswitch|@>@;
7427
7428
if (a==indent)
7429
c++; // Count the |indent|'s.
7430
else if (a==outdent)
7431
c--; // Count the |outdent|'s.
7432
else
7433
{ /* Use only the largest line-break command.. */
7434
if (a > b)
7435
b = a; // if |a==' '| we have |a < b|.
7436
else if(a==opt)
7437
get_output(); // Throw away digit after |opt|.
7438
}
7439
}
7440
}
7441
7442
@
7443
@<Output something...@>=
7444
{
7445
if (save_mode==outer)
7446
{
7447
if (out_ptr>out_buf+5 && STRNCMP(out_ptr-5,"\\WY\\WP",6)==0)
7448
goto reswitch;
7449
7450
@<Output saved |indent| or |outdent| tokens@>;
7451
7452
if(output_on)
7453
if(strt_off)
7454
{
7455
if(STRNCMP(out_ptr-2,"\\WP",3)==0)
7456
{
7457
out_ptr = out_buf;
7458
goto reswitch;
7459
}
7460
}
7461
else
7462
{
7463
out(@'\\'); @~ out(b-cancel+@'0');
7464
}
7465
if (a != end_translation)
7466
fin_line(); // Line break in the physical file for beauty.
7467
}
7468
else if (a != end_translation && cur_mode==inner)
7469
if(output_on)
7470
out(@' ');
7471
// In inner code mode, line breaks are replaced by spaces.
7472
7473
goto reswitch;
7474
}
7475
7476
@ While we're removing unwanted or duplicate tokens, we don't want to lose
7477
track of the indent level. So we count the |indent|s and |outdent|s, and
7478
write out the net here.
7479
7480
@<Output saved...@>=
7481
7482
for (;c>0;c--) OUT_STR("\\1");
7483
7484
for (;c<0;c++) OUT_STR("\\2");
7485
7486
@ The remaining part of |make_output| is somewhat more complicated. When we
7487
output a module name, we may need to enter the parsing and translation
7488
routines, since the name may contain code embedded in \Cb\~constructions.
7489
This code is placed at the end of the active input buffer and the
7490
translation process uses the end of the active |tok_mem| area.
7491
7492
@<Output a module name@>=
7493
#if FCN_CALLS
7494
out_md_name();
7495
#else
7496
@<Code to output a module name@>@;
7497
#endif
7498
7499
@
7500
@<Part 3@>=
7501
7502
#if FCN_CALLS
7503
@[
7504
SRTN
7505
out_md_name(VOID)
7506
{
7507
@<Code to output a module name@>@;
7508
}
7509
#endif
7510
7511
@
7512
@<Code to output a module name@>=
7513
{
7514
name_pointer cur_mod_name; /* name of module being output */
7515
7516
OUT_STR("\\WX{");
7517
@.\\WX@>
7518
cur_xref = (xref_pointer)cur_name->xref;
7519
7520
/* Output the module number, or zero if it was undefined */
7521
if (cur_xref->num>=def_flag)
7522
{
7523
out_mod(cur_xref->num-def_flag,ENCAP);
7524
7525
if (phase==3)
7526
{
7527
cur_xref=cur_xref->xlink;
7528
7529
while (cur_xref->num>=def_flag)
7530
{
7531
OUT_STR(", ");
7532
out_mod(cur_xref->num-def_flag,ENCAP);
7533
cur_xref=cur_xref->xlink;
7534
}
7535
}
7536
}
7537
else out(@'0');
7538
7539
out(@'}'); /* End the module number. */
7540
@<Output the text of the module name@>;
7541
OUT_STR("\\X "); /* End the text. (Can't use a colon here, because
7542
there may be colons in the text.) */
7543
OUT_STR(cur_xref->num >= def_flag ?
7544
LANGUAGE_SYMBOL((LANGUAGE)cur_mod_name->mod_info->language) :
7545
(CONST outer_char *)"");
7546
OUT_STR("\\X"); /* End the language marker. */
7547
}
7548
7549
@ In most situations, we only want to output a language marker if we're in
7550
a language different from the global language.
7551
7552
@d XLANGUAGE_NAME_PTR(l) Xlanguages[lan_num(l)]
7553
// Points to the full language name, in the form of \TeX\ macros.
7554
7555
@d LANGUAGE_SYMBOL(l)
7556
(l!=global_language ? LANGUAGE_CODE(l) : (CONST outer_char *)"")
7557
7558
@
7559
@<Output the text...@>=
7560
{
7561
ASCII HUGE *k, HUGE *k_limit; /* indices into |byte_mem| */
7562
ASCII HUGE *j; /* index into |cur_buffer| */
7563
ASCII HUGE *save_loc, HUGE *save_limit; // |loc| and |limit| to be restored.
7564
eight_bits b;
7565
7566
k=cur_name->byte_start; k_limit=(cur_name+1)->byte_start;
7567
cur_mod_name=cur_name;
7568
7569
while (k<k_limit)
7570
{
7571
b=*(k++);
7572
7573
if (b==@'@@') @<Skip next character, give error if not `\.{@@}'@>;
7574
7575
if (b!=@'|') out(b)@;
7576
else
7577
{
7578
@<Copy the \cee\ text into the |cur_buffer| array@>;
7579
save_loc=loc; save_limit=limit; loc=limit+2; limit=j+1;
7580
*limit=@'|'; output_C();
7581
loc=save_loc; limit=save_limit;
7582
}
7583
}
7584
}
7585
7586
@
7587
@<Skip next char...@>=
7588
7589
if (*k++!=@'@@')
7590
{
7591
SET_COLOR(error);
7592
printf("\n! Illegal control code in section name: <");
7593
@.Illegal control code...@>
7594
prn_id(cur_mod_name); printf("> ");
7595
mark_error;
7596
}
7597
7598
@ The \cee\ text enclosed in~\Cb\ should not contain `\vertbar'~characters,
7599
except within strings. We put a~`\vertbar' at the front of the buffer, so
7600
that an error message that displays the whole buffer will look a little bit
7601
sensible. The variable |delim| is zero outside of strings, otherwise it
7602
equals the delimiter that began the string being copied.
7603
7604
@<Copy the \cee\ text into...@>=
7605
{
7606
ASCII delim; /* first and last character of string being copied */
7607
7608
j=limit+1; *j=@'|'; delim=0;
7609
7610
WHILE()
7611
{
7612
if (k>=k_limit)
7613
{
7614
SET_COLOR(error);
7615
printf("\n! C text in section name didn't end: <");
7616
@.C text...didn't end@>
7617
prn_id(cur_mod_name); printf("> ");
7618
mark_error;
7619
break;
7620
}
7621
7622
b=*(k++);
7623
7624
if (b==@'@@')
7625
@<Copy a control code into the buffer@>@;
7626
else
7627
{
7628
if (b==@'\'' || b==@'"')
7629
if (delim==0) delim=b;
7630
else if ((eight_bits)delim == b) delim=0;
7631
7632
if (b!=@'|' || delim!=0)
7633
{
7634
if (j>cur_buffer+buf_size-2) OVERFLW("buffer","");
7635
7636
*(++j)=b;
7637
}
7638
else break;
7639
}
7640
}
7641
}
7642
7643
@
7644
@<Copy a control code into the buffer@>=
7645
{
7646
if (j>cur_buffer+buf_size-3) OVERFLW("buffer","");
7647
7648
*(++j)=@'@@'; *(++j)=*(k++);
7649
}
7650
7651
@* PHASE TWO PROCESSING. We have assembled enough pieces of the puzzle in
7652
order to be ready to specify the processing in \.{WEAVE}'s main pass over
7653
the source file. Phase two is analogous to phase one, except that more work
7654
is involved because we must actually output the \TeX\ material instead of
7655
merely looking at the \.{WEB} specifications.
7656
7657
@<Part 2@>=@[
7658
7659
SRTN
7660
phase2(VOID)
7661
{
7662
extern outer_char wbflnm0[];
7663
IN_COMMON int num_ifiles;
7664
7665
phase = 2; // Prepare for second phase.
7666
the_part = LIMBO;
7667
7668
params = global_params;
7669
frz_params();
7670
7671
rst_input();
7672
strt_off = ending_off = NO;
7673
writing(YES,tex_fname); @~ if(tex_file==stdout) putchar('\n');
7674
7675
fin_line(); // Write out the ``\.{\\input\ fwebmac.sty}''.
7676
7677
@<Issue the \.{\\Wbegin} command that sets up the beginning of the document@>@;
7678
7679
module_count = 0;
7680
num_ifiles = 0;
7681
7682
copy_limbo();
7683
flush_buffer(out_buf, NO); /* Insert a blank line---it looks nice. */
7684
7685
math_flag = NO;
7686
7687
while (!input_has_ended)
7688
@<Translate the current module@>@;
7689
}
7690
7691
@ After the macros have been read in, we are ready to
7692
actually begin the document. The command has the form
7693
``\.{\\Wbegin[\It{options}]\{\It{style}\}\{\It{TeXindent}\}\{\It{codeindent}\}
7694
\{\It{contents}\}
7695
\{\{\It{reserved}\}\{\It{short identifier}\}\{\It{identifier}\}
7696
\{\It{UPPERCASE identifier}\}
7697
\{\It{outer macro}\}\{\It{inner macro}\}
7698
\{\It{intrinsic}\}\{\It{keyword}\}\{\It{typewriter}\}\{\It{modtrans}\}\}}.''
7699
The \It{options} and \It{style} field are used only by \LaTeX.
7700
7701
@m OUT_PRM(fmt, n, cmt, ...) out_prm(OC(fmt), n, OC(cmt), #.)
7702
7703
@<Issue the \.{\\Wbegin} command...@>=
7704
{
7705
IN_COMMON outer_char style_file_name[];
7706
7707
OUT_STR("\n% --- Initialization parameters from FWEB's style file `");
7708
OUT_STR(style_file_name);
7709
OUT_STR("' ---");
7710
fin_line();
7711
7712
OUT_PRM("\\Wbegin[%s;%s]", 1, "[LaTeX.class.options;LaTeX.package.options]",
7713
w_style.misc.LaTeX.class.options, w_style.misc.LaTeX.package.options);
7714
7715
OUT_PRM("{%s;%s}", 2, "{LaTeX.class;LaTeX.package}",
7716
w_style.misc.LaTeX.class.file, w_style.misc.LaTeX.package.file);
7717
7718
OUT_PRM("{%s}", 3, "{indent.TeX}",
7719
w_style.misc.TeXindent);
7720
7721
OUT_PRM("{%s}", 4, "{indent.code}",
7722
w_style.misc.codeindent);
7723
7724
OUT_PRM("{%s}", 5, "{contents.TeX}",
7725
w_style.contents.tex);
7726
7727
OUT_PRM("{ %% ##6 ---\n {%s%s}", 1, "{{format.reserved}{format.RESERVED}}",
7728
pfrmt->reserved, pfrmt->RESERVED);
7729
7730
OUT_PRM(" {%s}", 2, "{format.short_id}",
7731
pfrmt->short_id);
7732
7733
OUT_PRM(" {%s%s}", 3, "{{format.id}{format.ID}}",
7734
pfrmt->id, pfrmt->ID);
7735
7736
OUT_PRM(" {%s%s}", 4, "{{format.outer_macro}{format.OUTER_MACRO}}",
7737
pfrmt->id_outer, pfrmt->ID_OUTER);
7738
7739
OUT_PRM(" {%s%s}", 5, "{{format.WEB_macro}{format.WEB_MACRO}}",
7740
pfrmt->id_inner, pfrmt->ID_INNER);
7741
7742
OUT_PRM(" {%s}", 6, "{format.intrinsic}",
7743
pfrmt->intrinsic);
7744
7745
OUT_PRM(" {%s%s}", 7, "{{format.keyword}{format.KEYWORD}}",
7746
pfrmt->keyword, pfrmt->KEYWORD);
7747
7748
OUT_PRM(" {%s}", 8, "{format.typewriter}",
7749
pfrmt->typewritr);
7750
7751
OUT_PRM(" {}", 9, "(For future use)");
7752
7753
OUT_PRM("}\n{%s}", 7, "{encap.prefix}",
7754
w_style.indx.encap_prefix);
7755
7756
OUT_PRM("{%s;%s}", 8, "{doc.preamble;doc.postamble}",
7757
w_style.misc.doc_preamble, w_style.misc.doc_postamble);
7758
7759
OUT_PRM("{%s}", 9, "{index.name}",
7760
prn_index ? w_style.indx.name : OC("NoIndex"));
7761
7762
fin_line();
7763
}
7764
7765
@
7766
@<Part 2@>=@[
7767
7768
SRTN
7769
out_prm FCN(VA_ALIST((fmt, n, cmt VA_ARGS)))
7770
VA_DCL(
7771
CONST outer_char *fmt C0("")@;
7772
int n C0("Arg number")@;
7773
CONST outer_char *cmt C2("")@;)@;
7774
{
7775
#define TEMP_LEN (MAX_FILE_NAME_LENGTH + 100)
7776
7777
int num_char;
7778
outer_char temp0[TEMP_LEN];
7779
outer_char HUGE *temp1 = GET_MEM("temp1", TEMP_LEN, outer_char);
7780
VA_LIST(arg_ptr)@;
7781
#if(NUM_VA_ARGS == 1)
7782
CONST outer_char *fmt;
7783
CONST outer_char *cmt;
7784
#endif
7785
7786
VA_START(arg_ptr, cmt);
7787
7788
#if(NUM_VA_ARGS == 1)
7789
fmt = va_arg(arg_ptr, outer_char *);
7790
cmt = va_arg(arg_ptr, outer_char *);
7791
#endif
7792
7793
#if ANSI_SPRINTF
7794
num_char =
7795
#endif
7796
7797
vsprintf((char *)temp0, (CONST char *)fmt, arg_ptr);
7798
7799
#if !ANSI_SPRINTF
7800
num_char = (int)STRLEN(temp0);
7801
#endif
7802
7803
if(num_char >= TEMP_LEN)
7804
OVERFLW("out_prm:temp0", "");
7805
7806
OUT_STR(xpn_name(&temp1, TEMP_LEN, temp0, wbflnm0));
7807
fin_line();
7808
7809
sprintf((char *)temp1, " %% #%i --- ", n);
7810
OUT_STR(temp1); OUT_STR(cmt);
7811
fin_line();
7812
7813
FREE_MEM(temp1, "temp1", TEMP_LEN, outer_char);
7814
7815
#undef TEMP_LEN
7816
}
7817
7818
@ The output file will contain the control sequence~\.{\\WY} between
7819
non-null sections of a module, e.g., between the \TeX\ and definition parts
7820
if both are nonempty. This puts a little white space between the parts when
7821
they are printed. However, we don't want \.{\\WY} to occur between two
7822
definitions within a single module. The variables |out_line| or |out_ptr|
7823
will change if a section is non-null, so the following macros
7824
`|save_position|' and `|emit_space_if_needed|' are able to handle the
7825
situation:
7826
7827
@d save_position save_line=out_line; save_place=out_ptr@;
7828
@d emit_space_if_needed if (save_line!=out_line || save_place!=out_ptr)
7829
{
7830
OUT_STR("\\WY");
7831
@.\\WY@>
7832
yskipped = YES;
7833
}
7834
7835
@<Global...@>=
7836
7837
EXTERN LINE_NUMBER save_line; // Former value of |out_line|.
7838
EXTERN ASCII HUGE *save_place; // Former value of |out_ptr|.
7839
EXTERN boolean in_module SET(NO); // Between \.{\\WN} and \.{\\fi}?
7840
EXTERN boolean yskipped SET(NO); // Did we skip between parts?
7841
7842
@
7843
@<Translate the current module@>=
7844
{
7845
the_part = TEX_;
7846
7847
/* Again, all modules start off in the global language. */
7848
params = global_params;
7849
frz_params();
7850
scanning_meta = NO; // For safety.
7851
7852
module_count++;
7853
7854
@<Output the code for the beginning of a new module@>;
7855
save_position;
7856
7857
the_type = NO_TYPE; // For use with \.{@@R} and \.{@@E}.
7858
7859
trns_TeX();
7860
trns_defn();
7861
trns_code();
7862
7863
the_type = NO_TYPE;
7864
7865
@<Show cross-references to this module@>;
7866
@<Output the code for the end of a module@>;
7867
}
7868
7869
@ Modules beginning with the \.{WEB} control sequence~`\.{@@\ }' start in the
7870
output with the \TeX\ control sequence~`\.{\\WM}', followed by the module
7871
number. Similarly, `\.{@@*}'~modules lead to the control sequence~`\.{\\WN}'.
7872
If this is a changed module, we put~\.{*} just before the module number.
7873
7874
@<Output the code for the beginning...@>=
7875
{
7876
@<Output the include file name if necessary@>;
7877
7878
if(!in_module && output_on)
7879
{
7880
OUT_STR(*(loc-1) == @'*' ? "\\WN" : "\\WM");
7881
@.\\WM@>
7882
@.\\WN@>
7883
in_module = YES;
7884
7885
out_mod(module_count,NO_ENCAP); OUT_STR(". ");
7886
}
7887
7888
progress(); // Progress report to terminal.
7889
}
7890
7891
@ These variables remember the last and current name of the include file.
7892
@<Glob...@>=
7893
7894
IN_COMMON outer_char last_include_file[], this_include_file[];
7895
7896
@
7897
@<Output the include file name...@>=
7898
7899
if(STRCMP(last_include_file,this_include_file) != 0)
7900
{
7901
STRCPY(last_include_file,this_include_file);
7902
OUT_STR("\\WIF{"); @~ out_fname(this_include_file); @~
7903
OUT_STR("}%");
7904
fin_line();
7905
}
7906
7907
@ In the \TeX\ part of a module, we simply copy the source text, except that
7908
index entries are not copied and \cee\ text within \Cb\ is translated.
7909
7910
@<Part 2@>=@[
7911
7912
SRTN
7913
trns_TeX(VOID)
7914
{
7915
the_part = TEX_;
7916
parsing_mode = OUTER;
7917
7918
do
7919
{
7920
next_control = copy_TeX();
7921
7922
switch(next_control)
7923
{
7924
@<Cases to set |language| and |break|@>@:@;
7925
7926
case toggle_output:
7927
out_skip();
7928
break;
7929
7930
case @'|': ini_stack; output_C(); break;
7931
7932
case math_break:
7933
out(@'|'); // Literal vertical bar.
7934
break;
7935
7936
case @'@@':
7937
out(@'@@'); // Literal '\.{@@}'.
7938
break;
7939
7940
case invisible_cmnt: loc = limit + 1; break;
7941
7942
case begin_meta:
7943
OUT_STR(w_style.misc.meta.TeX.begin);
7944
break;
7945
7946
case end_meta:
7947
OUT_STR(w_style.misc.meta.TeX.end);
7948
break;
7949
7950
case TeX_string:
7951
case xref_roman: case xref_wildcard: case xref_typewriter:
7952
case macro_module_name: case module_name:
7953
loc-=2; next_control=get_next(); /* skip to \.{@@>} */
7954
7955
if (next_control==TeX_string)
7956
ERR_PRINT(W,"@@t (TeX string) should be in code text only");
7957
@.TeX string should be...@>
7958
7959
break;
7960
7961
case keyword_name:
7962
loc-=2; next_control=get_next(); /* skip to \.{@@>} */
7963
@<Output an RCS-like keyword@>@;
7964
break;
7965
7966
case thin_space:
7967
case line_break: case ln_break_outdent:
7968
case big_line_break: case no_line_break: case join:
7969
case pseudo_semi: case pseudo_expr: case pseudo_colon:
7970
case Compiler_Directive:
7971
case no_index:
7972
case begin_bp: case insert_bp:
7973
CANT_DO(TeX);
7974
@.You can't do that...@>
7975
break;
7976
7977
case protect_code:
7978
if(*loc != @'|')
7979
ERR_PRINT(W, "@@p should be immediately followed by '|'");
7980
7981
output_protect = YES;
7982
break;
7983
7984
case USED_BY_NEITHER:
7985
err_print(W, "Invalid `@@%c' ignored", XCHR(*(loc-1)));
7986
break;
7987
}
7988
}
7989
while (next_control<formatt);
7990
7991
output_protect = NO;
7992
}
7993
7994
@ We need a flag to suppress phase~2 declarations of stuff recognized
7995
during macro definitions. Some other flags are useful too.
7996
@<Glob...@>=
7997
7998
EXTERN boolean ok_to_define SET(YES);
7999
EXTERN boolean q_protected SET(NO); // For protecting with quotes.
8000
EXTERN boolean suppress_defn SET(NO); // For masking out formats, etc.
8001
EXTERN boolean output_protect SET(NO); // For writing \.{\\protect}.
8002
8003
@ When we get to the following code we have |next_control>=formatt|, and
8004
the token memory is in its initial empty state.
8005
8006
@d SUPPRESS(name) if(!defn_mask.name) suppress_defn = YES@;
8007
8008
@<Part 2@>=@[
8009
8010
SRTN
8011
trns_defn(VOID)
8012
{
8013
boolean overload_ops0 = overload_ops;
8014
8015
the_part = DEFINITION;
8016
parsing_mode = OUTER;
8017
8018
if (next_control<begin_code)
8019
{ /* definition part non-empty */
8020
emit_space_if_needed; save_position;
8021
@<Store the output switch@>@;
8022
@% @<Append \.{\\WP}@>@;
8023
}
8024
8025
while (next_control<begin_code)
8026
@<Translate a |definition|, |formatt|, etc.@>@;
8027
}
8028
8029
@ Now deal with a |formatt|, |definition|, |undefinition|, |WEB_definition|,
8030
|limbo_text|, |op_def|, |macro_def|, or \.{@@\#...} command.
8031
8032
@<Translate a |definition|...@>=
8033
{
8034
eight_bits last_control = next_control;
8035
boolean nuweb_mode0;
8036
8037
ini_stack;
8038
8039
switch(next_control)
8040
{
8041
case begin_comment:
8042
case invisible_cmnt:
8043
break;
8044
8045
default:
8046
@<Store the output switch@>@;
8047
break;
8048
}
8049
8050
nuweb_mode0 = nuweb_mode;
8051
nuweb_mode = NO;
8052
8053
switch(next_control)
8054
{
8055
case formatt:
8056
@<Start a format definition@>@;
8057
break;
8058
8059
case limbo_text:
8060
@<Start a limbo text definition@>@;
8061
break;
8062
8063
case op_def:
8064
@<Start an overloaded operator definition@>@;
8065
break;
8066
8067
case macro_def:
8068
@<Start an overloaded identifier definition@>@;
8069
break;
8070
8071
case begin_comment:
8072
doing_cdir = NO;
8073
break;
8074
8075
case invisible_cmnt:
8076
loc = limit + 1; // Skip the line.
8077
/* Skip any other extraneous material that doesn't belong in the definition
8078
section. */
8079
while((next_control=get_next()) < formatt
8080
&& next_control!=begin_comment);
8081
continue;
8082
8083
default:
8084
@<Start a macro definition@>@;
8085
break;
8086
}
8087
8088
ok_to_define = NO;
8089
nuweb_mode = nuweb_mode0;
8090
8091
outr_parse(); // Scan the definition or whatever.
8092
8093
if(auto_app_semi && last_control==WEB_definition)
8094
{app_scrap(semi,maybe_math);}
8095
8096
overload_ops = overload_ops0;
8097
fin_C(); // Finish up the definition or whatever.
8098
ok_to_define = YES;
8099
}
8100
8101
@ The switch into code mode is appended rather than just written directly
8102
out in order to deal with the |output_on| status properly.
8103
@<Append \.{\\WP}@>=
8104
{
8105
APP_STR("\\WP");
8106
@.\\WP@>
8107
}
8108
8109
@ The |fin_C| procedure outputs the translation of the current scraps,
8110
preceded by the control sequence~`\.{\\WP}' and followed by the control
8111
sequence~`\.{\\par}'. It also restores the token and scrap memories to
8112
their initial empty state.
8113
8114
A |force| token is appended to the current scraps before translation takes
8115
place, so that the translation will normally end with~\.{\\6} or~\.{\\7}
8116
(the \TeX\ macros for |force| and |big_force|). This~\.{\\6} or~\.{\\7} is
8117
replaced by the concluding \.{\\par} or by \.{\\WY\\par}.
8118
8119
@<Part 2@>=@[
8120
8121
SRTN
8122
fin_C(VOID) // Finishes a definition or a \cee\ part.
8123
{
8124
text_pointer p; // Translation of the scraps.
8125
boolean current_output_state = output_on;
8126
8127
if(!suppress_defn)
8128
{
8129
@% output_on = YES;
8130
column_mode = NO;
8131
8132
app_tok(force); // Last thing in the translation.
8133
app_scrap(ignore_scrap,no_math);
8134
// The last stuff doesn't count for syntax.
8135
8136
/* We've accumulated all the stuff for one part. Translate it, then print
8137
it. */
8138
p = translate(OUTER);
8139
8140
APP_FLAG(tok,p,tok_start);
8141
make_output(); // Output the list.
8142
8143
if (out_ptr>out_buf+1)
8144
@<Tidy up the end of the part@>@;
8145
8146
OUT_STR(the_part == CODE ? "\\Wendc" : "\\Wendd");
8147
8148
fin_line();
8149
8150
/* Accumulate statistics. */
8151
if (text_ptr>mx_text_ptr)
8152
mx_text_ptr=text_ptr;
8153
if (tok_ptr>mx_tok_ptr)
8154
mx_tok_ptr=tok_ptr;
8155
if (scrp_ptr>mx_scr_ptr)
8156
mx_scr_ptr=scrp_ptr;
8157
}
8158
else
8159
suppress_defn = NO;
8160
8161
/* Forget the tokens and the scraps. */
8162
tok_ptr=tok_mem+1; text_ptr=tok_start+1; scrp_ptr=scrp_info;
8163
8164
#if(0)
8165
if(strt_off) output_on = strt_off = ending_off = NO;
8166
if(ending_off)
8167
{
8168
strt_off = ending_off = NO;
8169
output_on = YES;
8170
}
8171
#endif
8172
8173
output_on = current_output_state;
8174
}
8175
8176
@
8177
@<Tidy up...@>=
8178
{
8179
if (*(out_ptr-1)==@'\\')
8180
{
8181
@.\\6@>
8182
@.\\7@>
8183
@.\\WY@>
8184
if (*out_ptr==@'6')
8185
out_ptr -= 2; // Throw away the \.{\\6}.
8186
else if (*out_ptr==@'7')
8187
{
8188
out_ptr -= 2; // Throw away the \.{\\7}\dots
8189
OUT_STR("\\WY");
8190
// and replace it with \.{\\WY}.
8191
}
8192
}
8193
}
8194
8195
@ Here is a nucleus that writes out the appropriate macro for the
8196
preprocessor command.
8197
8198
@d APP_TEMP(letter,arg) app_temp(OC(letter),OC(arg))
8199
8200
@<Part 2@>=@[
8201
8202
SRTN
8203
app_temp FCN((letter,arg))
8204
CONST outer_char letter[] C0("")@;
8205
CONST outer_char arg[] C1("")@;
8206
{
8207
char temp[50];
8208
8209
sprintf(temp,"\\W%s{%s}", (char *)letter, (char *)arg);
8210
APP_STR(temp);
8211
}
8212
8213
@ This nucleus appends stuff for the preprocessor commands, macro
8214
definitions, formats, etc.
8215
8216
@<Part 2@>=@[
8217
8218
SRTN
8219
app_proc FCN((next_control))
8220
eight_bits next_control C1("")@;
8221
{
8222
if(the_part == DEFINITION)
8223
{
8224
@<Append \.{\\WP}@>@;
8225
8226
if(yskipped)
8227
{
8228
@<Append the scrap header for the definition part@>@;
8229
yskipped = NO;
8230
}
8231
}
8232
8233
switch(next_control)
8234
{
8235
case WEB_definition: // ``\.{@@m}''
8236
APP_STR(upper_case_code ? "\\WMD" : "\\WMd"); @~ break;
8237
8238
case undefinition: // ``\.{@@u}''
8239
APP_LANG("Ud"); @~ break;
8240
8241
case definition: // ``\.{@@d}''
8242
APP_LANG(upper_case_code ? "D" : "d"); @~ break;
8243
8244
case formatt: // ``\.{@@f}''
8245
APP_LANG(upper_case_code ? "F" : "f"); @~ break;
8246
8247
case limbo_text: // ``\.{@@l}''
8248
APP_LANG("l"); @~ break;
8249
8250
case op_def: // ``\.{@@v}''
8251
APP_LANG("v"); @~ break;
8252
8253
case macro_def: // `\.{@@w}'.
8254
APP_LANG(upper_case_code ? "WW" : "w"); @~ break;
8255
8256
case m_ifdef:
8257
APP_TEMP("E","ifdef"); @~ break;
8258
8259
case m_ifndef:
8260
APP_TEMP("E","ifndef"); @~ break;
8261
8262
case m_line:
8263
APP_TEMP("E","line"); @~ break;
8264
8265
case m_undef:
8266
APP_TEMP("E","undef"); @~ break;
8267
8268
case m_if:
8269
APP_TEMP("E","if"); @~ break;
8270
8271
case m_elif:
8272
APP_TEMP("E","elif"); @~ break;
8273
8274
case m_else:
8275
APP_TEMP("E","else");
8276
app_scrap(ignore_scrap,no_math);
8277
break;
8278
8279
case m_for:
8280
APP_TEMP("E","for"); @~ break;
8281
8282
case m_endfor:
8283
APP_TEMP("E","endfor");
8284
app_scrap(ignore_scrap,no_math);
8285
break;
8286
8287
case m_endif:
8288
APP_TEMP("E","endif");
8289
app_scrap(ignore_scrap,no_math);
8290
break;
8291
}
8292
@.\\WD@>
8293
@.\\WMD@>
8294
@.\\WE@>
8295
}
8296
8297
@ The following helps with error processing.
8298
8299
@d IMPROPER(m_type, msg) improper(OC(m_type), OC(msg))
8300
8301
@<Part 2@>=@[
8302
SRTN
8303
improper FCN((m_type, msg))
8304
outer_char *m_type C0("")@;
8305
outer_char *msg C1("")@;
8306
{
8307
err_print(W, "Improper %s definition: expected %s", m_type, msg);
8308
}
8309
8310
@ This function helps keep the code short.
8311
8312
@d APP_LANG(suffix) app_lang(OC(suffix))
8313
8314
@<Part 2@>=@[
8315
8316
SRTN
8317
app_lang FCN((suffix))
8318
CONST outer_char *suffix C1("")@;
8319
{
8320
APP_TEMP(suffix,(CONST outer_char *)(LANGUAGE_SYMBOL(language)));
8321
}
8322
8323
@ Macro definitions have the syntax `\.{@@m\ A\ b}' or `\.{@@m\ A(x)\ y}'.
8324
Keeping in line with the conventions of the C and~\.{WEB} preprocessors
8325
(and otherwise contrary to the rules of \.{WEB}) we distinguish here
8326
between the case that `\.('~immediately follows an identifier and the case
8327
that the two are separated by a space. In the latter case, and if the
8328
identifier is not followed by~`\.(' at all, the replacement text starts
8329
immediately after the identifier. In the former case, it starts after we
8330
scan the matching~`\.)'.
8331
8332
@<Start a macro...@>=
8333
{
8334
LANGUAGE saved_language = language;
8335
8336
if(next_control == definition)
8337
SUPPRESS(outer_macros);
8338
8339
if(next_control == WEB_definition)
8340
SUPPRESS(macros);
8341
8342
app_proc(next_control); // Macro command for \.{@@m}.
8343
8344
if(language==TEX)
8345
language = C;
8346
8347
if( ((C_LIKE(language) || language==LITERAL) &&
8348
next_control<=WEB_definition) ||
8349
next_control==WEB_definition ||
8350
next_control==m_ifdef ||
8351
next_control==m_ifndef || next_control==m_undef)
8352
{
8353
next_control = get_next();
8354
8355
if( !(next_control == identifier || next_control == AUTO_INSERT
8356
|| next_control == MAKE_RECURSIVE
8357
|| next_control == PROTECTED) )
8358
{
8359
IMPROPER("macro", "'[', '*', '!', or identifier");
8360
@.Improper macro definition@>
8361
}
8362
else
8363
{
8364
if(next_control == MAKE_RECURSIVE || next_control == PROTECTED)
8365
{
8366
app(next_control); // Second argument to \.{\\WMd}.
8367
next_control = get_next();
8368
}
8369
else
8370
{
8371
APP_STR("{}"); // Empty argument to \.{\\WMd}.
8372
8373
if(next_control == @'[')
8374
@<Format auto insertion@>@;
8375
}
8376
8377
if(next_control != identifier)
8378
IMPROPER("macro", "identifier");
8379
else
8380
{
8381
APP_ID;
8382
8383
/* Note use of |*loc| here rather than |next_control| to check for space. */
8384
if (*loc==@'(')
8385
@<Append argument of \WEB\ macro@>@;
8386
else
8387
{ /* Id not followed by parenthesis. */
8388
next_control = get_next();
8389
}
8390
8391
app(break_space);
8392
app_scrap(ignore_scrap,no_math); /* scrap won't take part in
8393
the parsing */
8394
}
8395
}
8396
}
8397
else
8398
next_control = get_next();
8399
8400
if(saved_language == TEX)
8401
language = saved_language;
8402
}
8403
8404
@
8405
@<Format auto insert...@>=
8406
{
8407
APP_STR("\\Wauto");
8408
get_string(@'[','\0');
8409
*id_loc = '\0';
8410
app_ASCII_str(id_first);
8411
next_control = get_next();
8412
}
8413
8414
@ The parenthesized macro argument will be put into math mode, because we
8415
use \.{\\;}.
8416
8417
@<Append argument of \WEB\ macro@>=
8418
{
8419
app(@'$'); // Begin math mode for parenthesized argument.
8420
8421
#ifdef DBGM // For debugging macros; define from gcc command line.
8422
app(@'5');
8423
#endif
8424
8425
reswitch:
8426
next_control = get_next();
8427
8428
the_switch:
8429
switch(next_control)
8430
{
8431
case @'(':
8432
app(next_control);
8433
next_control = get_next();
8434
8435
if(next_control == @')')
8436
{
8437
APP_STR("\\;"); // Extra space for beauty.
8438
goto done_arg;
8439
}
8440
else
8441
goto the_switch;
8442
8443
case @',':
8444
app(next_control); goto reswitch;
8445
8446
case identifier:
8447
APP_ID;
8448
goto reswitch;
8449
8450
case ellipsis:
8451
APP_STR("\\dots");
8452
8453
if( (next_control=get_next()) != @')')
8454
{
8455
ERR_PRINT(M,"Improper macro \
8456
definition: expected ')' after ellipsis");
8457
break;
8458
}
8459
8460
case @')':
8461
done_arg:
8462
app(next_control); // |app(@'~');|
8463
next_control=get_next(); break;
8464
8465
default:
8466
ERR_PRINT(M,"Improper macro definition: \
8467
unrecognized token in argument list");
8468
break;
8469
}
8470
8471
#ifdef DBGM
8472
app(@'6');
8473
#endif
8474
8475
app(@'$'); // End math mode for parenthesized argument.
8476
}
8477
8478
@ Here we append a format command, which has the two possible forms
8479
``\.{@@f\ a\ b}'' or ``\.{@@f\ `\{\ 11}''.
8480
8481
@<Start a format...@>=
8482
{
8483
LANGUAGE saved_language = language;
8484
scrap_pointer scrp_ptr0;
8485
8486
if(upper_case_code)
8487
{
8488
SUPPRESS(Formats);
8489
}
8490
else
8491
{
8492
SUPPRESS(formats);
8493
}
8494
8495
/* Mark formats that are not in the global language. */
8496
app_proc(next_control); // |formatt|.
8497
scrp_ptr0 = scrp_ptr; // Save to help check valid format.
8498
app_scrap(expr,maybe_math); /* this will produce `\&{format}'. The
8499
macro inserts a blank after \&{format}. */
8500
@.\\WF@>
8501
8502
if(language==TEX)
8503
language = C; // This kludge ought to be removed!
8504
8505
next_control=get_next(); /* First field: identifier, module name, or~'\.`'. */
8506
8507
if (next_control==identifier || next_control==module_name)
8508
@<Format an identifier or module name@>@;
8509
else if(next_control==@'`')
8510
@<Format a category code@>@;
8511
8512
if (scrp_ptr!=scrp_ptr0+3)
8513
ERR_PRINT(W,"Improper format definition");
8514
@.Improper format definition@>
8515
8516
/* The following doesn't work right if the format command is immediately
8517
followed by a language-changing command. */
8518
if(saved_language == TEX)
8519
language = saved_language;
8520
}
8521
8522
@
8523
@<Format an identifier or mod...@>=
8524
{
8525
if(next_control==identifier)
8526
APP_ID;
8527
else
8528
APP_FLAG(mod,cur_module,name_dir);
8529
8530
APP_STR("\\ ");
8531
8532
next_control=get_next(); /* Second field: identifier. */
8533
8534
if (next_control==identifier)
8535
{
8536
APP_ID;
8537
@<Finish appending format definition@>@;
8538
}
8539
}
8540
8541
@
8542
@<Finish appending format...@>=
8543
{
8544
app_scrap(expr,maybe_math);
8545
app_scrap(semi,maybe_math); // Pseudo-semi.
8546
8547
sharp_include_line = NO;
8548
8549
next_control=get_next();
8550
}
8551
8552
@ Here we typeset a format command that changes a category code, such as
8553
``\.{@@f\ `a\ 10}''.
8554
8555
@<Format a cat...@>=
8556
{
8557
@<Append commands for beginning of string@>@;
8558
app(@'`');
8559
if( (next_control = get_TeX()) == constant)
8560
APP_STR((outer_char *)id_first);
8561
app(@'}');
8562
8563
APP_STR("\\ ");
8564
8565
next_control = get_next(); // Integer category code.
8566
8567
if(next_control == constant)
8568
{
8569
APP_STR("\\WO{");
8570
8571
while(id_first < id_loc)
8572
app_tok(*id_first++);
8573
8574
app(@'}');
8575
8576
@<Finish appending format...@>@;
8577
}
8578
}
8579
8580
@ Here we append a limbo text definition of the form ``\.{@@l\ "text"}''.
8581
8582
@<Start a limbo...@>=
8583
{
8584
SUPPRESS(limbo);
8585
8586
app_proc(next_control);
8587
app_scrap(expr,maybe_math);
8588
8589
/* First field: String. */
8590
if((next_control = get_next()) != stringg)
8591
ERR_PRINT(W,"A string must follow @@l");
8592
}
8593
8594
@ Here we append an operator-overload command, of the form ``\.{@@v\ .IN.\
8595
"\\\\in"\ +}''.
8596
8597
@<Start an overloaded op...@>=
8598
{
8599
SUPPRESS(v);
8600
8601
overload_ops = NO;
8602
8603
app_proc(next_control);
8604
app_scrap(expr,maybe_math);
8605
8606
/* First field: The operator to be overloaded. */
8607
if(valid_op(next_control = get_next()))
8608
{
8609
@<Append an operator name@>@;
8610
8611
app(@' '); @~ app_scrap(expr,no_math);
8612
8613
/* Second field: Replacement text. */
8614
if((next_control = get_next()) == stringg)
8615
{
8616
@<Append commands for beginning of string@>@;
8617
@<Append the basic str...@>@;
8618
app_scrap(expr,yes_math);
8619
8620
/* Third field: Cat of this operator. */
8621
if(valid_op(next_control=get_next()))
8622
{
8623
app(@' '); @~ app_scrap(expr,no_math);
8624
8625
@<Append an operator...@>@;
8626
8627
next_control = get_next();
8628
}
8629
}
8630
}
8631
}
8632
8633
@ The last field of an \.{@@v}~command can be either an operator like~`\.+'
8634
or an identifier like~`\.{.IN.}'.
8635
8636
@<Append an operator...@>=
8637
{
8638
switch(next_control)
8639
{
8640
case identifier:
8641
ERR_PRINT(W,"For future compatibility, please use syntax .NAME. for \
8642
overloading dot operators");
8643
8644
APP_ID;
8645
break;
8646
8647
case dot_const:
8648
@<Append commands for beginning of string@>@;
8649
app(wt_style.dot_delimiter.begin);
8650
app_ASCII_str(dot_op.name + 1);
8651
app(wt_style.dot_delimiter.end);
8652
app(@'}');
8653
break;
8654
8655
default:
8656
app(@'{');
8657
app_overload();
8658
app(@'}');
8659
break;
8660
}
8661
8662
app_scrap(expr,yes_math);
8663
}
8664
8665
@
8666
@<Start an overloaded id...@>=
8667
{
8668
SUPPRESS(w);
8669
8670
app_proc(next_control);
8671
app_scrap(expr,maybe_math);
8672
8673
/* First field: The identifier to be overloaded. */
8674
if((next_control = get_next()) == identifier)
8675
{
8676
ASCII HUGE *id_first0, HUGE *id_loc0;
8677
8678
/* Remember first identifier. */
8679
id_first0 = id_first;
8680
id_loc0 = id_loc;
8681
8682
APP_ID;
8683
8684
app(@' '); @~ app_scrap(expr,no_math);
8685
8686
/* Second field: Replacement text. */
8687
switch(next_control = get_next())
8688
{
8689
case @'\\':
8690
if((next_control=get_next()) != identifier) break;
8691
goto quick_code1;
8692
8693
case QUICK_FORMAT:
8694
id_first = id_first0;
8695
id_loc = id_loc0;
8696
8697
quick_code1:
8698
@<Append commands for beginning of string@>@;
8699
APP_STR("\\\\");
8700
*id_loc = '\0'; // Make name into string.
8701
app_ASCII_str(id_first);
8702
app(@'}');
8703
app_scrap(expr,yes_math);
8704
next_control = get_next();
8705
break;
8706
8707
case stringg:
8708
@<Append commands for beginning of string@>@;
8709
@<Append the basic str...@>@;
8710
app_scrap(expr,yes_math);
8711
next_control = get_next();
8712
break;
8713
}
8714
}
8715
}
8716
8717
@ Finally, when the \TeX\ and definition parts have been treated, we have
8718
|next_control>=begin_code|. We will make the global variable |this_module|
8719
point to the current module name, if it has a name; otherwise, it will be
8720
equal to |name_dir|.
8721
8722
@<Global...@>=
8723
8724
EXTERN name_pointer this_module; // The current module name, or zero.
8725
EXTERN name_pointer the_module; /* The module we're working on; equal to
8726
|cur_module| at the beginning of the entire module. */
8727
8728
@
8729
@<Part 2@>=@[
8730
8731
SRTN
8732
trns_code(VOID)
8733
{
8734
the_part = CODE;
8735
this_module = name_dir;
8736
parsing_mode = OUTER;
8737
8738
if (next_control<=module_name)
8739
{
8740
@% emit_space_if_needed;
8741
OUT_STR("\\WY");
8742
ini_stack;
8743
@<Store the output switch@>@;
8744
@<Append \.{\\WP}@>@;
8745
8746
if (next_control==begin_code)
8747
{ /* We've hit an \.{@@a}. */
8748
boolean nuweb_mode0 = nuweb_mode;
8749
8750
unnamed_section = YES;
8751
params = global_params;// Unnamed module is in global language.
8752
nuweb_mode = nuweb_mode0;
8753
frz_params();
8754
the_module = NULL;
8755
@<Maybe start column mode.@>@;
8756
8757
@<Append the scrap header for code@>@; // !!!!!
8758
}
8759
else
8760
{ /* Named module. */
8761
unnamed_section = NO;
8762
8763
if(cur_module != NULL)
8764
{
8765
params = cur_module->mod_info->params;
8766
// Restore state for this module.
8767
frz_params();
8768
this_module = cur_module;
8769
}
8770
the_module = cur_module;
8771
@<Check that |=| or |==| follows this module name, and
8772
emit the scraps to start the module definition@>;
8773
}
8774
8775
/* Now scan the whole module. */
8776
while (next_control<=module_name)
8777
{
8778
outr_parse();
8779
@<Emit the scrap for a module name if present@>;
8780
}
8781
8782
@<Reset the language before translation@>@;
8783
fin_C();
8784
unnamed_section = NO;
8785
}
8786
}
8787
8788
@
8789
@<Append the scrap header for the definition part@>=
8790
{
8791
app_hdr("defs");
8792
}
8793
8794
@
8795
@<Append the scrap header for code@>=
8796
{
8797
app_hdr("code");
8798
}
8799
8800
@ The scrap header needs the file name as argument to \.{\\Wunnamed}; it
8801
must be escaped. We use the |mod_text| buffer as a scratch area.
8802
8803
@<Part 2@>=@[
8804
8805
SRTN
8806
app_hdr FCN((section_part))
8807
CONST char *section_part C1("Either \"code\" or \"defs\"")@;
8808
{
8809
outer_char temp[1000], *temp_end = temp + 1000, *t_first, *t_loc;
8810
8811
t_first = temp;
8812
STRCPY(t_first, params.OUT_FILE_NAME);
8813
to_ASCII(t_first);
8814
t_first = esc_buf((ASCII HUGE *)t_first+STRLEN(t_first)+1,
8815
(ASCII HUGE *)temp_end, (CONST ASCII HUGE *)t_first, YES);
8816
to_outer((ASCII HUGE *)t_first);
8817
t_loc = t_first + STRLEN(t_first) + 1;
8818
sprintf((char *)t_loc, " \\Wunnamed{%s}{%s}%%\n",
8819
section_part, (char *)t_first);
8820
APP_STR(t_loc);
8821
app_scrap(ignore_scrap,no_math);
8822
}
8823
8824
@
8825
@<Check that |=|...@>=
8826
{
8827
LANGUAGE saved_language = language;
8828
8829
if(language==TEX)
8830
language = C;
8831
8832
/* Allow optional `\.{+=}'. */
8833
do
8834
next_control=get_next();
8835
while (next_control==@'+');
8836
8837
language = saved_language;
8838
8839
switch(next_control)
8840
{
8841
case compound_assignment:
8842
if(assignment_token != plus_eq)
8843
{
8844
ERR_PRINT(W,"Invalid compound assignment after section \
8845
name; please use one of `=', `==', or `+='");
8846
@.Invalid compound assignment...@>
8847
break;
8848
}
8849
8850
/* The |plus_eq| falls through to the next case. */
8851
8852
case @'=':
8853
case eq_eq:
8854
@<Maybe start column mode.@>@; // Positioned after `\.{@@<\dots@@>=}'.
8855
break;
8856
8857
default:
8858
ERR_PRINT(W,"You need an = sign after the section name");
8859
@.You need an = sign...@>
8860
break;
8861
}
8862
8863
#if(0)
8864
if (out_ptr>out_buf+2 && STRNCMP(out_ptr-2,"\\WY",3)==0)
8865
#endif
8866
{
8867
app(backup); /* The module name will be flush left */
8868
app(backup);
8869
}
8870
@.\\WY@>
8871
8872
APP_FLAG(mod,this_module,name_dir);
8873
cur_xref = (xref_pointer)this_module->xref;
8874
APP_STR("${}");
8875
8876
if(cur_xref->num != module_count+def_flag)
8877
{
8878
APP_STR("\\WPQ"); // Module name is multiply defined,
8879
@.\\PQ@>
8880
this_module=name_dir; // so we won't give cross-reference info here.
8881
}
8882
else
8883
APP_STR("\\WSQ"); // Output the equivalence sign~`$\equiv$'.
8884
@.\\WSQ@>
8885
8886
APP_STR("{}$");
8887
app_misc(w_style.misc.named_preamble); // Optional stuff from style file.
8888
app(force); // This forces a line break unless `\.{@@~}' follows.
8889
app_scrap(ignore_scrap,no_math);
8890
}
8891
8892
@ Because the language may have changed in the middle of a module, we must
8893
reset it before we perform the translation of the scraps that have just
8894
been collected.
8895
8896
@<Reset the language...@>=
8897
{
8898
boolean nuweb_mode0 = nuweb_mode;
8899
8900
params = (the_module == NULL ? global_params : the_module->mod_info->params);
8901
nuweb_mode = nuweb_mode0;
8902
frz_params();
8903
}
8904
8905
@ When we append miscellaneous stuff from the style file, we must be a bit
8906
clever. If the stuff contains something like~`\.{\\7}' and we just
8907
appended it raw, it wouldn't be subject to the later output mechanism that
8908
takes the maximum of adjacent |force| and |big_force| tokens. Thus, we
8909
will translate the macros~`\.{\\1}' to~`\.{\\8}' into their internal tokens
8910
before appending them. Other text in the miscellaneous string is just left
8911
alone.
8912
8913
@<Part 2@>=@[
8914
8915
SRTN
8916
app_misc FCN((s))
8917
outer_char *s C1("")@;
8918
{
8919
outer_char *s0;
8920
8921
for(s0=s; *s; )
8922
if(*s++ == '\\')
8923
{
8924
if(isdigit(*s) && *s != '0' && *s != '8' && *s != '9')
8925
{
8926
*(s-1) = '\0'; // Terminate for |app_str|.
8927
APP_STR(s0);
8928
8929
switch(*s)
8930
{
8931
case '1': app(indent); @~ break;
8932
case '2': app(outdent); @~ break;
8933
case '3': app(opt); @~ break;
8934
case '4': app(backup); @~ break;
8935
case '5': app(break_space); @~ break;
8936
case '6': app(force); @~ break;
8937
case '7': app(big_force); @~ break;
8938
}
8939
*(s-1) = '\\'; // Put it back for the next time.
8940
s0 = ++s; // Skip the digit.
8941
}
8942
}
8943
8944
APP_STR(s0);
8945
}
8946
8947
@
8948
@<Maybe start column mode.@>=
8949
{
8950
if(!nuweb_mode && ((FORTRAN_LIKE(language) && !free_form_input)
8951
|| (language==TEX)) )
8952
{
8953
@<Set up column mode@>@;
8954
next_control = ignore;
8955
}
8956
else
8957
{
8958
@<Kill rest of line; no |auto_semi|@>@;
8959
next_control = (nuweb_mode ? begin_meta : get_next()); // !!!!!
8960
}
8961
}
8962
8963
@
8964
@<Kill rest of line; no...@>=
8965
8966
if(Fortran88 && (auto_semi && !free_Fortran))
8967
{
8968
loc = limit + 1;
8969
chk_end = NO;
8970
}
8971
8972
8973
@ When shifting into \FORTRAN\ mode, we skip any stuff on the same line as
8974
the~\.{@@n}, because surely that text isn't in the appropriate columns.
8975
@<Set up col...@>=
8976
{
8977
loc = limit + 1; // Skip rest of line.
8978
chk_end = NO;
8979
column_mode = YES;
8980
}
8981
8982
@
8983
@<Emit the scrap...@>=
8984
8985
if (next_control<module_name)
8986
{
8987
switch(next_control)
8988
{
8989
case m_if: case m_ifdef: case m_ifndef:
8990
case m_undef: case m_else:
8991
case m_elif: case m_endif:
8992
case m_for: case m_endfor:
8993
case m_line:
8994
case WEB_definition:
8995
pre_scrap(next_control);
8996
break;
8997
8998
default:
8999
CANT_DO(code);
9000
@.You can't do that...@>
9001
break;
9002
}
9003
next_control=get_next();
9004
}
9005
else if (next_control==module_name)
9006
{
9007
@<Append a module name@>@;
9008
next_control = (nuweb_mode ? begin_meta : get_next()); // !!!!!
9009
}
9010
9011
@ Tack on the representation of a module name.
9012
@<Append a mod...@>=
9013
{
9014
if(cur_module)
9015
{
9016
APP_FLAG(mod, cur_module, name_dir);
9017
}
9018
9019
app_scrap(cur_module != NULL ? cur_module->mod_ilk : expr,maybe_math);
9020
}
9021
9022
@ Build a preprocessor scrap.
9023
@<Part 2@>=@[
9024
9025
SRTN
9026
pre_scrap FCN((last_control))
9027
eight_bits last_control C1("")@;
9028
{
9029
scrap_pointer save_base;
9030
text_pointer p,q;
9031
LANGUAGE saved_language = language;
9032
9033
app(force);
9034
app_proc(last_control);
9035
9036
switch(last_control)
9037
{
9038
case WEB_definition:
9039
@<Start a deferred macro definition@>;
9040
break;
9041
}
9042
9043
p = text_ptr; freeze_text;
9044
9045
save_base = scrp_base;
9046
scrp_base = scrp_ptr + 1;
9047
9048
*limit = @'@@'; @~ *(limit+1) = @'m'; /* Stop the |outr_parse|. */
9049
next_control = ignore;
9050
9051
if(language==TEX) language = C;
9052
outr_parse();
9053
language = saved_language;
9054
9055
if(last_control==WEB_definition) {app_scrap(semi,maybe_math);}
9056
9057
q = translate(OUTER);
9058
scrp_ptr = scrp_base - 1;
9059
scrp_base = save_base;
9060
9061
APP_FLAG(tok,p,tok_start);
9062
APP_FLAG(tok,q,tok_start);
9063
APP_STR("\\WPs"); app(force); // Terminate preprocessor command.
9064
app_scrap(ignore_scrap,no_math);
9065
}
9066
9067
@
9068
@<Start a deferred macro...@>=
9069
{
9070
if( (next_control=get_next())!=identifier)
9071
ERR_PRINT(M,"Improper deferred macro definition: \
9072
expected identifier");
9073
@.Improper macro definition@>
9074
else
9075
{
9076
app(@'$'); APP_ID;
9077
9078
if (*loc==@'(')
9079
{
9080
reswitch: switch (next_control=get_next())
9081
{
9082
case @'(': case @',':
9083
app(next_control); goto reswitch;
9084
case identifier:
9085
APP_ID;
9086
goto reswitch;
9087
case ellipsis:
9088
APP_STR("\\dots");
9089
if( (next_control=get_next()) != @')')
9090
{
9091
ERR_PRINT(M,"Improper deferred macro \
9092
definition: expected ')' after ellipsis");
9093
break;
9094
}
9095
case @')': app(next_control); app(@' ');
9096
break;
9097
default: ERR_PRINT(M,"Improper deferred macro definition: \
9098
unrecognized token within argument list"); break;
9099
}
9100
}
9101
9102
app(@'$'); app(break_space);
9103
app_scrap(ignore_scrap,no_math); /* scrap won't take part
9104
in the parsing */
9105
}
9106
}
9107
9108
@ Cross references relating to a named module are given after the module ends.
9109
9110
@<Show cross...@>=
9111
9112
if (this_module>name_dir && output_on)
9113
{
9114
@<Rearrange the list pointed to by |cur_xref|@>;
9115
footnote(def_flag); footnote(0);
9116
}
9117
9118
@ To rearrange the order of the linked list of cross-references, we need
9119
four more variables that point to cross-reference entries. We'll end up
9120
with a list pointed to by |cur_xref|.
9121
9122
@<Global...@>=
9123
9124
EXTERN xref_pointer next_xref, this_xref, first_xref, mid_xref;
9125
/* Pointer variables for rearranging a list */
9126
9127
@ We want to rearrange the cross-reference list so that all the entries
9128
with |def_flag| come first, in ascending order; then come all the other
9129
entries, in ascending order. There may be no entries in either one or both
9130
of these categories.
9131
9132
@<Rearrange the list...@>=
9133
9134
first_xref = (xref_pointer)this_module->xref;
9135
this_xref=first_xref->xlink; /* Bypass current module number */
9136
9137
if (this_xref->num>def_flag)
9138
{
9139
mid_xref=this_xref; cur_xref=0; /* This value doesn't matter */
9140
9141
do
9142
{
9143
next_xref=this_xref->xlink; this_xref->xlink=cur_xref;
9144
cur_xref=this_xref; this_xref=next_xref;
9145
}
9146
while (this_xref->num>def_flag);
9147
9148
first_xref->xlink=cur_xref;
9149
}
9150
else mid_xref=xmem; /* First list null */
9151
9152
cur_xref=xmem;
9153
9154
while (this_xref!=xmem)
9155
{
9156
next_xref=this_xref->xlink; this_xref->xlink=cur_xref;
9157
cur_xref=this_xref; this_xref=next_xref;
9158
}
9159
9160
if (mid_xref>xmem) mid_xref->xlink=cur_xref;
9161
else first_xref->xlink=cur_xref;
9162
9163
cur_xref=first_xref->xlink;
9164
9165
@ The |footnote| procedure gives cross-reference information about multiply
9166
defined module names (if the |flag| parameter is |def_flag|), or about the
9167
uses of a module name (if the |flag| parameter is zero). It assumes that
9168
|cur_xref| points to the first cross-reference entry of interest, and it
9169
leaves |cur_xref| pointing to the first element not printed. Typical
9170
outputs: `\.{\\WA\ section 101.}'; `\.{\\WU\ sections 370 and 1009.}';
9171
`\.{\\WA\ sections 8, 27\\*, and 64.}'.
9172
9173
@<Part 3@>=@[
9174
9175
SRTN
9176
footnote FCN((flag)) /* Outputs module cross-references */
9177
sixteen_bits flag C1("")@;
9178
{
9179
xref_pointer q; /* Cross-reference pointer variable */
9180
9181
if (cur_xref->num<=flag) return;
9182
9183
fin_line(); OUT_STR("\\W");
9184
@.\\WA@>
9185
@.\\WU@>
9186
9187
out( flag==0 ? @'U' : @'A');
9188
9189
OUT_STR(" section"); // English!
9190
@<Output all the module numbers on the reference list |cur_xref|@>;
9191
out(@'.');
9192
fin_line();
9193
}
9194
9195
@ The following code distinguishes three cases, according as the number of
9196
cross-references is one, two, or more than two. Variable~|q| points to the
9197
first cross-reference, and the last link is a zero.
9198
9199
@<Output all the module numbers...@>=
9200
9201
q=cur_xref; if (q->xlink->num>flag) out(@'s'); // Pluralize. English!
9202
out(@'~');
9203
9204
WHILE()
9205
{
9206
out_mod(cur_xref->num-flag,ENCAP);
9207
cur_xref=cur_xref->xlink; /* Point to the next cross-reference to output */
9208
9209
if (cur_xref->num<=flag) break;
9210
9211
if (cur_xref->xlink->num>flag || cur_xref!=q->xlink) out(@',');
9212
/* Not the last of two */
9213
9214
out(@' ');
9215
9216
if (cur_xref->xlink->num<=flag)
9217
OUT_STR("and~"); /* The last. English! */
9218
}
9219
9220
@
9221
@<Output the code for the end of a module@>=
9222
{
9223
if(in_module && output_on)
9224
{
9225
outer_char temp[500];
9226
9227
SPRINTF(500, temp, `"\\fi %% End of %s", MOD_TRANS(module_count)`);
9228
// English!
9229
OUT_STR(temp); @~ fin_line();
9230
@.\\fi@>
9231
mfree();
9232
in_module = NO;
9233
9234
flush_buffer(out_buf, NO); // Insert a blank line for beauty.
9235
}
9236
}
9237
9238
@* PHASE THREE PROCESSING. We are nearly finished! \.{WEAVE}'s only
9239
remaining task is to write out the index and module list, after sorting the
9240
identifiers and index entries. The index and module list are written into
9241
separate files, by default \.{INDEX.tex} and \.{MODULES.tex}.
9242
9243
If the user has set the |no_xref| flag (the \.{-x} option on the command
9244
line), just finish off the page, omitting the index, module name list, and
9245
table of contents. (Fix this up.)
9246
9247
@d NEW_TeX(file_name)
9248
if(tex_file != stdout)
9249
{
9250
fclose(tex_file);
9251
if((tex_file=FOPEN(file_name,"w"))==NULL)
9252
FATAL(W,
9253
"ABORTING: ",
9254
"Can't open output file %s.",
9255
file_name);
9256
}
9257
9258
@<Part 3@>=@[
9259
9260
SRTN
9261
phase3(VOID)
9262
{
9263
language = global_language;
9264
9265
if (no_xref && !prn_contents)
9266
{
9267
fin_line();
9268
@<Finish off |phase3|@>@;
9269
}
9270
else
9271
{ // Print cross-reference information.
9272
temp_ndx = GET_MEM("temp_ndx",MAX_FILE_NAME_LENGTH,outer_char);
9273
temp_mds = GET_MEM("temp_mds",MAX_FILE_NAME_LENGTH,outer_char);
9274
9275
phase = 3;
9276
nuweb_mode = NO; // Force full output of identifiers.
9277
9278
if(prn_index)
9279
{
9280
OUT_STR("\\input ");
9281
OUT_STR(xpn_name(&temp_ndx,MAX_FILE_NAME_LENGTH,
9282
w_style.indx.tex,wbflnm0));
9283
fin_line();
9284
}
9285
9286
if(prn_modules)
9287
{
9288
OUT_STR("\\input ");
9289
OUT_STR(xpn_name(&temp_mds,MAX_FILE_NAME_LENGTH,
9290
w_style.modules.tex,wbflnm0));
9291
fin_line();
9292
9293
fin_line();
9294
9295
@<Print the command line, etc.@>@;
9296
@.\\Winfo@>
9297
}
9298
9299
if(prn_contents)
9300
{
9301
outer_char temp[20];
9302
9303
OUT_STR(w_style.contents.preamble);
9304
9305
SPRINTF(20, temp, `"{%i}", module_count`);
9306
OUT_STR(temp);
9307
9308
OUT_STR(w_style.contents.postamble);
9309
fin_line();
9310
@.\\Wcon@>
9311
OUT_STR("\\FWEBend"); @~ fin_line();
9312
}
9313
else
9314
@<Finish off |phase3|@>@;
9315
9316
if(prn_index)
9317
@<Output the index@>@;
9318
9319
if(prn_modules)
9320
@<Output all the module names@>@;
9321
}
9322
9323
if(tex_file != stdout)
9324
fclose(tex_file); // |tex_file| is actually the last open file.
9325
9326
CLR_PRINTF(SHORT_INFO, info, ("\nDone."));
9327
chk_complete(); // Was all of the change file used?
9328
}
9329
9330
@
9331
@<Finish off |phase3|@>=
9332
{
9333
OUT_STR("\\vfill"); @~ fin_line();
9334
OUT_STR("\\FWEBend"); @~ fin_line();
9335
}
9336
9337
@
9338
9339
@d N_CMD 1000
9340
9341
@<Print the command line...@>=
9342
@B
9343
outer_char HUGE *temp;
9344
9345
@b
9346
temp = GET_MEM("temp",N_CMD,outer_char);
9347
9348
OUT_STR(w_style.modules.info);
9349
OUT_STR(cmd_ln_buf); @~ fin_line();
9350
9351
/* Print a message identifying the global language. */
9352
SPRINTF(N_CMD,temp,`" {%s}", XLANGUAGE_NAME_PTR(global_language)`);
9353
OUT_STR(temp); @~ fin_line();
9354
9355
@<Print the RCS keywords@>@;
9356
9357
FREE_MEM(temp,"temp",N_CMD,outer_char);
9358
}
9359
9360
@ The values of any RCS keywords encountered during the
9361
\.{\AT!z}--\.{\AT!x} scan are printed at the end of the run.
9362
9363
@<Print the RCS...@>=
9364
{
9365
RCS HUGE *prcs;
9366
// Dynamic array of RCS-like keywords.
9367
IN_COMMON unsigned num_keywords;
9368
unsigned k;
9369
RCS HUGE *rcs_ptrs[1000]; // Kludge; to be upgraded.
9370
9371
/* Construct an array of pointers to the |RCS| entries. */
9372
for(prcs=prms[WEB_FILE].rcs_list.start, num_keywords=0; prcs;
9373
prcs=prcs->next, num_keywords++)
9374
rcs_ptrs[num_keywords] = prcs;
9375
9376
QSORT(rcs_ptrs, num_keywords, sizeof(RCS *), cmpr_rcs);
9377
9378
fin_line();
9379
9380
if(num_keywords > 0)
9381
{
9382
out_str(w_style.modules.kwd);
9383
out(@'s');
9384
fin_line();
9385
}
9386
9387
for(k=0; k<num_keywords; k++)
9388
{ /* Construct format of form \.{\\Wkwd\{kwd\}\{txt\}}. */
9389
prcs = rcs_ptrs[k];
9390
9391
out_str(w_style.modules.kwd); // (No escapes)
9392
out(@'{');
9393
out_atext(prcs->keyword); // (Escaped)
9394
out(@'}');
9395
out(@'{');
9396
out_atext(prcs->txt); // (Escaped)
9397
out(@'}');
9398
fin_line();
9399
}
9400
}
9401
9402
@ Here's the comparison routine for use with |qsort|ing the RCS keywords.
9403
9404
@<Part 3@>=@[
9405
9406
int
9407
cmpr_rcs FCN((pp0, pp1))
9408
RCS HUGE **pp0 C0("")@;
9409
RCS HUGE **pp1 C1("")@;
9410
{
9411
return STRCMP((*pp0)->keyword, (*pp1)->keyword);
9412
}
9413
9414
@ Here we escape an |ASCII| string into another |ASCII| buffer. We return the
9415
beginning of the output buffer.
9416
9417
@d TO_TEMP(val)
9418
if(temp < temp_end)
9419
*temp++ = val;
9420
else
9421
OVERFLW("Esc_buf:temp","")@;
9422
9423
@<Part 3@>=@[
9424
9425
ASCII HUGE *
9426
esc_buf FCN((temp,temp_end,buf,all_cases))
9427
ASCII HUGE *temp C0("Put it into here.")@;
9428
CONST ASCII HUGE *temp_end C0("End of |temp|.")@;
9429
CONST ASCII HUGE *buf C0("Translate from here.")@;
9430
boolean all_cases C1("")@;
9431
{
9432
ASCII HUGE *temp0 = temp;
9433
9434
while(*buf != '\0')
9435
{
9436
switch(*buf)
9437
{
9438
@<Special \TeX\ cases@>:
9439
if(!all_cases) break;
9440
9441
@<Other string cases@>:
9442
TO_TEMP(@'\\');
9443
break;
9444
}
9445
9446
TO_TEMP(*buf++);
9447
}
9448
9449
TO_TEMP('\0');
9450
return temp0; // Return the beginning of the output buffer.
9451
}
9452
9453
@ Just before the index comes a list of all the changed modules, including
9454
the index module itself.
9455
9456
@<Global...@>=
9457
9458
EXTERN sixteen_bits k_module; /* Runs through the modules */
9459
9460
@
9461
@<Tell about changed modules@>=
9462
{
9463
/* Remember that the index is already marked as changed */
9464
k_module=0;
9465
9466
while (!chngd_module[++k_module]);
9467
9468
OUT_STR("\\Wch ");
9469
@.\\Wch@>
9470
out_mod(k_module,ENCAP);
9471
9472
while (k_module < module_count)
9473
{
9474
while (!chngd_module[++k_module]); /* Skip over
9475
unchanged modules. */
9476
9477
OUT_STR(", "); out_mod(k_module,ENCAP);
9478
}
9479
9480
out(@'.');
9481
}
9482
9483
@ A left-to-right radix sorting method is used, since this makes it easy to
9484
adjust the collating sequence and since the running time will be at worst
9485
proportional to the total length of all entries in the index. We put the
9486
identifiers into different lists based on their first characters.
9487
(Uppercase letters are put into the same list as the corresponding
9488
lowercase letters, since we want to have `$t<\\{TeX}<\&{to}$'.) The list
9489
for character~|c| begins at location |bucket[c]| and continues through the
9490
|blink| array.
9491
9492
@<Global...@>=
9493
9494
EXTERN name_pointer bucket[128]; // One for each standard |ASCII char|.
9495
EXTERN name_pointer next_name; /* Successor of |cur_name| when sorting */
9496
IN_COMMON hash_pointer h; /* Index into |hash| */
9497
9498
IN_COMMON BUF_SIZE max_names; /* number of identifiers, strings, module names;
9499
must be less than~10240 */
9500
EXTERN name_pointer HUGE *blink; /* Links in the buckets */
9501
EXTERN ASCII last_letter SET('\0'); /* Used for separating groups in the
9502
index. */
9503
9504
@
9505
@<Alloc...@>=
9506
9507
ALLOC(name_pointer,blink,ABBREV(max_names),max_names,0);
9508
9509
@ To begin the sorting, we go through all the hash lists and put each entry
9510
having a nonempty cross-reference list into the proper bucket.
9511
9512
@<Do the first pass of sorting@>=
9513
@B
9514
int c;
9515
9516
@b
9517
for (c=0; c<=127; c++) bucket[c]=NULL;
9518
9519
for (h=hash; h<=hash_end; h++)
9520
{
9521
next_name=*h;
9522
9523
while (next_name)
9524
{
9525
cur_name=next_name; next_name=cur_name->link;
9526
9527
if ((xref_pointer)cur_name->xref != xmem)
9528
{
9529
c=(cur_name->byte_start)[0];
9530
9531
c = A_TO_LOWER(c);
9532
9533
blink[cur_name-name_dir]=bucket[c];
9534
bucket[c]=cur_name;
9535
}
9536
}
9537
}
9538
}
9539
9540
@ During the sorting phase we shall use the |cat| and |trans| arrays from
9541
\.{WEAVE}'s parsing algorithm and rename them |depth| and |head|. They now
9542
represent a stack of identifier lists for all the index entries that have
9543
not yet been output. The variable |sort_ptr| tells how many such lists are
9544
present; the lists are output in reverse order (first |sort_ptr|, then
9545
|sort_ptr-1|, etc.). The |j|th list starts at |head[j]|, and if the first
9546
|k| characters of all entries on this list are known to be equal we have
9547
|depth[j]=k|.
9548
9549
@
9550
@<Rest of |trans_plus| union@>=
9551
9552
name_pointer Head;
9553
9554
@
9555
@f sort_pointer scrap_pointer
9556
9557
@d depth cat /* reclaims memory that is no longer needed for parsing */
9558
@d head trans_plus.Head /* ditto */
9559
@d sort_pointer scrap_pointer /* ditto */
9560
@d sort_ptr scrp_ptr /* ditto */
9561
@d max_sorts max_scraps /* ditto */
9562
9563
@<Global...@>=
9564
9565
EXTERN eight_bits cur_depth; /* Depth of current buckets */
9566
EXTERN ASCII HUGE *cur_byte; /* Index into |byte_mem| */
9567
EXTERN sixteen_bits cur_val; /* Current cross-reference number */
9568
9569
EXTERN sort_pointer mx_sort_ptr; /* largest value of |sort_ptr| */
9570
9571
@
9572
@<Set init...@>=
9573
9574
mx_sort_ptr=scrp_info;
9575
9576
9577
@ The desired alphabetic order is specified by the |collate| array; namely,
9578
|collate[0]==0 <collate[1]<@t$\cdots$@><collate[max_collate]|. The collate
9579
array can be set by the style file entry \.{collate}.
9580
9581
@<Global...@>=
9582
9583
EXTERN ASCII collate[128]; // collation order.
9584
EXTERN int max_collate; // Last index in |collate|.
9585
9586
@ We use the order $\hbox{null}<\.\ <\hbox{other characters}<\.\_<
9587
\.A=\.a<\cdots<\.Z=\.z<\.0<\cdots<\.9.$
9588
9589
@<Set init...@>=
9590
9591
collate[0] = 0;
9592
9593
@ Procedure |unbucket| goes through the buckets and adds nonempty lists to
9594
the stack, using the collating sequence specified in the |collate| array.
9595
The parameter to |unbucket| tells the current depth in the buckets. Any
9596
two sequences that agree in their first 255 character positions are
9597
regarded as identical.
9598
9599
@d INFTY 255 // $\infty$ (approximately).
9600
9601
@<Part 3@>=@[
9602
9603
SRTN
9604
unbucket FCN((d)) /* Empties buckets having depth |d| */
9605
eight_bits d C1("")@;
9606
{
9607
int c; /* Index into |bucket|. {\it Must be |int|.} */
9608
9609
for (c=max_collate; c>= 0; c--) if (bucket[collate[c]]) {
9610
if (sort_ptr>=scrp_end) OVERFLW("sort levels",ABBREV(max_scraps));
9611
9612
sort_ptr++;
9613
9614
if (sort_ptr>mx_sort_ptr) mx_sort_ptr = sort_ptr;
9615
9616
sort_ptr->depth = (eight_bits)(c==0 ? INFTY : d);
9617
sort_ptr->head = bucket[collate[c]];
9618
bucket[collate[c]] = NULL;
9619
}
9620
}
9621
9622
@
9623
@<Sort and output the index@>=
9624
9625
w_style.indx.collate = x__to_ASCII((outer_char *)w_style.indx.collate);
9626
max_collate = STRLEN(w_style.indx.collate);
9627
STRNCPY(collate+1,w_style.indx.collate,max_collate);
9628
9629
sort_ptr=scrp_info; unbucket(1);
9630
9631
while (sort_ptr>scrp_info)
9632
{
9633
cur_depth=sort_ptr->depth;
9634
9635
if (blink[sort_ptr->head-name_dir]==0 || cur_depth==INFTY)
9636
@<Output index entries for the list at |sort_ptr|@>@;
9637
else @<Split the list at |sort_ptr| into further lists@>;
9638
}
9639
9640
@
9641
@<Split the list...@>=
9642
@B
9643
ASCII c;
9644
9645
@b
9646
next_name=sort_ptr->head;
9647
9648
do
9649
{
9650
cur_name=next_name; next_name=blink[cur_name-name_dir];
9651
cur_byte=cur_name->byte_start+cur_depth;
9652
9653
if (cur_byte==(cur_name+1)->byte_start) c=0; /* hit end of the name */
9654
else
9655
{
9656
c = *cur_byte;
9657
c = A_TO_LOWER(c);
9658
}
9659
9660
blink[PTR_DIFF(size_t,cur_name,name_dir)]=bucket[c];
9661
bucket[c]=cur_name;
9662
}
9663
while (next_name);
9664
9665
--sort_ptr; unbucket((eight_bits)(cur_depth+(eight_bits)1));
9666
}
9667
9668
@
9669
@<Output index...@>=
9670
{
9671
cur_name = sort_ptr->head;
9672
9673
@<Separate the groups if necessary@>@;
9674
9675
do
9676
{
9677
if(cur_name->defined_type(language) < 0x80)
9678
{ /* Write index entry for one identifier. */
9679
OUT_STR(w_style.indx.item_0);
9680
@.\\:@>
9681
@<Output the name at |cur_name|@>;
9682
@<Output the cross-references at |cur_name|@>;
9683
}
9684
9685
cur_name = blink[cur_name-name_dir];
9686
}
9687
while (cur_name);
9688
9689
--sort_ptr;
9690
}
9691
9692
@ Here we insert an optional macro between the different groups.
9693
9694
@d NON_TEX_MACRO '\1'
9695
9696
@<Separate the groups...@>=
9697
{
9698
ASCII letter = *cur_name->byte_start;
9699
9700
/* In some special cases in \Cpp, the identifier may be a \TeX\ macro
9701
beginning with~'\.\\' at this point. We must then take special precautions.
9702
In particular, we assign a non-null, non-printable value to |letter|. */
9703
if(letter == @'\\' && cur_name->ilk==normal && language!=TEX)
9704
letter = NON_TEX_MACRO;
9705
else
9706
letter = A_TO_LOWER(letter);
9707
9708
if(letter != last_letter)
9709
{
9710
if(last_letter)
9711
{ /* Separate groups, but not for the very first one. */
9712
OUT_STR(w_style.indx.group_skip);
9713
}
9714
9715
if(w_style.indx.lethead_flag && letter != NON_TEX_MACRO)
9716
{
9717
OUT_STR(w_style.indx.lethead_prefix);
9718
9719
switch(letter)
9720
{
9721
@<Special string cases@>: out(@'\\');
9722
}
9723
out((w_style.indx.lethead_flag > 0 ? A_TO_UPPER(letter) :
9724
A_TO_LOWER(letter)));
9725
9726
if(w_style.indx.m_headings_flag)
9727
{}
9728
9729
OUT_STR(w_style.indx.lethead_suffix);
9730
}
9731
}
9732
9733
last_letter = letter;
9734
}
9735
9736
@
9737
@<Output the name...@>=
9738
@B
9739
boolean all_uc = cur_name->info.upper_case;
9740
9741
@b
9742
if(makeindex)
9743
m_start = out_ptr + 1;
9744
9745
switch (cur_name->ilk)
9746
{
9747
case normal:
9748
output_type = IDENTIFIER;
9749
9750
if(is_intrinsic(cur_name))
9751
OUT_STR(pfrmt->intrinsic);
9752
// E.g., |sqrt|.
9753
else if(is_keyword(cur_name))
9754
OUT_STR(ALL_UC ? pfrmt->KEYWORD : pfrmt->keyword);
9755
// E.g., |@r BLOCKSIZE|.
9756
else
9757
if(language==TEX)
9758
OUT_STR(pfrmt->typewritr);
9759
// E.g., \.{\\hfill}.
9760
else if (length(cur_name)==1)
9761
OUT_STR(pfrmt->short_id); // E.g., |a|.
9762
else
9763
@<Output the appropriate identifier prefix@>@;
9764
break;
9765
@.\\\AT!@>
9766
@.\\|@>
9767
@.\\\\@>
9768
case roman: output_type = INDEX_ENTRY; @~ break;
9769
case wildcard: OUT_STR(pfrmt->wildcrd); @~ output_type = INDEX_ENTRY; @~ break;
9770
@.\\9@>
9771
case typewriter: OUT_STR(pfrmt->typewritr);
9772
output_type = INDEX_ENTRY; @~ break;
9773
@.\\.@>
9774
default:
9775
OUT_STR(ALL_UC ? pfrmt->RESERVED : pfrmt->reserved);
9776
output_type = IDENTIFIER; @~ break; // E.g., |int|.
9777
@.\\\&@>
9778
}
9779
9780
out_name(m_temp1, YES, output_type,cur_name);
9781
}
9782
9783
@ Section numbers that are to be underlined are enclosed in
9784
`\.{\\[}$\,\ldots\,$\.]'.
9785
9786
@d ENCAP YES
9787
@d NO_ENCAP NO
9788
9789
@<Output the cross-references...@>=
9790
{
9791
@<Invert the cross-reference list at |cur_name|, making |cur_xref| the head@>;
9792
9793
OUT_STR(w_style.indx.delim_0); /* Immediately before identifier. */
9794
9795
WHILE()
9796
{
9797
MX_OUT_S(keyword);
9798
MX_OUT_C(arg_open);
9799
m_start = out_ptr + 1;
9800
9801
if(makeindex)
9802
out_name(m_temp0, NO, output_type, cur_name);
9803
9804
MX_STR(mx_quote(m_temp, m_temp0));
9805
MX_OUT_C(actual);
9806
MX_STR(mx_quote(m_temp, m_temp1));
9807
9808
cur_val=cur_xref->num;
9809
9810
MX_OUT_C(encap);
9811
9812
/* Write `\.{pg\{\}}' --- file id unspecified for now. */
9813
MX_OUT_S(page);
9814
MX_OUT_C(arg_open);
9815
MX_OUT_C(arg_close);
9816
9817
if (cur_val<def_flag)
9818
{
9819
MX_OUT_C(arg_open); // Empty action macro line \.{\\underline}.
9820
MX_OUT_C(arg_close);
9821
9822
MX_OUT_C(arg_close); // End of \.{\\indexentry}.
9823
out_mod(cur_val, ENCAP);
9824
}
9825
else
9826
{
9827
OUT_STR(w_style.indx.underline_prefix);
9828
9829
/* Write action macro like \.{\\underline}. */
9830
MX_OUT_C(escape);
9831
MX_OUT_S(underline);
9832
MX_OUT_C(arg_close);
9833
9834
out_mod(cur_val-def_flag, ENCAP);
9835
OUT_STR(w_style.indx.underline_suffix);
9836
}
9837
@.\\[@>
9838
9839
/* If the language of this module isn't the global language, mark it in the
9840
|w_style|. */
9841
if((LANGUAGE)cur_xref->Language != global_language)
9842
{
9843
char temp[50];
9844
9845
sprintf(temp,"%s%s%s",
9846
(char *)w_style.indx.language_prefix,
9847
(char *)LANGUAGE_SYMBOL((LANGUAGE)cur_xref->Language),
9848
(char *)w_style.indx.language_suffix);
9849
OUT_STR(temp);
9850
}
9851
9852
MX_CHAR('\n'); // Finish off one page.
9853
9854
cur_xref=cur_xref->xlink;
9855
9856
if(cur_xref == xmem)
9857
break; // No more pages.
9858
9859
OUT_STR(w_style.indx.delim_n); /* Between page numbers. */
9860
}
9861
9862
out(@'.'); @~ fin_line();
9863
}
9864
9865
@
9866
@a
9867
outer_char *
9868
mx_quote FCN((m_out, s))
9869
outer_char *m_out C0("Escape into here")@;
9870
outer_char *s C1("Input")@;
9871
{
9872
outer_char *p;
9873
9874
for(p=m_out; *s; )
9875
{
9876
INDEX HUGE *q = &w_style.indx;
9877
9878
char c = *s++;
9879
9880
if(c == q->m_escape
9881
|| c == q->m_encap
9882
|| c == q->m_quote
9883
|| c == q->m_level
9884
|| c == q->m_actual)
9885
*p++ = q->m_quote;
9886
9887
*p++ = c;
9888
}
9889
9890
*p = '\0';
9891
9892
return m_out;
9893
}
9894
9895
@ List inversion is best thought of as popping elements off one stack and
9896
pushing them onto another. In this case |cur_xref| will be the head of
9897
the stack that we push things onto.
9898
9899
@<Invert the cross-reference list at |cur_name|, making |cur_xref| the head@>=
9900
9901
this_xref = (xref_pointer)cur_name->xref; cur_xref=xmem;
9902
9903
do
9904
{
9905
next_xref=this_xref->xlink; this_xref->xlink=cur_xref;
9906
cur_xref=this_xref; this_xref=next_xref;
9907
}
9908
while (this_xref!=xmem);
9909
9910
@ The following recursive procedure walks through the tree of module names and
9911
prints them.
9912
@^recursion@>
9913
9914
@<Part 3@>=@[
9915
9916
SRTN
9917
mod_print FCN((p)) /* Print all module names in subtree |p|. */
9918
name_pointer p C1("")@;
9919
{
9920
if (p)
9921
{
9922
mod_print(p->llink); OUT_STR("\\:");
9923
@.\\:@>
9924
tok_ptr=tok_mem+1; text_ptr=tok_start+1; scrp_ptr=scrp_info; ini_stack;
9925
APP_FLAG(mod, p, name_dir);
9926
make_output();
9927
footnote(0); /* |cur_xref| was set by |make_output| */
9928
fin_line();
9929
9930
mod_print(p->rlink);
9931
}
9932
}
9933
9934
@
9935
9936
@m MX_STR(str)
9937
if(makeindex) fprintf(mx_file, "%s", str)@;
9938
9939
@m MX_CHAR(c)
9940
if(makeindex) fprintf(mx_file, "%c", c)@;
9941
9942
@m MX_OUT_S(name)
9943
MX_STR(w_style.indx.m_##name)
9944
9945
@m MX_OUT_C(name)
9946
MX_CHAR(w_style.indx.m_##name)
9947
9948
@m MX_OUT_I(name)
9949
if(makeindex) fprintf(mx_file, "%i", w_style.indx.m_##name)@;
9950
9951
@<Glob...@>=
9952
9953
EXTERN FILE *mx_file;
9954
EXTERN outer_char HUGE *m_start;
9955
EXTERN outer_char m_temp[100], m_temp0[100], m_temp1[100];
9956
EXTERN boolean output_type;
9957
EXTERN outer_char HUGE *temp_ndx,HUGE *temp_mds;
9958
IN_COMMON outer_char wbflnm0[];
9959
9960
@
9961
@<Output the index@>=
9962
{
9963
writing(YES, temp_ndx);
9964
9965
if(tex_file == stdout)
9966
puts("");
9967
9968
NEW_TeX(temp_ndx);
9969
9970
if(makeindex)
9971
{
9972
@<Write \.{makeindex} style file@>@;
9973
9974
mx_open(w_style.indx.m_out);
9975
fprintf(mx_file, "%% %s\n\n", wbflnm0);
9976
}
9977
9978
if (change_exists)
9979
{
9980
@<Tell about changed modules@>;
9981
fin_line();
9982
fin_line();
9983
}
9984
9985
OUT_STR(w_style.indx.preamble); @~ fin_line();
9986
@.\\Winx@>
9987
9988
@<Do the first pass of sorting@>;
9989
@<Sort and output the index@>;
9990
9991
OUT_STR(w_style.indx.postamble); @~ fin_line();
9992
@.\\Wfin@>
9993
}
9994
9995
@
9996
9997
@m MX_STY_S(name)
9998
fprintf(mx_file, "%s \"%s\"\n", #name,
9999
dbl_bslash(m_temp0, w_style.indx.m_##name))
10000
10001
@m MX_STY_C(name)
10002
fprintf(mx_file, "%s '%s'\n", #name,
10003
dbl_cslash(m_temp0, w_style.indx.m_##name))
10004
10005
@m MX_STY_I(name)
10006
fprintf(mx_file, "%s %i\n", #name, w_style.indx.m_##name)
10007
10008
@<Write \.{make...@>=
10009
{
10010
mx_open(w_style.indx.m_sty);
10011
10012
MX_STR("% Produced automatically by fweave.\n\n");
10013
10014
sprintf((char *)m_temp0,
10015
" \\Wequate{%s%s} {%s} {%s%s} {%s%s} {%s%s} {%s} {%s%s} {%s} {%s}\n\n",
10016
pfrmt->reserved, pfrmt->RESERVED,@\ \
10017
pfrmt->short_id,@\ \
10018
pfrmt->id, pfrmt->ID,@\ \
10019
pfrmt->id_outer, pfrmt->ID_OUTER,@\ \
10020
pfrmt->id_inner, pfrmt->ID_INNER,@\ \
10021
pfrmt->intrinsic,@\ \
10022
pfrmt->keyword, pfrmt->KEYWORD,@\ \
10023
pfrmt->typewritr, "");
10024
10025
fprintf(mx_file, "%s \"%s\\\n%s\"\n",
10026
"preamble",
10027
dbl_bslash(m_temp, w_style.indx.m_preamble),
10028
dbl_bslash(m_temp1, m_temp0));
10029
10030
MX_STY_S(postamble);
10031
MX_STY_S(keyword);
10032
MX_STY_C(arg_open);
10033
MX_STY_C(arg_close);
10034
MX_STY_C(range_open);
10035
MX_STY_C(range_close);
10036
MX_STY_C(level);
10037
MX_STY_C(actual);
10038
MX_STY_C(encap);
10039
MX_STY_C(quote);
10040
MX_STY_C(escape);
10041
MX_STY_S(setpage_prefix);
10042
MX_STY_S(setpage_suffix);
10043
MX_STY_S(group_skip);
10044
MX_STY_I(headings_flag);
10045
MX_STY_S(heading_prefix);
10046
MX_STY_S(symhead_positive);
10047
MX_STY_S(symhead_negative);
10048
MX_STY_S(numhead_positive);
10049
MX_STY_S(numhead_negative);
10050
MX_STY_S(item_0);
10051
MX_STY_S(item_1);
10052
MX_STY_S(item_2);
10053
MX_STY_S(item_01);
10054
MX_STY_S(item_x1);
10055
MX_STY_S(item_12);
10056
MX_STY_S(item_x2);
10057
MX_STY_S(delim_0);
10058
MX_STY_S(delim_1);
10059
MX_STY_S(delim_2);
10060
MX_STY_S(delim_n);
10061
MX_STY_S(delim_r);
10062
MX_STY_S(delim_t);
10063
MX_STY_S(encap_prefix);
10064
MX_STY_S(encap_infix);
10065
MX_STY_S(encap_suffix);
10066
MX_STY_I(line_max);
10067
MX_STY_S(indent_space);
10068
MX_STY_I(indent_length);
10069
10070
fclose(mx_file);
10071
}
10072
10073
@ Translate a string, inserting appropriate backslashes.
10074
@a
10075
outer_char *
10076
dbl_bslash FCN((m_temp, s))
10077
outer_char *m_temp C0("Buffer")@;
10078
outer_char *s C1("String to expand")@;
10079
{
10080
outer_char *p;
10081
10082
for(p=m_temp; *s; )
10083
{
10084
c = *s++;
10085
10086
if(iscntrl(c) || c == '\\')
10087
@<Translate a control character |c|@>@;
10088
10089
*p++ = c;
10090
}
10091
10092
*p = '\0';
10093
10094
return m_temp;
10095
}
10096
10097
@ Make a string out of a single character.
10098
@a
10099
10100
outer_char *
10101
dbl_cslash FCN((m_temp, c))
10102
outer_char *m_temp C0("Buffer")@;
10103
outer_char c C1("Char to expand")@;
10104
{
10105
outer_char *p = m_temp;
10106
10107
if(iscntrl(c) || c == '\\')
10108
@<Translate a control character |c|@>@;
10109
10110
*p++ = c;
10111
*p = '\0';
10112
10113
return m_temp;
10114
}
10115
10116
@
10117
@<Translate a cont...@>=
10118
{
10119
*p++ = '\\';
10120
10121
switch(c)
10122
{
10123
case '\a': c = 'a'; break;
10124
case '\b': c = 'b'; break;
10125
case '\f': c = 'f'; break;
10126
case '\n': c = 'n'; break;
10127
case '\r': c = 'r'; break;
10128
case '\t': c = 't'; break;
10129
case '\v': c = 'v'; break;
10130
10131
case '\\':
10132
default:
10133
break;
10134
}
10135
}
10136
10137
10138
@
10139
@a
10140
SRTN mx_open FCN((ext))
10141
outer_char *ext C1("File extension")@;
10142
{
10143
xpn_name(&temp_ndx, MAX_FILE_NAME_LENGTH, ext, wbflnm0);
10144
mx_file = FOPEN(temp_ndx, "w");
10145
10146
if(mx_file)
10147
writing(NO, temp_ndx);
10148
else
10149
{
10150
CLR_PRINTF(WARNINGS, info,
10151
("\n! Can't open makeindex file %s\n", temp_ndx));
10152
mark_harmless;
10153
makeindex = NO;
10154
}
10155
}
10156
10157
@
10158
@<Output all the module names@>=
10159
{
10160
writing(BOOLEAN(!prn_index),temp_mds);
10161
NEW_TeX(temp_mds);
10162
10163
OUT_STR(w_style.modules.preamble); @~ fin_line();
10164
@.\\Wmods@>
10165
10166
mod_print(root);
10167
10168
OUT_STR(w_style.modules.postamble); @~ fin_line();
10169
}
10170
10171
@ Statistics are printed when the command-line option~\.{-s} is used.
10172
10173
@<Part 3@>=@[
10174
10175
SRTN
10176
see_statistics(VOID)
10177
{
10178
CLR_PRINTF(ALWAYS, info,("\n\nMEMORY USAGE STATISTICS:\n"));
10179
10180
STAT0("names",sizeof(*name_ptr),
10181
SUB_PTRS(name_ptr,name_dir),max_names,UPPER(max_names),",");
10182
10183
STAT0("cross-references",sizeof(*xref_ptr),
10184
SUB_PTRS(xref_ptr,xmem),max_refs,UPPER(max_refs),",");
10185
10186
STAT0("bytes",sizeof(*byte_ptr),
10187
SUB_PTRS(byte_ptr,byte_mem),max_bytes,UPPER(max_bytes),";");
10188
10189
CLR_PRINTF(ALWAYS, info,(" parsing required\n"));
10190
10191
STAT0("scraps",sizeof(*mx_scr_ptr),
10192
SUB_PTRS(mx_scr_ptr,scrp_base),max_scraps,UPPER(max_scraps),",");
10193
10194
STAT0("texts",sizeof(*mx_text_ptr),
10195
SUB_PTRS(mx_text_ptr,tok_start),max_texts,UPPER(max_texts),",");
10196
10197
STAT0("tokens",sizeof(*mx_tok_ptr),
10198
SUB_PTRS(mx_tok_ptr,tok_mem),max_toks,UPPER(max_toks_w),",");
10199
10200
STAT0("stack levels",sizeof(*mx_stck_ptr),
10201
SUB_PTRS(mx_stck_ptr,stack),stck_size,UPPER(stck_size_w),";");
10202
10203
CLR_PRINTF(ALWAYS, info, (" sorting required"));
10204
10205
printf(" %lu level(s).\n", SUB_PTRS(mx_sort_ptr,scrp_info));
10206
10207
mem_avail(1); // How much memory left at end of run?
10208
}
10209
10210
@ The following routines are invoked by \.{common.web}, but are used only by
10211
\.{TANGLE}.
10212
@<Part 3@>=@[
10213
10214
SRTN
10215
predefine_macros(VOID)
10216
{}
10217
10218
SRTN
10219
open_out(VOID)
10220
{}
10221
10222
boolean
10223
was_opened FCN((name,global_scope,pname,pptr))
10224
CONST outer_char HUGE *name C0("")@;
10225
boolean global_scope C0("")@;
10226
outer_char HUGE * HUGE *pname C0("")@;
10227
FILE **pptr C1("")@;
10228
{
10229
*pname = GET_MEM("*pname",STRLEN(name)+1,outer_char);
10230
STRCPY(*pname,name);
10231
10232
return NO;
10233
}
10234
10235
SRTN ini_tokens FCN((language0))
10236
LANGUAGE language0 C1("")@;
10237
{}
10238
10239
@* STYLE FILE. The style file is common to \FWEAVE\ and \FTANGLE. See
10240
\.{style.web}.
10241
10242
@<Include...@>=
10243
10244
#include "map.h" // Relations between style file keywords and internal arrays.
10245
10246
@* INDEX. If you have read and understood the code for Phase~III above,
10247
you know what is in this index and how it got here. All modules in which an
10248
identifier is used are listed with that identifier, except that reserved
10249
words are indexed only when they appear in format definitions, and the
10250
appearances of identifiers in module names are not indexed. Underlined
10251
entries correspond to where the identifier was declared. Error messages,
10252
control sequences put into the output, and a few other things like
10253
``recursion'' are indexed here too.
Loggerhead is a web-based interface for Breezy
Version: 2.0.1