« back to all changes in this revision
Viewing changes to Web/common.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/common.web
1
@z --- common.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{COMMON}
11
12
@c
13
14
@* INTRODUCTION.
15
This file contains code common to both \.{TANGLE} and
16
\.{WEAVE}, that roughly concerns the following problems: character
17
uniformity, input routines, error handling and parsing of command line. We
18
have tried to concentrate in this file all the system dependencies, so as
19
to maximize portability.
20
21
\FWEB\ has been written to work with a variety of C~compilers, not
22
necessarily ANSI. In particular, the special macro tokens~'\.\#'
23
and~'\.{\#\#}' are not used in any \.{@@d} commands; when such
24
constructions have been needed, the \WEB\ macro definition~\.{@@m} has been
25
used. The |enum| feature has been assumed to exist. \CWEB\ did not use
26
|enum|, so there's a fair amount of inherited \CWEB\ code that should
27
eventually be changed to |enum|, which makes debugging much easier. This
28
will be done in future versions. One should study the header files
29
\.{os.hweb}, \.{proto.hweb}, \.{includes.hweb}, and \.{custom.web} for
30
further information about machine dependencies.
31
32
In the texts below we will sometimes use \.{WEB} to refer to either of the
33
two component programs, if no confusion can arise.
34
35
@m _COMMON_
36
@d _COMMON_h
37
@d COMMON_FCNS_
38
39
@ Here is the overall appearance of this file:
40
41
@d VERSION "1.61" // For development, use |$REVISION| here.
42
@d RELEASE_DATE "September 23, 1998"
43
44
@A
45
@<Possibly split into parts@>@;
46
47
@<Include files@>@;
48
@<Common code for \.{TANGLE} and \.{WEAVE}@>@;
49
@<Typedef declarations@>@;
50
@<Other definitions@>@;
51
@<Global variables@>@;
52
53
/* For pc's, the file is split into two compilable parts using the
54
compiler-line macro |part|, which must equal either~1 or~2. */
55
#if(part != 2)
56
@<Part 1@>@;
57
#endif /* Part 1 */
58
59
#if(part != 1)
60
@<Part 2@>@;
61
#endif /* Part 2 */
62
63
64
@I typedefs.hweb
65
66
@I xrefs.hweb
67
@I tokens.hweb
68
@I scraps.hweb
69
@I stacks.hweb
70
71
@
72
@<Include...@>=
73
#include "map.h"
74
75
@ A dummy module for \.{scraps.hweb}.
76
77
@<Rest of |trans_plus| union@>=
78
79
@ For personal computers, we sometimes need to initialize the stack size.
80
81
@d STKLEN 20000U /* Borland needs this number; Microsoft requires it from
82
the compiler line. */
83
84
@<Common...@>=
85
86
#ifdef ibmpc /* \.{Machine-dependent}: For initializing the stack size. */
87
#ifdef borland
88
extern unsigned _stklen = STKLEN;
89
#endif
90
#endif
91
92
93
@* The CHARACTER SET.
94
One of the main goals in the design of \.{WEB} has been to make it readily
95
portable between a wide variety of computers. Yet \.{WEB} by its very
96
nature must use a greater variety of characters than most computer
97
programs deal with, and character encoding is one of the areas in which
98
existing machines differ most widely from each other.
99
100
To resolve this problem, all input to \.{WEAVE} and \.{TANGLE} is converted
101
to an internal seven-bit code that is essentially standard ASCII, the
102
``American Standard Code for Information Interchange.'' The conversion
103
is done immediately when each character is read in. Conversely,
104
characters are converted from ASCII to the user's external
105
representation just before they are output.
106
107
Such an internal code can be accessed by users of \.{WEB} by means of
108
constructions like \.{@@'A'}, which should be distinguished from \.{'A'}.
109
The former is transformed by \.{TANGLE} into an integer that is the
110
internal code of~\.A, but the latter, a |char| constant, is not touched by
111
\.{WEB}, and will be interpreted by the compiler according to the machine's
112
character set.
113
@^ASCII code@>
114
115
Here is a table of the standard visible ASCII codes (\.{\ } stands for
116
a blank space):
117
$$\def\:{\char\count255\global\advance\count255 by 1}
118
\count255='40
119
\vbox{
120
\hbox{\hbox to 40pt{\it\hfill0\/\hfill}%
121
\hbox to 40pt{\it\hfill1\/\hfill}%
122
\hbox to 40pt{\it\hfill2\/\hfill}%
123
\hbox to 40pt{\it\hfill3\/\hfill}%
124
\hbox to 40pt{\it\hfill4\/\hfill}%
125
\hbox to 40pt{\it\hfill5\/\hfill}%
126
\hbox to 40pt{\it\hfill6\/\hfill}%
127
\hbox to 40pt{\it\hfill7\/\hfill}}
128
\vskip 4pt
129
\hrule
130
\def\^{\vrule height 10.5pt depth 4.5pt}
131
\halign{\hbox to 0pt{\hskip -24pt\WO{\~#}\hfill}&\^
132
\hbox to 40pt{\tt\hfill#\hfill\^}&
133
&\hbox to 40pt{\tt\hfill#\hfill\^}\cr
134
04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
135
05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
136
06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
137
07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
138
10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
139
11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
140
12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
141
13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
142
14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
143
15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
144
16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
145
17&\:&\:&\:&\:&\:&\:&\:\cr}
146
\hrule width 280pt}$$
147
148
We introduce new types to distinguish between the transliterated characters
149
and the characters in the outside world. Let all ``interesting'' values
150
that a |char| variable may take lie between |first_text_char| and
151
|last_text_char|; for the ASCII code we can take |first_text_char=0| and
152
|last_text_char=0177|. We will tell \.{WEB} to convert all input characters
153
in this range to its own code, and balk at characters outside the range.
154
We make two assumptions: |first_text_char>=0| and |char| has room for at
155
least eight bits.
156
157
Following \CWEB, \FWEB\ deals with character constants by prefacing them
158
with '\.{@@}' if they are to be interpreted as |ASCII|. In \CWEB, \TANGLE\
159
translated such constants into octal, which makes the output hard to read
160
while debugging. While this mechanism is necessary for a non-ASCII machine,
161
it is redundant for an ASCII machine. Thus, for the latter by default
162
\FWEB\ does not translate |ASCII| character constants. To force it to do
163
so, use the `\.{-a}' command-line option. For non-ASCII machines, the
164
translation will always be done.
165
166
167
{\bf WARNING:} \FWEB\ has been tested only on an ASCII machine. It is
168
100\% likely that some debugging will be necessary for any other kind of
169
machine; the $|outer_char| \Leftrightarrow |ASCII|$ conversions are only
170
about 75\% in place at this point. (Even this is a substantial improvement
171
over \CWEB.)
172
173
@^system dependencies@>
174
175
@d first_text_char 0 // Lowest interesting value of an |outer_char|.
176
@d last_text_char 0377 // Highest interesting value of an |outer_char|.
177
178
@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
179
the user's external character set by means of arrays~|xord| and~|xchr|
180
that are analogous to PASCAL's |ord| and |chr| functions. Thus,
181
$\hbox{internal\_WEB\_chr} = |xord[@texternal\_chr@>]|$ and
182
$\hbox{external\_chr} = |xchr[@tinternal\_WEB\_chr@>]|$.
183
184
@<Common...@>=
185
186
IN_COMMON ASCII xord[last_text_char+1]; // Converts input chars.\ to |ASCII|.
187
#ifdef scramble_ASCII
188
ASCII xxord[last_text_char+1]; // For scrambling.
189
#endif
190
IN_COMMON outer_char xchr[0200]; // Converts output chars.\ from |ASCII|.
191
192
@ Every system supporting \cee\ must be able to read and write the
193
95~visible characters of standard ASCII above (although not necessarily
194
using the ASCII codes to represent them). Conversely, these characters,
195
plus the newline, are sufficient to write any \cee\ program. Other
196
characters are desirable mainly in strings, and they can be referred to by
197
means of escape sequences like~|'\t'|.
198
199
The basic implementation of \.{WEB}, then, only has to assign an~|xord| to
200
these 95 characters (newlines are swallowed by the reading
201
routines). The easiest way to do this is to assign the characters to
202
their positions in~|xchr| and then invert the correspondence:
203
204
@<Part 1@>=@[
205
206
SRTN
207
common_init(VOID)
208
{
209
IN_RATFOR SRTN is_Rat_present PROTO((VOID));
210
struct tm *t = the_localtime(); // Initialize the time.
211
212
#if(TRANSLATE_ASCII || DEBUG_XCHR)
213
translate_ASCII = YES; // Force it for the cases that really need it.
214
#endif
215
216
is_Rat_present(); // Find out if the \Ratfor\ package was linked on.
217
218
@<Set up character set translations@>@;
219
@<Initialize \TeX\ categories@>;
220
@<Initialize static pointers@>;
221
predefine_macros(); /* Must be done before parsing the command line, so
222
the user can undefine or override stuff if desired. */
223
@<Initialize flags@>@;
224
225
@<Scan arguments and open output files@>;
226
227
#if 0
228
banner(); // Start-up banner.
229
#endif
230
231
/* The next two have to be done after reading the command line. */
232
@<Allocate dynamic memory@>@;
233
@<Initialize dynamic pointers@>;
234
@<Execute deferred command-line options@>@;
235
236
more_includes(&incl, wt_style.Idir);
237
238
if(found_web)
239
read_aux(); // Process the \.{.aux} file.
240
}
241
242
@
243
@<Set up character set...@>=
244
{
245
STRNCPY(xchr," !\"#$%&'()*+,-./0123456789\
246
:;<=>?@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~ ",
247
sizeof(xchr));
248
249
/* Interesting ``invisible'' things to output. */
250
xchr[tab_mark] = '\t';
251
xchr[@'\n'] = '\n';
252
253
@<System-dependent parts of character set@>;
254
@<Invert |xchr| to get |xord|@>;
255
}
256
257
@ The following system-independent code makes the |xord| array contain
258
a suitable inverse to the information in |xchr|.
259
260
@<Invert |xchr|...@>=
261
@B
262
int i; /* to invert the correspondence */
263
264
@b
265
/* Initialize to |ASCII| blanks. */
266
for (i=first_text_char; i<=last_text_char; i++)
267
{
268
xord[i] = @' ';
269
#ifdef scramble_ASCII
270
xxord[i] = @' ';
271
#endif
272
}
273
274
/* The |NUL| and |DEL| characters are left alone! */
275
for (i=1; i<0177; i++)
276
{
277
xord[(eight_bits)XCHR_[i]] = (ASCII)i;
278
#ifdef scramble_ASCII
279
xxord[(eight_bits)wt_style.xchr[i]] = i;
280
#endif
281
}
282
283
#ifdef scramble_ASCII
284
for(i=0177; i<=0377; i++)
285
xxord[(eight_bits)wt_style.xchr[i]] = i;
286
#endif
287
288
#if(DEBUG_XCHR)
289
for(i=0177; i<=0377; i++)
290
xord[(eight_bits)XCHR_[i]] = (ASCII)i;
291
#endif
292
}
293
294
@ Now follow routines that translate |outer_char| strings into |ASCII|.
295
First, to avoid messing with possibly read-only memory, we have a routine
296
that allocates new storage for the string. (Thanks to Thorsten Ohl for
297
this one.)
298
299
@<Part 1@>=@[
300
301
ASCII HUGE *
302
x__to_ASCII FCN((p0))
303
CONST outer_char HUGE *p0 C1("Character string to translate.")@;
304
{
305
if(translate_ASCII)
306
{
307
ASCII HUGE *buffer, HUGE *p;
308
CONST outer_char HUGE *q;
309
310
buffer = GET_MEM("x__to_ASCII arg",STRLEN(p0)+1,ASCII);
311
312
for (p = buffer, q = p0; *q; p++, q++)
313
*p = XORD(*q);
314
*p = '\0';
315
316
return buffer;
317
}
318
else
319
return (ASCII HUGE *)p0;
320
}
321
322
@ For dealing with arrays, we have to |realloc| the space. (Again, thanks
323
to Thorsten Ohl.)
324
325
@<Part 1@>=@[
326
327
ASCII HUGE *
328
x_to_ASCII FCN((p0))
329
CONST outer_char HUGE *p0 C1("Character string to translate.")@;
330
{
331
static size_t bufsiz = 0;
332
static ASCII HUGE *buffer = NULL;
333
334
if(translate_ASCII)
335
{
336
ASCII HUGE *p;
337
CONST outer_char HUGE *q;
338
339
while (bufsiz <= STRLEN (p0) + 1)
340
{
341
if(buffer == NULL)
342
buffer = GET_MEM("x_to_ASCII_buf",bufsiz=32,ASCII);
343
/* Some systems don't like a |NULL| argument to |realloc|. */
344
else
345
{
346
buffer = (ASCII HUGE *) REALLOC(buffer, bufsiz+32, bufsiz);
347
bufsiz += 32;
348
}
349
350
if (buffer == NULL)
351
FATAL(C, "!! No more memory (x_to_ASCII)", "");
352
}
353
354
for (p = buffer, q = p0; *q; p++, q++)
355
*p = XORD(*q);
356
*p = '\0';
357
358
return buffer;
359
}
360
else
361
return (ASCII HUGE *)p0;
362
}
363
364
@ Finally, this function converts in place.
365
366
@<Part 1@>=@[
367
368
ASCII HUGE *
369
to_ASCII FCN((p0))
370
outer_char HUGE *p0 C1("Character string to translate.")@;
371
{
372
ASCII HUGE *p;
373
374
if(translate_ASCII)
375
for(p=(ASCII HUGE *)p0; *p; p++)
376
*p = XORD(*p);
377
378
return (ASCII HUGE *)p0;
379
}
380
381
@ Here is the inverse routine, converting in place |ASCII| to |outer_char|.
382
383
@<Part 1@>=@[
384
385
outer_char HUGE *
386
to_outer FCN((p0))
387
ASCII HUGE *p0 C1("Internal string to translate to outer world.")@;
388
{
389
outer_char HUGE *p;
390
391
if(translate_ASCII)
392
for(p=(outer_char HUGE *)p0; *p; p++) *p = XCHR(*(ASCII HUGE *)p);
393
394
return (outer_char HUGE *)p0;
395
}
396
397
@ Some \cee\ compilers accept an extended character set, so that one can
398
type things like~\.{\^\^Z} instead of~\.{!=}. If that's the case in your
399
system, you should change the relevant part of \.{typedefs.web}, assigning
400
positions~|01| to~|037| in the most convenient way; for example, at MIT you
401
can just say $$\hbox{|for (i=1; i<=037; i++) xchr[i]=i;|}$$ since \.{WEB}'s
402
character set is essentially identical to MIT's, even with respect to
403
characters less than |040| (see the definitions below). If, however, the
404
changes do not conform with these definitions you should change the
405
definitions as well. (See \.{typedefs.web} for definitions of |and_and|,
406
etc.)
407
408
@^system dependencies@>
409
@^notes to myself@>
410
411
@<System-dependent parts of character set@>= /* nothing needs to be done */
412
413
@* IDENTIFIERS.
414
At the point during phase one where we're recognizing
415
identifiers, we sometimes have to determine whether the identifier is a
416
special one. This is a simple byte-by-byte comparison. However, things are
417
complicated because by that time the input has been converted to |ASCII|.
418
Therefore, the comparison tables must also be converted to |ASCII|.
419
420
@ Test whether an identifier is a |BUILT_IN|.
421
422
@<Part 1@>=@[
423
424
boolean
425
is_include_like(VOID)
426
{
427
/* Check for \.{m4} built-in. */
428
if(m4 && is_in(incl_likes,id_first,id_loc)) return YES;
429
430
/* The \.{WEB} functions behave as built-ins for \.{WEAVE}, but as macros
431
for \.{TANGLE}. */
432
if(program==tangle) return NO;
433
434
if(!(*id_first == @'$' || *id_first == @'_')) return NO; // Speed up |is_in|.
435
return is_in(WEB_incl_likes,id_first,id_loc);
436
}
437
438
@ Convert lists to |ASCII|.
439
@<Part 1@>=@[
440
SRTN conv_bi FCN((b))
441
BUILT_IN HUGE *b C1("")@;
442
{
443
for( ; b->n != 0; b++)
444
b->name = x__to_ASCII((outer_char *)b->name);
445
}
446
447
SRTN
448
conv_dot FCN((d))
449
DOTS HUGE *d C1("")@;
450
{
451
for( ;d->code != 0; d++)
452
d->symbol = x__to_ASCII((outer_char *)d->symbol);
453
}
454
455
@ Hunt through a |BUILT_IN| list.
456
457
@<Part 1@>=@[
458
459
boolean
460
is_in FCN((b0,p0,p1))
461
CONST BUILT_IN b0[] C0("Array of built-ins.")@;
462
CONST ASCII HUGE *p0 C0("Start of text.")@;
463
CONST ASCII HUGE *p1 C1("End of text.")@;
464
{
465
CONST BUILT_IN HUGE *b;
466
467
for(b=b0; b->n != 0; b++)
468
if(web_strcmp(b->name,b->name+b->n,p0,p1) == EQUAL)
469
return YES;
470
471
return NO;
472
}
473
474
@
475
@<Common...@>=
476
477
extern DOTS dots0[],mcmds[]; /* These are put into \.{typedefs.web} so we can
478
make use of the various \.{@@d}s. */
479
480
@ Dot constants are allocated dynamically. Because of \Fortran-90's ability
481
to define new constants, we have to allow for expanding the size of the
482
table at run time.
483
@<Common...@>=
484
485
IN_COMMON BUF_SIZE delta_dots; // Expand the table in increments of this size.
486
IN_COMMON BUF_SIZE ndots; // The current total size.
487
IN_COMMON DOTS HUGE *dots,HUGE *dots_end,HUGE *next_dot; // The dynamic array.
488
489
@ Here we do the initial allocation of the dynamic |dots| table.
490
@<Allocate dynamic...@>=
491
{
492
DOTS HUGE *d;
493
494
ALLOC(DOTS,dots,ABBREV(delta_dots),delta_dots,0);
495
ndots = delta_dots; /* Initialize total size. */
496
dots_end = dots + ndots;
497
next_dot = dots; /* Current pointer. */
498
499
/* Fill the table with the initial values. */
500
for(d=dots0; d->len != 0; d++)
501
{
502
if(dot_code(dots,d->symbol,d->symbol+d->len,d->code) != d->code)
503
CONFUSION("dots allocation","Invalid dot code");
504
}
505
}
506
507
@ Either case is allowed for the dot constants. We will convert everything
508
between the dots in place to upper case.
509
510
@<Part 1@>=@[
511
512
ASCII HUGE *
513
uppercase FCN((p,n))
514
ASCII HUGE *p C0("Start of text.")@;
515
int n C1("Number of bytes to convert in place.")@;
516
{
517
int k;
518
519
for(k=0; k<n; ++k)
520
p[k] = A_TO_UPPER(p[k]); /* Convert $n$~bytes in place. */
521
522
return p; /* Return beginning address of string. */
523
}
524
525
@ The following routine simply determines whether a decimal point begins a dot
526
constant; this is used in parsing potential decimal constants.
527
528
@<Part 1@>=@[
529
530
boolean
531
is_dot(VOID)
532
{
533
ASCII HUGE *p;
534
int n;
535
ASCII temp[MAX_DOT_LENGTH]; /* For converting the putative constant to
536
upper case. */
537
538
/* Scan to the end of the dot constant (all of which are alphabetic). */
539
for(p=loc,n=0; n<MAX_DOT_LENGTH; n++,p++)
540
if(*p==@'.' || !isAlpha(*p))
541
break;
542
543
if(*p != @'.' || p==loc)
544
return NO; /* It wasn't stopped by a period, or
545
the scan didn't even get started, so it
546
can't be a dot constant. */
547
548
STRNCPY(temp,loc,n);
549
return BOOLEAN(CHOICE(dot_code(dots,uppercase(temp,n),temp+n,dot_const),
550
YES,NO));
551
}
552
553
@ Is it in a |DOTS| list? If so, return the associated code. If it is not,
554
add it to the table. (This was required by \FORTRAN-90.) If necessary,
555
enlarge the table.
556
557
@<Part 1@>=@[
558
559
eight_bits
560
dot_code FCN((d0,p0,p1,new_code))
561
DOTS HUGE *d0 C0("|DOTS| array.")@;
562
CONST ASCII HUGE *p0 C0("Start of text.")@;
563
CONST ASCII HUGE *p1 C0("End of text.")@;
564
eight_bits new_code C1("May we extend the table or not?")@;
565
{
566
DOTS HUGE *d;
567
568
re_dot:
569
for(d=d0; d < next_dot; d++)
570
if(web_strcmp(d->symbol,d->symbol+d->len,p0,p1) == EQUAL)
571
{
572
/* Check for an overloaded operator. If so, remember the details. */
573
if(d->code == dot_const)
574
{
575
STRCPY(dot_op.name+1,d->symbol);
576
dot_op.cat = d->cat;
577
dot_op.num = (eight_bits)(d-dots);
578
}
579
580
return d->code;
581
}
582
583
/* Didn't find the dot constant or operator in the table. Enlarge the table
584
if necessary. */
585
if(!new_code) return NO; /* One can add to |dots|, but not |mcmds|. */
586
587
if(next_dot == dots_end)
588
{
589
if( (dots=(DOTS HUGE *)REALLOC(dots,
590
(ndots+delta_dots)*sizeof(DOTS), ndots*sizeof(DOTS)))==NULL )
591
OVERFLW("dot operators",ABBREV(delta_dots));
592
593
next_dot = dots + ndots; /* Next available position. */
594
ndots += delta_dots; /* New total length. */
595
dots_end = dots + ndots; /* Upper bound. */
596
}
597
598
/* Add operator to table. */
599
next_dot->len = PTR_DIFF(short, p1, p0);
600
next_dot->symbol = GET_MEM("next_dot->symbol",next_dot->len + 1,ASCII);
601
STRNCPY(next_dot->symbol,p0,next_dot->len);
602
next_dot->code = new_code; /* Mark as overloaded, or initialize. */
603
next_dot->cat = 1; /* ??? */
604
d0 = next_dot++;
605
next_dot->len = 0;
606
goto re_dot;
607
}
608
609
@ Is it a macro preprocessor command in a |DOTS| list?
610
611
@<Part 1@>=@[
612
613
eight_bits
614
is_mcmd FCN((d0,p0,p1))
615
DOTS HUGE *d0 C0("|DOTS| array.")@;
616
CONST ASCII HUGE *p0 C0("Start of text.")@;
617
CONST ASCII HUGE *p1 C1("End of text.")@;
618
{
619
DOTS HUGE *d;
620
621
for(d=d0; d->code; d++)
622
if(web_strcmp(d->symbol,d->symbol+d->len,p0,p1) == EQUAL)
623
return d->code;
624
625
return 0; // Not a preprocessor command.
626
}
627
628
629
@* INPUT ROUTINES.
630
The lowest level of input to the \.{WEB} programs is
631
performed by |input_ln|, which must be told which file to read from.
632
Unlike the original \WEB s, there is a separate input buffer for each
633
possible open file, as well as associated parameters for each buffer. These
634
parameters are collected in an array of structures of type \&{INPUT\_PRMS},
635
which contains symmetric entries for both input files and change files.
636
The parameters for the current file are in |*cur0_prms| and are set upon
637
entry to |input_ln|. This change was necessary in order to accomodate
638
\Fortran, which, since it reads ahead, leaves stuff in the tail end of the
639
buffer, to be read on the next call to |input_ln|. If one doesn't have
640
separate buffers, the change file mechanism won't work properly, nor will
641
the include facility.
642
643
The return value of |input_ln| is |YES| if the read is successful and |NO| if
644
not (generally this means the file has ended). The conventions
645
of \TeX\ are followed; i.e., the characters of the next line of the file
646
are translated to |ASCII| code and copied into the |cur_buffer| array,
647
and the global variable |limit| is set to the first unoccupied position.
648
Trailing blanks are ignored. The value of |limit| must be strictly less
649
than |buf_size|, so that |cur_buffer[buf_size-1]| is never filled.
650
651
We assume that none of the |ASCII| values of |*j| for |cur_buffer<=j<limit|
652
is equal to~0, |0177|, |line_feed|, |form_feed|, or |carriage_return|.
653
Since |buf_size| is strictly less than |long_buf_size|,
654
some of \.{WEB}'s routines use the fact that it is safe to refer to
655
|*(limit+2)| without overstepping the bounds of the array.
656
657
658
@m fp cur0_prms->File /* The current file pointer. (It's~\.{@@m} instead
659
of~\.{@@d} because of a header conflict on the C370 system.) */
660
661
@<Common...@>=
662
663
IN_COMMON BUF_SIZE buf_size; // Holds input line.
664
665
IN_COMMON ASCII HUGE *loc;
666
// Points to the next character to be read from the buffer.
667
668
typedef enum {START,END} DELIM_TYPE;
669
typedef enum {NO_CMNT,SHORT_CMNT,LONG_CMNT} CMNT_TYPE;
670
671
typedef struct
672
{
673
CMNT_TYPE type;
674
DELIM_TYPE delim;
675
eight_bits len; // Length of the delimiter; either~$0$, $1$, or~$2$.
676
ASCII HUGE *pos; // Start of the delimiter.
677
} CMNT_DATA;
678
679
#define CMNT_MARKS 50
680
681
IN_COMMON CMNT_DATA posns[CMNT_MARKS], HUGE *pcmnt CSET(posns),
682
HUGE *pcmnt_end CSET(posns+CMNT_MARKS);
683
684
@*1 Reading an input line.
685
In the unlikely event that your standard I/O library does not support
686
|feof|, |getc| and |ungetc| you may have to change things here.
687
@^system dependencies@>
688
689
The |input_ln| function copies a line into |cur_buffer| or returns |NO| if it's
690
gotten to the end-of-file.
691
692
@<Part 1@>=@[
693
694
boolean
695
input_ln FCN((p0))
696
INPUT_PRMS0 HUGE *p0 C1("Which structure describes the current file?")@;
697
{
698
cur0_prms = p0; // Address of current parameters.
699
limit = cur_buffer; /* Initialize the top to the bottom. |limit| points to
700
first unfilled position. */
701
702
cur_line++; /* A separate line count is kept for each file (including the
703
change file). */
704
705
/* |column_mode| and |parsing_mode| may be redundant. But don't mess with
706
these. */
707
if(!nuweb_mode && FORTRAN_LIKE(language) && column_mode && parsing_mode==OUTER)
708
switch(language)
709
{
710
case FORTRAN:
711
case FORTRAN_90:
712
if(!rd_Fortran())
713
return NO;
714
break;
715
716
case RATFOR:
717
case RATFOR_90:
718
if(!rd_Ratfor())
719
return NO;
720
721
if(limit==cur_buffer)
722
goto empty_line;
723
break;
724
725
default:
726
CONFUSION("input_ln",
727
"Invalid FORTRAN_LIKE language %i", language);
728
}
729
else
730
if(!rd_free_form())
731
return NO;
732
733
/* Take care of an empty line: kill the semicolon. (This is a bit shaky.) */
734
if(column_mode && FORTRAN_LIKE(language) &&
735
PTR_DIFF(size_t,limit,cur_buffer)==2 &&
736
((!auto_semi && (cur_buffer[1]==@';' || cur_buffer[1]==@' ')) ||
737
(auto_semi && cur_buffer[1]==@';' && (cur_buffer[0]=='C' ||
738
cur_buffer[0]==@'c' || cur_buffer[0]==@'*'))))
739
empty_line:
740
limit = cur_buffer;
741
742
@#if 0
743
fin_line:
744
;
745
@#endif /* For future use. */
746
747
#if(DEBUG)
748
@<Echo the line to be returned from |input_ln|@>;
749
#endif
750
751
return YES; /* Successful read */
752
}
753
754
@ For debugging purposes, echo the line which will be returned. For the
755
benefit of the user, replace the |begin_comment0| by~'\.{!}' and
756
|begin_comment1| by~'\.?'. Turn on this echo with the command-line
757
option~'\.{-l}'. A positive numeric argument means only start debugging at
758
that line number; a negative one means also print the address of the
759
buffer.
760
761
@<Other...@>=
762
763
IN_COMMON long start_line CSET(1);
764
// Must be |long|; a negative value is used as a flag.
765
IN_COMMON long end_line CSET(LONG_MAX);
766
767
@
768
@<Echo the line...@>=
769
{
770
register ASCII HUGE *k;
771
772
if(prn_input_lines && cur_line >= (LINE_NUMBER)start_line
773
&& cur_line < (LINE_NUMBER)end_line)
774
{
775
if(prn_input_addresses)
776
printf("%lu->%lu (%u) ",
777
(unsigned long)cur_buffer,(unsigned long)limit,
778
PTR_DIFF(unsigned, limit, cur_buffer));
779
780
printf("%c[%d%s:%u]: \"",
781
(language == global_language ? ' ' : *LANGUAGE_CODE(language)),
782
incl_depth,
783
(changing ? "*" :""),
784
cur_line);
785
786
for(k=cur_buffer; k<limit; ++k)
787
switch(*k)
788
{
789
case (ASCII)begin_comment0:
790
printf("</*>");
791
break;
792
793
case (ASCII)begin_comment1:
794
printf("<//>");
795
break;
796
797
case interior_semi:
798
printf("<;>");
799
break;
800
801
default:
802
putchar(XCHR(*k));
803
break;
804
}
805
806
puts("\"");
807
}
808
}
809
810
@*1 Free-form input.
811
The simplest, most straightforward thing to do is read
812
completely free-form syntax. This is done for~C and for \RATFOR-77. Here is
813
one of the clearest examples of when to prefix single-quoted characters
814
with~'\.{@@}'.
815
816
@<Part 1@>=@[
817
818
boolean
819
rd_free_form(VOID)
820
{
821
register int c='\0'; // The character read.
822
register ASCII HUGE *k; // Where next character goes.
823
824
@<Read free-form syntax@>@;
825
826
return YES;
827
}
828
829
@
830
@<Read free...@>=
831
{
832
if(num_in_buffer != 0)
833
@<Flush \Fortran\ buffer.@>@;
834
else
835
{
836
if (feof(fp))
837
return NO; // We have hit end-of-file.
838
839
@<Read by bytes@>;
840
@#if(0)
841
@<Read by records@>;
842
@#endif /* For speeding up input; not debugged. */
843
}
844
}
845
846
@ This is the original byte-oriented input routine. It is ANSI-compatible.
847
However, on some systems such as VAX/VMS, it may be slow.
848
849
@d TOO_LONG
850
{
851
FATAL(C, "Input line too long; ",
852
"please use the `-ybs...' option to increase buffer size from \
853
its present value of %lu characters.",
854
buf_size);
855
}
856
857
@<Read by bytes@>=
858
{
859
k = cur_buffer; /* beginning of buffer */
860
861
@#if 0
862
if(column_mode && language==TEX)
863
{ // Make each line a short comment.
864
*k++ = @'/'; @~ *k++ = @'/';
865
}
866
@#endif
867
868
while (k<=buffer_end && (c=getc(fp)) != EOF && c!='\n')
869
if ((*(k++) = XORD(c)) != @' ') limit = k; /* Update first unfilled
870
position; |k|~is now pointing to next position to fill, and the last one
871
wasn't blank. */
872
873
if (k>buffer_end)
874
if ((c=getc(fp))!=EOF && c!='\n')
875
{
876
ungetc(c,fp); loc=cur_buffer; TOO_LONG;
877
@.Input line too long@>
878
}
879
880
if (c==EOF && limit==cur_buffer)
881
return NO; // There was nothing after the last newline.
882
}
883
884
@ This is an experimental block to speed up the input. It is not complete.
885
For VAX/VMS, it works only for files with variable length record formats,
886
not with stream files.
887
@<Read by records@>=
888
@B
889
int n;
890
891
@b
892
for(k = cur_buffer; k < buffer_end &&
893
(n = fread(k,buffer_end-k,fp))!=0 &&
894
k[n-1]!='\n'; k += n);
895
896
k += n;
897
898
if(k==buffer_end && *(k-1) != '\n')
899
{
900
loc = cur_buffer;
901
TOO_LONG;
902
}
903
904
#if(TRANSLATE_ASCII)
905
TERMINATE(cur_buffer,n);
906
to_ASCII(cur_buffer);
907
#endif
908
909
910
while(*(k-1)==@'\n' && k > cur_buffer) k--;
911
while(*(k-1)==@' ' && k > cur_buffer) k--;
912
913
limit = k;
914
915
if(n==0 && limit==cur_buffer) return NO;
916
}
917
918
@*1 \Fortran\ input.
919
It's probably hopeless to explain the present version
920
of the \FORTRAN\ input driver. It should be abandoned and rewritten from
921
scratch. The best that can be said about \FORTRAN\ with \FWEB\ is that one
922
should use \RATFOR\ instead.
923
924
The problem with \FORTRAN's fixed column format is that we must read ahead to
925
get any continuation lines which may be waiting. By the time we've figured
926
that out, we've read too far. We leave that stuff waiting, signified by
927
|num_in_buffer != 0|. On the next time into |input_ln|, the waiting stuff
928
will first be moved to the beginning of the buffer; then we go on and read
929
ahead some more.
930
931
In the following, |limit|~is the next available space in the buffer, |k|~is
932
the present position; |k0|~marks the beginning of the last line read. Each
933
line is actually 5~bytes longer than the actual number of characters read:
934
2~bytes for a possible |"*/"|, 3~for use by the scanning routines of
935
\TANGLE, which may put things there during its scans.
936
937
@d N_WORK 3
938
@d N_END (N_WORK+2)
939
940
@<Part 1@>=@[
941
942
boolean
943
rd_Fortran(VOID)
944
{
945
register int c='\0'; // The character read.
946
register ASCII HUGE *k; // Where next character goes.
947
boolean first_line = YES;
948
949
/* We're starting afresh; initialize flags. */
950
last_was_continued = NO;
951
scanning_C_cmnt = NO;
952
string_char = '\0';
953
in_char_string = NO;
954
955
/* Keep reading lines until we sense a non-comment, non-continuation line.
956
Leave the latter waiting in the buffer starting at~|k0|. */
957
for(k= limit; ; k=k0 = (limit+=N_END),first_line=NO,cur_line++)
958
if(num_in_buffer == 0)
959
@<Append to buffer.@>@;
960
else
961
@<Fill buffer from previous read.@>@;
962
963
/* Except for new module, throw away all stuff after \.{@@}~command in
964
column~1. */
965
if(*cur_buffer==@'@@' && !(limit==cur_buffer+1 || *(cur_buffer+1)==@'*' ||
966
*(cur_buffer+1)==@' '))
967
for(k=cur_buffer+2; k<limit; ++k)
968
if(*k == @';')
969
{
970
@#if(0)
971
limit = k;
972
@#endif
973
*k = @' ';
974
break;
975
}
976
977
return YES;
978
}
979
980
@ If |num_in_buffer == 0| on entry to |input_ln|, there's the beginning of
981
a line already waiting. That line starts at~|k0|. Here, we move it to the
982
beginning of the buffer.
983
984
@<Fill buffer from previous...@>=
985
{
986
@<Flush \Fortran\ buffer.@>;
987
988
/* If what was waiting was a control line, we must shift out of column mode. */
989
if(found_at)
990
{
991
out_of_column_mode:
992
found_at = column_mode = last_was_empty = NO;
993
break; /* Break out of |for| loop which reads lines. The finish-read
994
material is moot. */
995
}
996
997
if(at_line)
998
{
999
last_was_empty = NO;
1000
break;
1001
}
1002
1003
/* Finally, we give special treatment to empty lines. */
1004
last_was_empty = BOOLEAN(limit==cur_buffer);
1005
scan_for_cmnts();
1006
} /* Go back to the |for| loop which reads lines. */
1007
1008
@ Here we move stuff waiting in the buffer to the beginning of the buffer,
1009
and reset the end of the buffer.
1010
1011
@<Flush \Fortran\ buffer.@>=
1012
{
1013
STRNCPY(cur_buffer,k0,num_in_buffer); // Move line to beginning of buffer.
1014
k0 = cur_buffer; // For |scan_for_cmnts|
1015
limit = cur_buffer + num_in_buffer - N_END; // Reposition the end of buffer.
1016
num_in_buffer = 0; // We've now cleaned out the buffer.
1017
}
1018
1019
@ We get to here when |num_in_buffer == 0|.
1020
@<Append to buffer.@>=
1021
@B
1022
int i;
1023
1024
@b
1025
if (feof(fp))
1026
{
1027
if(first_line)
1028
return NO; // We have hit end-of-file.
1029
else
1030
goto concatenate_cmnts; // Don't lose the last line.
1031
}
1032
1033
k0 = limit; // Set the start of this line to the end of the old one.
1034
1035
@<Read \Fortran\ line.@>; // |limit| is positioned after the last char.\ read.
1036
1037
/* We will allow two extra characters at the end, in case we need to put
1038
end-of-comment markers there; we also need two bytes for Tangle's workspace. */
1039
MEMSET(limit,@' ',N_END);
1040
num_in_buffer = 0; // There's nothing waiting.
1041
1042
/* If we've read into a |new_module| command in column~1,
1043
prepare to switch out of column mode. */
1044
at_line = BOOLEAN(*k0==@'@@' && *(k0+1) != @'/');
1045
1046
if(at_line && (*(k0+1)==@'*' || *(k0+1)==@' '))
1047
found_at = YES;
1048
1049
/* If we were appending, then we must delay shifting out of column mode until
1050
we process the first part of the buffer. However, if we're actually at the
1051
beginning of the buffer, then we must shift out of column mode immediately. */
1052
if(found_at && k0==cur_buffer)
1053
goto out_of_column_mode;
1054
1055
if(first_line && at_line)
1056
break;
1057
1058
/* Now we look at the line we just put into the buffer. Usually, we should
1059
look at that to see whether it's a continuation or a comment line, because if
1060
so we keep on reading. However, if it's a command line, or if we're in the
1061
middle of handling a trailing C~comment which didn't end on the previous
1062
line, then this line should not be treated in column mode. */
1063
if(scanning_C_cmnt)
1064
{
1065
scan_for_cmnts();
1066
continue;
1067
}
1068
1069
if(!(at_line || scanning_C_cmnt))
1070
@<Check for comment or continuation.@>@;
1071
1072
/* If we get to here, it's neither a comment nor a continuation. If this line
1073
was the first in the buffer, we must continue to read more. (However,
1074
if this line is null, then we do not read any more, because we don't want to
1075
concatenate a null comment to the previous line.) Otherwise, we're
1076
done reading and we should leave this line waiting in the buffer. */
1077
neither_cmnt_nor_continuation:
1078
if(first_line)
1079
if(limit==cur_buffer) /* Quit on null first line. */
1080
{
1081
comment_in_buffer = NO;
1082
num_in_buffer = 0;
1083
break;
1084
}
1085
else
1086
{
1087
scan_for_cmnts();
1088
continue; /* We must read some more to see if next is
1089
continuation. */
1090
}
1091
1092
@<Finish reading lines.@>;
1093
}
1094
1095
@ This is the end of this read. Replace the newline by a semicolon to
1096
delimit the statements.
1097
1098
@<Finish read...@>=
1099
{
1100
last_of_read:
1101
if(!first_line)
1102
{
1103
num_in_buffer = PTR_DIFF(size_t,limit,k0) + N_END;
1104
limit = MAX(k0 - N_WORK,cur_buffer);
1105
}
1106
else limit += N_WORK;
1107
1108
concatenate_cmnts:
1109
anlz_cmnts(); // Concatenate comments appropriately, and set |scanning_C_cmnt|.
1110
1111
cur_line--;
1112
break; /* Break out of |for| loop. */
1113
}
1114
1115
@ Read characters for one line into buffer, translating them as we go.
1116
Trailing blanks will be ignored. Tabs will be translated into 6~spaces.
1117
1118
@d IS_POINT(c)
1119
(c=='!' && (point_comments || (c1=getc(fp),ungetc(c1,fp),c1=='!' )))
1120
1121
@<Read \Fortran\ line.@>=
1122
{
1123
if(ignore_C)
1124
@<Ignore single-line comments@>@;
1125
1126
while(k<=buffer_end && (c=getc(fp)) != EOF && c!='\n')
1127
if(c=='\t' && k<=buffer_end-6)
1128
for(i=0; i<6; ++i)
1129
*(k++) = @' ';
1130
// Translate tab character. (Don't update |limit|.)
1131
else
1132
{
1133
boolean escaped_char = NO;
1134
outer_char c1; // For looking ahead for \.{!!}.
1135
1136
if(c==';')
1137
c = XCHR(interior_semi);
1138
else if(point_comments && (*k0 != @'@@') &&
1139
(escaped_char = BOOLEAN(c == '\\')))
1140
{
1141
c = getc(fp); // What's coming up next?
1142
1143
/* If it's not an escaped point, just copy the escape sequence. */
1144
if(c != '!')
1145
{
1146
ungetc(c,fp);
1147
c = '\\';
1148
}
1149
}
1150
1151
/* A point that's not escaped begins a short comment. */
1152
if( (*(k++) = CHOICE(IS_POINT(c) && !escaped_char,
1153
(ASCII)begin_comment1, XORD(c))) != @' ')
1154
limit = k; // Ignore trailing blanks.
1155
}
1156
1157
if (k>buffer_end)
1158
if ((c=getc(fp))!=EOF && c!='\n')
1159
{
1160
ungetc(c,fp); loc=cur_buffer; TOO_LONG;
1161
@.Input line too long@>
1162
}
1163
1164
if (c==EOF && limit==cur_buffer) return NO; /* there was nothing after
1165
the last newline */
1166
}
1167
1168
@ Here we examine the line most recently read to see if it's a comment or
1169
continuation. If that's true, then we continue to the bottom of the
1170
enclosing |for| loop which reads lines.
1171
1172
@<Check for comment or cont...@>=
1173
@B
1174
boolean is_cmnt = NO, Fortran_cmnt = NO, C_cmnt = NO;
1175
1176
ASCII HUGE *p = k0; // Points to the comment character.
1177
1178
@b
1179
/* Did we get a comment line? */
1180
switch(*k0)
1181
{
1182
case @'C':
1183
case @'c':
1184
case @'*':
1185
case (ASCII)begin_comment0:
1186
case (ASCII)begin_comment1:
1187
is_cmnt = Fortran_cmnt = YES;
1188
break;
1189
1190
default:
1191
/* Skip over white space at beginning of line. */
1192
for(; p<limit; p++)
1193
if(*p!=@' ')
1194
break;
1195
1196
if( (*p==@'/' && (*(p+1)==@'*'
1197
|| (*(p+1)==@'/' && Cpp_comments && !ignore_C)))
1198
|| *p == (ASCII)begin_comment0
1199
|| *p == (ASCII)begin_comment1)
1200
is_cmnt = C_cmnt = YES;
1201
break;
1202
}
1203
1204
if(is_cmnt)
1205
@<Process comment line.@>@;
1206
1207
/* If we're this far, it's not a comment. Check for continuation line
1208
(neither blank nor |'0'| in column~6). If
1209
so, shift it over to abut it with previous stuff in buffer. */
1210
if(limit-k0 >=5 && !(k0[5] == @' ' || k0[5]==@'0') )
1211
@<Process possible continuation line.@>@;
1212
}
1213
1214
1215
@ If the |ignore_C| flag is on (\.{-nC} option), we simple skip a
1216
single-line \Fortran\ comment.
1217
1218
@<Ignore single-line comment...@>=
1219
{
1220
first_char:
1221
c = getc(fp); // First character in line.
1222
1223
switch(c)
1224
{
1225
case '!':
1226
if(!point_comments)
1227
{
1228
ungetc(c, fp);
1229
break;
1230
}
1231
1232
case 'C':
1233
case 'c':
1234
case '*':
1235
while((c=getc(fp)) != EOF && c != '\n')
1236
;
1237
cur_line++;
1238
goto first_char;
1239
1240
default:
1241
ungetc(c, fp);
1242
break;
1243
}
1244
}
1245
1246
@ The line is a comment line. We give special treatment to an otherwise null
1247
comment line, treating it as a line with nothing in it at all. If the last
1248
line was a comment also, we concatenate this one with the previous one.
1249
1250
@<Process comment line.@>=
1251
{
1252
if(limit == k0+1)
1253
{ /* Null comment line. */
1254
limit = k0;
1255
1256
if(!first_line)
1257
goto last_of_read;
1258
else
1259
goto concatenate_cmnts;
1260
}
1261
1262
if(k0 > cur_buffer)
1263
MEMSET(k0-N_END,@' ',N_END);
1264
1265
if(Fortran_cmnt)
1266
*p = begin_comment1;
1267
1268
/* If the last line was empty, we don't want to read any further; leave this
1269
comment waiting in the buffer. */
1270
if(last_was_empty)
1271
{
1272
num_in_buffer = PTR_DIFF(size_t,limit,k0) + N_END;
1273
comment_in_buffer = YES;
1274
limit = cur_buffer;
1275
break; // Break out of the |for| loop which reads lines.
1276
}
1277
1278
scan_for_cmnts();
1279
continue; // Go back and read more lines.
1280
}
1281
1282
1283
@ The line is a possible continuation line; namely, it has something in
1284
column~6. However, if we're in the midst of a trailing C~comment or if an
1285
alphanumeric label extends into column~6, then it's not a continuation. We
1286
check for these possibilities by seeing whether there's anything in columns
1287
1--5.
1288
1289
@<Process possible continuation...@>=
1290
@B
1291
register ASCII HUGE *l;
1292
boolean stuff_in_1_5;
1293
1294
@b
1295
if(first_line)
1296
{/* Error: Continuation line not expected. */
1297
scan_for_cmnts();
1298
continue;
1299
}
1300
1301
/* We don't allow anything in columns 1--5 for a continuation line. That's
1302
a FORTRAN rule, and it helps us to catch a possible continuation of a
1303
C-style comment. */
1304
stuff_in_1_5 = NO;
1305
1306
for(l=k0;l<k0+5; ++l)
1307
if(*l != @' ')
1308
{
1309
stuff_in_1_5 = YES;
1310
break;
1311
}
1312
1313
/* If there's stuff in columns 1--5, it's not a continuation line.
1314
Otherwise, it's a continuation line; abut it with the code in the previous
1315
line. */
1316
if(stuff_in_1_5) goto neither_cmnt_nor_continuation;
1317
1318
*l = @' '; // Delete the continuation symbol.
1319
scan_for_cmnts();
1320
continue; /* Keep on reading. */
1321
}
1322
1323
@ The following function records the status and position of a comment
1324
delimiter.
1325
1326
@<Part 1@>=@[
1327
1328
SRTN
1329
mark_cmnt FCN((type0,delim0,length0,pos0))
1330
CMNT_TYPE type0 C0("")@;
1331
DELIM_TYPE delim0 C0("")@;
1332
eight_bits length0 C0("")@;
1333
ASCII HUGE *pos0 C1("")@;
1334
{
1335
pcmnt->type = type0;
1336
pcmnt->delim = delim0;
1337
pcmnt->len = length0;
1338
pcmnt->pos = pos0;
1339
1340
if(type0 == LONG_CMNT)
1341
scanning_C_cmnt = BOOLEAN(delim0 == START);
1342
1343
pcmnt++;
1344
1345
if(pcmnt == pcmnt_end)
1346
FATAL(C, "Cmnt-buffer overflow.",
1347
" Please simplify long Fortran comment.");
1348
1349
pcmnt->type = NO_CMNT;
1350
pcmnt->delim = START;
1351
pcmnt->len = 0;
1352
pcmnt->pos = limit;
1353
}
1354
1355
@
1356
@<Glob...@>=
1357
1358
IN_COMMON ASCII string_char;
1359
IN_COMMON boolean in_char_string;
1360
1361
@
1362
1363
@d MARK(type,delim,len) mark_cmnt(type,delim,len,p)
1364
1365
@<Part 1@>=@[
1366
1367
SRTN
1368
scan_for_cmnts(VOID)
1369
{
1370
register ASCII HUGE *p;
1371
1372
for(p=k0; p<limit; p++)
1373
switch(*p)
1374
{
1375
case (ASCII)begin_comment0:
1376
if(scanning_C_cmnt)
1377
break;
1378
1379
MARK(LONG_CMNT,START,1);
1380
break;
1381
1382
case (ASCII)begin_comment1:
1383
if(scanning_C_cmnt)
1384
break;
1385
1386
MARK(SHORT_CMNT,START,1);
1387
p = limit;
1388
MARK(SHORT_CMNT,END,0);
1389
break;
1390
1391
case @'\'':
1392
case @'"':
1393
if(!scanning_C_cmnt)
1394
@<Check for \Fortran\ string@>@;
1395
break;
1396
1397
case @'/':
1398
if(in_char_string || scanning_C_cmnt)
1399
break;
1400
1401
if(*(p+1) == @'/' && Cpp_comments && !ignore_C)
1402
{
1403
MARK(SHORT_CMNT,START,2);
1404
p = limit;
1405
MARK(SHORT_CMNT,END,0);
1406
}
1407
else if(*(p+1) == @'*')
1408
{
1409
MARK(LONG_CMNT,START,2);
1410
p++;
1411
}
1412
1413
break;
1414
1415
case @'*':
1416
if(in_char_string)
1417
break;
1418
1419
if(scanning_C_cmnt && *(p+1) == @'/')
1420
{
1421
MARK(LONG_CMNT,END,2);
1422
p++;
1423
}
1424
1425
break;
1426
}
1427
}
1428
1429
@
1430
@<Check for \F...@>=
1431
{
1432
if(!in_char_string)
1433
{
1434
in_char_string = YES;
1435
string_char = *p;
1436
break;
1437
}
1438
1439
if(string_char == *p && p[1] == string_char)
1440
{
1441
p++;
1442
break;
1443
}
1444
1445
in_char_string = NO;
1446
}
1447
1448
@
1449
1450
@d BLANK_OUT(d) MEMSET((d)->pos,@' ',(d)->len)
1451
1452
@<Part 1@>=@[
1453
1454
SRTN
1455
anlz_cmnts(VOID)
1456
{
1457
CMNT_DATA *d;
1458
boolean found_text = NO;
1459
ASCII HUGE *l;
1460
1461
pcmnt->pos = limit;
1462
1463
for(d=posns + 1; d<pcmnt; d+=2)
1464
{
1465
found_text = NO;
1466
1467
for(l=d->pos+d->len; l<(d+1)->pos; l++)
1468
if(*l != @' ')
1469
{
1470
found_text = YES;
1471
break;
1472
}
1473
1474
if(found_text)
1475
{
1476
if(d->type == SHORT_CMNT)
1477
{
1478
BLANK_OUT(d-1);
1479
*((d-1)->pos) = begin_comment0;
1480
*(d->pos) = @'*';
1481
*(d->pos + 1) = @'/';
1482
}
1483
}
1484
else if(d->type == (d+1)->type)
1485
{
1486
BLANK_OUT(d);
1487
BLANK_OUT(d+1);
1488
d->type = (d+1)->type = NO_CMNT;
1489
}
1490
}
1491
1492
@<Insert an automatic semicolon@>@;
1493
1494
pcmnt = posns; // Reset.
1495
}
1496
1497
@
1498
@<Scan backwards over comments@>=
1499
for(pk = k0-1; ;)
1500
if(!bscn_white() || !bscn_cmnt())
1501
break;
1502
1503
@
1504
@<Common...@>=
1505
1506
IN_COMMON ASCII HUGE *pk;
1507
1508
@
1509
@<Unused@>=
1510
1511
boolean bscn_white(VOID)
1512
{
1513
for( ; pk>=cur_buffer; --pk)
1514
if(*pk != @' ') return YES;
1515
1516
return NO;
1517
}
1518
1519
boolean bscn_cmnt(VOID)
1520
{
1521
/* Are we at end of comment? */
1522
if( !(*pk==@'/' && *(pk-1) == @'*') )
1523
{
1524
++pk; /* Copy the continuation line to here. */
1525
return NO; /* Not on white space and
1526
not on end of comment; we're done. */
1527
}
1528
1529
/* Scan backwards to beginning of comment. Must allow for both kinds
1530
of comment styles. */
1531
for(pk -=N_END; pk >= cur_buffer; --pk)
1532
if(*pk==(ASCII)begin_comment0 ||
1533
*pk==(ASCII)begin_comment1 ||
1534
(*pk==@'/' && (*(pk+1) == @'*' || *(pk+1)==@'/')))
1535
/* Found start of comment. */
1536
{
1537
--pk;
1538
return YES;
1539
}
1540
1541
return NO;
1542
}
1543
1544
@ In Fortran mode, the last thing we do before returning the line is to
1545
parse looking for comments. We want to propagate the final semicolon to
1546
just before the last comment. With this scheme, the innards of \WEAVE\ and
1547
\TANGLE\ are presented with a uniform syntax.
1548
1549
@<Common...@>=
1550
1551
IN_COMMON ASCII HUGE *lp, HUGE *semi_pos;
1552
IN_COMMON boolean found_text,text,C_style_cmnt,short_cmnt,R_style_cmnt;
1553
1554
@
1555
@<Insert an auto...@>=
1556
{
1557
boolean text_after = NO;
1558
1559
if(pcmnt > posns)
1560
{ // There's at least one comment.
1561
if(!scanning_C_cmnt)
1562
for(l=limit-1; l>(pcmnt-1)->pos + (pcmnt-1)->len; l--)
1563
if(*l != @' ')
1564
{ // There's text after the comment.
1565
text_after = YES;
1566
*(l+1) = @';';
1567
break;
1568
}
1569
1570
if(!text_after)
1571
{
1572
pcmnt -= 2;
1573
1574
if(pcmnt < posns)
1575
{
1576
ERR_PRINT(C, "Fortran comment didn't end; missing */?");
1577
pcmnt = posns;
1578
}
1579
1580
while(pcmnt->type == NO_CMNT)
1581
{
1582
pcmnt--;
1583
1584
if(pcmnt < posns)
1585
CONFUSION("Insert an automatic semicolon",
1586
"Invalid comment structure");
1587
}
1588
1589
while(pcmnt >= posns)
1590
{
1591
ASCII HUGE *lmin;
1592
1593
if(pcmnt == posns)
1594
lmin = cur_buffer;
1595
else
1596
lmin = (pcmnt-1)->pos + (pcmnt-1)->len;
1597
1598
for(l=pcmnt->pos - 1; l>=lmin; l--)
1599
{
1600
if(*l != @' ')
1601
{ // There's text before the comment.
1602
semi_pos = pcmnt->pos;
1603
@<Fill in semi@>@;
1604
goto done_auto_insert;
1605
}
1606
}
1607
1608
pcmnt -= 2;
1609
}
1610
}
1611
}
1612
else
1613
{ // No comments at all.
1614
for(l=limit-1; l>=cur_buffer; l--)
1615
if(*l != @' ')
1616
{
1617
*(l+1) = @';';
1618
break;
1619
}
1620
}
1621
1622
done_auto_insert:
1623
;
1624
}
1625
1626
@ Here we put in the semicolon. We have to watch out for a preceding
1627
`\.{@@}' sign, which signifies a verbatim comment.
1628
@<Fill in semi@>=
1629
{
1630
*(semi_pos+1) = (ASCII)(((pcmnt+1)->type==LONG_CMNT ? begin_comment0 :
1631
begin_comment1)); /* If the comment was started by
1632
|begin_comment0| or |begin_comment1|, this overwrites the character
1633
after that. (We
1634
have to make room for the semicolon.) If we want to cure this, we
1635
must do more copying. */
1636
1637
if(semi_pos > cur_buffer && *(semi_pos-1) == @'@@') /* A verbatim comment. */
1638
{
1639
*(semi_pos--) = @'@@';
1640
}
1641
1642
*semi_pos = @';'; /* This overwrites the beginning of the comment marker,
1643
or the previous~\.{@@} if there was one. */
1644
1645
@<Interchange line-break and semi@>;
1646
}
1647
1648
@ As a kludge, if the Fortran line ends with an \.{@@/}, we interchange it
1649
with the semicolon.
1650
@<Interchange line-break...@>=
1651
1652
for(lp=semi_pos-1; lp>cur_buffer; lp--)
1653
{
1654
if(*lp == @' ') continue;
1655
1656
if(*lp == @'/' && *(--lp) == @'@@')
1657
{
1658
*semi_pos = @' ';
1659
*lp = @';'; @~ *(lp+1) = @'@@'; @~ *(lp+2) = @'/';
1660
}
1661
break;
1662
}
1663
1664
1665
@*1 \Ratfor\ input.
1666
1667
@<Part 1@>=@[
1668
1669
boolean
1670
rd_Ratfor(VOID)
1671
{
1672
register int c='\0'; // The character read.
1673
register ASCII HUGE *k; // Where next character goes.
1674
boolean found_semi;
1675
1676
string_char = '\0';
1677
in_char_string = NO;
1678
1679
@<Read free...@>@;
1680
1681
/* If we've read into a |new_module| command in column~1,
1682
switch out of column mode. */
1683
if(*cur_buffer == @'@@' && (limit==cur_buffer+1
1684
|| *(cur_buffer+1)==@'*' || *(cur_buffer+1)==@' '))
1685
column_mode = NO;
1686
else
1687
@<Finish Ratfor line.@>;
1688
1689
return YES;
1690
}
1691
1692
@
1693
@<Common...@>=
1694
1695
IN_COMMON ASCII HUGE *last_pos;
1696
IN_COMMON ASCII cmnt_char;
1697
1698
@ This section has to handle the completely free-form syntax as well as the
1699
``obviously continued'' syntax. The latter is more trouble than it's worth,
1700
and isn't recommended.
1701
1702
@<Finish Ratfor line.@>=
1703
{
1704
last_was_continued = continuing_line;
1705
continuing_line = NO;
1706
1707
if(limit==cur_buffer)
1708
return YES;
1709
1710
limit[0] = limit[1] = limit[2] = limit[3] = @' ';
1711
1712
cmnt_char = @'#';
1713
1714
found_semi = found_text = text = NO; /* Start off assuming we're in comment
1715
mode. */
1716
semi_pos = NULL; /* |semi_pos| will record the position of a prospective
1717
comment, to be begun by a semicolon. */
1718
1719
/* Scan the line. */
1720
if(!free_form_input && !(*cur_buffer==@'@@' && *(cur_buffer+1)==@'#'))
1721
{
1722
for(lp=cur_buffer; ;)
1723
if(!skip_Rtext() || !skp_cmnt()) break;
1724
1725
switch(*last_pos)
1726
{
1727
case @'+': case @'-': case @'*': case @'=':case @'{':case @'}':
1728
case @'^': case @'&': case @'|': case @'(': case @':':
1729
case @'>': case @'<': case @'[': case @',': case @'\\':
1730
continuing_line = YES;
1731
break; /* Line is continued. */
1732
1733
/* Ratfor's continuation character. */
1734
case @'_':
1735
if(last_pos > cur_buffer)
1736
{
1737
ASCII c;
1738
1739
c = *(last_pos-1);
1740
if(isAlpha(c) || isDigit(c) ||
1741
c==@'_' || c==@'$')
1742
goto not_continuation;
1743
}
1744
*last_pos = @' ';
1745
continuing_line = YES;
1746
break;
1747
1748
default:
1749
not_continuation:
1750
if(!auto_semi)
1751
break;
1752
1753
/* If the last construction is a comment (|!text|) and there was actually
1754
some text (|semi_pos!=NULL|),
1755
replace ``\.{\slashstar}'' by |';'| and |begin_comment0| or
1756
|begin_comment1|. */
1757
if(!text && semi_pos!=NULL) @<Fill in semi@>@;
1758
else if(found_text && limit > cur_buffer) *limit++ = @';';
1759
/* Line ended. */
1760
break;
1761
}
1762
}
1763
}
1764
1765
@ This nucleus skips over text in a line, stopping if it finds a comment.
1766
1767
@d is_C_style_cmnt (C_style_cmnt = ((short_cmnt = Cpp_comments && *lp ==
1768
@'/' && *(lp+1) == @'/')) || (*lp == @'/' && *(lp+1) == @'*') )
1769
1770
@d start_comment (is_C_style_cmnt || (*lp == (char)begin_comment0)
1771
|| (*lp == (char)begin_comment1) )
1772
1773
@<Unused@>=
1774
1775
boolean skip_Ftext(VOID)
1776
{
1777
@<Begin skipping text@>;
1778
1779
/* If we haven't found a comment, set mode to text. */
1780
if(!start_comment)
1781
{
1782
found_text = text = YES;
1783
++lp;
1784
}
1785
1786
/* Scan to a comment. */
1787
for(; lp<limit; ++lp)
1788
if(start_comment)
1789
if(++lp < limit) return YES;
1790
1791
return NO;
1792
}
1793
1794
@ This nucleus skips over text in a line, stopping if it finds a comment.
1795
1796
@d start_Rcomment ( (R_style_cmnt=BOOLEAN(*lp==cmnt_char &&
1797
*(lp+1)!=cmnt_char && *(lp-1)!=cmnt_char &&
1798
!(*(lp-1)==@'@@'))) || is_C_style_cmnt)
1799
1800
@<Part 1@>=@[
1801
boolean skip_Rtext(VOID)
1802
{
1803
static ASCII blank = @' ';
1804
1805
@<Begin skipping text@>;
1806
1807
last_pos = ␣
1808
1809
/* If we haven't found a comment, set mode to text. */
1810
if(!start_Rcomment)
1811
{
1812
found_text = text = YES;
1813
}
1814
1815
/* Scan to a comment. */
1816
for(; lp<limit; lp++)
1817
{
1818
if(start_Rcomment)
1819
{
1820
if(R_style_cmnt)
1821
{
1822
*lp = cmnt_char = begin_comment0;
1823
*limit++ = @'*'; @~ *limit++ = @'/';
1824
}
1825
if(++lp < limit) return YES;
1826
}
1827
1828
if(*lp != @' ' && *lp != tab_mark)
1829
last_pos = lp; /* Remember last non-blank position. */
1830
}
1831
1832
return NO;
1833
}
1834
1835
@
1836
@<Begin skipping ...@>=
1837
1838
if(scanning_C_cmnt) return YES; /* Make sure |skp_cmnt| is the first to be
1839
executed. */
1840
1841
/* Start scanning at the current position. Skip over white space. */
1842
for(; lp<limit; ++lp)
1843
if(!(*lp==@' ' || *lp==tab_mark)) break;
1844
1845
if(lp >= limit) return NO; /* The line was all white space. */
1846
1847
@ This nucleus skips over comments. */
1848
@<Part 1@>=@[
1849
boolean skp_cmnt(VOID)
1850
{
1851
/* If the last mode was text, remember the position for a possible semi. */
1852
if(text) semi_pos = lp - 1;
1853
1854
text = NO; /* We're in comment mode. */
1855
scanning_C_cmnt = NO; /* Flag used to handle the next line properly if the
1856
comment runs over. */
1857
1858
/* Scan to end of comment. */
1859
if(C_style_cmnt)
1860
{
1861
if(short_cmnt)
1862
{
1863
lp = limit;
1864
return YES;
1865
}
1866
1867
for(++lp; lp<limit; lp++)
1868
{
1869
if(*lp==(ASCII)begin_comment0 || *lp==(ASCII)begin_comment1)
1870
{
1871
*lp = @'c';
1872
continue;
1873
}
1874
1875
if(*lp==@'*' && *(lp+1)==@'/')
1876
{
1877
lp += 2; /* Position after end of comment. */
1878
if(lp<=limit) return YES;
1879
}
1880
}
1881
1882
scanning_C_cmnt = YES;
1883
}
1884
else
1885
{
1886
for(++lp; lp<limit; lp++)
1887
if(*lp==(ASCII)begin_comment1)
1888
*lp = @'!';
1889
1890
*(limit-2) = @'*'; @~ *(limit-1) = @'/';
1891
}
1892
1893
return NO;
1894
}
1895
1896
@*1 Change files.
1897
Now comes the problem of deciding which file to read from
1898
next. Recall that the actual text that \.{WEB} should process comes from
1899
two streams: a |web_file|, which can contain possibly nested include
1900
commands~`\.{@@i}', and a |change_file|, which should not contain includes.
1901
The currently open files form a stack |prms|. Each entry has two
1902
components: |web| and |change|. Thus, for any open web or include file,
1903
there can be a separate change file is desired. If no change file is
1904
specified at any include level, the change file from the last level is used
1905
instead. Thus, one could have just one change file that changes entries in
1906
both the |web_file| and all of the files included into the |web_file|. The
1907
boolean |changing| tells whether or not we're reading form the
1908
|change_file|.
1909
1910
The line number of each open file is also kept for error reporting and
1911
for the benefit of \.{TANGLE}, as are various other parameters.
1912
1913
|cur0_prms| points to the parameter component, either |web| or |change|,
1914
being or just processed by |input_ln|.
1915
1916
|cur_prms| points to the current stack level, including both |web| and
1917
|change| components.
1918
1919
@d k0 cur0_prms->K0
1920
@d found_at cur0_prms->Found_at
1921
@d at_line cur0_prms->At_line
1922
1923
@ When |changing=NO|, the next line of |change_file| is kept in
1924
|change_buffer|, for purposes of comparison with the next
1925
line of |cur_file|. After the change file has been completely input, we
1926
set |change_limit=change_buffer|, so that no further matches will be made.
1927
1928
Here's a shorthand expression for inequality between the two lines:
1929
1930
@d LINES_DONT_MATCH (change_limit-change_buffer != limit-cur_buffer ||
1931
STRNCMP(cur_buffer, change_buffer, PTR_DIFF(size_t,limit,cur_buffer)))
1932
1933
@d change_params prms[incl_depth].input_params
1934
1935
@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
1936
for the next matching operation. Since blank lines in the change file are
1937
not used for matching, we have |(change_limit==NULL && !changing)| if and
1938
only if the change file is exhausted. This procedure is called only
1939
when |changing| is |YES|; hence error messages will be reported correctly.
1940
1941
@<Part 1@>=@[
1942
1943
SRTN
1944
prime_the_change_buffer(VOID)
1945
{
1946
INPUT_PARAMS input_params; // Saves incoming state.
1947
1948
input_params.Language = language;
1949
input_params.Parsing_mode = parsing_mode;
1950
input_params.Column_mode = column_mode;
1951
1952
language = change_params.Language;
1953
parsing_mode = change_params.Parsing_mode;
1954
column_mode = change_params.Column_mode;
1955
1956
change_limit = NULL; // This value will be used if the change file ends.
1957
1958
@<Skip over comment lines in the change file; |goto done_priming@;| if end
1959
of file@>;
1960
@<Skip to the next nonblank line; |goto done_priming@;| if end of file@>;
1961
1962
done_priming:
1963
language = input_params.Language;
1964
parsing_mode = input_params.Parsing_mode;
1965
column_mode = input_params.Column_mode;
1966
1967
/* After we're done priming the change buffer, we will next read from the
1968
input file. */
1969
changing = NO;
1970
cur0_prms = cur_prms.web;
1971
}
1972
1973
@ While looking for a line that begins with~\.{@@x} in the change file,
1974
we allow lines that begin with~\.{@@}, as long as they don't begin
1975
with~\.{@@y} or~\.{@@z} (which would probably indicate that the change file is
1976
fouled up).
1977
1978
@<Skip over comment lines in the change file...@>=
1979
1980
WHILE()
1981
{
1982
ASCII c;
1983
1984
if (!input_ln(CHANGE_FILE))
1985
{
1986
change_limit = NULL;
1987
goto done_priming;
1988
}
1989
1990
if (limit < cur_buffer+2) continue;
1991
// There can't be an \.{@@}~command.
1992
if (cur_buffer[0] != @'@@') continue;
1993
// Skip lines that don't start with~\.{@@}.
1994
@<Lowercasify |cur_buffer[1]|@>;
1995
@<Check for erroneous \.{@@i}@>;
1996
if ((c=cur_buffer[1])==@'x') break; // Found beginning of a change.
1997
1998
if (c==@'y' || c==@'z')
1999
{
2000
loc = cur_buffer+2; // Skip erroneous change.
2001
ERR_PRINT(C,"Where is the matching @@x?");
2002
@.Where is the match...@>
2003
}
2004
else @<Process language-related change command@>@;
2005
}
2006
2007
@
2008
@<Process language-related change...@>=
2009
{
2010
if(c==@'l')
2011
if(limit == cur_buffer+2)
2012
ERR_PRINT(C,"Missing language character after @@L");
2013
else c = cur_buffer[2];
2014
2015
switch(c)
2016
{
2017
@<|ASCII| cases for |C|@>:
2018
language = change_params.Language =
2019
(cur_buffer[2] == @'+') ? C_PLUS_PLUS : C;
2020
column_mode = change_params.Column_mode = NO;
2021
continue;
2022
2023
@<|ASCII| cases for |RATFOR|@>:
2024
if(!RAT_OK("Language change ignored")) continue;
2025
2026
language = change_params.Language =
2027
(cur_buffer[2] == @'9') ? RATFOR_90 : RATFOR;
2028
continue;
2029
2030
@<|ASCII| cases for |FORTRAN|@>:
2031
language = change_params.Language =
2032
(cur_buffer[2] == @'9') ? FORTRAN_90 : FORTRAN;
2033
continue;
2034
2035
@<|ASCII| cases for |LITERAL|@>:
2036
language = change_params.Language = LITERAL; continue;
2037
2038
@<|ASCII| cases for |TEX|@>:
2039
language = change_params.Language = TEX; continue;
2040
2041
case @'[':
2042
column_mode = change_params.Column_mode = YES;continue;
2043
2044
case @']':
2045
column_mode = change_params.Column_mode = NO;continue;
2046
2047
default:
2048
loc = cur_buffer + 2;
2049
ERR_PRINT(C,"Invalid @@ command in change file");
2050
continue;
2051
}
2052
}
2053
2054
@ This line of code makes~|"@@X"| equivalent to~|"@@x"| and so on.
2055
2056
@<Lowerc...@>=
2057
2058
if ((cur_buffer[1]>=@'X' && cur_buffer[1]<=@'Z') || cur_buffer[1]==@'I')
2059
cur_buffer[1]+=@'z'-@'Z';
2060
2061
@ We do not allow includes in a change file, so as to avoid confusion.
2062
2063
@<Check for erron...@>=
2064
2065
if (cur_buffer[1]==@'i')
2066
{
2067
loc = cur_buffer + 2;
2068
ERR_PRINT(C,"Sorry, no includes allowed in change file");
2069
@.No includes allowed...@>
2070
}
2071
2072
@ Here we are looking at lines following the~\.{@@x}.
2073
2074
@<Skip to the next nonblank line...@>=
2075
2076
do
2077
{
2078
if (!input_ln(CHANGE_FILE))
2079
{
2080
ERR_PRINT(C,"Change file ended after @@x");
2081
@.Change file ended...@>
2082
change_limit = NULL;
2083
goto done_priming;
2084
}
2085
}
2086
while (limit==cur_buffer);
2087
2088
@ The following procedure is used to see if the next change entry should go
2089
into effect; it is called only when |changing| is~|NO|. The idea is to
2090
test whether or not the current contents of |cur_buffer| matches the
2091
current contents of |change_buffer|. If not, there's nothing more to do;
2092
but if so, a change is called for: All of the text down to the~\.{@@y} is
2093
supposed to match. An error message is issued if any discrepancy is found.
2094
Then the procedure prepares to read the next line from |change_file|.
2095
2096
@<Part 1@>=@[
2097
2098
SRTN
2099
chk_change(VOID) // Switches to |change_file| if the buffers match.
2100
{
2101
int n = 0; // The number of discrepancies found.
2102
2103
if(LINES_DONT_MATCH) return; // Didn't match a change.
2104
2105
WHILE()
2106
{
2107
changing = YES; prn_where = YES;
2108
2109
if (!input_ln(CHANGE_FILE))
2110
{
2111
ERR_PRINT(C,"Change file ended before @@y");
2112
@.Change file ended...@>
2113
change_limit = NULL; changing = NO; prn_where = YES;
2114
return;
2115
}
2116
2117
@<If the current line starts with \.{@@y},
2118
report any discrepancies and |return|@>;@/
2119
changing = NO; prn_where = YES;
2120
2121
while(!input_ln(INPUT_FILE))
2122
{ /* Pop the stack or quit. */
2123
if (incl_depth==WEB_FILE)
2124
{
2125
ERR_PRINT(C,"WEB file ended during a change");
2126
@.WEB file ended...@>
2127
input_has_ended = YES; return;
2128
}
2129
2130
incl_depth--; prn_where = YES;
2131
}
2132
2133
if(LINES_DONT_MATCH) n++;
2134
}
2135
}
2136
2137
@
2138
@<If the current line starts with \.{@@y}...@>=
2139
2140
if (limit>cur_buffer+1 && cur_buffer[0]==@'@@')
2141
{
2142
@<Lowerc...@>;
2143
@<Check for erron...@>;
2144
2145
if (cur_buffer[1]==@'x' || cur_buffer[1]==@'z')
2146
{
2147
loc=cur_buffer+2;
2148
ERR_PRINT(C,"Where is the matching @@y?");
2149
@.Where is the match...@>
2150
}
2151
else if (cur_buffer[1]==@'y')
2152
{
2153
if (n>0)
2154
{
2155
loc = cur_buffer + 2;
2156
ERR_PRINT(C,"Hmm... some of the preceding lines failed to match");
2157
@.Hmm... some of the preceding...@>
2158
}
2159
return;
2160
}
2161
}
2162
2163
@ The |rst_input| procedure, which gets \.{WEAVE} ready to read the
2164
user's \.{WEB} input, is used at the beginning of both phases one and two.
2165
2166
@d ABORT_ON_ERROR YES
2167
@d DONT_ABORT_ON_ERROR NO
2168
2169
@d FCLOSE(file_ptr) if(file_ptr != stdin) fclose(file_ptr); file_ptr = NULL@;
2170
2171
@<Part 2@>=@[
2172
2173
SRTN
2174
rst_input(VOID)
2175
{
2176
FCLOSE(prms[WEB_FILE].web.File);
2177
FCLOSE(prms[WEB_FILE].change.File);
2178
2179
ini_input_prms(WEB_FILE,(outer_char HUGE *)"",ABORT_ON_ERROR);
2180
@<Reset cur\_buffer@>;
2181
2182
@<Initialize change buffer@>@;
2183
2184
incl_depth = WEB_FILE;
2185
input_has_ended = NO;
2186
}
2187
2188
@ Prepare to read from an input buffer. It positions the~|loc|
2189
after~|limit| so that a new line will be sure to be read next.
2190
2191
@<Reset cur\_buffer@>=
2192
2193
limit=cur_buffer; loc=cur_buffer+1; cur_buffer[0]=@' '@;
2194
2195
@
2196
@<Glob...@>=
2197
2198
IN_COMMON INPUT_PARAMS change_params0
2199
#if(part == 0 || part == 1)
2200
= {FORTRAN,OUTER,NO}
2201
#endif
2202
;
2203
2204
@
2205
@<Initialize change...@>=
2206
{
2207
cur0_prms = cur_prms.change;
2208
changing = YES;
2209
change_params = change_params0; // Reset to default values.
2210
prime_the_change_buffer();
2211
@<Reset cur\_buffer@>;
2212
}
2213
2214
@*1 Initializing input files.
2215
Whenever a new input file is opened, we must
2216
allocate a buffer, and initialize parameters. This routine initializes
2217
both the \WEB\ file and the change file for a particular include level.
2218
@^system dependencies@>
2219
2220
@
2221
@<Initialize static...@>=
2222
{
2223
ALLOC(INPUT_PRMS, prms, ABBREV(max_include_depth), max_include_depth, 1);
2224
}
2225
2226
@ Although the |prms| array had to be allocated before scanning the command
2227
line (with the default |DFLT_MAX_INCLUDE_DEPTH|), the \.{-y}~option might
2228
have requested a change in size. If so, we reallocate the array.
2229
2230
@<Allocate dynamic...@>=
2231
{
2232
BUF_SIZE cur_prms_units;
2233
2234
alloc(OC("id"), &cur_prms_units, 0, -1); // What is current allocation?
2235
2236
if(cur_prms_units != DFLT_MAX_INCLUDE_DEPTH)
2237
prms = (INPUT_PRMS *)REALLOC(prms,
2238
(cur_prms_units + 1)*sizeof(INPUT_PRMS),
2239
(DFLT_MAX_INCLUDE_DEPTH+1)*sizeof(INPUT_PRMS));
2240
}
2241
2242
@
2243
@<Part 2@>=@[
2244
2245
boolean
2246
ini_input_prms FCN((ilevel,path,quit_on_error))
2247
int ilevel C0("Present level of input files.")@;
2248
outer_char HUGE *path C0("Colon-delimited path list")@;
2249
boolean quit_on_error C1("Abort flag.")@;
2250
{
2251
INPUT_PRMS HUGE *p = &prms[ilevel];
2252
CUR_PRMS old_prms;
2253
boolean web_level = BOOLEAN(ilevel==WEB_FILE);
2254
2255
old_prms = cur_prms; // Save state in case of error.
2256
2257
/* Initialize this here in case of error messages. */
2258
cur_prms.web = &p->web;
2259
cur_prms.change = &p->change;
2260
2261
/* Initialize both input and change files; abort if error. */
2262
if(!(ini0_input_prms(cur_prms.web,path,OC("input"),quit_on_error,
2263
(SEQUENCES *)(web_level ? wt_style.input_ext.web :
2264
wt_style.input_ext.hweb)) &&
2265
ini0_input_prms(cur_prms.change,path,OC("change"),quit_on_error,
2266
(SEQUENCES *)(web_level ? wt_style.input_ext.change :
2267
wt_style.input_ext.hchange))))
2268
{
2269
cur_prms = old_prms; // Restore old state if error.
2270
return NO;
2271
}
2272
2273
/* For definiteness we set |cur0_prms| to the web input file. */
2274
cur0_prms = cur_prms.web;
2275
loc = cur_buffer;
2276
2277
/* Remember the name of the include file, for use by \WEAVE. */
2278
STRCPY(this_include_file,web_level ?
2279
(CONST outer_char *)"" : p->web.File_name);
2280
2281
return YES;
2282
}
2283
2284
@ This function initializes either a web file or a change file.
2285
@<Part 2@>=@[
2286
2287
boolean
2288
ini0_input_prms FCN((p0,path,file_type,quit_on_error,extensions))
2289
INPUT_PRMS0 HUGE *p0 C0("")@;
2290
outer_char HUGE *path C0("")@;
2291
outer_char file_type[] C0("")@;
2292
boolean quit_on_error C0("")@;
2293
SEQUENCES *extensions C1("")@;
2294
{
2295
cur0_prms = p0; /* In case of error messages. */
2296
2297
/* If we've never opened this level before, allocate appropriate space. */
2298
if(p0->Buffer == NULL)
2299
{
2300
ALLOC(ASCII,p0->Buffer,ABBREV(buf_size),buf_size,0);
2301
p0->Buffer_end = p0->Buffer + buf_size - 2;
2302
}
2303
2304
/* Initialize location pointers and flags. */
2305
loc = p0->Limit = p0->Buffer;
2306
p0->Line = 0;
2307
p0->Num_in_buffer = 0;
2308
p0->Scanning_C_cmnt = p0->Last_was_empty
2309
= p0->Continuing_line = p0->Last_was_continued = NO;
2310
2311
/* --- Open file (but not if it's already open) --- */
2312
if(!p0->File &&
2313
(p0->File=xopen(p0->File_name,path,extensions,OC("r"))) == NULL)
2314
{
2315
if(quit_on_error)
2316
{
2317
FATAL(C, "",
2318
"Can't open %s%s file %s.",
2319
*p0->File_name ? "" : "(null) ",
2320
(char *)file_type,
2321
*p0->File_name ? p0->File_name : wt_style.null_file_name);
2322
@.Can't open input file@>
2323
@.Can't open change file@>
2324
}
2325
else
2326
{
2327
err_print(C,"Can't open include %s file \"%s\"",
2328
file_type,p0->File_name);
2329
@.Can't open include file@>
2330
}
2331
2332
return NO; // Couldn't open file.
2333
}
2334
2335
return YES; // Opened file successfully.
2336
}
2337
2338
@ This general routine attempts to open a file by searching through a path.
2339
@<Part 2@>=@[
2340
2341
FILE *
2342
xopen FCN((file_name,path,extensions,iomode))
2343
outer_char *file_name C0("")@;
2344
outer_char HUGE *path C0("")@;
2345
SEQUENCES *extensions C0("")@;
2346
CONST outer_char *iomode C1("")@;
2347
{
2348
outer_char HUGE *p1;
2349
FILE *file_ptr;
2350
outer_char total_name[2*MAX_FILE_NAME_LENGTH];
2351
outer_char prefix_end_str[2];
2352
2353
if(!*file_name)
2354
return FOPEN(wt_style.null_file_name,iomode);
2355
2356
if(*iomode=='r' && STRCMP(file_name,"stdin")==0)
2357
return stdin;
2358
else if(*iomode=='w' && STRCMP(file_name,"stdout")==0)
2359
return stdout;
2360
2361
/* If at this point there's still a path attached to |file_name| (probably
2362
occurs only with the \.{-H} option), we just try to open the file.
2363
If there's no path, we just try to look in the present directory. */
2364
if(file_name[0] == prefix_end_char || !(path && *path))
2365
return x0open(file_name,extensions,iomode);
2366
2367
prefix_end_str[0] = prefix_end_char;
2368
prefix_end_str[1] = '\0';
2369
2370
/* Hunt through the path. */
2371
while((p1=(outer_char HUGE *)STRCHR(path,':')) != NULL)
2372
{
2373
*p1 = '\0';
2374
STRCPY(total_name,path);
2375
*p1 = ':';
2376
if(*(p1-1) != prefix_end_char)
2377
STRCAT(total_name,prefix_end_str);
2378
STRCAT(total_name,file_name);
2379
if((file_ptr=x0open(total_name,extensions,iomode)) != NULL)
2380
return file_ptr;
2381
path = p1 + 1;
2382
}
2383
2384
return NULL; // Couldn't open any file.
2385
}
2386
2387
@ Here we attempt to open a file with a specific file name. When the
2388
\.{-e}~option is in effect, we must scan through the list of
2389
possible extensions in order to ascertain whether one of the possible files
2390
can be opened.
2391
@<Part 2@>=@[
2392
2393
FILE *
2394
x0open FCN((file_name,extensions,iomode))
2395
outer_char *file_name C0("")@;
2396
SEQUENCES *extensions C0("")@;
2397
CONST outer_char *iomode C1("")@;
2398
{
2399
int k;
2400
2401
/* If it has a dot in it, it's always interpreted literally. If it didn't
2402
have a dot, then if the `\.{-e}'~option isn't in effect it will already
2403
have had the `\.{.web}' extension added to it, so it will now have a dot.
2404
(So presumably the last option of the \&{if} is redundant?) */
2405
if(STRCHR(file_name,wt_style.ext_delimiter)!=NULL || !try_extensions)
2406
return FOPEN(file_name,iomode);
2407
2408
/* At this point, the file name didn't have a dot and the `\.{-e}'~option
2409
is in effect. Make trial file names from the list of extensions and try to
2410
open them one at a time until one matches. */
2411
for(k=0; k<extensions->n; k++)
2412
{
2413
outer_char full_name[MAX_FILE_NAME_LENGTH];
2414
FILE *file_ptr;
2415
2416
if(NSPRINTF(full_name,"%s%c%s",
2417
file_name,wt_style.ext_delimiter,extensions->string[k]) >=
2418
MAX_FILE_NAME_LENGTH) OVERFLW("Extended file name","");
2419
2420
file_ptr = FOPEN(full_name,iomode);
2421
2422
if(file_ptr)
2423
{
2424
STRCPY(file_name,full_name); /* If we don't do this, the
2425
information messages aren't as informative as they could be. */
2426
return file_ptr; // Opened a file successfully.
2427
}
2428
}
2429
2430
return NULL; // Failed to open the file.
2431
}
2432
2433
@ The |get_line| procedure is called when |loc>limit|; it
2434
puts the next line of merged input into the buffer and updates the other
2435
variables appropriately. A space is placed at the right end of the line.
2436
This procedure returns |!input_has_ended| because we often want to check
2437
the value of that variable after calling the procedure.
2438
2439
If we've just changed from the |cur_file| to the |change_file|, or if
2440
the |cur_file| has changed, we tell \.{TANGLE} to print this
2441
information in the output file by means of the |prn_where| flag.
2442
2443
@<Common...@>=
2444
2445
IN_COMMON sixteen_bits module_count; // The current module number.
2446
2447
IN_COMMON BUF_SIZE max_modules; // Greater than the total number of modules.
2448
IN_COMMON boolean HUGE *chngd_module; // Dynamic array: Is the module changed?
2449
2450
IN_COMMON boolean prn_where CSET(NO);
2451
// Tells \.{TANGLE} to print line and file info
2452
IN_COMMON boolean return_toggle CSET(NO);
2453
/* Switch used for sending back an `\.{@@i}' when |toggle_includes|
2454
is on. */
2455
IN_COMMON boolean toggling CSET(NO); // In the middle of a toggle include?
2456
IN_COMMON boolean popped CSET(NO); // After popping the stack?
2457
IN_COMMON boolean no_more_input CSET(NO);
2458
// Temporary replacement for |input_has_ended|.
2459
2460
2461
@
2462
@<Allocate dynamic...@>=
2463
2464
ALLOC(boolean,chngd_module,ABBREV(max_modules),max_modules,0);
2465
2466
@*1 Getting the next line.
2467
Input the next line.
2468
2469
@<Part 2@>=@[
2470
2471
boolean
2472
get_line(VOID)
2473
{
2474
if(return_toggle)
2475
@<Restore next line and |goto process_line@;|@>@;
2476
2477
restart:
2478
if (changing)
2479
chngd_module[module_count] = YES;
2480
else
2481
@<Read from |cur_file| and maybe turn on |changing|@>;
2482
2483
if (changing)
2484
{
2485
@<Read from |change_file| and maybe turn off |changing|@>;
2486
2487
if (!changing)
2488
{
2489
chngd_module[module_count]=YES; goto restart;
2490
}
2491
}
2492
2493
process_line:
2494
loc = cur_buffer; *limit = @' ';
2495
2496
if(return_toggle)
2497
@<Send back a toggle command@>@;
2498
2499
if (*cur_buffer==@'@@')
2500
switch(*(cur_buffer+1))
2501
{
2502
case @'i':
2503
case @'I':
2504
@<Process an \.{\AT!i} command@>@;
2505
break;
2506
}
2507
2508
return (boolean)(!input_has_ended);
2509
}
2510
2511
@
2512
@<Process an \.{\AT!i}...@>=
2513
2514
if( *(cur_buffer+1)==@'I' && (skip_includes ||
2515
(program==weave && toggle_includes && CUR_FILE==WEB_FILE)) )
2516
{
2517
if(skip_includes)
2518
{ /* Include commands are being skipped altogether. */
2519
loc = limit + 1; // Turn whole line into null.
2520
goto restart;
2521
}
2522
else if(toggle_includes && CUR_FILE==WEB_FILE)
2523
{ /* Include files are read, but not printed. */
2524
toggling = YES;
2525
@<Send back a tog...@>@;
2526
}
2527
}
2528
else
2529
@<Push stack and go to |restart|@>@;
2530
2531
@ Process an \.{\AT!o} command.
2532
@<Unused@>=
2533
{
2534
outer_char new_file_name[MAX_FILE_NAME_LENGTH];
2535
2536
if(program==weave || phase==1) goto restart;
2537
2538
loc = cur_buffer + 2; // Position after \.{@@o}.
2539
2540
/* Look for the name of the new output file. */
2541
if(!get_fname(new_file_name))
2542
ERR_PRINT(C,"Output file name not given");
2543
@.Output file name not given@>
2544
else
2545
{
2546
fclose(out_file);
2547
strcpy(output_file_name,new_file_name);
2548
open_out();
2549
}
2550
2551
goto restart;
2552
}
2553
2554
@ An~`\.{@@i}'---|toggle_output|--- is returned before and after an include
2555
line that is to be processed but not output (when |toggle_includes == YES|).
2556
Before we send it back, we must save the line in the buffer, because
2557
we must process it the next time we come back in for a line.
2558
2559
@<Send back a toggle...@>=
2560
{
2561
return_toggle = YES;
2562
stored_line_length = PTR_DIFF(size_t, limit, cur_buffer);
2563
stored_line = GET_MEM("stored_line", stored_line_length+1, ASCII); /* We
2564
allocate one extra so we don't have to handle the special case of a
2565
zero-length line, for which |FREE_MEM| would complain. */
2566
STRNCPY(stored_line, cur_buffer, stored_line_length);
2567
loc = cur_buffer + 2;
2568
get_fname(prms[1].web.File_name); // For \.{@@I} bug.
2569
loc = limit = cur_buffer;
2570
*limit++ = @'@@'; @~ *limit++ = '\001'; @~ *limit = @' ';
2571
// |toggle_output| is \.{@@\\001}.
2572
return YES;
2573
}
2574
2575
@ We need a place to hold that line.
2576
@<Other def...@>=
2577
2578
IN_COMMON int stored_line_length;
2579
IN_COMMON ASCII HUGE *stored_line; // Allocated dynamically.
2580
2581
@ When we come back after sending a |toggle_include| command, we must get
2582
back the previous line that was in the buffer.
2583
2584
@<Restore next line...@>=
2585
{
2586
return_toggle = NO;
2587
2588
if(popped && no_more_input)
2589
{
2590
input_has_ended = YES;
2591
return NO;
2592
}
2593
2594
STRNCPY(cur_buffer, stored_line, stored_line_length);
2595
FREE_MEM(stored_line, "stored_line", stored_line_length, ASCII);
2596
limit = cur_buffer + stored_line_length;
2597
*limit = @' ';
2598
2599
if(popped)
2600
{
2601
popped = NO;
2602
goto popped_stack;
2603
}
2604
else if(toggling)
2605
goto push_stack;
2606
else
2607
goto process_line;
2608
}
2609
2610
@ When an \.{@@i}~line is found in the |cur_file|, we must temporarily
2611
stop reading it and start reading from the named include file. The
2612
\.{@@i}~line should give a complete file name with or without~\.{"..."};
2613
\.{WEB} will not look for include files in standard directories as the
2614
\cee\ preprocessor does when a \.{\#include <filename>} line is found.
2615
Also, the file name should only contain visible ASCII characters,
2616
since the characters are translated into ASCII and back again.
2617
2618
Optionally, one may also name a new change file. As for the command line,
2619
the format is \.{@@i include\_file [change\_file]}.
2620
2621
The next arrays hold the last and current names of the include file, for
2622
use by \WEAVE\ in printing out what file goes with what section.
2623
2624
@<Other...@>=
2625
2626
IN_COMMON outer_char last_include_file[MAX_FILE_NAME_LENGTH] CSET(""),
2627
this_include_file[MAX_FILE_NAME_LENGTH] CSET("");
2628
2629
@
2630
@<Push stack and...@>=
2631
@B
2632
boolean found_include;
2633
2634
@b
2635
push_stack:
2636
loc = cur_buffer + 2; // Position after \.{@@i}.
2637
2638
if(++incl_depth >= (int)max_include_depth)
2639
{
2640
incl_depth--;
2641
err_print(C, "Too many nested includes; %d allowed. \
2642
Increase with `-yid'.", max_include_depth);
2643
@.Too many nested includes@>
2644
goto restart;
2645
}
2646
2647
/* Look for the name of a \WEB\ file to include. */
2648
if(!(found_include=get_fname(cur_file_name)))
2649
ERR_PRINT(C,"Include file name not given");
2650
@.Include file name not given@>
2651
else
2652
{ // Found a \WEB\ file name; now look for change file name.
2653
if(skip_ifiles)
2654
@<Skip an already-included file and |goto restart@;|@>@;
2655
2656
if(!get_fname(change_file_name))
2657
{ /* No change file name specified; obtain it from the
2658
last level. */
2659
INPUT_PRMS *p_lower = &prms[incl_depth-1];
2660
INPUT_PRMS0 *p0_lower = &p_lower->change;
2661
2662
STRCPY(change_file_name,p0_lower->File_name);
2663
change_file = p0_lower->File;
2664
change_params = p_lower->input_params;
2665
}
2666
}
2667
2668
if(found_include)
2669
{
2670
if(ini_input_prms(CUR_FILE,incl.list,DONT_ABORT_ON_ERROR))
2671
{
2672
if(cur_prms.change->File != prms[incl_depth-1].change.File)
2673
@<Initialize change...@>@; // New change file.
2674
else *cur_prms.change = prms[incl_depth-1].change;
2675
// Still using the old change file.
2676
2677
cur_line = 0;
2678
prn_where = YES;
2679
CLR_PRINTF(SHORT_INFO, include_file,
2680
(" (%s", (char *)cur_file_name));
2681
/* Tell the terminal where we're reading from. */
2682
}
2683
else
2684
{ /* Failed to open include file. */
2685
incl_depth--;
2686
}
2687
}
2688
2689
goto restart;
2690
}
2691
2692
@ When option \.{-j} is used, include files that have already been included
2693
are not included again.
2694
2695
@<Glob...@>=
2696
2697
IN_COMMON BUF_SIZE max_ifiles;
2698
IN_COMMON outer_char **ifiles; // Dynamic array of unique include file names.
2699
IN_COMMON int num_ifiles; // Current number of include file names.
2700
2701
@
2702
@<Allocate dynamic...@>=
2703
{
2704
ALLOC(outer_char *, ifiles, ABBREV(max_ifiles), max_ifiles, 0);
2705
}
2706
2707
@
2708
@<Skip an already...@>=
2709
{
2710
int j;
2711
2712
for(j=0; j<num_ifiles; j++)
2713
if(STRCMP(ifiles[j], cur_file_name) == 0)
2714
{
2715
incl_depth--;
2716
goto restart;
2717
}
2718
2719
if(num_ifiles == (int)max_ifiles)
2720
OVERFLW("unique include file names", ABBREV(max_ifiles));
2721
2722
if(phase == 1)
2723
{
2724
ifiles[num_ifiles] = GET_MEM("ifile", STRLEN(cur_file_name) + 1, outer_char);
2725
STRCPY(ifiles[num_ifiles], cur_file_name);
2726
}
2727
2728
num_ifiles++;
2729
}
2730
2731
@ Read a file name from an \.{@@i}~line. One annoyance is the possibility
2732
of embedded comments.
2733
@<Part 2@>=@[
2734
2735
boolean
2736
get_fname FCN((file_name))
2737
outer_char HUGE *file_name C1("")@;
2738
{
2739
ASCII HUGE *j;
2740
outer_char HUGE *k;
2741
2742
skip_white:
2743
2744
/* Skip over leading white space and optional quotes. */
2745
while (loc<=limit && (*loc==@' '||*loc==@'\t'||*loc==@'"')) loc++;
2746
2747
/* If we've hit the end of the buffer, we're done, and we didn't find
2748
anything. */
2749
if(loc >= limit) return NO;
2750
2751
@<Process comment in include line@>@;
2752
2753
k = file_name; j=loc;
2754
2755
/* Terminate scan by white space or quotes. */
2756
while (*loc!=@' '&&*loc!=@'\t'&&*loc!=@'"') *k++ = XCHR(*loc++);
2757
TERMINATE(k,0);
2758
2759
/* On certain systems, underscores aren't allowed in file names. */
2760
@#ifdef MVS
2761
for (k = file_name; *k; k++)
2762
if (*k == '_')
2763
*k = '@@';
2764
@#endif // |MVS|
2765
2766
add_prefix(file_name); // Attach a directory prefix.
2767
2768
return YES;
2769
}
2770
2771
@
2772
@<Process comment in include...@>=
2773
{
2774
if(*loc==@'/')
2775
{
2776
if(*(loc+1) == @'/')
2777
{ /* Short comment */
2778
loc = limit+1;
2779
return NO;
2780
}
2781
2782
if(*(loc+1) == @'*')
2783
{ /* Long comment */
2784
for(loc += 2; loc <= limit; loc++)
2785
if(*loc==@'*' && *(loc+1)==@'/')
2786
{
2787
loc += 2;
2788
goto skip_white;
2789
}
2790
2791
ERR_PRINT(C,"Can't continue comments on @@i lines");
2792
}
2793
}
2794
}
2795
2796
@ If the include file name has no directory prefix and there was a web file
2797
prefix, then attach the latter to the former.
2798
2799
@<Part 2@>=@[
2800
2801
SRTN
2802
add_prefix FCN((file_name))
2803
outer_char HUGE *file_name C1("")@;
2804
{
2805
outer_char temp[MAX_FILE_NAME_LENGTH];
2806
2807
xpnd_file_name(file_name); // Expand possible environmental prefix.
2808
2809
if(*wbprefix && STRRCHR(file_name,prefix_end_char)==NULL)
2810
{
2811
if(NSPRINTF(temp,"%s%s",wbprefix,file_name) >=
2812
MAX_FILE_NAME_LENGTH) OVERFLW("Path/file_name","");
2813
2814
STRCPY(file_name,temp);
2815
}
2816
}
2817
2818
@ The following function emulates VMS' expansions of logical names. It's
2819
assumed that the file names in an \.{@@i} command look like \.{ENV:name},
2820
where \.{ENV}~is an environmental variable defined with \.{setenv}.
2821
\.{ENV}~should expand to a subdirectory, without a trailing slash.
2822
@<Part 2@>=@[
2823
2824
SRTN
2825
xpnd_file_name FCN((name))
2826
outer_char HUGE *name C1("")@;
2827
{
2828
outer_char temp[MAX_FILE_NAME_LENGTH],env_prefix[MAX_FILE_NAME_LENGTH];
2829
outer_char *pc,*px,*qx;
2830
CONST char *separator;
2831
int n;
2832
boolean expanded;
2833
2834
#ifdef vms
2835
return; // VAX/VMS does its own expansions of logical names.
2836
#else
2837
2838
#if !HAVE_GETENV
2839
err_print(C,"Sorry, this machine doesn't support environment variables");
2840
return;
2841
#else
2842
2843
/* Is there a logical name prefix? */
2844
if((pc=OC(STRCHR(name,':'))) == NULL) return;
2845
2846
/* Isolate the prefix. */
2847
STRNCPY(env_prefix,name,n=PTR_DIFF(int, pc, name));
2848
TERMINATE(env_prefix,n);
2849
2850
/* Recursively expand the prefix. |px|~will have the last non-null name. */
2851
expanded = NO;
2852
for(px=env_prefix; px; px=qx)
2853
{
2854
if((qx=GETENV(px)) == NULL) break;
2855
if(STRCMP(qx,env_prefix) == 0)
2856
{
2857
err_print(C,"Infinite recursion in definition of \
2858
environmental variable \"%s\"",px=env_prefix);
2859
expanded = NO;
2860
break;
2861
}
2862
expanded = YES; /* At least one expansion of the logical name was
2863
made. */
2864
}
2865
2866
/* If the prefix wasn't expandable, or if it turned into an infinite
2867
recursion, do nothing. */
2868
if(!expanded) return;
2869
2870
/* Otherwise, |px|~has the last expansion of the name. */
2871
separator =
2872
#ifdef ibmpc
2873
"\\"
2874
#else
2875
"/"
2876
#endif /* |ibmpc| */
2877
;
2878
if(NSPRINTF(temp,"%s%s%s",px,separator,pc+1) >=
2879
MAX_FILE_NAME_LENGTH)
2880
OVERFLW("Expandable file name","");
2881
STRCPY(name,temp);
2882
2883
#endif // |HAVE_GETENV|
2884
#endif // |vms|
2885
}
2886
2887
@
2888
@<Read from |cur_file|...@>=
2889
{
2890
popped = NO;
2891
2892
if(cur_prms.web->Line == 0)
2893
{
2894
if(ignored_cmnts())
2895
goto fin_read;
2896
else
2897
goto pop_or_quit;
2898
}
2899
2900
while (!input_ln(INPUT_FILE))
2901
{ /* Pop the stack or quit. */
2902
pop_or_quit:
2903
prn_where=YES;
2904
2905
if(incl_depth==WEB_FILE)
2906
{input_has_ended = YES; break;}
2907
else
2908
{ /* Tidy up the include level we're about to leave. */
2909
if(cur_prms.web->File != prms[incl_depth-1].web.File)
2910
{FCLOSE(cur_prms.web->File);}
2911
2912
if(cur_prms.change->File != prms[incl_depth-1].change.File)
2913
{FCLOSE(cur_prms.change->File);}
2914
else prms[incl_depth-1].change = *cur_prms.change;
2915
2916
cur0_prms->File = NULL;
2917
CLR_PRINTF(SHORT_INFO, include_file, (")"));
2918
/* Tell the terminal we're finished with this web
2919
input file. */
2920
2921
/* Pop the stack here. */
2922
incl_depth--;
2923
cur_prms.web = &prms[incl_depth].web;
2924
cur_prms.change = &prms[incl_depth].change;
2925
2926
if(incl_depth == WEB_FILE && toggle_includes && toggling)
2927
{
2928
toggling = NO;
2929
return_toggle = YES;
2930
}
2931
2932
STRCPY(this_include_file,(incl_depth==WEB_FILE) ?
2933
(CONST outer_char *)"" : cur_file_name);
2934
2935
}
2936
}
2937
2938
fin_read:
2939
if(return_toggle)
2940
{
2941
no_more_input = input_has_ended;
2942
input_has_ended = NO;
2943
popped = YES;
2944
@<Send back a tog...@>@;
2945
}
2946
2947
popped_stack:
2948
if (!input_has_ended)
2949
if (limit==change_limit-change_buffer+cur_buffer)
2950
if (cur_buffer[0]==change_buffer[0])
2951
if (change_limit>change_buffer) chk_change();
2952
}
2953
2954
@ Here we look at the beginning material in the include file. If the file
2955
begins with~`\.{@@z}', then everything up to and including a line beginning
2956
with~`\.{@@x}' is skipped.
2957
2958
@<Part 2@>=@[
2959
2960
boolean
2961
ignored_cmnts(VOID)
2962
{
2963
boolean limbo_material;
2964
2965
/* Read the first line of file. */
2966
if(!input_ln(INPUT_FILE))
2967
return NO;
2968
2969
/* Check for possible limbo material. If so, skip all lines up to
2970
an~`\.{@@x}'. */
2971
limbo_material = BOOLEAN(cur_buffer[0] == @'@@' && cur_buffer[1] == @'z');
2972
2973
if(limbo_material)
2974
do
2975
{
2976
if(!input_ln(INPUT_FILE))
2977
{
2978
CLR_PRINTF(WARNINGS, warning, ("\n! File ended while \
2979
skiping ignorable commentary. Limbo material that begins with @@z must be \
2980
terminated by @@x."));
2981
return NO;
2982
}
2983
2984
if(phase == 1)
2985
find_keywords(cur_buffer, limit); /* The |WEB_FILE|
2986
constraint is a kludge. Eventually, one should integrate this into the
2987
stacking mechanism for include files. */
2988
}
2989
while(!(cur_buffer[0] == @'@@' && cur_buffer[1] == @'x'));
2990
2991
/* If there was limbo material, at this point the line beginning
2992
with~`\.{@@x}' is in the buffer. The next operation is to read another
2993
line, which starts the proper part of the include file. If there was no
2994
limbo material, the first line of the file is already in the buffer. Thus,
2995
after the following operation we'll always have the first proper line of
2996
the file in the buffer. */
2997
if(limbo_material && !input_ln(INPUT_FILE))
2998
return NO;
2999
3000
return YES; // Successfully skipped comments.
3001
}
3002
3003
@ Here we search the line from~|p| to~|p_end| for the pattern
3004
`\.{\$keyword:\ text\ \$}'. If so, the text is associated with the
3005
built-in function \.{\$KEYWORD(keyword)}.
3006
3007
@<Part 2@>=@[
3008
3009
SRTN
3010
find_keywords FCN((p, p_end))
3011
ASCII HUGE *p C0("Start of line to search")@;
3012
ASCII HUGE *p_end C1("End of line")@;
3013
{
3014
ASCII HUGE *pk, HUGE *pk_end, HUGE *ptext, HUGE *ptext_end;
3015
3016
*p_end = '\0';
3017
3018
pk = (ASCII HUGE *)STRCHR(p, @'$');
3019
3020
if(!pk)
3021
return; // No starting \.{'\$'}.
3022
3023
pk_end = (ASCII HUGE *)STRCHR(pk, @':');
3024
3025
if(!pk_end)
3026
return; // No intermediate \.{':'}.
3027
3028
if(pk_end[1] != @' ')
3029
return; // There must be at least one blank after the \.{':'}.
3030
3031
ptext_end = (ASCII HUGE *)STRCHR(pk_end+1, @'$');
3032
3033
if(!ptext_end)
3034
return; // No ending \.{'\$'}.
3035
3036
if(ptext_end[-1] != @' ')
3037
return; // There must be at least one blank before the \.{'\$'}.
3038
3039
/* Strip blanks from start of text. */
3040
for(ptext = pk_end+2; *ptext == @' '; ptext++)
3041
;
3042
3043
/* Strip blanks from end of text. */
3044
for(ptext_end--; *ptext_end == @' '; ptext_end--)
3045
;
3046
3047
add_keyword(pk+1, pk_end, ptext, ptext_end+1);
3048
}
3049
3050
@
3051
@<Glob...@>=
3052
3053
IN_COMMON BUF_SIZE max_keywords;
3054
IN_COMMON RCS HUGE *rcs; // Dynamic array of RCS-like keywords.
3055
IN_COMMON unsigned num_keywords; // Current number of RCS-like keywords.
3056
3057
@
3058
@<Allocate dynamic...@>=
3059
{
3060
ALLOC(RCS, rcs, ABBREV(max_keywords), max_keywords, 0);
3061
}
3062
3063
@
3064
@<Part 2@>=@[
3065
3066
SRTN
3067
add_keyword FCN((pk, pk_end, pt, pt_end))
3068
ASCII HUGE *pk C0("Start of keyword")@;
3069
ASCII HUGE *pk_end C0("End of keyword")@;
3070
ASCII HUGE *pt C0("Start of text")@;
3071
ASCII HUGE *pt_end C1("End of text")@;
3072
{
3073
RCS_LIST HUGE *plist = &prms[CUR_FILE].rcs_list;
3074
RCS HUGE *prcs;
3075
unsigned k;
3076
3077
*pk_end = *pt_end = '\0';
3078
3079
for(prcs=plist->start; prcs && prcs->keyword; prcs=prcs->next)
3080
if(STRCMP(pk, prcs->keyword) == 0)
3081
{
3082
outer_char temp[256];
3083
3084
STRCPY(temp, pk);
3085
to_outer(temp);
3086
printf("\n! Duplicate RCS-like keyword `%s' ignored (l. %u).",
3087
temp, cur_line);
3088
mark_harmless;
3089
return;
3090
}
3091
3092
if(!plist->start)
3093
plist->end = plist->start = GET_MEM("RCS", 1, RCS);
3094
else
3095
plist->end = plist->end->next = GET_MEM("RCS", 1, RCS);
3096
3097
prcs = plist->end;
3098
3099
prcs->keyword = GET_MEM("keyword", STRLEN(pk) + 1, ASCII);
3100
STRCPY(prcs->keyword, pk);
3101
3102
prcs->txt = GET_MEM("RCS text", STRLEN(pt) + 1, ASCII);
3103
STRCPY(prcs->txt, pt);
3104
3105
prcs->next = NULL;
3106
}
3107
3108
@
3109
@<Read from |change_file|...@>=
3110
{
3111
if (!input_ln(CHANGE_FILE))
3112
{
3113
ERR_PRINT(C,"Change file ended without @@z");
3114
@.Change file ended...@>
3115
cur_buffer[0]=@'@@'; cur_buffer[1]=@'z'; limit=cur_buffer+2;
3116
}
3117
3118
if (limit>cur_buffer+1) /* check if the change has ended */
3119
if (cur_buffer[0]==@'@@')
3120
{
3121
@<Lowerc...@>;
3122
@<Check for erron...@>;
3123
3124
if (cur_buffer[1]==@'x' || cur_buffer[1]==@'y')
3125
{
3126
loc=cur_buffer+2; ERR_PRINT(C,"Where is the matching @@z?");
3127
@.Where is the match...@>
3128
}
3129
else if (cur_buffer[1]==@'z')
3130
{
3131
prime_the_change_buffer(); prn_where=YES;
3132
}
3133
}
3134
}
3135
3136
@ At the end of the program, we will tell the user if the change file
3137
had a line that didn't match any relevant line in |web_file|.
3138
3139
@<Part 2@>=@[
3140
3141
SRTN
3142
chk_complete(VOID)
3143
{
3144
if (change_limit != NULL)
3145
{ /* |changing| is |NO| */
3146
STRNCPY(cur_buffer,change_buffer,
3147
PTR_DIFF(size_t,change_limit,change_buffer)+1);
3148
loc = limit = PTR_DIFF(size_t,change_limit,change_buffer) + cur_buffer;
3149
changing=YES;
3150
ERR_PRINT(C,"Change file entry did not match");
3151
@.Change file entry did not match@>
3152
}
3153
}
3154
3155
@* MEMORY ALLOCATION.
3156
Almost all memory is allocated dynamically. This
3157
allows one to customize the tables if necessary; default sizes can be
3158
overridden by the command-line option~``\.{-y}'', which can also be used in
3159
the ini file. Dynamic allocation also ensures that the pointer to the array
3160
is |HUGE|, and that sometimes matters for personal computers.
3161
3162
@i mem.hweb
3163
3164
@ The memory allocation routine quits if it can't find anything.
3165
3166
@d MAX_SIZE_T ((BUF_SIZE)(size_t)(~(0L))) // Maximum argument to |calloc|.
3167
3168
@<Glob...@>=
3169
3170
IN_COMMON BUF_SIZE total_mem CSET(0);
3171
// Current total dynamically allocated memory.
3172
IN_COMMON BUF_SIZE max_mem CSET(0); // The maximum bytes that were allocated.
3173
3174
@
3175
@<Part 2@>=@[
3176
3177
void HUGE *
3178
get_mem0 FCN((why,nunits,nsize))
3179
CONST outer_char why[] C0("Reason for request")@;
3180
BUF_SIZE nunits C0("Number of units to allocate.")@;
3181
size_t nsize C1("Size of each unit.")@;
3182
{
3183
void HUGE *p; /* With certain compilers such as the |SGI|, |void| is
3184
translated into |char|; see \.{proto.hweb}. */
3185
BUF_SIZE nbytes;
3186
3187
if(nunits==0)
3188
return NULL; /* Should this ever happen? */
3189
3190
if(nsize==0)
3191
CONFUSION("get_mem0","Nsize = 0 requested");
3192
3193
#if !NON_ANSI_CALLOC
3194
/* For ANSI, the prototype for |calloc| is |void *calloc(size_t,size_t)|. */
3195
if(nunits > MAX_SIZE_T)
3196
{
3197
err_print(C,"get_mem0: Can't request %lu units; used max of %lu",
3198
nunits,MAX_SIZE_T);
3199
nunits = MAX_SIZE_T;
3200
}
3201
#endif /* |ANSI_CALLOC| */
3202
3203
if( (p=(void HUGE *)CALLOC(nunits,nsize)) == NULL)
3204
{
3205
FREE(byte_mem); // Kludge to try to make it go out gracefully.
3206
3207
FATAL(C, "\n!!! NO MORE MEMORY",
3208
" (\"%s\")!!! \
3209
[Requesting %lu unit(s) of size %lu byte(s); \
3210
allocated %lu bytes so far.] \
3211
Try using the -y option to reduce the sizes of internal tables.",
3212
(char *)why, nunits, (BUF_SIZE)nsize, total_mem);
3213
}
3214
3215
/* Keep track of total allocation. */
3216
nbytes = nunits*nsize;
3217
total_mem += nbytes;
3218
max_mem = MAX(max_mem,total_mem);
3219
3220
#ifdef mac
3221
lmemset(p,0,nbytes); /* For |lmalloc|, must zero explicitly. */
3222
#endif
3223
3224
if(show_mem && nbytes >= show_size)
3225
show_alloc('+',why,nunits,(BUF_SIZE)nsize,nbytes,p,total_mem);
3226
3227
return p; /* The allocated memory area. */
3228
}
3229
3230
@ Here we display the details of the memory allocation.
3231
@<Part 2@>=@[
3232
3233
SRTN
3234
show_alloc FCN((c,why,nunits,nsize,nbytes,p,total_mem))
3235
outer_char c C0("Either plus or minus")@;
3236
CONST outer_char why[] C0("Reason for request")@;
3237
BUF_SIZE nunits C0("Number of units")@;
3238
BUF_SIZE nsize C0("Size of each unit.")@;
3239
BUF_SIZE nbytes C0("Bytes allocated")@;
3240
void HUGE *p C0("Start of allocated area")@;
3241
BUF_SIZE total_mem C1("Total bytes currently allocated")@;
3242
{
3243
printf("\"%s\": %c(%s x %s) = %c%s ",
3244
(char *)why, c, commas(nunits), commas(nsize), c, commas(nbytes));
3245
ptr_range(p,nbytes);
3246
printf("(%s total)\n", commas(total_mem));
3247
free_buf(&c_buf);
3248
}
3249
3250
@ Because not all compilers understand the \.{\%p}~format command, and
3251
since different users may wish to customize the form of the pointer range
3252
for an allocation, we provide this function.
3253
3254
If one wanted, for the Sun etc.\ he could use |$TRANSLIT| to turn~\.p
3255
into~\.d, for example.
3256
3257
@d PTR_BASE "[%p,%p) " /* To style file? */
3258
3259
@<Part 2@>=@[
3260
3261
SRTN
3262
ptr_range FCN((p,nbytes))
3263
void HUGE *p C0("Start of the allocated space.")@;
3264
BUF_SIZE nbytes C1("Length of the allocation")@;
3265
{
3266
static char ptr_string[] =
3267
#ifdef ibmpc
3268
PTR_BASE
3269
#else
3270
""
3271
#endif
3272
;
3273
3274
printf(ptr_string,p,(char HUGE *)p + nbytes);
3275
}
3276
3277
@ We free memory through an intermediate routine so we can keep track of
3278
the total memory allocations.
3279
@<Part 2@>=@[
3280
3281
SRTN
3282
free_mem0 FCN((p,why,nunits,nsize))
3283
void HUGE *p C0("Pointer to deallocate")@;
3284
CONST outer_char why[] C0("Reason for request")@;
3285
BUF_SIZE nunits C0("Number of units to deallocate.")@;
3286
size_t nsize C1("Size of each unit.")@;
3287
{
3288
BUF_SIZE nbytes;
3289
3290
/* If things are working correctly, |p|~should have been previously
3291
allocated. */
3292
if(p == NULL)
3293
CONFUSION("free_mem0", "Attempting to deallocate NULL pointer");
3294
3295
/* Keep track of total allocation. */
3296
nbytes = nunits*nsize;
3297
total_mem -= nbytes;
3298
3299
if(show_mem && nbytes >= show_size)
3300
show_alloc('-',why,nunits,(BUF_SIZE)nsize,nbytes,p,total_mem);
3301
3302
FREE(p);
3303
}
3304
3305
@ For debugging, we have some variables that say whether to display the
3306
dynamic memory allocations as they occur. To turn on the display, use the
3307
command-line option~\.{-sm}. A numeric argument changes |show_size|---e.g.,
3308
\.{-sm100} shows all memory allocations whose size is $\ge 100$ bytes.
3309
3310
@d SHOW_MEM 0 /* Don't display by default. */
3311
3312
@<Glob...@>=
3313
3314
IN_COMMON boolean show_mem CSET(SHOW_MEM);
3315
IN_COMMON BUF_SIZE show_size CSET(10000); // Display for |nbytes >= show_size|.
3316
3317
@ Here we set up for dynamic memory allocation. The information about the
3318
minimum allowed, maximum allowed, and default value for the length or value
3319
of a variable is held in a |MEM| structure. The default value can be
3320
overridden with the command-line option~\.{-y}.
3321
3322
@m ID_FLAG 10240 /* \bf DO NOT MESS WITH THIS NUMBER!. */
3323
@m ID_FLAG1 $EVAL(ID_FLAG-1)
3324
3325
@<Common...@>=
3326
3327
/* Ideally, the following numbers should be large enough to handle both
3328
\FTANGLE\ and \FWEAVE. In the comments, we show some characteristic
3329
statistics. */
3330
3331
/* \.{Machine-dependent:} Machines with limited memory. */
3332
#if SMALL_MEMORY
3333
#define DFLT_BYTES 10000 /* \.{fweave fweave} $\approx$ 23,300. */
3334
#define DFLT_BUF_SIZE 1500
3335
#define DFLT_C_BUF_SIZE 200
3336
#define DFLT_FMT_SIZE 200
3337
#define DFLT_MSG_SIZE 1000
3338
#define DFLT_DELTA_DOTS 20
3339
#define DFLT_MAX_LBLS 20
3340
#define DFLT_LINE_LENGTH 80
3341
#define DFLT_LONGEST_NAME 1000
3342
#define DFLT_MAX_EXPR_CHARS 500
3343
#define DFLT_MAX_IFILES 10
3344
#define DFLT_MAX_INCLUDE_DEPTH 10
3345
#define DFLT_MAX_KEYWORDS 15
3346
#define DFLT_MAX_MARGS 20
3347
#define DFLT_MAX_MODULES 400
3348
#define DFLT_MBUF_SIZE 32767
3349
#define DFLT_MAX_NAMES 1000 /* \.{fweave fweave} $\approx$ 3,300. */
3350
#define DFLT_MAX_REFS 2500 /* \.{fweave ftangle} $\approx$ 5,850. */
3351
#define DFLT_SBUF_LEN 300
3352
#define DFLT_STACK_SIZE_T 50
3353
#define DFLT_STACK_SIZE_W 210 /* \.{fweave fweave} $\approx$ 200. */
3354
#define DFLT_MAX_SCRAPS 1000 /* \.{fweave fweave} $\approx$ 900. */
3355
#define DFLT_MAX_TOKS_T 50000L // \.{ftangle fweave} $\approx$ 92,000.
3356
#define DFLT_MAX_TOKS_W 6000 /* \.{fweave fweave} $\approx$ 6,700. */
3357
#define DFLT_MAX_DTOKS 2500
3358
#define DFLT_MAX_TEXTS 2500 /* \.{fweave fweave} $\approx$ 4,500. */
3359
#define DFLT_MAX_DTEXTS 100
3360
#define DFLT_NUM_FILES 15
3361
#define DFLT_OP_ENTRIES $EVAL(128+PREDEFINED_DOTS+5)
3362
#define DFLT_X_BUF_SIZE 80
3363
#else /* Large limits. */
3364
#define DFLT_BYTES 90000L
3365
#define DFLT_BUF_SIZE 1500
3366
#define DFLT_C_BUF_SIZE 255
3367
#define DFLT_FMT_SIZE 500
3368
#define DFLT_MSG_SIZE 2000
3369
#define DFLT_DELTA_DOTS 20
3370
#define DFLT_MAX_LBLS 20
3371
#define DFLT_LINE_LENGTH 80
3372
#define DFLT_LONGEST_NAME 10000
3373
#define DFLT_MAX_EXPR_CHARS 500
3374
#define DFLT_MAX_IFILES 100
3375
#define DFLT_MAX_INCLUDE_DEPTH 10
3376
#define DFLT_MAX_KEYWORDS 20
3377
#define DFLT_MAX_MARGS 20
3378
#define DFLT_MAX_MODULES 2000
3379
#define DFLT_MBUF_SIZE 50000L
3380
#define DFLT_MAX_NAMES 4000
3381
#define DFLT_MAX_REFS 20000
3382
#define DFLT_SBUF_LEN 300
3383
#define DFLT_STACK_SIZE_T 50
3384
#define DFLT_STACK_SIZE_W 400
3385
#define DFLT_MAX_SCRAPS 10000
3386
#define DFLT_MAX_TOKS_T 150000L
3387
#define DFLT_MAX_TOKS_W 25000
3388
#define DFLT_MAX_DTOKS 25000
3389
#define DFLT_MAX_TEXTS ID_FLAG1
3390
#define DFLT_MAX_DTEXTS 500
3391
#define DFLT_NUM_FILES 15
3392
#define DFLT_OP_ENTRIES $EVAL(128+PREDEFINED_DOTS+15)
3393
#define DFLT_X_BUF_SIZE 80
3394
#endif /* Limited memory. */
3395
3396
3397
@ The following list must be kept sorted by abbreviation!
3398
@<Glob...@>=
3399
3400
IN_COMMON MEM mem[]
3401
#if(part == 0 || part == 1)
3402
= {
3403
{ABBREV(max_bytes),1,
3404
1000,DFLT_BYTES,ULONG_MAX}, /* |"b"|. |max_bytes|: the
3405
number of bytes in identifiers, index entries, and module names. */
3406
{ABBREV(buf_size),1,
3407
500,DFLT_BUF_SIZE,20000}, // |"bs"|. |change_buffer| etc.
3408
{ABBREV(C_buf_size),1,
3409
10,DFLT_C_BUF_SIZE,1000},// |"cb"|. |C_buf_size|: see |C_putc|.
3410
{ABBREV(cmd_fsize),1,
3411
100,DFLT_FMT_SIZE,UL(65536L)}, // |"cf"|.|cmd_fsize|: see |out_cmd|.
3412
{ABBREV(cmd_size),1,
3413
100,DFLT_MSG_SIZE,UL(65536L)}, // |"cg"|. |cmd_size|: see |out_cmd|
3414
{ABBREV(delta_dots),sizeof(DOTS),
3415
20,DFLT_DELTA_DOTS,255}, /* |"d"|. |delta_dots|: Number of
3416
additional entries to reallocate for |dots| if necessary. */
3417
{ABBREV(max_dtoks),sizeof(eight_bits),
3418
1000,DFLT_MAX_DTOKS,ULONG_MAX}, // |"dt"|. |max_dtoks|.
3419
{ABBREV(dtexts_max),sizeof(text),
3420
100,DFLT_MAX_DTEXTS,ID_FLAG1}, // |"dx"|. |dtexts_max|.
3421
{ABBREV(max_include_depth), sizeof(INPUT_PRMS),
3422
1, DFLT_MAX_INCLUDE_DEPTH, 100}, // |"id"|. |prms| (open files).
3423
{ABBREV(max_ifiles), sizeof(outer_char *),
3424
1, DFLT_MAX_IFILES, 10000}, // |"if"|. |max_ifiles|.
3425
{ABBREV(stck_size_t),sizeof(output_state),
3426
10,DFLT_STACK_SIZE_T,100}, // |"kt"|. Tangle's |stck_size|.
3427
{ABBREV(stck_size_w),sizeof(output_state),
3428
50,DFLT_STACK_SIZE_W,1000}, // |"kw"|. Weave's |stck_size|.
3429
{ABBREV(max_lbls),sizeof(BEGUN),
3430
5,DFLT_MAX_LBLS,255}, // |"lb"|. |max_lbls|.
3431
{ABBREV(line_length),1,
3432
60,DFLT_LINE_LENGTH,255}, /* |"ll"|. |line_length| for
3433
\FWEAVE's output. */
3434
{ABBREV(longest_name),1,
3435
3*MAX_FILE_NAME_LENGTH, DFLT_LONGEST_NAME, UL(50000L)},
3436
/* |"ln"|. |longest_name|: module names and strings shouldn't be longer
3437
than this. */
3438
{ABBREV(max_expr_chars),1,
3439
25,DFLT_MAX_EXPR_CHARS,UL(65536L)}, // |"lx"|. |max_expr_chars|.
3440
{ABBREV(max_modules),sizeof(boolean),
3441
100,DFLT_MAX_MODULES,ID_FLAG1}, /* |"m"|. |max_modules|:
3442
larger than the max number of modules. */
3443
{ABBREV(max_margs), sizeof(sixteen_bits),
3444
1, DFLT_MAX_MARGS, 255}, // |"ma"|. |max_margs|.
3445
{ABBREV(mbuf_size),1,
3446
5000,DFLT_MBUF_SIZE,ULONG_MAX}, // |"mb"|. |mbuf_size|.
3447
{ABBREV(max_names),sizeof(NAME_INFO)+sizeof(name_pointer),
3448
500,DFLT_MAX_NAMES,ID_FLAG1}, /* |"n"|. |max_names|:
3449
number of identifiers, strings, module names; must be less than 10240. */
3450
{ABBREV(num_files),sizeof(OPEN_FILE),
3451
1,DFLT_NUM_FILES,256}, // |"nf"|. |num_files|.
3452
{ABBREV(op_entries),sizeof(OPERATOR),
3453
$EVAL(128+PREDEFINED_DOTS),DFLT_OP_ENTRIES,256}, /* |"op"|.
3454
|op_entries| */
3455
{ABBREV(max_refs),sizeof(xref_info),
3456
500,DFLT_MAX_REFS,UL(65536L)}, /* |"r"|. |max_refs|: number of
3457
cross-references; must be less than 65536. */
3458
{ABBREV(max_keywords), sizeof(RCS),
3459
11, DFLT_MAX_KEYWORDS, UL(65536L)}, // |"rk"|. |max_keywords|.
3460
{ABBREV(max_scraps),sizeof(scrap),
3461
1000,DFLT_MAX_SCRAPS,ULONG_MAX}, // |"s"|. |max_scraps|.
3462
{ABBREV(sbuf_len),sizeof(outer_char),
3463
100,DFLT_SBUF_LEN,ULONG_MAX}, // |"sb"|. |sbuf_len|.
3464
{ABBREV(max_toks_t),sizeof(eight_bits),
3465
10000,DFLT_MAX_TOKS_T,ULONG_MAX}, /* |"tt"|. Tangle's
3466
|max_toks|: Total for the entire code; can be big. */
3467
{ABBREV(max_toks_w),sizeof(sixteen_bits),1000,
3468
DFLT_MAX_TOKS_W,UL(65536L)}, /* |"tw"|. Weave's |max_toks|:
3469
number of symbols in code texts being parsed; must be less than 65536. */
3470
{ABBREV(max_texts),sizeof(text),
3471
500,DFLT_MAX_TEXTS,ID_FLAG1}, // |"x"|. |max_texts|.
3472
{ABBREV(X_buf_size),1,
3473
10,DFLT_X_BUF_SIZE,1000},// |"xb"|. |X_buf_size|: see |C_putc|.
3474
{"",0,0,0}
3475
}
3476
#endif // |part == 1|
3477
;
3478
3479
IN_COMMON size_t sizeof_mem CSET(sizeof(mem));
3480
3481
@ This is the search routine used by the `\.{-y}'~option that matches an
3482
abbreviation with the right element of the |MEM| structure and overrides
3483
the default value.
3484
3485
@<Part 2@>=@[
3486
3487
MEM HUGE *
3488
msearch FCN((abbrev,nunits))
3489
CONST outer_char abbrev[] C0("Abbreviation for desired object.")@;
3490
BUF_SIZE nunits C1("Value.")@;
3491
{
3492
MEM HUGE *m;
3493
3494
for(m=mem; *m->abbrev; m++)
3495
if(STRCMP(m->abbrev,abbrev)==0)
3496
{
3497
if(nunits == 0L) return m; // Special case: just find it.
3498
3499
if(nunits < m->min)
3500
{
3501
CLR_PRINTF(WARNINGS, warning,
3502
("! Warning (msearch:%s): nunits (%lu) < min (%lu); min used.\n",
3503
(char *)abbrev,nunits,m->min));
3504
mark_harmless;
3505
nunits = m->min;
3506
}
3507
else if(nunits > m->max)
3508
{
3509
CLR_PRINTF(WARNINGS, warning,
3510
("! Warning (dynamic buffer %s): nunits (%lu) > max (%lu); max used.\n",
3511
(char *)abbrev,nunits,m->max));
3512
mark_harmless;
3513
nunits = m->max;
3514
}
3515
3516
m->nunits = nunits; /* Override the default value. */
3517
return m;
3518
}
3519
3520
CLR_PRINTF(WARNINGS, warning,
3521
("! Invalid alloc abbreviation \"%s[%lu]\"\n", (char *)abbrev,nunits));
3522
mark_harmless;
3523
return m;
3524
}
3525
3526
@ Here is the allocation routine that works with the |ALLOC| macro. It
3527
returns a pointer to allocated memory, and also sets an|unsigned long|
3528
variable with the number of units (not bytes) allocated.
3529
3530
@<Part 2@>=@[
3531
3532
void HUGE *
3533
alloc FCN((abbrev,pnunits,nsize,dn))
3534
CONST outer_char abbrev[] C0("Abbreviation for desired object.")@;
3535
BUF_SIZE HUGE *pnunits C0("Pointer to returned \# of units.")@;
3536
size_t nsize C0("Size of object.")@;
3537
int dn C1("Incremental number of units to allocate.")@;
3538
{
3539
MEM HUGE *m = find_abbrev(abbrev);
3540
3541
*pnunits = m->nunits;
3542
3543
/* |dn| is used as a flag; if it's negative, we just obtain the number of
3544
units. */
3545
if(dn < 0)
3546
return NULL;
3547
else
3548
return get_mem0(abbrev, (*pnunits)+dn, nsize);
3549
}
3550
3551
@ Search through the abbreviations list to get the element.
3552
@<Part 2@>=@[
3553
MEM HUGE *
3554
find_abbrev FCN((abbrev))
3555
CONST outer_char abbrev[] C1("")@;
3556
{
3557
MEM HUGE *m;
3558
3559
for(m=mem; *m->abbrev; m++)
3560
if(STRCMP(m->abbrev,abbrev)==0)
3561
return m;
3562
3563
CONFUSION("find_abbrev", "Bad alloc abbreviation \"%s\"", abbrev);
3564
3565
return NULL;
3566
}
3567
3568
@ Annoyingly, Microsoft doesn't supply a reallocation routine that works
3569
with |halloc|, presumably because it doesn't do heap management with |huge|
3570
stuff. So, we write our own. We simply allocate new space, copy the old to
3571
the new, then free the old.
3572
3573
@<Part 2@>=@[
3574
#ifdef mcc
3575
3576
void HUGE *
3577
hrealloc FCN((old_ptr, new_size, old_size))
3578
void HUGE *old_ptr C0("Old buf previously allocated with |halloc|.")@;
3579
BUF_SIZE new_size C0("New size in bytes.")@;
3580
BUF_SIZE old_size C1("Old size in bytes.")@;
3581
{
3582
void HUGE *new_ptr;
3583
BUF_SIZE num_to_copy;
3584
size_t ncopied;
3585
3586
new_ptr = GET_MEM("hrealloc", new_size, char);
3587
3588
if(new_ptr == NULL)
3589
return NULL;
3590
3591
num_to_copy = MIN(old_size, new_size);
3592
ncopied = (size_t)num_to_copy;
3593
3594
if((BUF_SIZE)ncopied != num_to_copy)
3595
CONFUSION("hrealloc",
3596
"trying to copy %lu bytes; more than size_t", num_to_copy);
3597
3598
memcpy(new_ptr, old_ptr, ncopied);
3599
3600
FREE_MEM(old_ptr, "old_ptr", old_size, char);
3601
3602
return new_ptr;
3603
}
3604
3605
#endif /* |mcc| */
3606
3607
@* STORAGE of IDENTIFIERS and MODULE NAMES.
3608
Both \.{WEAVE} and \.{TANGLE} store identifiers, module names and
3609
other strings in a large array of |ASCII|s, called |byte_mem|.
3610
Information about the names is kept in the array |name_dir|, whose
3611
elements are structures of type \&{NAME\_INFO}, containing a pointer into
3612
the |byte_mem| array (the address where the name begins) and other data.
3613
A \&{name\_pointer} variable is a pointer into |name_dir|.
3614
3615
@<Allocate dynamic memory@>=
3616
3617
ALLOC(ASCII,byte_mem,ABBREV(max_bytes),max_bytes,0); // Characters of names.
3618
byte_end = byte_mem + max_bytes - 1; // End of |byte_mem|.
3619
3620
ALLOC(NAME_INFO,name_dir,ABBREV(max_names),max_names,0);
3621
// Information about names.
3622
name_end = name_dir + max_names - 1; // End of |name_dir|.
3623
3624
ALLOC(ASCII,mod_text,ABBREV(longest_name),longest_name,1);
3625
mod_end = mod_text+longest_name; // End of |mod_text|.
3626
3627
@I trunc.hweb
3628
3629
@ The actual sequence of characters in the name pointed to by a |name_pointer
3630
p| appears in positions |p->byte_start| to |(p+1)->byte_start|, inclusive.
3631
The |prn_id| macro prints this text on the user's terminal.
3632
3633
@<Part 2@>=@[
3634
3635
unsigned
3636
prn_id FCN((np))
3637
name_pointer np C1("")@;
3638
{
3639
ASCII_write(*np->byte_start == BP_MARKER ?
3640
((BP *)np->byte_start)->Root->id : np->byte_start,Length(np));
3641
3642
return PTR_DIFF(unsigned, np, name_dir);
3643
}
3644
3645
int
3646
Length FCN((np))
3647
name_pointer np C1("")@;
3648
{
3649
int n;
3650
BP HUGE *bp;
3651
TRUNC HUGE *s;
3652
CONST ASCII HUGE *p0;
3653
CONST ASCII HUGE *p1;
3654
3655
p0 = np->byte_start;
3656
bp = (BP *)p0;
3657
3658
if(*(char *)bp == BP_MARKER)
3659
{
3660
s = bp->Root;
3661
n = PTR_DIFF(int, s->id_end, s->id);
3662
}
3663
else
3664
{
3665
p1 = (np+1)->byte_start;
3666
PROPER_END(p1);
3667
n = PTR_DIFF(int, p1, p0);
3668
}
3669
3670
return n;
3671
}
3672
3673
@ The first unused position in |byte_mem| and |name_dir| is
3674
kept in |byte_ptr| and |name_ptr|, respectively. Thus we
3675
usually have |name_ptr->byte_start=byte_ptr|, and certainly
3676
we want to keep |name_ptr<=name_end| and |byte_ptr<=byte_end|.
3677
3678
@<Common...@>=
3679
3680
IN_COMMON name_pointer name_ptr; // First unused position in |byte_start|.
3681
IN_COMMON ASCII HUGE *byte_ptr; // First unused position in |byte_mem|.
3682
3683
@
3684
@<Initialize dynamic...@>=
3685
3686
CAST(name_pointer,name_dir)->byte_start=byte_ptr=byte_mem; /* position zero
3687
in both arrays */
3688
name_ptr=name_dir+1; /* |name_dir[0]| will not be used */
3689
CAST(name_pointer,name_ptr)->byte_start=byte_mem; /* this makes name 0 of
3690
length zero */
3691
3692
@ The names of identifiers are found by computing a hash address |h| and
3693
then looking at strings of bytes signified by the |name_pointer|s
3694
|hash[h]|, |hash[h]->link|, |hash[h]->link->link|, \dots,
3695
until either finding the desired name or encountering the null pointer.
3696
3697
The hash table itself consists of |hash_size| entries of type
3698
|name_pointer|, and is updated by the |id_lookup| procedure, which finds a
3699
given identifier and returns the appropriate |name_pointer|. The matching
3700
is done by the function |names_match|, which is slightly different in
3701
\.{WEAVE} and \.{TANGLE}. If there is no match for the identifier, it is
3702
inserted into the table.
3703
3704
@d hash_size 353 /* should be prime */
3705
3706
@ Initially all the hash lists are empty.
3707
3708
@<Initialize static...@>=
3709
3710
hash = GET_MEM("hash",hash_size,name_pointer);
3711
hash_end = hash + hash_size - 1;
3712
3713
for (h=hash; h<=hash_end; *h++=NULL) ;
3714
3715
@ Here is the main procedure for finding identifiers. The type of
3716
identifier being considered is held in the global variable |word_type| (set
3717
in \.{reserved.web}, function |save_id|; this comes into play when |last == NULL|.
3718
3719
@<Part 2@>=@[
3720
3721
name_pointer
3722
id_lookup FCN((first,last,t))
3723
CONST ASCII HUGE *first C0("First character of string.")@;
3724
CONST ASCII HUGE *last C0("last character of string plus one.")@;
3725
eight_bits t C1("The |ilk|; used by \.{WEAVE} only.")@;
3726
{
3727
CONST ASCII HUGE *i=first; /* position in |cur_buffer| */
3728
int h; /* hash code */
3729
int l; /* length of the given identifier */
3730
name_pointer p; /* where the identifier is being sought */
3731
WORD_TYPE word_type0 = ORDINARY_ID;
3732
3733
if(last == NULL)
3734
{
3735
word_type0 = word_type;
3736
3737
for (last=first; *last!='\0'; last++)
3738
; // Find end of identifier.
3739
}
3740
3741
l = PTR_DIFF(int,last,first); /* compute the length */
3742
@<Compute the hash code |h|@>;
3743
@<Compute the name location |p|@>;
3744
3745
if (p==name_ptr)
3746
@<Enter a new name into the table at position |p|@>;
3747
3748
if(!(p->Language & (boolean)language))
3749
p->ilk = t;
3750
3751
p->Language |= (boolean)language; /* Record language usage. This line is
3752
dangerous if one is using |id_lookup| for a query from a routine for a
3753
language other than the current one; see |ini_special_tokens|. */
3754
3755
switch(word_type0)
3756
{
3757
case RESERVED_WD:
3758
p->reserved_word |= (boolean)language;
3759
break;
3760
3761
case INTRINSIC_FCN:
3762
p->intrinsic_word |= (boolean)language;
3763
break;
3764
3765
case KEYWD:
3766
p->keyword |= (boolean)language;
3767
break;
3768
3769
default: ; /* Avoids warning about unused |enum|. */
3770
}
3771
3772
return p;
3773
}
3774
3775
@ The following two routines |find_n| and |find_s| are for rapid debugging
3776
of the |name_dir|. They are to be called from the debugger. |find_n| prints
3777
information about the $n$th~identifier; |find_s| prints information about
3778
the identifier named~|s|.
3779
3780
@<Part 2@>=@[
3781
3782
sixteen_bits
3783
find_n FCN((n))
3784
sixteen_bits n C1("")@;
3785
{
3786
name_pointer np;
3787
CONST ASCII HUGE *end;
3788
outer_char HUGE *s;
3789
size_t len;
3790
3791
np = name_dir + n;
3792
3793
if(np >= name_ptr)
3794
{
3795
printf("!! n = %u exceeds nmax = %u.\n", n,
3796
PTR_DIFF(unsigned, name_ptr, name_dir) - 1);
3797
return 0;
3798
}
3799
3800
PROPER_END(end);
3801
3802
len = PTR_DIFF(size_t, end, np->byte_start); // Length of the $n$th identifier.
3803
s = GET_MEM("find_n",len+1,outer_char); // Allocate temporary area.
3804
3805
STRNCPY(s,np->byte_start,len);
3806
TERMINATE(s,len);
3807
3808
/* Convert from |ASCII| to the outer world; print info about id. */
3809
to_outer((ASCII HUGE *)s);
3810
id_info(np,(long)n,(CONST outer_char *)s, NULL);
3811
FREE_MEM(s,"find_n",len+1,outer_char);
3812
3813
return n;
3814
}
3815
3816
sixteen_bits
3817
find_s FCN((s))
3818
CONST outer_char *s C1("")@;
3819
{
3820
int h,l;
3821
name_pointer p;
3822
ASCII HUGE *a;
3823
CONST ASCII HUGE *first, HUGE *last;
3824
CONST ASCII HUGE *i;
3825
sixteen_bits n = 0;
3826
3827
l = STRLEN(s);
3828
a = GET_MEM("find_s",l+1,ASCII);
3829
STRCPY(a,s);
3830
i = first = to_ASCII((outer_char *)a);
3831
last = first + l;
3832
3833
@<Compute the hash...@>@;
3834
p=hash[h];
3835
while (p && !(STRNCMP(first,p->byte_start,l) == 0))
3836
p = p->link;
3837
3838
if(p == NULL)
3839
{CLR_PRINTF(WARNINGS, warning, ("%cId \"%s\" is not in name_dir!\n",
3840
beep(1), (char *)s));}
3841
else
3842
id_info(p,(long)(n=(sixteen_bits)(p-name_dir)),s, NULL);
3843
3844
FREE_MEM(a,"find_s",l+1,ASCII);
3845
3846
return n;
3847
}
3848
3849
@I t_codes.hweb
3850
3851
@
3852
@<Part 2@>=@[
3853
3854
sixteen_bits
3855
find_id FCN((a0,a1))
3856
eight_bits a0 C0("")@;
3857
eight_bits a1 C1("")@;
3858
{
3859
return find_n(IDENTIFIER(a0,a1));
3860
}
3861
3862
@ The information utility used in |find_n| and |find_s|; also in |see_reserved|.
3863
@<Part 2@>=@[
3864
3865
SRTN
3866
id_info FCN((np,n,s,prsrvd))
3867
name_pointer np C0("")@;
3868
long n C0("")@;
3869
CONST outer_char *s C0("")@;
3870
CONST RSRVD HUGE *prsrvd C1("")@;
3871
{
3872
if(n >= 0)
3873
printf(_Xx("Id %ld (0x%lx):"),n,n);
3874
3875
if(!prsrvd
3876
|| (prsrvd->reserveds && np->reserved_word)
3877
|| (prsrvd->intrinsics && np->intrinsic_word)
3878
|| (prsrvd->keywords && np->keyword))
3879
printf(" \"%s\"\n", (char *)s);
3880
3881
if(!prsrvd)
3882
pr_lan("Language ", np->Language);
3883
3884
if(!prsrvd || prsrvd->reserveds)
3885
pr_lan("reserved ", np->reserved_word);
3886
3887
if(!prsrvd || prsrvd->intrinsics)
3888
pr_lan("intrinsic", np->intrinsic_word);
3889
3890
if(!prsrvd || prsrvd->keywords)
3891
pr_lan("keyword ", np->keyword);
3892
}
3893
3894
@
3895
@<Glob...@>=
3896
3897
IN_COMMON boolean info_option CSET(NO);
3898
IN_COMMON boolean see_rsrvd CSET(NO);
3899
IN_COMMON RSRVD rsrvd
3900
#if(part == 0 || part == 1)
3901
= {NULL, NO, NO, NO}
3902
#endif // |part == 1|
3903
;
3904
IN_COMMON outer_char HUGE *style_args CSET(NULL);
3905
IN_STYLE ASCII HUGE *at_codes;
3906
3907
@ Some info options can be executed only after dynamic memory is allocated.
3908
After that, if no web file was specified on the command line we just
3909
terminate gracefully.
3910
@<Execute deferred...@>=
3911
{
3912
if(rsrvd.args) see_reserved(&rsrvd);
3913
if(style_args) see_style(style_args, NO);
3914
3915
if(!found_web && info_option && !at_codes)
3916
wrap_up();
3917
}
3918
3919
@ Format the language dependence of a boolean variable~|b|, for debugging and
3920
the \.{-D}~option.
3921
3922
@<Part 2@>=@[
3923
3924
SRTN
3925
pr_lan FCN((name,b))
3926
CONST char *name C0("")@;
3927
boolean b C1("")@;
3928
{
3929
unsigned k; // For scanning over the 8 possibilities.
3930
boolean first = YES;
3931
3932
if(b==0)
3933
return; // Not turned on at all.
3934
3935
printf(" %s = { ",name);
3936
3937
for(k=1; k<=$EVAL(2^^8); k<<=1)
3938
if(k & b)
3939
{
3940
printf("%s%s", first ? "" : ", ",
3941
languages[lan_num((LANGUAGE)k)]);
3942
first = NO;
3943
}
3944
3945
if(first)
3946
printf("(none)");
3947
3948
printf(" }");
3949
3950
@% printf(_Xx(" (0x%x)"), b);
3951
3952
puts("");
3953
}
3954
3955
@ More debugging: Print out the entire |name_dir|.
3956
@<Part 2@>=@[
3957
3958
BUF_SIZE
3959
prn_nd(VOID)
3960
{
3961
BUF_SIZE k, n = name_ptr - name_dir;
3962
3963
for(k=0; k<n; k++)
3964
{
3965
printf("[%lu]: ", k);
3966
prn_id(name_dir + k);
3967
putchar('\n');
3968
}
3969
3970
return n;
3971
}
3972
3973
@ A simple hash code is used: If the sequence of
3974
ASCII codes is $c_1c_2\ldots c_n$, its hash value will be
3975
$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$
3976
3977
@<Compute the hash...@>=
3978
3979
h=*i;
3980
3981
while (++i<last) h=(h+h+*i) % hash_size;
3982
3983
@ If the identifier is new, it will be placed in position |p=name_ptr|,
3984
otherwise |p| will point to its existing location.
3985
3986
@<Compute the name location...@>=
3987
p=hash[h];
3988
3989
while (p && !names_match(p,first,l,t)) p=p->link;
3990
3991
if (p==NULL)
3992
{
3993
p=name_ptr; /* the current identifier is new */
3994
p->link=hash[h]; hash[h]=p; /* insert |p| at beginning of hash
3995
list */
3996
}
3997
3998
@ The information associated with a new identifier must be initialized
3999
in a slightly different way in \.{WEAVE} than in \.{TANGLE}; hence the
4000
|ini_p| procedure.
4001
4002
@<Enter a new name...@>=
4003
@B
4004
if (byte_ptr+l>byte_end) OVERFLW("bytes",ABBREV(max_bytes));
4005
if (name_ptr>=name_end) OVERFLW("names",ABBREV(max_names));
4006
4007
STRNCPY(byte_ptr,first,l);
4008
(++name_ptr)->byte_start = byte_ptr += l;
4009
4010
if (program==weave)
4011
ini_p(p,t);
4012
}
4013
4014
@ The names of modules are stored in |byte_mem| together
4015
with the identifier names, but a hash table is not used for them because
4016
\.{TANGLE} needs to be able to recognize a module name when given a prefix of
4017
that name. A conventional binary seach tree is used to retrieve module names,
4018
with fields called |llink| and |rlink| (where |llink| takes the place
4019
of |link|). The root of this tree is stored in |name_dir->rlink|;
4020
this will be the only information in |name_dir[0]|.
4021
4022
Since the space used by |rlink| has a different function for
4023
identifiers than for module names, we declare it as a |union|.
4024
4025
@ The binary search tree starts out with nothing in it.
4026
4027
@<Initialize dynamic...@>=
4028
4029
root = NULL;
4030
4031
@ The |mod_lookup| procedure finds a module name in the
4032
search tree, after inserting it if necessary, and returns a pointer to
4033
where it was found.
4034
4035
According to the rules of \.{WEB}, no module name should be a proper
4036
prefix of another, so a ``clean'' comparison should occur between any
4037
two names. The result of |mod_lookup| is |NULL| if this prefix condition
4038
is violated. An error message is printed when such violations are detected.
4039
(Note that the |LESS|, |EQUAL|, and |GREATER| conventions here are
4040
different than those for |strcmp|; they are defined in \.{typedefs.hweb}.)
4041
4042
@<Part 2@>=@[
4043
4044
name_pointer
4045
mod_lookup FCN((k,l))
4046
CONST ASCII HUGE *k C0("First character of name.")@;
4047
CONST ASCII HUGE *l C1("Last character of name.")@;
4048
{
4049
LEXI c = GREATER; /* comparison between two names */
4050
name_pointer p = root; /* current node of the search tree */
4051
name_pointer q = name_dir; /* father of node |p| */
4052
4053
while (p)
4054
{
4055
c = web_strcmp(k,l+1,p->byte_start,(p+1)->byte_start);
4056
q=p;
4057
4058
switch(c)
4059
{
4060
case LESS: p=p->llink; continue;
4061
case GREATER: p=p->rlink; continue;
4062
case EQUAL: return p;
4063
default: ERR_PRINT(C,"Incompatible section names");
4064
return NULL;
4065
@.Incompatible section names@>
4066
}
4067
}
4068
4069
return install_node(q,c,k,PTR_DIFF(int,l,k)+1);
4070
}
4071
4072
@ This function is like |strcmp|, but it does not assume the strings
4073
are null-terminated.
4074
4075
@<Part 2@>=@[
4076
4077
LEXI
4078
web_strcmp FCN((j,j1,k,k1)) /* fuller comparison than |strcmp| */
4079
CONST ASCII HUGE *j C0("Beginning of first string.")@;
4080
CONST ASCII HUGE *j1 C0("End of first string plus one.")@;
4081
CONST ASCII HUGE *k C0("Beginning of second string.")@;
4082
CONST ASCII HUGE *k1 C1("End of second string plus one.")@;
4083
{
4084
while (k<k1 && j<j1 && *j==*k) k++, j++;
4085
4086
if (k==k1) if (j==j1) return EQUAL;
4087
else return EXTENSION;
4088
else if (j==j1) return PREFIX;
4089
else if (*j<*k) return LESS;
4090
else return GREATER;
4091
}
4092
4093
@ The reason we initialized |c| to |greater| is so that |name_pointer| will
4094
make |name_dir->rlink| point to the root of the tree when |q=name_dir|,
4095
that is, the first time it is called.
4096
4097
The information associated with a new node must be initialized in a
4098
slightly different way in \.{WEAVE} than in \.{TANGLE}; hence the
4099
|ini_node| procedure.
4100
4101
@<Part 2@>=@[
4102
4103
name_pointer
4104
install_node FCN((parent,c,j,name_len)) /* install a new node in the tree */
4105
name_pointer parent C0("Parent of new node.")@;
4106
int c C0("Right or left?")@;
4107
CONST ASCII HUGE *j C0("Where replacement text starts.")@;
4108
int name_len C1("length of replacement text.")@;
4109
{
4110
name_pointer node=name_ptr; /* new node */
4111
if (byte_ptr+name_len>byte_end) OVERFLW("bytes",ABBREV(max_bytes));
4112
if (name_ptr==name_end) OVERFLW("names",ABBREV(max_names));
4113
4114
if (c==LESS) parent->llink=node; else parent->rlink=node;
4115
4116
node->llink=node->rlink=NULL;
4117
ini_node(node);
4118
STRNCPY(byte_ptr,j,name_len);
4119
(++name_ptr)->byte_start=byte_ptr+=name_len;
4120
return node;
4121
}
4122
4123
@ The |prefix_lookup| procedure is supposed to find exactly one module name
4124
that has |k..l| as a prefix. Actually the algorithm silently accepts also
4125
the situation that some module name is a prefix of |k..l|, because the user
4126
who painstakingly typed in more than necessary probably doesn't want to be
4127
told about the wasted effort.
4128
4129
@<Part 2@>=@[
4130
4131
name_pointer
4132
prefix_lookup FCN((k,l)) /* finds module name given a prefix */
4133
CONST ASCII HUGE *k C0("First char of prefix.")@;
4134
CONST ASCII HUGE *l C1("Last char of prefix.")@;
4135
{
4136
LEXI c = GREATER; /* comparison between two names */
4137
short count = 0; /* the number of hits */
4138
name_pointer p = root; /* current node of the search tree */
4139
name_pointer q = NULL;
4140
/* another place to resume the search after one is done */
4141
name_pointer r = NULL; /* extension found */
4142
while (p) {
4143
c=web_strcmp(k,l+1,p->byte_start,(p+1)->byte_start);
4144
4145
switch(c) {
4146
case LESS: p=p->llink; break;
4147
case GREATER: p=p->rlink; break;
4148
default: r=p; count++; q=p->rlink; p=p->llink;
4149
}
4150
4151
if (p==NULL) {
4152
p=q; q=NULL;
4153
}
4154
}
4155
if (count==0) ERR_PRINT(C,"Name does not match");
4156
@.Name does not match@>
4157
else if (count>1) ERR_PRINT(C,"Ambiguous prefix");
4158
@.Ambiguous prefix@>
4159
4160
return r; /* the result will be |NULL| if there was no match */
4161
}
4162
4163
@ Here's a routine to be called from the debugger; it returns the directory
4164
number and the full name of a prefix.
4165
@<Part 2@>=@[
4166
4167
unsigned
4168
find_prefix FCN((s))
4169
outer_char s[] C1("")@;
4170
{
4171
name_pointer r;
4172
4173
to_ASCII(s);
4174
r = prefix_lookup((ASCII HUGE *)s,(ASCII HUGE *)(s+STRLEN(s)));
4175
4176
return r ? prn_id(r) : 0;
4177
}
4178
4179
@ The last component of |name_info| is different for \.{TANGLE} and
4180
\.{WEAVE}. In \.{TANGLE}, if |p| is a pointer to a module name, |p->equiv|
4181
is a pointer to its replacement text, an element of the array |text_info|.
4182
In \.{WEAVE}, on the other hand, if |p| points to an identifier, |p->xref|
4183
is a pointer to its list of cross-references, an element of the array
4184
|xmem|. The make-up of |text_info| and |xmem| is discussed in the
4185
\.{TANGLE} and \.{WEAVE} source files, respectively; here we just declare a
4186
common field |equiv_or_xref| as a pointer to an |ASCII|.
4187
4188
@* REPORTING ERRORS to the USER.
4189
The command `|ERR_PRINT(origin,"Error message")|' will report a syntax
4190
error to the user, by printing the error message at the beginning of a new
4191
line and then giving an indication of where the error was spotted in the
4192
source file. Note that no period follows the error message, since the
4193
error routine will automatically supply a period. The |origin| argument is
4194
one of~|C|, |T|, |W|, |R|, or~|M|; these are translated by the macro into
4195
things like |ERR_C|, an enumerated type that says where the error came
4196
from. More generally, one can say |err_print(origin,msg,args)|, where
4197
|msg| can be formatted as for |printf| and |n|~specifies how many arguments
4198
follow. Thus, |ERR_PRINT| is a special case of |err_print| with $n = 0$.
4199
4200
The actual error indications are provided by a procedure called |error|.
4201
However, error messages are not actually reported during phase one, since
4202
errors detected on the first pass will be detected again during the second.
4203
4204
@<Glob...@>=
4205
4206
IN_COMMON CONST char *origin_name[]
4207
#if(part == 0 || part == 1)
4208
= {"","COMMON","FTANGLE","FWEAVE","RATFOR","MACROS","STYLE",".fweb"}
4209
#endif // |part == 1|
4210
;
4211
4212
@
4213
@<Part 2@>=@[
4214
4215
SRTN
4216
err0_print FCN(VA_ALIST((err_origin,fmt,n VA_ARGS)))
4217
VA_DCL(
4218
ERR_ORIGIN err_origin C0("Where the error came from")@;
4219
CONST outer_char *fmt C0("Format of error message.")@;
4220
int n C2("Number of arguments to the string.")@;)@;
4221
{
4222
VA_LIST(arg_ptr)@;
4223
ASCII HUGE *k, HUGE *l; /* pointers into |cur_buffer| */
4224
char temp[500];
4225
boolean prn_input_buffer;
4226
boolean newline_first;
4227
#if(NUM_VA_ARGS == 1)
4228
ERR_ORIGIN err_origin;
4229
CONST outer_char *fmt;
4230
int n;
4231
#endif
4232
4233
VA_START(arg_ptr, n);
4234
4235
#if(NUM_VA_ARGS == 1)
4236
err_origin = va_arg(arg_ptr,ERR_ORIGIN);
4237
fmt = va_arg(arg_ptr,outer_char *);
4238
va_arg(arg_ptr,int);
4239
#endif
4240
4241
prn_input_buffer = BOOLEAN(err_origin!=ERR_NULL);
4242
4243
if(n < 0)
4244
{
4245
n = -(n+1);
4246
newline_first = NO;
4247
}
4248
else
4249
newline_first = YES;
4250
4251
if(prn_input_buffer && err_origin != ERR_S && newline_first)
4252
putchar('\n');
4253
4254
SET_COLOR(error);
4255
4256
if(prn_input_buffer)
4257
{
4258
printf("! ");
4259
CLR_PRINTF(ALWAYS, md_name, ("(%s)", origin_name[err_origin]));
4260
sprintf(temp,": %s", (char *)fmt);
4261
vprintf(temp, arg_ptr);
4262
}
4263
else
4264
vprintf((char *)fmt, arg_ptr);
4265
4266
va_end(arg_ptr);
4267
4268
if(prn_input_buffer)
4269
{
4270
outer_char last_char = fmt[STRLEN(fmt)-1];
4271
4272
if(*fmt && last_char != '?' && last_char != '!')
4273
printf(".");
4274
/* Sometimes the third argument to |fatal| is empty,
4275
so the period isn't necessary; or the phrase ends
4276
with a question mark or exclamation point. */
4277
4278
if(err_origin == ERR_S)
4279
@<Print error location based on style file buffer@>@;
4280
else
4281
@<Print error location based on input buffer@>@;
4282
}
4283
4284
fflush(stdout); mark_error;
4285
4286
if(prn_input_buffer && err_origin != ERR_S && !newline_first)
4287
putchar('\n');
4288
4289
mfree(); // Free up any |mod_trans| allocations.
4290
4291
free_buf(&sput_buf);
4292
set_color(NORMAL);
4293
}
4294
4295
@ The error locations can be indicated by using the global variables |loc|,
4296
|cur_line|, |cur_file_name| and |changing|, which tell respectively the
4297
first unlooked-at position in |cur_buffer|, the current line number, the
4298
current file, and whether the current line is from |change_file| or
4299
|cur_file|. This routine should be modified on systems whose standard text
4300
editor has special line-numbering conventions. @^system dependencies@>
4301
4302
@d MAX_ERR_BUF 160
4303
4304
@<Print error location based on input buffer@>=
4305
{
4306
if(cur0_prms)
4307
{
4308
if (changing)
4309
{
4310
CLR_PRINTF(ALWAYS, line_num,
4311
(" (l. %u of %s file ", change_line, "change"));
4312
CLR_PRINTF(ALWAYS, in_file, ("%s)\n", (char *)change_file_name));
4313
}
4314
else if (incl_depth==WEB_FILE)
4315
{
4316
CLR_PRINTF(ALWAYS, line_num, (" (l. %u)\n", cur_line));
4317
}
4318
else
4319
{
4320
CLR_PRINTF(ALWAYS, line_num,
4321
(" (l. %u of %s file ",cur_line,"include"));
4322
CLR_PRINTF(ALWAYS, in_file,("%s)\n", (char *)cur_file_name));
4323
}
4324
4325
l = MIN(loc,limit);
4326
4327
SET_COLOR(ordinary);
4328
4329
if (l>cur_buffer && cur_buffer!=NULL)
4330
{
4331
if((BUF_SIZE)(l-cur_buffer) > buf_size)
4332
{
4333
CLR_PRINTF(ALWAYS, error,
4334
("! TROUBLE IN ERROR ROUTINE. PLEASE REPORT THIS!\n"));
4335
mark_error;
4336
4337
l = cur_buffer + MAX_ERR_BUF;
4338
}
4339
4340
for (k=cur_buffer; k<l; k++)
4341
if (*k==@'\t')
4342
putchar(' '); // Convert tab to space.
4343
else
4344
putchar(*k > 127 ? ' ' : XCHR(*k));
4345
/* print the characters already read */
4346
4347
putchar('\n'); // Separate already read from not yet read.
4348
4349
multi_chars(' ', l - cur_buffer); // Space out the next line.
4350
}
4351
4352
if(l != NULL)
4353
{
4354
if((BUF_SIZE)(limit-l) > buf_size)
4355
{
4356
puts("! TROUBLE IN ERROR ROUTINE. PLEASE REPORT THIS!");
4357
l = limit - MAX_ERR_BUF;
4358
}
4359
4360
for (k=l; k<limit; k++)
4361
putchar(*k > 127 ? ' ' : XCHR(*k));
4362
/* print the part not yet read */
4363
}
4364
if(limit != NULL)
4365
if (*limit==@'|') putchar('|'); // End of code text in module names.
4366
4367
putchar(' '); // To separate the message from future asterisks.
4368
err_happened = YES;
4369
}
4370
}
4371
4372
@ Print a character multiple times.
4373
@a
4374
SRTN
4375
multi_chars FCN((c, n))
4376
outer_char c C0("Character to print")@;
4377
int n C1("Number of times to print")@;
4378
{
4379
while(--n >= 0)
4380
putchar(c);
4381
}
4382
4383
@
4384
@<Print error location based on style file buffer@>=
4385
{
4386
CONST outer_char HUGE *k, HUGE *l;
4387
IN_STYLE boolean from_sprm;
4388
4389
printf(" (l. %u of %s file ", s_line, "style");
4390
CLR_PRINTF(ALWAYS, in_file, ("%s)\n",
4391
from_sprm ? "parameter buffer" : (char *)style_file_name));
4392
4393
l = MIN(sloc,slimit);
4394
4395
for (k=sbuf; k<l; k++)
4396
putchar(*k > 127 ? ' ' : (*k == '\t' ? ' ' : *k));
4397
// Print the characters already read.
4398
4399
putchar('\n'); // Separate already read from not yet read.
4400
4401
multi_chars(' ', l - sbuf); // Space out the next line.
4402
4403
for (k=l; k<slimit; k++)
4404
putchar(*k > 127 ? ' ' : *k); // Print the part not yet read.
4405
4406
putchar('\n');
4407
}
4408
4409
@ When no recovery from some error has been provided, we have to wrap up
4410
and quit as graciously as possible. This is done by calling the function
4411
|wrap_up| at the end of the code.
4412
4413
@<Part 2@>=@[
4414
4415
int
4416
fatal FCN(VA_ALIST((err_origin, s1, fmt VA_ARGS)))
4417
VA_DCL(
4418
ERR_ORIGIN err_origin C0("Where the error came from")@;
4419
CONST outer_char s1[] C0("Basic message.")@;
4420
CONST outer_char fmt[] C2("Elaboration.")@;)@;
4421
{
4422
VA_LIST(arg_ptr)@;
4423
#if(NUM_VA_ARGS == 1)
4424
ERR_ORIGIN err_origin;
4425
CONST outer_char s1[];
4426
CONST outer_char fmt[];
4427
#endif
4428
outer_char temp[500];
4429
4430
VA_START(arg_ptr, fmt);
4431
4432
#if(NUM_VA_ARGS == 1)
4433
err_origin = va_arg(arg_ptr, ERR_ORIGIN);
4434
s1 = va_arg(arg_ptr, outer_char *);
4435
fmt = va_arg(arg_ptr, outer_char *);
4436
#endif
4437
4438
printf("\n");
4439
if(err_origin != ERR_NULL)
4440
{
4441
CLR_PRINTF(ALWAYS, fatal, ("! "));
4442
CLR_PRINTF(ALWAYS, md_name, ("(%s)", origin_name[err_origin]));
4443
CLR_PRINTF(ALWAYS, fatal, (": "));
4444
}
4445
CLR_PRINTF(ALWAYS, fatal,((char *)s1));
4446
4447
vsprintf((char *)temp, (CONST char *)fmt, arg_ptr);
4448
err0_print(ERR_NULL, temp, 0);
4449
4450
history = FATAL_MESSAGE;
4451
4452
va_end(arg_ptr);
4453
4454
return wrap_up(); /* It never really returns, but the compiler doesn't
4455
know that. */
4456
}
4457
4458
@ Sometimes the program's behavior is far different from what it should be,
4459
and \.{WEB} prints an error message that is really for the \.{WEB}
4460
maintainance person, not the user. In such cases the program says
4461
|confusion("indication of where we are","what went wrong")|. The second
4462
argument is actually a format in the style of |printf|, and there may
4463
optionally be additional arguments that are printed into the format.
4464
4465
Note that this function doesn't really return. It's coded this way so
4466
compilers don't give spurious warnings.
4467
@<Part 2@>=@[
4468
4469
int
4470
confusion FCN(VA_ALIST((where, fmt0 VA_ARGS)))
4471
VA_DCL(
4472
CONST outer_char where[] C0("")@;
4473
CONST outer_char fmt0[] C2("")@;)@;
4474
{
4475
outer_char fmt[200], temp[200];
4476
VA_LIST(arg_ptr)@;
4477
#if(NUM_VA_ARGS == 1)
4478
CONST outer_char where[];
4479
CONST outer_char fmt0[];
4480
#endif
4481
4482
VA_START(arg_ptr, fmt0);
4483
4484
#if(NUM_VA_ARGS == 1)
4485
where = va_arg(arg_ptr, outer_char *);
4486
fmt0 = va_arg(arg_ptr, outer_char *);
4487
#endif
4488
4489
SPRINTF(200, fmt, `"\n At %s: %s.", where, fmt0`);
4490
vsprintf((char *)temp, (CONST char *)fmt, arg_ptr);
4491
4492
beep(3);
4493
4494
return FATAL(NULL, "\n!!! \
4495
I'M CONFUSED; this shouldn't happen. PLEASE REPORT THIS!!! ", temp);
4496
}
4497
@.This shouldn't happen@>
4498
4499
@ An overflow stop occurs if \.{WEB}'s tables aren't large enough.
4500
@<Part 2@>=@[
4501
4502
SRTN
4503
overflow FCN((s,abbrev))
4504
CONST outer_char s[] C0("Condition that caused overflow.")@;
4505
CONST outer_char abbrev[] C1("Abbreviation for buffer.")@;
4506
{
4507
if(*abbrev == '\0')
4508
{
4509
FATAL(NULL,
4510
"!!! Sorry, CAPACITY EXCEEDED: ",
4511
"%s contents too long.", (char *)s);
4512
}
4513
else
4514
{
4515
MEM HUGE *m = msearch(abbrev,0L);
4516
4517
FATAL(NULL,
4518
"!!! Sorry, CAPACITY EXCEEDED: ",
4519
"Too many %s. Current number is %lu, absolute max is \
4520
%lu. Use command-line option \"-y%s...\" to override default.",
4521
(char *)s, m->nunits, m->max, (char *)abbrev);
4522
}
4523
}
4524
@.Sorry, capacity exceeded@>
4525
4526
@ A special case of |overflow| is useful for style-file parameters.
4527
@<Part 2@>=@[
4528
4529
SRTN
4530
new_sprm FCN((name, value))
4531
CONST outer_char name[] C0("Name of parameter.")@;
4532
int value C1("Integer value of parameters.")@;
4533
{
4534
char temp[100];
4535
4536
sprintf(temp, "Please increase style-file parameter `%s' from current value \
4537
of %i;", name, value);
4538
OVERFLW(temp, "");
4539
}
4540
4541
@ Some implementations may wish to pass the |history| value to the
4542
operating system so that it can be used to govern whether or not other
4543
programs are started. Here, for instance, we pass the Unix operating system
4544
a status of~ 0 if and only if only harmless messages were printed.
4545
@^system dependencies@>
4546
4547
@<Part 2@>=@[
4548
4549
#if(VMS)
4550
#include stsdef // Return codes.
4551
#endif /* |VMS| */
4552
4553
int
4554
wrap_up(VOID)
4555
{
4556
/* --- Finish up --- */
4557
if(statistics)
4558
see_statistics(); /* Invoked by command-line option~\.{-s}.
4559
(\FTANGLE\ and \FWEAVE\ each has its own version of
4560
|see_statistics|.) */
4561
4562
#if TIMING
4563
prn_time();
4564
#endif // |TIMING|
4565
4566
@<Print the job |history|@>@;
4567
@<Close all open files@>@;
4568
4569
SET_COLOR(ordinary);
4570
4571
#if(VMS)
4572
switch(history)
4573
{
4574
case SPOTLESS: exit(STS$K_SUCCESS | STS$M_INHIB_MSG);
4575
case HARMLESS_MESSAGE: exit(STS$K_INFO | STS$M_INHIB_MSG);
4576
case ERROR_MESSAGE: exit(STS$K_ERROR | STS$M_INHIB_MSG);
4577
case FATAL_MESSAGE: exit(STS$K_SEVERE | STS$M_INHIB_MSG);
4578
}
4579
#else
4580
switch(history)
4581
{
4582
case SPOTLESS:
4583
case HARMLESS_MESSAGE:
4584
exit(0);
4585
4586
default:
4587
exit(1); // Some reasonably serious error occurred.
4588
}
4589
#endif // |VMS|
4590
4591
return -1; // Never really does this.
4592
}
4593
4594
@ With some systems, it seems to be helpful to close the open files
4595
explicitly, rather than letting |exit| do it. I don't know why.
4596
4597
@<Close all open files@>=
4598
{
4599
if(cur_prms.web && cur_prms.web->File)
4600
fclose(cur_prms.web->File);
4601
4602
if(cur_prms.change && cur_prms.change->File)
4603
fclose(cur_prms.change->File);
4604
4605
cls_files(); // Do stuff specific to \FTANGLE\ or \FWEAVE.
4606
}
4607
4608
@
4609
@<Print the job |history|@>=
4610
{
4611
if(msg_level >= SHORT_INFO
4612
|| (msg_level >= WARNINGS && history >= HARMLESS_MESSAGE)
4613
|| (history >= ERROR_MESSAGE))
4614
{
4615
putchar('\n');
4616
CLR_PRINTF(ALWAYS, program_name,
4617
("[%s:",program==tangle ? TANGLE : WEAVE));
4618
printf(" ");
4619
}
4620
4621
switch(history)
4622
{
4623
case SPOTLESS:
4624
CLR_PRINTF(SHORT_INFO, info,
4625
("No errors were found."));
4626
break;
4627
4628
case HARMLESS_MESSAGE:
4629
CLR_PRINTF(WARNINGS, warning,
4630
("%cDid you see the warning message(s) above?", beep(1)));
4631
break;
4632
4633
case ERROR_MESSAGE:
4634
CLR_PRINTF(ALWAYS, error,
4635
("%cPardon me, but I think I spotted something wrong.", beep(1)));
4636
break;
4637
4638
case FATAL_MESSAGE:
4639
CLR_PRINTF(ALWAYS, fatal,
4640
("%cThat was a fatal error, my friend.", beep(2)));
4641
break;
4642
} // There are no other cases.
4643
4644
if(msg_level >= SHORT_INFO
4645
|| (msg_level >= WARNINGS && history >= HARMLESS_MESSAGE)
4646
|| (history >= ERROR_MESSAGE))
4647
CLR_PRINTF(ALWAYS, program_name, ("]\n"));
4648
4649
set_color(NORMAL);
4650
}
4651
4652
@ Certain errors beep the terminal. The beeps can be turned off (and
4653
replaced by an exclamation point) with the \.{-B} option.
4654
@<Part 2@>=@[
4655
4656
char
4657
beep FCN((n))
4658
int n C1("")@;
4659
{
4660
if(beeps)
4661
{
4662
for(--n; n>0; n--)
4663
printf("\007");
4664
4665
fflush(stdout);
4666
4667
return '\007'; // (Some compilers didn't understand \.{'\\a'}.)
4668
}
4669
else
4670
return '!';
4671
}
4672
4673
@ The following error routine is called if there's problem with writing.
4674
Usually, this means that you've run out of disk space.
4675
@<Part 2@>=@[
4676
4677
SRTN
4678
out_error FCN((fcn))
4679
CONST outer_char fcn[] C1("")@;
4680
{
4681
FATAL(C,
4682
"Output error",
4683
"from %s (quota exceeded?).",
4684
fcn);
4685
}
4686
4687
4688
@ Here is a function that accepts either \.{yes} or \.{no} from the
4689
keyboard, then returns~1 or~0.
4690
4691
@<Part 2@>=@[
4692
4693
boolean
4694
verify FCN(VA_ALIST((fmt VA_ARGS)))
4695
VA_DCL(
4696
CONST outer_char fmt[] C2("")@;)@;
4697
{
4698
VA_LIST(arg_ptr)@;
4699
outer_char buf[80];
4700
4701
VA_START(arg_ptr, fmt);
4702
vprintf_((CONST char *)fmt, arg_ptr)@;
4703
va_end(arg_ptr);
4704
4705
printf(" [");
4706
CLR_PRINTF(ALWAYS, info, ("yes"));
4707
printf("/");
4708
CLR_PRINTF(ALWAYS, error, ("no"));
4709
printf("]? "), fflush(stdout);
4710
4711
WHILE()
4712
{
4713
SET_COLOR(ordinary);
4714
gets((char *)buf);
4715
4716
if(STRCMP(buf, "yes") == 0 || STRCMP(buf, "no") == 0)
4717
break;
4718
4719
SET_COLOR(error);
4720
printf(">>> Please answer ``yes'' or ``no'': ");
4721
fflush(stdout);
4722
}
4723
4724
return (STRCMP(buf, "yes") == 0);
4725
}
4726
4727
@* INITIALIZING FLAGS.
4728
4729
@<Initialize \TeX\ cat...@>=
4730
{
4731
int k;
4732
4733
for(k=0; k<128; k++)
4734
TeX[k] = TeX_other;
4735
4736
for(k=@'A'; k<=@'Z'; k++)
4737
TeX[k] = TeX_letter;
4738
4739
for(k=@'a'; k<=@'z'; k++)
4740
TeX[k] = TeX_letter;
4741
4742
TeX[@'\\'] = TeX_escape;
4743
TeX[@'{'] = TeX_bgroup;
4744
TeX[@'}'] = TeX_egroup;
4745
TeX[@'$'] = TeX_math_shift;
4746
TeX[@'&'] = TeX_alignment_tab;
4747
TeX[@'\n'] = TeX_eol;
4748
TeX[@'#'] = TeX_parameter;
4749
TeX[@'^'] = TeX_superscript;
4750
TeX[@'_'] = TeX_subscript;
4751
TeX[0] = TeX_ignored;
4752
TeX[@' '] = TeX[tab_mark] = TeX_space;
4753
TeX[@'~'] = TeX_active;
4754
TeX[@'%'] = TeX_comment;
4755
TeX[0177] = TeX_invalid;
4756
}
4757
4758
@ We don't initialize the flags statically because it's too tedious to get
4759
the initialization list right if one adds a flag randomly.
4760
4761
@<Initialize flags@>=
4762
{
4763
params.uses = 0; // For safety.
4764
4765
#define FSET(flag) = flag
4766
4767
active_brackets FSET(ACTIVE_BRACKETS); // Special array handling?
4768
all_cmnts_verbatim FSET(ALL_CMNTS_VERBATIM); /* Should \.{TANGLE} copy
4769
all comments? */
4770
all_includes FSET(ALL_INCLUDES); // Cross-reference all include files?
4771
auto_app_semi FSET(AUTO_APP_SEMI); /* For \.{WEAVE}, automatically
4772
append a pseudo-semi to the end of \.{WEB} macro definitions? */
4773
auto_line FSET(AUTO_LINE); // Auto-insert line nums after \.{@@\%}?
4774
4775
/* Append automatic semicolon or pseudo-semicolon? */
4776
params.Auto_semi[LN(FORTRAN)]
4777
= params.Auto_semi[LN(FORTRAN_90)] = YES;
4778
params.Auto_semi[LN(RATFOR)]
4779
= params.Auto_semi[LN(RATFOR_90)]
4780
= params.Auto_semi[LN(C)]
4781
= params.Auto_semi[LN(C_PLUS_PLUS)]
4782
= params.Auto_semi[LN(LITERAL)]
4783
= params.Auto_semi[LN(TEX)]
4784
= NO;
4785
4786
/* Which do we append: pseudo or actual? */
4787
params.Auto_pseudo_semis[LN(FORTRAN)]
4788
= params.Auto_pseudo_semis[LN(RATFOR)]
4789
= params.Auto_pseudo_semis[LN(RATFOR_90)]
4790
= params.Auto_pseudo_semis[LN(C)]
4791
= params.Auto_pseudo_semis[LN(C_PLUS_PLUS)]
4792
= params.Auto_pseudo_semis[LN(LITERAL)]
4793
= params.Auto_pseudo_semis[LN(TEX)]
4794
= NO;
4795
4796
params.Auto_pseudo_semis[LN(FORTRAN_90)] FSET(AUTO_PSEUDO_SEMIS);
4797
// F90 code: append pseudo-semis, not semis.
4798
4799
params.Beeps FSET(BEEPS);
4800
4801
/* Do we label |do|s and |if|s with the block number? */
4802
params.Block_nums[LN(C)]
4803
= params.Block_nums[LN(C_PLUS_PLUS)]
4804
= params.Block_nums[LN(LITERAL)]
4805
= params.Block_nums[LN(TEX)]
4806
= NO;
4807
4808
params.Block_nums[LN(FORTRAN)]
4809
= params.Block_nums[LN(FORTRAN_90)]
4810
= params.Block_nums[LN(RATFOR)]
4811
= params.Block_nums[LN(RATFOR_90)]
4812
= BLOCK_NUMS;
4813
4814
bslash_continued_strings FSET(BSLASH_CONTINUED_STRINGS); /* Do the
4815
continuations of strings require a starting backslash? */
4816
chk_ifelse FSET(CHK_IFELSE); // Protect parenthesized strings?
4817
chk_stmts FSET(CHK_STMTS); // Check statement syntax in \Ratfor?
4818
compare_outfiles FSET(COMPARE_OUTFILES);// Compare new vs.\ old output.
4819
compound_assignments FSET(COMPOUND_ASSIGNMENTS); /* Do we allow things
4820
like \.{+=}? */
4821
Cpp FSET(NO); /* Do we recognize \.{C++}? */
4822
4823
dbg_output FSET(DBG_OUTPUT); // Print output characters?
4824
deferred_macros FSET(DEFERRED_MACROS); // Allow deferred macros?
4825
4826
defn_mask.outer_macros FSET(PRN_OUTER_MACROS);
4827
defn_mask.formats FSET(PRN_fORMATS);
4828
defn_mask.Formats FSET(PRN_FORMATS);
4829
defn_mask.limbo FSET(PRN_LIMBO);
4830
defn_mask.macros FSET(PRN_MACROS);
4831
defn_mask.v FSET(PRN_V);
4832
defn_mask.w FSET(PRN_W);
4833
4834
dot_constants FSET(DOT_CONSTANTS); // Recognize dot constants?
4835
4836
params.CPP_comments[LN(C)]
4837
= params.CPP_comments[LN(C_PLUS_PLUS)]
4838
= params.CPP_comments[LN(LITERAL)]
4839
= params.CPP_comments[LN(TEX)]
4840
= CPP_COMMENTS;
4841
4842
/* For \Fortran\ and \Ratfor, the \.{//}~is preempted for concatenation.
4843
Therefore, its use for short comments must be turned on explicitly. */
4844
params.CPP_comments[LN(FORTRAN)]
4845
= params.CPP_comments[LN(FORTRAN_90)]
4846
= params.CPP_comments[LN(RATFOR)]
4847
= params.CPP_comments[LN(RATFOR_90)]
4848
= NO;
4849
4850
Fortran88 FSET(FORTRAN88); // Turn on stuff for Fortran-88?
4851
Fortran_label FSET(FORTRAN_LABEL); // Label on same line?
4852
4853
params.Free_form_input[LN(FORTRAN)]
4854
= params.Free_form_input[LN(LITERAL)]
4855
= params.Free_form_input[LN(TEX)]
4856
= NO;
4857
params.Free_form_input[LN(RATFOR)]
4858
= params.Free_form_input[LN(RATFOR_90)]
4859
= params.Free_form_input[LN(C)]
4860
= params.Free_form_input[LN(C_PLUS_PLUS)]
4861
= params.Free_form_input[LN(FORTRAN_90)]
4862
= YES;
4863
4864
keep_trailing_comments FSET(KEEP_TRAILING_COMMENTS); // For \TeX.
4865
ignore_C FSET(IGNORE_C); // Throw away single \Fortran\ comment lines.
4866
4867
params.In_escape[LN(FORTRAN)]
4868
= params.In_escape[LN(FORTRAN_90)]
4869
= '&';
4870
params.In_escape[LN(RATFOR)]
4871
= params.In_escape[LN(RATFOR_90)]
4872
= params.In_escape[LN(C)]
4873
= params.In_escape[LN(C_PLUS_PLUS)]
4874
= params.In_escape[LN(LITERAL)]
4875
= params.In_escape[LN(TEX)]
4876
= '\\';
4877
4878
in_escape FSET(IN_ESCAPE); // Default continuation character.
4879
index_hidden FSET(INDEX_HIDDEN); // Index skipped includes files.
4880
index_one FSET(INDEX_ONE); // Index single-character identifiers?
4881
input_macros FSET(INPUT_MACROS); /* Generate the default ``\.{\\input
4882
fwebmac.tx}'' line? */
4883
lc_keywords FSET(LC_KEYWORDS); // Lower-case \Fortran\ keywords?
4884
line_info FSET(LINE_INFO); // Should \FTANGLE\ print out line info?
4885
lowercase_tokens FSET(LOWERCASE_TOKENS); // Output lower-case tokens?
4886
m4 FSET(M4_);
4887
makeindex FSET(MAKEINDEX); // Output a \.{makeindex} file?
4888
no_xref FSET(NO_XREF); // Should \.{WEAVE} print an index?
4889
number_dos FSET(NUMBER_DOS);
4890
nuweb_mode FSET(NUWEB_MODE); // Emulate \.{nuweb}?
4891
overload_ops FSET(OVERLOAD_OPS); // Is operator overloading allowed?
4892
4893
params.Point_comments[LN(C)]
4894
= params.Point_comments[LN(C_PLUS_PLUS)]
4895
= params.Point_comments[LN(TEX)]
4896
= params.Point_comments[LN(LITERAL)]
4897
= NO;
4898
params.Point_comments[LN(FORTRAN)]
4899
= params.Point_comments[LN(FORTRAN_90)]
4900
= params.Point_comments[LN(RATFOR)]
4901
= params.Point_comments[LN(RATFOR_90)]
4902
= POINT_COMMENTS; /* Does \.! signify a Fortran comment? */
4903
4904
prn_contents FSET(PRN_CONTENTS); // Print the table of contents?
4905
prn_index FSET(PRN_INDEX); // Print the index?
4906
prn_input_lines FSET(NO); /* Used in |input_ln| to print out the
4907
lines sent back. */
4908
prn_input_addresses FSET(NO); /* Print out the buffer addresses. */
4909
prn_modules FSET(PRN_MODULES); // Print the module list?
4910
prn_semis FSET(PRN_SEMIS); // Print semicolons in \Fortran\ output?
4911
4912
quoted_includes FSET(QUOTED_INCLUDES);
4913
// Cross-reference quoted include files?
4914
Ratfor77 FSET(RATFOR77); /* Expand \Ratfor\ code directly to
4915
\Fortran-77? */
4916
read_iformats FSET(READ_IFORMATS); // Read include files for formats.
4917
params.Reverse_indices[LN(C)]
4918
= params.Reverse_indices[LN(C_PLUS_PLUS)]
4919
= params.Reverse_indices[LN(TEX)]
4920
= params.Reverse_indices[LN(LITERAL)]
4921
= NO;
4922
params.Reverse_indices[LN(FORTRAN)]
4923
= params.Reverse_indices[LN(FORTRAN_90)]
4924
= params.Reverse_indices[LN(RATFOR)]
4925
= params.Reverse_indices[LN(RATFOR_90)]
4926
= REVERSE_INDICES; // C-style indexing in \Fortran?
4927
rmv_files FSET(RMV_FILES); // Remove temporary files related to \.{-H}?
4928
4929
skip_ifiles FSET(SKIP_IFILES); // \.{-j} --- skip files already included.
4930
skip_includes FSET(SKIP_INCLUDES); /* For \.{WEAVE}, don't read in \.{@@I}
4931
commands. (Uppercase '\.{I}' only.) */
4932
statistics FSET(STATISTICS); /* Print statistics about memory usage? */
4933
stop_the_scan FSET(YES); /* */
4934
subscript_fcns FSET(YES); // Module references on functions?
4935
suppress_cmds FSET(YES); /* ??? */
4936
toggle_includes FSET(TOGGLE_INCLUDES); /* For \.{WEAVE}, read in
4937
\.{@@I} commands, but don't print them out. */
4938
top_version FSET(TOP_VERSION); /* Header info at top of output? */
4939
translate_ASCII FSET(TRANSLATE_ASCII0); /* Do we bother with the
4940
|xchr|--|xord| conversions? */
4941
translate_brackets FSET(TRANSLATE_BRACKETS); /* Do we translate
4942
brackets to parentheses in \Fortran? */
4943
truncate_ids FSET(NO); /* Shorten identifiers? */
4944
try_extensions FSET(TRY_EXTENSIONS); // Try various file names.
4945
TeX_processor FSET(TEX_PROCESSOR); // Default \TeX\ processor.
4946
xref_unnamed FSET(XREF_UNNAMED); // Xref unnamed stuff.
4947
#undef FSET
4948
4949
#if(TRANSLATE_ASCII || DEBUG_XCHR)
4950
translate_ASCII = YES; // Force it for the cases that really need it.
4951
#endif
4952
4953
/* The following ensures that |ini_language| will work right. (It
4954
references |global_params|.) */
4955
global_params = params;
4956
}
4957
4958
@ When we're scanning for identifiers, we have sometimes to do a
4959
byte-by-byte comparison looking for special strings. These have to be
4960
|ASCII|, not ordinary compiler strings. Thus, we initialize them here.
4961
4962
@<Common...@>=
4963
4964
IN_COMMON ASCII HUGE *pformat,HUGE *pdefault, HUGE *pdata,
4965
HUGE *pbp, HUGE *pinclude, HUGE *ppragma, HUGE *pcontains;
4966
4967
@ We must translate the |outer_char| strings into |ASCII|.
4968
4969
@<Initialize static...@>=
4970
{
4971
pformat = x__to_ASCII(OC("format"));
4972
pdata = x__to_ASCII(OC("data"));
4973
pdefault = x__to_ASCII(OC("default"));
4974
pbp = x__to_ASCII(OC("_BP"));
4975
pinclude = x__to_ASCII(OC("include"));
4976
ppragma = x__to_ASCII(OC("pragma"));
4977
4978
conv_bi(incl_likes);
4979
conv_bi(WEB_incl_likes);
4980
conv_bi(non_labels);
4981
4982
conv_dot(dots0);
4983
conv_dot(mcmds);
4984
}
4985
4986
@* COMMAND-LINE ARGUMENTS.
4987
The user calls \.{WEAVE} and \.{TANGLE} with arguments on the command line.
4988
These are either file names or flags (beginning with |'-'|).
4989
The following globals are for communicating the user's desires to the rest
4990
of the program. The various file name variables contain strings with
4991
the names of those files.
4992
4993
See the user manual for a detailed description of the various flags.
4994
4995
4996
@<Common...@>=
4997
4998
IN_COMMON outer_char outp_buf[MAX_OUTPUT_LINE_LENGTH];
4999
// FORTRAN's output buffer.
5000
IN_COMMON int nbuf_length CSET(72);
5001
5002
IN_COMMON outer_char wbprefix[MAX_FILE_NAME_LENGTH];
5003
// Possible directory prefix for the web file name.
5004
5005
/* Signifies the end of a directory prefix. */
5006
IN_COMMON outer_char prefix_end_char CSET(PREFIX_END_CHAR);
5007
5008
IN_COMMON boolean all_std CSET(NO); // Do we route all output to |stdout|?
5009
5010
@ We now must look at the command line arguments and set the file names
5011
accordingly. At least one file name must be present: the \.{WEB}
5012
file. It may have an extension, or it may omit it to get |'.web'|
5013
added. The \TeX\ output file name is formed by replacing the \.{WEB}
5014
file name extension by |'.tex'|, and the code output file name by replacing
5015
the extension by~|'.c'|, |'.rat'|, or~|'.for'|.
5016
5017
If there is another file name present among the arguments, it is the
5018
change file, again either with an extension or without one to get~|'.ch'|
5019
An omitted change file argument means that \.{/dev/null} (for Unix),
5020
\.{nl:} (for VMS), or \.{NUL} (for DOS) should be used, when no
5021
changes are desired. (These default extensions are in the style file, and
5022
can be overridden.)
5023
@^system dependencies@>
5024
5025
The following function should be superceded by ANSI's |strchr|.
5026
@<Unused@>=
5027
5028
char HUGE *index FCN((s,c)) /* this is standard, but the name is not */
5029
char HUGE *s C0("String to be searched.")@;
5030
char c C1("Search for this character.")@;
5031
{
5032
while (*s!=c && *s!='\0')
5033
s++;
5034
if (*s=='\0') return NULL;
5035
return s;
5036
}
5037
5038
@*1 Scanning command-line arguments.
5039
|scan_args| is the major routine that handles
5040
the command-line arguments. If a command-line option doesn't begin with a
5041
hyphen, it's a file name. If it just a hyphen, it means ``\.{stdin}''.
5042
Otherwise, it's an option.
5043
5044
@<Glob...@>=
5045
5046
IN_COMMON boolean found_web,found_change; // Have these names been seen?
5047
IN_COMMON outer_char wbflnm0[MAX_FILE_NAME_LENGTH];
5048
// The root name of the web file.
5049
5050
@
5051
@<Part 2@>=@[
5052
5053
SRTN
5054
scan_args(VOID)
5055
{
5056
outer_char wbflnm[MAX_FILE_NAME_LENGTH];
5057
5058
/* Build the command line in a buffer. */
5059
cmd_ln_buf = cmd_line(argc, argv);
5060
5061
/* Add the arguments from the ini file \.{.fweb}. This resets |argc| and
5062
|argv|, and also ignores |argv[0]| from the command line. */
5063
set_args(&argc, &argv);
5064
5065
/* Process all the arguments in order from left to right. */
5066
do_args(YES, argc, argv, &found_web, wbflnm, &found_change);
5067
5068
banner(); // Start-up banner.
5069
5070
if(statistics)
5071
mem_avail(0); /* How much memory is available at start? */
5072
5073
@<Get the path and root file name@>@;
5074
5075
@<Read the style file@>@;
5076
5077
@<Make |web_file_name|, |tex_fname| and output file names@>;
5078
5079
if (!(found_web || info_option))
5080
usage("!! Missing webfile name.\n", YES);
5081
5082
if (!found_change)
5083
*change_file_name = '\0'; // This means null file.
5084
}
5085
5086
@ Here we allocate a buffer and build the command line into it.
5087
5088
@d WEAVE_LINE0 OC("{\"")
5089
@d TANGLE_LINE0 OC(" COMMAND LINE: \"")
5090
5091
@d WEAVE_LINE1 OC("\"} ")
5092
@d TANGLE_LINE1 OC("\"")
5093
5094
@d ESCAPE_LENGTH 256
5095
5096
@<Part 2@>=@[
5097
5098
outer_char HUGE *
5099
cmd_line FCN((num_args,args))
5100
int num_args C0("Number of arguments on command line.")@;
5101
outer_char *args[] C1("Array of pointers to arguments.")@;
5102
{
5103
int k,len,l0,l1;
5104
outer_char HUGE *buf,HUGE *b, HUGE *line0, HUGE *line1;
5105
outer_char p[ESCAPE_LENGTH]; /* The escaped argument. */
5106
5107
if(program==tangle)
5108
{
5109
line0 = TANGLE_LINE0;
5110
line1 = TANGLE_LINE1;
5111
}
5112
else
5113
{
5114
line0 = WEAVE_LINE0;
5115
line1 = WEAVE_LINE1;
5116
}
5117
5118
/* Determine required buffer length. */
5119
for(k=0,len=0; k<num_args; len += STRLEN(args[k++]) + 1) ;
5120
5121
l0 = STRLEN(line0);
5122
l1 = STRLEN(line1);
5123
buf = GET_MEM("buf", 2*(len+l0+l1), outer_char);
5124
STRCPY(buf,line0);
5125
b = buf + l0;
5126
5127
while(num_args-- > 0)
5128
{
5129
int n = esc_file_name(p, ESCAPE_LENGTH, *(args++));
5130
5131
STRNCPY(b, p, n);
5132
b += n;
5133
*b++ = ' ';
5134
}
5135
5136
STRCPY(--b, line1); /* Kill off final blank. */
5137
return buf;
5138
}
5139
5140
@*1 Processing {\tt .fweb}.
5141
Here we handle the initialization file
5142
\.{.fweb}. If it exists, it is opened. Arguments beginning with a '\.-' are
5143
placed before the command-line arguments (\.+ also works for backward
5144
compatibility); those beginning with a '\.\&' are placed after the
5145
command-line arguments.
5146
5147
@<Glob...@>=
5148
5149
IN_COMMON outer_char
5150
HUGE * HUGE *ini_args,
5151
// Arguments read from the ini file; allocated dynamically.
5152
HUGE * HUGE *new_args, /* The new list of all arguments; allocated
5153
dynamically. */
5154
HUGE * HUGE *pn; // Pointer to the current new argument being processed.
5155
IN_COMMON outer_char HUGE * HUGE *pn0; // Marks end of ini args.
5156
IN_COMMON outer_char HUGE * HUGE *pn1; // Marks end of cmd-line args.
5157
IN_COMMON FILE *ini_file CSET(NULL); // The ini file \.{.fweb}.
5158
5159
@
5160
5161
@d MAX_INI_ARGS 100 // Max \# of arguments in the ini file.
5162
@d T_SIZE 200 // Buffer length for |fgets|.
5163
@d INI_CMNT_CHAR '%'
5164
5165
@d BEFORE_CHAR '-'
5166
@d MIDDLE_CHAR '0'
5167
@d AFTER_CHAR '&'
5168
5169
@<Part 2@>=@[
5170
5171
SRTN
5172
set_args FCN((pargc,pargv))
5173
int HUGE *pargc C0("Pointer to the arg count; new value returned.")@;
5174
outer_char HUGE * HUGE * *pargv C1("Ptr to the array of ptrs; returned.")@;
5175
{
5176
int k,n;
5177
outer_char HUGE *buffer, // Put one line from ini file into here.
5178
HUGE *temp, HUGE *t, // Extract the argument into here.
5179
HUGE * HUGE *a, // The current ini arg.
5180
HUGE *pc; // Pointer to possible comment character in ini line.
5181
boolean blank;
5182
outer_char ini_file_name[MAX_FILE_NAME_LENGTH];
5183
5184
/* Allocate temporary buffers. */
5185
buffer = GET_MEM("buffer",T_SIZE,outer_char);
5186
temp = GET_MEM("temp",T_SIZE,outer_char);
5187
5188
/* We start by assuming there is no ini file, hence no argument. */
5189
k = 0; // Argument count.
5190
5191
ini_args = GET_MEM("ini_args", MAX_INI_ARGS, outer_char HUGE *);
5192
5193
@<Make ini file name and try to open it@>@;
5194
5195
/* If there is an ini file, then put the arguments into an array. */
5196
if(ini_file)
5197
@<Read \.{.fweb}@>@;
5198
5199
/* Allocate space for all the arguments, both ini and command-line. (We
5200
don't count |argv[0]| from command line.) */
5201
pn = new_args = GET_MEM("new_args", n=*pargc-1+k, outer_char HUGE *);
5202
5203
acopy(BEFORE_CHAR, ini_args, k);
5204
// Put those starting with '\.+' or '\.-' first.
5205
pn0 = pn; // Mark end of the ini stuff.
5206
5207
acopy(MIDDLE_CHAR, (outer_char HUGE **)(*pargv), *pargc);
5208
// Then the command-line arguments.
5209
5210
pn1 = pn; // Mark end of command-line arguments.
5211
5212
acopy(AFTER_CHAR, ini_args, k); // Then the rest.
5213
5214
/* Return the new number and array of arguments. */
5215
*pargc = n;
5216
*pargv = new_args;
5217
5218
FREE_MEM(ini_args, "ini_args", MAX_INI_ARGS, outer_char HUGE *);
5219
FREE_MEM(buffer, "buffer", T_SIZE, char);
5220
FREE_MEM(temp, "temp", T_SIZE, char);
5221
}
5222
5223
@ We will look for the ini file in the user's root directory, if possible.
5224
We determine this by querying the environment with |getenv|.
5225
5226
@d HOME OC("HOME") // The Unix-standard name for the top-level directory.
5227
@d ENV_INI OC("FWEB_INI") // Default root name to use.
5228
@d ENV_INCLUDES OC("FWEB_INCLUDES") // The include path for \FWEB\ files.
5229
@d ENV_HDR_INCLUDES OC("FWEB_HDR_INCLUDES") // \.{gcc -I} options.
5230
5231
@<Make ini file...@>=
5232
@B
5233
outer_char *p_root, ini_root[MAX_FILE_NAME_LENGTH];
5234
5235
#if HAVE_GETENV /* \.{Machine-dependent}: Understands |getenv|. */
5236
p_root = GETENV(ENV_INI);
5237
5238
if(p_root)
5239
STRCPY(ini_root, p_root);
5240
else
5241
STRCPY(ini_root, OC(FWEB_INI));
5242
5243
more_includes(&incl, GETENV(ENV_INCLUDES)); // Included \FWEB\ files.
5244
more_includes(&hdr_incl, GETENV(ENV_HDR_INCLUDES));
5245
// Included C files to be scanned by preprocessor.
5246
#else
5247
STRCPY(ini_root, OC(FWEB_INI));
5248
#endif // |HAVE_GETENV|
5249
5250
ini_file = FOPEN(mk_fname(ini_file_name, MAX_FILE_NAME_LENGTH,
5251
HOME, YES, ini_root), "r");
5252
}
5253
5254
@ Here we read the initialization file, if we could open it.
5255
5256
@<Read \.{.fweb}@>=
5257
{
5258
outer_char CONST HUGE *b, HUGE *blimit;
5259
5260
#if 0
5261
reading(ini_file_name, NO); // Can't print this here; msg level isn't set.
5262
#endif
5263
5264
for(a=ini_args; k<MAX_INI_ARGS; )
5265
{
5266
if(FGETS(buffer, T_SIZE, ini_file)==NULL)
5267
break; // Read one line (including newline).
5268
5269
blimit = buffer + STRLEN(buffer) - 1;
5270
// Position of end-of-line, excluding newline.
5271
5272
/* Extract the string, disgarding the newline. If the line is blank, do
5273
nothing. */
5274
blank = YES;
5275
5276
for(t=temp,b=buffer; b < blimit; )
5277
switch(*b)
5278
{
5279
case INI_CMNT_CHAR:
5280
goto done;
5281
5282
case '"':
5283
case '\'':
5284
blank = NO;
5285
@<Get ini string@>@;
5286
goto done; // Should check for trailing spurious text.
5287
5288
case ' ':
5289
*t = '\0';
5290
for(b++; b<blimit; b++)
5291
if(*b != INI_CMNT_CHAR)
5292
{
5293
err_print(F, "Garbage after option `%s' ignored", temp);
5294
putchar('\n');
5295
goto done;
5296
}
5297
5298
default:
5299
blank = NO;
5300
5301
*t++ = *b++; // Copy one character of argument.
5302
break;
5303
}
5304
5305
done:
5306
*t = '\0'; // Terminate the argument.
5307
5308
if(blank)
5309
continue;
5310
5311
if(t==temp)
5312
continue; // The line was entirely a comment.
5313
5314
*a = GET_MEM("ini arg", STRLEN(temp)+1, outer_char);
5315
// Space for the argument.
5316
STRCPY(*a++, temp); // Store ini argument.
5317
k++; // Count arguments found.
5318
}
5319
5320
FCLOSE(ini_file);
5321
5322
#if 0
5323
if(msg_level >= SHORT_INFO)
5324
putchar('\n'); // End of reading message.
5325
#endif
5326
}
5327
5328
@
5329
@<Get ini string@>=
5330
{
5331
outer_char delim = *b; // Opening and closing character of string.
5332
5333
*t++ = *b++; // Store opening delimiter.
5334
5335
while(*b != delim)
5336
{
5337
if(b == blimit)
5338
{
5339
err_print_(F, ".fweb: Missing quote inserted at end of string. \
5340
Did you mean to continue the line with '\\'? \
5341
(No white space is allowed after the '\\'.)");
5342
*t++ = delim;
5343
goto done;
5344
}
5345
5346
if(*b == '\\')
5347
{
5348
if(++b == blimit)
5349
{ /* Line is continued. */
5350
FGETS(buffer, T_SIZE, ini_file);
5351
blimit = buffer + STRLEN(buffer);
5352
b = buffer;
5353
continue;
5354
}
5355
else
5356
*t++ = '\\';
5357
}
5358
5359
*t++ = *b++; // Ordinary character within string.
5360
}
5361
5362
*t++ = *b++; // Store terminating quote.
5363
}
5364
5365
@ The list of include paths is allocated only as necessary.
5366
@<Glob...@>=
5367
5368
IN_COMMON INCL_PATHS incl;
5369
IN_COMMON INCL_PATHS hdr_incl;
5370
5371
@ This function adds more entries to the include list. The list is
5372
constructed in the format \.{$\alpha$:$\beta$:$\gamma$:}; in other words,
5373
entries are terminated by a colon.
5374
5375
@<Part 2@>=@[
5376
5377
SRTN
5378
more_includes FCN((pincl, incl_list0))
5379
INCL_PATHS *pincl C0("Structure to fill")@;
5380
outer_char *incl_list0 C1("")@;
5381
{
5382
unsigned n;
5383
BUF_SIZE old_size;
5384
5385
if(!incl_list0)
5386
return;
5387
5388
/* Strip off useless opening colon. */
5389
while(*incl_list0 == ':')
5390
incl_list0++;
5391
5392
if((n = STRLEN(incl_list0)) == 0)
5393
return;
5394
5395
old_size = incl.size;
5396
pincl->size += n + 2; // Allow for trailing colon and null byte.
5397
5398
if(!pincl->list)
5399
{ /* List hasn't been allocated yet. */
5400
pincl->list = GET_MEM("incl_list", pincl->size, outer_char);
5401
STRCPY(pincl->list, incl_list0);
5402
pincl->num = chr_cnt(pincl->list, ':'); // Count number of entries.
5403
}
5404
else
5405
{ /* Add more to the list. */
5406
pincl->list = (outer_char HUGE *)REALLOC(pincl->list, pincl->size,
5407
old_size);
5408
5409
if(pincl->list == NULL)
5410
FATAL(NULL,
5411
"!! NO MORE MEMORY",
5412
" (more_includes)");
5413
5414
STRCAT(pincl->list, incl_list0);
5415
pincl->num += chr_cnt(incl_list0, ':');
5416
}
5417
5418
/* Ensure list ends in a colon. */
5419
if(pincl->list[n-1] != ':')
5420
{
5421
pincl->list[n] = ':';
5422
pincl->num++;
5423
}
5424
}
5425
5426
@
5427
@<Part 2@>=@[
5428
5429
int
5430
chr_cnt FCN((s, c))
5431
outer_char *s C0("String to be searched for occurrences of |c|")@;
5432
outer_char c C1("Search character")@;
5433
{
5434
int n;
5435
5436
for(n=0; *s; s++)
5437
if(*s == c)
5438
n++;
5439
5440
return n;
5441
}
5442
5443
5444
@
5445
@<Part 2@>=@[
5446
5447
char *
5448
mk_fname FCN((buffer,buf_len,env_var,print_msg,file_name))
5449
outer_char *buffer C0("Put result here.")@;
5450
unsigned buf_len C0("Length of |buffer|.")@;
5451
CONST outer_char *env_var C0("Variable that holds directory name.")@;
5452
boolean print_msg C0("Flag for not recognizing |env_var|.")@;
5453
CONST outer_char *file_name C1("The raw file name.")@;
5454
{
5455
outer_char *directory; // Will hold result of |getenv|.
5456
5457
#if HAVE_GETENV /* \.{Machine-dependent}: Understands |getenv|. */
5458
if( (directory=GETENV(env_var)) == NULL)
5459
{
5460
if(print_msg)
5461
printf("! I can't find environment \
5462
variable \"%s\", so I'll look for file \"%s\" \
5463
in directory \"%s\".\n",
5464
(char *)env_var, (char *)file_name,
5465
*wbprefix ? (char *)wbprefix : ".");
5466
if(buf_chk(file_name,buf_len,
5467
STRLEN(file_name)+STRLEN(wbprefix)))
5468
return (char *)wt_style.null_file_name;
5469
STRCPY(buffer,wbprefix);
5470
STRCAT(buffer,file_name);
5471
}
5472
else
5473
{ /* Got a directory from the environment variable. */
5474
if(buf_chk(file_name,buf_len,
5475
STRLEN(directory)+1+STRLEN(file_name)))
5476
return (char *)wt_style.null_file_name;
5477
/* For Unix, home is of the form
5478
\.{/u/krommes}; for VMS, it's like \.{ux3:[krommes]}. */
5479
#if !UNIX_PATH
5480
SPRINTF(buf_len,buffer,`"%s%s",directory,file_name`);
5481
#else
5482
SPRINTF(buf_len,buffer,`"%s%c%s",directory,prefix_end_char,file_name`);
5483
#endif // |!UNIX_PATH|
5484
}
5485
#else /* Doesn't understand |getenv|. */
5486
if(buf_chk(file_name,buf_len,STRLEN(file_name)))
5487
return (char *)wt_style.null_file_name;
5488
STRCPY(buffer,file_name);
5489
#endif // |CAN_GETENV|
5490
5491
return (char *)buffer;
5492
}
5493
5494
@ Make sure we don't overrun a file buffer.
5495
@<Part 2@>=@[
5496
5497
boolean
5498
buf_chk FCN((file_name,buf_len,needed))
5499
CONST outer_char *file_name C0("Raw file name")@;
5500
unsigned buf_len C0("Max space available")@;
5501
unsigned needed C1("Requested")@;
5502
{
5503
if(needed >= buf_len)
5504
{
5505
printf("\n! Buffer too small to make complete file name from \
5506
\"%s\"; opened \"%s\"\n", (char *)file_name, (char *)wt_style.null_file_name);
5507
return YES;
5508
}
5509
5510
return NO;
5511
}
5512
5513
@ Here we copy from an old argument array to the new one. If the argument
5514
begins with a~'\.+', that is changed to a~'\.-'.
5515
@<Part 2@>=@[
5516
5517
SRTN
5518
acopy FCN((c,a,n))
5519
outer_char c C0("Starting symbol.")@;
5520
outer_char HUGE **a C0("Old array.")@;
5521
int n C1("Number of arguments to be looked at.")@;
5522
{
5523
boolean is_before = BOOLEAN(c==BEFORE_CHAR || c=='+');
5524
boolean is_middle = BOOLEAN(c==MIDDLE_CHAR);
5525
boolean is_after = BOOLEAN(c==AFTER_CHAR);
5526
int k;
5527
5528
/* Disgard the zeroth argument from the command line. */
5529
if(is_middle)
5530
{
5531
k = 1;
5532
a++;
5533
}
5534
else
5535
k = 0;
5536
5537
/* Look at all the arguments; copy them if appropriate. */
5538
for(; k<n; k++,a++)
5539
{
5540
boolean before_entry = BOOLEAN((*a)[0] == BEFORE_CHAR || (*a)[0] == '+');
5541
5542
/* The following somewhat inscrutable logic puts file names and ``after''
5543
entries from \.{.fweb} into the ``after'' list. */
5544
if( (!is_before && !before_entry) || (!is_after && before_entry) )
5545
{
5546
*pn = GET_MEM("*pn", STRLEN(*a)+1, outer_char);
5547
STRCPY(*pn, *a);
5548
if((*pn)[0] == '+' || (*pn)[0] == AFTER_CHAR)
5549
(*pn)[0] = BEFORE_CHAR;
5550
pn++;
5551
}
5552
}
5553
}
5554
5555
@*1 Making file names.
5556
We use all of |pa=*argv| for the |web_file_name| if
5557
there is a~|'.'| in it, otherwise add |'.web'|. \It{This has to be
5558
augmented for VMS!} The other file names come from adding things after the
5559
dot. We must check that there is enough room in |web_file_name| and the
5560
other arrays for the argument.
5561
5562
If the output file name was already set by~`\.{->}', we do nothing, except if
5563
it contains a~`\.\#' we expand that into the |wbflnm0|. If it was not set,
5564
we add the extension determined from the style file.
5565
5566
@m SET_NAME(l,labbrev) set_name(l,wt_style.output_ext.labbrev##_)
5567
5568
@<Make |web_file_name...@>=
5569
{
5570
int k;
5571
5572
/* \WEAVE's output file. */
5573
xpn_name(&tex_fname, MAX_FILE_NAME_LENGTH, tex_fname, wbflnm0);
5574
if(*tex_fname == '\0')
5575
new_fname(&tex_fname, wbflnm0, OC("tex"));
5576
5577
/* \TANGLE's output files. */
5578
for(k=0; k<NUM_LANGUAGES; k++)
5579
xpn_name(params.outp_nm+k, MAX_FILE_NAME_LENGTH,
5580
params.outp_nm[k], wbflnm0);
5581
5582
SET_NAME(C,C);
5583
SET_NAME(C_PLUS_PLUS,Cpp);
5584
SET_NAME(LITERAL,V);
5585
SET_NAME(FORTRAN,N);
5586
SET_NAME(FORTRAN_90,N90);
5587
SET_NAME(RATFOR,R);
5588
SET_NAME(RATFOR_90,R90);
5589
SET_NAME(TEX,X);
5590
}
5591
5592
@
5593
@<Get the path...@>=
5594
{
5595
outer_char HUGE *dot_pos;
5596
outer_char HUGE *p = NULL;
5597
5598
if (STRLEN(wbflnm) > MAX_FILE_NAME_LENGTH-5)
5599
too_long();
5600
5601
if(STRCMP(wbflnm,"stdin") == 0) STRCPY(web_file_name,wbflnm);
5602
else
5603
{
5604
p = OC(STRRCHR(wbflnm,prefix_end_char)); // Is there a path?
5605
5606
if((dot_pos=OC(STRCHR(p ? p+1 : wbflnm,wt_style.ext_delimiter)))==NULL
5607
&& !try_extensions)
5608
{ /* Attach ``\.{.web}'' as a default. */
5609
SPRINTF(MAX_FILE_NAME_LENGTH,web_file_name,`"%s%cweb",
5610
wbflnm,wt_style.ext_delimiter`);
5611
}
5612
else { /* There's a dot, or we're trying extensions; treat the
5613
name as is. */
5614
SPRINTF(MAX_FILE_NAME_LENGTH,web_file_name,`"%s",wbflnm`);
5615
5616
if(!try_extensions)
5617
TERMINATE(dot_pos,0); /* string now ends where the
5618
dot was */
5619
}
5620
}
5621
5622
@<Extract the basic file name and the directory prefix@>@;
5623
}
5624
5625
@
5626
@<Part 2@>=@[
5627
5628
SRTN
5629
set_name FCN((l,output_ext))
5630
LANGUAGE l C0("")@;
5631
outer_char *output_ext C1("")@;
5632
{
5633
int k;
5634
5635
if(*params.outp_nm[k=lan_num(l)] == '\0')
5636
new_fname(params.outp_nm+k,wbflnm0,output_ext);
5637
}
5638
5639
@ We will always write into the current directory. Thus, we strip off all
5640
leading subdirectory information.
5641
@<Extract...@>=
5642
{
5643
if(p)
5644
{ /* Path was specified. */
5645
STRNCPY(wbprefix,wbflnm,
5646
PTR_DIFF(size_t,p,(outer_char HUGE *)wbflnm)+1); // Path.
5647
STRCPY(wbflnm0,p+1); // Root name.
5648
}
5649
else
5650
{ /* No path specification. */
5651
TERMINATE(wbprefix,0); // No path.
5652
STRCPY(wbflnm0,wbflnm); // Root name.
5653
}
5654
}
5655
5656
@ Here we search for an embedded~`\.\#' and expand that into the web file
5657
name. The construction `\.{\#\#}' is replaced by a single~`\.\#'.
5658
5659
@<Part 2@>=@[
5660
5661
outer_char HUGE *
5662
xpn_name FCN((pout_name, buf_len, in_name, wbflnm0))
5663
outer_char HUGE * HUGE *pout_name C0("The expanded result")@;
5664
int buf_len C0("Length of above buffer")@;
5665
CONST outer_char *in_name C0("File name possibly having a \.\#.")@;
5666
CONST outer_char wbflnm0[] C1("Basic name of the web file.")@;
5667
{
5668
size_t n; /* Length of the root name. */
5669
outer_char HUGE *t,HUGE *t0=NULL;
5670
boolean buffered = BOOLEAN(*pout_name == in_name);
5671
5672
if(buffered)
5673
t = t0 = GET_MEM("xpn buffer",buf_len,outer_char);
5674
else
5675
t = *pout_name;
5676
5677
for(; *in_name; in_name++)
5678
if(*in_name == '#')
5679
{
5680
if(in_name[1] == '#')
5681
*t++ = *in_name++;
5682
5683
else
5684
{
5685
n = STRLEN(wbflnm0);
5686
STRNCPY(t,wbflnm0,n);
5687
t += n;
5688
}
5689
}
5690
else
5691
*t++ = *in_name;
5692
5693
TERMINATE(t,0);
5694
5695
if(buffered)
5696
{
5697
new_fname(pout_name, t0, NULL);
5698
FREE_MEM(t0, "xpn buffer", buf_len,outer_char);
5699
}
5700
5701
return *pout_name;
5702
}
5703
5704
5705
@*1 Processing the {\tt .aux} file.
5706
When |TeX_processor == LaTeX_p|, the \.{.aux} file is read if it is
5707
present. Information from the \.{\\Newlabel} commands is accumulated and
5708
used to translate module numbers in error messages.
5709
5710
@d AUX_LEN 200
5711
@d MAX_MOD_NAMES 3 // No more than this many names in one error message.
5712
5713
@<Typed...@>=
5714
5715
typedef struct
5716
{
5717
outer_char *secno; // The \LaTeX\ section number.
5718
sixteen_bits pageno, modno0;
5719
boolean subpage_flag; // |YES| if more than one section per page.
5720
} SECT_INFO;
5721
5722
IN_COMMON SECT_INFO HUGE *sect_info;
5723
5724
IN_COMMON outer_char HUGE * HUGE *mod_names;
5725
IN_COMMON outer_char HUGE * HUGE *next_mod_name, HUGE * HUGE *last_mod_name;
5726
5727
@
5728
@<Allocate dynamic...@>=
5729
5730
ALLOC(SECT_INFO, sect_info, ABBREV(max_modules), max_modules, 0);
5731
5732
@ Open the \.{.aux} file, read and process each line of the file. If the
5733
line begins with ``\.{\\Newlabel}'', then the line is parsed. The same
5734
logic as in \.{fwebmac.web} is used to set the |subpage_flag| to |NO| if
5735
there is only one section per page, or to |YES| if there are more than one.
5736
5737
@<Part 2@>=@[
5738
5739
SRTN
5740
read_aux(VOID)
5741
{
5742
outer_char aux_file_name[MAX_FILE_NAME_LENGTH];
5743
FILE *fa;
5744
outer_char buffer[AUX_LEN];
5745
int aline = 0; // Counts line in the \.{.aux} file.
5746
sixteen_bits modno, modno0;
5747
outer_char smodno[100], smodno0[100], spageno[10], ssecno[100];
5748
int n;
5749
SECT_INFO *ps; // Points to current info structure.
5750
int pmcount = 1; // Number of sections per page.
5751
long modno_ref = -1; /* Last reference module number. It's |long| to deal
5752
with the possibility of 16-bit integers, where |-1| would be the
5753
maximum module number. */
5754
5755
next_mod_name = mod_names = GET_MEM("mod_names", MAX_MOD_NAMES,
5756
outer_char HUGE *@e);
5757
last_mod_name = mod_names + MAX_MOD_NAMES;
5758
5759
if(TeX_processor != LaTeX_p)
5760
return;
5761
5762
@<Determine \.{aux} file name and try to open it@>@;
5763
5764
modno = 0; // In case there's nothing in the \.{.aux} file.
5765
5766
while(FGETS(buffer,AUX_LEN,fa))
5767
{
5768
aline++;
5769
5770
if(STRNCMP(buffer,"\\Newlabel",9) != 0)
5771
continue;
5772
5773
@<Parse a \.{\\Newlabel} line@>@;
5774
}
5775
5776
sect_info[modno].subpage_flag = BOOLEAN(pmcount != 1);
5777
fclose(fa);
5778
}
5779
5780
@
5781
@<Determine \.{aux}...@>=
5782
{
5783
outer_char *dot_pos; // For finding extension in file name.
5784
5785
dot_pos = OC(STRCHR(tex_fname, wt_style.ext_delimiter));
5786
5787
if(dot_pos == NULL)
5788
n = STRLEN(tex_fname);
5789
else
5790
n = PTR_DIFF(int, dot_pos, tex_fname);
5791
5792
STRNCPY(aux_file_name, tex_fname, n);
5793
SPRINTF(MAX_FILE_NAME_LENGTH, aux_file_name+n,`"%caux",
5794
wt_style.ext_delimiter`);
5795
5796
fa = FOPEN(aux_file_name, "r");
5797
5798
if(!fa)
5799
{
5800
SET_COLOR(info);
5801
printf("(No ");
5802
CLR_PRINTF(ALWAYS, in_file, ("%s", (char *)aux_file_name));
5803
printf(" file.)\n");
5804
return;
5805
}
5806
else
5807
reading(aux_file_name, YES);
5808
5809
}
5810
5811
@
5812
@a
5813
void
5814
seea(int n, char *s)
5815
{
5816
printf("Arg %i = \"%s\"\n", n, s);
5817
}
5818
5819
@ The format of the \.{\\Newlabel} line is
5820
``\.{\\Newlabel\{12\}\{\{1.11\}\{5\}\}\{10\}}''. In the original scheme,
5821
we used the ANSI |sscanf|
5822
\.{\%[\dots]} format command to read the contents of the braces as
5823
strings. However, that didn't work for complicated arguments that included
5824
nested braces. So now we do it right, taking account of brace levels.
5825
5826
@<Parse a \.{\\New...@>=
5827
{
5828
#if(!ANSI_SSCANF)
5829
{
5830
ERR_PRINT(C,"Sorry, non-ANSI sscanf; can't read .aux file");
5831
return;
5832
}
5833
#endif
5834
5835
#if 0
5836
n = sscanf((char *)(buffer+9),"%*c%[^}]%*3c%[^}]%*2c%[^}]%*3c%[^}]",
5837
(char *)smodno, (char *)ssecno, (char *)spageno, (char *)smodno0);
5838
5839
if(n != 4)
5840
{
5841
err_print(C,"Invalid \\Newlabel format in %s file, line %d",
5842
aux_file_name, aline);
5843
return;
5844
}
5845
#endif
5846
5847
if(setjmp(top_of_get_arg) == 0)
5848
{
5849
outer_char *p, *q;
5850
outer_char arg2[100];
5851
5852
p = (outer_char *)STRCHR(buffer, '{');
5853
p = get_arg(smodno, p, '{', '}');
5854
#if 0
5855
seea(1, smodno);
5856
#endif
5857
5858
p = get_arg(arg2, p, '{', '}');
5859
q = get_arg(ssecno, arg2, '{', '}');
5860
#if 0
5861
seea(2, ssecno);
5862
#endif
5863
q = get_arg(spageno, q, '{', '}');
5864
#if 0
5865
seea(3, spageno);
5866
#endif
5867
5868
p = get_arg(smodno0, p, '{', '}');
5869
#if 0
5870
seea(4, smodno0);
5871
#endif
5872
}
5873
else
5874
{
5875
err_print(C, "Invalid \\Newlabel format in %s file, line %d",
5876
aux_file_name, aline);
5877
return;
5878
}
5879
5880
modno = (sixteen_bits)ATOI(smodno);
5881
5882
if(modno >= max_modules)
5883
OVERFLW("sections", ABBREV(max_modules));
5884
5885
ps = sect_info + modno;
5886
5887
ps->secno = GET_MEM("ps->secno",STRLEN(ssecno)+1,outer_char);
5888
STRCPY(ps->secno, ssecno);
5889
5890
ps->pageno = (sixteen_bits)ATOI(spageno);
5891
ps->modno0 = modno0 = (sixteen_bits)ATOI(smodno0);
5892
5893
/* Check to see whether there was more than one section on a page. */
5894
sect_info[modno-1].subpage_flag = YES;
5895
5896
if((long)modno0 == modno_ref)
5897
pmcount++; // More than one section on page.
5898
else
5899
{ /* Start of new page. */
5900
if(pmcount == 1)
5901
sect_info[modno-1].subpage_flag = NO;
5902
5903
modno_ref = (long)modno0;
5904
pmcount = 1;
5905
}
5906
}
5907
5908
@ The core routine for obtaining a delimited argument is |get_arg|. That
5909
can fail because of a variety of error conditions. If one is recognized,
5910
we bail out immediately with a |longjmp|.
5911
5912
@<Glob...@>=
5913
5914
jmp_buf top_of_get_arg; // For premature bailout from get_arg.
5915
5916
@ |get_arg| takes a string |s| and returns in |result| an argument
5917
delimited by |ldelim| and |rdelim|. The argument can itself contain
5918
matched delimiters.
5919
5920
@a
5921
outer_char *
5922
get_arg FCN((result, s, ldelim, rdelim))
5923
outer_char *result C0("Resulting argument string")@;
5924
outer_char *s C0("Input argument")@;
5925
outer_char ldelim C0("Left argument delimiter")@;
5926
outer_char rdelim C1("Right argument delimiter")@;
5927
{
5928
outer_char *s0;
5929
int blevel; // Brace level.
5930
5931
if(!s)
5932
{
5933
err_print(C, "get_arg: Null arg pointer");
5934
longjmp(top_of_get_arg, 1);
5935
}
5936
5937
5938
/* Skip white space at beginning of argument. */
5939
while(*s == ' ' || *s == '\t')
5940
s++;
5941
5942
if(*s++ != ldelim)
5943
{
5944
err_print(C, "get_arg: Expected '%c' while processing \"%s\".\n",
5945
ldelim, s-1);
5946
longjmp(top_of_get_arg, 2);
5947
}
5948
5949
s0 = s; // Remember beginning of argument.
5950
blevel = 1; // We've already found the left-hand delimiter.
5951
5952
while(*s)
5953
{
5954
if(*s == ldelim)
5955
blevel++;
5956
else if(*s == rdelim)
5957
{
5958
blevel--;
5959
5960
if(blevel < 0)
5961
{
5962
err_print(C, "Too many '%c' while processing \"%s\"\n",
5963
rdelim, s0-1);
5964
longjmp(top_of_get_arg, 3);
5965
}
5966
5967
if(blevel == 0)
5968
{ /* We've found the matching right-hand delimiter. */
5969
int n;
5970
5971
STRNCPY(result, s0, n = s-s0);
5972
result[n] = '\0';
5973
return s + 1;
5974
}
5975
}
5976
5977
s++;
5978
}
5979
5980
if(!(*s))
5981
{
5982
err_print(C, "get_arg: Field \"%s\" ended while scanning for '%c'\n",
5983
s0-1, rdelim);
5984
longjmp(top_of_get_arg, 4);
5985
}
5986
}
5987
5988
@ Format a module number including section and page information. (The
5989
value returned from this function should be |FREE|d after use by calling
5990
|mfree|.)
5991
5992
@d NMOD_TEMP 200
5993
5994
@<Part 2@>=@[
5995
5996
outer_char HUGE *
5997
mod_trans FCN((prefix,modno))
5998
outer_char *prefix C0("")@;
5999
sixteen_bits modno C1("")@;
6000
{
6001
outer_char HUGE *mod_temp = GET_MEM("mod_temp", NMOD_TEMP, outer_char);
6002
SECT_INFO *ps = sect_info + modno;
6003
6004
if(ps->secno)
6005
{
6006
outer_char c, letter[2];
6007
6008
letter[1] = '\0';
6009
6010
c = (ps->subpage_flag ?
6011
XCHR(modno - ps->modno0 + @'a' - 1) : '\0');
6012
6013
if(c)
6014
{
6015
if(XORD(c) > @'z')
6016
c = '?';
6017
else if(c == @'`')
6018
c = '\0';
6019
}
6020
6021
letter[0] = c;
6022
6023
SPRINTF(NMOD_TEMP, mod_temp, `"%s %d (sect. %s, p. %d%s)",
6024
prefix, modno, ps->secno, ps->pageno, letter`);
6025
}
6026
else
6027
{
6028
SPRINTF(NMOD_TEMP, mod_temp, `"%s %d", prefix, modno`);
6029
}
6030
6031
if(next_mod_name == last_mod_name)
6032
CONFUSION("mod_trans", "too many unfreed mod names");
6033
6034
return *(next_mod_name++) = mod_temp;
6035
}
6036
6037
@ Undo storage areas allocated for |mod_trans|.
6038
@<Part 2@>=@[
6039
6040
SRTN
6041
mfree(VOID)
6042
{
6043
if(!mod_names)
6044
return; // For errors happening during the command line.
6045
6046
/* Don't mess with this next construction; tricky on some systems. The form
6047
|for(--next_mod_name; next_mod_name >= mod_names; next_mod_name--)| doesn't
6048
always work. */
6049
while(next_mod_name > mod_names)
6050
{
6051
next_mod_name--;
6052
FREE(*next_mod_name);
6053
}
6054
}
6055
6056
@*1 Indexing languages.
6057
Languages have both a number, name, and symbol; be
6058
careful to keep these all in the same order. We provide two functions:
6059
|lan_num| takes a language and returns an index number; |lan_enum| takes an
6060
index number and returns a language.
6061
6062
@<Part 2@>=@[
6063
6064
int
6065
lan_num FCN((Language))
6066
LANGUAGE Language C1("")@;
6067
{
6068
proper_language:
6069
switch(Language)
6070
{
6071
case C: return 0;
6072
case RATFOR: return 1;
6073
case FORTRAN: return 2;
6074
case TEX: return 3;
6075
case LITERAL: return 4;
6076
6077
case C_PLUS_PLUS: return 5;
6078
case RATFOR_90: return 6;
6079
case FORTRAN_90: return 7;
6080
6081
case NO_LANGUAGE: Language = GLOBAL_LANGUAGE; goto proper_language;
6082
default: Language = global_language; goto proper_language;
6083
}
6084
}
6085
6086
LANGUAGE
6087
lan_enum FCN((num))
6088
int num C1("Integer index of the language.")@;
6089
{
6090
switch(num)
6091
{
6092
case 0: return C;
6093
case 1: return RATFOR;
6094
case 2: return FORTRAN;
6095
case 3: return TEX;
6096
case 4: return LITERAL;
6097
6098
case 5: return C_PLUS_PLUS;
6099
case 6: return RATFOR_90;
6100
case 7: return FORTRAN_90;
6101
6102
default: return NO_LANGUAGE;
6103
}
6104
}
6105
6106
@ The function |lan_index| is like |lan_num|, but it compresses
6107
|RATFOR| and |FORTRAN| onto the same index.
6108
6109
@<Part 2@>=@[
6110
int
6111
lan_index FCN((Language))
6112
LANGUAGE Language C1("")@;
6113
{
6114
proper_language:
6115
switch(Language)
6116
{
6117
case C: return 0;
6118
6119
case RATFOR:
6120
case FORTRAN: return 1;
6121
6122
case TEX: return 2;
6123
case LITERAL: return 3;
6124
6125
case C_PLUS_PLUS: return 4;
6126
6127
case RATFOR_90:
6128
case FORTRAN_90: return 5;
6129
6130
case NO_LANGUAGE: Language = GLOBAL_LANGUAGE; goto proper_language;
6131
default: Language = global_language; goto proper_language;
6132
}
6133
}
6134
6135
@*1 Processing {\tt fweb.sty}.
6136
Here we construct the name of the style file, and read that file.
6137
6138
@<Glob...@>=
6139
6140
IN_COMMON outer_char style_file_name[MAX_FILE_NAME_LENGTH]
6141
CSET(STYLE_FILE_NAME);
6142
IN_COMMON boolean renamed_style CSET(NO);
6143
6144
@
6145
@<Read the style file@>=
6146
{
6147
read_sty(style_file_name,renamed_style); // See \.{style.web}.
6148
6149
@<Convert selected fields to |ASCII|@>@;
6150
}
6151
6152
@ The style file is read as |outer_char|. Some fields are best left that
6153
way, while others need to be converted to |ASCII|.
6154
6155
@<Convert selected...@>=
6156
{
6157
DOT_DELIMITER HUGE *d = &wt_style.dot_delimiter;
6158
6159
d->begin = XORD(d->begin);
6160
d->end = XORD(d->end);
6161
6162
if(program==tangle)
6163
{
6164
t_style.ASCII_fcn = x__to_ASCII((outer_char *)t_style.ASCII_fcn);
6165
}
6166
}
6167
6168
@*1 Processing command-line arguments.
6169
Processing arguments is done in a
6170
separate function because it's called several times: once for the command
6171
line, and (possibly) each time there's a language change.
6172
6173
@d THE_FILE_NAME (a_file_name ? pa : (outer_char HUGE *)"stdin")
6174
6175
@<Glob...@>=
6176
6177
IN_COMMON boolean doing_cmd_line; // Command line or optional arguments?
6178
IN_COMMON boolean cmd_prms; // Stuff from ini file or from command line?
6179
6180
@
6181
@<Part 2@>=@[
6182
6183
SRTN
6184
do_args FCN((doing_cmd_line0,argc,argv,pfound_web,wbflnm,pfound_change))
6185
boolean doing_cmd_line0 C0("")@;
6186
int argc C0("")@;
6187
outer_char HUGE *argv[] C0("")@;
6188
boolean HUGE *pfound_web C0("")@;
6189
outer_char wbflnm[] C0("")@;
6190
boolean HUGE *pfound_change C1("")@;
6191
{
6192
boolean a_file_name; // Is an actual file name supplied from the command line?
6193
outer_char HUGE *dot_pos; /* Position of |'.'| (or more generally,
6194
|wt_style.ext_delimiter|) in the argument */
6195
IN_STYLE outer_char HUGE *sprm_ptr0, HUGE *sprm_ptr;
6196
6197
doing_cmd_line = doing_cmd_line0;
6198
cmd_prms = NO;
6199
6200
*pfound_web = *pfound_change = NO;
6201
6202
while (argc-- > 0)
6203
{
6204
if(!cmd_prms && argv == pn0)
6205
{ /* Note beginning of command-line parameters. */
6206
cmd_prms = YES;
6207
sprm_ptr0 = sprm_ptr;
6208
}
6209
6210
if(cmd_prms && argv == pn1)
6211
{ /* Note beginning of more \.{.fweb} arguments. */
6212
cmd_prms = YES;
6213
}
6214
6215
pa = pa_begin = *(argv++); // Beginning of current argument string.
6216
6217
/* Arguments that don't begin with a hyphen, or that are just a single
6218
hyphen with no trailing stuff, mean file names. */
6219
if ( (a_file_name= BOOLEAN(*pa != '-')) || *(pa+1)=='\0')
6220
@<Process a file name@>@;
6221
else
6222
@<Handle flag argument@>;
6223
}
6224
}
6225
6226
@
6227
@<Process a file name@>=
6228
{
6229
if(doing_cmd_line)
6230
{
6231
if (!*pfound_web)
6232
{
6233
STRCPY(wbflnm,THE_FILE_NAME);
6234
*pfound_web = YES;
6235
}
6236
else if (!*pfound_change)
6237
@<Make |change_file_name| from |fname|@>@;
6238
else
6239
@<Print change file warning message and |continue|@>;
6240
}
6241
else
6242
{
6243
printf("\n! File name \"%s\" is not allowed as optional argument; \
6244
ignored.\n", pa);
6245
mark_harmless;
6246
}
6247
}
6248
6249
@
6250
@<Make |change_file_name|...@>=
6251
{
6252
if (a_file_name && STRLEN(pa) > MAX_FILE_NAME_LENGTH-5)
6253
too_long();
6254
6255
/* For VMS, should skip over brackets here. */
6256
6257
if (a_file_name && (dot_pos=OC(STRCHR(pa,wt_style.ext_delimiter)))==NULL
6258
&& !try_extensions)
6259
{
6260
SPRINTF(MAX_FILE_NAME_LENGTH,change_file_name,`"%s%cch",
6261
pa,wt_style.ext_delimiter`);
6262
}
6263
else
6264
{
6265
SPRINTF(MAX_FILE_NAME_LENGTH,change_file_name,`"%s",THE_FILE_NAME`);
6266
}
6267
6268
*pfound_change=YES;
6269
}
6270
6271
@ After a language command, there may be optional arguments that must also
6272
be parsed.
6273
6274
@d ARG_BUFFER_SIZE 500
6275
@d COPY_TO_ARG_BUFFER(c) if(pa < arg_buffer_end) *pa++ = c;
6276
else OVERFLW("arg buffer bytes","")@;
6277
@d MAX_ARGS 100
6278
6279
@<Part 2@>=@[
6280
6281
SRTN
6282
opt_args FCN((l))
6283
ASCII l C1("")@;
6284
{
6285
ASCII arg_buffer[ARG_BUFFER_SIZE],*pa = arg_buffer,
6286
*arg_buffer_end = arg_buffer + ARG_BUFFER_SIZE;
6287
int argc;
6288
outer_char HUGE *args[MAX_ARGS];
6289
6290
ini_language(l); /* Set language and initialize flags. */
6291
6292
if(!IS_WHITE(*loc))
6293
{
6294
if(*loc != @'[')
6295
{ /* Unbracketed command, as in \.{@@c++}. */
6296
*pa++ = @'-'; // Make it an honest command.
6297
*pa++ = l; // Don't forget the language.
6298
6299
WHILE()
6300
{
6301
if(IS_WHITE(*loc) || *loc==@'[') break;
6302
if(*loc==@'|' && parsing_mode==INNER)
6303
{
6304
ERR_PRINT(C,"WARNING: Code mode ended during \
6305
unbracketed optional argument. Should there be white space after \
6306
language command?");
6307
break;
6308
}
6309
COPY_TO_ARG_BUFFER(*loc++);
6310
}
6311
}
6312
6313
/* We allow bracketed commands to follow unbracketed ones. */
6314
if(*loc == @'[')
6315
{
6316
COPY_TO_ARG_BUFFER(@' ');
6317
6318
for(loc++; ; )
6319
{ // Skip the opening bracket; copy contents.
6320
if(*loc == @']')
6321
{
6322
loc++; /* Skip the ending bracket. */
6323
break;
6324
}
6325
COPY_TO_ARG_BUFFER(*loc++);
6326
}
6327
}
6328
6329
TERMINATE(pa,0); /* Terminate |arg_buffer|. */
6330
argc = to_args(to_outer(arg_buffer),args,MAX_ARGS);
6331
do_args(NO,argc,args,&found_web,(outer_char *)NULL,&found_change);
6332
}
6333
6334
fin_language(); /* Do any further flag setup. */
6335
}
6336
6337
@ Set the language, and also set up flags for particular language.
6338
The input parameter is the letter corresponding to the basic language.
6339
Subsidiary dialect flags such as~|Cpp| or~|Fortran88| are used to determine
6340
the full language.
6341
@<Part 2@>=@[
6342
6343
SRTN
6344
ini_language FCN((l))
6345
ASCII l C1("Basic language code")@;
6346
{
6347
/* First we set the language. */
6348
l = A_TO_LOWER(l); // We now enforce that language commands are lower case.
6349
6350
switch(l)
6351
{
6352
@<|ASCII| cases for |C|@>:
6353
language = (Cpp ? C_PLUS_PLUS : C);
6354
break;
6355
6356
@<|ASCII| cases for |RATFOR|@>:
6357
if(!RAT_OK("Invalid @@r command; language set to C")) language = C;
6358
else language = (Fortran88 ? RATFOR_90 : RATFOR);
6359
break;
6360
6361
@<|ASCII| cases for |FORTRAN|@>:
6362
language = (Fortran88 ? FORTRAN_90 : FORTRAN);
6363
break;
6364
6365
@<|ASCII| cases for |LITERAL|@>:
6366
language = LITERAL;
6367
break;
6368
6369
@<|ASCII| cases for |TEX|@>:
6370
language = TEX;
6371
break;
6372
}
6373
6374
/* The following is for checking an override of the command-line language
6375
in the limbo section. */
6376
if(doing_cmd_line)
6377
cmd_language = language;
6378
6379
ini0_language();
6380
}
6381
6382
@ Set parameters for each language. Note that certain flags, such as
6383
|free_form_input|, are really arrays that can have a different value
6384
depending on the language.
6385
6386
@<Part 2@>=@[
6387
6388
SRTN
6389
ini0_language(VOID)
6390
{
6391
/* Set the output language. */
6392
out_language = OUT_LANGUAGE(language);
6393
6394
/* Storing these numbers cuts down on the overhead of function calls. It
6395
also enables us to use the macros in the following |switch| properly. */
6396
language_index = (short)lan_index(language); // Maybe no longer used.
6397
language_num = (short)lan_num(language);
6398
6399
index_flag = YES; // Most languages will cross-reference.
6400
6401
switch(language)
6402
{
6403
case C:
6404
Cpp = NO;
6405
break;
6406
6407
case C_PLUS_PLUS:
6408
Cpp = YES; // Just a shorthand for |language==CPP|.
6409
break;
6410
6411
case FORTRAN:
6412
case FORTRAN_90:
6413
free_form_input = global_params.Free_form_input[language_num];
6414
/* This can be turned on by the \.{-n\\} or \.{-n\&} options. */
6415
auto_semi = global_params.Auto_semi[language_num];
6416
break;
6417
6418
case RATFOR:
6419
case RATFOR_90:
6420
if(nuweb_mode)
6421
err_print(C, "SORRY, but Ratfor doesn't work yet with the N \
6422
mode!") ;
6423
auto_semi = global_params.Auto_semi[language_num];
6424
if(auto_semi)
6425
free_form_input = NO;
6426
break;
6427
6428
case LITERAL:
6429
nuweb_mode = YES;
6430
line_info = NO;
6431
index_flag = NO;
6432
break;
6433
6434
case TEX:
6435
break;
6436
6437
default:
6438
break;
6439
}
6440
}
6441
6442
@ Now handle any parameter modifications after optional arguments have been
6443
read.
6444
@<Part 2@>=@[
6445
6446
SRTN
6447
fin_language(VOID)
6448
{
6449
ini_reserved(language);
6450
6451
switch(language)
6452
{
6453
case C:
6454
break;
6455
6456
case RATFOR:
6457
break;
6458
6459
case FORTRAN:
6460
break;
6461
6462
case LITERAL:
6463
break;
6464
6465
case TEX:
6466
break;
6467
6468
default:
6469
break;
6470
}
6471
6472
frz_params(); // Make any local parameters.
6473
6474
/* Output file name. For |program == weave|, |out_file == tex_file| by a
6475
macro definition in \.{typedefs.hweb}. */
6476
if(program == tangle)
6477
out_file = params.outp_file[lan_num(out_language)];
6478
}
6479
6480
@ Call this routine whenever |params| is reset.
6481
@<Part 2@>=@[
6482
6483
SRTN
6484
frz_params(VOID)
6485
{
6486
@#if 0
6487
if(auto_semi && !Fortran88) free_form_input = NO;
6488
@#endif
6489
6490
cont_char = XORD(in_escape); // Current continuation character (in |ASCII|).
6491
free_90 = BOOLEAN(Fortran88 && free_form_input);
6492
free_Fortran = BOOLEAN((language==FORTRAN_90) && free_90);
6493
6494
if(!prn_semis && free_Fortran && auto_pseudo_semis)
6495
prn_semis = YES;
6496
6497
@#if 0
6498
/* Semicolons must be inserted explicitly for \Fortran-90! */
6499
if(is_FORTRAN_(language))
6500
auto_semi = BOOLEAN(!free_Fortran);
6501
@#endif
6502
6503
if(program==tangle && free_90)
6504
switch(language)
6505
{
6506
case FORTRAN_90:
6507
case RATFOR_90:
6508
begin_comment_char[lan_num(FORTRAN_90)] =
6509
(outer_char)CHOICE(free_90, '!', 'C');
6510
break;
6511
6512
default: ;
6513
}
6514
6515
}
6516
6517
@ At this point the effective command line is in |outer_char| form in
6518
|arg_buffer|.
6519
@<Part 2@>=@[
6520
6521
int
6522
to_args FCN((p,args,max_args))
6523
outer_char HUGE *p C0("")@;
6524
outer_char HUGE *args[] C0("")@;
6525
int max_args C1("")@;
6526
{
6527
int n;
6528
6529
for(n=0; *p; p++)
6530
{
6531
if(n >= max_args)
6532
{
6533
err_print(C,"Too many command-line or optional \
6534
arguments; must be < %d",max_args);
6535
break;
6536
}
6537
while(isspace(*p)) p++; // Skip leading white space.
6538
args[n++] = p; // Record start and count.
6539
6540
for(p++; *p; p++)
6541
if(isspace(*p) || !*p) break; // Find end of argument.
6542
6543
if(!*p) break; // Get out at end of line.
6544
TERMINATE(p,0); // Mark end of argument.
6545
}
6546
6547
return n; // Number of arguments found.
6548
}
6549
6550
@
6551
@<Initialize static...@>=
6552
6553
SET_VAL(mbuf_size,ABBREV(mbuf_size));
6554
6555
@ These are for automatic statement numbering.
6556
6557
@d STARTING_DO_NUM UL(90000L)
6558
6559
@<Common...@>=
6560
6561
IN_COMMON STMT_LBL max_stmt CSET(STARTING_DO_NUM);
6562
IN_COMMON int not; // For the negations of options.
6563
6564
@ For many of the flags, a minus option, as \.{-flag}, means to do the
6565
opposite of the default. Furthermore, if the format is \.{--flag}, this is
6566
the opposite of \.{-flag}. Negating the usual flag value can be
6567
accomplished by exclusive-oring it with |not|, where |not == YES| when we
6568
have the extra hyphen, or |NO|~otherwise.
6569
6570
@d NOT(flag) BOOLEAN((!flag) ^ not)
6571
6572
@<Handle flag...@>=
6573
@B
6574
outer_char mc;
6575
outer_char cmd_symbol; // The character after the hyphen.
6576
6577
@b
6578
pa++; // |pa| now points to the character after the hyphen.
6579
6580
if(*pa == '-')
6581
{ // Second hyphen means negate.
6582
not = YES;
6583
pa++; // Skip second hyphen.
6584
}
6585
else
6586
not = NO;
6587
6588
reswitch:
6589
switch(cmd_symbol= *pa++)
6590
{ /* |pa| now positioned after command symbol---e.g., to optional
6591
argument. */
6592
case '1':
6593
tracing = BRIEF;
6594
break;
6595
6596
case '2':
6597
tracing = VERBOSE;
6598
break;
6599
6600
case '@@':
6601
@<Option \.{-@@}: print control codes@>@;
6602
continue;
6603
6604
case 'a':
6605
case 'A':
6606
@<Option \.{-A}: translations to |ASCII|@>@;
6607
break;
6608
6609
case 'b':
6610
@<Option \.{-b}: block numbering@>@;
6611
break;
6612
6613
case 'B':
6614
beeps = NOT(BEEPS);
6615
break;
6616
6617
@<|outer_char| cases for |C|@>:
6618
@<Option \.{-c}: C and \Cpp@>@;
6619
break;
6620
6621
case 'C':
6622
while(*pa)
6623
pa++;
6624
break; // This was already processed in |ini_program|.
6625
6626
case 'D':
6627
@<Option \.{-D}: see reserved words@>@;
6628
continue;
6629
6630
case 'd':
6631
number_dos = NOT(NUMBER_DOS); // NOTE: falls through to next case!
6632
6633
case ':':
6634
@<Option \.{-:}: starting line number@>@;
6635
continue;
6636
6637
case 'e':
6638
try_extensions = NOT(TRY_EXTENSIONS); @~ break;
6639
6640
case 'E':
6641
@<Option \.{-E}: change extension delimiter@>@;
6642
break;
6643
6644
case 'f':
6645
subscript_fcns = NOT(SUBSCRIPT_FCNS); @~ break;
6646
6647
case 'F':
6648
compare_outfiles = NOT(COMPARE_OUTFILES); @~ break;
6649
6650
case 'g':
6651
dbg_output = NOT(DBG_OUTPUT); @~ break;
6652
6653
case 'h':
6654
@<Issue warning if this command is negated@>@;
6655
help();
6656
continue;
6657
6658
case 'H':
6659
@<Option \.{-H}: scan include files@>@;
6660
break;
6661
6662
case 'i':
6663
@<Option \.{-i}: skip include files@>@;
6664
break;
6665
6666
case 'I':
6667
@<Option \.{-I}: add to include path list@>@;
6668
continue;
6669
6670
case 'j':
6671
skip_ifiles = NOT(SKIP_IFILES); @~ break;
6672
6673
case 'k':
6674
lc_keywords = NOT(LC_KEYWORDS); @~ break;
6675
6676
case 'L':
6677
@<Option \.{-L}: generalized language switch@>@;
6678
continue;
6679
6680
case 'l':
6681
@<Option \.{-l}: print input lines for debugging@>@;
6682
continue;
6683
6684
case 'M':
6685
@<Option \.{-M}: set output message level@>@;
6686
continue;
6687
6688
case 'm':
6689
@<Option \.{-m}: macro definitions etc.@>@;
6690
break;
6691
6692
case 'N':
6693
nuweb_mode = NOT(NUWEB_MODE);
6694
break;
6695
6696
case 'n':
6697
FR_args(FORTRAN);
6698
continue;
6699
6700
case 'o':
6701
overload_ops = NOT(OVERLOAD_OPS);
6702
break;
6703
6704
case 'p':
6705
@<Option \.{-p}: collect style-file parameter@>@;
6706
continue;
6707
6708
case 'P':
6709
@<Option \.{-P}: specify the \TeX\ processor@>@;
6710
break;
6711
6712
case 'q':
6713
free_form_input = NOT(FREE_FORM_INPUT);
6714
Ratfor77 = NOT(RATFOR77);
6715
break;
6716
6717
@<|outer_char| cases for |RATFOR|@>:
6718
if(!RAT_OK("Language command ignored"))
6719
break;
6720
FR_args(RATFOR);
6721
continue;
6722
6723
case 's':
6724
@<Option \.{-s}: statistics@>@;
6725
continue;
6726
6727
case 't':
6728
@<Option \.{-t}: truncate identifiers@>@;
6729
continue;
6730
6731
case 'T':
6732
@<Option \.{-T}: various flags for \FTANGLE@>@;
6733
continue;
6734
6735
case 'u':
6736
@<Option \.{-u}: undefine a macro@>@;
6737
continue;
6738
6739
case 'U':
6740
lowercase_tokens = NOT(LOWERCASE_TOKENS);
6741
break;
6742
6743
case 'V':
6744
prn_version = NOT(PRN_VERSION);
6745
break;
6746
6747
case 'v':
6748
all_cmnts_verbatim = NOT(ALL_CMNTS_VERBATIM);
6749
break;
6750
6751
case 'w':
6752
if(*pa)
6753
new_fname(&fwebmac, pa, NULL);
6754
else
6755
input_macros = NOT(INPUT_MACROS);
6756
6757
continue;
6758
6759
case 'W':
6760
@<Option \.{-W}: various flags for \FWEAVE@>@;
6761
continue;
6762
6763
case 'x':
6764
flags3(BOOLEAN(not));
6765
continue;
6766
6767
case 'X':
6768
if(*pa == 'I')
6769
{
6770
makeindex = NOT(MAKEINDEX);
6771
break;
6772
}
6773
6774
flags3(BOOLEAN(!not));
6775
continue;
6776
6777
case 'y':
6778
@<Option \.{-y}: process allocation command@>@;
6779
continue;
6780
6781
case 'z':
6782
@<Option \.{-z}@>@;
6783
continue;
6784
6785
case 'Z':
6786
prn_style_defaults = BOOLEAN(!not);
6787
style_args = pa;
6788
info_option = YES;
6789
continue;
6790
6791
case '.':
6792
dot_constants = NOT(DOT_CONSTANTS);
6793
break;
6794
6795
case '\\':
6796
bslash_continued_strings = NOT(BSLASH_CONTINUED_STRINGS);
6797
break;
6798
6799
case '?':
6800
chk_stmts = NOT(CHK_STMTS);
6801
break;
6802
6803
case '[':
6804
translate_brackets = NOT(TRANSLATE_BRACKETS);
6805
break;
6806
6807
case '(':
6808
case ')':
6809
chk_ifelse = NOT(CHK_IFELSE); @~break;
6810
6811
case '>':
6812
case '=':
6813
@<Issue warning if this command is negated@>@;
6814
if(doing_cmd_line || phase==2)
6815
redirect_output();
6816
continue;
6817
6818
case '/':
6819
params.CPP_comments[LN(FORTRAN)]
6820
= params.CPP_comments[LN(FORTRAN_90)]
6821
= params.CPP_comments[LN(RATFOR)]
6822
= params.CPP_comments[LN(RATFOR_90)]
6823
= BOOLEAN(YES ^ not);
6824
break;
6825
6826
case '!':
6827
params.Point_comments[LN(FORTRAN)]
6828
= params.Point_comments[LN(FORTRAN_90)]
6829
= params.Point_comments[LN(RATFOR)]
6830
= params.Point_comments[LN(RATFOR_90)]
6831
= BOOLEAN(YES ^ not);
6832
break;
6833
6834
case '+':
6835
compound_assignments = NOT(COMPOUND_ASSIGNMENTS); @~ break;
6836
6837
case '#':
6838
line_info = NOT(LINE_INFO); @~ break;
6839
6840
default:
6841
bad_option();
6842
continue;
6843
}
6844
6845
/* Check for trailing garbage. */
6846
if(*pa)
6847
spurious(pa);
6848
}
6849
6850
6851
@*1 Option {\tt -@@}.
6852
6853
@<Option \.{-@@...@>=
6854
{
6855
if(!at_codes)
6856
{
6857
at_codes = GET_MEM("at_codes", 200, ASCII); // 200 is KLUDGE!
6858
at_codes[0] = '\0';
6859
}
6860
6861
STRCAT(at_codes, to_ASCII(pa));
6862
info_option = YES;
6863
}
6864
6865
@*1 Option {\tt -A}.
6866
ASCII translations are off by default on |ASCII|
6867
machines; they're turned on for the cases that really need. Therefore,
6868
this flag is for debugging.
6869
6870
@<Option \.{-A}...@>=
6871
{
6872
#if(TRANSLATE_ASCII || DEBUG_XCHR)
6873
translate_ASCII = YES; // Force it for the cases that really need it.
6874
#else
6875
translate_ASCII = NOT(TRANSLATE_ASCII0);
6876
#endif
6877
}
6878
6879
6880
@*1 Option {\tt -b}.
6881
6882
@<Option \.{-b}...@>=
6883
{
6884
params.Block_nums[LN(FORTRAN)]
6885
= params.Block_nums[LN(FORTRAN_90)]
6886
= params.Block_nums[LN(RATFOR)]
6887
= params.Block_nums[LN(RATFOR_90)]
6888
= NOT(BLOCK_NUMS);
6889
}
6890
6891
@*1 Option {\tt -c}.
6892
Options related to the C~language.
6893
6894
@<Option \.{-c}...@>=
6895
{
6896
@<Issue warning if this command is negated@>@;
6897
6898
Cpp = BOOLEAN(*pa == '+'); /* The commands \.{-c+} or \.{-c++} turn on
6899
knowledge of \.{C++}. */
6900
if(Cpp)
6901
while(*pa == '+')
6902
pa++; // Skip the pluses.
6903
6904
switch(*pa)
6905
{
6906
case '{':
6907
set_filter(Cpp ? C_PLUS_PLUS : C);
6908
continue;
6909
6910
case '\0':
6911
ini_language(XORD(*LANGUAGE_CODE(C)));
6912
continue;
6913
6914
default:
6915
break;
6916
}
6917
}
6918
6919
6920
@*1 Option {\tt -D}.
6921
See reserved words. The form `\.{-D[ikr]word}' says to print only the
6922
intrinsic functions (`\.i'), and/or the \Fortran/\Ratfor\ keywords (`\.k'),
6923
and/or the reserved words (`\.r') beginning with `\.{word}'.
6924
6925
Note that we can't immediately execute |see_reserved| because dynamic
6926
memory and the |name_dir| hasn't been set up yet.
6927
6928
@<Option \.{-D}...@>=
6929
{
6930
if(*pa == '[')
6931
@<Get the optional arguments to `\.{-D}'@>@;
6932
else
6933
{
6934
if(!(*pa=='\0' || *pa=='*' || isalpha(*pa)))
6935
{
6936
err_print_(C, "Either nothing, a letter, '*', or '[' \
6937
must follow `-D'; option ignored");
6938
break;
6939
}
6940
6941
rsrvd.reserveds = rsrvd.intrinsics = rsrvd.keywords = YES;
6942
}
6943
6944
rsrvd.args = pa; // Points to `\.{*}' or letters to match.
6945
6946
info_option = YES;
6947
}
6948
6949
@
6950
@<Get the optional arguments to `\.{-D}'...@>=
6951
{
6952
for(++pa; *pa != ']'; pa++)
6953
switch(*pa)
6954
{
6955
case 'i':
6956
case 'I':
6957
rsrvd.intrinsics = YES;
6958
break;
6959
6960
case 'k':
6961
case 'K':
6962
rsrvd.keywords = YES;
6963
break;
6964
6965
case 'r':
6966
case 'R':
6967
rsrvd.reserveds = YES;
6968
break;
6969
6970
case '\0':
6971
err_print_(C, "Missing ']' inserted after optional argument \
6972
list to `-D'");
6973
break;
6974
6975
default:
6976
err_print_(C, "Optional argument to `-D' must be one of \
6977
'i', 'k', or 'r'");
6978
break;
6979
}
6980
6981
pa++; // Advance past the \.{']'}.
6982
}
6983
6984
@*1 Options {\tt -d} and {\tt -:}.
6985
Process starting line number.
6986
6987
@<Option \.{-:}...@>=
6988
{
6989
@<Issue warning if this command is negated@>@;
6990
6991
max_stmt = STARTING_DO_NUM;
6992
6993
if(*pa)
6994
{ // Optional starting line number specified.
6995
max_stmt = ATOL(pa);
6996
6997
if(max_stmt > 99999L)
6998
err_print_(C,"Starting DO number must be < 99999; assuming %lu",
6999
max_stmt = STARTING_DO_NUM);
7000
}
7001
}
7002
7003
7004
@*1 Option {\tt -E}.
7005
Change the extension delimiter from its default value of period.
7006
7007
@<Option \.{-E}...@>=
7008
{
7009
@<Issue warning if this command is negated@>@;
7010
7011
if(*pa)
7012
wt_style.ext_delimiter = *pa++;
7013
else
7014
err_print_(C,"Missing character after -E option; option ignored");
7015
}
7016
7017
@*1 Option {\tt -h}.
7018
Enter the help package with \.{-h}. Just typing \.{-h} gives a brief
7019
message about possible helpful options. Typing `\.{-h?}' or `\.{-h.}'
7020
enters `\.{info FWEB}' at top level. Typing `\.{-h}\emph{menu-list}' calls
7021
`\.{info FWEB {\it menu-list}}'.
7022
7023
@<Part 2@>=@[
7024
7025
SRTN
7026
help(VOID)
7027
{
7028
if(!*pa)
7029
{
7030
printf("! For help, please use options\n\n\
7031
`-@@' (query control codes),\n\
7032
`-D' (query reserved words),\n\
7033
`-y' (query memory allocations),\n\
7034
`-Z' (query style-file parameters)\n\n\
7035
or see the info(1) man-page entry for FWEB."), fflush(stdout);
7036
}
7037
7038
#if(HAVE_INFO)
7039
@<Enter the \.{info} package@>@;
7040
#endif // |HAVE_INFO|
7041
7042
usage("", NO); // In lieu of anything better.
7043
}
7044
7045
7046
@
7047
@<Enter the \.{info}...@>=
7048
{
7049
outer_char temp[500], buf[500], *pmenus;
7050
7051
if(*pa)
7052
pmenus = pa; // There were command-line arguments.
7053
else
7054
{ /* No command-line arguments. Offer to enter \.{info}. */
7055
printf("\nTo enter `info FWEB' now, type\n\n\
7056
`?', for the top-level FWEB directory;\n\
7057
`node-name' or `-n node-name', to go to a specific node like `Macros'; or\n\
7058
a space-separated list of hierarchal FWEB menu items,\n\
7059
like `concepts structure'.\n\n\
7060
Type `q' to exit info. To abort now, hit Enter: "), fflush(stdout);
7061
gets((char *)buf);
7062
7063
pmenus = buf;
7064
}
7065
7066
if(STRLEN(pmenus) > 0)
7067
{
7068
if(*pmenus == '?' || *pmenus == '.')
7069
pmenus++;
7070
7071
sprintf((char *)temp, "info -f FWEB %s", pmenus);
7072
system((char *)temp);
7073
}
7074
}
7075
7076
@*1 Option {\tt -H}.
7077
7078
@<Option \.{-H}...@>=
7079
{
7080
outer_char HUGE *p = pa;
7081
7082
more_H:
7083
switch(*p++)
7084
{
7085
case 'r':
7086
rmv_files = NOT(RMV_FILES); // For debugging.
7087
goto more_H;
7088
7089
case 'x':
7090
quoted_includes = NOT(QUOTED_INCLUDES);
7091
goto more_H;
7092
7093
case 'X':
7094
all_includes = NOT(ALL_INCLUDES);
7095
goto more_H;
7096
7097
case '\0':
7098
read_iformats = NOT(READ_IFORMATS);
7099
continue;
7100
7101
default:
7102
bad_option();
7103
continue;
7104
}
7105
7106
}
7107
7108
@*1 Option {\tt -i}.
7109
When an include file is referenced by `\.{@@I}', then `\.{-i}' says for
7110
\FWEAVE\ to not print the contents of the file. `\.{-i!}' means to not
7111
even read it (probably not useful). By default, index entries are not made
7112
for files that aren't printed; `\.{-ix}' says to index them anyway.
7113
7114
@<Option \.{-i}...@>=
7115
{
7116
switch(*pa++)
7117
{
7118
case 'x':
7119
index_hidden = NOT(INDEX_HIDDEN); // Falls through.
7120
toggle_includes = NOT(TOGGLE_INCLUDES);
7121
break;
7122
7123
case '\0':
7124
toggle_includes = NOT(TOGGLE_INCLUDES);
7125
continue;
7126
7127
case '!':
7128
skip_includes = NOT(SKIP_INCLUDES); @~ break;
7129
7130
default:
7131
bad_option();
7132
continue;
7133
}
7134
}
7135
7136
@*1 Option {\tt -I}.
7137
The \.{-I}~option normally specifies additional files to add to the search
7138
list for \FWEB\ include files. However, any \.{-I}~options that follow
7139
a~\.{-H} add to the search list for C~include files; this list is passed
7140
to~\.{gcc} as the \.{-I}~option.
7141
7142
@<Option \.{-I}...@>=
7143
{
7144
more_includes(read_iformats ? &hdr_incl : &incl, pa);
7145
// Add to include path list.
7146
}
7147
7148
@*1 Option {\tt -L}.
7149
Generalized language switch.
7150
7151
@<Option \.{-L}...@>=
7152
{
7153
switch(*pa)
7154
{
7155
@<|outer_char| cases for |C|@>:
7156
@<|outer_char| cases for |FORTRAN|@>:
7157
@<|outer_char| cases for |RATFOR|@>:
7158
goto reswitch;
7159
7160
@<|outer_char| cases for |LITERAL|@>:
7161
@<Issue warning if this command is negated@>@;
7162
switch(*(pa+1))
7163
{
7164
case '{':
7165
set_filter(LITERAL);
7166
break;
7167
7168
case '\0':
7169
ini_language(XORD(*LANGUAGE_CODE(LITERAL)));
7170
break;
7171
7172
default:
7173
bad_lcmd("argument",pa-2);
7174
break;
7175
}
7176
break;
7177
7178
@<|outer_char| cases for |TEX|@>:
7179
@<Issue warning...@>@;
7180
switch(*(pa+1))
7181
{
7182
case '{':
7183
set_filter(TEX);
7184
break;
7185
7186
case '\0':
7187
ini_language(XORD(*LANGUAGE_CODE(TEX)));
7188
break;
7189
7190
default:
7191
bad_lcmd("argument",pa-2);
7192
break;
7193
}
7194
break;
7195
7196
default:
7197
bad_lcmd("command",pa-2);
7198
break;
7199
}
7200
}
7201
7202
@*1 Option {\tt -l}.
7203
Print input lines for debugging; see |input_ln|.
7204
7205
@<Option \.{-l}...@>=
7206
{
7207
prn_input_lines = BOOLEAN(YES ^ not);
7208
7209
if(*pa)
7210
if(isdigit(*pa) || *pa=='-')
7211
{
7212
outer_char *colon_pos;
7213
7214
start_line = ATOL(pa);
7215
7216
if((colon_pos=OC(STRCHR(pa,':'))) == NULL)
7217
end_line = LONG_MAX;
7218
else
7219
end_line = ATOL(colon_pos + 1);
7220
}
7221
7222
else
7223
{
7224
printf("! Option `-l' must be followed by integer.\n");
7225
mark_harmless;
7226
}
7227
7228
/* Negative line numbers are undocumented; they're for the developer. */
7229
if(start_line < 0)
7230
{
7231
start_line = -start_line;
7232
prn_input_addresses = YES;
7233
}
7234
}
7235
7236
@ Here's code for command-line options for \Fortran\ and \Ratfor. Note
7237
that not all options set the language.
7238
7239
@<Part 2@>=@[
7240
7241
SRTN
7242
FR_args FCN((Language))
7243
LANGUAGE Language C1("")@;
7244
{
7245
int lnum;
7246
7247
if(isdigit(*pa))
7248
{
7249
@<Issue warning if this command is negated@>@;
7250
7251
switch(*pa++)
7252
{ // Options \.{-n7} or \.{-n9}.
7253
case '7':
7254
if(*pa == '7')
7255
pa++;
7256
Fortran88 = NO;
7257
ini_language(XORD(*LANGUAGE_CODE(Language)));
7258
break;
7259
7260
case '9':
7261
if(*pa == '0')
7262
pa++;
7263
Fortran88 = YES;
7264
ini_language(XORD(*LANGUAGE_CODE(Language)));
7265
break;
7266
7267
default:
7268
bad_loption(Language);
7269
return;
7270
}
7271
}
7272
else
7273
{
7274
lnum = lan_num(language); /* We need to set this so that we can access
7275
the language arrays properly. Note use of |language| (here and in other
7276
statements below) rather than the function argument |Language|; the latter
7277
is only either |FORTRAN| or |RATFOR|. */
7278
7279
switch(*pa++)
7280
{
7281
case '\\':
7282
case '&':
7283
/* Set the continuation character; for \Fortran-90, turn on
7284
free-form syntax. */
7285
@<Issue...@>@;
7286
7287
if(FORTRAN90_LIKE(language))
7288
params.Free_form_input[lnum] = NOT(FREE_FORTRAN);
7289
params.In_escape[lnum] = *(pa-1); // Continuation character.
7290
break;
7291
7292
case '@@':
7293
if(*pa++ != ';')
7294
{
7295
bad_option();
7296
return;
7297
}
7298
7299
params.Auto_semi[lnum] = BOOLEAN(YES ^ not);
7300
params.Auto_pseudo_semis[lnum] = YES;
7301
break;
7302
7303
case ';':
7304
params.Auto_semi[lnum] = BOOLEAN(YES ^ not);
7305
params.Auto_pseudo_semis[lnum] = NO;
7306
break;
7307
7308
case ':':
7309
if(is_FORTRAN_(Language))
7310
Fortran_label = NOT(FORTRAN_LABEL);
7311
break;
7312
7313
case '!':
7314
params.Point_comments[lnum] = BOOLEAN(YES ^ not);
7315
break;
7316
7317
case '/':
7318
params.CPP_comments[lnum] = BOOLEAN(YES ^ not);
7319
break;
7320
7321
case ')':
7322
params.Reverse_indices[lnum] = BOOLEAN(YES ^ not);
7323
break;
7324
7325
case 'b':
7326
case 'B':
7327
params.Block_nums[lnum] = NOT(BLOCK_NUMS);
7328
break;
7329
7330
case 'C':
7331
params.Ignore_C = NOT(IGNORE_C);
7332
break;
7333
7334
case 'g':
7335
case 'G':
7336
@<Issue...@>@;
7337
7338
@<Option \.{-g}: set |goto| parameters@>@;
7339
return;
7340
7341
case 'k':
7342
suppress_cmds = BOOLEAN(YES ^ not);
7343
@<Copy abbreviation characters@>@;
7344
return;
7345
7346
case 'K':
7347
suppress_cmds = BOOLEAN(NO ^ not);
7348
@<Copy abbrev...@>@;
7349
return;
7350
7351
case 'p':
7352
if(is_FORTRAN_(Language))
7353
prn_semis = NOT(PRN_SEMIS);
7354
break;
7355
7356
case '{':
7357
@<Issue...@>@;
7358
pa--;
7359
set_filter(language);
7360
return;
7361
7362
case '\0':
7363
/* No argument at all: Specify the language. Note that the other
7364
commands don't. */
7365
@<Issue...@>@;
7366
ini_language(XORD(*LANGUAGE_CODE(Language)));
7367
return;
7368
7369
default:
7370
bad_loption(Language);
7371
return;
7372
}
7373
}
7374
7375
if(*pa)
7376
spurious(pa);
7377
}
7378
7379
@ After many commands are processed, there shouldn't be any further
7380
trailing text; print a message if there is.
7381
7382
@d SPURIOUS_MSG "Spurious trailing text ignored in option"
7383
7384
@a
7385
SRTN
7386
spurious FCN((pa1))
7387
outer_char HUGE *pa1 C1("Current position")@;
7388
{
7389
printf("%c%s `%s'.\n", beep(1), SPURIOUS_MSG, pa_begin);
7390
multi_chars(' ', STRLEN(SPURIOUS_MSG) + 2 + pa1 - pa_begin);
7391
puts("^");
7392
}
7393
7394
@
7395
@<Option \.{-g}...@>=
7396
{
7397
if(is_RATFOR_(Language))
7398
{
7399
if(!RAT_OK("'g' command ignored"))
7400
break;
7401
@<Scan the |goto| parameters@>;
7402
}
7403
else
7404
bad_loption(Language);
7405
}
7406
7407
@ Here we have some definitions for the parameters that control \Ratfor's
7408
|goto|. (See the user manual.)
7409
7410
@d G_RATIO 2.0
7411
@d MIN_G_RATIO 0.0 // This value definitively turns off the computed |goto|.
7412
7413
@d MARGINAL_CASES 5L
7414
@d MIN_MARGINAL_CASES 1
7415
7416
@d MAX_SPREAD UL(128L)
7417
@d MIN_MAX_SPREAD 1
7418
7419
@<Common...@>=
7420
7421
IN_COMMON double g_ratio CSET(G_RATIO);
7422
IN_COMMON unsigned short marginal_cases CSET(MARGINAL_CASES);
7423
IN_COMMON CASE_TYPE max_spread CSET(MAX_SPREAD);
7424
7425
@ We define an error macro to help ensure that valid parameters are passed
7426
to the \.{-g}~option.
7427
7428
@m CHK_G(var,VAR,type) if(var < MIN_##VAR)
7429
{
7430
err_print_(C,$IFELSE(type,int,"Invalid 'g' option: %s must be >= %d",
7431
"Invalid 'g' option: %s must be >= %.1f"),#var,
7432
MIN_##VAR);
7433
var = VAR;
7434
}
7435
7436
@<Scan the |goto|...@>=
7437
{
7438
while(*pa)
7439
if(isalpha(*pa))
7440
switch(*pa++)
7441
{
7442
case 'r':
7443
case 'R':
7444
g_ratio = STRTOD(pa,&pa);
7445
CHK_G(g_ratio,G_RATIO,double);
7446
break;
7447
case 'm':
7448
case 'M':
7449
marginal_cases =
7450
(unsigned short)STRTOL(pa,&pa,10);
7451
CHK_G(marginal_cases,MARGINAL_CASES,int);
7452
break;
7453
case 's':
7454
case 'S':
7455
max_spread = STRTOL(pa,&pa,10);
7456
CHK_G(max_spread,MAX_SPREAD,int);
7457
break;
7458
default:
7459
err_print_(C,"Invalid 'g' option: \
7460
parameter type '%c'",*(pa-1));
7461
break;
7462
}
7463
}
7464
7465
@*1 Option {\tt -k}.
7466
If there are no abbreviation characters, we assume
7467
that all are intended, so we insert an asterisk.
7468
7469
@<Copy abbrev...@>=
7470
{
7471
if(!*pa)
7472
STRCPY(abbrev_cmds,"*");
7473
else
7474
STRNCPY(abbrev_cmds, pa, NUM_RATFOR_CMDS); // Not fully error-checked.
7475
}
7476
7477
7478
@*1 Option {\tt -p}.
7479
Each use of this option collects its string argument
7480
as a separate line in a style-file buffer. That buffer is read before the
7481
local style file.
7482
7483
@<Option \.{-p}...@>=
7484
{
7485
IN_STYLE outer_char HUGE *sprm_buf,HUGE *sprm_ptr,HUGE *sprm_end;
7486
int n = STRLEN(pa);
7487
size_t nbuf,nused;
7488
7489
if(!sprm_buf)
7490
{ /* Allocate the style-parameter buffer. */
7491
sprm_ptr = sprm_buf = GET_MEM("sprm_buf",SPRM_LEN,outer_char);
7492
sprm_end = sprm_buf + SPRM_LEN;
7493
nbuf = SPRM_LEN;
7494
}
7495
7496
if(sprm_ptr + (n+2) >= sprm_end)
7497
{ /* Reallocate a larger buffer. */
7498
BUF_SIZE old_size;
7499
7500
nused = PTR_DIFF(size_t, sprm_ptr, sprm_buf);
7501
old_size = nbuf;
7502
nbuf = PTR_DIFF(size_t, sprm_end, sprm_buf) + SPRM_LEN;
7503
7504
if( (sprm_buf = (outer_char HUGE *)REALLOC(sprm_buf,
7505
nbuf*sizeof(outer_char), old_size*sizeof(outer_char)))==NULL)
7506
OVERFLW("sprm_buf",0);
7507
7508
sprm_ptr = sprm_buf + nused;
7509
sprm_end = sprm_ptr + nbuf;
7510
}
7511
7512
/* Add a line (terminated with space and newline). */
7513
STRCPY(sprm_ptr, pa);
7514
sprm_ptr += n;
7515
*sprm_ptr++ = ' ';
7516
*sprm_ptr++ = '\n';
7517
}
7518
7519
@*1 Option {\tt -P}.
7520
In a few cases it is useful to specify which processor,
7521
\TeX\ or \LaTeX, will be used to process the output from \FWEAVE. The
7522
default is~`\.{-P}', which is equivalent to~`\.{-PL}'.
7523
7524
@<Option \.{-P}...@>=
7525
{
7526
switch(*pa)
7527
{
7528
default:
7529
err_print_(C,"'%c' is invalid option for -X; must be either 'L' \
7530
(LaTeX) or 'T' (TeX). Assuming LaTeX", *pa); // Falls through to \LaTeX\ case.
7531
TeX_processor = LaTeX_p;
7532
continue;
7533
7534
case '\0':
7535
pa--;
7536
7537
case 'L':
7538
TeX_processor = LaTeX_p;
7539
break;
7540
7541
case 'T':
7542
err_print_(C, "Warning: Plain TeX (`-PT') is no longer supported. \
7543
Please use LaTeX (`-PL')");
7544
TeX_processor = TeX_p;
7545
break;
7546
}
7547
7548
pa++;
7549
}
7550
7551
7552
@*1 Option {\tt -M}.
7553
The \.{-M}~option sets the message level (|msg_level|) for output, as
7554
follows:
7555
\begin{enumerate}
7556
\setcounter{enumi}{-1}
7557
7558
\item
7559
(|NOTHING|): Like |ERRORS_ONLY|, but without the welcoming version number.
7560
7561
\item
7562
(|ERRORS_ONLY|): Errors only.
7563
7564
\item
7565
(|WARNINGS|): Errors and warnings.
7566
7567
\item
7568
(|SHORT_INFO|): Errors, warnings, and all regular information output
7569
except for major module numbers and line numbers.
7570
7571
\item
7572
(|EVERYTHING|): Errors, warnings, and all information output.
7573
7574
\end{enumerate}
7575
7576
@<Option \.{-M}...@>=
7577
{
7578
if(!*pa)
7579
msg_level = EVERYTHING;
7580
else
7581
{
7582
msg_level = ATOI(pa++);
7583
7584
if(msg_level < NOTHING || msg_level > EVERYTHING)
7585
{
7586
printf("! Argument to `-M' must be %i--%i or empty (==%i).\n",
7587
NOTHING, EVERYTHING, EVERYTHING);
7588
mark_harmless;
7589
msg_level = EVERYTHING;
7590
}
7591
}
7592
}
7593
7594
7595
@*1 Option {\tt -m}.
7596
The \.{-m}~option takes care of several commands:
7597
\.{-m4}~says to recognize \.{m4}~commands; \.{-m;}~means automatically
7598
append as pseudo-semi to \WEB\ macro definitions; otherwise, it's a \WEB\
7599
macro definition.
7600
7601
@<Option \.{-m}...@>=
7602
{
7603
switch(*pa)
7604
{
7605
case '4':
7606
/* Recognize \.{m4} definitions. */
7607
@<Issue warning...@>@;
7608
@#if 0
7609
R_ext = "m4"; N_ext = "n4";
7610
@#endif
7611
m4 = !M4_;
7612
pa++;
7613
break;
7614
7615
case ';':
7616
/* Automatically append pseudo-semi to \.{WEB} macro definition. */
7617
auto_app_semi = NOT(AUTO_APP_SEMI);
7618
pa++;
7619
break;
7620
7621
case '\0':
7622
err_print_(C,"Missing id for 'm' option");
7623
break;
7624
7625
default:
7626
if(not)
7627
goto undefine_macro;
7628
7629
define_macro:
7630
mc = *pa;
7631
7632
if(!(isalpha(mc) || mc=='_' || mc=='$'))
7633
err_print_(C,"Macro definition may not start with \
7634
'%c'; -m option ignored",mc);
7635
else
7636
save_macro(OC("m"), (outer_char *)pa);
7637
// Macro definition (unprotected; can't use |SAVE_MACRO|).
7638
7639
continue;
7640
}
7641
}
7642
7643
@ Build a macro definition in the macro buffer. This is used for
7644
predefining macros as well as defining from the command line. (This
7645
function modifies the text~|t|.)
7646
7647
@<Part 2@>=@[
7648
7649
SRTN
7650
save_macro FCN((cmd,t))
7651
CONST outer_char HUGE *cmd C0("Name of the ``at'' command to put first.")@;
7652
outer_char HUGE *t C1("Text of the definition.")@;
7653
{
7654
eight_bits HUGE *p;
7655
boolean replace_equals = BOOLEAN(STRCMP(cmd,"m")==0); /* For macros, if an
7656
equals sign appears before a space, it will be turned into a space. */
7657
7658
if(program==weave) return;
7659
7660
p = mp;
7661
7662
/* Place command such as \.{@@m} into buffer. */
7663
*mp++ = '@@';
7664
7665
while(*cmd)
7666
*mp++ = *cmd++; /* Copy text of command. */
7667
7668
*mp++ = ' ';
7669
7670
while(*t)
7671
{
7672
if(replace_equals)
7673
if(*t == '=')
7674
{
7675
*t = ' ';
7676
replace_equals = NO;
7677
}
7678
else if(*t == ' ') replace_equals = NO;
7679
*mp++ = *t++;
7680
}
7681
7682
*mp++ = ' ';
7683
*mp = '@@'; @~ *(mp+1) = 'm';
7684
7685
/* After we've built it, convert to internal notation. */
7686
for( ; p<mp+2; p++)
7687
*p = XORD(*p);
7688
}
7689
7690
@ Divert the input stream to be from a buffer.
7691
@<Glob...@>=
7692
7693
IN_COMMON ASCII HUGE *fbuffer, HUGE *flimit, HUGE *floc; /* Saved position
7694
of current file. */
7695
7696
@
7697
@<Part 2@>=@[
7698
7699
SRTN
7700
divert FCN((buffer,end,stop))
7701
ASCII HUGE *buffer C0("Start of the buffer.")@;
7702
ASCII HUGE *end C0("End of the buffer.")@;
7703
boolean stop C1("Stop when end is reached?")@;
7704
{
7705
stop_the_scan = stop;
7706
7707
fbuffer = cur_buffer;
7708
flimit = limit;
7709
floc = loc;
7710
7711
cur_buffer = loc = buffer;
7712
limit = end;
7713
7714
from_buffer = YES;
7715
}
7716
7717
@ Undivert back to reading from files.
7718
@<Part 2@>=@[
7719
SRTN
7720
undivert(VOID)
7721
{
7722
cur_buffer = fbuffer;
7723
limit = flimit;
7724
loc = floc;
7725
7726
from_buffer = NO;
7727
}
7728
7729
7730
@*1 Option {\tt -s}.
7731
Process statistics requests.
7732
7733
@<Option \.{-s}...@>=
7734
{
7735
statistics = NOT(STATISTICS);
7736
7737
/* The format ``\.{-sm100}'' says to display memory allocations for sizes
7738
$>= 100$ bytes. */
7739
if(*pa)
7740
if(*pa == 'm')
7741
{
7742
pa++; // |pa| positioned to byte size.
7743
show_mem = NOT(SHOW_MEM);
7744
if(isdigit(*pa)) show_size = ATOL(pa);
7745
}
7746
else
7747
{
7748
printf("! Option \"%s\" is invalid.\n", (char *)(pa-2));
7749
mark_harmless;
7750
}
7751
}
7752
7753
@ On the smaller computers, it's helpful to know where we stand regarding
7754
available memory. The function |mem_avail| is invoked along with the other
7755
statistics turned on by the \.{-s}~command-line option.
7756
7757
A global variable is used to capture the starting memory, so we don't print
7758
rediculously large maximum numbers with the statistics.
7759
7760
@<Glob...@>=
7761
7762
IN_COMMON BUF_SIZE starting_memory CSET(ULONG_MAX);
7763
// Set at first call to |mem_avail|.
7764
7765
@
7766
@<Part 2@>=@[
7767
7768
SRTN
7769
mem_avail FCN((at_end))
7770
int at_end C1("0 for beginning, 1 for end")@;
7771
{
7772
SET_COLOR(info);
7773
7774
if(at_end)
7775
printf("\n Allocated maximum of %s bytes dynamically; \
7776
ended with %s bytes.\n",
7777
commas(max_mem), commas(total_mem));
7778
7779
#if PRINT_AVAILABLE_MEMORY
7780
printf(" Available memory: %s bytes.\n", commas(CORE_LEFT));
7781
if(!at_end)
7782
{
7783
starting_memory = CORE_LEFT; // Used in |smin0|.
7784
putchar('\n');
7785
}
7786
#endif
7787
7788
free_buf(&c_buf);
7789
SET_COLOR(ordinary);
7790
}
7791
7792
@ Here is a common routine to print the statistics for a particular kind of
7793
array.
7794
@<Part 2@>=@[
7795
7796
SRTN
7797
stat0 FCN((name,size,num,max_num,abs_max_num,abbrev,ctrl_chars))
7798
CONST outer_char *name C0("")@;
7799
size_t size C0("")@;
7800
BUF_SIZE num C0("")@;
7801
BUF_SIZE max_num C0("")@;
7802
BUF_SIZE abs_max_num C0("")@;
7803
CONST outer_char *abbrev C0("")@;
7804
CONST outer_char *ctrl_chars C1("")@;
7805
{
7806
SET_COLOR(ordinary);
7807
printf(" %s ", (char *)name);
7808
7809
SET_COLOR(character);
7810
printf("[\"%s\"]", (char *)abbrev);
7811
7812
SET_COLOR(ordinary);
7813
printf(" x %u byte(s): %lu [%lu byte(s)] of %lu <= %s%s\n",
7814
(unsigned)size, num, num*size, max_num,
7815
commas(abs_max_num), (char *)ctrl_chars);
7816
free_buf(&c_buf);
7817
}
7818
7819
@ A simple function to return the maximum ``reasonable'' memory.
7820
@<Part 2@>=@[
7821
7822
BUF_SIZE
7823
smin0 FCN((abs_max_num))
7824
BUF_SIZE abs_max_num C1("")@;
7825
{
7826
return MIN(starting_memory,abs_max_num);
7827
}
7828
7829
7830
@*1 Commas.
7831
Here are routines to insert commas in integers.
7832
7833
@<Part 2@>=@[
7834
7835
SRTN
7836
init_buf FCN((p, num))
7837
BUF *p C0("")@;
7838
int num C1("")@;
7839
{
7840
p->s = GET_MEM("buf array", num, outer_char *);
7841
p->num = num;
7842
p->n = 0;
7843
}
7844
7845
outer_char *
7846
push_buf FCN((p, s))
7847
BUF *p C0("")@;
7848
outer_char *s C1("")@;
7849
{
7850
if(p->n >= p->num)
7851
{}
7852
7853
return p->s[p->n++] = s;
7854
}
7855
7856
SRTN
7857
free_buf FCN((p))
7858
BUF *p C1("")@;
7859
{
7860
while(p->n > 0)
7861
FREE(p->s[--p->n]);
7862
}
7863
7864
@
7865
@<Initialize static...@>=
7866
{
7867
init_buf(&sput_buf, 10);
7868
init_buf(&c_buf, 10);
7869
}
7870
7871
@
7872
@<Part 2@>=@[
7873
7874
outer_char *
7875
commas FCN((l))
7876
unsigned long l C1("")@;
7877
{
7878
outer_char temp[50], *p;
7879
outer_char temp1[100], *p1;
7880
int n0, n;
7881
int len;
7882
7883
p = temp;
7884
p1 = temp1;
7885
7886
#if 0
7887
if(l < 0)
7888
{
7889
*p1++ = '-';
7890
l = -l;
7891
}
7892
#endif
7893
7894
sprintf((char *)temp, "%lu", l);
7895
7896
len = STRLEN(temp);
7897
7898
n = 3 - len % 3;
7899
7900
while(*p)
7901
{
7902
*p1++ = *p++;
7903
n++;
7904
if(n % 3 == 0)
7905
*p1++ = ',';
7906
}
7907
7908
p1[-1] = '\0';
7909
7910
return push_buf(&c_buf, temp1);
7911
}
7912
7913
7914
@*1 Option {\tt -t}.
7915
Truncate identifiers.
7916
7917
@<Option \.{-t}...@>=
7918
{
7919
@<Issue warning if this command is negated@>@;
7920
ntrunc();
7921
}
7922
7923
@ Parse the argument of the truncate (`\.{-t}') command.
7924
@<Part 2@>=@[
7925
7926
SRTN
7927
ntrunc(VOID)
7928
{
7929
LANGUAGE l;
7930
7931
truncate_ids = NO;
7932
7933
if(!*pa)
7934
goto bad_t_option;
7935
7936
while(*pa)
7937
{
7938
if(isdigit(*pa))
7939
l = (language==NO_LANGUAGE) ? GLOBAL_LANGUAGE : language;
7940
else switch(*pa++)
7941
{
7942
@<|outer_char| cases for |C|@>:
7943
l = lcase(C,'\0',C_PLUS_PLUS,'+',&pa);
7944
break;
7945
@<|outer_char| cases for |RATFOR|@>:
7946
l = lcase(RATFOR,'7',RATFOR_90,'9',&pa);
7947
break;
7948
@<|outer_char| cases for |FORTRAN|@>:
7949
l = lcase(FORTRAN,'7',FORTRAN_90,'9',&pa);
7950
break;
7951
@<|outer_char| cases for |LITERAL|@>:
7952
l = LITERAL; @~ break;
7953
@<|outer_char| cases for |TEX|@>:
7954
l = TEX; @~ break;
7955
default:
7956
bad_t_option:
7957
err_print_(C,"Invalid -t option. Example: `-tn=6{_}'");
7958
return;
7959
}
7960
7961
/* Skip over optional equals sign. */
7962
if(*pa == LANGUAGE_SEPARATOR)
7963
pa++;
7964
7965
/* Set the maximum identifier length for language~|l|. */
7966
truncate_ids =
7967
BOOLEAN(CHOICE((tr_max[lan_num(l)] = (unsigned short)ATOI(pa)) != 0,
7968
YES,NO));
7969
7970
while(isdigit(*pa)) pa++; // Skip over the integer.
7971
7972
if(*pa == '{')
7973
set_filter(l);
7974
}
7975
}
7976
7977
@ Return a language based on the current argument character.
7978
@<Part 2@>=@[
7979
7980
LANGUAGE
7981
lcase FCN((l0,c0,l1,c1,pp))
7982
LANGUAGE l0 C0("")@;
7983
outer_char c0 C0("")@;
7984
LANGUAGE l1 C0("")@;
7985
outer_char c1 C0("")@;
7986
outer_char HUGE * HUGE *pp C1("")@;
7987
{
7988
if(c0 && **pp==c0)
7989
{
7990
while(**pp==c0) (*pp)++;
7991
return l0;
7992
}
7993
7994
if(c1 && **pp==c1)
7995
{
7996
while(**pp==c1) (*pp)++;
7997
return l1;
7998
}
7999
8000
return l0;
8001
}
8002
8003
@ Set list of characters to strip from identifiers. The language command
8004
`\.{-n\{abc\}}' sets the undesirable characters to `\.{abc}'.
8005
8006
@<Part 2@>=@[
8007
8008
SRTN
8009
set_filter FCN((Language))
8010
LANGUAGE Language C1("")@;
8011
{
8012
if(!*pa)
8013
return; // In case there's no argument following the language cmd.
8014
8015
if(*pa == '{')
8016
pa++;
8017
8018
filter_char[lan_num(Language)] = (char *)pa; /* Repoint to the string of
8019
characters following this command. */
8020
8021
/* Remove the closing bracket from the list. */
8022
for( ; *pa; pa++)
8023
if(*pa == '}')
8024
{
8025
*pa++ = '\0';
8026
return;
8027
}
8028
}
8029
8030
8031
@*1 Option {\tt -T}.
8032
Various flags for \FTANGLE.
8033
8034
@<Option \.{-T}: various flags for \FTANGLE@>=
8035
{
8036
outer_char HUGE *p = pa;
8037
8038
if(!*p)
8039
{
8040
no_arg('T', OC("Dv%#"));
8041
continue;
8042
}
8043
8044
while(*p)
8045
switch(*p++)
8046
{
8047
case 'D':
8048
deferred_macros = NOT(DEFERRED_MACROS);
8049
break;
8050
8051
case 'b':
8052
redefine_builtins = NOT(REDEFINE_BUILTINS);
8053
break;
8054
8055
case 'm':
8056
redefine_macros = NOT(REDEFINE_MACROS);
8057
break;
8058
8059
case 'v':
8060
top_version = NOT(TOP_VERSION);
8061
break;
8062
8063
case '%':
8064
keep_trailing_comments = NOT(KEEP_TRAILING_COMMENTS);
8065
break;
8066
8067
case '#':
8068
auto_line = NOT(AUTO_LINE);
8069
break;
8070
8071
default:
8072
bad_option();
8073
break;
8074
}
8075
}
8076
8077
@*1 Option {\tt -u}.
8078
Undefine a macro.
8079
8080
@<Option \.{-u}...@>=
8081
{
8082
if(not)
8083
goto define_macro;
8084
8085
undefine_macro:
8086
if(*pa == '\0')
8087
err_print_(C,"Missing identifier for `-u' option");
8088
else
8089
save_macro(OC("#undef"),pa);
8090
}
8091
8092
8093
@*1 Option {\tt -W}.
8094
Various flags for \FWEAVE.
8095
8096
@<Glob...@>=
8097
8098
IN_COMMON outer_char *extra_args;
8099
// Extra arguments for preprocessor; used in conjunction with \.{-H}.
8100
IN_COMMON boolean mod_warning_flag CSET(NEVER_USED);
8101
8102
@
8103
8104
@d NEVER_USED 0b01
8105
@d MULTIPLE_USES 0b10
8106
@d ALL_WARNINGS (NEVER_USED | MULTIPLE_USES)
8107
8108
@<Option \.{-W}: various flags for \FWEAVE@>=
8109
{
8110
outer_char HUGE *p = pa;
8111
int n, n_old;
8112
8113
if(!*p)
8114
{
8115
no_arg('W', OC("@@1[HdFflmvWw"));
8116
continue;
8117
}
8118
8119
while(*p)
8120
switch(*p++)
8121
{
8122
case '@@':
8123
if(!*p)
8124
mod_warning_flag = ALL_WARNINGS;
8125
else
8126
mod_warning_flag = ATOI(p++);
8127
break;
8128
8129
case '1':
8130
index_one = NOT(INDEX_ONE);
8131
break;
8132
8133
case '[':
8134
active_brackets = NOT(ACTIVE_BRACKETS);
8135
break;
8136
8137
case 'H':
8138
n = STRLEN(p);
8139
n_old = STRLEN(extra_args);
8140
8141
if(!extra_args)
8142
{
8143
extra_args = GET_MEM("extra_args", n+1, outer_char);
8144
STRCPY(extra_args, p);
8145
}
8146
else
8147
{
8148
if((extra_args = (outer_char *)REALLOC(extra_args,
8149
(n_old + n + 1)*sizeof(outer_char),
8150
n_old*sizeof(outer_char))) == NULL)
8151
OVERFLW("extra_args", 0);
8152
8153
STRCAT(extra_args, p);
8154
}
8155
8156
p += n;
8157
break;
8158
8159
case 'd':
8160
defn_mask.outer_macros = NOT(PRN_OUTER_MACROS);
8161
break;
8162
8163
case 'f':
8164
defn_mask.formats = NOT(PRN_fORMATS);
8165
break;
8166
8167
case 'F':
8168
defn_mask.Formats = NOT(PRN_FORMATS);
8169
break;
8170
8171
case 'l':
8172
defn_mask.limbo = NOT(PRN_LIMBO);
8173
break;
8174
8175
case 'm':
8176
defn_mask.macros = NOT(PRN_MACROS);
8177
break;
8178
8179
case 'v':
8180
defn_mask.v = NOT(PRN_V);
8181
break;
8182
8183
case 'w':
8184
case 'W':
8185
defn_mask.w = NOT(PRN_W);
8186
break;
8187
8188
default:
8189
bad_option();
8190
break;
8191
}
8192
}
8193
8194
@*1 Option {\tt -x}.
8195
The \.{-x}~option has the format `\.{-x\It{[*cimu]}}',
8196
which controls the printing of the table of contents~(`\.{c}'),
8197
index~(`\.{i}'), module list~(`\.{m}'), and unnamed
8198
cross-references~(`\.{u}'). `\.{*}"~means print nothing.
8199
`\.{-xi}'~means don't print the index, but print everything else. (More
8200
precisely, `\.{*}'~is translated into the list~`\.{cim}'. Each letter
8201
negates the default action associated with it.)
8202
8203
@<Part 2@>=@[
8204
8205
SRTN
8206
flags3 FCN((not))
8207
boolean not C1("")@;
8208
{
8209
prn_contents = BOOLEAN(PRN_CONTENTS ^ not);
8210
prn_index = BOOLEAN(PRN_INDEX ^ not);
8211
prn_modules = BOOLEAN(PRN_MODULES ^ not);
8212
xref_unnamed = BOOLEAN(XREF_UNNAMED ^ not);
8213
8214
if(!(*pa))
8215
{ /* No argument. Assume nothing is to be printed. */
8216
*pa = '*';
8217
*(pa+1) = '\0';
8218
}
8219
8220
for(; *pa; pa++)
8221
switch(*pa)
8222
{
8223
case '*':
8224
case '/':
8225
prn_contents = NOT(PRN_CONTENTS);
8226
prn_index = NOT(PRN_INDEX);
8227
prn_modules = NOT(PRN_MODULES);
8228
break;
8229
8230
case 'c':
8231
prn_contents = NOT(PRN_CONTENTS);
8232
break;
8233
8234
case 'i':
8235
prn_index = NOT(PRN_INDEX);
8236
break;
8237
8238
case 'm':
8239
prn_modules = NOT(PRN_MODULES);
8240
break;
8241
8242
case 'u':
8243
xref_unnamed = NOT(XREF_UNNAMED);
8244
break;
8245
8246
default:
8247
err_print_(C,"'%c' is invalid argument for `-x' or `-X'; \
8248
must be element of set {*cim}",*pa);
8249
break;
8250
}
8251
8252
no_xref = BOOLEAN(!(prn_index || prn_modules));
8253
}
8254
8255
@*1 Option {\tt -y}.
8256
The `\.{-y}~command has two forms: a query mode,
8257
``\.{-y$aa$?}'', or the setting mode, ``\.{-y$aa$\It{nnnnn}}''. To query
8258
all options, say ``\.{-y?}''
8259
8260
@<Option \.{-y}...@>=
8261
@B
8262
outer_char abbrev[80],HUGE *a;
8263
BUF_SIZE nunits;
8264
MEM HUGE *m,HUGE *mmin = NULL, HUGE *mmax = NULL;
8265
boolean query_mode = NO;
8266
8267
@b
8268
@<Issue warning if this command is negated@>@;
8269
8270
if(!*pa)
8271
{ /* Query everything. */
8272
mmin = mem;
8273
mmax = mmin + (sizeof_mem/sizeof(MEM) - 1);
8274
query_mode = YES;
8275
CLR_PRINTF(ALWAYS, info, ("Default memory allocation parameters:"));
8276
}
8277
else
8278
{ /* Abbreviation specified. */
8279
abbrev[0] = abbrev[1] = '\0'; /* Ensure the abbreviation gets
8280
terminated properly. */
8281
8282
for(a=abbrev; isalpha(*pa); )
8283
*a++ = *pa++;
8284
8285
TERMINATE(abbrev,2); // Max of two character abbreviation.
8286
8287
if(!isdigit(*pa))
8288
{ /* Assume it's a question. */
8289
mmin = msearch(abbrev,0L);
8290
mmax = mmin + 1;
8291
query_mode = YES;
8292
}
8293
}
8294
8295
if(query_mode)
8296
for(m=mmin; m<mmax; m++)
8297
{
8298
SET_COLOR(character);
8299
printf(" \"%-s\"%s",
8300
(char *)m->abbrev, m->abbrev[1] ? "" : " ");
8301
8302
SET_COLOR(ordinary);
8303
printf("x %d byte(s):\
8304
min = %s, cur = %s [%s byte(s)], max = %s.\n",
8305
m->bytes,
8306
commas(m->min),
8307
commas(m->nunits),
8308
commas((m->nunits)*(m->bytes)),
8309
commas(m->max));
8310
}
8311
else
8312
{ /* Change setting. */
8313
nunits = ATOL(pa);
8314
msearch(abbrev,nunits); // Set the value.
8315
}
8316
8317
info_option = YES;
8318
}
8319
8320
@*1 Option {\tt -z}.
8321
Set name of style file.
8322
8323
@<Option \.{-z}@>=
8324
{
8325
@<Issue warning if this command is negated@>@;
8326
8327
if(STRLEN(pa) < MAX_FILE_NAME_LENGTH)
8328
{
8329
if(STRCMP(pa,".") == 0)
8330
{ /* Read default file in current directory. */
8331
if(NSPRINTF(style_file_name,
8332
".%c%s",PREFIX_END_CHAR,STYLE_FILE_NAME) >=
8333
MAX_FILE_NAME_LENGTH) OVERFLW("./style_file_name","");
8334
}
8335
else
8336
STRCPY(style_file_name,pa);
8337
8338
renamed_style = YES;
8339
}
8340
else
8341
err_print_(C,"Style file name `%s' is too long; must be less \
8342
than %d characters",pa, MAX_FILE_NAME_LENGTH);
8343
}
8344
8345
8346
@*1 Options {\tt ->} and {\tt -=}.
8347
Here we determine a new output file
8348
name, with the command~\.{->}. If the argument is empty, everything goes to
8349
|stdout|. Otherwise, the command must have the format \.{->l=name.ext}. If
8350
the language~\.l is empty, all output is redirected to \.{name.ext}. If
8351
the name field is~'\.*', the name of the web file is used, but with the new
8352
extension. Otherwise, both the new name and the new extension are used.
8353
8354
@d LANGUAGE_SEPARATOR '=' // Separates language from file name.
8355
8356
@<Part 2@>=@[
8357
8358
SRTN
8359
redirect_output(VOID)
8360
{
8361
int k;
8362
8363
if(*pa == '\0')
8364
{ /* Empty argument; send stuff to |stdout|. */
8365
new_fname(&tex_fname,OC("stdout"),NULL);
8366
8367
for(k=0; k<NUM_LANGUAGES; k++)
8368
new_fname(params.outp_nm+k,OC("stdout"),NULL);
8369
}
8370
else if(phase==2 && program==weave)
8371
return;
8372
else
8373
{
8374
outer_char c,HUGE *pname;
8375
outer_char HUGE *q = (outer_char HUGE *)STRCHR(pa,LANGUAGE_SEPARATOR);
8376
// Is there an '='?
8377
8378
if(q==pa)
8379
{ /* ``\.{->=new\_name}'' */
8380
c = LANGUAGE_SEPARATOR;
8381
pname = q + 1; // Point to file name.
8382
}
8383
else if(q)
8384
{ /* ``\.{->c=new\_name}'' */
8385
c = *pa++; /* Language symbol. */
8386
pname = q; // Point to \.=.
8387
}
8388
else
8389
{ /* ``\.{->new\_name}'' */
8390
c = LANGUAGE_SEPARATOR;
8391
pname = pa; // Point to file name.
8392
}
8393
8394
switch(c)
8395
{
8396
@<|outer_char| cases for |C|@>:
8397
set_fname(lcase(C,'\0',C_PLUS_PLUS,'+',&pa),pname,YES);
8398
break;
8399
8400
@<|outer_char| cases for |RATFOR|@>:
8401
if(!RAT_OK("Redirection ignored")) break;
8402
8403
set_fname(lcase(RATFOR,'7',RATFOR_90,'9',&pa),pname,YES);
8404
break;
8405
8406
@<|outer_char| cases for |FORTRAN|@>:
8407
set_fname(lcase(FORTRAN,'7',FORTRAN_90,'9',&pa),pname,YES);
8408
break;
8409
8410
@<|outer_char| cases for |LITERAL|@>:
8411
set_fname(LITERAL,pname,YES);
8412
break;
8413
8414
@<|outer_char| cases for |TEX|@>:
8415
set_fname(TEX,pname,YES);
8416
break;
8417
8418
case LANGUAGE_SEPARATOR:
8419
#if 0 /* Don't want to do this; it screws up module labeling for \FWEAVE. */
8420
new_fname(&tex_fname,pname,NULL);
8421
#endif
8422
8423
for(k=0; k<NUM_LANGUAGES; k++)
8424
new_fname(params.outp_nm+k,pname,NULL);
8425
8426
break;
8427
8428
default:
8429
err_print_(C,"Syntax error in output redirection \
8430
command \"->\". Language must be one of 'c', 'r', 'n', `m', or `x', not '%c'",
8431
*(pa-1));
8432
break;
8433
}
8434
}
8435
}
8436
8437
@ This function sets an alternative output file name. If the |check| field
8438
is |YES|, we check to see that the string has the format ``\.{=stuff}''.
8439
8440
@<Part 2@>=@[
8441
8442
SRTN
8443
set_fname FCN((l,s,check))
8444
LANGUAGE l C0("Language")@;
8445
outer_char HUGE *s C0("Remainder of command-line argument to parse")@;
8446
boolean check C1("Do we check for beginning colon?")@;
8447
{
8448
if(program==weave)
8449
err_print_(C,"Can't redirect FWEAVE's TeX output by individual \
8450
languages. Use \"->\" or \"-%cname.ext\"",LANGUAGE_SEPARATOR);
8451
8452
if(check)
8453
if(*s++ != LANGUAGE_SEPARATOR)
8454
{
8455
err_print_(C,"Expected '%c' after language in \"->\"; \
8456
command ignored",LANGUAGE_SEPARATOR);
8457
return;
8458
}
8459
8460
/* If the name begins with a '\.\#', it's filled in later with |wbflnm0|. */
8461
new_fname(params.outp_nm+lan_num(l),*s ? s : (outer_char HUGE *)"stdout",NULL);
8462
}
8463
8464
8465
@*1 Warnings.
8466
Some of the commands aren't naturally negatable; issue a warning.
8467
8468
@<Issue warning...@>=
8469
cant_negate(pa-2);
8470
8471
@
8472
@<Part 2@>=@[
8473
8474
SRTN
8475
cant_negate FCN((s))
8476
outer_char HUGE *s C1("")@;
8477
{
8478
if(not)
8479
{
8480
printf("! Can't negate option \"%s\"'; ignoring extra hyphen.\n",
8481
(char *)s);
8482
mark_harmless;
8483
}
8484
}
8485
8486
@
8487
@<Part 2@>=@[
8488
8489
SRTN
8490
bad_lcmd FCN((type,pa0))
8491
CONST char *type C0("")@;
8492
CONST outer_char HUGE *pa0 C1("")@;
8493
{
8494
err_print_(C,"Invalid language %s \"%s\"",type,pa0);
8495
}
8496
8497
@
8498
@<Part 2@>=@[
8499
8500
SRTN
8501
bad_loption FCN((Language))
8502
LANGUAGE Language C1("")@;
8503
{
8504
printf("! Invalid language option \"%s\" for %s.\n",
8505
(char *)(pa-3), is_FORTRAN_(Language) ? "Fortran" : "Ratfor");
8506
mark_harmless;
8507
}
8508
8509
@
8510
@<Part 2@>=@[
8511
8512
SRTN
8513
no_arg FCN((option, letters))
8514
outer_char option C0("Letter of option")@;
8515
CONST outer_char *letters C1("Possibilities for args")@;
8516
{
8517
err_print_(C, "Missing argument for `-%c' option; \
8518
should be one or more letters in set {%s}", option, letters);
8519
}
8520
8521
@
8522
@<Part 2@>=@[
8523
8524
SRTN
8525
usage FCN((msg,is_fatal))
8526
CONST char *msg C0("")@;
8527
boolean is_fatal C1("Fatal?")@;
8528
{
8529
if(is_fatal)
8530
{
8531
char c = wt_style.ext_delimiter;
8532
8533
FATAL(NULL,
8534
msg,
8535
"!! Usage: %s [-option...] webfile[%cweb] \
8536
[changefile[%cch]]\n",
8537
program==tangle ? "ftangle" : "fweave",
8538
c, c);
8539
}
8540
else
8541
wrap_up();
8542
}
8543
8544
@
8545
@<Print change file warning...@>=
8546
{
8547
printf("! Warning: Ignoring multiple change file \"%s\".\n",
8548
(char *)THE_FILE_NAME);
8549
mark_harmless;
8550
continue;
8551
}
8552
8553
@
8554
@<Part 2@>=@[
8555
8556
SRTN
8557
too_long(VOID)
8558
{
8559
FATAL(NULL,
8560
"!! Filename too long: ",
8561
"%s.",
8562
(CONST outer_char *)pa);
8563
}
8564
8565
@
8566
@<Part 2@>=@[
8567
8568
SRTN
8569
bad_option(VOID)
8570
{
8571
printf("! (%s): Unknown option `%s' ignored.\n",
8572
cmd_prms ? "Command line" : ".fweb", (char *)pa_begin);
8573
mark_harmless;
8574
}
8575
8576
@ If a language was set on the command line, we issue a warning if the
8577
limbo section overrode that.
8578
@<Part 2@>=@[
8579
8580
SRTN
8581
chk_override FCN((language0))
8582
LANGUAGE language0 C1("")@;
8583
{
8584
if(language != language0 && cmd_language != NO_LANGUAGE && cmd_language !=
8585
language)
8586
err_print(C,"WARNING: Command-line language %s overridden in limbo by %s",
8587
languages[lan_num(cmd_language)],languages[lan_num(language)]);
8588
}
8589
8590
@* OUTPUT.
8591
Here is the code that opens the output file:
8592
@^system dependencies@>
8593
8594
@<Scan arguments and open output files@>=
8595
{
8596
@<Allocate initial file names@>@;
8597
scan_args();
8598
8599
/* If there's no \WEB\ file, it must be an info option. */
8600
if(found_web)
8601
{
8602
ini_input_prms(WEB_FILE,(outer_char HUGE *)"",ABORT_ON_ERROR);
8603
// Opens both input and change file.
8604
@<Remember the |web_file_name| and |change_file_name|@>;
8605
8606
if(program == weave)
8607
open_tex_file();
8608
}
8609
8610
/* In case no explicit language commands are given, either on the command
8611
line or in the file, before encountering the first module, pick a default. */
8612
if(language == NO_LANGUAGE)
8613
ini_language(XORD(*LANGUAGE_CODE(GLOBAL_LANGUAGE)));
8614
8615
global_params = params; // Freeze the params after arguments have been read.
8616
}
8617
8618
@ Initially, all output file names are empty.
8619
@<Allocate initial file names@>=
8620
{
8621
int k;
8622
8623
/* We initialize the \It{local} name list; it's set to global later after
8624
everything else is set. */
8625
new_fname(&tex_fname,NULL,NULL);
8626
new_fname(&fwebmac,NULL,NULL);
8627
8628
for(k=0; k<NUM_LANGUAGES; k++)
8629
new_fname(params.outp_nm+k,NULL,NULL);
8630
}
8631
8632
@ Make a new file name.
8633
8634
@d DFLT_FNAME_LENGTH 20
8635
8636
@<Part 2@>=@[
8637
8638
SRTN
8639
new_fname FCN((pname,name,ext))
8640
outer_char HUGE * HUGE *pname C0("")@;
8641
outer_char *name C0("")@;
8642
outer_char *ext C1("")@;
8643
{
8644
outer_char temp[MAX_FILE_NAME_LENGTH];
8645
8646
/* An empty |name| means allocate some space. */
8647
if(!name)
8648
*pname = GET_MEM("pname",DFLT_FNAME_LENGTH+1,outer_char);
8649
else
8650
{ /* Otherwise, we possibly allocate the space and construct the
8651
name. */
8652
char ext_delimiter[2];
8653
FILE *temp_file_ptr;
8654
8655
ext_delimiter[0] = (char)wt_style.ext_delimiter;
8656
ext_delimiter[1] = '\0';
8657
8658
SPRINTF(MAX_FILE_NAME_LENGTH,temp,`"%s%s%s",name,ext ?
8659
ext_delimiter : "",
8660
ext ? ext : (outer_char *)""`);
8661
8662
/* Previously we used to reallocate the file name here. However, that
8663
leads to an egregious error, since if the block is actually moved the old
8664
pointers are still around on the stack and in various other hiding places.
8665
Now, we just allocate a new area if the name is new. */
8666
was_opened(temp,0,pname,&temp_file_ptr);
8667
}
8668
}
8669
8670
@
8671
@<Remember the |web_file_name| and |change_file_name|@>=
8672
@B
8673
outer_char temp1[100],temp2[1000],
8674
full_web_name[ESCAPE_LENGTH],esc_full_web_name[ESCAPE_LENGTH],
8675
full_change_name[ESCAPE_LENGTH],esc_full_change_name[ESCAPE_LENGTH];
8676
int n1,n2;
8677
BUF_SIZE old_size;
8678
8679
@b
8680
/* Run time */
8681
n1 = program==tangle ? NSPRINTF(temp1,
8682
"\n RUN TIME: \"%s, %s at %s.\"",
8683
the_day(t),the_cdate(t),the_time(t))
8684
: NSPRINTF(temp1,"");
8685
8686
#if(VMS)
8687
fgetname(web_file,full_web_name);
8688
fgetname(change_file,full_change_name);
8689
#else
8690
STRCPY(full_web_name,web_file_name);
8691
STRCPY(full_change_name,change_file_name);
8692
#endif /* |VMS| */
8693
8694
esc_file_name(esc_full_web_name,ESCAPE_LENGTH,full_web_name);
8695
esc_file_name(esc_full_change_name,ESCAPE_LENGTH,full_change_name);
8696
8697
n2 = NSPRINTF(temp2,
8698
program==tangle ?
8699
"\n WEB FILE: \"%s\"\n CHANGE FILE: %c%s%c" :
8700
" {\"%s\"} {%c%s%c} ",
8701
esc_full_web_name,
8702
*esc_full_change_name ? '"' : '(',
8703
*esc_full_change_name ? esc_full_change_name : OC("none"),
8704
*esc_full_change_name ? '"' : ')');
8705
8706
old_size = STRLEN(cmd_ln_buf) + 1;
8707
cmd_ln_buf = (outer_char HUGE *)REALLOC(cmd_ln_buf,old_size+n1+n2, old_size);
8708
STRCAT(cmd_ln_buf,temp1);
8709
STRCAT(cmd_ln_buf,temp2);
8710
}
8711
8712
@ For some system such as DOS, the file names may have special characters
8713
in them that need to be escaped:
8714
@<Part 2@>=@[
8715
8716
unsigned
8717
esc_file_name FCN((esc_name,max_length,name))
8718
outer_char *esc_name C0("Put answer into here")@;
8719
unsigned max_length C0("Maximum length of |esc_name|.")@;
8720
outer_char *name C1("Put escapes into this name")@;
8721
{
8722
outer_char *pt,*pn;
8723
unsigned n;
8724
8725
max_length--; /* Allow room for the final null. */
8726
8727
for(pt=esc_name,pn=name,n=0; *pn; )
8728
{
8729
if(program==weave)
8730
switch(*pn)
8731
{
8732
case '\\': case '$': case '#': case '%':
8733
case '^': case '~': case '&': case '_':
8734
if(n < max_length)
8735
{
8736
n++;
8737
*pt++ = '\\';
8738
}
8739
}
8740
8741
if(n < max_length)
8742
{
8743
n++;
8744
*pt++ = *pn++;
8745
}
8746
}
8747
8748
TERMINATE(pt,0);
8749
return n;
8750
}
8751
8752
@ The |update_terminal| macro is used when we want
8753
to make sure that everything we have output to the terminal so far has
8754
actually left the computer's internal buffers and been sent.
8755
@^system dependencies@>
8756
8757
@d UPDATE_TERMINAL fflush(stdout) // Empty the terminal output buffer.
8758
8759
@ For single-character output we use |putchar| (to the terminal) and |putc|
8760
(to a file). When we have to translate from \.{WEB}'s code into the
8761
external character code, we must say things like |putchar(xchr[c])|. When
8762
we just want to print strings, we use |printf|.
8763
@^system dependencies@>
8764
8765
@d new_line putchar('\n')
8766
@d putxchar putchar
8767
8768
@<Part 2@>=@[
8769
8770
SRTN
8771
ASCII_file_write FCN((file_ptr,p0,n))
8772
FILE *file_ptr C0("Standard file pointer.")@;
8773
CONST ASCII HUGE *p0 C0("Start of the buffer.")@;
8774
size_t n C1("Number of characters to write.")@;
8775
{
8776
CONST ASCII HUGE *p, HUGE *p1 = p0+n;
8777
ASCII atemp[1000],HUGE *a,HUGE *a1;
8778
size_t n_out;
8779
8780
if(n == 0)
8781
return;
8782
8783
/* Translate any special characters into something readable. */
8784
for(p=p0,a1=atemp; p<p1;a1++,p++)
8785
switch(*p)
8786
{
8787
case interior_semi:
8788
*a1 = @';';
8789
break;
8790
8791
case MACRO_ARGUMENT:
8792
*a1++ = @'[';
8793
*a1++ = @'[';
8794
*a1++ = (ASCII)(@'0' + *(++p));
8795
*a1++ = @']';
8796
*a1 = @']';
8797
break;
8798
8799
default:
8800
*a1 = *p;
8801
break;
8802
}
8803
8804
n = PTR_DIFF(size_t, a1, atemp);
8805
// Might be bigger than incoming~|n| because of macro arg.
8806
8807
if(translate_ASCII)
8808
{ /* Convert to the outer world. */
8809
outer_char temp[1000];
8810
outer_char HUGE *t;
8811
8812
for(a=atemp,t=temp; a<a1;)
8813
*t++ = XCHR(*a++);
8814
8815
n_out = FWRITE(temp,n,file_ptr);
8816
}
8817
else
8818
n_out = FWRITE(atemp,n,file_ptr);
8819
8820
if(n_out != 1)
8821
@<Diagnose a write error and give up@>@;
8822
}
8823
8824
@
8825
@<Diagnose...@>=
8826
{
8827
FATAL(NULL,
8828
"! WRITE ERROR: ",
8829
"nbytes = %u, %u items written\n%s",
8830
(unsigned)n, (unsigned)n_out, strerror(errno));
8831
}
8832
8833
@ The error routine |strerror| isn't available on all systems.
8834
@<Part 2@>=@[
8835
8836
#if !HAVE_STRERROR
8837
8838
char *
8839
strerror FCN((errnum))
8840
int errnum C1("")@;
8841
{
8842
static char temp[50];
8843
8844
sprintf(temp, "(strerror() is not available; errno = %d).", errnum);
8845
return temp;
8846
}
8847
8848
#endif // |!HAVE_STRERROR|
8849
8850
@ The |args| array used by the macro processor must be allocated after
8851
the command line is parsed, because |max_margs| might have been changed by
8852
the \.{-y}~option.
8853
8854
@<Allocate dyn...@>=
8855
{
8856
if(program == tangle)
8857
{
8858
ALLOC(sixteen_bits, args, ABBREV(max_margs), max_margs, 1);
8859
max_margs++; // So the user thinks this is really the max \#.
8860
}
8861
}
8862
8863
@* DATE, TIME, and TIMING.
8864
Here are declarations for time and date. We use
8865
many of the ANSI routines. (However, some of the following could be
8866
simplified if the compiler were fully ANSI. Timing seems to be one of the
8867
areas that's most difficult to get right on the various machines.)
8868
8869
@<Common...@>=
8870
8871
IN_COMMON CONST char *day[]
8872
#if(part == 0 || part == 1)
8873
= {"Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"}
8874
#endif // |part == 1|
8875
;
8876
8877
IN_COMMON CONST char *month[]
8878
#if(part == 0 || part == 1)
8879
= {"January","February","March","April","May","June","July",
8880
"August","September","October","November","December"}
8881
#endif // |part == 1|
8882
;
8883
8884
@ Fill the |tm| structure and return a pointer.
8885
@<Part 2@>=@[
8886
8887
struct tm *
8888
the_localtime(VOID)
8889
{
8890
time_t the_tm;
8891
time_t time PROTO((time_t *tp));
8892
8893
time(&the_tm);
8894
return localtime(&the_tm);
8895
}
8896
8897
@ Return strings containing the time and/or date.
8898
@<Part 2@>=@[
8899
8900
CONST outer_char *
8901
the_day FCN((t))
8902
CONST struct tm *t C1("")@;
8903
{
8904
return OC(day[t->tm_wday]);
8905
}
8906
8907
#define NDATE 20
8908
8909
CONST outer_char *
8910
the_cdate FCN((t))
8911
CONST struct tm *t C1("")@;
8912
{
8913
static outer_char date_buf[NDATE];
8914
8915
if(NSPRINTF(date_buf,"%s %d, %d",
8916
month[t->tm_mon],t->tm_mday,1900+t->tm_year) >= NDATE)
8917
OVERFLW("Date","");
8918
return (CONST outer_char *)date_buf;
8919
}
8920
#undef NDATE
8921
8922
#define NTIME 8
8923
8924
CONST outer_char *
8925
the_time FCN((t))
8926
CONST struct tm *t C1("")@;
8927
{
8928
static outer_char time_buf[NTIME];
8929
8930
if(NSPRINTF(time_buf,"%d:%02d",t->tm_hour,t->tm_min) >= NTIME)
8931
OVERFLW("Time","");
8932
8933
return (CONST outer_char *)time_buf;
8934
}
8935
#undef NTIME
8936
8937
@ Timing routines. In particular, sometimes we want timing more precise
8938
than seconds, but the standard ANSI |difftime| doesn't always do that.
8939
Thus, we sometimes supply our own.
8940
8941
@f TIME_T int
8942
8943
@<Common...@>=
8944
8945
#if TIMING
8946
8947
IN_COMMON clock_t clock0;
8948
IN_COMMON TIME_T time0;
8949
8950
#if NEW_DIFFTIME
8951
double diff_time FCN((t1,t0))
8952
TIME_T t1 C0("")@;
8953
TIME_T t0 C1("")@;
8954
{
8955
#if HAVE_GETTIMEOFDAY
8956
return (double)(t1.tv_sec - t0.tv_sec)
8957
+ 1.0e-6*(double)(t1.tv_usec - t0.tv_usec);
8958
#else
8959
#if HAVE_SYS_TIMEB_H
8960
return (double)t1.time - (double)t0.time
8961
+ 1.0e-3*((double)t1.millitm - (double)t0.millitm); /*
8962
Without the casts, this line didn't work right on the DECstation. I think
8963
it has to do with the |unsigned short| type of |millitm|; a compiler bug
8964
with type promotion. */
8965
#else
8966
return t1 - t0;
8967
#endif // |HAVE_SYS_TIMEB_H|
8968
#endif
8969
}
8970
#endif // |NEW_DIFFTIME|
8971
8972
#endif // |TIMING|
8973
8974
@ This function is called at the beginning of both \FTANGLE\ and \FWEAVE.
8975
@<Part 2@>=@[
8976
8977
#if TIMING
8978
8979
SRTN
8980
ini_timer(VOID)
8981
{
8982
TIME(&time0);
8983
clock0 = clock();
8984
}
8985
8986
#endif // |TIMING|
8987
8988
@ This one's called at the end.
8989
8990
@d TIMING_PREC 10 /* Check that |cpu <= wall| by multiplying seconds by
8991
this number, then truncating. */
8992
8993
@<Part 2@>=@[
8994
8995
#if TIMING
8996
8997
SRTN
8998
prn_time(VOID)
8999
{
9000
TIME_T time1;
9001
double cpu,wall;
9002
char less_than = NO;
9003
char format[100]; /* We build the format for the time output here. */
9004
9005
cpu = (clock()-clock0)/(double)(CLOCKS_PER_SEC);
9006
TIME(&time1);
9007
9008
/* Because the real time is in units of seconds, we might get~0, so we'll
9009
be fancy and print an inequality in that case. */
9010
if( (wall = DIFFTIME(time1,time0)) == 0.0)
9011
{
9012
wall = 1.0;
9013
less_than = YES;
9014
}
9015
9016
SET_COLOR(timing);
9017
9018
/* --- CPU time --- */
9019
sprintf(format, "\nCPU = %%.%df sec.", TIMING_WIDTH);
9020
printf(format, cpu);
9021
if(cpu >= 60.0) printf(" (%.2f min.)",cpu/60.0);
9022
9023
/* --- WALL CLOCK time --- */
9024
sprintf(format,"; REAL %%s %%.%df sec.",TIMING_WIDTH);
9025
printf(format,less_than ? "<=" : "=",wall);
9026
if(wall >= 60.0) printf(" (%.2f min.).",wall/60.0);
9027
9028
/* --- PERCENTAGE CPU UTILIZATION --- */
9029
printf(" CPU/REAL = %.1f%%.",100.0*(cpu/wall));
9030
9031
/* Debugging message: Check for compatibility. Because the timing routines
9032
may not be perfectly compatible through all decimal places, we check only
9033
that |cpu <= wall| to an accuracy of tenths of seconds. */
9034
@#if 0
9035
if((unsigned long)(TIMING_PREC*cpu) > (unsigned long)(TIMING_PREC*wall))
9036
printf("! CPU (%.3f s.) > REAL (%.3f s.). \
9037
Check for invalid CLOCKS_PER_SEC (%.3e) or type of clock().\n",
9038
cpu,wall,(double)CLOCKS_PER_SEC);
9039
@#endif
9040
9041
SET_COLOR(ordinary);
9042
}
9043
9044
#endif /* |TIMING| */
9045
9046
@* MISCELLANEOUS FUNCTIONS.
9047
Here are various routines that didn't fit anywhere else.
9048
9049
@*1 Initializing |program|.
9050
9051
@<Part 2@>=@[
9052
9053
SRTN
9054
ini_program FCN((program0))
9055
PROGRAM program0 C1("")@;
9056
{
9057
program = program0; // Set global flag.
9058
9059
the_system = OC(THE_SYSTEM); /* |THE_SYSTEM| is defined in \.{os.hweb}. */
9060
local_banner = OC(LOCAL_BANNER); /* See \.{os.hweb} and \.{custom.web}. */
9061
9062
ini_style(); // Default style file initializations. Sets up initial color.
9063
}
9064
9065
@*1 Printing the banner line.
9066
9067
@<Part 2@>=@[
9068
9069
SRTN
9070
banner(VOID)
9071
{
9072
if(msg_level == NOTHING && !prn_version)
9073
return;
9074
9075
CLR_PRINTF(ALWAYS, info, ("This is "));
9076
SET_COLOR(program_name);
9077
printf("%s", DEBUG_XCHR ? "ScRaMbLeD " : "");
9078
9079
#if 0
9080
CLR_PRINTF(ALWAYS, program_name,
9081
("%s",program==tangle ? "FTANGLE" : "FWEAVE"));
9082
#endif
9083
9084
printf("%s", program==tangle ? "FTANGLE" : "FWEAVE");
9085
9086
SET_COLOR(info);
9087
9088
printf(" [%s version %s (%s)%s%s]. %s\n",
9089
(char *)the_system, (char *)version, (char *)release_date,
9090
color_mode ? "; TERM=" : "",
9091
color_mode ? (char *)termcap : "",
9092
(char *)local_banner);
9093
9094
SET_COLOR(ordinary);
9095
}
9096
9097
@*1 Announcing current file.
9098
@<Part 2@>=@[
9099
9100
SRTN
9101
reading FCN((in_name,emit_newline))
9102
CONST outer_char *in_name C0("")@;
9103
boolean emit_newline C1("")@;
9104
{
9105
if(msg_level < SHORT_INFO)
9106
return;
9107
9108
CLR_PRINTF(SHORT_INFO, info, ("Reading")); @~ putchar(' ');
9109
CLR_PRINTF(SHORT_INFO, in_file, ("%s", (char *)in_name));
9110
CLR_PRINTF(SHORT_INFO, info, ("..."));
9111
9112
if(emit_newline)
9113
putchar('\n');
9114
}
9115
9116
@
9117
@<Part 2@>=@[
9118
9119
SRTN
9120
writing FCN((print_write,out_name))
9121
boolean print_write C0("")@;
9122
CONST outer_char *out_name C1("")@;
9123
{
9124
if(msg_level < SHORT_INFO)
9125
return;
9126
9127
if(print_write)
9128
{
9129
CLR_PRINTF(SHORT_INFO, info, ("\nWriting"));
9130
putchar(' ');
9131
}
9132
9133
CLR_PRINTF(SHORT_INFO, out_file, ("%s", (char *)out_name));
9134
CLR_PRINTF(SHORT_INFO, info, ("..."));
9135
fflush(stdout);
9136
}
9137
9138
@* Printing the progress report for each starred module.
9139
@<Part 2@>=@[
9140
9141
SRTN
9142
progress(VOID)
9143
{
9144
if(msg_level < EVERYTHING)
9145
return;
9146
9147
if (loc[-1] == @'*')
9148
{ /* Found a starred section. */
9149
if(err_happened)
9150
{
9151
putchar('\n');
9152
err_happened = NO;
9153
}
9154
else
9155
putchar(' ');
9156
9157
CLR_PRINTF(EVERYTHING, module_num, ("*%d",module_count));
9158
}
9159
9160
UPDATE_TERMINAL;
9161
}
9162
9163
@*1 {\bf nsprintf}.
9164
The ANSI |sprintf| returns the number of characters
9165
written; however, not all libraries are ANSI. The following function
9166
|nsprintf| forces the issue.
9167
9168
@<Part 2@>=@[
9169
9170
int
9171
nsprintf FCN(VA_ALIST((s,fmt,n VA_ARGS)))
9172
VA_DCL(
9173
outer_char *s C0("")@;
9174
CONST outer_char *fmt C0("")@;
9175
int n C2("")@;)@;
9176
{
9177
int num_char;
9178
VA_LIST(arg_ptr)@;
9179
#if(NUM_VA_ARGS == 1)
9180
outer_char *s;
9181
CONST outer_char *fmt;
9182
int n;
9183
#endif
9184
9185
VA_START(arg_ptr,n);
9186
9187
#if(NUM_VA_ARGS == 1)
9188
s = va_arg(arg_ptr,outer_char *);
9189
fmt = va_arg(arg_ptr,outer_char *);
9190
va_arg(arg_ptr,int);
9191
#endif
9192
9193
#if ANSI_SPRINTF
9194
num_char =
9195
#endif
9196
9197
vsprintf((char *)s,(CONST char *)fmt,arg_ptr);
9198
9199
#if !ANSI_SPRINTF
9200
num_char = (int)STRLEN(s);
9201
#endif
9202
9203
va_end(arg_ptr);
9204
9205
return num_char;
9206
}
9207
9208
@*1 {\bf x\_keyword}.
9209
Expand the text of an RCS-like keyword into a buffer, without |stringg|
9210
delimiters. This is called both from \.{macs}:|i_keyword_| (output phase)
9211
as well as directly from \FTANGLE\ during the input phase (when \.{\$LKWD})
9212
is recognized.
9213
9214
@d BCHECK(n, reason)
9215
if(mp + (n) > buf_end)
9216
OVERFLW("Keyword buffer", "")@;
9217
9218
@d CUR_QUOTE ((eight_bits)(single_quote || (!double_quote && R77_or_F) ?
9219
@'\'' : @'"'))
9220
9221
@<Glob...@>=
9222
9223
IN_COMMON boolean single_quote CSET(NO), double_quote CSET(NO);
9224
9225
@
9226
@a
9227
9228
SRTN
9229
x_keyword FCN((pmp, buf_end, p, p1, in_quotes, out_quotes, input_level))
9230
eight_bits HUGE * HUGE *pmp C0("")@;
9231
eight_bits HUGE *buf_end C0("")@;
9232
eight_bits HUGE *p C0("")@;
9233
eight_bits HUGE *p1 C0("")@;
9234
boolean in_quotes C0("")@;
9235
boolean out_quotes C0("")@;
9236
int input_level C1("")@;
9237
{
9238
eight_bits HUGE *mp = *pmp;
9239
RCS HUGE *prcs;
9240
// Dynamic array of RCS-like keywords.
9241
ASCII temp[256]; // Should make this variable.
9242
int len;
9243
eight_bits quote_char;
9244
boolean found_it;
9245
9246
len = p1 - p - 2*in_quotes; // The 2 takes care of quote characters.
9247
9248
if(in_quotes)
9249
quote_char = *p++;
9250
else if(out_quotes)
9251
quote_char = CUR_QUOTE;
9252
9253
if(out_quotes)
9254
{
9255
BCHECK(1, "quote0");
9256
*mp++ = quote_char;
9257
}
9258
9259
STRNCPY(temp, p, len);
9260
temp[len] = '\0';
9261
9262
found_it = NO;
9263
9264
for(prcs=prms[input_level].rcs_list.start;
9265
prcs && prcs->keyword; prcs=prcs->next)
9266
if(STRCMP(temp, prcs->keyword) == 0)
9267
{
9268
len = STRLEN(prcs->txt);
9269
BCHECK(len, "keyword");
9270
STRCPY(mp, prcs->txt);
9271
mp += len;
9272
found_it = YES;
9273
break;
9274
}
9275
9276
if(!found_it)
9277
err_print(C, "Unrecognized %s RCS-like keyword `%s'",
9278
input_level == WEB_FILE ? "global" : "local",
9279
temp);
9280
9281
if(out_quotes)
9282
{
9283
BCHECK(1, "quote1");
9284
*mp++ = quote_char;
9285
}
9286
9287
*pmp = mp; // Update the buffer pointer in the caller.
9288
}
9289
9290
@* INDEX.
Loggerhead is a web-based interface for Breezy
Version: 2.0.1