« back to all changes in this revision
Viewing changes to Web/macs.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/macs.web
1
@z --- macs.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{MACS.WEB} % Macro processing for FTANGLE
11
12
@c
13
14
@* MACROS. In the C~version of \WEB, namely \CWEB, the macro processor was
15
removed since C~has its own preprocessor. However, there are advantages to
16
having an internal processor when several languages are involved, even when
17
one wants to run a macro preprocessor on each language separately. For
18
example, the internal processor can modify the text of the outer macros, so
19
that setting one switch can affect conditional compilation in several
20
languages.
21
22
Here we collect the routines dealing with WEB's macro processor, which is
23
C-like.
24
25
(Parts of this code are inelegant; the first goal was to achieve the
26
desired functionality. Some of the difficulties stemmed from attempting to
27
integrate this code into \CWEB. In any event, although one might achieve
28
somewhat more compact and elegant code by rewriting the macro processor
29
from scratch, that's not a trivial job.)
30
31
@m _MACS_
32
@d _MACS_h
33
34
@A
35
@<Include files@>@;
36
@<Typedef declarations@>@;
37
@<Prototypes@>@;
38
@<Global variables@>@;
39
40
@I typedefs.hweb /* Declarations common to both \FTANGLE\ and \FWEAVE. */
41
42
@I t_codes.hweb
43
@I texts.hweb
44
@I stacks.hweb
45
@I val.hweb
46
@I trunc.hweb
47
48
@i macs.hweb /* Macro definitions. */
49
50
@
51
@<Include...@>=
52
#include "map.h"
53
54
@ The function prototypes must appear before the global variables.
55
@<Proto...@>=
56
57
#include "t_type.h" /* Prototypes for \.{ftangle.web}, etc. */
58
59
@ A token list of the current macro arguments is allocated dynamically.
60
61
@<Glob...@>=
62
63
IN_COMMON sixteen_bits HUGE *args; /* Token list of current macro arguments.
64
Allocated in |predefine_macros| just below. */
65
IN_COMMON BUF_SIZE max_margs; // Allocated length of |args|.
66
67
@ There may be predefined macros. These must be inserted into the
68
|macrobuf| during |common_init|.
69
@a
70
SRTN
71
predefine_macros(VOID)
72
{
73
new_mbuf(); // Here is the first, top-level allocation of the macro buffer.
74
75
@<Define internal macros@>; /* We accrete to this from various places, as
76
it becomes convenient to discuss the particular macro. */
77
t_macros(); // Internal macros from \.{ftangle.web}.
78
e_macros(); // Internal macros from \.{eval.web}.
79
}
80
81
@ We also introduce the concept of {\it internal macros}. These are
82
identifiers prefaced by `\.{\#\&}'. The identifier corresponds to a
83
function that is executed during macro expansion; the function places stuff
84
into the macro buffer. Internal macros are intended to be used only by the
85
designer of \FWEB, not by the user.
86
87
@<Typedef...@>=
88
89
typedef struct
90
{
91
const char *name; // Identifier.
92
int len; // Length of identifier. Filled in by |ini_internal_fcns|.
93
SRTN (*expnd)PROTO((int,unsigned char **));
94
/* Function that expands this token. This prototype really
95
should read |(int,PARGS)|, but that didn't work on the DECstation. The
96
name |expand| also seemed special to the DECstation. */
97
boolean Language;
98
eight_bits nargs;
99
boolean var_args;
100
boolean recursive;
101
sixteen_bits id; // The id code returned from |id_lookup|.
102
} INTERNAL_FCN;
103
104
@ Here are all the internal functions and the associated names that invoke
105
them.
106
@<Glob...@>=
107
108
INTERNAL_FCN internal_fcns[] = {
109
{"$$ASCII", 0, i_ascii_, 0xF, 1, NO, NO},
110
{"$ASSERT", 0, i_assert_, 0xF, 1, NO, NO},
111
{"$$CONST", 0, i_const_, 0xF, 2, YES, NO},
112
{"$DEFINE", 0, i_define_, 0xF, 1, NO, NO},
113
{"_DUMPDEF", 0, i_dumpdef_, 0xF, 0, YES, NO},
114
{"$DUMPDEF", 0, i_dumpdef_, 0xF, 0, YES, NO},
115
{"$$ERROR", 0, i_error_, 0xF, 1, NO, NO},
116
{"$$EVAL", 0, i_eval_, 0xF, 1, NO, NO},
117
{"$$GETENV", 0, i_getenv_, 0xF, 1, NO, NO},
118
{"$IF", 0, i_if_, 0xF, 3, NO, YES},
119
{"$IFCASE", 0, i_ifcase_, 0xF, 1, YES, YES},
120
{"$IFDEF", 0, i_ifdef_, 0xF, 3, NO, YES},
121
{"$IFNDEF", 0, i_ifndef_, 0xF, 3, NO, YES},
122
{"$IFELSE", 0, i_ifelse_, 0xF, 4, NO, YES},
123
{"_INPUT_LINE", 0, i_inp_line_, 0xF, 0, NO, NO},
124
{"$INPUT_LINE", 0, i_inp_line_, 0xF, 0, NO, NO},
125
{"$$KEYWORD", 0, i_keyword_, 0xF, 1, NO, NO},
126
{"_LANGUAGE", 0, i_lang_, 0xF, 0, NO, NO},
127
{"$LANGUAGE", 0, i_lang_, 0xF, 0, NO, NO},
128
{"$$LC", 0, i_lowercase_, 0xF, 1, NO, NO},
129
{"$$LEN", 0, i_len_, 0xF, 1, NO, NO},
130
{"$$LOG", 0, i_log_, 0xF, 2, NO, NO},
131
{"_LANGUAGE_NUM", 0, i_lnum_, 0xF, 0, NO, NO},
132
{"$LANGUAGE_NUM", 0, i_lnum_, 0xF, 0, NO, NO},
133
{"$M", 0, i_define_, 0xF, 1, NO, NO},
134
{"$$META", 0, i_meta_, 0xF, 1, NO, NO},
135
{"$$MIN_MAX", 0, i_min_max_, 0xF, 2, YES, NO},
136
{"$$MODULE_NAME", 0, i_mod_name_, 0xF, 0, NO, NO},
137
{"$$MODULES", 0, i_modules_, 0xF, 1, NO, NO},
138
{"$$NARGS", 0, i_nargs_, 0xF, 1, NO, NO},
139
{"_OUTPUT_LINE", 0, i_outp_line_, 0xF, 0, NO, NO},
140
{"$OUTPUT_LINE", 0, i_outp_line_, 0xF, 0, NO, NO},
141
{"$$ROUTINE", 0, i_routine_, RATFOR, 0, NO, NO},
142
{"_SECTION_NUM", 0, i_sect_num_, 0xF, 0, NO, NO},
143
{"$SECTION_NUM", 0, i_sect_num_, 0xF, 0, NO, NO},
144
{"$$SWITCH", 0, i_switch_, 0, 0, NO, NO},
145
{"$$TM", 0, i_tm_, 0xF, 1, NO, NO},
146
{"$$TRANSLIT", 0, i_translit_, 0xF, 3, NO, NO},
147
{"$UNDEF", 0, i_undef_, 0xF, 1, NO, NO},
148
{"$$UNSTRING", 0, i_unstring_, 0xF, 1, NO, NO},
149
{"$$UC", 0, i_uppercase_, 0xF, 1, NO, NO},
150
{"$$VERBATIM", 0, i_verbatim_, 0xF, 1, NO, NO},
151
{"$$VERSION", 0, i_version_, 0xF, 0, NO, NO},
152
{"_XX", 0, i_xflag_, 0xF, 1, NO, NO},
153
{"$XX", 0, i_xflag_, 0xF, 1, NO, NO},
154
{"", 0, NULL} // The null string terminates the list.
155
};
156
157
/* Put the internal function names into the table. */
158
SRTN
159
ini_internal_fcns(VOID)
160
{
161
INTERNAL_FCN HUGE *s;
162
name_pointer np;
163
text_pointer m;
164
165
for(s=internal_fcns; (s->len=STRLEN(s->name)) != 0; s++)
166
{
167
ASCII HUGE *p = x_to_ASCII(OC(s->name));
168
169
s->id = ID_NUM_ptr(np,p,p+s->len);
170
171
np->equiv = (ASCII HUGE *)(m=text_ptr++);
172
np->macro_type = IMMEDIATE_MACRO;
173
174
m->tok_start = (eight_bits HUGE *)s->expnd; // NON-ANSI cast???
175
m->nbytes = 0; // Should be irrelevant.
176
m->text_link = macro;
177
m->Language = s->Language;
178
m->nargs = s->nargs;
179
m->recursive = s->recursive;
180
m->var_args = s->var_args;
181
m->module_text = NO;
182
m->built_in = YES;
183
m->protected = YES;
184
}
185
186
/* Regular macro definitions (temporarily) store the replacement text in
187
the token memory. */
188
text_ptr->tok_start = tok_mem;
189
}
190
191
@ The |macrobuf| is maintained in |cur_state|. (See \.{stacks.hweb}.) Here
192
we allocate it. This is called both from \.{macs.web} and \.{ftangle.web}.
193
A separate copy of the macro buffer is maintained for each stack level;
194
it's allocated from |push_level| and freed from |pop_level|.
195
196
@a
197
SRTN
198
new_mbuf(VOID)
199
{
200
mp = cur_mp = macrobuf = GET_MEM("macrobuf",mbuf_size,eight_bits);
201
macrobuf_end = macrobuf + mbuf_size;
202
}
203
204
@
205
@<Glob...@>=
206
207
IN_TANGLE text_pointer cur_text; /* See \.{ftangle.web}. */
208
IN_TANGLE LINE_NUMBER nearest_line;
209
210
@* ARGUMENT PROCESSING.
211
On input, after the raw text of a \WEB\ macro has been tokenized, we must
212
go through and replace the dummy arguments by special tokens. The special
213
tokens consists of |MACRO_ARGUMENT| in the first byte, and the argument
214
number in the second byte.
215
216
@a
217
eight_bits HUGE *
218
argize FCN((start, end))
219
eight_bits HUGE *start C0("Beginning of the raw tokens.")@;
220
eight_bits HUGE *end C1("End.")@;
221
{
222
eight_bits k,l;
223
eight_bits HUGE *p, HUGE *last2, HUGE *start0;
224
boolean var_args; /* Whether variable arguments or not. */
225
226
start0 = start; /* Remember the beginning of the raw tokens. */
227
228
if(TOKEN1(*start))
229
{
230
ERR_PRINT(M,"! Macro must start with identifier");
231
// SHOULD FLUSH HERE.
232
return end;
233
}
234
235
/* Determine the number~|k| of macro arguments and return starting position
236
of text after arguments. */
237
start = get_dargs(start,end,args,&k,&var_args);
238
cur_text->moffset = (unsigned char)(start - start0);
239
/* Offset to text after $(\dots)$ (or
240
to text after macro name if no arguments). */
241
cur_text->nargs = k; /* Number of macro arguments. */
242
cur_text->var_args = var_args;
243
244
/* Start after right paren. */
245
for(last2=p= start; p<end; p++)
246
{
247
if(TOKEN1(*p))
248
switch(*p)
249
{
250
case @'#':
251
@<Possibly argize a variable argument@>@;
252
continue;
253
254
case dot_const:
255
case begin_language:
256
p++;
257
258
default:
259
continue; /* Skip ordinary token. */
260
}
261
262
/* At this point, it's a two-byte token. Search for match with argument
263
token. */
264
if(*p == MOD1 && *(p+1) == 0)
265
p += 5; // Skip line-number info.
266
else
267
for(l=0; l<k; ++l)
268
/* The following effects |if(args[l] == *(sixteen_bits *)p)|. See the
269
analogous bit manipulations in |store_two_bytes|. */
270
if(args[l]>>8 == *p && (args[l] & 0x00FF) == *(p+1))
271
{
272
*p = MACRO_ARGUMENT; /* Mark as macro argument. */
273
*(p+1) = l; /* Store argument number in following
274
byte. */
275
break;
276
}
277
278
last2 = ++p; /* Advance over second byte of two-byte token.
279
Remember the position |last2| of a two-byte token so we can strip
280
off newlines properly below. */
281
}
282
283
@<Remove newlines and spaces from end of macro@>;
284
return p;
285
}
286
287
@ Tokenize the $n$th~variable argument, indicated by~\.{\#$n$}. The
288
counting starts with~1.
289
@<Possibly argize a var...@>=
290
@B
291
int n; // The argument number; must be |int|.
292
eight_bits HUGE *q = p; // |q|~remembers the position of the number.
293
outer_char *tmp; // Temporary buffer for argument number.
294
size_t i;
295
296
if(*(p+1) != constant) continue; // This isn't the case \.{\#\It{n}}.
297
298
p += 2; // Position after |constant|.
299
300
for(i=0; p[i] != constant; i++)
301
; // Find the length of the constant.
302
303
tmp = GET_MEM("var arg buf",i+1,outer_char);
304
305
for(i=0; p[i] != constant; i++)
306
tmp[i] = XCHR(p[i]); // Convert to |outer_char|.
307
tmp[i+1] = '\0';
308
309
n = ATOI(tmp); // Eval.\ the arg.~\#, starting after |constant|.
310
311
/* \bfit SHOULD CHECK FOR TOO BIG HERE. */
312
313
FREE_MEM(tmp,"var arg buf",i+1,outer_char);
314
315
if(!var_args) MACRO_ERR("! #%d may only be used with variable-argument \
316
macros",YES,n);
317
318
while(*p != constant) *p++ = ignore;
319
320
if(n < 0) MACRO_ERR("! #%d is not allowed",YES,n);
321
else if(n == 0)
322
*(q+1) = @'0'; /* Marker for future expansion---the \# of variable
323
arguments. */
324
else
325
{/* Overwrite the \.\# and the |constant|. */
326
*q = MACRO_ARGUMENT;
327
*(q+1) = (eight_bits)(k + (eight_bits)(n - 1));
328
// We must offset by the fixed number of arguments.
329
}
330
331
last2 = p;
332
*p = ignore;
333
}
334
335
@ We must be careful not to interpret the second byte of a |sixteen_bits|
336
as a newline or a space.
337
@<Remove newlines...@>=
338
339
for(last2++; p > last2; )
340
if(*(p-1) == @'\n' || *(p-1) == @' ')
341
p--;
342
else
343
break;
344
345
@ Here we determine the number of arguments, and return an array of the
346
identifier tokens of the dummy arguments. The function value is the
347
starting position of the token text after the arguments.
348
349
The macro |MAKE_16| makes a |sixteen_bits| from the two |eight_bits|
350
starting at |start|. It effectively does |*(sixteen_bits *)start|.
351
352
@d MAKE_16(start) (((sixteen_bits)(*start)<<8) + (sixteen_bits)(*(start+1)))
353
354
@a
355
eight_bits HUGE *
356
get_dargs FCN((start,end,args,n,pvar_args))
357
eight_bits HUGE *start C0("Start of token string.")@;
358
eight_bits HUGE *end C0("End of token string.")@;
359
sixteen_bits HUGE *args C0("Array of argument tokens, to be returned.")@;
360
eight_bits *n C0("Number of arguments found.")@;
361
boolean *pvar_args C1("Return whether variable arguments")@;
362
{
363
eight_bits k; // Counts the arguments.
364
sixteen_bits id_token; // Identifier for this macro.
365
366
*pvar_args = NO; // To begin, assume no variable arguments.
367
368
id_token = IDENTIFIER(*start, *(start+1));
369
start +=2; // After initial identifier.
370
371
*n = 0;
372
373
if(start == end)
374
return end; // No arguments and no replacement text.
375
376
if(*start != @'(')
377
{ /* No args; nothing exciting to do. */
378
while(start != end && *start == @' ')
379
start++; // Skip possible white space.
380
381
return start;
382
}
383
384
/* At this point, we've found the left paren of an argument list. */
385
for(k=0,++start; start != end && *start != @')'; ++k)
386
{
387
if(TOKEN1(*start))
388
{
389
@<Check for |ellipsis| and |break| if found@>@;
390
391
err_print(M,"Invalid macro parameter in definition of macro \
392
\"%s\". Token %s is invalid; \
393
can only have identifiers and commas between (...)",
394
name_of(id_token), type1(*start));
395
return start;
396
}
397
398
if(k >= (eight_bits)max_margs)
399
mac_args(id_token);
400
401
args[k] = MAKE_16(start); // Store the argument token.
402
403
start += 2; /* After argument token, positioned now either on comma
404
or right paren. */
405
406
if(*start == @',')
407
start++; // Skip comma.
408
}
409
410
/* Usually get here when we've found the right paren. */
411
*n = k; // Number of arguments found.
412
413
if(start==end)
414
{ /* Got to the end prematurely. */
415
err_print(M,"Missing right paren in definition of macro \"%s\"",
416
name_of(id_token));
417
return end;
418
}
419
420
/* Special case of no argument list. We assume this means one dummy
421
argument. */
422
if(*start == @')' && k == 0 && !*pvar_args)
423
args[k++] = 0;
424
425
return start + 1; // Position after right paren.
426
}
427
428
@
429
@<Check for |ellipsis|...@>=
430
431
if(*start == ellipsis)
432
{
433
if(*++start != @')') ERR_PRINT(M,"Expected ')' after ellipsis");
434
else *pvar_args = YES;
435
436
break;
437
}
438
439
@
440
@a
441
SRTN
442
mac_args FCN((id_token))
443
sixteen_bits id_token C1("")@;
444
{
445
char temp[200];
446
447
sprintf(temp, "arguments to macro \"%s\"", (char *)name_of(id_token));
448
OVERFLW(temp, ABBREV(max_margs));
449
}
450
451
@ For error processing, we have a function that returns a string describing
452
the value and kind of single-byte token.
453
454
@d TYPE_DESCR_LEN 20 /* Should be long enough to hold the reasonable type
455
descriptions that are constructed below. */
456
457
@a
458
outer_char *
459
type1 FCN((c))
460
eight_bits c C1("")@;
461
{
462
outer_char *p = NULL;
463
static outer_char type_descr[TYPE_DESCR_LEN];
464
465
if(isprint(XCHR(c)))
466
{SPRINTF(TYPE_DESCR_LEN,type_descr,`"'%c'",XCHR(c)`);} /* Printable
467
character. */
468
else
469
{
470
switch(c)
471
{
472
case constant:
473
p = OC("constant"); @+ break;
474
475
case stringg:
476
p = OC("string"); @+ break;
477
478
case @'\n':
479
p = OC("newline"); @+ break;
480
}
481
482
if(p)
483
{SPRINTF(TYPE_DESCR_LEN,type_descr,`"'%s'",p`);}
484
/* Special \WEB\ token. */
485
else
486
{SPRINTF(TYPE_DESCR_LEN,type_descr,`"0x%x",c`);}
487
/* Unknown byte. */
488
}
489
490
return type_descr;
491
}
492
493
@ Functions to copy and compare $n$~bytes.
494
@<Unused@>=
495
496
ncpy(s0,s1,n)
497
char *s0,*s1;
498
int n;
499
{
500
for(; n>0; n--)
501
*s0++ = *s1++;
502
}
503
504
ncmp(s0,s1,n)
505
char *s0,*s1;
506
int n;
507
{
508
for(; n>0; n--)
509
{
510
if(*s0 != *s1) return *s0 - *s1;
511
s0++; @+ s1++;
512
}
513
514
return 0;
515
}
516
517
@ This function is used during output expansion. It fills an array of
518
pointers to the token strings for the actual arguments of a macro call
519
beginning at |start|. It returns the position of the token text after the
520
actual arguments.
521
@a
522
eight_bits HUGE *
523
get_margs0 FCN((start, end, pcur_byte, pthe_end, multilevels,
524
var_args, pargs, n))
525
eight_bits HUGE *start C0("Beginning of the tokens for this \
526
macro call.")@;
527
eight_bits HUGE *end C0("Maximum possible end.")@;
528
eight_bits HUGE **pcur_byte C0("Pointer to |cur_byte|.")@;
529
eight_bits HUGE **pthe_end C0("End of the current buffer.")@;
530
boolean multilevels C0("")@;
531
boolean var_args C0("Does macro have variable arguments?")@;
532
PARGS pargs C0("Array of pointers to the actual arguments, \
533
to be returned.")@;
534
eight_bits *n C1("Number of arguments found.")@;
535
{
536
eight_bits k;
537
int bal, bbal; // Balance for parens and brackets.
538
boolean mac_protected;
539
sixteen_bits id_token; // Identifier for this macro.
540
541
id_token = IDENTIFIER(*start, *(start+1)); // Remember for error processing.
542
start +=2; // After initial identifier.
543
544
/* Read more arguments into buffer if necessary. */
545
if(start == end && pthe_end != NULL)
546
end = args_to_macrobuf(end, pcur_byte, pthe_end, multilevels, var_args);
547
548
/* Does a parenthesized list follow identifier? */
549
if(start==end || *start != @'(')
550
{
551
return pargs[*n = 0] = start; /* No args; nothing to do. Position
552
after macro name identifier. */
553
}
554
555
pargs[k=0] = start++; /* Beginning of first actual argument
556
token string. (Actually, this is the position of the left paren,
557
one less than the position of the first token. This is so the ending
558
position, which will point to a comma, can be used as the start of
559
the next argument. The value~1 is added in |x0macro|.) */
560
561
bal = 1; // Keep track of balanced parens. Already past the opening one.
562
bbal = 0; // Also keep track of balanced brackets.
563
mac_protected = NO; // Reverse accent protects commas, etc.
564
565
while(start < end)
566
{
567
eight_bits c = *start;
568
569
if(TOKEN1(c))
570
{
571
switch(c)
572
{
573
case @'#':
574
if(start+1 < end && *(start+1) == @',')
575
{ /* Skip over `\.{\#,}'. */
576
*start = '\0'; // Replace '\.\#' by null.
577
start += 2;
578
continue;
579
}
580
break;
581
582
case constant:
583
case stringg:
584
for(start++; *start++ != c; );
585
continue;
586
587
case dot_const:
588
case begin_language:
589
start += 2;
590
continue;
591
592
case @'`':
593
mac_protected = BOOLEAN(!mac_protected);
594
*start++ = '\0'; /* Replace the protection
595
character by a null. */
596
continue;
597
598
/* The following scheme needs to be generalized. Doesn't check for syntax
599
such as `\.{[(]}' or `\.{([)}'. Probably must stack counters. */
600
case @'(':
601
bal++;
602
break;
603
604
case @')':
605
if(bal == 0)
606
MACRO_ERR("Unexpected ')' in macro argument",YES);
607
else if(bal > 0) bal--;
608
break;
609
610
case @'[':
611
bbal++;
612
break;
613
614
case @']':
615
if(bbal == 0)
616
MACRO_ERR("Unexpected ']' in macro argument",YES);
617
else if(bbal > 0) bbal--;
618
break;
619
}
620
621
if(!mac_protected && ( (bal==1 && bbal==0 && (c == @','))
622
|| bal==0) )
623
{/* Found end of argument token list. Record the
624
upper limit. */
625
if(++k >= max_margs)
626
mac_args(id_token);
627
628
pargs[k] = start++; /* Count the argument, skip
629
over comma or paren. */
630
if(bal==0) break; // End of arguments.
631
}
632
else start++; // Skip over one-byte token.
633
}
634
else
635
start += (c < MOD0 ? 2 : 4+4*1);
636
// Skip over two-byte token. (`1' for |line_info|.)
637
}
638
639
*n = k;
640
return start; // Positioned after right paren.
641
}
642
643
@* MACRO LOOKUP, etc.
644
Here we determine whether the |cur_val| computed during the output phase
645
corresponds to a \WEB\ macro. We return the appropriate |text_pointer|, or
646
|NULL| if it's not a macro. The function |mac_lookup| is an interface to
647
independently compiled modules.
648
649
@a
650
void HUGE *
651
mac_lookup FCN((cur_val))
652
sixteen_bits cur_val C1("Current id token.")@;
653
{
654
return (void *)MAC_LOOKUP(cur_val);
655
}
656
657
@ Corresponding to |MAC_LOOKUP|, there is an internal macro |_DEFINED|
658
that expands to~1 if its argument is a defined macro, or~0 otherwise. This
659
macro, however, essentially is obsolete since the advent of the |defined|
660
unary operator.
661
@<Define internal...@>=
662
663
SAVE_MACRO("$DEFINED(macro)$EVAL(defined #!macro)");
664
665
@ Furthermore, the macro |$IFDEF(a,b,c)| returns the expansion of~\.b if the
666
macro~\.a is defined; otherwise, it returns the expansion of~\.c.
667
668
@m DEF_RTN(name, cond)
669
SRTN
670
i_##name##_ FCN((n,pargs))
671
int n C0("")@;
672
PARGS pargs C1("")@;
673
{
674
text_pointer m;
675
sixteen_bits id;
676
eight_bits HUGE *p0 = pargs[0] + 1;
677
boolean e;
678
679
CHK_ARGS("$IFDEF", 3);
680
681
if(TOKEN1(*p0))
682
{
683
MACRO_ERR("! First argument of $IFDEF or $IFNDEF must be a macro", YES);
684
return;
685
}
686
687
id = IDENTIFIER(p0[0], p0[1]);
688
e = ((m=mac_lookup(id)) != NULL && !(m->built_in));
689
690
if(cond)
691
COPY_ARG(1, name)@;
692
else
693
COPY_ARG(2, name)@;
694
}
695
696
@a
697
DEF_RTN(ifdef, e)@;
698
DEF_RTN(ifndef, !e)@;
699
700
@ A similar macro implements the four-argument version of |ifelse|. Here,
701
we want to compare two strings that need not evaluate to numbers. Thus, we
702
can't use |_IF|, but must do it explicitly.
703
704
The following function compares its first two arguments on a byte-by-byte
705
basis. If they agree, the third argument is copied into the macro buffer;
706
otherwise, the fourth argument is copied.
707
@a
708
SRTN
709
i_ifelse_ FCN((n,pargs))
710
int n C0("")@;
711
PARGS pargs C1("")@;
712
{
713
eight_bits HUGE *p0;
714
eight_bits HUGE *pp0, HUGE *pp1, HUGE *mp0, HUGE *mp1;
715
boolean args_identical = YES;
716
717
CHK_ARGS("$IFELSE", 4);
718
719
pp0 = xmac_text(mp0=mp, pargs[0] + 1, pargs[1]);
720
mp1 = mp; // |expr0| is now in |(pp0,mp1)|.
721
722
pp1 = xmac_text(mp, pargs[1] + 1, pargs[2]);
723
// |expr1| is now in |(pp1,mp)|.
724
725
/* Are the arguments identical? For speed, first check just the length of
726
the arguments; then compare byte by byte. */
727
if(mp-pp1 != mp1-pp0)
728
args_identical = NO;
729
else
730
while(pp0 < mp1)
731
if(*pp0++ != *pp1++)
732
args_identical = NO;
733
734
mp = mp0;
735
736
if(args_identical)
737
COPY_ARG(2,_ifelse_)@;
738
else
739
COPY_ARG(3,_ifelse_)@;
740
}
741
742
@ A general mechanism handles almost all such cases. (We use a \WEB\ macro
743
so we can pretty it up with |$EVAL|.)
744
Given the expression evaluator, |_IF| can be implemented enormously simply.
745
746
@m COPY_ARG(n,reason) {MCHECK(pargs[$EVAL(n+1)]-pargs[n]-1,#reason);
747
for(p0=pargs[n]+1; p0<pargs[$EVAL(n+1)]; ) *mp++ = *p0++;}
748
749
@a
750
SRTN
751
i_if_ FCN((n,pargs))
752
int n C0("")@;
753
PARGS pargs C1("")@;
754
{
755
eight_bits HUGE *pp;
756
eight_bits HUGE *mp0;
757
eight_bits HUGE *p0;
758
boolean e;
759
760
CHK_ARGS("$IF", 3);
761
762
pp = xmac_text(mp0=mp, p0=pargs[0]+1, pargs[1]); // Expand the expr.
763
e = eval(pp, mp);
764
mp = mp0;
765
766
if(e)
767
COPY_ARG(1,_if_)@;
768
else
769
COPY_ARG(2,_if_)@;
770
}
771
772
@ A related routine |$IFCASE| behaves like \TeX's \.{\\ifcase}.
773
Expanding the first argument of the |$IFCASE| is a bit tricky, since
774
we're doing this from within a macro expansion. We use recursion;
775
watch out for resetting~|mp|.
776
@a
777
SRTN
778
i_ifcase_ FCN((n,pargs))
779
int n C0("Total number of arguments")@;
780
PARGS pargs C1("")@;
781
{
782
eight_bits HUGE *pp;
783
eight_bits HUGE *mp0;
784
int ncase;
785
786
CHK_ARGS("$IFCASE", -1);
787
pp = xmac_text(mp0=mp, pargs[0]+1, pargs[1]); // Expand the |ncase|.
788
ncase = neval(pp, mp);
789
mp = mp0;
790
copy_nth_arg(ncase, n-3, pargs); // Evaluate the |ncase|.
791
}
792
793
@ This function copies the $n0$th~argument (after the very first) to the
794
macro buffer. The cases are numbered 0--$n$, with case~$n+1$ being the default.
795
@a
796
SRTN
797
copy_nth_arg FCN((n0,n,pargs))
798
int n0 C0("Should be a non-negative integer")@;
799
int n C0("Cases are numbered 0--n, default")@;
800
PARGS pargs C1("")@;
801
{
802
eight_bits HUGE *p0;
803
804
if(n0 < 0 || n0 > n) n0 = n+1; /* Do the default case. */
805
806
n0++; /* Don't count the index argument. */
807
MCHECK(pargs[n0+1]-pargs[n0]-1,"copy_nth_arg");
808
for(p0=pargs[n0]+1; p0<pargs[n0+1]; ) *mp++ = *p0++;
809
}
810
811
@ We have not yet implemented a |_SWITCH| statement.
812
@a
813
SRTN
814
i_switch_ FCN((n,pargs))
815
int n C0("")@;
816
PARGS pargs C1("")@;
817
{}
818
819
@ Here are some things one can do with |_IF|.
820
@<Define internal...@>=
821
822
SAVE_MACRO("$ABS(a)$IF((a) > 0,$EVAL(a),$EVAL(-(a)))");
823
824
@ We need a facility to undefine macros. This must be done implicitly
825
before a new macro is defined; and may also be done explicitly through the
826
\.{@@\#undef} command.
827
828
@a
829
SRTN
830
undef FCN((cur_val, warning))
831
sixteen_bits cur_val C0("Token to be undefined.")@;
832
boolean warning C1("Complain is there's an error?")@;
833
{
834
name_pointer np = name_dir + cur_val;
835
text_pointer m;
836
837
if(np->macro_type == NOT_DEFINED)
838
{
839
if(warning)
840
MACRO_ERR("WARNING: \"%s\" is already undefined",YES,
841
name_of(cur_val));
842
843
return;
844
}
845
846
847
if(np->equiv == NULL)
848
{
849
if(np->macro_type == IMMEDIATE_MACRO)
850
{
851
MACRO_ERR("Attempting to @@#undef deferred macro \"%s\" \
852
during phase 1; consider using $UNDEF(%s)",
853
YES, name_of(cur_val), name_of(cur_val));
854
}
855
else
856
{
857
MACRO_ERR("Missing equivalence field while undefining \"%s\"; \
858
this shouldn't happen!",YES,name_of(cur_val));
859
860
np->macro_type = NOT_DEFINED;
861
}
862
863
return;
864
}
865
866
np->macro_type = NOT_DEFINED;
867
868
m = (text_pointer)np->equiv;
869
m->nargs = UNDEFINED_MACRO;
870
FREE(m->tok_start); // Should be |FREE_MEM|.
871
m->nbytes = m->moffset = 0;
872
873
np->equiv = NULL;
874
}
875
876
@* ERROR MESSAGES.
877
We maintain a stack of macro id tokens that we are in the middle of
878
expanding. This is to prevent recursion.
879
880
@<Glob...@>=
881
882
XIDS HUGE *pids[MAX_XLEVELS];
883
int xlevel = 0;
884
885
@ Simple macros push or pop the id stack. We also need a routine to see if
886
an id is on the stack.
887
888
@d save_name(a) {if(xids->level >= MAX_XLEVELS)
889
{
890
MACRO_ERR("! Macro inner recursion depth exceeded",YES);
891
FATAL(M, "!! BYE.", "");
892
}
893
xids->token[slevel=xids->level++] = a;
894
}
895
896
@d unsave_name xids->level = slevel
897
898
@a
899
boolean recursive_name FCN((a,xids,last_level))
900
sixteen_bits a C0("")@;
901
XIDS HUGE *xids C0("")@;
902
int last_level C1("")@;
903
{
904
int i;
905
906
/* Hunt through levels lower than the present one. */
907
for(i=0; i<last_level; i++)
908
if(xids->token[i] == a) return YES;
909
910
return NO;
911
}
912
913
@ Macro error messages can print the recursion stack as an indication of
914
where we are.
915
@a
916
917
SRTN
918
macro_err FCN(VA_ALIST((s, trail VA_ARGS)))
919
VA_DCL(
920
CONST outer_char s[] C0("Error message about macro expansion.")@;
921
int trail C2("Do we print out the expansion trail?")@;)@;
922
{
923
VA_LIST(arg_ptr)@;
924
outer_char HUGE *temp, HUGE *temp1, HUGE *t, HUGE *near_line;
925
int i, ntemp;
926
#if(NUM_VA_ARGS == 1)
927
CONST outer_char s[];
928
int trail;
929
#endif
930
931
/* We allocate dynamically to keep the size of the stack down. */
932
temp = GET_MEM("macro_err:temp", N_MSGBUF, outer_char);
933
temp1 = GET_MEM("macro_err:temp1", N_MSGBUF, outer_char);
934
near_line = GET_MEM("macro_err:near_line", N_MSGBUF, outer_char);
935
936
VA_START(arg_ptr, trail);
937
vsprintf_((char *)temp1, (CONST char *)s, arg_ptr)@;
938
va_end(arg_ptr);
939
940
if(phase==2)
941
SPRINTF(N_MSGBUF, near_line, `"; near input l. %u", nearest_line`);
942
943
/* We surround the message that we construct with double quotes. These are
944
printed into the file, but not to the terminal. This is to help out
945
preprocessors that parse the message prematurely and get confused by
946
unmatched quotes. */
947
SPRINTF(N_MSGBUF, temp, `"\"%s. (%s l. %u in %s%s.) %s",
948
temp1,
949
phase==1 ? "Input" : "Output",
950
phase==1 ? cur_line : OUTPUT_LINE,
951
phase==1 ? cur_file_name : params.OUTPUT_FILE_NAME,
952
near_line,
953
trail && (xlevel > 0) ? "Expanding " : ""`);
954
955
t = temp + STRLEN(temp);
956
957
/* `Print out' levels associated with each invocation of |xmac_buf| by
958
attaching them to end of |temp|. */
959
if(trail && (xlevel > 0))
960
for(i=0; i<1; i++)
961
see_xlevel(&t, pids[i]);
962
963
ntemp = STRLEN(temp);
964
temp[ntemp] = '"';
965
temp[ntemp+1] = '\0';
966
967
/* Message to file. */
968
OUT_MSG(to_ASCII(temp), NULL);
969
970
/* Message to terminal. */
971
temp[ntemp] = '\0'; // Kill off final quote.
972
printf("\n%s\n", (char *)to_outer((ASCII HUGE *)temp)+1);
973
974
mark_harmless;
975
976
FREE_MEM(temp, "macro_err:temp", N_MSGBUF, outer_char);
977
FREE_MEM(temp1, "macro_err:temp1", N_MSGBUF, outer_char);
978
FREE_MEM(near_line, "macro_err:near_line", N_MSGBUF, outer_char);
979
}
980
981
@ Print out all names stored at some recursive invocation of |xmac_buf|.
982
@a
983
SRTN
984
see_xlevel FCN((pt,p))
985
outer_char HUGE **pt C0("")@;
986
XIDS HUGE *p C1("")@;
987
{
988
int i,level;
989
990
level = p->level; /* Total number at this level. */
991
992
for(i=0; i<level;
993
i++,sprintf((char *)(*pt),"%s",i==level ? ". " : ", "),(*pt)+=2)
994
prn_mname(pt,p->token[i]);
995
}
996
997
/* Print one name. */
998
SRTN
999
prn_mname FCN((pt,token))
1000
outer_char HUGE **pt C0("")@;
1001
sixteen_bits token C1("")@;
1002
{
1003
name_pointer np;
1004
ASCII HUGE *p;
1005
CONST ASCII HUGE *end;
1006
1007
np = name_dir + token;
1008
1009
PROPER_END(end);
1010
1011
for(p=np->byte_start; p<end; )
1012
*(*pt)++ = XCHR(*p++);
1013
}
1014
1015
@
1016
@a
1017
SRTN
1018
i_inp_line_ FCN((n,pargs))
1019
int n C0("")@;
1020
PARGS pargs C1("")@;
1021
{
1022
num_to_mbuf(n,pargs,"$INPUT_LINE",0,"nearest line",nearest_line);
1023
}
1024
1025
SRTN
1026
i_outp_line_ FCN((n,pargs))
1027
int n C0("")@;
1028
PARGS pargs C1("")@;
1029
{
1030
num_to_mbuf(n,pargs,"$OUTPUT_LINE",0,"output line",OUTPUT_LINE);
1031
}
1032
1033
@
1034
@a
1035
SRTN
1036
num_to_mbuf FCN((n,pargs,built_in_name,num_args,num_descr,num))
1037
int n C0("")@;
1038
PARGS pargs C0("")@;
1039
CONST char *built_in_name C0("")@;
1040
int num_args C0("")@;
1041
CONST char *num_descr C0("")@;
1042
int num C1("")@;
1043
{
1044
CHK_ARGS(built_in_name,num_args);
1045
1046
MCHECK0(20,num_descr);
1047
1048
*mp++ = constant;
1049
sprintf((char *)mp,"%d",num);
1050
to_ASCII((outer_char HUGE *)mp); // Convert the number in place to |ASCII|.
1051
mp += STRLEN(mp);
1052
*mp++ = constant;
1053
}
1054
1055
1056
@* EXPANDING a BUFFER.
1057
Here we actually expand a buffer possibly containing macros. The first
1058
call to |x0macro| will be a macro name itself, possibly with arguments.
1059
After that expansion, |x0macro| is called again repeatedly until nothing
1060
more can be expanded. The expansion will end when no |paste| tokens
1061
appeared during the previous cycle. The expansion is put into the next
1062
available position of |macrobuf|, which is pointed to by |mp|.
1063
1064
@a
1065
boolean
1066
x0macro FCN((p, end, xids, pcur_byte, pthe_end, multilevels))
1067
eight_bits HUGE *p C0("Present position in the input buffer.")@;
1068
eight_bits HUGE *end C0("Last filled position of the input \
1069
buffer plus~1.")@;
1070
XIDS HUGE *xids C0("")@;
1071
eight_bits HUGE **pcur_byte C0("Pointer to |cur_byte|.")@;
1072
eight_bits HUGE **pthe_end C0("End of buffer.")@;
1073
boolean multilevels C1("")@;
1074
{
1075
boolean expanded; /* Was a macro expanded in this pass? */
1076
sixteen_bits a;
1077
eight_bits a0,a1; /* Left and right parts of |sixteen_bits| token. */
1078
text_pointer m; /* Points to info about current macro being expanded. */
1079
eight_bits HUGE *p0, HUGE *p1;
1080
eight_bits HUGE * HUGE *pargs = GET_MEM("pargs",max_margs,eight_bits HUGE *);
1081
boolean must_paste = NO,pasting = NO;
1082
int level0 = xids->level;
1083
boolean mac_protected = NO; /* Protection flag flipped by left quote. */
1084
1085
expanded = NO; /* If no macros were expanded in this pass, then we're done. */
1086
1087
/* |p| is current position in input buffer. */
1088
while(p < end)
1089
{
1090
a0 = *p++; // The next token to be examined.
1091
1092
if(p==end && a0==@'\n') break;
1093
1094
if(TOKEN1(a0)) @<Process |eight_bits| token@>@;
1095
else @<Process identifier token@>@;
1096
}
1097
1098
/* Get directly to here from |MACRO_ERR|. */
1099
done_expanding:
1100
FREE_MEM(pargs, "pargs", max_margs, eight_bits HUGE *);
1101
return expanded; /* Return flag to say whether any macro was
1102
expanded. If nothing was, then we're done. */
1103
}
1104
1105
@ As we scan through the |macro_buf|, we either encounter |eight_bits|
1106
tokens, or identifiers (|sixteen_bits|). Here we process the single-byte
1107
tokens. If it's a left quote, we flip the protection flag. If it's
1108
|stringg|, we copy the entire contents to and including the concluding
1109
|stringg|. Otherwise, we just copy over the token.
1110
1111
@<Process |eight_bits| token@>=
1112
{
1113
switch(a0)
1114
{
1115
case @'`':
1116
mac_protected = BOOLEAN(!mac_protected);
1117
continue;
1118
1119
case stringg:
1120
case constant:
1121
MCHECK(1,"`");
1122
*mp++ = a0; // |stringg| or |constant| token.
1123
1124
copy_string:
1125
do
1126
{
1127
if(!TOKEN1(*mp=*p++))
1128
{
1129
MCHECK(1,"id prefix");
1130
*++mp = *p++;
1131
}
1132
MCHECK(1,"8-bit token");
1133
}
1134
while(*mp++ != a0);
1135
1136
if(a0 == stringg) @<Check for string concatenation@>@;
1137
1138
continue;
1139
1140
case dot_const:
1141
case begin_language:
1142
MCHECK(2,"dot_const");
1143
*mp++ = a0;
1144
*mp++ = *p++;
1145
continue;
1146
1147
default:
1148
MCHECK(1,"`");
1149
*mp++ = a0; /* Copy over ASCII token to the macro buffer. */
1150
continue;
1151
}
1152
}
1153
1154
@ We implement an ANSI type of string concatenation feature.
1155
@<Check for string concat...@>=
1156
{
1157
eight_bits HUGE *p00;
1158
1159
/* Scan over possible white space. */
1160
for(p00=p; p < end; p++)
1161
if(*p != @' ' && *p != @'\t') break;
1162
1163
if(p < end && *p == stringg)
1164
{
1165
eight_bits mchar = *(mp-2);// Quote character from last string.
1166
eight_bits pchar = *(p+1);// Quote character from next string.
1167
1168
if((mchar == @'\'' || mchar == @'\"') &&
1169
(pchar == @'\'' || pchar == @'\"'))
1170
{
1171
mp -= 2; // Back over |stringg| and quote char.
1172
p += 2; // Move over |stringg| and quote char.
1173
goto copy_string;
1174
}
1175
}
1176
else p = p00; // Didn't find another string.
1177
}
1178
1179
@ Deal with identifier while scanning through |macro_buf|.
1180
@<Process identifier token@>=
1181
{
1182
a = IDENTIFIER(a0,a1= *p++);
1183
1184
if(a == id_defined)
1185
{
1186
@<Copy |defined| and its argument@>@;
1187
continue;
1188
}
1189
1190
/* If it's a macro token, we must decide whether to expand it. If this
1191
token is already on the |xids| stack from an earlier level of recursive
1192
expansion, then we don't expand. If we haven't encountered this name
1193
before, then we expand the macro. */
1194
if((m=MAC_LOOKUP(a)) != NULL)
1195
if(mac_protected)
1196
{
1197
MCHECK(2,"protected macro token");
1198
*mp++ = a0;
1199
*mp++ = a1;
1200
}
1201
else if(recursive_name(a,xids,level0))
1202
@<Don't expand macro.@>@;
1203
else
1204
{
1205
int slevel = ignore;
1206
1207
if(!m->recursive)
1208
save_name(a); // To prevent recursion.
1209
1210
#ifdef DEBUG_MACS
1211
dbg_macs(a, p, end);
1212
#endif
1213
1214
@<Expand a macro@>@;
1215
1216
if(!m->recursive)
1217
unsave_name;
1218
}
1219
else
1220
{/* Copy a nonmacro 2-byte token to the output buffer (pointed to
1221
by~|mp|). */
1222
MCHECK(2,"ordinary id");
1223
*mp++ = a0;
1224
*mp++ = a1;
1225
1226
/* If we're actually dealing with a module name, we punt here and don't
1227
expand it at this time; it will be expanded on output. */
1228
if(a0 >= MOD0)
1229
{
1230
int n = 2 + 4*1; // `1' for |line_info|.
1231
1232
MCHECK(n,"module defn");
1233
while(n-- > 0)
1234
*mp++ = *p++;
1235
}
1236
}
1237
}
1238
1239
@
1240
@a
1241
SRTN
1242
dbg_macs FCN((n, start, end))
1243
sixteen_bits n C0("")@;
1244
eight_bits HUGE *start C0("")@;
1245
eight_bits HUGE *end C1("")@;
1246
{
1247
printf("%lu = (0x%x->0x%x) <<%lu>>: ",
1248
end - start, start, end, start - macrobuf);
1249
find_n(n);
1250
}
1251
1252
@ In macro expansions, the token |defined| gets special treatment. If it's
1253
followed by an identifier, that identifier should not be expanded.
1254
1255
@d DEFINED_ERR(s) {MACRO_ERR(s,YES); goto done_expanding;}
1256
1257
@d ERR_IF_DEFINED_AT_END if(p >= end)
1258
DEFINED_ERR("! `defined' ends prematurely")@;
1259
1260
@<Copy |defined|...@>=
1261
{
1262
MCHECK(6,"defined stuff");
1263
1264
/* Copy the |defined| token. */
1265
*mp++ = a0;
1266
*mp++ = a1;
1267
1268
ERR_IF_DEFINED_AT_END;
1269
if(TOKEN1(a0= *p++)) /* Possible parenthesis */
1270
{
1271
if(a0 != @'(') DEFINED_ERR("! Invalid token after `defined'")@;
1272
else *mp++ = a0;
1273
1274
ERR_IF_DEFINED_AT_END;
1275
if(TOKEN1(a0 = *p++)) DEFINED_ERR("! Invalid argument of `defined'")@;
1276
else
1277
{ /* Copy parenthesized id token. */
1278
*mp++ = a0;
1279
*mp++ = *p++;
1280
}
1281
1282
ERR_IF_DEFINED_AT_END;
1283
if(TOKEN1(a0 = *p++))
1284
if(a0 != @')') DEFINED_ERR("! Missing ')' after `defined'")@;
1285
else *mp++ = a0;
1286
}
1287
else
1288
{ /* Copy non-parenthesized id token. */
1289
*mp++ = a0;
1290
*mp++ = *p++;
1291
}
1292
}
1293
1294
1295
@ The flag |keep_intact| is used with stringizing; it is set with the
1296
\.{\#*}~operation. It means that if the parameter is a string, just pass it
1297
through unchanged; don't add extra quotes arounds it.
1298
1299
Other flags are used in conjunction with the~`\.{\#'}' and~`\.{\#"}'
1300
commands.
1301
1302
@<Glob...@>=
1303
1304
static boolean keep_intact;
1305
IN_COMMON boolean single_quote, double_quote;
1306
1307
@ We endow the preprocessor with ANSI-C's stringize operation. Parameter
1308
tokens preceded by `\.{\#}' are converted into strings. We must follow the
1309
rest of \TANGLE's conventions; the string must be bracketed with |stringg|.
1310
@<Stringize parameter@>=
1311
@B
1312
eight_bits HUGE *begin;
1313
boolean do_quote;
1314
1315
@b
1316
do_stringize:
1317
for(begin=pargs[*p0]+1; *begin == '\0'; begin++)
1318
; /* Skip over leading nulls (that possibly replace protection
1319
characters). */
1320
1321
@<String token to |macrobuf|. @>;
1322
1323
do_quote = BOOLEAN(!keep_intact || *begin != stringg || begin[1] != CUR_QUOTE);
1324
1325
if(do_quote)
1326
@<Quote token to |macrobuf|. @>@;
1327
1328
str_to_mb(begin,pargs[*p0 + 1], YES);
1329
p0++; /* Don't put this into previous stmt, because order of evaluation is
1330
undefined. */
1331
1332
if(do_quote)
1333
@<Quote token...@>@;
1334
1335
@<String token...@>;
1336
1337
single_quote = double_quote = NO;
1338
}
1339
1340
@ We must preface and end all strings with |stringg| tokens.
1341
@<String token...@>=
1342
MCHECK(1,"stringg"); @+ *mp++ = stringg@;
1343
1344
@ The string delimiter depends in general on the language, but it can be
1345
overridden by the commands~`\.{\#'} or~`\.{\#"}, which set the flags
1346
|single_quote| or |double_quote|.
1347
1348
@d CUR_QUOTE ((eight_bits)(single_quote || (!double_quote && R77_or_F) ?
1349
@'\'' : @'"'))
1350
1351
@<Quote token...@>=
1352
{
1353
MCHECK(1,"quote");
1354
*mp++ = CUR_QUOTE;
1355
}
1356
1357
@ Now we prepare to copy/translate a token string into the |macrobuf|. To
1358
get the spacings right, we use an |OUTPUT_STATE| flag.
1359
@<Glob...@>=
1360
OUTPUT_STATE copy_state;
1361
1362
@ This function is analogous to |out_op|: It copies a string to the
1363
|macro_buf|, and set |copy_state|.
1364
@a
1365
SRTN
1366
cpy_op FCN((s))
1367
CONST outer_char HUGE *s C1("String such as \.{++}.")@;
1368
{
1369
MCHECK(2,"cpy_op");
1370
1371
while(*s)
1372
*mp++ = XORD(*s++);
1373
1374
copy_state = MISCELLANEOUS;
1375
}
1376
1377
@ When copying strings, certain intermediate characters must be escaped,
1378
depending on the language:
1379
@a
1380
eight_bits HUGE *
1381
str_to_mb FCN((begin_arg, end_arg, esc_chars))
1382
CONST eight_bits HUGE *begin_arg C0("Beginning of string.")@;
1383
CONST eight_bits HUGE *end_arg C0("End of string.")@;
1384
boolean esc_chars C1("Insert escape characters?")@;
1385
{
1386
eight_bits HUGE *mp0 = mp;
1387
sixteen_bits c;
1388
1389
copy_state = MISCELLANEOUS;
1390
1391
while(begin_arg < end_arg)
1392
{
1393
if(TOKEN1(c= *begin_arg++))
1394
{
1395
@<Flip copy state and escape certain characters@>@;
1396
}
1397
else
1398
{
1399
name_pointer np;
1400
1401
if(copy_state == NUM_OR_ID)
1402
@<Copy a space@>@;
1403
1404
if(c == MACRO_ARGUMENT)
1405
@<Fill in argument number@>@;
1406
else
1407
@<Handle identifier-like token@>@;
1408
1409
copy_state = NUM_OR_ID;
1410
}
1411
}
1412
1413
*mp = '\0';
1414
return mp0;
1415
}
1416
1417
@
1418
@<Fill in arg...@>=
1419
{
1420
outer_char temp[10];
1421
int n;
1422
1423
n = NSPRINTF(temp,"$%d",*begin_arg++);
1424
to_ASCII(temp);
1425
MCHECK(n,"%arg");
1426
STRCPY(mp,temp);
1427
mp += n;
1428
}
1429
1430
@
1431
@d UNNAMED_MODULE 0
1432
@<Handle identifier-like...@>=
1433
{
1434
c = IDENTIFIER(c,*begin_arg++);
1435
1436
switch(c/MODULE_NAME)
1437
{
1438
case 0: /* Ordinary identifier. */
1439
np = name_dir + c;
1440
@<Copy possibly truncated identifier to macro buffer@>@;
1441
break;
1442
1443
case 1: /* Module name. */
1444
MCHECK(5, "macro name");
1445
1446
*mp++ = @'#';
1447
*mp++ = @'<';
1448
1449
c -= MODULE_NAME;
1450
1451
np = name_dir + c;
1452
1453
if(np->equiv != (EQUIV)text_info)
1454
@<Copy possibly truncated id...@>@;
1455
else if(c != UNNAMED_MODULE)
1456
*mp++ = @'?';
1457
// Temporary kludge; should actually write out the name.
1458
1459
*mp++ = @'@@';
1460
*mp++ = @'>';
1461
break;
1462
1463
default:
1464
if(c == MODULE_NUM)
1465
begin_arg += 4*1; // `1' for |line_info|.
1466
// Skip over line number info.
1467
break;
1468
}
1469
}
1470
1471
@ Stringize an id token by copying the actual name into the |macro_buf|.
1472
1473
@<Copy actual name to macro buffer@>=
1474
{
1475
end = proper_end(np);
1476
1477
p = np->byte_start;
1478
MCHECK(end - p,"id name");
1479
while(p<end) *mp++ = *p++;
1480
}
1481
1482
@ Here we just copy a space into the |macro_buf|.
1483
@<Copy a space@>=
1484
{
1485
MCHECK(1,"' '"); @+ *mp++ = @' ';
1486
}
1487
1488
@ Here we process a single-byte token during stringizing. We have to do
1489
many of the same operations that are done during output expansion.
1490
1491
@<Flip copy state...@>=
1492
1493
switch(c)
1494
{
1495
case ignore:
1496
break;
1497
1498
@<Copy cases like \.{!=}@>@;
1499
1500
case join:
1501
copy_state = UNBREAKABLE;
1502
break;
1503
1504
case constant:
1505
if(copy_state==NUM_OR_ID)
1506
@<Copy a space@>@;
1507
@<Copy stuff between |constant| or |stringg|@>@;
1508
copy_state = NUM_OR_ID;
1509
break;
1510
1511
case stringg:
1512
@<Copy stuff between |constant|...@>@;
1513
copy_state = MISCELLANEOUS;
1514
break;
1515
1516
case @';':
1517
if(R77_or_F)
1518
{
1519
@<Make semi into string@>;
1520
break;
1521
}
1522
1523
default:
1524
esc_certain_chars(c,esc_chars);
1525
if(copy_state != VERBATIM) copy_state = MISCELLANEOUS;
1526
break;
1527
}
1528
1529
@
1530
@<Make semi into string@>=
1531
{
1532
MCHECK(3,"\";\"");
1533
*mp++ = constant;
1534
*mp++ = @';';
1535
*mp++ = constant;
1536
}
1537
1538
@ Expand various internal codes during stringizing.
1539
1540
@d CPY_OP(token,trans) case token: cpy_op(OC(trans)); break@;
1541
1542
@<Copy cases like \.{!=}@>=
1543
1544
CPY_OP(plus_plus,"++");
1545
CPY_OP(minus_minus,"--");
1546
CPY_OP(minus_gt,C_LIKE(language) ? "->" : ".EQV.");
1547
CPY_OP(gt_gt,">>");
1548
CPY_OP(eq_eq,"==");
1549
CPY_OP(lt_lt,"<<");
1550
CPY_OP(gt_eq,">=");
1551
CPY_OP(lt_eq,"<=");
1552
CPY_OP(not_eq,"!=");
1553
CPY_OP(and_and,"&&");
1554
CPY_OP(or_or,"||");
1555
CPY_OP(star_star,"**");
1556
CPY_OP(slash_slash,"//");
1557
CPY_OP(ellipsis,C_LIKE(language) ? "..." : ".XOR.");
1558
1559
case dot_const:
1560
cpy_op(OC("."));
1561
{
1562
ASCII *symbol = dots[*begin_arg++].symbol;
1563
1564
cpy_op(to_outer(symbol));
1565
to_ASCII((outer_char *)symbol);
1566
}
1567
cpy_op(OC("."));
1568
break;
1569
1570
@ During stringizing, we must just copy verbatim constants or strings.
1571
(This assumes that no id tokens are buried inside strings.)
1572
@<Copy stuff between |constant|...@>=
1573
{
1574
if(!keep_intact && c==stringg) esc_certain_chars(*begin_arg++,YES);
1575
/* Escape the opening quote. */
1576
1577
while(*begin_arg != (eight_bits)c)
1578
{
1579
MCHECK(1,"constant");
1580
*mp++ = *begin_arg++;
1581
}
1582
1583
if(!keep_intact && c==stringg)
1584
esc_certain_chars((sixteen_bits)*(--mp),YES); /* Escape the closing
1585
quote. */
1586
1587
begin_arg++; /* Skip the closing |stringg| or |constant|. */
1588
}
1589
1590
@ During stringizing and certain other places, if the flag |esc_chars|
1591
is on, we should convert things like a bare double quote to the appropriate
1592
escaped form. This is language-dependent.
1593
1594
@a
1595
SRTN
1596
esc_certain_chars FCN((c,esc_chars))
1597
sixteen_bits c C0("Character to be maybe escaped.")@;
1598
boolean esc_chars C1("Do we escape them?")@;
1599
{
1600
if(esc_chars)
1601
if(C_LIKE(language))
1602
{
1603
if(c==@'\\' || c==@'"')
1604
{
1605
MCHECK(1,"'\\'");
1606
*mp++ = @'\\';
1607
}
1608
}
1609
else if(R77_or_F)
1610
{
1611
if(c==@'\'')
1612
{
1613
MCHECK(1,"doubled quote");
1614
*mp++ = (eight_bits)c; /* Double the quote in Fortran
1615
string. */
1616
}
1617
}
1618
else
1619
{
1620
if(c==@'"')
1621
{
1622
MCHECK(1,"'\"'");
1623
*mp++ = (eight_bits)c;
1624
}
1625
}
1626
1627
/* We've added the escape character. Now copy the character itself. */
1628
MCHECK(1,"escaped character");
1629
*mp++ = (eight_bits)c;
1630
}
1631
1632
@ Associated with stringizing is a predefined macro that creates a string
1633
from an expanded argument.
1634
@<Define internal...@>=
1635
1636
SAVE_MACRO("$STRING(expr)$STRING0(`expr`)"); /* Expand the argument.
1637
Quotes take care of possible commas in |expr|. */
1638
1639
SAVE_MACRO("$STRING0(expr)#*expr");
1640
1641
@ Here's a macro that takes the length of a string.
1642
@<Define internal...@>=
1643
1644
SAVE_MACRO("$LEN(s)$$LEN(#*s)"); // Don't expand argument.
1645
1646
@ The internal function that determines the length of a string.
1647
@a
1648
SRTN
1649
i_len_ FCN((n,pargs))
1650
int n C0("")@;
1651
PARGS pargs C1("")@;
1652
{
1653
int m, num;
1654
1655
CHK_ARGS("$LEN",1);
1656
1657
m = (int)(pargs[1] - pargs[0] - 5);
1658
/* 5: 1 from |pargs[0]|, 2 from |constant|, 2 from quotes.
1659
Should this be |unsigned|? */
1660
1661
num = NSPRINTF((outer_char HUGE *)mp, "%d", m);
1662
MCHECK(num, "_len_");
1663
to_ASCII((outer_char HUGE *)mp);
1664
mp += num;
1665
}
1666
1667
@ The inverse of |_STRING| just removes the quotes from a string, so that
1668
the string contents go verbatim to the output. We also introduce a special
1669
notation for the preprocessor symbol~'\.\#', namely~|$P|.
1670
1671
@<Define internal...@>=
1672
1673
SAVE_MACRO("$VERBATIM(s)$$VERBATIM(s)"); // Possibly expand the argument.
1674
1675
SAVE_MACRO("$UNQUOTE(s)$$VERBATIM(s)"); // Alternative name.
1676
1677
@% SAVE_MACRO("_P $VERBATIM(\"#\")"); // Preprocessor symbol.
1678
SAVE_MACRO("$P $VERBATIM($IF($LANGUAGE_NUM==2 || $LANGUAGE_NUM==4, \
1679
'#', \"#\"))"); // Preprocessor symbol; different quotes for \Fortran.
1680
1681
SAVE_MACRO("$PP $UNSTRING($P)"); // A character, not a string; use for \Fortran.
1682
1683
@
1684
@a
1685
SRTN
1686
i_verbatim_ FCN((n,pargs))
1687
int n C0("")@;
1688
PARGS pargs C1("")@;
1689
{
1690
eight_bits HUGE *p, delim[2];
1691
eight_bits quote_char[3];
1692
1693
CHK_ARGS("$VERBATIM", 1);
1694
1695
if(*(p = pargs[0]+1) != stringg)
1696
{
1697
MUST_QUOTE("$VERBATIM", p, pargs[1]);
1698
return;
1699
}
1700
1701
STRNCPY(delim, @"\0\0", 2);
1702
STRNCPY(quote_char, @"\"\0\0", 3);
1703
1704
/* At this point, |quote_char[0]| is initialized to a double quote. */
1705
switch(language)
1706
{
1707
case FORTRAN:
1708
quote_char[0] = @'\'';
1709
break;
1710
1711
case FORTRAN_90:
1712
quote_char[1] = @'\''; // Two possibilities for \Fortran--90.
1713
break;
1714
1715
case TEX:
1716
return;
1717
1718
default:
1719
break;
1720
}
1721
1722
/* Beginning |stringg| token. */
1723
MCHECK(1, "string token");
1724
*mp++ = *p++;
1725
1726
/* Check to ensure it's really a quoted string. */
1727
delim[0] = *p; // Make the quote character into a string.
1728
1729
if(STRSPN(delim, quote_char))
1730
p++; // Advance over the quote.
1731
else
1732
delim[0] = stringg;
1733
1734
while(*p != stringg)
1735
{
1736
MCHECK(1, "verbatim token");
1737
*mp++ = *p++;
1738
}
1739
1740
/* Kill off the final quote, replacing it by |stringg|. */
1741
if(STRSPN(delim, quote_char))
1742
*(mp-- -1) = stringg;
1743
}
1744
1745
@ |$UNSTRING| strips off the |stringg| and possible quotes from a string.
1746
1747
@<Define internal...@>=
1748
1749
SAVE_MACRO("$UNSTRING(s)$$UNSTRING(s)"); // Possibly expand the argument.
1750
1751
@
1752
@a
1753
SRTN
1754
i_unstring_ FCN((n,pargs))
1755
int n C0("")@;
1756
PARGS pargs C1("")@;
1757
{
1758
eight_bits HUGE *p,delim[2];
1759
eight_bits quote_char[3];
1760
1761
CHK_ARGS("$UNSTRING", 1);
1762
1763
if(*(p = pargs[0]+1) != stringg)
1764
{
1765
MUST_QUOTE("$UNSTRING", p, pargs[1]);
1766
return;
1767
}
1768
1769
STRNCPY(delim, @"\0\0", 2);
1770
STRNCPY(quote_char, @"\"\0\0", 3);
1771
1772
/* At this point, |quote_char[0]| is initialized to a double quote. */
1773
switch(language)
1774
{
1775
case FORTRAN:
1776
quote_char[0] = @'\'';
1777
break;
1778
1779
case FORTRAN_90:
1780
quote_char[1] = @'\''; // Two possibilities for \Fortran--90.
1781
break;
1782
1783
case TEX:
1784
return;
1785
1786
default:
1787
break;
1788
}
1789
1790
/* Skip beginning |stringg| token. */
1791
p++;
1792
1793
/* Check to ensure it's really a quoted string. */
1794
delim[0] = *p; // Make the quote character into a string.
1795
1796
if(STRSPN(delim, quote_char))
1797
p++; // Advance over the quote.
1798
else
1799
delim[0] = stringg;
1800
1801
while(*p != stringg)
1802
{
1803
MCHECK(1,"verbatim token");
1804
*mp++ = *p++;
1805
}
1806
1807
/* Kill off the final quote */
1808
if(STRSPN(delim, quote_char))
1809
mp--;
1810
}
1811
1812
@ An error routine for built-ins that don't get a quoted string as argument.
1813
1814
@d MUST_QUOTE(name,p,p1) must_quote(OC(name),p,p1)
1815
1816
@a
1817
SRTN
1818
must_quote FCN((name,p,p1))
1819
CONST outer_char *name C0("")@;
1820
eight_bits HUGE *p C0("")@;
1821
eight_bits HUGE *p1 C1("")@;
1822
{
1823
MACRO_ERR("! Argument of %s must be a quoted string",YES,name);
1824
1825
/* Just copy over the argument. */
1826
MCHECK(p1 - p,"copy quotes");
1827
while(p < p1) *mp++ = *p++;
1828
}
1829
1830
@ Here is another string-related macro, patterned after the
1831
\.{m4}~|translit|. The call ``|$TRANSLIT(s,from to)|'', where all three
1832
arguments are strings, modifies~|s| by replacing any character found in
1833
|from| with the corresponding character of~|to|. If |to|~is shorter
1834
than~|from|, characters that don't have an entry are deleted.
1835
1836
@<Define internal...@>=
1837
1838
SAVE_MACRO("$TRANSLIT(s,from,to)$$TRANSLIT(#*s,#*from,#*to)"); /* Make
1839
strings from the arguments (but do nothing if they're already strings). */
1840
1841
@
1842
@a
1843
SRTN
1844
i_translit_ FCN((n,pargs))
1845
int n C0("")@;
1846
PARGS pargs C1("")@;
1847
{
1848
int k;
1849
1850
CHK_ARGS("$TRANSLIT",3);
1851
1852
for(k=0; k<2; k++)
1853
if(*(pargs[k]+1) != stringg) MACRO_ERR("! Argument %d of $TRANSLIT \
1854
must be a string",YES,k);
1855
1856
translit((ASCII HUGE *)(pargs[0]+2),
1857
(ASCII HUGE *)(pargs[1]+2),
1858
(ASCII HUGE *)(pargs[2]+2));
1859
}
1860
1861
@ This function actually does the transliteration.
1862
1863
@d CHECK_QUOTE(var,n) if(*var++ != end_char) MACRO_ERR("! Argument %d of \
1864
$TRANSLIT doesn't begin with '%c'",YES,n,end_char)@;
1865
1866
@a
1867
SRTN
1868
translit FCN((s,from,to))
1869
CONST ASCII HUGE *s C0("String to be transliterated")@;
1870
CONST ASCII HUGE *from C0("Characters to replace")@;
1871
CONST ASCII HUGE *to C1("Replace by")@;
1872
{
1873
short code[128],i,n;
1874
ASCII end_char = *s++;
1875
ASCII c,cfrom,cto;
1876
ASCII esc_achar PROTO((CONST ASCII HUGE * HUGE *));
1877
1878
CHECK_QUOTE(from,1);
1879
CHECK_QUOTE(to,2);
1880
1881
@<String token...@>;
1882
1883
/* First, construct the identity. */
1884
for(i=0; i<128; i++)
1885
code[i] = i;
1886
1887
/* Put the new characters into the table. */
1888
while(*(to+1) != stringg)
1889
{
1890
if(*(from+1) == stringg) break; // Stop when the |from| characters end.
1891
1892
/* We must watch out for escaped characters. */
1893
if((cfrom= *from++) == @'\\') cfrom = esc_achar(&from);
1894
if((cto= *to++) == @'\\') cto = esc_achar(&to);
1895
1896
code[cfrom] = cto;
1897
}
1898
1899
/* If there are more |from| characters than replacement ones, give the
1900
extra ones a special delete code of~|-1|. */
1901
if(*(from+1) != stringg)
1902
while(*(from+1) != stringg)
1903
{
1904
if((cfrom= *from++) == @'\\') cfrom = esc_achar(&from);
1905
1906
code[cfrom] = -1; // Delete code.
1907
}
1908
1909
/* Now translate the string. */
1910
while(*(s+1) != stringg)
1911
{
1912
if((c= *s++) == @'\\') c = esc_achar(&s);
1913
1914
if( (n=code[c]) == -1) continue; // Skip deleted characters.
1915
MCHECK(1,"_translit_");
1916
*mp++ = (eight_bits)n; // Put the translation into the |macrobuf|.
1917
}
1918
1919
@<String token...@>;
1920
}
1921
1922
@ This built-in returns an environmental variable.
1923
@<Define internal...@>=
1924
1925
SAVE_MACRO("$GETENV(var)$STRING($$GETENV(#*var))");
1926
1927
SAVE_MACRO("$HOME $GETENV(HOME)"); /* An important special case: the
1928
user's home directory. */
1929
1930
@ First we make a string out of the argument. Then we query the
1931
environment for the requested variable. If we get |NULL|, we return the
1932
empty string; otherwise, we return the answer as an unquoted string of
1933
characters.
1934
1935
@d N_ENVBUF 200
1936
1937
@d SAVE_ENV(aval) if(t < temp_end) *t++ = XCHR(aval);
1938
else OVERFLW("Env_buf","")@;
1939
1940
@a
1941
SRTN
1942
i_getenv_ FCN((n,pargs))
1943
int n C0("")@;
1944
PARGS pargs C1("")@;
1945
{
1946
ASCII HUGE *p;
1947
outer_char *pvar, HUGE *t;
1948
outer_char HUGE *temp, HUGE *temp_end; /* Holds the name of the requested
1949
variable. */
1950
1951
#if !HAVE_GETENV
1952
MACRO_ERR("Sorry, this machine doesn't support getenv",YES);
1953
#else
1954
1955
CHK_ARGS("$GETENV",1);
1956
1957
1958
temp = GET_MEM("_getenv_:temp",N_ENVBUF,outer_char);
1959
temp_end = temp + N_ENVBUF;
1960
1961
for(p=(ASCII HUGE *)(pargs[0]+3),t=temp; *(p+1) != stringg; )
1962
SAVE_ENV(*p++);
1963
1964
SAVE_ENV('\0');
1965
1966
if( (pvar=GETENV((CONST char *)temp)) != NULL) mcopy(pvar);
1967
1968
FREE_MEM(temp,"_getenv_:temp",N_ENVBUF,outer_char);
1969
1970
#endif // |HAVE_GETENV|
1971
}
1972
1973
@ If the macro name is recursive, we don't expand it; we just copy the name
1974
itself.
1975
@<Don't expand...@>=
1976
@B
1977
name_pointer np;
1978
CONST ASCII HUGE *end;
1979
1980
np = name_dir + a;
1981
1982
PROPER_END(end);
1983
copy_id(np->byte_start,end,"recursive macro name");
1984
1985
/* Can't do this; infinite recursion! */
1986
@#if 0
1987
MCHECK(2,"recursive macro name");
1988
*mp++ = LEFT(a,ID0);
1989
*mp++ = RIGHT(a);
1990
@#endif
1991
}
1992
1993
1994
1995
@* EXPANDING a MACRO.
1996
Here is the heart of the macro processor. We must actually replace an
1997
expandable macro token by the replacement text. While processing the
1998
replacement text, the tokens~'\.\#' and |MACRO_ARGUMENT| have special
1999
significance.
2000
2001
@<Expand a macro@>=
2002
@B
2003
eight_bits n = 0; // Number of actual arguments found.
2004
eight_bits HUGE *mp0=NULL, HUGE *mp1, HUGE *m_start, HUGE *m_end;
2005
boolean xpn_argument = YES;
2006
boolean last_was_paste;
2007
long max_n = 0; // Maximum statement label offset encountered.
2008
2009
@b
2010
/* Get pointers to $n$~actual argument tokens. */
2011
if(m->nargs > 0 || m->var_args)
2012
p = get_margs0(p-2, end, pcur_byte, pthe_end, multilevels,
2013
(boolean)(m->var_args), pargs, &n);
2014
2015
if( (!m->var_args && n != m->nargs) || (m->var_args && n < m->nargs) )
2016
{
2017
MACRO_ERR("! Actual number of WEB macro arguments (%u) does not match \
2018
number of def'n (%u); %s",YES,n,m->nargs,
2019
n < m->nargs ? "missing ones assumed to be NULL" :
2020
"extra ones discarded");
2021
2022
/* If there are too many, we'll just ignore the remainder. However, if
2023
there are too few, we'll essentially supply null arguments by fleshing out
2024
the pointer list. */
2025
while(n < m->nargs)
2026
{
2027
pargs[n+1] = pargs[n] + 1;
2028
n++;
2029
}
2030
}
2031
2032
/* Copy macro text, substituting arguments. */
2033
m_start = mp; /* Remember the beginning. */
2034
last_was_paste = NO; /* Remember whether last token was |paste|. */
2035
2036
if(m->built_in)
2037
{
2038
(*(SRTN (*)(int,unsigned char **))(m->tok_start))(n,pargs);
2039
}
2040
else
2041
@<Expand ordinary macro@>@;
2042
2043
/* If any |paste| tokens were encountered, implement them. */
2044
if(must_paste)
2045
@<Paste expansion.@>@;
2046
2047
if(max_n > 0)
2048
max_stmt += max_n;
2049
2050
xpn_before(m_start, xids, pcur_byte, pthe_end, multilevels);
2051
#if 0
2052
if(must_paste)
2053
#endif
2054
expanded = YES; /* If we pasted something, a new macro may
2055
have been created. */
2056
}
2057
2058
@
2059
@<Expand ordinary macro@>=
2060
{
2061
/* Beginning and end of the text for this macro. */
2062
p0 = m->tok_start + m->moffset;
2063
p1 = m->tok_start + m->nbytes;
2064
2065
while(p0 < p1)
2066
{
2067
if(TOKEN1(a = *p0++))
2068
@<``Expand'' a one-byte token@>@;
2069
else
2070
@<Copy two-byte macro token@>@;
2071
}
2072
}
2073
2074
@
2075
@<Copy two-byte macro...@>=
2076
{
2077
eight_bits k = *p0++; // Second of the two bytes.
2078
2079
if(a == MACRO_ARGUMENT)
2080
{
2081
pasting = cp_macro_arg(pargs, k, n, &xpn_argument,
2082
last_was_paste, (boolean)(*p0 == paste));
2083
}
2084
else
2085
{/* Copy nonargument two-byte macro token. */
2086
last_was_paste = NO;
2087
2088
MCHECK(2, "nonargument macro token");
2089
2090
*mp++ = (eight_bits)a;
2091
*mp++ = k;
2092
2093
if(a == MOD1 && k == '\0')
2094
{ /* Line-number info. */
2095
MCHECK(4, "line info");
2096
memcpy(mp, p0, 4);
2097
mp += 4;
2098
p0 += 4;
2099
}
2100
}
2101
}
2102
2103
@ While processing a one-byte token, we must remember if the |paste| token
2104
appeared, because that means we have more work to do.
2105
@<``Expand...@>=
2106
{
2107
if(!(a==@'#' && *p0==@'.')) last_was_paste = NO;
2108
2109
if(p0==p1 && a==@'\n') break;
2110
2111
switch(a)
2112
{
2113
case @'#':
2114
@<Perform stringize or related cases@>@;
2115
break;
2116
2117
case stringg:
2118
MCHECK(1,"\"");
2119
*mp++ = (eight_bits)a; // |stringg| token.
2120
2121
do
2122
{
2123
if(!TOKEN1(*mp=*p0++))
2124
{
2125
MCHECK(1,"id prefix");
2126
*++mp = *p0++;
2127
}
2128
MCHECK(1,"8-bit token");
2129
}
2130
while(*mp++ != (eight_bits)a);
2131
2132
break;
2133
2134
case dot_const:
2135
case begin_language:
2136
MCHECK(2,"dot_const");
2137
*mp++ = (eight_bits)a;
2138
*mp++ = *p0++;
2139
break;
2140
2141
default:
2142
/* Copy over single-byte token; remember if it was |paste|. */
2143
MCHECK(1,"single-byte token");
2144
if( (*mp++ = (eight_bits)a) == paste)
2145
last_was_paste = must_paste = YES;
2146
break;
2147
}
2148
}
2149
2150
@ Here we deal with a macro argument. (The argument number is in |*p0|,
2151
immediately after the token |MACRO_ARGUMENT|.)
2152
@a
2153
boolean cp_macro_arg FCN((pargs,k,n,pxpn_argument,
2154
last_was_paste,next_is_paste))
2155
PARGS pargs C0("")@;
2156
eight_bits k C0("Current argument to process")@;
2157
eight_bits n C0("")@;
2158
boolean HUGE *pxpn_argument C0("")@;
2159
boolean last_was_paste C0("")@;
2160
boolean next_is_paste C1("")@;
2161
{
2162
boolean pasting;
2163
eight_bits HUGE *begin_arg, HUGE *end_arg, HUGE *mp0=NULL;
2164
2165
/* Check for requested argument number bigger than the maximum actually
2166
used in the call. */
2167
if(k >= n)
2168
{ // Make it of zero length.
2169
pargs[k] = pargs[n];
2170
pargs[k +1] = pargs[n] + 1;
2171
}
2172
2173
begin_arg = pargs[k] + 1; /* The next byte (|k|) after the marker token
2174
has the argument number. Make
2175
|begin_arg| point to the token list of the appropriate actual
2176
argument. */
2177
while(*begin_arg==@'\n') begin_arg++;
2178
2179
end_arg = pargs[k + 1]; /* The end is in the next element of |pargs|. */
2180
2181
/* Check if the last (already copied to |macrobuf|) or next token to this
2182
parameter is |paste|. */
2183
if(last_was_paste || next_is_paste) pasting = YES;
2184
else
2185
{
2186
pasting = NO;
2187
mp0 = mp; /* Remember where this argument text started. */
2188
}
2189
2190
/* Copy the tokens of the argument. If it's a null argument to be pasted,
2191
explicitly insert a null character to avoid a warning message and/or to
2192
prevent the paste from pasting the previous identifier. */
2193
if(begin_arg == end_arg)
2194
{
2195
if(pasting)
2196
{
2197
MCHECK(1,"null character");
2198
*mp++ = '\0';
2199
}
2200
}
2201
else
2202
{/* Copy the argument. */
2203
MCHECK(end_arg - begin_arg,"argument tokens");
2204
while(begin_arg < end_arg) *mp++ = *begin_arg++;
2205
}
2206
2207
/* If the parameter is to be pasted, the argument does not get expanded.
2208
It also doesn't get expanded if it was immediately preceded by `\.{\#!}',
2209
in which case |xpn_argument| was set to |NO|.
2210
Otherwise, the argument gets expanded before finally substituting it for
2211
the parameter. */
2212
if(!*pxpn_argument)
2213
*pxpn_argument = YES;
2214
else if(!pasting)
2215
xpn_before(mp0, NULL, NULL, NULL, NO);
2216
2217
return pasting;
2218
}
2219
2220
@ In the ANSI preprocessor, the token `\.{\#}' must be followed by a macro
2221
argument, when it then means stringize the argument. Here we extend the
2222
usage to encompass other cases. If `\.{\#}' is followed by a macro token,
2223
the complete expansion of that macro will be substituted immediately, on
2224
input. If the construction `\.{\#!}' is followed by a macro token, the
2225
token definition of that macro will be copied, but tokens in that
2226
definition will not be expanded; otherwise, `\.{\#!}' must be followed by a
2227
macro parameter, which will be substituted but not expanded. The
2228
construction `\.{\#\&}' means execute the internal function whose id
2229
follows. `\.{\#:}$nnn$' is related to automatic generation of labels, where
2230
when $nnn = 0$ the statement number is assigned immediately (on input), and
2231
when $nnn > 0$ means generate the current statement number plus~$nnn$ on
2232
output, uniquely on each execution of the macro.
2233
2234
@d DOES_ARG_FOLLOW(c)
2235
if(*p0 != MACRO_ARGUMENT)
2236
{
2237
MACRO_ERR("! Macro token `#%c' must be followed by a parameter",YES,c);
2238
break;
2239
}
2240
p0++@; // Skip over |MACRO_ARGUMENT|.
2241
2242
@<Perform stringize or...@>=
2243
{
2244
keep_intact = NO;
2245
2246
switch(*p0++)
2247
{
2248
case @'&':
2249
@<Expand internal function@>@; break;
2250
2251
case @':':
2252
@<Generate statement label@>@; break;
2253
2254
case @'!':
2255
if(*p0 == MACRO_ARGUMENT) xpn_argument = NO;
2256
else MACRO_ERR("! Macro token '#!' must be followed by \
2257
a parameter",YES);
2258
break;
2259
2260
case @'\'':
2261
single_quote = YES;
2262
DOES_ARG_FOLLOW('\'');
2263
goto do_stringize;
2264
2265
case @'"':
2266
double_quote = YES;
2267
DOES_ARG_FOLLOW('\"'); // Without the escape, bug on VAX.
2268
goto do_stringize;
2269
2270
case @'*':
2271
DOES_ARG_FOLLOW('*');
2272
keep_intact = YES;
2273
/* Falls through to next case! */
2274
2275
case MACRO_ARGUMENT:
2276
@<Stringize parameter@>@; break;
2277
2278
case @'0':
2279
@<Insert the number of variable arguments@>@;
2280
break;
2281
2282
case @'{':
2283
@<Insert the $n^{\rm th}$ variable argument@>@;
2284
break;
2285
2286
case @'[':
2287
@<Insert the $n^{\rm th}$ fixed argument@>@;
2288
break;
2289
2290
case @'.':
2291
@<Insert all of the variable arguments@>@;
2292
break;
2293
2294
default:
2295
p0--;
2296
MACRO_ERR(_Xx("! Invalid token 0x%x ('%c') after '#'"),YES,
2297
*p0,isprint(*p0) ? *p0 : '.');
2298
break;
2299
}
2300
}
2301
2302
@
2303
@<Insert the number of var...@>=
2304
{
2305
eight_bits HUGE *mp0; // For converting the number to |ASCII|.
2306
2307
p0 += 2; // Skip over null tokens.
2308
2309
MCHECK(4,"tokens for number of variable arguments");
2310
*mp++ = constant;
2311
mp0 = mp;
2312
mp += NSPRINTF((outer_char *)mp0,"%d",n - m->nargs);
2313
to_ASCII((outer_char HUGE *)mp0);
2314
*mp++ = constant;
2315
}
2316
2317
@ Format \.{\#[$n$]}: Insert the $n$-th fixed argument.
2318
2319
@d INS_ARG_LIST pargs,m,n,&p0,&pasting,&xpn_argument,last_was_paste
2320
2321
@<Insert the $n^{\rm th}$ fixed argument@>=
2322
expanded |= ins_arg(@'[',@']',INS_ARG_LIST);
2323
2324
@ Format \.{\#[$n$]}: Insert the $n$-th variable argument.
2325
@<Insert the $n^{\rm th}$ variable argument@>=
2326
expanded |= ins_arg(@'{',@'}',INS_ARG_LIST);
2327
2328
@
2329
@a
2330
boolean ins_arg FCN((cleft,cright,
2331
pargs,m,n,pp0,ppasting,pxpn_argument,last_was_paste))
2332
ASCII cleft C0("")@;
2333
ASCII cright C0("")@;
2334
PARGS pargs C0("")@;
2335
text_pointer m C0("")@;
2336
eight_bits n C0("")@;
2337
eight_bits HUGE * HUGE *pp0 C0("")@;
2338
boolean *ppasting C0("")@;
2339
boolean *pxpn_argument C0("")@;
2340
boolean last_was_paste C1("")@;
2341
{
2342
int k;
2343
boolean next_is_paste = BOOLEAN(*(*pp0) == paste);
2344
eight_bits HUGE *pp;
2345
eight_bits HUGE *mp0 = mp;
2346
eight_bits HUGE *p00 = (*pp0);
2347
boolean fixed = BOOLEAN(cleft == @'[');
2348
2349
WHILE()
2350
if(*(*pp0) == cright)
2351
{
2352
break;
2353
}
2354
else if(TOKEN1(*(*pp0))) (*pp0)++;
2355
else (*pp0) += 2;
2356
2357
pp = xmac_text(mp0,p00,(*pp0)++);
2358
k = neval(pp,mp);
2359
2360
mp = mp0;
2361
2362
/* For debugging */
2363
if(k == 0)
2364
{
2365
*mp++ = @'#';
2366
*mp++ = @'{';
2367
2368
while(p00 < *pp0)
2369
*mp++ = *p00++;
2370
2371
return YES;
2372
}
2373
2374
if(k <= 0)
2375
{ /* Insert the total number of arguments. */
2376
outer_char temp[5];
2377
2378
NSPRINTF(temp,"#%c0%c",5,XCHR(cleft),XCHR(cright));
2379
MCHECK(4,temp);
2380
*mp++ = constant;
2381
mp0 = mp;
2382
mp += NSPRINTF((outer_char *)mp0,"%d",n - (fixed ? 0 : m->nargs));
2383
to_ASCII((outer_char HUGE *)mp0);
2384
*mp++ = constant;
2385
}
2386
else
2387
*ppasting = cp_macro_arg(pargs, (eight_bits)(k-1 + (fixed ? 0 : m->nargs)),
2388
n, pxpn_argument, last_was_paste, next_is_paste);
2389
2390
return NO;
2391
}
2392
2393
@ Here we insert the complete list of variable arguments, separated by
2394
commas, as in~$a,b,c$.
2395
@<Insert all of the var...@>=
2396
{
2397
eight_bits k;
2398
boolean next_is_paste = BOOLEAN(*p0 == paste);
2399
2400
for(k=m->nargs; k<n; k++)
2401
{
2402
pasting = cp_macro_arg(pargs,k,n,&xpn_argument,
2403
(boolean)(last_was_paste && k==m->nargs),
2404
(boolean)(next_is_paste && k==(eight_bits)(n-1)) );
2405
*mp++ = @',';
2406
}
2407
2408
if(*(mp-1) == @',') mp--;
2409
// If we inserted at least one arg, kill off last comma.
2410
}
2411
2412
@
2413
@<Unused@>=
2414
{
2415
eight_bits HUGE *begin_arg, HUGE *end_arg;
2416
2417
begin_arg = pargs[k] + 1;
2418
while(*begin_arg==@'\n') begin_arg++;
2419
2420
end_arg = pargs[k+1];
2421
2422
MCHECK(end_arg - begin_arg+1,"variable argument tokens");
2423
while(begin_arg < end_arg) *mp++ = *begin_arg++;
2424
}
2425
2426
@ Here we append the tokens of a macro definition, without expanding them.
2427
@<Unused@>=
2428
{
2429
if(m->nargs > 0)
2430
MACRO_ERR("! Macro after #! may not have arguments",YES);
2431
else
2432
{
2433
eight_bits HUGE *q0, HUGE *q1;
2434
2435
q0 = m->tok_start + m->moffset;
2436
q1 = m->tok_start + m->nbytes;
2437
2438
/* Just copy the definition without expanding. */
2439
MCHECK(q1-q0,"unexpanded definition");
2440
while(q0 < q1)
2441
*mp++ = *q0++;
2442
}
2443
}
2444
2445
@ Here we expand an argument exhaustively before final substitution.
2446
@a
2447
SRTN
2448
xpn_before FCN((mp0, xids, pcur_byte, pthe_end, multilevels))
2449
eight_bits HUGE *mp0 C0("Remember this end of |macro_buf|.")@;
2450
XIDS HUGE *xids C0("")@;
2451
eight_bits HUGE **pcur_byte C0("Pointer to |cur_byte|.")@;
2452
eight_bits HUGE **pthe_end C0("End of buffer.")@;
2453
boolean multilevels C1("")@;
2454
{
2455
eight_bits HUGE *mp1;
2456
2457
mp1 = xmac_buf(mp0, xids, pcur_byte, pthe_end, multilevels);
2458
// Expand argument before substitution.
2459
2460
while(mp1 < mp)
2461
*mp0++ = *mp1++;
2462
// Copy the expansion back to original place.
2463
2464
mp = mp0; // Current end of |macrobuf|.
2465
}
2466
2467
@ When we encounter the juxtaposition `\.{\#\&}', the next identifier must
2468
correspond to an internal macro function. We get the address of that
2469
function, then execute it.
2470
@<Expand internal...@>=
2471
@B
2472
sixteen_bits id;
2473
2474
@b
2475
if(p0 == p1) MACRO_ERR("! Missing internal function name after #&",YES);
2476
else
2477
{
2478
if(TOKEN1(a = *p0++)) MACRO_ERR("! Identifier must follow #&",YES);
2479
else if(!x_int_fcn(id=IDENTIFIER(a,*p0++),n,pargs))
2480
MACRO_ERR("! Internal function name \"%s\" not defined",
2481
YES,name_of(id));
2482
}
2483
}
2484
2485
@ Here we expand a generic internal function.
2486
2487
@f INTERNAL_FCN int
2488
2489
@a
2490
boolean
2491
x_int_fcn FCN((id,n,pargs))
2492
sixteen_bits id C0("Token for internal function.")@;
2493
int n C0("Number of arguments")@;
2494
PARGS pargs C1("Array of pointers to arguments.")@;
2495
{
2496
INTERNAL_FCN HUGE *f;
2497
2498
for(f=internal_fcns; f->len != 0; f++)
2499
if(f->id == id)
2500
{
2501
(*f->expnd)(n,pargs); /* Feed the internal function the list
2502
of (pointers to) arguments; put the expansion into the |macrobuf|. */
2503
return YES;
2504
}
2505
2506
return NO; /* Function not found. */
2507
}
2508
2509
@ The combination~`\.{\#:}$nnn$', where $nnn$~is a non-negative integer,
2510
expands to the next available automatic statement label plus~$nnn - 1$.
2511
@<Generate statement label@>=
2512
@B
2513
int m;
2514
long n; // Label increment.
2515
outer_char *tmp; // Temporary buffer for the number.
2516
size_t i;
2517
2518
@b
2519
if(*p0 != constant)
2520
{
2521
MACRO_ERR("Expected constant after \"#:\"",YES);
2522
break;
2523
}
2524
2525
p0++; // Position after |constant|.
2526
2527
for(i=0; p0[i] != constant; i++)
2528
; // Find size of the constant.
2529
2530
tmp = GET_MEM("stmt number",i+1,outer_char);
2531
2532
/* Convert to |outer_char|, and also position to after |constant|. */
2533
for(i=0; *p0 != constant; i++, p0++)
2534
tmp[i] = XCHR(*p0);
2535
tmp[i+1] = '\0';
2536
p0++;
2537
2538
n = ATOL(tmp); // Convert the following number.
2539
2540
FREE_MEM(tmp,"stmt number",i+1,outer_char);
2541
2542
if(n <= 0)
2543
{
2544
MACRO_ERR("! Invalid statement number offset (%ld) after #:; 1 assumed",YES,n);
2545
n = 1;
2546
}
2547
2548
if(n > max_n) max_n = n; // Remember the maximum offset.
2549
2550
MCHECK(2,"|constant|");
2551
*mp++ = constant;
2552
2553
m = NSPRINTF((outer_char *)mp,"%lu",max_stmt + n - 1);
2554
MCHECK(m,"stmt label");
2555
to_ASCII((outer_char HUGE *)mp);
2556
mp += m;
2557
2558
*mp++ = constant;
2559
}
2560
2561
2562
@ Pasting an expansion is rather complicated. We hunt through the tokens
2563
looking for |paste|. When we find it, the last and the next objects must be
2564
expanded side-by-side into their character representations in a buffer.
2565
Then this expansion must be re-tokenized and substituted for the original
2566
objects.
2567
@<Paste expansion...@>=
2568
{
2569
m_end = mp; /* End of the macro tokens to be scanned for pasting; beginning
2570
of the new, pasted expansion. */
2571
2572
/* Copy from |mp0| to |mp|. If we find |paste|, execute that operation. */
2573
copy_and_paste(m_start,m_end);
2574
2575
/* Copy pasted expansion back to start of this macro. */
2576
for(mp1=mp,mp=m_start,mp0=m_end; mp0<mp1; )
2577
*mp++ = *mp0++;
2578
}
2579
2580
@ Here we copy tokens into the |macrobuf| beginning at |mp|. If we find
2581
|paste|, we execute that operation.
2582
@a
2583
eight_bits HUGE *
2584
copy_and_paste FCN((m_start,m_end))
2585
eight_bits HUGE *m_start C0("Start of range.")@;
2586
eight_bits HUGE *m_end C1("End of range.")@;
2587
{
2588
eight_bits HUGE *mp0;
2589
eight_bits a0;
2590
eight_bits HUGE *m_last = m_start; // Remember start of last token.
2591
2592
for(mp0=m_start; mp0 < m_end; )
2593
{
2594
if(TOKEN1(a0=*mp0))
2595
{
2596
if(a0 == paste) @<Juxtapose left and right.@>@;
2597
else
2598
{
2599
if(a0 == ignore)
2600
{
2601
mp0++; // Just skip any nulls that sneak in.
2602
continue;
2603
}
2604
2605
m_last = mp;
2606
2607
switch(a0)
2608
{
2609
case constant:
2610
case stringg:
2611
MCHECK(1,"|constant| or |stringg|");
2612
*mp++ = *mp0++;
2613
2614
do
2615
{
2616
*mp = *mp0++;
2617
MCHECK(1,"text of \
2618
|constant| or |stringg|");
2619
}
2620
while (*mp++ != a0);
2621
2622
break;
2623
2624
case dot_const:
2625
case begin_language:
2626
MCHECK(2,"dot_const");
2627
*mp++ = *mp0++;
2628
*mp++ = *mp0++;
2629
break;
2630
2631
default: /* Copy ASCII token. */
2632
MCHECK(1,"ASCII token");
2633
*mp++ = *mp0++;
2634
break;
2635
}
2636
}
2637
}
2638
else
2639
{ /* Copy two-byte token. */
2640
m_last = mp;
2641
MCHECK(2,"two-byte token");
2642
*mp++ = *mp0++; *mp++ = *mp0++;
2643
}
2644
}
2645
2646
return m_last;
2647
}
2648
2649
@ To do token-pasting, we must first juxtapose the expansions of the tokens
2650
to the left and right of the |paste| token. Then we must retokenize the
2651
juxtaposition.
2652
2653
@d STOP YES
2654
2655
@<Juxtapose...@>=
2656
{
2657
eight_bits HUGE *p;
2658
2659
p = mp; /* Beginning of the juxtaposition. */
2660
2661
paste1(m_last,m_start); /* Paste tokens to left of `\.{\#\#}'. */
2662
mp0 = paste1(++mp0,m_end); /* Paste tokens to right. */
2663
2664
/* Tokenize the juxtaposition. */
2665
divert((ASCII HUGE *)p, (ASCII HUGE *)mp, STOP); /* Make the next |scan_repl|
2666
read from |macrobuf| between~|p| and~|mp|. */
2667
scan_repl(macro, STOP);
2668
2669
/* Copy tokenized stuff back into |macrobuf|, overwriting the juxtaposition. */
2670
mp = m_last;
2671
m_last = copy_and_paste(cur_text->tok_start, tok_ptr);
2672
2673
/* Back up the text buffer. */
2674
text_ptr = cur_text;
2675
mx_tok_ptr = tok_ptr;
2676
tok_ptr = text_ptr->tok_start;
2677
}
2678
2679
@ Here we expand the tokens beginning at~|p0| into the |macrobuf|. The
2680
routine returns the next position in the input buffer.
2681
@a
2682
eight_bits HUGE *
2683
paste1 FCN((p0,begin_or_end))
2684
eight_bits HUGE *p0 C0("Beginning of tokens to be expanded.")@;
2685
eight_bits HUGE *begin_or_end C1("")@;
2686
{
2687
eight_bits a0,a1;
2688
sixteen_bits a;
2689
2690
if(p0 == begin_or_end)
2691
{
2692
MACRO_ERR("! Missing argument to token-paste operation. Null assumed",
2693
YES);
2694
return p0;
2695
}
2696
2697
if(TOKEN1(a0=*p0++))
2698
switch(a0)
2699
{
2700
case ignore: break;
2701
2702
case constant:
2703
case stringg:
2704
/* Copy the stuff sandwiched between tokens. */
2705
while( (a1=*p0++) != a0)
2706
{
2707
MCHECK(1,"stuff between tokens");
2708
*mp++ = a1;
2709
}
2710
break;
2711
2712
case dot_const:
2713
case begin_language:
2714
MCHECK(2,"dot_const");
2715
*mp++ = a0;
2716
*mp++ = *p0++;
2717
break;
2718
2719
default:
2720
MCHECK(1,"default ASCII token");
2721
*mp++ = a0; /* Copy ASCII token. */
2722
break;
2723
}
2724
else
2725
{
2726
a = IDENTIFIER(a0,*p0++);
2727
2728
if(a < MODULE_NAME)
2729
{
2730
name_pointer np;
2731
2732
np = name_dir + a;
2733
@<Copy possibly truncated identifier to macro buffer@>@;
2734
}
2735
else {} /* ?? */
2736
}
2737
2738
return p0;
2739
}
2740
2741
@
2742
@<Copy possibly truncated id...@>=
2743
{
2744
TRUNC HUGE *s;
2745
ASCII HUGE *pc = np->byte_start;
2746
2747
if(*pc != BP_MARKER)
2748
{ /* Not truncated. */
2749
CONST ASCII HUGE *end;
2750
2751
PROPER_END(end);
2752
copy_id((CONST ASCII HUGE *)pc,end,"copied id");
2753
}
2754
else
2755
{
2756
s = ((BP HUGE *)pc)->Root;
2757
copy_id(s->id,s->id_end,"copied id");
2758
}
2759
}
2760
2761
@ Copy an identifier into the macro buffer.
2762
@a
2763
SRTN
2764
copy_id FCN((start,end,descr))
2765
CONST ASCII HUGE *start C0("Beginning of identifier name.")@;
2766
CONST ASCII HUGE *end C0("End of identifier name.")@;
2767
CONST char *descr C1("")@;
2768
{
2769
CONST ASCII HUGE *j;
2770
2771
MCHECK(end - start,descr);
2772
2773
for (j=start; j<end; )
2774
*mp++ = (eight_bits)(*j++);
2775
}
2776
2777
@ Report macro buffer overflow, and abort.
2778
2779
@a
2780
SRTN
2781
mbuf_full FCN((n,reason))
2782
unsigned long n C0("Number of bytes requested.")@;
2783
CONST outer_char reason[] C1("Reason for request.")@;
2784
{
2785
MACRO_ERR("! Macro buffer full; %lu byte(s) requested for %s",YES,n,reason);
2786
OVERFLW("macro buffer bytes",ABBREV(mbuf_size));
2787
}
2788
2789
/* Interface from independently compiled modules. */
2790
SRTN
2791
mcheck0 FCN((n,reason))
2792
unsigned long n C0("Number of bytes requested.")@;
2793
CONST outer_char reason[] C1("Reason for request.")@;
2794
{
2795
MCHECK(n,reason);
2796
}
2797
2798
@ Do the complete, recursive expansion of a macro.
2799
@a
2800
eight_bits HUGE *
2801
xmacro FCN((macro_text, pcur_byte, pthe_end, multilevels, mp0))
2802
text_pointer macro_text C0("")@;
2803
eight_bits HUGE **pcur_byte C0("Pointer to |cur_byte|.")@;
2804
eight_bits HUGE **pthe_end C0("End of buffer.")@;
2805
boolean multilevels C0("Read args through many levels?")@;
2806
eight_bits HUGE *mp0 C1("Build the expansion beginning here in \
2807
|macrobuf|.")@;
2808
{
2809
eight_bits HUGE *macro_start;
2810
extern long cur_val;
2811
2812
/* Copy the token of this macro. */
2813
mp = mp0; /* Current position in |macrobuf|. */
2814
2815
MCHECK(2,"macro token");
2816
2817
if(macro_text->built_in)
2818
{
2819
*mp++ = LEFT(cur_val,ID0);
2820
*mp++ = RIGHT(cur_val);
2821
}
2822
else
2823
{
2824
macro_start = macro_text->tok_start;
2825
*mp++ = *macro_start++; *mp++ = *macro_start++;
2826
}
2827
2828
/* If there are arguments, must get more tokens, through end of
2829
parens. Put all these into beginning of |macrobuf|. */
2830
if(macro_text->nargs > 0 || macro_text->var_args)
2831
mp = args_to_macrobuf(mp, pcur_byte, pthe_end, multilevels,
2832
(boolean)(macro_text->var_args));
2833
2834
return xmac_buf(mp0, NULL, pcur_byte, pthe_end, multilevels);
2835
/* Start at expansion level~0;
2836
return pointer to start of final expansion. */
2837
}
2838
2839
@ The following routine places all the argument tokens into the
2840
|macro_buf|, ready for expansion. We must watch out for nested parentheses.
2841
2842
Warning: the |pop_level| command below resets the value of |cur_byte| and
2843
|cur_end|. When |multilevels==YES|, |pcur_byte| and |pthe_end| must be
2844
pointing to |cur_byte| and |cur_end|!!!
2845
2846
@a
2847
eight_bits HUGE *
2848
args_to_macrobuf FCN((mp, pcur_byte, pthe_end,
2849
multilevels, var_args))
2850
eight_bits HUGE *mp C0("Next available position in |macro_buf|.")@;
2851
eight_bits HUGE **pcur_byte C0("Pointer to |cur_byte|.")@;
2852
eight_bits HUGE **pthe_end C0("End of buffer.")@;
2853
boolean multilevels C0("Read through many levels?")@;
2854
boolean var_args C1("Does macro have variable args?")@;
2855
{
2856
eight_bits c; // First token of identifier.
2857
sixteen_bits id_token; // Name of this macro.
2858
int bal = 0; // Keep track of balanced parens.
2859
2860
id_token = IDENTIFIER(*(mp-2),*(mp-1));
2861
// Name of the macro; remember for error processing.
2862
2863
do
2864
{
2865
if(*pcur_byte == *pthe_end)
2866
{
2867
if(!(multilevels && pop_level()))
2868
{
2869
MACRO_ERR("! No ')' in call to macro \"%s\"",YES,
2870
name_of(id_token));
2871
break;
2872
}
2873
}
2874
2875
MCHECK(1,"arg to macrobuf");
2876
c = *mp++ = *(*pcur_byte)++;
2877
2878
if(TOKEN1(c))
2879
@<Copy single character of argument@>@;
2880
else
2881
{/* Copy second token of identifier, or stuff relating to
2882
module name and line number. */
2883
int n; /* Number of remaining bytes to copy. */
2884
2885
n = (c < MOD0 ? 1 : 3 + 4*1); // `1' for |line_info|.
2886
MCHECK(n,"second id token");
2887
while(n-- > 0) *mp++ = *(*pcur_byte)++;
2888
continue;
2889
}
2890
}
2891
while(bal > 0);
2892
2893
done_copying:
2894
return mp; /* New end. */
2895
}
2896
2897
@
2898
@<Copy single character of arg...@>=
2899
{
2900
switch(c)
2901
{
2902
case stringg:
2903
do
2904
{
2905
MCHECK(1,"string arg");
2906
*mp = *(*pcur_byte)++;
2907
}
2908
while(*mp++ != stringg);
2909
break;
2910
2911
case dot_const:
2912
case begin_language:
2913
MCHECK(1,"dot const");
2914
*mp++ = *(*pcur_byte)++;
2915
break;
2916
2917
case @'(':
2918
bal++;
2919
break;
2920
2921
case @')':
2922
if(bal == 0 && !var_args)
2923
{
2924
MACRO_ERR("! Missing '(' in call to macro \"%s\"",YES,
2925
name_of(id_token));
2926
goto done_copying;
2927
}
2928
else bal--;
2929
2930
break;
2931
}
2932
}
2933
2934
@ Expand the macro buffer. Keep expanding until nothing more. The original
2935
thing to be expanded, either just a macro token or the token plus its
2936
argument list, starts off in the beginning of |macrobuf|. Successive
2937
translations are put after that, until on the final pass no macros were
2938
expanded. |mp|~points to the next free position in |macrobuf|.
2939
2940
(Some of the code here may be archaic and/or redundant, because of
2941
changes made in the order of recursive expansion. In some cases, |x0macro|
2942
may be called one more time than necessary. Fixing this up might save some
2943
time in macro-bound codes.)
2944
@a
2945
eight_bits HUGE *
2946
xmac_buf FCN((mp0, old_xids, pcur_byte, pthe_end, multilevels))
2947
eight_bits HUGE *mp0 C0("Text to be expanded begins here.")@;
2948
XIDS HUGE *old_xids C0("")@;
2949
eight_bits HUGE **pcur_byte C0("Pointer to |cur_byte|.")@;
2950
eight_bits HUGE **pthe_end C0("End of buffer.")@;
2951
boolean multilevels C1("")@;
2952
{
2953
eight_bits HUGE *p, HUGE *p1;
2954
XIDS xids;
2955
XIDS HUGE *pid;
2956
2957
xids.level = 0;
2958
2959
if(xlevel >= MAX_XLEVELS)
2960
{
2961
MACRO_ERR("! Macro outer recursion depth exceeded",YES);
2962
FATAL(M, "!! BYE.", "");
2963
}
2964
2965
pid = pids[xlevel++] = old_xids ? old_xids : &xids; /* Store the address of
2966
this bunch of recursive names. */
2967
2968
for(p=mp0, p1= mp;
2969
x0macro(p, p1, pid, pcur_byte, pthe_end, multilevels);
2970
p=p1, p1=mp);
2971
2972
xlevel--; // Pop the outer recursion stack.
2973
2974
return p1; // Return beginning of the expanded text.
2975
}
2976
2977
@ Copy unexpanded text to the macro buffer, expand it, and return the
2978
location of the expanded stuff.
2979
@a
2980
eight_bits HUGE *
2981
xmac_text FCN((mp0,start,end))
2982
eight_bits HUGE *mp0 C0("")@;
2983
eight_bits HUGE *start C0("")@;
2984
eight_bits HUGE *end C1("")@;
2985
{
2986
/* Copy the text to the macrobuf. */
2987
for(mp=mp0; start < end; )
2988
*mp++ = *start++;
2989
2990
/* Expand the contents and return pointer. */
2991
return xmac_buf(mp0, NULL, NULL, NULL, NO);
2992
}
2993
2994
@* BUILT-IN FUNCTIONS.
2995
Generate a comment in the output.
2996
@<Define internal...@>=
2997
2998
SAVE_MACRO("$COMMENT(cmnt)$$META(#*cmnt)");
2999
3000
@
3001
3002
@d arg_must_be_constant(name)
3003
MACRO_ERR("Argument of \"%s\" must be constant or string",YES,name);
3004
3005
@a
3006
SRTN
3007
i_meta_ FCN((n,pargs))
3008
int n C0("")@;
3009
PARGS pargs C1("")@;
3010
{
3011
eight_bits HUGE *p;
3012
3013
CHK_ARGS("$COMMENT",1);
3014
3015
IS_IT_CONSTANT($COMMENT);
3016
3017
@<Write begin-comment token to |macrobuf|@>;
3018
3019
*(p+1) = *(pargs[1]-2) = @' '; /* Change quotes to blanks. */
3020
3021
do
3022
{
3023
MCHECK0(1,"_meta_");
3024
*mp++ = *p++;
3025
}
3026
while(p < pargs[1]);
3027
3028
@<Write end-comment token to |macrobuf|@>;
3029
}
3030
3031
@ In the initialization of |begin_C_meta|, we use the octal definition of
3032
|constant| (see \.{t\_codes}). This is necessary since otherwise a space is
3033
inserted between~'\./' and~'\.*' to handle expressions such as \.{x / *p}.
3034
3035
@<Write begin-comment...@>=
3036
@B
3037
static eight_bits begin_C_meta[] = {constant,@'/',@'*',constant,'\0'};
3038
eight_bits HUGE *p;
3039
3040
@b
3041
if(C_LIKE(language))
3042
{
3043
MCHECK0(4,"begin_C_meta");
3044
for(p=begin_C_meta; *p; ) *mp++ = *p++;
3045
}
3046
else
3047
{
3048
MCHECK0(2,"begin_meta");
3049
*mp++ = begin_meta;
3050
*mp++ = begin_meta;
3051
}
3052
}
3053
3054
@
3055
@<Write end-comment...@>=
3056
@B
3057
static eight_bits end_C_meta[] = @"*/";
3058
eight_bits HUGE *p;
3059
3060
@b
3061
if(C_LIKE(language))
3062
{
3063
MCHECK0(2,"end_C_meta");
3064
for(p=end_C_meta; *p; ) *mp++ = *p++;
3065
}
3066
else
3067
{
3068
MCHECK0(1,"end_meta");
3069
*mp++ = end_meta;
3070
}
3071
}
3072
3073
@
3074
@m IS_IT_CONSTANT(name)
3075
p = pargs[0] + 1;
3076
if(!(*p == constant || *p == stringg))
3077
{
3078
arg_must_be_constant(#name);
3079
return;
3080
}
3081
3082
@ Assert a preprocessor condition.
3083
@a
3084
SRTN
3085
i_assert_ FCN((n,pargs))
3086
int n C0("")@;
3087
PARGS pargs C1("")@;
3088
{
3089
eight_bits HUGE *p;
3090
eight_bits HUGE *pp;
3091
eight_bits HUGE *mp0;
3092
boolean e;
3093
3094
CHK_ARGS("$ASSERT",1);
3095
3096
pp = xmac_text(mp0=mp, p=pargs[0]+1, pargs[1]); // Expand the expression.
3097
e = eval(pp, mp);
3098
mp = mp0;
3099
3100
if(e)
3101
return;
3102
3103
mp = str_to_mb(p, pargs[1], YES);
3104
3105
MACRO_ERR("! $ASSERT(%s) failed",NO,to_outer((ASCII HUGE *)mp));
3106
FATAL(M, "", "Processing ABORTED!");
3107
}
3108
3109
@ Generate error message.
3110
@<Define internal...@>=
3111
3112
SAVE_MACRO("$ERROR(text)$$ERROR(#*text)");
3113
3114
@
3115
@a
3116
SRTN
3117
i_error_ FCN((n,pargs))
3118
int n C0("")@;
3119
PARGS pargs C1("")@;
3120
{
3121
eight_bits c;
3122
eight_bits HUGE *t, HUGE *p, HUGE *temp;
3123
3124
CHK_ARGS("$ERROR",1);
3125
3126
IS_IT_CONSTANT($ERROR);
3127
3128
temp = GET_MEM("_error_:temp",N_MSGBUF,eight_bits);
3129
3130
for(c=*p++,t=temp; *p != c; ) *t++ = *p++;
3131
*t = '\0';
3132
3133
MACRO_ERR("%cUSER ERROR: %s",NO, beep(1),to_outer((ASCII HUGE *)temp));
3134
FREE_MEM(temp,"_error_:temp",N_MSGBUF,eight_bits);
3135
}
3136
3137
@ The internal macro |$ROUTINE| generates a string containing the name of
3138
the current routine. This macro is associated with the internal function
3139
|_routine_|, below.
3140
3141
@<Define internal macros@>=
3142
3143
SAVE_MACRO("$ROUTINE $STRING($$ROUTINE)");
3144
3145
@ The internal function |_routine_| expands |cur_fcn| into the |macro_buf|.
3146
@a
3147
SRTN
3148
i_routine_ FCN((n,pargs))
3149
int n C0("")@;
3150
PARGS pargs C1("")@;
3151
{
3152
name_pointer np;
3153
CONST ASCII HUGE *f, HUGE *end;
3154
3155
CHK_ARGS("$ROUTINE",0);
3156
3157
if(!(is_RATFOR_(language))) return; // So far, only \Ratfor\ is active.
3158
if(!RAT_OK("")) CONFUSION("_routine_","Language shouldn't be Ratfor here");
3159
3160
if(cur_fcn == NO_FCN)
3161
{
3162
MCHECK0(1,"'?'");
3163
*mp++ = @'?';
3164
return;
3165
}
3166
3167
np = name_dir + cur_fcn;
3168
end = proper_end(np);
3169
3170
MCHECK0(end - np->byte_start,"_routine_");
3171
for(f = np->byte_start; f < end; )
3172
*mp++ = *f++;
3173
}
3174
3175
3176
@ Case conversion of macro argument.
3177
@<Define internal macros@>=
3178
3179
SAVE_MACRO("$L(name)$$LC(name)"); // Possibly expand the argument.
3180
3181
SAVE_MACRO("$U(name)$$UC(name)");
3182
3183
@
3184
@a
3185
SRTN
3186
i_lowercase_ FCN((n,pargs))
3187
int n C0("")@;
3188
PARGS pargs C1("")@;
3189
{
3190
eight_bits HUGE *p = pargs[0] + 1, HUGE *p1 = pargs[1];
3191
3192
CHK_ARGS("$LC",1);
3193
3194
if(*p != stringg)
3195
{
3196
MUST_QUOTE("$L",p,p1);
3197
return;
3198
}
3199
3200
MCHECK(p1 - p,"lowercase");
3201
3202
for( ; p<p1; p++)
3203
*mp++ = A_TO_LOWER(*p); // Watch out for side effects in |A_TO_LOWER|!
3204
}
3205
3206
SRTN
3207
i_uppercase_ FCN((n,pargs))
3208
int n C0("")@;
3209
PARGS pargs C1("")@;
3210
{
3211
eight_bits HUGE *p = pargs[0] + 1, HUGE *p1 = pargs[1];
3212
3213
CHK_ARGS("$UC",1);
3214
3215
if(*p != stringg)
3216
{
3217
MUST_QUOTE("$U",p,p1);
3218
return;
3219
}
3220
3221
MCHECK(p1 - p, "uppercase");
3222
3223
for( ; p<p1; p++)
3224
*mp++ = A_TO_UPPER(*p); // Watch out for side effects in |A_TO_LOWER|!
3225
}
3226
3227
@
3228
@<Define internal macros@>=
3229
3230
SAVE_MACRO("$NARGS(mname)$$NARGS(#!mname)");
3231
3232
@ Determining the number of fixed arguments.
3233
@a
3234
SRTN
3235
i_nargs_ FCN((n,pargs))
3236
int n C0("")@;
3237
PARGS pargs C1("")@;
3238
{
3239
text_pointer m;
3240
eight_bits *pa = pargs[0] + 1;
3241
3242
if((m=MAC_LOOKUP(IDENTIFIER(pa[0],pa[1]))) == NULL)
3243
{
3244
MACRO_ERR("! Argument of $NARGS is not a WEB macro",YES);
3245
put_long(-1L);
3246
}
3247
else put_long((long)m->nargs);
3248
}
3249
3250
@ Put a long integer into the macro buffer as a constant.
3251
@a
3252
SRTN
3253
put_long FCN((l))
3254
long l C1("")@;
3255
{
3256
outer_char temp[100];
3257
int n;
3258
3259
n = NSPRINTF(temp,"%ld",l);
3260
to_ASCII(temp);
3261
MCHECK(n+2,"long");
3262
*mp++ = constant;
3263
STRCPY(mp,temp);
3264
mp += n;
3265
*mp++ = constant;
3266
}
3267
3268
@ The code for checking the correct number of arguments in a built-in macro
3269
call isn't complete yet, since most of them go through an intermediate
3270
level of expansion.
3271
@a
3272
SRTN
3273
chk_args FCN((name,proper_num,actual_num,pargs))
3274
outer_char *name C0("")@;
3275
int proper_num C0("")@;
3276
int actual_num C0("")@;
3277
PARGS pargs C1("")@;
3278
{
3279
if(proper_num >= 0)
3280
{
3281
if(actual_num != proper_num)
3282
MACRO_ERR("Built-in macro %s should be called with %d \
3283
argument(s), not %d",NO,name,proper_num,actual_num);
3284
}
3285
}
3286
3287
@ This code is used for debugging; it displays the token list for a macro
3288
in a slightly translated form. This function can be called from the debugger.
3289
3290
@d MTEXT_SIZE 2500
3291
3292
@d SAVE_MTEXT(val) if(p < mtext_end) *p++ = (eight_bits)(val);
3293
else OVERFLW("Mtext","")@;
3294
3295
@a
3296
SRTN
3297
see_macro FCN((p0,p1))
3298
CONST eight_bits HUGE *p0 C0("Beginning of token list.")@;
3299
CONST eight_bits HUGE *p1 C1("End of token list.")@;
3300
{
3301
int k,l,num_tokens;
3302
ASCII HUGE *q0;
3303
sixteen_bits HUGE *tokens;
3304
ASCII HUGE *mtext;
3305
3306
num_tokens = PTR_DIFF(int, p1, p0); // Why is this |int|?
3307
3308
tokens = GET_MEM("see_macro:tokens",num_tokens,sixteen_bits);
3309
mtext = GET_MEM("see_macro:mtext",MTEXT_SIZE,ASCII);
3310
3311
k = rcvr_macro(mtext,tokens,p0,p1);
3312
3313
printf(">> \"");
3314
for(l=0; l<k; ++l)
3315
printf(_Xx("%x "),tokens[l]);
3316
3317
printf("\"\n== \"");
3318
for(q0=mtext; q0<mtext+k; ++q0)
3319
putchar(XCHR(*q0));
3320
puts("\"");
3321
3322
FREE_MEM(mtext,"see_macro:mtext",MTEXT_SIZE,ASCII);
3323
if(num_tokens) FREE_MEM(tokens,"see_macro:tokens",num_tokens,sixteen_bits);
3324
}
3325
3326
@ Translate a macro into readable form.
3327
@a
3328
int
3329
rcvr_macro FCN((mtext,tokens,p0,p1))
3330
ASCII HUGE *mtext C0("Holds readable translation of the text.")@;
3331
sixteen_bits HUGE *tokens C0("Slightly translated tokens.")@;
3332
CONST eight_bits HUGE *p0 C0("")@;
3333
CONST eight_bits HUGE *p1 C1("")@;
3334
{
3335
ASCII HUGE *mtext_end = mtext + MTEXT_SIZE;
3336
ASCII HUGE *p; // Current position in output text buffer.
3337
ASCII HUGE *j;
3338
int k;
3339
sixteen_bits a; // The current token.
3340
3341
for(k=0,p=mtext; p0 < p1; k++)
3342
{
3343
if(TOKEN1(a = *p0++))
3344
switch(a)
3345
{
3346
case paste:
3347
SAVE_MTEXT(@'#'); @+ SAVE_MTEXT(@'#');
3348
break;
3349
3350
default:
3351
SAVE_MTEXT(a);
3352
break;
3353
}
3354
else if(a == MACRO_ARGUMENT)
3355
{
3356
SAVE_MTEXT(@'$');
3357
a = (sixteen_bits)(-(*p0));
3358
SAVE_MTEXT(*p0++ + @'0'); // Only for 9 or less???
3359
}
3360
else
3361
{
3362
a = IDENTIFIER(a,*p0++);
3363
3364
if(a < MODULE_NAME)
3365
{
3366
CONST ASCII HUGE *end;
3367
name_pointer np = name_dir + a;
3368
3369
PROPER_END(end);
3370
3371
for(j=np->byte_start; j<end; ++j)
3372
{SAVE_MTEXT(*j);}
3373
}
3374
else
3375
{
3376
SAVE_MTEXT(@'M');
3377
}
3378
}
3379
3380
if(tokens) tokens[k] = a; // Should have special color marker for ids.
3381
}
3382
3383
return k;
3384
}
3385
3386
@ For manipulating the behavior of various macros, we set a global variable
3387
|xflag| with the aid of the |$XX| macro.
3388
@<Glob...@>=
3389
3390
int xflag = 1;
3391
3392
@
3393
@a
3394
SRTN
3395
i_xflag_ FCN((n,pargs))
3396
int n C0("")@;
3397
PARGS pargs C1("")@;
3398
{
3399
eight_bits HUGE *p = pargs[0] + 1;
3400
outer_char temp[100],*t=temp;
3401
3402
CHK_ARGS("$XX",1);
3403
3404
if(*p++ != constant)
3405
{
3406
MACRO_ERR("Argument of $XX is not a numerical constant",NO);
3407
return;
3408
}
3409
3410
while(*p != constant)
3411
*t++ = XCHR(*p++);
3412
3413
TERMINATE(t,0);
3414
3415
xflag = ATOI(temp);
3416
}
3417
3418
@
3419
@a
3420
SRTN
3421
i_dumpdef_ FCN((n,pargs))
3422
int n C0("")@;
3423
PARGS pargs C1("")@;
3424
{
3425
int k;
3426
eight_bits HUGE *p,HUGE *mp0,HUGE *mp1,HUGE *mp2;
3427
sixteen_bits a;
3428
extern long cur_val;
3429
eight_bits HUGE *q0,HUGE *q1;
3430
ASCII HUGE *mtext = GET_MEM("rcvr_macro:mtext",MTEXT_SIZE,ASCII);
3431
ASCII HUGE *mx, HUGE *mx0;
3432
name_pointer np;
3433
3434
CHK_ARGS("$DUMPDEF",INT_MIN);
3435
3436
for(k=0; k<n; k++)
3437
{ /* Print translation of $k^{{\rm th}}$ macro. */
3438
text_pointer m;
3439
3440
if(xflag)
3441
printf("\n");
3442
3443
mp0 = mp;
3444
3445
p = pargs[k] + 1; // Start of argument.
3446
3447
while(IS_WHITE(*p) || *p==@'\n') p++;
3448
3449
a = IDENTIFIER(*p,*(p+1));
3450
3451
if( (m=MAC_LOOKUP(a)) == NULL)
3452
{ /* Not a valid WEB macro. */
3453
str_to_mb(p,pargs[k+1],NO);
3454
printf("NOT WEB MACRO: %s\n",(char *)to_outer((ASCII *)mp0));
3455
}
3456
else
3457
@<Dump a valid \WEB\ macro@>@;
3458
3459
mp = mp0;
3460
}
3461
3462
FREE_MEM(mtext,"_dumpdef_:mtext",MTEXT_SIZE,ASCII);
3463
}
3464
3465
@
3466
@<Dump a valid...@>=
3467
{
3468
p += 2;
3469
3470
/* Copy the name. */
3471
np = name_dir + a;
3472
3473
for(mx=mtext,mx0=np->byte_start; mx0<(np+1)->byte_start; )
3474
*mx++ = *mx0++;
3475
3476
*mx++ = '\0';
3477
to_outer(mtext);
3478
3479
/* Translate the definition. */
3480
if(m->built_in)
3481
{
3482
cur_val = a;
3483
STRCPY(mp0,"<built-in>");
3484
mp = mp0 + STRLEN(mp0) + 1;
3485
}
3486
else
3487
{
3488
q0 = m->tok_start + m->moffset;
3489
q1 = m->tok_start + m->nbytes;
3490
3491
str_to_mb(q0,q1,NO);
3492
mp++;
3493
to_outer((ASCII *)mp0);
3494
}
3495
3496
/* Print the definition. */
3497
printf("%s", (char *)mtext);
3498
3499
if(m->nargs || m->var_args)
3500
{
3501
eight_bits n;
3502
3503
printf("(");
3504
for(n=0; n<m->nargs; n++)
3505
printf("$%d%s",(int)n,
3506
CHOICE(n==(eight_bits)(m->nargs-1), "", ","));
3507
if(m->var_args) printf("%s...",
3508
CHOICE(m->nargs,",",""));
3509
printf(")");
3510
}
3511
3512
printf(" = %s\n", (char *)(mp=mp0));
3513
3514
if(xflag)
3515
{
3516
/* Convert arguments to readable form. */
3517
mp0 = mp;
3518
str_to_mb(p,pargs[k+1],NO);
3519
mp++;
3520
to_outer((ASCII *)mp0);
3521
3522
/* Expand the macro. */
3523
mp1 = xmacro(m, &p, &pargs[k+1], NO, mp);
3524
*mp++ = '\0';
3525
mp2 = mp;
3526
str_to_mb(mp1,mp,NO);
3527
mp++;
3528
to_outer((ASCII *)mp2);
3529
3530
printf("%s%s = %s\n", (char *)mtext, (char *)mp0, (char *)(mp=mp2));
3531
3532
if(p != pargs[k+1])
3533
ERR_PRINT(M,"Extra text after macro call");
3534
}
3535
}
3536
3537
3538
@ The expansion of \.{\$KEYWORD(keyword)} is the text associated with the
3539
global keyword, which was declared between \.{@@z}\dots\.{@@x} like
3540
`\.{\$keyword:\ text\ \$}'.
3541
3542
@<Define internal...@>=
3543
3544
SAVE_MACRO("$KEYWORD(s)$$KEYWORD(#*s)");
3545
3546
SAVE_MACRO("$AUTHOR $KEYWORD(Author)");
3547
SAVE_MACRO("$DATE_TIME $KEYWORD(Date)");
3548
SAVE_MACRO("$HEADER $KEYWORD(Header)");
3549
SAVE_MACRO("$ID $KEYWORD(Id)");
3550
SAVE_MACRO("$LOCKER $KEYWORD(Locker)");
3551
SAVE_MACRO("$NAME $KEYWORD(Name)");
3552
SAVE_MACRO("$RCSFILE $KEYWORD(RCSfile)");
3553
SAVE_MACRO("$REVISION $KEYWORD(Revision)");
3554
SAVE_MACRO("$SOURCE $KEYWORD(Source)");
3555
SAVE_MACRO("$STATE $KEYWORD(State)");
3556
3557
@ The |i_keyword_| function is called during the output phase, when it is
3558
being sent a string delimited by |stringg|. It builds a
3559
|stringg|-delimited string into the macro buffer that is the contents of
3560
the relevant RCS-like keyword. As a nucleus, it calls |x_keyword|, which
3561
expands without the |stringg| delimiters.
3562
3563
@a
3564
SRTN
3565
i_keyword_ FCN((n, pargs))
3566
int n C0("")@;
3567
PARGS pargs C1("")@;
3568
{
3569
eight_bits HUGE *p = pargs[0] + 1, HUGE *p1 = pargs[1];
3570
3571
CHK_ARGS("$KEYWORD", 1);
3572
3573
if(*p != stringg)
3574
{
3575
MUST_QUOTE("$KEYWORD", p, p1);
3576
return;
3577
}
3578
3579
MCHECK(1, "stringg0");
3580
*mp++ = *p++;
3581
3582
x_keyword(&mp, macrobuf_end, p, p1-1, YES, YES, WEB_FILE);
3583
3584
MCHECK(1, "stringg1");
3585
*mp++ = stringg;
3586
}
3587
3588
@* INDEX.
Loggerhead is a web-based interface for Breezy
Version: 2.0.1