« back to all changes in this revision
Viewing changes to Web/macs.c
- 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.c
1
#if(0)
2
FTANGLE v1.60,\
3
created with UNIX on "Thursday, September 24, 1998 at 16:12." \
4
COMMAND LINE: "Web/ftangle Web/macs -A -# --F -= 1.62/Web/macs.c"\
5
RUN TIME: "Friday, September 25, 1998 at 8:02."\
6
WEB FILE: "Web/macs.web"\
7
CHANGE FILE: (none)
8
#endif
9
#define _MACS_h \
10
11
#define stringg (eight_bits)02 \
12
13
#define constant (eight_bits)03
14
#define begin_Xmeta or_or
15
#define end_Xmeta star_star
16
#define cdir (eight_bits)06
17
#define colon_colon (eight_bits)011 \
18
19
#define join (eight_bits)0177 \
20
21
#define ID0 0200
22
#define TOKEN1(a)((a)<ID0) \
23
24
#define MACRO_ARGUMENT 0377 \
25
26
#define BASE2 0400 \
27
28
#define MODULE_NAME 10240
29
#define MODULE_NUM 20480
30
#define LINE_NUM 53248L \
31
32
#define IDENTIFIER(left,right) \
33
((sixteen_bits)(((left)-ID0)*BASE2+(sixteen_bits)(right))) \
34
\
35
36
#define LEFT(a,id)((eight_bits)(((a)/BASE2+(id)))) \
37
38
#define RIGHT(a)((eight_bits)(((a)%BASE2))) \
39
40
#define ignore 0 \
41
42
#define begin_comment0 (eight_bits)0376
43
#define begin_comment1 (eight_bits)0375 \
44
45
#define module_number (eight_bits)0201
46
#define identifier (eight_bits)0202
47
#define id_keyword (eight_bits)0203 \
48
49
#define L_switch (eight_bits)0257
50
#define begin_FORTRAN (eight_bits)0260
51
#define begin_RATFOR (eight_bits)0261
52
#define begin_C (eight_bits)0262
53
#define begin_LITERAL (eight_bits)0263 \
54
55
#define verbatim (eight_bits)0264 \
56
\
57
58
#define invisible_cmnt (eight_bits)0265
59
#define compiler_directive (eight_bits)0266
60
#define Compiler_Directive (eight_bits)0267 \
61
62
#define keyword_name (eight_bits)0270 \
63
64
#define no_index (eight_bits)0300
65
#define yes_index (eight_bits)0301 \
66
67
#define ascii_constant (eight_bits)0302
68
#define begin_vcmnt (eight_bits)0303
69
#define big_line_break (eight_bits)0304 \
70
71
#define begin_bp (eight_bits)0305
72
#define insert_bp (eight_bits)0306 \
73
74
#define begin_meta (eight_bits)017
75
#define end_meta (eight_bits)027 \
76
77
#define TeX_string (eight_bits)0307
78
#define xref_roman (eight_bits)0310
79
#define xref_typewriter (eight_bits)0311
80
#define xref_wildcard (eight_bits)0312 \
81
82
#define control_text (eight_bits)0313 \
83
84
#define begin_nuweb (eight_bits)0314
85
#define no_mac_expand (eight_bits)0315
86
#define set_line_info (eight_bits)0316
87
#define short_fcn (eight_bits)0317 \
88
89
#define formatt (eight_bits)0320 \
90
91
#define limbo_text (eight_bits)0323
92
#define op_def (eight_bits)0324
93
#define macro_def (eight_bits)0325 \
94
95
#define ignore_defn (eight_bits)0327 \
96
97
#define new_output_file (eight_bits)0331 \
98
99
#define definition (eight_bits)0332
100
#define undefinition (eight_bits)0333
101
#define WEB_definition (eight_bits)0334 \
102
103
#define m_ifdef (eight_bits)0335
104
#define m_ifndef (eight_bits)0336
105
#define m_if (eight_bits)0337
106
#define m_else (eight_bits)0340
107
#define m_elif (eight_bits)0341
108
#define m_endif (eight_bits)0342
109
#define m_for (eight_bits)0343
110
#define m_endfor (eight_bits)0344
111
#define m_line (eight_bits)0345
112
#define m_undef (eight_bits)0346 \
113
114
#define end_of_buffer (eight_bits)0347 \
115
116
#define begin_code (eight_bits)0350
117
#define module_name (eight_bits)0351 \
118
119
#define new_module (eight_bits)0352 \
120
121
#define cur_end cur_state.end_field
122
#define cur_byte cur_state.byte_field
123
#define cur_name cur_state.name_field
124
#define cur_repl cur_state.repl_field
125
#define cur_mod cur_state.mod_field \
126
127
#define cur_language cur_state.language
128
#define cur_global_language cur_state.global_params.Language \
129
\
130
\
131
132
#define cur_params cur_state.params
133
#define cur_global_params cur_state.global_params \
134
\
135
136
#define macrobuf cur_state.macro_buf
137
#define cur_mp cur_state.mp
138
#define macrobuf_end cur_state.macro_buf_end \
139
140
#define BP_MARKER 1 \
141
142
#define PROPER_END(end) \
143
end= (np+1)->byte_start; \
144
if(*end==BP_MARKER&&np!=npmax)end= ((BP*)end)->byte_start \
145
146
#define MAX_ID_LENGTH 32 \
147
148
#define semi 01 \
149
150
#define SILENT (boolean)NO
151
#define COMPLAIN (boolean)YES \
152
153
#define OUTER_MACRO 0xFF
154
#define OUTER_UNMACRO 0xFE
155
#define UNDEFINED_MACRO 0xFD \
156
157
#define MAX_XLEVELS 200 \
158
159
#define equiv equiv_or_xref
160
#define EQUIV ASCII HUGE* \
161
\
162
\
163
164
#define MAC_LOOKUP(cur_val)(cur_val<MODULE_NAME? \
165
(text_pointer)(name_dir+(cur_val))->equiv:NULL) \
166
167
#define macro 0 \
168
\
169
\
170
\
171
172
#define NOT_DEFINED 0
173
#define DEFERRED_MACRO 1 \
174
175
#define IMMEDIATE_MACRO 2
176
#define FILE_NAME 3 \
177
\
178
179
#define MCHECK(n,reason)if(mp+(n)>macrobuf_end) \
180
mbuf_full((unsigned long)(n),(outer_char*)reason) \
181
182
#define MAKE_16(start)(((sixteen_bits)(*start)<<8)+(sixteen_bits)(*(start+1))) \
183
184
#define TYPE_DESCR_LEN 20 \
185
\
186
187
#define save_name(a){if(xids->level>=MAX_XLEVELS) \
188
{ \
189
\
190
macro_err(OC("! Macro inner recursion depth exceeded"),YES); \
191
\
192
fatal(ERR_M,OC("!! BYE."),OC("")); \
193
} \
194
xids->token[slevel= xids->level++]= a; \
195
} \
196
197
#define unsave_name xids->level= slevel \
198
199
#define DEFINED_ERR(s){ \
200
macro_err(OC(s),YES);goto done_expanding;} \
201
202
#define ERR_IF_DEFINED_AT_END if(p>=end) \
203
DEFINED_ERR("! `defined' ends prematurely") \
204
205
#define CUR_QUOTE ((eight_bits)(single_quote||(!double_quote&&R77_or_F)? \
206
047:042)) \
207
208
#define UNNAMED_MODULE 0
209
#define CPY_OP(token,trans)case token:cpy_op(OC(trans));break \
210
211
#define MUST_QUOTE(name,p,p1)must_quote(OC(name),p,p1) \
212
213
#define CHECK_QUOTE(var,n)if(*var++!=end_char) \
214
macro_err(OC("! Argument %d of \
215
$TRANSLIT doesn't begin with '%c'"),YES,n,end_char) \
216
217
#define N_ENVBUF 200 \
218
219
#define SAVE_ENV(aval)if(t<temp_end)*t++= XCHR(aval); \
220
else OVERFLW("Env_buf","") \
221
222
#define DOES_ARG_FOLLOW(c) \
223
if(*p0!=MACRO_ARGUMENT) \
224
{ \
225
\
226
macro_err(OC("! Macro token `#%c' must be followed by a parameter"),YES,c); \
227
break; \
228
} \
229
p0++ \
230
231
#define INS_ARG_LIST pargs,m,n,&p0,&pasting,&xpn_argument,last_was_paste \
232
233
#define STOP YES \
234
235
#define arg_must_be_constant(name) \
236
\
237
macro_err(OC("Argument of \"%s\" must be constant or string"),YES,name); \
238
239
#define MTEXT_SIZE 2500 \
240
241
#define SAVE_MTEXT(val)if(p<mtext_end)*p++= (eight_bits)(val); \
242
else OVERFLW("Mtext","") \
243
244
245
246
#include "typedefs.h"
247
248
249
250
251
252
253
#include "map.h"
254
255
256
257
258
typedef struct
259
{
260
eight_bits HUGE*tok_start;
261
262
sixteen_bits text_link;
263
boolean Language;
264
eight_bits nargs;
265
unsigned
266
moffset:8,
267
recursive:1,
268
var_args:1,
269
module_text:1,
270
built_in:1,
271
protected:1,
272
nbytes:19;
273
}text;
274
275
typedef text HUGE*text_pointer;
276
277
278
279
typedef struct{
280
eight_bits HUGE*end_field;
281
eight_bits HUGE*byte_field;
282
name_pointer name_field;
283
text_pointer repl_field;
284
sixteen_bits mod_field;
285
PARAMS global_params,params;
286
eight_bits HUGE*macro_buf,HUGE*mp,HUGE*macro_buf_end;
287
288
}output_state;
289
290
typedef output_state HUGE*stack_pointer;
291
292
293
294
295
typedef enum{BAD_TOKEN,OR_OR,AND_AND,BIT_OR,BIT_XOR,BIT_AND,LOG_EQ,LOG_LT,
296
BIT_SHIFT,PLUS_MINUS,TIMES,EXP,UNARY,HIGHEST_UNARY}PRECEDENCE;
297
298
299
typedef struct
300
{
301
eight_bits token;
302
PRECEDENCE precedence;
303
}OP;
304
305
306
typedef union
307
{
308
long i;
309
double d;
310
sixteen_bits id;
311
OP op;
312
}VALUE;
313
314
315
316
typedef enum{Int,Double,Id,Op}TYPE;
317
318
319
320
typedef struct val
321
{
322
VALUE value;
323
TYPE type;
324
struct val HUGE*last,HUGE*next;
325
}VAL;
326
327
328
329
#if(0)
330
IN_COMMON boolean truncate_ids;
331
IN_COMMON unsigned short tr_max[];
332
IN_COMMON name_pointer npmax;
333
#endif
334
335
336
typedef struct Bp
337
{
338
ASCII c;
339
LANGUAGE Language;
340
CONST ASCII HUGE*byte_start,HUGE*byte_end;
341
342
struct Bp HUGE*next;
343
344
struct Trunc HUGE*Root;
345
}BP;
346
347
348
typedef struct Trunc
349
{
350
boolean Language;
351
size_t num[NUM_LANGUAGES];
352
353
ASCII HUGE*id,HUGE*id_end;
354
BP HUGE*first,HUGE*last;
355
struct Trunc HUGE*next;
356
}TRUNC;
357
358
359
360
361
typedef struct
362
{
363
sixteen_bits token[MAX_XLEVELS];
364
int level;
365
}XIDS;
366
367
368
369
typedef struct
370
{
371
const char*name;
372
int len;
373
SRTN(*expnd)PROTO((int,unsigned char**));
374
375
376
377
boolean Language;
378
eight_bits nargs;
379
boolean var_args;
380
boolean recursive;
381
sixteen_bits id;
382
}INTERNAL_FCN;
383
384
385
386
387
#include "t_type.h"
388
389
390
391
392
393
394
395
#ifdef SMALL_MEMORY
396
#define N_MSGBUF 2000
397
#else
398
#define N_MSGBUF 10000
399
#endif
400
401
402
403
404
405
EXTERN long max_texts;
406
EXTERN text HUGE*text_info;
407
EXTERN text_pointer text_end;
408
409
EXTERN long dtexts_max;
410
EXTERN text HUGE*txt_dinfo;
411
EXTERN text_pointer textd_end;
412
413
EXTERN text_pointer text_ptr,txt_dptr;
414
415
416
EXTERN long max_toks;
417
EXTERN eight_bits HUGE*tok_mem;
418
EXTERN eight_bits HUGE*tok_m_end;
419
420
EXTERN long max_dtoks;
421
EXTERN eight_bits HUGE*tok_dmem;
422
EXTERN eight_bits HUGE*tokd_end;
423
424
EXTERN eight_bits HUGE*tok_ptr,HUGE*tok_dptr;
425
426
EXTERN eight_bits HUGE*mx_tok_ptr,HUGE*mx_dtok_ptr;
427
428
429
EXTERN text_pointer macro_text;
430
431
432
433
EXTERN output_state cur_state;
434
435
436
EXTERN long stck_size;
437
EXTERN output_state HUGE*stack;
438
EXTERN stack_pointer stck_end;
439
EXTERN stack_pointer stck_ptr;
440
441
442
443
IN_COMMON STMT_LBL max_stmt;
444
445
EXTERN sixteen_bits outp_line[NUM_LANGUAGES]
446
#ifdef _FTANGLE_h
447
#if(part == 0 || part == 1)
448
= {1,1,1,1,1,1,1,1}
449
#endif
450
#endif
451
;
452
453
454
455
IN_COMMON sixteen_bits HUGE*args;
456
457
IN_COMMON BUF_SIZE max_margs;
458
459
460
461
INTERNAL_FCN internal_fcns[]= {
462
{"$$ASCII",0,i_ascii_,0xF,1,NO,NO},
463
{"$ASSERT",0,i_assert_,0xF,1,NO,NO},
464
{"$$CONST",0,i_const_,0xF,2,YES,NO},
465
{"$DEFINE",0,i_define_,0xF,1,NO,NO},
466
{"_DUMPDEF",0,i_dumpdef_,0xF,0,YES,NO},
467
{"$DUMPDEF",0,i_dumpdef_,0xF,0,YES,NO},
468
{"$$ERROR",0,i_error_,0xF,1,NO,NO},
469
{"$$EVAL",0,i_eval_,0xF,1,NO,NO},
470
{"$$GETENV",0,i_getenv_,0xF,1,NO,NO},
471
{"$IF",0,i_if_,0xF,3,NO,YES},
472
{"$IFCASE",0,i_ifcase_,0xF,1,YES,YES},
473
{"$IFDEF",0,i_ifdef_,0xF,3,NO,YES},
474
{"$IFNDEF",0,i_ifndef_,0xF,3,NO,YES},
475
{"$IFELSE",0,i_ifelse_,0xF,4,NO,YES},
476
{"_INPUT_LINE",0,i_inp_line_,0xF,0,NO,NO},
477
{"$INPUT_LINE",0,i_inp_line_,0xF,0,NO,NO},
478
{"$$KEYWORD",0,i_keyword_,0xF,1,NO,NO},
479
{"_LANGUAGE",0,i_lang_,0xF,0,NO,NO},
480
{"$LANGUAGE",0,i_lang_,0xF,0,NO,NO},
481
{"$$LC",0,i_lowercase_,0xF,1,NO,NO},
482
{"$$LEN",0,i_len_,0xF,1,NO,NO},
483
{"$$LOG",0,i_log_,0xF,2,NO,NO},
484
{"_LANGUAGE_NUM",0,i_lnum_,0xF,0,NO,NO},
485
{"$LANGUAGE_NUM",0,i_lnum_,0xF,0,NO,NO},
486
{"$M",0,i_define_,0xF,1,NO,NO},
487
{"$$META",0,i_meta_,0xF,1,NO,NO},
488
{"$$MIN_MAX",0,i_min_max_,0xF,2,YES,NO},
489
{"$$MODULE_NAME",0,i_mod_name_,0xF,0,NO,NO},
490
{"$$MODULES",0,i_modules_,0xF,1,NO,NO},
491
{"$$NARGS",0,i_nargs_,0xF,1,NO,NO},
492
{"_OUTPUT_LINE",0,i_outp_line_,0xF,0,NO,NO},
493
{"$OUTPUT_LINE",0,i_outp_line_,0xF,0,NO,NO},
494
{"$$ROUTINE",0,i_routine_,RATFOR,0,NO,NO},
495
{"_SECTION_NUM",0,i_sect_num_,0xF,0,NO,NO},
496
{"$SECTION_NUM",0,i_sect_num_,0xF,0,NO,NO},
497
{"$$SWITCH",0,i_switch_,0,0,NO,NO},
498
{"$$TM",0,i_tm_,0xF,1,NO,NO},
499
{"$$TRANSLIT",0,i_translit_,0xF,3,NO,NO},
500
{"$UNDEF",0,i_undef_,0xF,1,NO,NO},
501
{"$$UNSTRING",0,i_unstring_,0xF,1,NO,NO},
502
{"$$UC",0,i_uppercase_,0xF,1,NO,NO},
503
{"$$VERBATIM",0,i_verbatim_,0xF,1,NO,NO},
504
{"$$VERSION",0,i_version_,0xF,0,NO,NO},
505
{"_XX",0,i_xflag_,0xF,1,NO,NO},
506
{"$XX",0,i_xflag_,0xF,1,NO,NO},
507
{"",0,NULL}
508
};
509
510
511
SRTN
512
ini_internal_fcns(VOID)
513
{
514
INTERNAL_FCN HUGE*s;
515
name_pointer np;
516
text_pointer m;
517
518
for(s= internal_fcns;(s->len= STRLEN(s->name))!=0;s++)
519
{
520
ASCII HUGE*p= x_to_ASCII(OC(s->name));
521
522
s->id= ID_NUM_ptr(np,p,p+s->len);
523
524
np->equiv= (ASCII HUGE*)(m= text_ptr++);
525
np->macro_type= IMMEDIATE_MACRO;
526
527
m->tok_start= (eight_bits HUGE*)s->expnd;
528
m->nbytes= 0;
529
m->text_link= macro;
530
m->Language= s->Language;
531
m->nargs= s->nargs;
532
m->recursive= s->recursive;
533
m->var_args= s->var_args;
534
m->module_text= NO;
535
m->built_in= YES;
536
m->protected= YES;
537
}
538
539
540
541
text_ptr->tok_start= tok_mem;
542
}
543
544
545
546
IN_TANGLE text_pointer cur_text;
547
IN_TANGLE LINE_NUMBER nearest_line;
548
549
550
551
XIDS HUGE*pids[MAX_XLEVELS];
552
int xlevel= 0;
553
554
555
556
static boolean keep_intact;
557
IN_COMMON boolean single_quote,double_quote;
558
559
560
OUTPUT_STATE copy_state;
561
562
563
564
int xflag= 1;
565
566
567
568
569
570
571
572
SRTN
573
predefine_macros(VOID)
574
{
575
new_mbuf();
576
577
578
579
SAVE_MACRO("$DEFINED(macro)$EVAL(defined #!macro)");
580
581
582
583
SAVE_MACRO("$ABS(a)$IF((a) > 0,$EVAL(a),$EVAL(-(a)))");
584
585
586
587
SAVE_MACRO("$STRING(expr)$STRING0(`expr`)");
588
589
590
SAVE_MACRO("$STRING0(expr)#*expr");
591
592
593
594
SAVE_MACRO("$LEN(s)$$LEN(#*s)");
595
596
597
598
SAVE_MACRO("$VERBATIM(s)$$VERBATIM(s)");
599
600
SAVE_MACRO("$UNQUOTE(s)$$VERBATIM(s)");
601
602
SAVE_MACRO("$P $VERBATIM($IF($LANGUAGE_NUM==2 || $LANGUAGE_NUM==4, \
603
'#', \"#\"))");
604
605
SAVE_MACRO("$PP $UNSTRING($P)");
606
607
608
609
SAVE_MACRO("$UNSTRING(s)$$UNSTRING(s)");
610
611
612
613
SAVE_MACRO("$TRANSLIT(s,from,to)$$TRANSLIT(#*s,#*from,#*to)");
614
615
616
617
618
SAVE_MACRO("$GETENV(var)$STRING($$GETENV(#*var))");
619
620
SAVE_MACRO("$HOME $GETENV(HOME)");
621
622
623
624
625
SAVE_MACRO("$COMMENT(cmnt)$$META(#*cmnt)");
626
627
628
629
SAVE_MACRO("$ERROR(text)$$ERROR(#*text)");
630
631
632
633
SAVE_MACRO("$ROUTINE $STRING($$ROUTINE)");
634
635
636
637
SAVE_MACRO("$L(name)$$LC(name)");
638
639
SAVE_MACRO("$U(name)$$UC(name)");
640
641
642
643
SAVE_MACRO("$NARGS(mname)$$NARGS(#!mname)");
644
645
646
647
SAVE_MACRO("$KEYWORD(s)$$KEYWORD(#*s)");
648
649
SAVE_MACRO("$AUTHOR $KEYWORD(Author)");
650
SAVE_MACRO("$DATE_TIME $KEYWORD(Date)");
651
SAVE_MACRO("$HEADER $KEYWORD(Header)");
652
SAVE_MACRO("$ID $KEYWORD(Id)");
653
SAVE_MACRO("$LOCKER $KEYWORD(Locker)");
654
SAVE_MACRO("$NAME $KEYWORD(Name)");
655
SAVE_MACRO("$RCSFILE $KEYWORD(RCSfile)");
656
SAVE_MACRO("$REVISION $KEYWORD(Revision)");
657
SAVE_MACRO("$SOURCE $KEYWORD(Source)");
658
SAVE_MACRO("$STATE $KEYWORD(State)");
659
660
;
661
662
t_macros();
663
e_macros();
664
}
665
666
667
SRTN
668
new_mbuf(VOID)
669
{
670
mp= cur_mp= macrobuf= GET_MEM("macrobuf",mbuf_size,eight_bits);
671
macrobuf_end= macrobuf+mbuf_size;
672
}
673
674
675
eight_bits HUGE*
676
argize FCN((start,end))
677
eight_bits HUGE*start C0("Beginning of the raw tokens.")
678
eight_bits HUGE*end C1("End.")
679
{
680
eight_bits k,l;
681
eight_bits HUGE*p,HUGE*last2,HUGE*start0;
682
boolean var_args;
683
684
start0= start;
685
686
if(TOKEN1(*start))
687
{
688
689
err0_print(ERR_M,OC("! Macro must start with identifier"),0);
690
691
return end;
692
}
693
694
695
696
start= get_dargs(start,end,args,&k,&var_args);
697
cur_text->moffset= (unsigned char)(start-start0);
698
699
700
cur_text->nargs= k;
701
cur_text->var_args= var_args;
702
703
704
for(last2= p= start;p<end;p++)
705
{
706
if(TOKEN1(*p))
707
switch(*p)
708
{
709
case 043:
710
711
{
712
int n;
713
eight_bits HUGE*q= p;
714
outer_char*tmp;
715
size_t i;
716
717
if(*(p+1)!=constant)continue;
718
719
p+= 2;
720
721
for(i= 0;p[i]!=constant;i++)
722
;
723
724
tmp= GET_MEM("var arg buf",i+1,outer_char);
725
726
for(i= 0;p[i]!=constant;i++)
727
tmp[i]= XCHR(p[i]);
728
tmp[i+1]= '\0';
729
730
n= ATOI(tmp);
731
732
733
734
FREE_MEM(tmp,"var arg buf",i+1,outer_char);
735
736
if(!var_args)
737
macro_err(OC("! #%d may only be used with variable-argument \
738
macros"),YES,n);
739
740
while(*p!=constant)*p++= ignore;
741
742
if(n<0)
743
macro_err(OC("! #%d is not allowed"),YES,n);
744
else if(n==0)
745
*(q+1)= 060;
746
747
else
748
{
749
*q= MACRO_ARGUMENT;
750
*(q+1)= (eight_bits)(k+(eight_bits)(n-1));
751
752
}
753
754
last2= p;
755
*p= ignore;
756
}
757
758
759
continue;
760
761
case dot_const:
762
case begin_language:
763
p++;
764
765
default:
766
continue;
767
}
768
769
770
771
if(*p==0320&&*(p+1)==0)
772
p+= 5;
773
else
774
for(l= 0;l<k;++l)
775
776
777
if(args[l]>>8==*p&&(args[l]&0x00FF)==*(p+1))
778
{
779
*p= MACRO_ARGUMENT;
780
*(p+1)= l;
781
782
break;
783
}
784
785
last2= ++p;
786
787
788
}
789
790
791
792
for(last2++;p>last2;)
793
if(*(p-1)==012||*(p-1)==040)
794
p--;
795
else
796
break;
797
798
;
799
return p;
800
}
801
802
803
eight_bits HUGE*
804
get_dargs FCN((start,end,args,n,pvar_args))
805
eight_bits HUGE*start C0("Start of token string.")
806
eight_bits HUGE*end C0("End of token string.")
807
sixteen_bits HUGE*args C0("Array of argument tokens, to be returned.")
808
eight_bits*n C0("Number of arguments found.")
809
boolean*pvar_args C1("Return whether variable arguments")
810
{
811
eight_bits k;
812
sixteen_bits id_token;
813
814
*pvar_args= NO;
815
816
id_token= IDENTIFIER(*start,*(start+1));
817
start+= 2;
818
819
*n= 0;
820
821
if(start==end)
822
return end;
823
824
if(*start!=050)
825
{
826
while(start!=end&&*start==040)
827
start++;
828
829
return start;
830
}
831
832
833
for(k= 0,++start;start!=end&&*start!=051;++k)
834
{
835
if(TOKEN1(*start))
836
{
837
838
839
if(*start==ellipsis)
840
{
841
if(*++start!=051)
842
err0_print(ERR_M,OC("Expected ')' after ellipsis"),0);
843
else*pvar_args= YES;
844
845
break;
846
}
847
848
849
850
851
err0_print(ERR_M,OC("Invalid macro parameter in definition of macro \
852
\"%s\". Token %s is invalid; \
853
can only have identifiers and commas between (...)"),2,name_of(id_token),type1(*start));
854
return start;
855
}
856
857
if(k>=(eight_bits)max_margs)
858
mac_args(id_token);
859
860
args[k]= MAKE_16(start);
861
862
start+= 2;
863
864
865
if(*start==054)
866
start++;
867
}
868
869
870
*n= k;
871
872
if(start==end)
873
{
874
875
err0_print(ERR_M,OC("Missing right paren in definition of macro \"%s\""),1,name_of(id_token));
876
return end;
877
}
878
879
880
881
if(*start==051&&k==0&&!*pvar_args)
882
args[k++]= 0;
883
884
return start+1;
885
}
886
887
888
SRTN
889
mac_args FCN((id_token))
890
sixteen_bits id_token C1("")
891
{
892
char temp[200];
893
894
sprintf(temp,"arguments to macro \"%s\"",(char*)name_of(id_token));
895
OVERFLW(temp,"ma");
896
}
897
898
899
outer_char*
900
type1 FCN((c))
901
eight_bits c C1("")
902
{
903
outer_char*p= NULL;
904
static outer_char type_descr[TYPE_DESCR_LEN];
905
906
if(isprint(XCHR(c)))
907
{
908
if(
909
nsprintf(type_descr,OC("'%c'"),1,XCHR(c))>=(int)(TYPE_DESCR_LEN))OVERFLW("type_descr","");}
910
911
else
912
{
913
switch(c)
914
{
915
case constant:
916
p= OC("constant");break;
917
918
case stringg:
919
p= OC("string");break;
920
921
case 012:
922
p= OC("newline");break;
923
}
924
925
if(p)
926
{
927
if(
928
nsprintf(type_descr,OC("'%s'"),1,p)>=(int)(TYPE_DESCR_LEN))OVERFLW("type_descr","");}
929
930
else
931
{
932
if(
933
nsprintf(type_descr,OC("0x%x"),1,c)>=(int)(TYPE_DESCR_LEN))OVERFLW("type_descr","");}
934
935
}
936
937
return type_descr;
938
}
939
940
941
eight_bits HUGE*
942
get_margs0 FCN((start,end,pcur_byte,pthe_end,multilevels,
943
var_args,pargs,n))
944
eight_bits HUGE*start C0("Beginning of the tokens for this \
945
macro call.")
946
eight_bits HUGE*end C0("Maximum possible end.")
947
eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
948
eight_bits HUGE**pthe_end C0("End of the current buffer.")
949
boolean multilevels C0("")
950
boolean var_args C0("Does macro have variable arguments?")
951
PARGS pargs C0("Array of pointers to the actual arguments, \
952
to be returned.")
953
eight_bits*n C1("Number of arguments found.")
954
{
955
eight_bits k;
956
int bal,bbal;
957
boolean mac_protected;
958
sixteen_bits id_token;
959
960
id_token= IDENTIFIER(*start,*(start+1));
961
start+= 2;
962
963
964
if(start==end&&pthe_end!=NULL)
965
end= args_to_macrobuf(end,pcur_byte,pthe_end,multilevels,var_args);
966
967
968
if(start==end||*start!=050)
969
{
970
return pargs[*n= 0]= start;
971
972
}
973
974
pargs[k= 0]= start++;
975
976
977
978
979
980
bal= 1;
981
bbal= 0;
982
mac_protected= NO;
983
984
while(start<end)
985
{
986
eight_bits c= *start;
987
988
if(TOKEN1(c))
989
{
990
switch(c)
991
{
992
case 043:
993
if(start+1<end&&*(start+1)==054)
994
{
995
*start= '\0';
996
start+= 2;
997
continue;
998
}
999
break;
1000
1001
case constant:
1002
case stringg:
1003
for(start++;*start++!=c;);
1004
continue;
1005
1006
case dot_const:
1007
case begin_language:
1008
start+= 2;
1009
continue;
1010
1011
case 0140:
1012
mac_protected= BOOLEAN(!mac_protected);
1013
*start++= '\0';
1014
1015
continue;
1016
1017
1018
1019
case 050:
1020
bal++;
1021
break;
1022
1023
case 051:
1024
if(bal==0)
1025
1026
macro_err(OC("Unexpected ')' in macro argument"),YES);
1027
else if(bal>0)bal--;
1028
break;
1029
1030
case 0133:
1031
bbal++;
1032
break;
1033
1034
case 0135:
1035
if(bbal==0)
1036
1037
macro_err(OC("Unexpected ']' in macro argument"),YES);
1038
else if(bbal>0)bbal--;
1039
break;
1040
}
1041
1042
if(!mac_protected&&((bal==1&&bbal==0&&(c==054))
1043
||bal==0))
1044
{
1045
1046
if(++k>=max_margs)
1047
mac_args(id_token);
1048
1049
pargs[k]= start++;
1050
1051
if(bal==0)break;
1052
}
1053
else start++;
1054
}
1055
else
1056
start+= (c<0250?2:4+4*1);
1057
1058
}
1059
1060
*n= k;
1061
return start;
1062
}
1063
1064
1065
void HUGE*
1066
mac_lookup FCN((cur_val))
1067
sixteen_bits cur_val C1("Current id token.")
1068
{
1069
return(void*)MAC_LOOKUP(cur_val);
1070
}
1071
1072
1073
1074
SRTN
1075
i_ifdef_ FCN((n,pargs))
1076
int n C0("")
1077
PARGS pargs C1("")
1078
{
1079
text_pointer m;
1080
sixteen_bits id;
1081
eight_bits HUGE*p0= pargs[0]+1;
1082
boolean e;
1083
1084
CHK_ARGS("$IFDEF",3);
1085
1086
if(TOKEN1(*p0))
1087
{
1088
1089
macro_err(OC("! First argument of $IFDEF or $IFNDEF must be a macro"),YES);
1090
return;
1091
}
1092
1093
id= IDENTIFIER(p0[0],p0[1]);
1094
e= ((m= mac_lookup(id))!=NULL&&!(m->built_in));
1095
1096
if(e)
1097
{MCHECK(pargs[2]-pargs[1]-1,"ifdef");
1098
for(p0= pargs[1]+1;p0<pargs[2];)*mp++= *p0++;}
1099
else
1100
{MCHECK(pargs[3]-pargs[2]-1,"ifdef");
1101
for(p0= pargs[2]+1;p0<pargs[3];)*mp++= *p0++;}
1102
}
1103
1104
SRTN
1105
i_ifndef_ FCN((n,pargs))
1106
int n C0("")
1107
PARGS pargs C1("")
1108
{
1109
text_pointer m;
1110
sixteen_bits id;
1111
eight_bits HUGE*p0= pargs[0]+1;
1112
boolean e;
1113
1114
CHK_ARGS("$IFDEF",3);
1115
1116
if(TOKEN1(*p0))
1117
{
1118
1119
macro_err(OC("! First argument of $IFDEF or $IFNDEF must be a macro"),YES);
1120
return;
1121
}
1122
1123
id= IDENTIFIER(p0[0],p0[1]);
1124
e= ((m= mac_lookup(id))!=NULL&&!(m->built_in));
1125
1126
if(!e)
1127
{MCHECK(pargs[2]-pargs[1]-1,"ifndef");
1128
for(p0= pargs[1]+1;p0<pargs[2];)*mp++= *p0++;}
1129
else
1130
{MCHECK(pargs[3]-pargs[2]-1,"ifndef");
1131
for(p0= pargs[2]+1;p0<pargs[3];)*mp++= *p0++;}
1132
}
1133
1134
1135
SRTN
1136
i_ifelse_ FCN((n,pargs))
1137
int n C0("")
1138
PARGS pargs C1("")
1139
{
1140
eight_bits HUGE*p0;
1141
eight_bits HUGE*pp0,HUGE*pp1,HUGE*mp0,HUGE*mp1;
1142
boolean args_identical= YES;
1143
1144
CHK_ARGS("$IFELSE",4);
1145
1146
pp0= xmac_text(mp0= mp,pargs[0]+1,pargs[1]);
1147
mp1= mp;
1148
1149
pp1= xmac_text(mp,pargs[1]+1,pargs[2]);
1150
1151
1152
1153
1154
if(mp-pp1!=mp1-pp0)
1155
args_identical= NO;
1156
else
1157
while(pp0<mp1)
1158
if(*pp0++!=*pp1++)
1159
args_identical= NO;
1160
1161
mp= mp0;
1162
1163
if(args_identical)
1164
{MCHECK(pargs[3]-pargs[2]-1,"_ifelse_");
1165
for(p0= pargs[2]+1;p0<pargs[3];)*mp++= *p0++;}
1166
else
1167
{MCHECK(pargs[4]-pargs[3]-1,"_ifelse_");
1168
for(p0= pargs[3]+1;p0<pargs[4];)*mp++= *p0++;}
1169
}
1170
1171
1172
SRTN
1173
i_if_ FCN((n,pargs))
1174
int n C0("")
1175
PARGS pargs C1("")
1176
{
1177
eight_bits HUGE*pp;
1178
eight_bits HUGE*mp0;
1179
eight_bits HUGE*p0;
1180
boolean e;
1181
1182
CHK_ARGS("$IF",3);
1183
1184
pp= xmac_text(mp0= mp,p0= pargs[0]+1,pargs[1]);
1185
e= eval(pp,mp);
1186
mp= mp0;
1187
1188
if(e)
1189
{MCHECK(pargs[2]-pargs[1]-1,"_if_");
1190
for(p0= pargs[1]+1;p0<pargs[2];)*mp++= *p0++;}
1191
else
1192
{MCHECK(pargs[3]-pargs[2]-1,"_if_");
1193
for(p0= pargs[2]+1;p0<pargs[3];)*mp++= *p0++;}
1194
}
1195
1196
1197
SRTN
1198
i_ifcase_ FCN((n,pargs))
1199
int n C0("Total number of arguments")
1200
PARGS pargs C1("")
1201
{
1202
eight_bits HUGE*pp;
1203
eight_bits HUGE*mp0;
1204
int ncase;
1205
1206
CHK_ARGS("$IFCASE",-1);
1207
pp= xmac_text(mp0= mp,pargs[0]+1,pargs[1]);
1208
ncase= neval(pp,mp);
1209
mp= mp0;
1210
copy_nth_arg(ncase,n-3,pargs);
1211
}
1212
1213
1214
SRTN
1215
copy_nth_arg FCN((n0,n,pargs))
1216
int n0 C0("Should be a non-negative integer")
1217
int n C0("Cases are numbered 0--n, default")
1218
PARGS pargs C1("")
1219
{
1220
eight_bits HUGE*p0;
1221
1222
if(n0<0||n0>n)n0= n+1;
1223
1224
n0++;
1225
MCHECK(pargs[n0+1]-pargs[n0]-1,"copy_nth_arg");
1226
for(p0= pargs[n0]+1;p0<pargs[n0+1];)*mp++= *p0++;
1227
}
1228
1229
1230
SRTN
1231
i_switch_ FCN((n,pargs))
1232
int n C0("")
1233
PARGS pargs C1("")
1234
{}
1235
1236
1237
SRTN
1238
undef FCN((cur_val,warning))
1239
sixteen_bits cur_val C0("Token to be undefined.")
1240
boolean warning C1("Complain is there's an error?")
1241
{
1242
name_pointer np= name_dir+cur_val;
1243
text_pointer m;
1244
1245
if(np->macro_type==NOT_DEFINED)
1246
{
1247
if(warning)
1248
1249
macro_err(OC("WARNING: \"%s\" is already undefined"),YES,name_of(cur_val));
1250
1251
return;
1252
}
1253
1254
1255
if(np->equiv==NULL)
1256
{
1257
if(np->macro_type==IMMEDIATE_MACRO)
1258
{
1259
1260
macro_err(OC("Attempting to @#undef deferred macro \"%s\" \
1261
during phase 1; consider using $UNDEF(%s)"),YES,name_of(cur_val),name_of(cur_val));
1262
}
1263
else
1264
{
1265
1266
macro_err(OC("Missing equivalence field while undefining \"%s\"; \
1267
this shouldn't happen!"),YES,name_of(cur_val));
1268
1269
np->macro_type= NOT_DEFINED;
1270
}
1271
1272
return;
1273
}
1274
1275
np->macro_type= NOT_DEFINED;
1276
1277
m= (text_pointer)np->equiv;
1278
m->nargs= UNDEFINED_MACRO;
1279
FREE(m->tok_start);
1280
m->nbytes= m->moffset= 0;
1281
1282
np->equiv= NULL;
1283
}
1284
1285
1286
boolean recursive_name FCN((a,xids,last_level))
1287
sixteen_bits a C0("")
1288
XIDS HUGE*xids C0("")
1289
int last_level C1("")
1290
{
1291
int i;
1292
1293
1294
for(i= 0;i<last_level;i++)
1295
if(xids->token[i]==a)return YES;
1296
1297
return NO;
1298
}
1299
1300
1301
1302
SRTN
1303
macro_err FCN(VA_ALIST((s,trail VA_ARGS)))
1304
VA_DCL(
1305
CONST outer_char s[]C0("Error message about macro expansion.")
1306
int trail C2("Do we print out the expansion trail?"))
1307
{
1308
VA_LIST(arg_ptr)
1309
outer_char HUGE*temp,HUGE*temp1,HUGE*t,HUGE*near_line;
1310
int i,ntemp;
1311
#if(NUM_VA_ARGS == 1)
1312
CONST outer_char s[];
1313
int trail;
1314
#endif
1315
1316
1317
temp= GET_MEM("macro_err:temp",N_MSGBUF,outer_char);
1318
temp1= GET_MEM("macro_err:temp1",N_MSGBUF,outer_char);
1319
near_line= GET_MEM("macro_err:near_line",N_MSGBUF,outer_char);
1320
1321
VA_START(arg_ptr,trail);
1322
1323
#if(NUM_VA_ARGS==1)
1324
{
1325
char*fmt0= va_arg(arg_ptr,char*);
1326
1327
va_arg(arg_ptr,int);
1328
vsprintf((char*)(char*)temp1,fmt0,arg_ptr);
1329
}
1330
#else
1331
vsprintf((char*)temp1,(CONST char*)s,arg_ptr);
1332
#endif
1333
va_end(arg_ptr);
1334
1335
if(phase==2)
1336
1337
if(
1338
nsprintf(near_line,OC("; near input l. %u"),1,nearest_line)>=(int)(N_MSGBUF))OVERFLW("near_line","");
1339
1340
1341
1342
1343
1344
1345
if(
1346
nsprintf(temp,OC("\"%s. (%s l. %u in %s%s.) %s"),6,temp1,phase==1?"Input":"Output",phase==1?cur_line:OUTPUT_LINE,phase==1?cur_file_name:params.OUTPUT_FILE_NAME,near_line,trail&&(xlevel>0)?"Expanding ":"")>=(int)(N_MSGBUF))OVERFLW("temp","");
1347
1348
t= temp+STRLEN(temp);
1349
1350
1351
1352
if(trail&&(xlevel>0))
1353
for(i= 0;i<1;i++)
1354
see_xlevel(&t,pids[i]);
1355
1356
ntemp= STRLEN(temp);
1357
temp[ntemp]= '"';
1358
temp[ntemp+1]= '\0';
1359
1360
1361
OUT_MSG(to_ASCII(temp),NULL);
1362
1363
1364
temp[ntemp]= '\0';
1365
printf("\n%s\n",(char*)to_outer((ASCII HUGE*)temp)+1);
1366
1367
mark_harmless;
1368
1369
FREE_MEM(temp,"macro_err:temp",N_MSGBUF,outer_char);
1370
FREE_MEM(temp1,"macro_err:temp1",N_MSGBUF,outer_char);
1371
FREE_MEM(near_line,"macro_err:near_line",N_MSGBUF,outer_char);
1372
}
1373
1374
1375
SRTN
1376
see_xlevel FCN((pt,p))
1377
outer_char HUGE**pt C0("")
1378
XIDS HUGE*p C1("")
1379
{
1380
int i,level;
1381
1382
level= p->level;
1383
1384
for(i= 0;i<level;
1385
i++,sprintf((char*)(*pt),"%s",i==level?". ":", "),(*pt)+= 2)
1386
prn_mname(pt,p->token[i]);
1387
}
1388
1389
1390
SRTN
1391
prn_mname FCN((pt,token))
1392
outer_char HUGE**pt C0("")
1393
sixteen_bits token C1("")
1394
{
1395
name_pointer np;
1396
ASCII HUGE*p;
1397
CONST ASCII HUGE*end;
1398
1399
np= name_dir+token;
1400
1401
PROPER_END(end);
1402
1403
for(p= np->byte_start;p<end;)
1404
*(*pt)++= XCHR(*p++);
1405
}
1406
1407
1408
SRTN
1409
i_inp_line_ FCN((n,pargs))
1410
int n C0("")
1411
PARGS pargs C1("")
1412
{
1413
num_to_mbuf(n,pargs,"$INPUT_LINE",0,"nearest line",nearest_line);
1414
}
1415
1416
SRTN
1417
i_outp_line_ FCN((n,pargs))
1418
int n C0("")
1419
PARGS pargs C1("")
1420
{
1421
num_to_mbuf(n,pargs,"$OUTPUT_LINE",0,"output line",OUTPUT_LINE);
1422
}
1423
1424
1425
SRTN
1426
num_to_mbuf FCN((n,pargs,built_in_name,num_args,num_descr,num))
1427
int n C0("")
1428
PARGS pargs C0("")
1429
CONST char*built_in_name C0("")
1430
int num_args C0("")
1431
CONST char*num_descr C0("")
1432
int num C1("")
1433
{
1434
CHK_ARGS(built_in_name,num_args);
1435
1436
MCHECK0(20,num_descr);
1437
1438
*mp++= constant;
1439
sprintf((char*)mp,"%d",num);
1440
to_ASCII((outer_char HUGE*)mp);
1441
mp+= STRLEN(mp);
1442
*mp++= constant;
1443
}
1444
1445
1446
1447
boolean
1448
x0macro FCN((p,end,xids,pcur_byte,pthe_end,multilevels))
1449
eight_bits HUGE*p C0("Present position in the input buffer.")
1450
eight_bits HUGE*end C0("Last filled position of the input \
1451
buffer plus~1.")
1452
XIDS HUGE*xids C0("")
1453
eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
1454
eight_bits HUGE**pthe_end C0("End of buffer.")
1455
boolean multilevels C1("")
1456
{
1457
boolean expanded;
1458
sixteen_bits a;
1459
eight_bits a0,a1;
1460
text_pointer m;
1461
eight_bits HUGE*p0,HUGE*p1;
1462
eight_bits HUGE*HUGE*pargs= GET_MEM("pargs",max_margs,eight_bits HUGE*);
1463
boolean must_paste= NO,pasting= NO;
1464
int level0= xids->level;
1465
boolean mac_protected= NO;
1466
1467
expanded= NO;
1468
1469
1470
while(p<end)
1471
{
1472
a0= *p++;
1473
1474
if(p==end&&a0==012)break;
1475
1476
if(TOKEN1(a0))
1477
{
1478
switch(a0)
1479
{
1480
case 0140:
1481
mac_protected= BOOLEAN(!mac_protected);
1482
continue;
1483
1484
case stringg:
1485
case constant:
1486
MCHECK(1,"`");
1487
*mp++= a0;
1488
1489
copy_string:
1490
do
1491
{
1492
if(!TOKEN1(*mp= *p++))
1493
{
1494
MCHECK(1,"id prefix");
1495
*++mp= *p++;
1496
}
1497
MCHECK(1,"8-bit token");
1498
}
1499
while(*mp++!=a0);
1500
1501
if(a0==stringg)
1502
{
1503
eight_bits HUGE*p00;
1504
1505
1506
for(p00= p;p<end;p++)
1507
if(*p!=040&&*p!=011)break;
1508
1509
if(p<end&&*p==stringg)
1510
{
1511
eight_bits mchar= *(mp-2);
1512
eight_bits pchar= *(p+1);
1513
1514
if((mchar==047||mchar==042)&&
1515
(pchar==047||pchar==042))
1516
{
1517
mp-= 2;
1518
p+= 2;
1519
goto copy_string;
1520
}
1521
}
1522
else p= p00;
1523
}
1524
1525
1526
1527
continue;
1528
1529
case dot_const:
1530
case begin_language:
1531
MCHECK(2,"dot_const");
1532
*mp++= a0;
1533
*mp++= *p++;
1534
continue;
1535
1536
default:
1537
MCHECK(1,"`");
1538
*mp++= a0;
1539
continue;
1540
}
1541
}
1542
1543
1544
else
1545
{
1546
a= IDENTIFIER(a0,a1= *p++);
1547
1548
if(a==id_defined)
1549
{
1550
1551
{
1552
MCHECK(6,"defined stuff");
1553
1554
1555
*mp++= a0;
1556
*mp++= a1;
1557
1558
ERR_IF_DEFINED_AT_END;
1559
if(TOKEN1(a0= *p++))
1560
{
1561
if(a0!=050)DEFINED_ERR("! Invalid token after `defined'")
1562
else*mp++= a0;
1563
1564
ERR_IF_DEFINED_AT_END;
1565
if(TOKEN1(a0= *p++))DEFINED_ERR("! Invalid argument of `defined'")
1566
else
1567
{
1568
*mp++= a0;
1569
*mp++= *p++;
1570
}
1571
1572
ERR_IF_DEFINED_AT_END;
1573
if(TOKEN1(a0= *p++))
1574
if(a0!=051)DEFINED_ERR("! Missing ')' after `defined'")
1575
else*mp++= a0;
1576
}
1577
else
1578
{
1579
*mp++= a0;
1580
*mp++= *p++;
1581
}
1582
}
1583
1584
1585
1586
continue;
1587
}
1588
1589
1590
1591
1592
1593
if((m= MAC_LOOKUP(a))!=NULL)
1594
if(mac_protected)
1595
{
1596
MCHECK(2,"protected macro token");
1597
*mp++= a0;
1598
*mp++= a1;
1599
}
1600
else if(recursive_name(a,xids,level0))
1601
1602
{
1603
name_pointer np;
1604
CONST ASCII HUGE*end;
1605
1606
np= name_dir+a;
1607
1608
PROPER_END(end);
1609
copy_id(np->byte_start,end,"recursive macro name");
1610
1611
1612
}
1613
1614
1615
1616
1617
else
1618
{
1619
int slevel= ignore;
1620
1621
if(!m->recursive)
1622
save_name(a);
1623
1624
#ifdef DEBUG_MACS
1625
dbg_macs(a,p,end);
1626
#endif
1627
1628
1629
{
1630
eight_bits n= 0;
1631
eight_bits HUGE*mp0= NULL,HUGE*mp1,HUGE*m_start,HUGE*m_end;
1632
boolean xpn_argument= YES;
1633
boolean last_was_paste;
1634
long max_n= 0;
1635
1636
1637
1638
if(m->nargs>0||m->var_args)
1639
p= get_margs0(p-2,end,pcur_byte,pthe_end,multilevels,
1640
(boolean)(m->var_args),pargs,&n);
1641
1642
if((!m->var_args&&n!=m->nargs)||(m->var_args&&n<m->nargs))
1643
{
1644
1645
macro_err(OC("! Actual number of WEB macro arguments (%u) does not match \
1646
number of def'n (%u); %s"),YES,n,m->nargs,n<m->nargs?"missing ones assumed to be NULL":
1647
"extra ones discarded");
1648
1649
1650
1651
1652
while(n<m->nargs)
1653
{
1654
pargs[n+1]= pargs[n]+1;
1655
n++;
1656
}
1657
}
1658
1659
1660
m_start= mp;
1661
last_was_paste= NO;
1662
1663
if(m->built_in)
1664
{
1665
(*(SRTN(*)(int,unsigned char**))(m->tok_start))(n,pargs);
1666
}
1667
else
1668
1669
{
1670
1671
p0= m->tok_start+m->moffset;
1672
p1= m->tok_start+m->nbytes;
1673
1674
while(p0<p1)
1675
{
1676
if(TOKEN1(a= *p0++))
1677
1678
{
1679
if(!(a==043&&*p0==056))last_was_paste= NO;
1680
1681
if(p0==p1&&a==012)break;
1682
1683
switch(a)
1684
{
1685
case 043:
1686
1687
{
1688
keep_intact= NO;
1689
1690
switch(*p0++)
1691
{
1692
case 046:
1693
1694
{
1695
sixteen_bits id;
1696
1697
1698
if(p0==p1)
1699
macro_err(OC("! Missing internal function name after #&"),YES);
1700
else
1701
{
1702
if(TOKEN1(a= *p0++))
1703
macro_err(OC("! Identifier must follow #&"),YES);
1704
else if(!x_int_fcn(id= IDENTIFIER(a,*p0++),n,pargs))
1705
1706
macro_err(OC("! Internal function name \"%s\" not defined"),YES,name_of(id));
1707
}
1708
}
1709
1710
break;
1711
1712
case 072:
1713
1714
{
1715
int m;
1716
long n;
1717
outer_char*tmp;
1718
size_t i;
1719
1720
1721
if(*p0!=constant)
1722
{
1723
1724
macro_err(OC("Expected constant after \"#:\""),YES);
1725
break;
1726
}
1727
1728
p0++;
1729
1730
for(i= 0;p0[i]!=constant;i++)
1731
;
1732
1733
tmp= GET_MEM("stmt number",i+1,outer_char);
1734
1735
1736
for(i= 0;*p0!=constant;i++,p0++)
1737
tmp[i]= XCHR(*p0);
1738
tmp[i+1]= '\0';
1739
p0++;
1740
1741
n= ATOL(tmp);
1742
1743
FREE_MEM(tmp,"stmt number",i+1,outer_char);
1744
1745
if(n<=0)
1746
{
1747
1748
macro_err(OC("! Invalid statement number offset (%ld) after #:; 1 assumed"),YES,n);
1749
n= 1;
1750
}
1751
1752
if(n>max_n)max_n= n;
1753
1754
MCHECK(2,"|constant|");
1755
*mp++= constant;
1756
1757
m=
1758
nsprintf((outer_char*)mp,OC("%lu"),1,max_stmt+n-1);
1759
MCHECK(m,"stmt label");
1760
to_ASCII((outer_char HUGE*)mp);
1761
mp+= m;
1762
1763
*mp++= constant;
1764
}
1765
1766
1767
break;
1768
1769
case 041:
1770
if(*p0==MACRO_ARGUMENT)xpn_argument= NO;
1771
else
1772
macro_err(OC("! Macro token '#!' must be followed by \
1773
a parameter"),YES);
1774
break;
1775
1776
case 047:
1777
single_quote= YES;
1778
DOES_ARG_FOLLOW('\'');
1779
goto do_stringize;
1780
1781
case 042:
1782
double_quote= YES;
1783
DOES_ARG_FOLLOW('\"');
1784
goto do_stringize;
1785
1786
case 052:
1787
DOES_ARG_FOLLOW('*');
1788
keep_intact= YES;
1789
1790
1791
case MACRO_ARGUMENT:
1792
1793
{
1794
eight_bits HUGE*begin;
1795
boolean do_quote;
1796
1797
1798
do_stringize:
1799
for(begin= pargs[*p0]+1;*begin=='\0';begin++)
1800
;
1801
1802
1803
1804
MCHECK(1,"stringg");*mp++= stringg
1805
1806
;
1807
1808
do_quote= BOOLEAN(!keep_intact||*begin!=stringg||begin[1]!=CUR_QUOTE);
1809
1810
if(do_quote)
1811
1812
{
1813
MCHECK(1,"quote");
1814
*mp++= CUR_QUOTE;
1815
}
1816
1817
1818
1819
str_to_mb(begin,pargs[*p0+1],YES);
1820
p0++;
1821
1822
1823
if(do_quote)
1824
1825
{
1826
MCHECK(1,"quote");
1827
*mp++= CUR_QUOTE;
1828
}
1829
1830
1831
1832
1833
MCHECK(1,"stringg");*mp++= stringg
1834
1835
;
1836
1837
single_quote= double_quote= NO;
1838
}
1839
1840
break;
1841
1842
case 060:
1843
1844
{
1845
eight_bits HUGE*mp0;
1846
1847
p0+= 2;
1848
1849
MCHECK(4,"tokens for number of variable arguments");
1850
*mp++= constant;
1851
mp0= mp;
1852
mp+=
1853
nsprintf((outer_char*)mp0,OC("%d"),1,n-m->nargs);
1854
to_ASCII((outer_char HUGE*)mp0);
1855
*mp++= constant;
1856
}
1857
1858
1859
break;
1860
1861
case 0173:
1862
1863
expanded|= ins_arg(0173,0175,INS_ARG_LIST);
1864
1865
1866
break;
1867
1868
case 0133:
1869
1870
expanded|= ins_arg(0133,0135,INS_ARG_LIST);
1871
1872
1873
break;
1874
1875
case 056:
1876
1877
{
1878
eight_bits k;
1879
boolean next_is_paste= BOOLEAN(*p0==paste);
1880
1881
for(k= m->nargs;k<n;k++)
1882
{
1883
pasting= cp_macro_arg(pargs,k,n,&xpn_argument,
1884
(boolean)(last_was_paste&&k==m->nargs),
1885
(boolean)(next_is_paste&&k==(eight_bits)(n-1)));
1886
*mp++= 054;
1887
}
1888
1889
if(*(mp-1)==054)mp--;
1890
1891
}
1892
1893
1894
break;
1895
1896
default:
1897
p0--;
1898
1899
macro_err(OC(_Xx("! Invalid token 0x%x ('%c') after '#'")),YES,*p0,isprint(*p0)?*p0:'.');
1900
break;
1901
}
1902
}
1903
1904
1905
break;
1906
1907
case stringg:
1908
MCHECK(1,"\"");
1909
*mp++= (eight_bits)a;
1910
1911
do
1912
{
1913
if(!TOKEN1(*mp= *p0++))
1914
{
1915
MCHECK(1,"id prefix");
1916
*++mp= *p0++;
1917
}
1918
MCHECK(1,"8-bit token");
1919
}
1920
while(*mp++!=(eight_bits)a);
1921
1922
break;
1923
1924
case dot_const:
1925
case begin_language:
1926
MCHECK(2,"dot_const");
1927
*mp++= (eight_bits)a;
1928
*mp++= *p0++;
1929
break;
1930
1931
default:
1932
1933
MCHECK(1,"single-byte token");
1934
if((*mp++= (eight_bits)a)==paste)
1935
last_was_paste= must_paste= YES;
1936
break;
1937
}
1938
}
1939
1940
1941
else
1942
1943
{
1944
eight_bits k= *p0++;
1945
1946
if(a==MACRO_ARGUMENT)
1947
{
1948
pasting= cp_macro_arg(pargs,k,n,&xpn_argument,
1949
last_was_paste,(boolean)(*p0==paste));
1950
}
1951
else
1952
{
1953
last_was_paste= NO;
1954
1955
MCHECK(2,"nonargument macro token");
1956
1957
*mp++= (eight_bits)a;
1958
*mp++= k;
1959
1960
if(a==0320&&k=='\0')
1961
{
1962
MCHECK(4,"line info");
1963
memcpy(mp,p0,4);
1964
mp+= 4;
1965
p0+= 4;
1966
}
1967
}
1968
}
1969
1970
1971
}
1972
}
1973
1974
1975
1976
1977
if(must_paste)
1978
1979
{
1980
m_end= mp;
1981
1982
1983
1984
copy_and_paste(m_start,m_end);
1985
1986
1987
for(mp1= mp,mp= m_start,mp0= m_end;mp0<mp1;)
1988
*mp++= *mp0++;
1989
}
1990
1991
1992
1993
if(max_n>0)
1994
max_stmt+= max_n;
1995
1996
xpn_before(m_start,xids,pcur_byte,pthe_end,multilevels);
1997
#if 0
1998
if(must_paste)
1999
#endif
2000
expanded= YES;
2001
2002
}
2003
2004
2005
2006
if(!m->recursive)
2007
unsave_name;
2008
}
2009
else
2010
{
2011
2012
MCHECK(2,"ordinary id");
2013
*mp++= a0;
2014
*mp++= a1;
2015
2016
2017
2018
if(a0>=0250)
2019
{
2020
int n= 2+4*1;
2021
2022
MCHECK(n,"module defn");
2023
while(n-->0)
2024
*mp++= *p++;
2025
}
2026
}
2027
}
2028
2029
2030
}
2031
2032
2033
done_expanding:
2034
FREE_MEM(pargs,"pargs",max_margs,eight_bits HUGE*);
2035
return expanded;
2036
2037
}
2038
2039
2040
SRTN
2041
dbg_macs FCN((n,start,end))
2042
sixteen_bits n C0("")
2043
eight_bits HUGE*start C0("")
2044
eight_bits HUGE*end C1("")
2045
{
2046
printf("%lu = (0x%x->0x%x) <<%lu>>: ",
2047
end-start,start,end,start-macrobuf);
2048
find_n(n);
2049
}
2050
2051
2052
SRTN
2053
cpy_op FCN((s))
2054
CONST outer_char HUGE*s C1("String such as \.{++}.")
2055
{
2056
MCHECK(2,"cpy_op");
2057
2058
while(*s)
2059
*mp++= XORD(*s++);
2060
2061
copy_state= MISCELLANEOUS;
2062
}
2063
2064
2065
eight_bits HUGE*
2066
str_to_mb FCN((begin_arg,end_arg,esc_chars))
2067
CONST eight_bits HUGE*begin_arg C0("Beginning of string.")
2068
CONST eight_bits HUGE*end_arg C0("End of string.")
2069
boolean esc_chars C1("Insert escape characters?")
2070
{
2071
eight_bits HUGE*mp0= mp;
2072
sixteen_bits c;
2073
2074
copy_state= MISCELLANEOUS;
2075
2076
while(begin_arg<end_arg)
2077
{
2078
if(TOKEN1(c= *begin_arg++))
2079
{
2080
2081
2082
switch(c)
2083
{
2084
case ignore:
2085
break;
2086
2087
2088
2089
CPY_OP(plus_plus,"++");
2090
CPY_OP(minus_minus,"--");
2091
CPY_OP(minus_gt,C_LIKE(language)?"->":".EQV.");
2092
CPY_OP(gt_gt,">>");
2093
CPY_OP(eq_eq,"==");
2094
CPY_OP(lt_lt,"<<");
2095
CPY_OP(gt_eq,">=");
2096
CPY_OP(lt_eq,"<=");
2097
CPY_OP(not_eq,"!=");
2098
CPY_OP(and_and,"&&");
2099
CPY_OP(or_or,"||");
2100
CPY_OP(star_star,"**");
2101
CPY_OP(slash_slash,"//");
2102
CPY_OP(ellipsis,C_LIKE(language)?"...":".XOR.");
2103
2104
case dot_const:
2105
cpy_op(OC("."));
2106
{
2107
ASCII*symbol= dots[*begin_arg++].symbol;
2108
2109
cpy_op(to_outer(symbol));
2110
to_ASCII((outer_char*)symbol);
2111
}
2112
cpy_op(OC("."));
2113
break;
2114
2115
2116
2117
case join:
2118
copy_state= UNBREAKABLE;
2119
break;
2120
2121
case constant:
2122
if(copy_state==NUM_OR_ID)
2123
2124
{
2125
MCHECK(1,"' '");*mp++= 040;
2126
}
2127
2128
2129
2130
{
2131
if(!keep_intact&&c==stringg)esc_certain_chars(*begin_arg++,YES);
2132
2133
2134
while(*begin_arg!=(eight_bits)c)
2135
{
2136
MCHECK(1,"constant");
2137
*mp++= *begin_arg++;
2138
}
2139
2140
if(!keep_intact&&c==stringg)
2141
esc_certain_chars((sixteen_bits)*(--mp),YES);
2142
2143
2144
begin_arg++;
2145
}
2146
2147
2148
copy_state= NUM_OR_ID;
2149
break;
2150
2151
case stringg:
2152
2153
{
2154
if(!keep_intact&&c==stringg)esc_certain_chars(*begin_arg++,YES);
2155
2156
2157
while(*begin_arg!=(eight_bits)c)
2158
{
2159
MCHECK(1,"constant");
2160
*mp++= *begin_arg++;
2161
}
2162
2163
if(!keep_intact&&c==stringg)
2164
esc_certain_chars((sixteen_bits)*(--mp),YES);
2165
2166
2167
begin_arg++;
2168
}
2169
2170
2171
copy_state= MISCELLANEOUS;
2172
break;
2173
2174
case 073:
2175
if(R77_or_F)
2176
{
2177
2178
{
2179
MCHECK(3,"\";\"");
2180
*mp++= constant;
2181
*mp++= 073;
2182
*mp++= constant;
2183
}
2184
2185
;
2186
break;
2187
}
2188
2189
default:
2190
esc_certain_chars(c,esc_chars);
2191
if(copy_state!=VERBATIM)copy_state= MISCELLANEOUS;
2192
break;
2193
}
2194
2195
2196
}
2197
else
2198
{
2199
name_pointer np;
2200
2201
if(copy_state==NUM_OR_ID)
2202
2203
{
2204
MCHECK(1,"' '");*mp++= 040;
2205
}
2206
2207
2208
2209
if(c==MACRO_ARGUMENT)
2210
2211
{
2212
outer_char temp[10];
2213
int n;
2214
2215
n=
2216
nsprintf(temp,OC("$%d"),1,*begin_arg++);
2217
to_ASCII(temp);
2218
MCHECK(n,"%arg");
2219
STRCPY(mp,temp);
2220
mp+= n;
2221
}
2222
2223
2224
else
2225
2226
{
2227
c= IDENTIFIER(c,*begin_arg++);
2228
2229
switch(c/MODULE_NAME)
2230
{
2231
case 0:
2232
np= name_dir+c;
2233
2234
{
2235
TRUNC HUGE*s;
2236
ASCII HUGE*pc= np->byte_start;
2237
2238
if(*pc!=BP_MARKER)
2239
{
2240
CONST ASCII HUGE*end;
2241
2242
PROPER_END(end);
2243
copy_id((CONST ASCII HUGE*)pc,end,"copied id");
2244
}
2245
else
2246
{
2247
s= ((BP HUGE*)pc)->Root;
2248
copy_id(s->id,s->id_end,"copied id");
2249
}
2250
}
2251
2252
2253
break;
2254
2255
case 1:
2256
MCHECK(5,"macro name");
2257
2258
*mp++= 043;
2259
*mp++= 074;
2260
2261
c-= MODULE_NAME;
2262
2263
np= name_dir+c;
2264
2265
if(np->equiv!=(EQUIV)text_info)
2266
2267
{
2268
TRUNC HUGE*s;
2269
ASCII HUGE*pc= np->byte_start;
2270
2271
if(*pc!=BP_MARKER)
2272
{
2273
CONST ASCII HUGE*end;
2274
2275
PROPER_END(end);
2276
copy_id((CONST ASCII HUGE*)pc,end,"copied id");
2277
}
2278
else
2279
{
2280
s= ((BP HUGE*)pc)->Root;
2281
copy_id(s->id,s->id_end,"copied id");
2282
}
2283
}
2284
2285
2286
else if(c!=UNNAMED_MODULE)
2287
*mp++= 077;
2288
2289
2290
*mp++= 0100;
2291
*mp++= 076;
2292
break;
2293
2294
default:
2295
if(c==MODULE_NUM)
2296
begin_arg+= 4*1;
2297
2298
break;
2299
}
2300
}
2301
2302
2303
2304
copy_state= NUM_OR_ID;
2305
}
2306
}
2307
2308
*mp= '\0';
2309
return mp0;
2310
}
2311
2312
2313
SRTN
2314
esc_certain_chars FCN((c,esc_chars))
2315
sixteen_bits c C0("Character to be maybe escaped.")
2316
boolean esc_chars C1("Do we escape them?")
2317
{
2318
if(esc_chars)
2319
if(C_LIKE(language))
2320
{
2321
if(c==0134||c==042)
2322
{
2323
MCHECK(1,"'\\'");
2324
*mp++= 0134;
2325
}
2326
}
2327
else if(R77_or_F)
2328
{
2329
if(c==047)
2330
{
2331
MCHECK(1,"doubled quote");
2332
*mp++= (eight_bits)c;
2333
2334
}
2335
}
2336
else
2337
{
2338
if(c==042)
2339
{
2340
MCHECK(1,"'\"'");
2341
*mp++= (eight_bits)c;
2342
}
2343
}
2344
2345
2346
MCHECK(1,"escaped character");
2347
*mp++= (eight_bits)c;
2348
}
2349
2350
2351
SRTN
2352
i_len_ FCN((n,pargs))
2353
int n C0("")
2354
PARGS pargs C1("")
2355
{
2356
int m,num;
2357
2358
CHK_ARGS("$LEN",1);
2359
2360
m= (int)(pargs[1]-pargs[0]-5);
2361
2362
2363
2364
num=
2365
nsprintf((outer_char HUGE*)mp,OC("%d"),1,m);
2366
MCHECK(num,"_len_");
2367
to_ASCII((outer_char HUGE*)mp);
2368
mp+= num;
2369
}
2370
2371
2372
SRTN
2373
i_verbatim_ FCN((n,pargs))
2374
int n C0("")
2375
PARGS pargs C1("")
2376
{
2377
eight_bits HUGE*p,delim[2];
2378
eight_bits quote_char[3];
2379
2380
CHK_ARGS("$VERBATIM",1);
2381
2382
if(*(p= pargs[0]+1)!=stringg)
2383
{
2384
MUST_QUOTE("$VERBATIM",p,pargs[1]);
2385
return;
2386
}
2387
2388
STRNCPY(delim,"\0\0",2);
2389
STRNCPY(quote_char,"\42\0\0",3);
2390
2391
2392
switch(language)
2393
{
2394
case FORTRAN:
2395
quote_char[0]= 047;
2396
break;
2397
2398
case FORTRAN_90:
2399
quote_char[1]= 047;
2400
break;
2401
2402
case TEX:
2403
return;
2404
2405
default:
2406
break;
2407
}
2408
2409
2410
MCHECK(1,"string token");
2411
*mp++= *p++;
2412
2413
2414
delim[0]= *p;
2415
2416
if(STRSPN(delim,quote_char))
2417
p++;
2418
else
2419
delim[0]= stringg;
2420
2421
while(*p!=stringg)
2422
{
2423
MCHECK(1,"verbatim token");
2424
*mp++= *p++;
2425
}
2426
2427
2428
if(STRSPN(delim,quote_char))
2429
*(mp---1)= stringg;
2430
}
2431
2432
2433
SRTN
2434
i_unstring_ FCN((n,pargs))
2435
int n C0("")
2436
PARGS pargs C1("")
2437
{
2438
eight_bits HUGE*p,delim[2];
2439
eight_bits quote_char[3];
2440
2441
CHK_ARGS("$UNSTRING",1);
2442
2443
if(*(p= pargs[0]+1)!=stringg)
2444
{
2445
MUST_QUOTE("$UNSTRING",p,pargs[1]);
2446
return;
2447
}
2448
2449
STRNCPY(delim,"\0\0",2);
2450
STRNCPY(quote_char,"\42\0\0",3);
2451
2452
2453
switch(language)
2454
{
2455
case FORTRAN:
2456
quote_char[0]= 047;
2457
break;
2458
2459
case FORTRAN_90:
2460
quote_char[1]= 047;
2461
break;
2462
2463
case TEX:
2464
return;
2465
2466
default:
2467
break;
2468
}
2469
2470
2471
p++;
2472
2473
2474
delim[0]= *p;
2475
2476
if(STRSPN(delim,quote_char))
2477
p++;
2478
else
2479
delim[0]= stringg;
2480
2481
while(*p!=stringg)
2482
{
2483
MCHECK(1,"verbatim token");
2484
*mp++= *p++;
2485
}
2486
2487
2488
if(STRSPN(delim,quote_char))
2489
mp--;
2490
}
2491
2492
2493
SRTN
2494
must_quote FCN((name,p,p1))
2495
CONST outer_char*name C0("")
2496
eight_bits HUGE*p C0("")
2497
eight_bits HUGE*p1 C1("")
2498
{
2499
2500
macro_err(OC("! Argument of %s must be a quoted string"),YES,name);
2501
2502
2503
MCHECK(p1-p,"copy quotes");
2504
while(p<p1)*mp++= *p++;
2505
}
2506
2507
2508
SRTN
2509
i_translit_ FCN((n,pargs))
2510
int n C0("")
2511
PARGS pargs C1("")
2512
{
2513
int k;
2514
2515
CHK_ARGS("$TRANSLIT",3);
2516
2517
for(k= 0;k<2;k++)
2518
if(*(pargs[k]+1)!=stringg)
2519
macro_err(OC("! Argument %d of $TRANSLIT \
2520
must be a string"),YES,k);
2521
2522
translit((ASCII HUGE*)(pargs[0]+2),
2523
(ASCII HUGE*)(pargs[1]+2),
2524
(ASCII HUGE*)(pargs[2]+2));
2525
}
2526
2527
2528
SRTN
2529
translit FCN((s,from,to))
2530
CONST ASCII HUGE*s C0("String to be transliterated")
2531
CONST ASCII HUGE*from C0("Characters to replace")
2532
CONST ASCII HUGE*to C1("Replace by")
2533
{
2534
short code[128],i,n;
2535
ASCII end_char= *s++;
2536
ASCII c,cfrom,cto;
2537
ASCII esc_achar PROTO((CONST ASCII HUGE*HUGE*));
2538
2539
CHECK_QUOTE(from,1);
2540
CHECK_QUOTE(to,2);
2541
2542
2543
MCHECK(1,"stringg");*mp++= stringg
2544
2545
;
2546
2547
2548
for(i= 0;i<128;i++)
2549
code[i]= i;
2550
2551
2552
while(*(to+1)!=stringg)
2553
{
2554
if(*(from+1)==stringg)break;
2555
2556
2557
if((cfrom= *from++)==0134)cfrom= esc_achar(&from);
2558
if((cto= *to++)==0134)cto= esc_achar(&to);
2559
2560
code[cfrom]= cto;
2561
}
2562
2563
2564
2565
if(*(from+1)!=stringg)
2566
while(*(from+1)!=stringg)
2567
{
2568
if((cfrom= *from++)==0134)cfrom= esc_achar(&from);
2569
2570
code[cfrom]= -1;
2571
}
2572
2573
2574
while(*(s+1)!=stringg)
2575
{
2576
if((c= *s++)==0134)c= esc_achar(&s);
2577
2578
if((n= code[c])==-1)continue;
2579
MCHECK(1,"_translit_");
2580
*mp++= (eight_bits)n;
2581
}
2582
2583
2584
MCHECK(1,"stringg");*mp++= stringg
2585
2586
;
2587
}
2588
2589
2590
SRTN
2591
i_getenv_ FCN((n,pargs))
2592
int n C0("")
2593
PARGS pargs C1("")
2594
{
2595
ASCII HUGE*p;
2596
outer_char*pvar,HUGE*t;
2597
outer_char HUGE*temp,HUGE*temp_end;
2598
2599
2600
#if !HAVE_GETENV
2601
2602
macro_err(OC("Sorry, this machine doesn't support getenv"),YES);
2603
#else
2604
2605
CHK_ARGS("$GETENV",1);
2606
2607
2608
temp= GET_MEM("_getenv_:temp",N_ENVBUF,outer_char);
2609
temp_end= temp+N_ENVBUF;
2610
2611
for(p= (ASCII HUGE*)(pargs[0]+3),t= temp;*(p+1)!=stringg;)
2612
SAVE_ENV(*p++);
2613
2614
SAVE_ENV('\0');
2615
2616
if((pvar= GETENV((CONST char*)temp))!=NULL)mcopy(pvar);
2617
2618
FREE_MEM(temp,"_getenv_:temp",N_ENVBUF,outer_char);
2619
2620
#endif
2621
}
2622
2623
2624
boolean cp_macro_arg FCN((pargs,k,n,pxpn_argument,
2625
last_was_paste,next_is_paste))
2626
PARGS pargs C0("")
2627
eight_bits k C0("Current argument to process")
2628
eight_bits n C0("")
2629
boolean HUGE*pxpn_argument C0("")
2630
boolean last_was_paste C0("")
2631
boolean next_is_paste C1("")
2632
{
2633
boolean pasting;
2634
eight_bits HUGE*begin_arg,HUGE*end_arg,HUGE*mp0= NULL;
2635
2636
2637
2638
if(k>=n)
2639
{
2640
pargs[k]= pargs[n];
2641
pargs[k+1]= pargs[n]+1;
2642
}
2643
2644
begin_arg= pargs[k]+1;
2645
2646
2647
2648
while(*begin_arg==012)begin_arg++;
2649
2650
end_arg= pargs[k+1];
2651
2652
2653
2654
if(last_was_paste||next_is_paste)pasting= YES;
2655
else
2656
{
2657
pasting= NO;
2658
mp0= mp;
2659
}
2660
2661
2662
2663
2664
if(begin_arg==end_arg)
2665
{
2666
if(pasting)
2667
{
2668
MCHECK(1,"null character");
2669
*mp++= '\0';
2670
}
2671
}
2672
else
2673
{
2674
MCHECK(end_arg-begin_arg,"argument tokens");
2675
while(begin_arg<end_arg)*mp++= *begin_arg++;
2676
}
2677
2678
2679
2680
2681
2682
2683
if(!*pxpn_argument)
2684
*pxpn_argument= YES;
2685
else if(!pasting)
2686
xpn_before(mp0,NULL,NULL,NULL,NO);
2687
2688
return pasting;
2689
}
2690
2691
2692
boolean ins_arg FCN((cleft,cright,
2693
pargs,m,n,pp0,ppasting,pxpn_argument,last_was_paste))
2694
ASCII cleft C0("")
2695
ASCII cright C0("")
2696
PARGS pargs C0("")
2697
text_pointer m C0("")
2698
eight_bits n C0("")
2699
eight_bits HUGE*HUGE*pp0 C0("")
2700
boolean*ppasting C0("")
2701
boolean*pxpn_argument C0("")
2702
boolean last_was_paste C1("")
2703
{
2704
int k;
2705
boolean next_is_paste= BOOLEAN(*(*pp0)==paste);
2706
eight_bits HUGE*pp;
2707
eight_bits HUGE*mp0= mp;
2708
eight_bits HUGE*p00= (*pp0);
2709
boolean fixed= BOOLEAN(cleft==0133);
2710
2711
WHILE()
2712
if(*(*pp0)==cright)
2713
{
2714
break;
2715
}
2716
else if(TOKEN1(*(*pp0)))(*pp0)++;
2717
else(*pp0)+= 2;
2718
2719
pp= xmac_text(mp0,p00,(*pp0)++);
2720
k= neval(pp,mp);
2721
2722
mp= mp0;
2723
2724
2725
if(k==0)
2726
{
2727
*mp++= 043;
2728
*mp++= 0173;
2729
2730
while(p00<*pp0)
2731
*mp++= *p00++;
2732
2733
return YES;
2734
}
2735
2736
if(k<=0)
2737
{
2738
outer_char temp[5];
2739
2740
2741
nsprintf(temp,OC("#%c0%c"),3,5,XCHR(cleft),XCHR(cright));
2742
MCHECK(4,temp);
2743
*mp++= constant;
2744
mp0= mp;
2745
mp+=
2746
nsprintf((outer_char*)mp0,OC("%d"),1,n-(fixed?0:m->nargs));
2747
to_ASCII((outer_char HUGE*)mp0);
2748
*mp++= constant;
2749
}
2750
else
2751
*ppasting= cp_macro_arg(pargs,(eight_bits)(k-1+(fixed?0:m->nargs)),
2752
n,pxpn_argument,last_was_paste,next_is_paste);
2753
2754
return NO;
2755
}
2756
2757
2758
SRTN
2759
xpn_before FCN((mp0,xids,pcur_byte,pthe_end,multilevels))
2760
eight_bits HUGE*mp0 C0("Remember this end of |macro_buf|.")
2761
XIDS HUGE*xids C0("")
2762
eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
2763
eight_bits HUGE**pthe_end C0("End of buffer.")
2764
boolean multilevels C1("")
2765
{
2766
eight_bits HUGE*mp1;
2767
2768
mp1= xmac_buf(mp0,xids,pcur_byte,pthe_end,multilevels);
2769
2770
2771
while(mp1<mp)
2772
*mp0++= *mp1++;
2773
2774
2775
mp= mp0;
2776
}
2777
2778
2779
boolean
2780
x_int_fcn FCN((id,n,pargs))
2781
sixteen_bits id C0("Token for internal function.")
2782
int n C0("Number of arguments")
2783
PARGS pargs C1("Array of pointers to arguments.")
2784
{
2785
INTERNAL_FCN HUGE*f;
2786
2787
for(f= internal_fcns;f->len!=0;f++)
2788
if(f->id==id)
2789
{
2790
(*f->expnd)(n,pargs);
2791
2792
return YES;
2793
}
2794
2795
return NO;
2796
}
2797
2798
2799
eight_bits HUGE*
2800
copy_and_paste FCN((m_start,m_end))
2801
eight_bits HUGE*m_start C0("Start of range.")
2802
eight_bits HUGE*m_end C1("End of range.")
2803
{
2804
eight_bits HUGE*mp0;
2805
eight_bits a0;
2806
eight_bits HUGE*m_last= m_start;
2807
2808
for(mp0= m_start;mp0<m_end;)
2809
{
2810
if(TOKEN1(a0= *mp0))
2811
{
2812
if(a0==paste)
2813
{
2814
eight_bits HUGE*p;
2815
2816
p= mp;
2817
2818
paste1(m_last,m_start);
2819
mp0= paste1(++mp0,m_end);
2820
2821
2822
divert((ASCII HUGE*)p,(ASCII HUGE*)mp,STOP);
2823
2824
scan_repl(macro,STOP);
2825
2826
2827
mp= m_last;
2828
m_last= copy_and_paste(cur_text->tok_start,tok_ptr);
2829
2830
2831
text_ptr= cur_text;
2832
mx_tok_ptr= tok_ptr;
2833
tok_ptr= text_ptr->tok_start;
2834
}
2835
2836
2837
else
2838
{
2839
if(a0==ignore)
2840
{
2841
mp0++;
2842
continue;
2843
}
2844
2845
m_last= mp;
2846
2847
switch(a0)
2848
{
2849
case constant:
2850
case stringg:
2851
MCHECK(1,"|constant| or |stringg|");
2852
*mp++= *mp0++;
2853
2854
do
2855
{
2856
*mp= *mp0++;
2857
MCHECK(1,"text of \
2858
|constant| or |stringg|");
2859
}
2860
while(*mp++!=a0);
2861
2862
break;
2863
2864
case dot_const:
2865
case begin_language:
2866
MCHECK(2,"dot_const");
2867
*mp++= *mp0++;
2868
*mp++= *mp0++;
2869
break;
2870
2871
default:
2872
MCHECK(1,"ASCII token");
2873
*mp++= *mp0++;
2874
break;
2875
}
2876
}
2877
}
2878
else
2879
{
2880
m_last= mp;
2881
MCHECK(2,"two-byte token");
2882
*mp++= *mp0++;*mp++= *mp0++;
2883
}
2884
}
2885
2886
return m_last;
2887
}
2888
2889
2890
eight_bits HUGE*
2891
paste1 FCN((p0,begin_or_end))
2892
eight_bits HUGE*p0 C0("Beginning of tokens to be expanded.")
2893
eight_bits HUGE*begin_or_end C1("")
2894
{
2895
eight_bits a0,a1;
2896
sixteen_bits a;
2897
2898
if(p0==begin_or_end)
2899
{
2900
2901
macro_err(OC("! Missing argument to token-paste operation. Null assumed"),YES);
2902
return p0;
2903
}
2904
2905
if(TOKEN1(a0= *p0++))
2906
switch(a0)
2907
{
2908
case ignore:break;
2909
2910
case constant:
2911
case stringg:
2912
2913
while((a1= *p0++)!=a0)
2914
{
2915
MCHECK(1,"stuff between tokens");
2916
*mp++= a1;
2917
}
2918
break;
2919
2920
case dot_const:
2921
case begin_language:
2922
MCHECK(2,"dot_const");
2923
*mp++= a0;
2924
*mp++= *p0++;
2925
break;
2926
2927
default:
2928
MCHECK(1,"default ASCII token");
2929
*mp++= a0;
2930
break;
2931
}
2932
else
2933
{
2934
a= IDENTIFIER(a0,*p0++);
2935
2936
if(a<MODULE_NAME)
2937
{
2938
name_pointer np;
2939
2940
np= name_dir+a;
2941
2942
{
2943
TRUNC HUGE*s;
2944
ASCII HUGE*pc= np->byte_start;
2945
2946
if(*pc!=BP_MARKER)
2947
{
2948
CONST ASCII HUGE*end;
2949
2950
PROPER_END(end);
2951
copy_id((CONST ASCII HUGE*)pc,end,"copied id");
2952
}
2953
else
2954
{
2955
s= ((BP HUGE*)pc)->Root;
2956
copy_id(s->id,s->id_end,"copied id");
2957
}
2958
}
2959
2960
2961
}
2962
else{}
2963
}
2964
2965
return p0;
2966
}
2967
2968
2969
SRTN
2970
copy_id FCN((start,end,descr))
2971
CONST ASCII HUGE*start C0("Beginning of identifier name.")
2972
CONST ASCII HUGE*end C0("End of identifier name.")
2973
CONST char*descr C1("")
2974
{
2975
CONST ASCII HUGE*j;
2976
2977
MCHECK(end-start,descr);
2978
2979
for(j= start;j<end;)
2980
*mp++= (eight_bits)(*j++);
2981
}
2982
2983
2984
SRTN
2985
mbuf_full FCN((n,reason))
2986
unsigned long n C0("Number of bytes requested.")
2987
CONST outer_char reason[]C1("Reason for request.")
2988
{
2989
2990
macro_err(OC("! Macro buffer full; %lu byte(s) requested for %s"),YES,n,reason);
2991
OVERFLW("macro buffer bytes","mb");
2992
}
2993
2994
2995
SRTN
2996
mcheck0 FCN((n,reason))
2997
unsigned long n C0("Number of bytes requested.")
2998
CONST outer_char reason[]C1("Reason for request.")
2999
{
3000
MCHECK(n,reason);
3001
}
3002
3003
3004
eight_bits HUGE*
3005
xmacro FCN((macro_text,pcur_byte,pthe_end,multilevels,mp0))
3006
text_pointer macro_text C0("")
3007
eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
3008
eight_bits HUGE**pthe_end C0("End of buffer.")
3009
boolean multilevels C0("Read args through many levels?")
3010
eight_bits HUGE*mp0 C1("Build the expansion beginning here in \
3011
|macrobuf|.")
3012
{
3013
eight_bits HUGE*macro_start;
3014
extern long cur_val;
3015
3016
3017
mp= mp0;
3018
3019
MCHECK(2,"macro token");
3020
3021
if(macro_text->built_in)
3022
{
3023
*mp++= LEFT(cur_val,ID0);
3024
*mp++= RIGHT(cur_val);
3025
}
3026
else
3027
{
3028
macro_start= macro_text->tok_start;
3029
*mp++= *macro_start++;*mp++= *macro_start++;
3030
}
3031
3032
3033
3034
if(macro_text->nargs>0||macro_text->var_args)
3035
mp= args_to_macrobuf(mp,pcur_byte,pthe_end,multilevels,
3036
(boolean)(macro_text->var_args));
3037
3038
return xmac_buf(mp0,NULL,pcur_byte,pthe_end,multilevels);
3039
3040
3041
}
3042
3043
3044
eight_bits HUGE*
3045
args_to_macrobuf FCN((mp,pcur_byte,pthe_end,
3046
multilevels,var_args))
3047
eight_bits HUGE*mp C0("Next available position in |macro_buf|.")
3048
eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
3049
eight_bits HUGE**pthe_end C0("End of buffer.")
3050
boolean multilevels C0("Read through many levels?")
3051
boolean var_args C1("Does macro have variable args?")
3052
{
3053
eight_bits c;
3054
sixteen_bits id_token;
3055
int bal= 0;
3056
3057
id_token= IDENTIFIER(*(mp-2),*(mp-1));
3058
3059
3060
do
3061
{
3062
if(*pcur_byte==*pthe_end)
3063
{
3064
if(!(multilevels&&pop_level()))
3065
{
3066
3067
macro_err(OC("! No ')' in call to macro \"%s\""),YES,name_of(id_token));
3068
break;
3069
}
3070
}
3071
3072
MCHECK(1,"arg to macrobuf");
3073
c= *mp++= *(*pcur_byte)++;
3074
3075
if(TOKEN1(c))
3076
3077
{
3078
switch(c)
3079
{
3080
case stringg:
3081
do
3082
{
3083
MCHECK(1,"string arg");
3084
*mp= *(*pcur_byte)++;
3085
}
3086
while(*mp++!=stringg);
3087
break;
3088
3089
case dot_const:
3090
case begin_language:
3091
MCHECK(1,"dot const");
3092
*mp++= *(*pcur_byte)++;
3093
break;
3094
3095
case 050:
3096
bal++;
3097
break;
3098
3099
case 051:
3100
if(bal==0&&!var_args)
3101
{
3102
3103
macro_err(OC("! Missing '(' in call to macro \"%s\""),YES,name_of(id_token));
3104
goto done_copying;
3105
}
3106
else bal--;
3107
3108
break;
3109
}
3110
}
3111
3112
3113
else
3114
{
3115
3116
int n;
3117
3118
n= (c<0250?1:3+4*1);
3119
MCHECK(n,"second id token");
3120
while(n-->0)*mp++= *(*pcur_byte)++;
3121
continue;
3122
}
3123
}
3124
while(bal>0);
3125
3126
done_copying:
3127
return mp;
3128
}
3129
3130
3131
eight_bits HUGE*
3132
xmac_buf FCN((mp0,old_xids,pcur_byte,pthe_end,multilevels))
3133
eight_bits HUGE*mp0 C0("Text to be expanded begins here.")
3134
XIDS HUGE*old_xids C0("")
3135
eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
3136
eight_bits HUGE**pthe_end C0("End of buffer.")
3137
boolean multilevels C1("")
3138
{
3139
eight_bits HUGE*p,HUGE*p1;
3140
XIDS xids;
3141
XIDS HUGE*pid;
3142
3143
xids.level= 0;
3144
3145
if(xlevel>=MAX_XLEVELS)
3146
{
3147
3148
macro_err(OC("! Macro outer recursion depth exceeded"),YES);
3149
3150
fatal(ERR_M,OC("!! BYE."),OC(""));
3151
}
3152
3153
pid= pids[xlevel++]= old_xids?old_xids:&xids;
3154
3155
3156
for(p= mp0,p1= mp;
3157
x0macro(p,p1,pid,pcur_byte,pthe_end,multilevels);
3158
p= p1,p1= mp);
3159
3160
xlevel--;
3161
3162
return p1;
3163
}
3164
3165
3166
eight_bits HUGE*
3167
xmac_text FCN((mp0,start,end))
3168
eight_bits HUGE*mp0 C0("")
3169
eight_bits HUGE*start C0("")
3170
eight_bits HUGE*end C1("")
3171
{
3172
3173
for(mp= mp0;start<end;)
3174
*mp++= *start++;
3175
3176
3177
return xmac_buf(mp0,NULL,NULL,NULL,NO);
3178
}
3179
3180
3181
SRTN
3182
i_meta_ FCN((n,pargs))
3183
int n C0("")
3184
PARGS pargs C1("")
3185
{
3186
eight_bits HUGE*p;
3187
3188
CHK_ARGS("$COMMENT",1);
3189
3190
3191
p= pargs[0]+1;
3192
if(!(*p==constant||*p==stringg))
3193
{
3194
arg_must_be_constant("$COMMENT");
3195
return;
3196
};
3197
3198
3199
{
3200
static eight_bits begin_C_meta[]= {constant,057,052,constant,'\0'};
3201
eight_bits HUGE*p;
3202
3203
3204
if(C_LIKE(language))
3205
{
3206
MCHECK0(4,"begin_C_meta");
3207
for(p= begin_C_meta;*p;)*mp++= *p++;
3208
}
3209
else
3210
{
3211
MCHECK0(2,"begin_meta");
3212
*mp++= begin_meta;
3213
*mp++= begin_meta;
3214
}
3215
}
3216
3217
;
3218
3219
*(p+1)= *(pargs[1]-2)= 040;
3220
3221
do
3222
{
3223
MCHECK0(1,"_meta_");
3224
*mp++= *p++;
3225
}
3226
while(p<pargs[1]);
3227
3228
3229
{
3230
static eight_bits end_C_meta[]= "\52\57";
3231
eight_bits HUGE*p;
3232
3233
3234
if(C_LIKE(language))
3235
{
3236
MCHECK0(2,"end_C_meta");
3237
for(p= end_C_meta;*p;)*mp++= *p++;
3238
}
3239
else
3240
{
3241
MCHECK0(1,"end_meta");
3242
*mp++= end_meta;
3243
}
3244
}
3245
3246
;
3247
}
3248
3249
3250
SRTN
3251
i_assert_ FCN((n,pargs))
3252
int n C0("")
3253
PARGS pargs C1("")
3254
{
3255
eight_bits HUGE*p;
3256
eight_bits HUGE*pp;
3257
eight_bits HUGE*mp0;
3258
boolean e;
3259
3260
CHK_ARGS("$ASSERT",1);
3261
3262
pp= xmac_text(mp0= mp,p= pargs[0]+1,pargs[1]);
3263
e= eval(pp,mp);
3264
mp= mp0;
3265
3266
if(e)
3267
return;
3268
3269
mp= str_to_mb(p,pargs[1],YES);
3270
3271
3272
macro_err(OC("! $ASSERT(%s) failed"),NO,to_outer((ASCII HUGE*)mp));
3273
3274
fatal(ERR_M,OC(""),OC("Processing ABORTED!"));
3275
}
3276
3277
3278
SRTN
3279
i_error_ FCN((n,pargs))
3280
int n C0("")
3281
PARGS pargs C1("")
3282
{
3283
eight_bits c;
3284
eight_bits HUGE*t,HUGE*p,HUGE*temp;
3285
3286
CHK_ARGS("$ERROR",1);
3287
3288
3289
p= pargs[0]+1;
3290
if(!(*p==constant||*p==stringg))
3291
{
3292
arg_must_be_constant("$ERROR");
3293
return;
3294
};
3295
3296
temp= GET_MEM("_error_:temp",N_MSGBUF,eight_bits);
3297
3298
for(c= *p++,t= temp;*p!=c;)*t++= *p++;
3299
*t= '\0';
3300
3301
3302
macro_err(OC("%cUSER ERROR: %s"),NO,beep(1),to_outer((ASCII HUGE*)temp));
3303
FREE_MEM(temp,"_error_:temp",N_MSGBUF,eight_bits);
3304
}
3305
3306
3307
SRTN
3308
i_routine_ FCN((n,pargs))
3309
int n C0("")
3310
PARGS pargs C1("")
3311
{
3312
name_pointer np;
3313
CONST ASCII HUGE*f,HUGE*end;
3314
3315
CHK_ARGS("$ROUTINE",0);
3316
3317
if(!(is_RATFOR_(language)))return;
3318
if(!RAT_OK(""))
3319
confusion(OC("_routine_"),OC("Language shouldn't be Ratfor here"));
3320
3321
if(cur_fcn==NO_FCN)
3322
{
3323
MCHECK0(1,"'?'");
3324
*mp++= 077;
3325
return;
3326
}
3327
3328
np= name_dir+cur_fcn;
3329
end= proper_end(np);
3330
3331
MCHECK0(end-np->byte_start,"_routine_");
3332
for(f= np->byte_start;f<end;)
3333
*mp++= *f++;
3334
}
3335
3336
3337
3338
SRTN
3339
i_lowercase_ FCN((n,pargs))
3340
int n C0("")
3341
PARGS pargs C1("")
3342
{
3343
eight_bits HUGE*p= pargs[0]+1,HUGE*p1= pargs[1];
3344
3345
CHK_ARGS("$LC",1);
3346
3347
if(*p!=stringg)
3348
{
3349
MUST_QUOTE("$L",p,p1);
3350
return;
3351
}
3352
3353
MCHECK(p1-p,"lowercase");
3354
3355
for(;p<p1;p++)
3356
*mp++= A_TO_LOWER(*p);
3357
}
3358
3359
SRTN
3360
i_uppercase_ FCN((n,pargs))
3361
int n C0("")
3362
PARGS pargs C1("")
3363
{
3364
eight_bits HUGE*p= pargs[0]+1,HUGE*p1= pargs[1];
3365
3366
CHK_ARGS("$UC",1);
3367
3368
if(*p!=stringg)
3369
{
3370
MUST_QUOTE("$U",p,p1);
3371
return;
3372
}
3373
3374
MCHECK(p1-p,"uppercase");
3375
3376
for(;p<p1;p++)
3377
*mp++= A_TO_UPPER(*p);
3378
}
3379
3380
3381
SRTN
3382
i_nargs_ FCN((n,pargs))
3383
int n C0("")
3384
PARGS pargs C1("")
3385
{
3386
text_pointer m;
3387
eight_bits*pa= pargs[0]+1;
3388
3389
if((m= MAC_LOOKUP(IDENTIFIER(pa[0],pa[1])))==NULL)
3390
{
3391
3392
macro_err(OC("! Argument of $NARGS is not a WEB macro"),YES);
3393
put_long(-1L);
3394
}
3395
else put_long((long)m->nargs);
3396
}
3397
3398
3399
SRTN
3400
put_long FCN((l))
3401
long l C1("")
3402
{
3403
outer_char temp[100];
3404
int n;
3405
3406
n=
3407
nsprintf(temp,OC("%ld"),1,l);
3408
to_ASCII(temp);
3409
MCHECK(n+2,"long");
3410
*mp++= constant;
3411
STRCPY(mp,temp);
3412
mp+= n;
3413
*mp++= constant;
3414
}
3415
3416
3417
SRTN
3418
chk_args FCN((name,proper_num,actual_num,pargs))
3419
outer_char*name C0("")
3420
int proper_num C0("")
3421
int actual_num C0("")
3422
PARGS pargs C1("")
3423
{
3424
if(proper_num>=0)
3425
{
3426
if(actual_num!=proper_num)
3427
3428
macro_err(OC("Built-in macro %s should be called with %d \
3429
argument(s), not %d"),NO,name,proper_num,actual_num);
3430
}
3431
}
3432
3433
3434
SRTN
3435
see_macro FCN((p0,p1))
3436
CONST eight_bits HUGE*p0 C0("Beginning of token list.")
3437
CONST eight_bits HUGE*p1 C1("End of token list.")
3438
{
3439
int k,l,num_tokens;
3440
ASCII HUGE*q0;
3441
sixteen_bits HUGE*tokens;
3442
ASCII HUGE*mtext;
3443
3444
num_tokens= PTR_DIFF(int,p1,p0);
3445
3446
tokens= GET_MEM("see_macro:tokens",num_tokens,sixteen_bits);
3447
mtext= GET_MEM("see_macro:mtext",MTEXT_SIZE,ASCII);
3448
3449
k= rcvr_macro(mtext,tokens,p0,p1);
3450
3451
printf(">> \"");
3452
for(l= 0;l<k;++l)
3453
printf(_Xx("%x "),tokens[l]);
3454
3455
printf("\"\n== \"");
3456
for(q0= mtext;q0<mtext+k;++q0)
3457
putchar(XCHR(*q0));
3458
puts("\"");
3459
3460
FREE_MEM(mtext,"see_macro:mtext",MTEXT_SIZE,ASCII);
3461
if(num_tokens)FREE_MEM(tokens,"see_macro:tokens",num_tokens,sixteen_bits);
3462
}
3463
3464
3465
int
3466
rcvr_macro FCN((mtext,tokens,p0,p1))
3467
ASCII HUGE*mtext C0("Holds readable translation of the text.")
3468
sixteen_bits HUGE*tokens C0("Slightly translated tokens.")
3469
CONST eight_bits HUGE*p0 C0("")
3470
CONST eight_bits HUGE*p1 C1("")
3471
{
3472
ASCII HUGE*mtext_end= mtext+MTEXT_SIZE;
3473
ASCII HUGE*p;
3474
ASCII HUGE*j;
3475
int k;
3476
sixteen_bits a;
3477
3478
for(k= 0,p= mtext;p0<p1;k++)
3479
{
3480
if(TOKEN1(a= *p0++))
3481
switch(a)
3482
{
3483
case paste:
3484
SAVE_MTEXT(043);SAVE_MTEXT(043);
3485
break;
3486
3487
default:
3488
SAVE_MTEXT(a);
3489
break;
3490
}
3491
else if(a==MACRO_ARGUMENT)
3492
{
3493
SAVE_MTEXT(044);
3494
a= (sixteen_bits)(-(*p0));
3495
SAVE_MTEXT(*p0+++060);
3496
}
3497
else
3498
{
3499
a= IDENTIFIER(a,*p0++);
3500
3501
if(a<MODULE_NAME)
3502
{
3503
CONST ASCII HUGE*end;
3504
name_pointer np= name_dir+a;
3505
3506
PROPER_END(end);
3507
3508
for(j= np->byte_start;j<end;++j)
3509
{SAVE_MTEXT(*j);}
3510
}
3511
else
3512
{
3513
SAVE_MTEXT(0115);
3514
}
3515
}
3516
3517
if(tokens)tokens[k]= a;
3518
}
3519
3520
return k;
3521
}
3522
3523
3524
SRTN
3525
i_xflag_ FCN((n,pargs))
3526
int n C0("")
3527
PARGS pargs C1("")
3528
{
3529
eight_bits HUGE*p= pargs[0]+1;
3530
outer_char temp[100],*t= temp;
3531
3532
CHK_ARGS("$XX",1);
3533
3534
if(*p++!=constant)
3535
{
3536
3537
macro_err(OC("Argument of $XX is not a numerical constant"),NO);
3538
return;
3539
}
3540
3541
while(*p!=constant)
3542
*t++= XCHR(*p++);
3543
3544
TERMINATE(t,0);
3545
3546
xflag= ATOI(temp);
3547
}
3548
3549
3550
SRTN
3551
i_dumpdef_ FCN((n,pargs))
3552
int n C0("")
3553
PARGS pargs C1("")
3554
{
3555
int k;
3556
eight_bits HUGE*p,HUGE*mp0,HUGE*mp1,HUGE*mp2;
3557
sixteen_bits a;
3558
extern long cur_val;
3559
eight_bits HUGE*q0,HUGE*q1;
3560
ASCII HUGE*mtext= GET_MEM("rcvr_macro:mtext",MTEXT_SIZE,ASCII);
3561
ASCII HUGE*mx,HUGE*mx0;
3562
name_pointer np;
3563
3564
CHK_ARGS("$DUMPDEF",INT_MIN);
3565
3566
for(k= 0;k<n;k++)
3567
{
3568
text_pointer m;
3569
3570
if(xflag)
3571
printf("\n");
3572
3573
mp0= mp;
3574
3575
p= pargs[k]+1;
3576
3577
while(IS_WHITE(*p)||*p==012)p++;
3578
3579
a= IDENTIFIER(*p,*(p+1));
3580
3581
if((m= MAC_LOOKUP(a))==NULL)
3582
{
3583
str_to_mb(p,pargs[k+1],NO);
3584
printf("NOT WEB MACRO: %s\n",(char*)to_outer((ASCII*)mp0));
3585
}
3586
else
3587
3588
{
3589
p+= 2;
3590
3591
3592
np= name_dir+a;
3593
3594
for(mx= mtext,mx0= np->byte_start;mx0<(np+1)->byte_start;)
3595
*mx++= *mx0++;
3596
3597
*mx++= '\0';
3598
to_outer(mtext);
3599
3600
3601
if(m->built_in)
3602
{
3603
cur_val= a;
3604
STRCPY(mp0,"<built-in>");
3605
mp= mp0+STRLEN(mp0)+1;
3606
}
3607
else
3608
{
3609
q0= m->tok_start+m->moffset;
3610
q1= m->tok_start+m->nbytes;
3611
3612
str_to_mb(q0,q1,NO);
3613
mp++;
3614
to_outer((ASCII*)mp0);
3615
}
3616
3617
3618
printf("%s",(char*)mtext);
3619
3620
if(m->nargs||m->var_args)
3621
{
3622
eight_bits n;
3623
3624
printf("(");
3625
for(n= 0;n<m->nargs;n++)
3626
printf("$%d%s",(int)n,
3627
CHOICE(n==(eight_bits)(m->nargs-1),"",","));
3628
if(m->var_args)printf("%s...",
3629
CHOICE(m->nargs,",",""));
3630
printf(")");
3631
}
3632
3633
printf(" = %s\n",(char*)(mp= mp0));
3634
3635
if(xflag)
3636
{
3637
3638
mp0= mp;
3639
str_to_mb(p,pargs[k+1],NO);
3640
mp++;
3641
to_outer((ASCII*)mp0);
3642
3643
3644
mp1= xmacro(m,&p,&pargs[k+1],NO,mp);
3645
*mp++= '\0';
3646
mp2= mp;
3647
str_to_mb(mp1,mp,NO);
3648
mp++;
3649
to_outer((ASCII*)mp2);
3650
3651
printf("%s%s = %s\n",(char*)mtext,(char*)mp0,(char*)(mp= mp2));
3652
3653
if(p!=pargs[k+1])
3654
3655
err0_print(ERR_M,OC("Extra text after macro call"),0);
3656
}
3657
}
3658
3659
3660
3661
3662
mp= mp0;
3663
}
3664
3665
FREE_MEM(mtext,"_dumpdef_:mtext",MTEXT_SIZE,ASCII);
3666
}
3667
3668
3669
SRTN
3670
i_keyword_ FCN((n,pargs))
3671
int n C0("")
3672
PARGS pargs C1("")
3673
{
3674
eight_bits HUGE*p= pargs[0]+1,HUGE*p1= pargs[1];
3675
3676
CHK_ARGS("$KEYWORD",1);
3677
3678
if(*p!=stringg)
3679
{
3680
MUST_QUOTE("$KEYWORD",p,p1);
3681
return;
3682
}
3683
3684
MCHECK(1,"stringg0");
3685
*mp++= *p++;
3686
3687
x_keyword(&mp,macrobuf_end,p,p1-1,YES,YES,WEB_FILE);
3688
3689
MCHECK(1,"stringg1");
3690
*mp++= stringg;
3691
}
3692
3693
Loggerhead is a web-based interface for Breezy
Version: 2.0.1