« back to all changes in this revision
Viewing changes to Web/ftangle.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/ftangle.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/ftangle -A -# --F -= 1.62/Web/ftangle.c"\
5
RUN TIME: "Friday, September 25, 1998 at 8:02."\
6
WEB FILE: "Web/ftangle.web"\
7
CHANGE FILE: (none)
8
#endif
9
#define _FTANGLE_h
10
#define _FWEB_h \
11
12
#define semi 01 \
13
14
#define SILENT (boolean)NO
15
#define COMPLAIN (boolean)YES \
16
17
#define OUTER_MACRO 0xFF
18
#define OUTER_UNMACRO 0xFE
19
#define UNDEFINED_MACRO 0xFD \
20
21
#define MAX_XLEVELS 200 \
22
23
#define equiv equiv_or_xref
24
#define EQUIV ASCII HUGE* \
25
\
26
\
27
28
#define MAC_LOOKUP(cur_val)(cur_val<MODULE_NAME? \
29
(text_pointer)(name_dir+(cur_val))->equiv:NULL) \
30
31
#define macro 0 \
32
\
33
\
34
\
35
36
#define NOT_DEFINED 0
37
#define DEFERRED_MACRO 1 \
38
39
#define IMMEDIATE_MACRO 2
40
#define FILE_NAME 3 \
41
\
42
43
#define MCHECK(n,reason)if(mp+(n)>macrobuf_end) \
44
mbuf_full((unsigned long)(n),(outer_char*)reason) \
45
46
#define RST_LAST_EXPR {plast_char= last_char;last_xpr_overflowed= NO;} \
47
48
#define INDENT_SIZE 2 \
49
\
50
51
#define NO_INDENT 0
52
#define INDENT 2 \
53
54
#define OUT_FILE outp_file[lan_num(out_language)] \
55
\
56
57
#define C_printf(c,a) \
58
{ \
59
if(!out_file)open_out(OC(""),YES); \
60
if(fprintf(out_file,c,a)<0)out_error(OC("fprintf")); \
61
} \
62
63
#define NOT_CONTINUATION 0
64
#define CONTINUATION 1 \
65
66
#define N_STRBUF 150 \
67
68
#define send_new_line RST_LAST_EXPR flush0();PUTC('\n') \
69
70
#define NEWLINE_TO_FORTRAN(continuation_flag) \
71
flush_out(YES); \
72
rst_out(continuation_flag) \
73
\
74
75
#define TO_BUFFER(type) \
76
if(!nuweb_mode) \
77
{ \
78
px= t_style.meta[lan_num(language)].msg.type; \
79
STRCPY(outp_buf,px); \
80
out_pos= STRLEN(px); \
81
} \
82
83
#define CUR_BUF (pai->text_buf[pai->ilevel]) \
84
85
#define module_flag (sixteen_bits)max_texts \
86
\
87
88
#define cur_end cur_state.end_field
89
#define cur_byte cur_state.byte_field
90
#define cur_name cur_state.name_field
91
#define cur_repl cur_state.repl_field
92
#define cur_mod cur_state.mod_field \
93
94
#define cur_language cur_state.language
95
#define cur_global_language cur_state.global_params.Language \
96
\
97
\
98
99
#define cur_params cur_state.params
100
#define cur_global_params cur_state.global_params \
101
\
102
103
#define macrobuf cur_state.macro_buf
104
#define cur_mp cur_state.mp
105
#define macrobuf_end cur_state.macro_buf_end \
106
107
#define UNNAMED_MODULE 0 \
108
109
#define UNNAMED_MOD "unnamed"
110
#define flush_buffer()C_putc('\n') \
111
112
#define NEWLINE puts("") \
113
114
#define BP_MARKER 1 \
115
116
#define PROPER_END(end) \
117
end= (np+1)->byte_start; \
118
if(*end==BP_MARKER&&np!=npmax)end= ((BP*)end)->byte_start \
119
120
#define MAX_ID_LENGTH 32 \
121
122
#define GLOBAL_SCOPE YES
123
#define LOCAL_SCOPE NO \
124
125
#define CHECK_OPEN if(!out_file)open_out(OC(""),GLOBAL_SCOPE) \
126
127
#define OUT_OP(s)out_op(OC(s))
128
#define OUT_STR(s)out_str(OC(s)) \
129
130
#define F_OP(op77,op88)(Fortran88?op88:op77) \
131
132
#define LINE_CHAR '@' \
133
134
#define stringg (eight_bits)02
135
#define constant (eight_bits)03
136
#define begin_Xmeta or_or
137
#define end_Xmeta star_star
138
#define cdir (eight_bits)06
139
#define colon_colon (eight_bits)011 \
140
141
#define join (eight_bits)0177 \
142
143
#define ID0 0200
144
#define TOKEN1(a)((a)<ID0) \
145
146
#define MACRO_ARGUMENT 0377 \
147
148
#define BASE2 0400 \
149
150
#define MODULE_NAME 10240
151
#define MODULE_NUM 20480
152
#define LINE_NUM 53248L \
153
154
#define IDENTIFIER(left,right) \
155
((sixteen_bits)(((left)-ID0)*BASE2+(sixteen_bits)(right))) \
156
\
157
158
#define LEFT(a,id)((eight_bits)(((a)/BASE2+(id)))) \
159
160
#define RIGHT(a)((eight_bits)(((a)%BASE2))) \
161
162
#define ignore 0 \
163
164
#define begin_comment0 (eight_bits)0376
165
#define begin_comment1 (eight_bits)0375 \
166
167
#define module_number (eight_bits)0201
168
#define identifier (eight_bits)0202
169
#define id_keyword (eight_bits)0203 \
170
171
#define L_switch (eight_bits)0257
172
#define begin_FORTRAN (eight_bits)0260
173
#define begin_RATFOR (eight_bits)0261
174
#define begin_C (eight_bits)0262
175
#define begin_LITERAL (eight_bits)0263 \
176
177
#define verbatim (eight_bits)0264 \
178
\
179
180
#define invisible_cmnt (eight_bits)0265
181
#define compiler_directive (eight_bits)0266
182
#define Compiler_Directive (eight_bits)0267 \
183
184
#define keyword_name (eight_bits)0270 \
185
186
#define no_index (eight_bits)0300
187
#define yes_index (eight_bits)0301 \
188
189
#define ascii_constant (eight_bits)0302
190
#define begin_vcmnt (eight_bits)0303
191
#define big_line_break (eight_bits)0304 \
192
193
#define begin_bp (eight_bits)0305
194
#define insert_bp (eight_bits)0306 \
195
196
#define begin_meta (eight_bits)017
197
#define end_meta (eight_bits)027 \
198
199
#define TeX_string (eight_bits)0307
200
#define xref_roman (eight_bits)0310
201
#define xref_typewriter (eight_bits)0311
202
#define xref_wildcard (eight_bits)0312 \
203
204
#define control_text (eight_bits)0313 \
205
206
#define begin_nuweb (eight_bits)0314
207
#define no_mac_expand (eight_bits)0315
208
#define set_line_info (eight_bits)0316
209
#define short_fcn (eight_bits)0317 \
210
211
#define formatt (eight_bits)0320 \
212
213
#define limbo_text (eight_bits)0323
214
#define op_def (eight_bits)0324
215
#define macro_def (eight_bits)0325 \
216
217
#define ignore_defn (eight_bits)0327 \
218
219
#define new_output_file (eight_bits)0331 \
220
221
#define definition (eight_bits)0332
222
#define undefinition (eight_bits)0333
223
#define WEB_definition (eight_bits)0334 \
224
225
#define m_ifdef (eight_bits)0335
226
#define m_ifndef (eight_bits)0336
227
#define m_if (eight_bits)0337
228
#define m_else (eight_bits)0340
229
#define m_elif (eight_bits)0341
230
#define m_endif (eight_bits)0342
231
#define m_for (eight_bits)0343
232
#define m_endfor (eight_bits)0344
233
#define m_line (eight_bits)0345
234
#define m_undef (eight_bits)0346 \
235
236
#define end_of_buffer (eight_bits)0347 \
237
238
#define begin_code (eight_bits)0350
239
#define module_name (eight_bits)0351 \
240
241
#define new_module (eight_bits)0352 \
242
243
#define MAYBE_SET_OUTPUT(l)if(last_char!=0174)set_output_file(l) \
244
245
#define RETURN(pcode)return(eight_bits)pcode \
246
247
#define compress(c)if(loc++<=limit)return(eight_bits)(c)
248
#define Fcompress(c)if(is_FORTRAN_(language)&&loc<limit) \
249
return(eight_bits)(c)
250
#define STOP (boolean)YES
251
#define DONT_STOP (boolean)NO \
252
\
253
254
#define app_repl(c){if(tok_ptr==tok_m_end) \
255
OVERFLW("tokens","tt"); \
256
*tok_ptr++= (eight_bits)(c);} \
257
258
#define BP_BUF_SIZE (13+MAX_ID_LENGTH) \
259
\
260
\
261
262
#define N_IDBUF 100
263
#define TOO_BIG \
264
\
265
err0_print(ERR_T,OC("Construction too big to convert on \
266
this machine; max is 0x%x"),1,ULONG_MAX); \
267
268
#define MAX_LEVEL 20 \
269
\
270
\
271
272
#define EXPAND YES \
273
274
#define DEF_OR_NDEF(flag) \
275
found_else= NO; \
276
if(!expand) \
277
{ \
278
to_endif(m_ifdef); \
279
goto next_macro_token; \
280
} \
281
else \
282
{ \
283
text_pointer m; \
284
if((next_control= get_next())!=identifier) \
285
{ \
286
\
287
err0_print(ERR_T,OC("Expected identifier after @#ifdef \
288
or @#ifndef; assuming not defined"),0); \
289
if_switch= NO; \
290
} \
291
else if_switch= \
292
BOOLEAN(flag((m= MAC_LOOKUP(ID_NUM(id_first,id_loc)))!=NULL \
293
&&!(m->built_in))); \
294
\
295
if(if_switch) \
296
{ \
297
GET_LINE; \
298
\
299
scan_text(text_type,p,if_switch); \
300
} \
301
else \
302
{ \
303
expand= NO;to_else(); \
304
\
305
if(next_control!=m_endif) \
306
{ \
307
scanned_if= YES; \
308
goto next_macro_token; \
309
} \
310
else \
311
{ \
312
next_control= ignore; \
313
expand= YES; \
314
GET_LINE; \
315
\
316
break; \
317
} \
318
} \
319
} \
320
\
321
\
322
323
#define M_TRUE
324
#define M_FALSE ! \
325
326
#define GET_LINE \
327
if(!from_buffer) \
328
if(language!=TEX) \
329
get_line() \
330
331
#define OUT_OF_ORDER(cmd)out_of_order((outer_char*)cmd) \
332
333
#define IS_PROTECTED(np)((npq= (text_pointer)(np->equiv))&&npq->protected) \
334
335
#define LKWD "$L_KEYWORD" \
336
337
#define SPCS_AFTER_CMNT 1 \
338
339
340
341
342
#ifndef part
343
#define part 0
344
#else
345
#if(part != 1 && part != 2 && part != 3)
346
#define part 1
347
#endif
348
#endif
349
350
351
352
353
#if(part == 0 || part == 1)
354
#define part1_or_extern
355
#define SET1(stuff) = stuff
356
#define TSET1(stuff) = stuff
357
#else
358
#define part1_or_extern extern
359
#define SET1(stuff)
360
#define TSET1(stuff)
361
#endif
362
363
364
365
366
367
#include "typedefs.h"
368
369
370
371
372
373
374
375
#include "map.h"
376
377
378
379
380
381
typedef enum{BAD_TOKEN,OR_OR,AND_AND,BIT_OR,BIT_XOR,BIT_AND,LOG_EQ,LOG_LT,
382
BIT_SHIFT,PLUS_MINUS,TIMES,EXP,UNARY,HIGHEST_UNARY}PRECEDENCE;
383
384
385
typedef struct
386
{
387
eight_bits token;
388
PRECEDENCE precedence;
389
}OP;
390
391
392
typedef union
393
{
394
long i;
395
double d;
396
sixteen_bits id;
397
OP op;
398
}VALUE;
399
400
401
402
typedef enum{Int,Double,Id,Op}TYPE;
403
404
405
406
typedef struct val
407
{
408
VALUE value;
409
TYPE type;
410
struct val HUGE*last,HUGE*next;
411
}VAL;
412
413
414
415
416
typedef struct
417
{
418
sixteen_bits token[MAX_XLEVELS];
419
int level;
420
}XIDS;
421
422
423
424
425
426
typedef struct
427
{
428
outer_char HUGE*start,HUGE*pos,HUGE*end;
429
}TEXT_BUF;
430
431
432
typedef struct
433
{
434
int ilevel;
435
TEXT_BUF HUGE*HUGE*text_buf;
436
TEXT_BUF HUGE*last_buf;
437
}PAREN_LEVEL;
438
439
EXTERN PAREN_LEVEL HUGE*paren_level,HUGE*paren_level_end,HUGE*pai;
440
441
EXTERN int rparen TSET(NO);
442
443
444
445
446
typedef struct
447
{
448
eight_bits HUGE*tok_start;
449
450
sixteen_bits text_link;
451
boolean Language;
452
eight_bits nargs;
453
unsigned
454
moffset:8,
455
recursive:1,
456
var_args:1,
457
module_text:1,
458
built_in:1,
459
protected:1,
460
nbytes:19;
461
}text;
462
463
typedef text HUGE*text_pointer;
464
465
466
467
typedef struct{
468
eight_bits HUGE*end_field;
469
eight_bits HUGE*byte_field;
470
name_pointer name_field;
471
text_pointer repl_field;
472
sixteen_bits mod_field;
473
PARAMS global_params,params;
474
eight_bits HUGE*macro_buf,HUGE*mp,HUGE*macro_buf_end;
475
476
}output_state;
477
478
typedef output_state HUGE*stack_pointer;
479
480
481
482
#if(0)
483
IN_COMMON boolean truncate_ids;
484
IN_COMMON unsigned short tr_max[];
485
IN_COMMON name_pointer npmax;
486
#endif
487
488
489
typedef struct Bp
490
{
491
ASCII c;
492
LANGUAGE Language;
493
CONST ASCII HUGE*byte_start,HUGE*byte_end;
494
495
struct Bp HUGE*next;
496
497
struct Trunc HUGE*Root;
498
}BP;
499
500
501
typedef struct Trunc
502
{
503
boolean Language;
504
size_t num[NUM_LANGUAGES];
505
506
ASCII HUGE*id,HUGE*id_end;
507
BP HUGE*first,HUGE*last;
508
struct Trunc HUGE*next;
509
}TRUNC;
510
511
512
513
typedef struct
514
{
515
ASCII HUGE*start,HUGE*end;
516
}TEMPLATE;
517
518
519
520
521
#include "t_type.h"
522
523
524
525
526
527
528
529
#ifdef SMALL_MEMORY
530
#define N_MSGBUF 2000
531
#else
532
#define N_MSGBUF 10000
533
#endif
534
535
536
537
538
539
IN_COMMON STMT_LBL max_stmt;
540
541
EXTERN sixteen_bits outp_line[NUM_LANGUAGES]
542
#ifdef _FTANGLE_h
543
#if(part == 0 || part == 1)
544
= {1,1,1,1,1,1,1,1}
545
#endif
546
#endif
547
;
548
549
550
551
552
EXTERN int indnt_size SET(INDENT_SIZE);
553
554
555
EXTERN outer_char HUGE*last_char,HUGE*last_end;
556
EXTERN outer_char HUGE*plast_char;
557
EXTERN BUF_SIZE max_expr_chars;
558
559
EXTERN boolean last_xpr_overflowed SET(NO);
560
561
EXTERN int indent_level SET(0);
562
563
564
565
566
EXTERN outer_char HUGE*C_buffer,HUGE*pC_end;
567
EXTERN outer_char HUGE*pC_buffer;
568
EXTERN BUF_SIZE C_buf_size;
569
570
571
EXTERN outer_char HUGE*split_pos;
572
573
574
EXTERN outer_char HUGE*X_buffer,HUGE*pX_end;
575
EXTERN outer_char HUGE*pX_buffer;
576
EXTERN BUF_SIZE X_buf_size;
577
578
579
580
EXTERN int rst_pos SET(0);
581
EXTERN int out_pos SET(0);
582
EXTERN boolean in_string SET(NO);
583
EXTERN boolean in_constant SET(NO);
584
EXTERN boolean started_vcmnt SET(NO);
585
EXTERN boolean meta_mode SET(NO);
586
587
588
589
IN_COMMON outer_char outp_buf[];
590
IN_COMMON int nbuf_length;
591
EXTERN boolean out_at_beginning SET(YES);
592
593
594
595
EXTERN long max_texts;
596
EXTERN text HUGE*text_info;
597
EXTERN text_pointer text_end;
598
599
EXTERN long dtexts_max;
600
EXTERN text HUGE*txt_dinfo;
601
EXTERN text_pointer textd_end;
602
603
EXTERN text_pointer text_ptr,txt_dptr;
604
605
606
EXTERN long max_toks;
607
EXTERN eight_bits HUGE*tok_mem;
608
EXTERN eight_bits HUGE*tok_m_end;
609
610
EXTERN long max_dtoks;
611
EXTERN eight_bits HUGE*tok_dmem;
612
EXTERN eight_bits HUGE*tokd_end;
613
614
EXTERN eight_bits HUGE*tok_ptr,HUGE*tok_dptr;
615
616
EXTERN eight_bits HUGE*mx_tok_ptr,HUGE*mx_dtok_ptr;
617
618
619
EXTERN text_pointer macro_text;
620
621
622
623
624
EXTERN text_pointer last_unnamed;
625
626
627
628
629
EXTERN output_state cur_state;
630
631
632
EXTERN long stck_size;
633
EXTERN output_state HUGE*stack;
634
EXTERN stack_pointer stck_end;
635
EXTERN stack_pointer stck_ptr;
636
637
638
639
640
641
642
#undef begin_format_stmt
643
#define begin_format_stmt (eight_bits)014
644
645
#undef end_format_stmt
646
#define end_format_stmt (eight_bits)015
647
648
EXTERN long cur_val;
649
650
651
652
653
654
655
EXTERN eight_bits sent;
656
657
658
659
IN_RATFOR sixteen_bits id_function,id_program,id_subroutine;
660
661
662
663
EXTERN sixteen_bits cur_mod_no SET(0);
664
665
666
667
EXTERN OUTPUT_STATE out_state;
668
EXTERN boolean protect;
669
EXTERN boolean copying_macros SET(NO);
670
EXTERN boolean in_cdir SET(NO);
671
672
673
674
EXTERN TRUNC sh;
675
676
677
678
EXTERN boolean mac_protected SET(NO);
679
680
EXTERN boolean send_rp SET(NO);
681
682
683
684
EXTERN boolean in_version SET(NO);
685
EXTERN T_META*pmeta;
686
687
688
689
EXTERN OPEN_FILE HUGE*open_file,HUGE*open_file_end,HUGE*last_file;
690
EXTERN BUF_SIZE num_files;
691
692
693
694
EXTERN LINE_NUMBER nearest_line SET(0);
695
696
697
698
IN_STYLE eight_bits ccode[128];
699
700
701
702
EXTERN boolean comment_continues SET(NO);
703
704
705
706
EXTERN name_pointer cur_module SET(NULL);
707
EXTERN ASCII c;
708
EXTERN boolean strt_cmnt;
709
EXTERN boolean strt_point_cmnt;
710
EXTERN boolean suppress_newline;
711
EXTERN boolean eat_blank_lines;
712
EXTERN boolean no_expand SET(NO);
713
EXTERN boolean insrt_line SET(NO);
714
715
716
717
EXTERN boolean starts_with_0,hex_constant,bin_constant,floating_constant;
718
719
720
721
EXTERN text_pointer cur_text;
722
723
EXTERN eight_bits next_control;
724
EXTERN boolean scanning_meta SET(NO);
725
EXTERN boolean macro_scan SET(NO);
726
727
728
729
EXTERN boolean breakpoints;
730
731
732
733
EXTERN int n_unique SET(0);
734
EXTERN boolean deferred_macro SET(NO);
735
736
737
738
EXTERN boolean is_WEB_macro SET(NO);
739
EXTERN boolean scanning_defn;
740
EXTERN boolean scanning_TeX;
741
742
EXTERN boolean nuweb_mode1;
743
744
EXTERN int mlevel SET(0);
745
746
747
748
EXTERN boolean found_else SET(NO);
749
750
751
752
text_pointer npq;
753
754
755
756
sixteen_bits lkwd;
757
758
759
760
EXTERN sixteen_bits num_distinct_modules SET(1);
761
EXTERN sixteen_bits num_modules;
762
763
764
765
#if SMALL_MEMORY
766
#define MSG_BUF_SIZE 5000
767
#else
768
#define MSG_BUF_SIZE 50000L
769
#endif
770
771
772
773
774
775
#if(part == 0 || part == 1)
776
777
778
int main FCN((ac,av))
779
int ac C0("Number of arguments.")
780
outer_char**av C1("Argument list.")
781
{
782
#if TIMING
783
ini_timer();
784
785
#endif
786
787
788
argc= ac;argv= av;
789
790
ini_program(tangle);
791
792
793
{
794
795
{
796
ALLOC(OPEN_FILE,open_file,"nf",num_files,0);
797
last_file= open_file;
798
open_file_end= open_file+num_files;
799
}
800
801
802
common_init();
803
804
805
ALLOC(outer_char,last_char,"lx",max_expr_chars,0);
806
last_end= last_char+max_expr_chars;
807
plast_char= last_char;
808
809
810
811
812
ALLOC(outer_char,C_buffer,"cb",C_buf_size,0);
813
pC_end= C_buffer+C_buf_size-1;
814
pC_buffer= C_buffer;
815
816
#if FANCY_SPLIT
817
818
{
819
split_pos= C_buffer;
820
}
821
822
823
#endif
824
825
826
ALLOC(outer_char,X_buffer,"xb",X_buf_size,0);
827
pX_end= X_buffer+X_buf_size;
828
pX_buffer= X_buffer;
829
830
831
{
832
paren_level= GET_MEM("paren_level",t_style.paren.nest,PAREN_LEVEL);
833
paren_level_end= paren_level+t_style.paren.nest;
834
835
836
for(pai= paren_level;pai<paren_level_end;pai++)
837
pai->text_buf= GET_MEM("pai->text_buf",t_style.paren.num,
838
TEXT_BUF HUGE*);
839
840
pai= paren_level;
841
pai->ilevel= 0;
842
pai->text_buf[0]= pai->last_buf= calloc(1,sizeof(TEXT_BUF));
843
}
844
845
846
847
alloc_Rat();
848
849
ALLOC(text,text_info,"x",max_texts,0);
850
text_end= text_info+max_texts-1;
851
852
ALLOC(text,txt_dinfo,"dx",dtexts_max,0);
853
textd_end= txt_dinfo+dtexts_max-1;
854
855
ALLOC(eight_bits,tok_mem,"tt",max_toks,0);
856
tok_m_end= tok_mem+max_toks-1;
857
858
ALLOC(eight_bits,tok_dmem,"dt",max_dtoks,0);
859
tokd_end= tok_dmem+max_dtoks-1;
860
861
862
863
ALLOC(output_state,stack,"kt",stck_size,1);
864
stck_end= stack+stck_size;
865
866
867
{
868
BUF_SIZE cur_num= last_file-open_file;
869
870
871
alloc((outer_char*)"nf",(BUF_SIZE HUGE*)&num_files,
872
sizeof(*open_file),-1);
873
874
875
open_file= (OPEN_FILE*)REALLOC(open_file,
876
num_files*sizeof(OPEN_FILE),cur_num*sizeof(OPEN_FILE));
877
last_file= open_file+cur_num;
878
open_file_end= open_file+num_files;
879
}
880
881
882
883
884
CAST(text_pointer,text_info)->tok_start= tok_ptr= tok_mem;
885
CAST(text_pointer,txt_dinfo)->tok_start= tok_dptr= tok_dmem;
886
887
888
text_ptr= text_info+1;text_ptr->tok_start= tok_mem;
889
txt_dptr= txt_dinfo+1;txt_dptr->tok_start= tok_dmem;
890
891
892
893
CAST(name_pointer,name_dir)->equiv= (EQUIV)text_info;
894
895
896
897
last_unnamed= text_info;
898
CAST(text_pointer,text_info)->text_link= 0;
899
900
901
902
zero_ccodes();
903
ccode[057]= begin_vcmnt;
904
905
906
907
908
{
909
910
ini_ccode((outer_char*)"new_module",(outer_char*)" \t*",new_module);
911
912
913
ini_ccode((outer_char*)"begin_code",(outer_char*)"aA",begin_code);
914
915
ini_ccode((outer_char*)"module_name",(outer_char*)"<",module_name);
916
917
918
ini_ccode((outer_char*)"definition",(outer_char*)"dD",definition);
919
920
ini_ccode((outer_char*)"undefinition",(outer_char*)"uU",undefinition);
921
922
ini_ccode((outer_char*)"WEB_definition",(outer_char*)"mM",WEB_definition);
923
924
ini_ccode((outer_char*)"formatt",(outer_char*)"fF",formatt);
925
926
927
ini_ccode((outer_char*)"ascii_constant",(outer_char*)"'\"",ascii_constant);
928
929
ini_ccode((outer_char*)"verbatim",(outer_char*)"=",verbatim);
930
931
932
ini_ccode((outer_char*)"TeX_string",(outer_char*)"tT",TeX_string);
933
934
935
ini_ccode((outer_char*)"L_switch",(outer_char*)"L",L_switch);
936
937
ini_ccode((outer_char*)"begin_C",(outer_char*)"c",begin_C);
938
939
ini_ccode((outer_char*)"begin_RATFOR",(outer_char*)"r",begin_RATFOR);
940
941
ini_ccode((outer_char*)"begin_FORTRAN",(outer_char*)"n",begin_FORTRAN);
942
943
ini_ccode((outer_char*)"begin_nuweb",(outer_char*)"N",begin_nuweb);
944
945
946
ini_ccode((outer_char*)"join",(outer_char*)"&",join);
947
948
949
ini_ccode((outer_char*)"Compiler_Directive",(outer_char*)"?",Compiler_Directive);
950
951
ini_ccode((outer_char*)"invisible_cmnt",(outer_char*)"%",invisible_cmnt);
952
953
954
955
ini_ccode((outer_char*)"xref_roman",(outer_char*)"^",xref_roman);
956
957
ini_ccode((outer_char*)"xref_typewriter",(outer_char*)".",xref_typewriter);
958
959
ini_ccode((outer_char*)"xref_wildcard",(outer_char*)"9",xref_wildcard);
960
961
962
ini_ccode((outer_char*)"big_line_break",(outer_char*)"#",big_line_break);
963
964
965
ini_ccode((outer_char*)"begin_meta",(outer_char*)"(",begin_meta);
966
967
ini_ccode((outer_char*)"end_meta",(outer_char*)")",end_meta);
968
969
970
ini_ccode((outer_char*)"limbo_text",(outer_char*)"l",limbo_text);
971
972
ini_ccode((outer_char*)"op_def",(outer_char*)"vV",op_def);
973
974
ini_ccode((outer_char*)"macro_def",(outer_char*)"wW",macro_def);
975
976
ini_ccode((outer_char*)"short_fcn",(outer_char*)"{",short_fcn);
977
978
979
ini_ccode((outer_char*)"begin_bp",(outer_char*)"B",begin_bp);
980
981
ini_ccode((outer_char*)"insert_bp",(outer_char*)"}b",insert_bp);
982
983
984
ini_ccode((outer_char*)"no_mac_expand",(outer_char*)"!",no_mac_expand);
985
986
ini_ccode((outer_char*)"set_line_info",(outer_char*)"q",set_line_info);
987
988
989
ini_ccode((outer_char*)"new_output_file",(outer_char*)"oO",new_output_file);
990
991
992
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"\001",USED_BY_OTHER);
993
#if 0
994
995
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"/",USED_BY_OTHER);
996
#endif
997
998
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"\\",USED_BY_OTHER);
999
1000
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"_",USED_BY_OTHER);
1001
1002
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"[",USED_BY_OTHER);
1003
1004
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"`]",USED_BY_OTHER);
1005
1006
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"$",USED_BY_OTHER);
1007
1008
1009
ini_ccode((outer_char*)"keyword_name",(outer_char*)"kK",keyword_name);
1010
1011
{
1012
char temp[3];
1013
1014
sprintf(temp,";%c",XCHR(interior_semi));
1015
1016
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)temp,USED_BY_OTHER);
1017
}
1018
1019
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"e",USED_BY_OTHER);
1020
1021
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)":",USED_BY_OTHER);
1022
1023
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)",",USED_BY_OTHER);
1024
1025
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"|",USED_BY_OTHER);
1026
1027
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"~",USED_BY_OTHER);
1028
1029
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"-",USED_BY_OTHER);
1030
1031
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"+",USED_BY_OTHER);
1032
1033
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"p",USED_BY_OTHER);
1034
#if(DEBUG)
1035
1036
ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"012",USED_BY_OTHER);
1037
#endif
1038
}
1039
1040
1041
1042
{
1043
reassign(xref_roman,control_text);
1044
reassign(xref_typewriter,control_text);
1045
reassign(xref_wildcard,control_text);
1046
reassign(TeX_string,control_text);
1047
1048
reassign(verbatim,stringg);
1049
}
1050
1051
1052
prn_codes();
1053
1054
1055
1056
mod_text[0]= 040;
1057
1058
1059
ini_internal_fcns();
1060
ini_Ratfor();
1061
}
1062
1063
1064
1065
1066
;
1067
1068
phase1();
1069
phase2();
1070
1071
return wrap_up();
1072
}
1073
1074
1075
1076
SRTN rst_last(VOID)
1077
RST_LAST_EXPR
1078
1079
1080
1081
SRTN split_C(VOID)
1082
{
1083
#if FANCY_SPLIT
1084
1085
{
1086
1087
if(in_string&&split_pos==C_buffer)
1088
{
1089
1090
{
1091
if(!meta_mode)
1092
*pC_buffer++= '\\';
1093
1094
C_out(C_buffer,pC_buffer,&pC_buffer,OC("\n"),OC(""),NO_INDENT);
1095
1096
}
1097
1098
1099
return;
1100
}
1101
1102
*pC_buffer= '\0';
1103
split0_C(split_pos);
1104
}
1105
1106
1107
#else
1108
1109
{
1110
if(!meta_mode)
1111
*pC_buffer++= '\\';
1112
1113
C_out(C_buffer,pC_buffer,&pC_buffer,OC("\n"),OC(""),NO_INDENT);
1114
1115
}
1116
1117
1118
#endif
1119
}
1120
1121
1122
1123
#if FANCY_SPLIT
1124
1125
SRTN
1126
split0_C FCN((p))
1127
outer_char*p C1("Position for the split")
1128
{
1129
int indent;
1130
1131
1132
if(p==C_buffer)
1133
{
1134
*pC_buffer++= '\\';
1135
p= pC_buffer;
1136
indent= NO_INDENT;
1137
}
1138
else
1139
indent= INDENT;
1140
1141
C_out(C_buffer,p,&pC_buffer,OC("\n"),OC(""),indent);
1142
1143
1144
}
1145
#endif
1146
1147
1148
1149
SRTN
1150
C_out FCN((C_buffer,p,ppC_buffer,end_str,begin_str,indent))
1151
outer_char HUGE*C_buffer C0("Buffer we're working with")
1152
outer_char HUGE*p C0("End (next available pos)")
1153
outer_char HUGE*HUGE*ppC_buffer C0("")
1154
outer_char*end_str C0("")
1155
CONST outer_char*begin_str C0("")
1156
int indent C1("Should the next buffer be indented?")
1157
{
1158
int n= PTR_DIFF(int,*ppC_buffer,p);
1159
1160
if(p>C_buffer)
1161
WRITE1(C_buffer,p-C_buffer)
1162
1163
1164
if(*end_str)
1165
WRITE1(end_str,STRLEN(end_str))
1166
1167
1168
*ppC_buffer= C_buffer;
1169
1170
while(*begin_str)
1171
*(*ppC_buffer)++= *begin_str++;
1172
1173
1174
while(indent--)
1175
*(*ppC_buffer)++= ' ';
1176
1177
1178
if(n)
1179
{
1180
STRNCPY(*ppC_buffer,p,n);
1181
*ppC_buffer+= n;
1182
}
1183
1184
flush0();
1185
1186
{
1187
split_pos= C_buffer;
1188
}
1189
1190
1191
}
1192
1193
1194
1195
SRTN
1196
C_putc FCN((c))
1197
outer_char c C1("Character to be sent to output.")
1198
{
1199
static CONST outer_char HUGE*prefx= OC("");
1200
1201
CHECK_OPEN;
1202
1203
if(dbg_output)
1204
printf("c = '%c' (0x%x)\n",c,c);
1205
1206
if(at_beginning&&meta_mode&&!nuweb_mode&&(in_string||in_version))
1207
{
1208
at_beginning= NO;
1209
out_pos= 0;
1210
pmeta= &t_style.meta[lan_num(language)];
1211
prefx= OUT_STR(in_version?pmeta->hdr.prefx:pmeta->msg.prefx);
1212
}
1213
1214
switch(language)
1215
{
1216
case RATFOR:
1217
case RATFOR_90:
1218
if(!Ratfor77)
1219
{
1220
RAT_out(c);
1221
1222
break;
1223
}
1224
1225
case FORTRAN:
1226
case FORTRAN_90:
1227
if(reverse_indices
1228
&&((pai>paren_level)||rparen||!(in_string||in_version)))
1229
1230
{
1231
switch(c)
1232
{
1233
case '(':
1234
if(rparen)
1235
{
1236
1237
pai->ilevel++;
1238
1239
if(pai->ilevel==(int)t_style.paren.num)
1240
NEW_SPRM("paren.num",t_style.paren.num);
1241
1242
1243
{
1244
if(!CUR_BUF)
1245
CUR_BUF= GET_MEM("CUR_BUF",1,TEXT_BUF);
1246
}
1247
1248
1249
1250
1251
rparen= NO;
1252
}
1253
else
1254
{
1255
1256
store(CUR_BUF,'(');
1257
1258
(pai+1)->last_buf= CUR_BUF;
1259
pai++;
1260
1261
if(pai==paren_level_end)
1262
NEW_SPRM("paren.nest",t_style.paren.nest);
1263
1264
pai->ilevel= 0;
1265
1266
1267
{
1268
if(!CUR_BUF)
1269
CUR_BUF= GET_MEM("CUR_BUF",1,TEXT_BUF);
1270
}
1271
1272
1273
1274
}
1275
1276
break;
1277
1278
case ')':
1279
if(!rparen)
1280
rparen= YES;
1281
else
1282
unwind();
1283
1284
break;
1285
1286
default:
1287
if(rparen)
1288
{
1289
unwind();
1290
rparen= NO;
1291
}
1292
1293
if(in_string&&pai==paren_level)
1294
buffer_out(c);
1295
else
1296
store(CUR_BUF,c);
1297
1298
break;
1299
}
1300
}
1301
1302
1303
else
1304
buffer_out(c);
1305
1306
break;
1307
1308
case LITERAL:
1309
case TEX:
1310
1311
{
1312
*pX_buffer++= c;
1313
1314
if(c=='\n')
1315
C_out(X_buffer,pX_buffer,&pX_buffer,OC(""),
1316
(outer_char HUGE*)CHOICE(meta_mode&&language==TEX,prefx,OC("")),
1317
NO_INDENT);
1318
else if(pX_buffer==pX_end)
1319
split_X(prefx);
1320
}
1321
1322
1323
break;
1324
1325
case C:
1326
case C_PLUS_PLUS:
1327
default:
1328
#ifndef mac
1329
1330
{
1331
*pC_buffer++= c;
1332
1333
if(c=='\n')
1334
C_out(C_buffer,pC_buffer,&pC_buffer,OC(""),OC(""),NO_INDENT);
1335
1336
else if(pC_buffer==pC_end)
1337
split_C();
1338
}
1339
1340
1341
1342
1343
#else
1344
if(c=='\n')
1345
flush0();
1346
PUTC(c);
1347
#endif
1348
break;
1349
}
1350
1351
at_beginning= BOOLEAN(c=='\n');
1352
}
1353
1354
1355
1356
SRTN
1357
split_X FCN((prefx))
1358
CONST outer_char HUGE*prefx C1("")
1359
{
1360
outer_char HUGE*p= pX_buffer-1;
1361
1362
WHILE()
1363
{
1364
if(p==X_buffer)
1365
1366
{
1367
1368
err0_print(ERR_T,OC("Line had to be broken"),0);
1369
C_out(X_buffer,pX_buffer,&pX_buffer,
1370
language==TEX?OC("%\n"):OC("\n"),
1371
OC(""),NO_INDENT);
1372
return;
1373
}
1374
1375
1376
1377
if(*p==' ')
1378
{
1379
C_out(X_buffer,p+1,&pX_buffer,OC("\n"),
1380
(outer_char HUGE*)CHOICE(meta_mode&&language==TEX,
1381
prefx,OC("")),
1382
NO_INDENT);
1383
return;
1384
}
1385
1386
if(*(p--)=='\\'&&*p!='\\')
1387
{
1388
C_out(X_buffer,p+1,&pX_buffer,
1389
language==TEX?OC("%\n"):OC("\n"),
1390
(outer_char HUGE*)CHOICE(meta_mode&&language==TEX,
1391
prefx,OC("")),
1392
NO_INDENT);
1393
return;
1394
}
1395
}
1396
}
1397
1398
1399
1400
static outer_char last_out= '\0';
1401
1402
1403
static boolean is_label= NO;
1404
static boolean should_continue= NO;
1405
static continuation_line= NOT_CONTINUATION;
1406
1407
static STMT_LBL stmt_num[50];
1408
1409
static short do_level= 0;
1410
1411
1412
SRTN
1413
C_sprintf FCN(VA_ALIST((fmt,n VA_ARGS)))
1414
VA_DCL(
1415
CONST outer_char fmt[]C0("String to be printed.")
1416
int n C2("Number of arguments to follow."))
1417
{
1418
VA_LIST(arg_ptr)
1419
outer_char temp[N_STRBUF];
1420
outer_char HUGE*t;
1421
1422
VA_START(arg_ptr,n);
1423
1424
#if(NUM_VA_ARGS==1)
1425
{
1426
char*fmt0= va_arg(arg_ptr,char*);
1427
1428
va_arg(arg_ptr,int);
1429
vsprintf((char*)(char*)temp,fmt0,arg_ptr);
1430
}
1431
#else
1432
vsprintf((char*)temp,(CONST char*)fmt,arg_ptr);
1433
#endif
1434
va_end(arg_ptr);
1435
1436
for(t= temp;*t;++t)
1437
C_putc(*t);
1438
}
1439
1440
1441
1442
SRTN
1443
RAT_out FCN((c))
1444
outer_char c C1("Output this character to \Ratfor.")
1445
{
1446
switch(c)
1447
{
1448
case end_meta:
1449
send_new_line;
1450
return;
1451
1452
case begin_meta:
1453
if(meta_mode)return;
1454
meta_mode= YES;
1455
1456
case '\n':
1457
send_new_line;
1458
if(meta_mode)PUTC('#');
1459
return;
1460
1461
default:
1462
PUTC(c);
1463
return;
1464
}
1465
}
1466
1467
1468
1469
SRTN
1470
buffer_out FCN((c))
1471
outer_char c C1("Output this character to the \Fortran\ buffer.")
1472
{
1473
outer_char*px;
1474
1475
1476
1477
1478
if(compound_assignments&&!send_rp)
1479
if(plast_char>=last_end)
1480
last_xpr_overflowed= YES;
1481
else
1482
*plast_char++= c;
1483
1484
1485
1486
switch(c)
1487
{
1488
case '\0':if(!in_string)
1489
return;
1490
1491
1492
1493
if(in_string&&started_vcmnt)
1494
{
1495
NEWLINE_TO_FORTRAN(should_continue);
1496
started_vcmnt= NO;
1497
return;
1498
}
1499
break;
1500
1501
case '{':
1502
case '}':
1503
1504
if(!in_string&&xpn_Ratfor)
1505
return;
1506
break;
1507
1508
1509
case ' ':
1510
if(out_at_beginning)
1511
return;
1512
break;
1513
1514
1515
1516
case '\n':
1517
if(in_cdir)
1518
{
1519
out_pos= 0;
1520
}
1521
else if(!in_string||(in_string&&started_vcmnt))
1522
{
1523
NEWLINE_TO_FORTRAN(NOT_CONTINUATION);
1524
1525
if(in_string&&started_vcmnt)
1526
1527
{
1528
int k;
1529
1530
if(!meta_mode)
1531
{
1532
outp_buf[0]= begin_comment_char[lan_num(out_language)];
1533
1534
for(out_pos= 1,k= spcs_after_cmnt;k;k--)
1535
outp_buf[out_pos++]= ' ';
1536
}
1537
1538
nbuf_length= MAX(t_style.output_line_length[lan_num(out_language)],80);
1539
out_at_beginning= NO;
1540
}
1541
1542
1543
}
1544
else if(!started_vcmnt)
1545
{
1546
1547
should_continue= BOOLEAN(out_pos>rst_pos);
1548
1549
1550
if(should_continue)
1551
{NEWLINE_TO_FORTRAN(NOT_CONTINUATION);}
1552
1553
should_continue= BOOLEAN((!free_Fortran)&&should_continue);
1554
1555
{
1556
int k;
1557
1558
if(!meta_mode)
1559
{
1560
outp_buf[0]= begin_comment_char[lan_num(out_language)];
1561
1562
for(out_pos= 1,k= spcs_after_cmnt;k;k--)
1563
outp_buf[out_pos++]= ' ';
1564
}
1565
1566
nbuf_length= MAX(t_style.output_line_length[lan_num(out_language)],80);
1567
out_at_beginning= NO;
1568
}
1569
1570
;
1571
started_vcmnt= YES;
1572
}
1573
1574
return;
1575
1576
1577
1578
1579
1580
1581
case ';':
1582
if(!(in_string||in_constant))
1583
{
1584
if(free_Fortran)
1585
outp_buf[out_pos++]= ';';
1586
1587
1588
1589
NEWLINE_TO_FORTRAN(NOT_CONTINUATION);
1590
return;
1591
}
1592
break;
1593
1594
case interior_semi:
1595
case semi:
1596
c= ';';
1597
break;
1598
1599
1600
case begin_meta:
1601
if(!meta_mode&&last_out!='\n')
1602
flush_out(YES);
1603
meta_mode= YES;
1604
if(in_string)
1605
{
1606
TO_BUFFER(top);
1607
if(out_pos>0)
1608
flush_out(YES);
1609
}
1610
rst_out(NOT_CONTINUATION);
1611
return;
1612
1613
case end_meta:
1614
if(in_string)
1615
{
1616
TO_BUFFER(bottom);
1617
if(out_pos>0)
1618
flush_out(YES);
1619
started_vcmnt= NO;
1620
}
1621
else
1622
flush_out(YES);
1623
1624
rst_out(NOT_CONTINUATION);
1625
return;
1626
}
1627
1628
1629
1630
if(out_pos>=nbuf_length)
1631
{
1632
if(free_Fortran)
1633
outp_buf[out_pos++]= '&';
1634
1635
flush_out(YES);
1636
rst_out(CONTINUATION);
1637
1638
if(in_string&&started_vcmnt)
1639
1640
{
1641
int k;
1642
1643
if(!meta_mode)
1644
{
1645
outp_buf[0]= begin_comment_char[lan_num(out_language)];
1646
1647
for(out_pos= 1,k= spcs_after_cmnt;k;k--)
1648
outp_buf[out_pos++]= ' ';
1649
}
1650
1651
nbuf_length= MAX(t_style.output_line_length[lan_num(out_language)],80);
1652
out_at_beginning= NO;
1653
}
1654
1655
;
1656
}
1657
1658
if(out_at_beginning)
1659
{
1660
out_at_beginning= NO;
1661
1662
1663
1664
if(!in_string)
1665
if(isdigit(c)&&!is_label)
1666
{
1667
is_label= YES;
1668
out_pos= 0;
1669
}
1670
else if(c==LINE_CHAR)
1671
{
1672
outp_buf[0]= t_style.line_char[lan_num(language)];
1673
1674
out_pos= 1;
1675
return;
1676
}
1677
else if(c=='#')
1678
out_pos= 0;
1679
}
1680
1681
1682
1683
1684
if(is_label&&!isdigit(c))
1685
{
1686
is_label= NO;
1687
out_pos= 6+indent_level*INDENT_SIZE;
1688
if(c==':'||c==' ')
1689
return;
1690
}
1691
1692
1693
1694
if(number_dos&&!continuation_line&&(language==FORTRAN||
1695
language==FORTRAN_90||R66))
1696
{
1697
outer_char HUGE*do_pos;
1698
1699
do_pos= outp_buf+6;
1700
1701
if(out_pos==9)
1702
{
1703
if(STRNCMP(do_pos,"do ",3)==0&&!isdigit(c))
1704
{
1705
sprintf((char*)(do_pos+= 3),"%lu ",
1706
stmt_num[do_level++]= max_stmt++);
1707
1708
while(*do_pos++!='\0')
1709
out_pos++;
1710
}
1711
}
1712
else if((out_pos==10&&STRNCMP(do_pos,"endd",4)==0)||
1713
(out_pos==11&&STRNCMP(do_pos,"end d",5)==0))
1714
{
1715
if(do_level==0)
1716
{
1717
1718
err0_print(ERR_T,OC("Too many END DOs"),0);
1719
*outp_buf= 'C';
1720
}
1721
else
1722
{
1723
sprintf((char*)outp_buf,"%-5lu CONTINUE",
1724
stmt_num[--do_level]);
1725
out_pos= 14;
1726
return;
1727
}
1728
}
1729
}
1730
1731
1732
1733
1734
last_out= outp_buf[out_pos++]= c;
1735
1736
return;
1737
}
1738
1739
1740
1741
SRTN
1742
flush_out FCN((prn_new_line))
1743
boolean prn_new_line C1("Do we print a newline?")
1744
{
1745
outp_buf[out_pos]= '\0';
1746
1747
1748
WRITE1(outp_buf,out_pos)
1749
1750
if(prn_new_line)
1751
{
1752
last_out= '\n';
1753
PUTC(last_out);
1754
flush0();
1755
}
1756
}
1757
1758
1759
1760
int
1761
rst_out FCN((continuation))
1762
boolean continuation C1("Is line a continuation?")
1763
{
1764
if(!continuation)
1765
RST_LAST_EXPR
1766
1767
1768
1769
for(out_pos= 0;out_pos<5;++out_pos)
1770
outp_buf[out_pos]= ' ';
1771
1772
1773
outp_buf[out_pos++]= continuation?t_style.cchar:(outer_char)' ';
1774
continuation_line= continuation;
1775
out_at_beginning= BOOLEAN(!continuation_line);
1776
1777
nbuf_length= t_style.output_line_length[lan_num(out_language)];
1778
1779
if(meta_mode)
1780
{
1781
if(!in_string||in_version)
1782
{
1783
outp_buf[0]= begin_comment_char[lan_num(out_language)];
1784
1785
if(!xpn_Ratfor)
1786
out_pos= 1+spcs_after_cmnt;
1787
}
1788
1789
nbuf_length= MAX(nbuf_length,80);
1790
}
1791
1792
1793
1794
if(out_at_beginning&&xpn_Ratfor)
1795
blank_out(indent_level);
1796
1797
return rst_pos= out_pos;
1798
}
1799
1800
1801
1802
SRTN
1803
blank_out FCN((n))
1804
int n C1("Number of levels to indent.")
1805
{
1806
outer_char HUGE*p;
1807
int i;
1808
1809
for(i= 0,p= outp_buf+out_pos;i<n*INDENT_SIZE;i++)*p++= ' ';
1810
1811
out_pos+= i;
1812
rst_pos= out_pos;
1813
}
1814
1815
1816
1817
SRTN
1818
store FCN((t,c))
1819
TEXT_BUF HUGE*t C0("")
1820
outer_char c C1("")
1821
{
1822
if(pai==paren_level||t==paren_level[0].last_buf)
1823
{
1824
buffer_out(c);
1825
return;
1826
}
1827
1828
1829
if(t->start==NULL)
1830
{
1831
t->pos= t->start= GET_MEM("t->start",t_style.paren.len,outer_char);
1832
t->end= t->start+t_style.paren.len;
1833
}
1834
1835
if(t->pos==t->end)
1836
{
1837
size_t len= PTR_DIFF(size_t,t->end,t->start);
1838
1839
t->start= (outer_char*)REALLOC(t->start,len+t_style.paren.len,len);
1840
t->pos= t->start+len;
1841
t->end= t->start+len+t_style.paren.len;
1842
}
1843
1844
*t->pos++= c;
1845
}
1846
1847
1848
1849
SRTN
1850
unwind(VOID)
1851
{
1852
int i;
1853
TEXT_BUF HUGE*t;
1854
outer_char HUGE*s1;
1855
1856
if(pai==paren_level)
1857
{
1858
1859
err0_print(ERR_T,OC("Missing '('"),0);
1860
buffer_out(')');
1861
return;
1862
}
1863
1864
for(i= pai->ilevel;i>=0;i--)
1865
{
1866
t= pai->text_buf[i];
1867
1868
for(s1= t->start;s1<t->pos;s1++)
1869
store(pai->last_buf,*s1);
1870
1871
t->pos= t->start;
1872
1873
if(i>0)
1874
store(pai->last_buf,',');
1875
}
1876
1877
store(pai->last_buf,')');
1878
pai--;
1879
}
1880
1881
1882
1883
1884
boolean names_match FCN((p,first,l,dummy))
1885
name_pointer p C0("Points to the proposed match.")
1886
CONST ASCII HUGE*first C0("Position of first character of string.")
1887
int l C0("length of identifier.")
1888
eight_bits dummy C1("Not used here")
1889
{
1890
if(length(p)!=l)return NO;
1891
return(boolean)(!STRNCMP(first,p->byte_start,l));
1892
}
1893
1894
1895
1896
SRTN
1897
ini_node FCN((node))
1898
CONST name_pointer node C1("")
1899
{
1900
node->equiv= (EQUIV)text_info;
1901
1902
{
1903
1904
1905
node->mod_info= GET_MEM("mod_info",1,MOD_INFO);
1906
1907
node->mod_info->Ilk= expr;
1908
node->mod_info->params= params;
1909
node->mod_info->params.uses= 0;
1910
1911
node->Language= (boolean)language;
1912
}
1913
1914
1915
1916
}
1917
1918
1919
1920
SRTN
1921
ini_p FCN((p,t))
1922
name_pointer p C0("")
1923
eight_bits t C1("")
1924
{}
1925
1926
SRTN
1927
open_tex_file(VOID)
1928
{}
1929
1930
1931
1932
SRTN
1933
store_two_bytes FCN((x))
1934
sixteen_bits x C1("Two-byte token to be entered into |tok_mem|.")
1935
{
1936
if(tok_ptr+2>tok_m_end)OVERFLW("tokens","tt");
1937
1938
*tok_ptr++= (eight_bits)(x>>8);
1939
*tok_ptr++= (eight_bits)(x&0377);
1940
}
1941
1942
1943
1944
1945
SRTN
1946
push_level FCN((p,b0,b1))
1947
name_pointer p C0("The new replacement text.")
1948
CONST eight_bits HUGE*b0 C0("If |p == NULL|, beginning of new \
1949
stuff in memory.")
1950
CONST eight_bits HUGE*b1 C1("If |p == NULL|, end of new stuff in \
1951
memory.")
1952
{
1953
if(stck_ptr==stck_end)
1954
OVERFLW("stack levels","kt");
1955
1956
1957
cur_mp= mp;
1958
*stck_ptr= cur_state;
1959
1960
1961
cur_name= p;
1962
1963
if(p!=NULL)
1964
{
1965
cur_repl= (text_pointer)p->equiv;
1966
1967
if(cur_repl==NULL)
1968
1969
confusion(OC("push_level"),OC("cur_repl is NULL"));
1970
1971
cur_byte= cur_repl->tok_start;
1972
cur_end= cur_byte+cur_repl->nbytes;
1973
}
1974
else
1975
{
1976
cur_repl= NULL;
1977
1978
cur_byte= (eight_bits HUGE*)b0;
1979
cur_end= (eight_bits HUGE*)b1;
1980
}
1981
1982
new_mbuf();
1983
1984
1985
1986
1987
(stck_ptr++)->params= cur_params= cur_global_params=
1988
(p!=NULL)?params:params;
1989
set_output_file(cur_language);
1990
cur_mod= UNNAMED_MODULE;
1991
}
1992
1993
1994
1995
boolean
1996
pop_level(VOID)
1997
{
1998
if(cur_repl!=NULL&&cur_repl->text_link<module_flag)
1999
{
2000
2001
cur_repl= cur_repl->text_link+text_info;
2002
cur_byte= cur_repl->tok_start;
2003
cur_end= cur_byte+cur_repl->nbytes;
2004
2005
2006
if(cur_repl->module_text)
2007
{
2008
params= cur_params= cur_global_params;
2009
frz_params();
2010
set_output_file(cur_language);
2011
}
2012
2013
return YES;
2014
}
2015
2016
if(macrobuf)
2017
FREE_MEM(macrobuf,"macrobuf",mbuf_size,eight_bits);
2018
2019
stck_ptr--;
2020
2021
if(stck_ptr>stack)
2022
{
2023
cur_state= *stck_ptr;
2024
mp= cur_mp;
2025
2026
if(cur_language!=language)
2027
flush_buffer();
2028
2029
set_output_file(cur_language);
2030
return YES;
2031
}
2032
2033
return NO;
2034
}
2035
2036
2037
2038
eight_bits
2039
get_output(VOID)
2040
{
2041
sixteen_bits a;
2042
2043
restart:
2044
if(stck_ptr==stack)
2045
return NO;
2046
2047
if(cur_byte==cur_end)
2048
{
2049
cur_val= -((long)cur_mod);
2050
2051
2052
2053
if(cur_val!=ignore)
2054
OUT_CHAR(module_number);
2055
2056
2057
pop_level();
2058
2059
if(cur_val==ignore)
2060
goto restart;
2061
2062
return module_number;
2063
}
2064
2065
2066
{
2067
a= *cur_byte++;
2068
2069
if((in_string&&!nuweb_mode)||TOKEN1(a))
2070
{
2071
2072
{
2073
send_single(a);
2074
}
2075
2076
;
2077
return sent;
2078
}
2079
else
2080
{
2081
a= IDENTIFIER(a,*cur_byte++);
2082
2083
switch(a/MODULE_NAME)
2084
{
2085
case 0:
2086
cur_val= a;
2087
2088
{
2089
IN_RATFOR boolean balanced;
2090
IN_RATFOR ASCII cur_delim;
2091
2092
if(!balanced&&language==RATFOR&&
2093
(a==id_function||a==id_program||a==id_subroutine))
2094
{
2095
2096
RAT_error(ERROR,OC("Inserted missing '%c' at beginning of function"),1,XCHR(cur_delim));
2097
cur_byte-= 2;
2098
return OUT_CHAR(cur_delim);
2099
}
2100
}
2101
2102
2103
return OUT_CHAR(identifier);
2104
2105
case 1:
2106
2107
{
2108
name_pointer np;
2109
2110
a-= MODULE_NAME;
2111
2112
np= name_dir+a;
2113
2114
if(np->equiv!=(EQUIV)text_info)
2115
push_level(np,NULL,NULL);
2116
else if(a!=UNNAMED_MODULE)
2117
{
2118
CLR_PRINTF(ERRORS_ONLY,error,("\n! Not present: "));
2119
CLR_PRINTF(ERRORS_ONLY,md_name,("<"));
2120
prn_id(np);
2121
2122
err0_print(ERR_NULL,OC(">. "),0);
2123
2124
SET_COLOR(ordinary);
2125
2126
{
2127
#define TEMP_LEN 300
2128
2129
static eight_bits temp[TEMP_LEN],temp1[TEMP_LEN];
2130
sixteen_bits stub;
2131
size_t n= (size_t)length(np);
2132
2133
id_first= x__to_ASCII(OC("$STUB"));
2134
stub= ID_NUM(id_first,id_first+5);
2135
2136
STRNCPY(temp1,np->byte_start,n);
2137
temp1[n]= '\0';
2138
2139
2140
if(
2141
nsprintf(temp,OC("%c%c%c%c%s%c%c"),7,LEFT(stub,ID0),RIGHT(stub),050,stringg,temp1,stringg,051)>=(int)(TEMP_LEN))OVERFLW("temp","");
2142
copy_out(temp,temp+6+n,macro);
2143
OUT_CHAR(012);
2144
2145
#undef TEMP_LEN
2146
}
2147
2148
2149
}
2150
}
2151
2152
2153
goto restart;
2154
2155
default:
2156
cur_val= a-MODULE_NUM;
2157
if(cur_val>UNNAMED_MODULE)cur_mod= (sixteen_bits)cur_val;
2158
2159
2160
return OUT_CHAR(module_number);
2161
2162
}
2163
}
2164
}
2165
2166
2167
}
2168
2169
2170
2171
eight_bits
2172
get_saved_output FCN((stck_ptr0))
2173
stack_pointer stck_ptr0 C1("")
2174
{
2175
sixteen_bits a;
2176
2177
restart:
2178
if(stck_ptr==stack||stck_ptr!=stck_ptr0)
2179
return NO;
2180
2181
if(DONE_LEVEL)
2182
{
2183
if(!pop_level())
2184
2185
confusion(OC("get_saved_output"),OC("Shouldn't encounter top level here"));
2186
return ignore;
2187
}
2188
2189
2190
{
2191
a= *cur_byte++;
2192
2193
if((in_string&&!nuweb_mode)||TOKEN1(a))
2194
{
2195
2196
{
2197
send_single(a);
2198
}
2199
2200
;
2201
return sent;
2202
}
2203
else
2204
{
2205
a= IDENTIFIER(a,*cur_byte++);
2206
2207
switch(a/MODULE_NAME)
2208
{
2209
case 0:
2210
cur_val= a;
2211
2212
{
2213
IN_RATFOR boolean balanced;
2214
IN_RATFOR ASCII cur_delim;
2215
2216
if(!balanced&&language==RATFOR&&
2217
(a==id_function||a==id_program||a==id_subroutine))
2218
{
2219
2220
RAT_error(ERROR,OC("Inserted missing '%c' at beginning of function"),1,XCHR(cur_delim));
2221
cur_byte-= 2;
2222
return OUT_CHAR(cur_delim);
2223
}
2224
}
2225
2226
2227
return OUT_CHAR(identifier);
2228
2229
case 1:
2230
2231
{
2232
name_pointer np;
2233
2234
a-= MODULE_NAME;
2235
2236
np= name_dir+a;
2237
2238
if(np->equiv!=(EQUIV)text_info)
2239
push_level(np,NULL,NULL);
2240
else if(a!=UNNAMED_MODULE)
2241
{
2242
CLR_PRINTF(ERRORS_ONLY,error,("\n! Not present: "));
2243
CLR_PRINTF(ERRORS_ONLY,md_name,("<"));
2244
prn_id(np);
2245
2246
err0_print(ERR_NULL,OC(">. "),0);
2247
2248
SET_COLOR(ordinary);
2249
2250
{
2251
#define TEMP_LEN 300
2252
2253
static eight_bits temp[TEMP_LEN],temp1[TEMP_LEN];
2254
sixteen_bits stub;
2255
size_t n= (size_t)length(np);
2256
2257
id_first= x__to_ASCII(OC("$STUB"));
2258
stub= ID_NUM(id_first,id_first+5);
2259
2260
STRNCPY(temp1,np->byte_start,n);
2261
temp1[n]= '\0';
2262
2263
2264
if(
2265
nsprintf(temp,OC("%c%c%c%c%s%c%c"),7,LEFT(stub,ID0),RIGHT(stub),050,stringg,temp1,stringg,051)>=(int)(TEMP_LEN))OVERFLW("temp","");
2266
copy_out(temp,temp+6+n,macro);
2267
OUT_CHAR(012);
2268
2269
#undef TEMP_LEN
2270
}
2271
2272
2273
}
2274
}
2275
2276
2277
goto restart;
2278
2279
default:
2280
cur_val= a-MODULE_NUM;
2281
if(cur_val>UNNAMED_MODULE)cur_mod= (sixteen_bits)cur_val;
2282
2283
2284
return OUT_CHAR(module_number);
2285
2286
}
2287
}
2288
}
2289
2290
2291
}
2292
2293
2294
2295
SRTN
2296
copy_out FCN((p0,p1,is_expr))
2297
CONST eight_bits HUGE*p0 C0("Start of memory buffer.")
2298
CONST eight_bits HUGE*p1 C0("End of memory buffer.")
2299
boolean is_expr C1("Flag for resetting pointer to last expression.")
2300
{
2301
stack_pointer stck_ptr0;
2302
2303
2304
if(is_expr)
2305
rst_last();
2306
2307
push_level(NULL,p0,p1);
2308
stck_ptr0= stck_ptr;
2309
2310
while(get_saved_output(stck_ptr0))
2311
;
2312
}
2313
2314
2315
2316
SRTN
2317
send_single FCN((a))
2318
sixteen_bits a C1("")
2319
{
2320
boolean scope;
2321
2322
switch(a)
2323
{
2324
case begin_language:
2325
2326
switch(sent= *cur_byte++)
2327
{
2328
case NO_LANGUAGE:
2329
scope= *cur_byte++;
2330
a= *cur_byte++;
2331
a= IDENTIFIER(a,*cur_byte++);
2332
new_out(scope,a);
2333
sent= new_output_file;
2334
break;
2335
2336
2337
2338
case C:opn_output_file(C);break;
2339
case C_PLUS_PLUS:opn_output_file(C_PLUS_PLUS);break;
2340
case RATFOR:
2341
if(!RAT_OK("(send_single)"))
2342
2343
confusion(OC("output default"),OC("Ratfor command during output"));
2344
opn_output_file(RATFOR);
2345
break;
2346
case RATFOR_90:
2347
if(!RAT_OK("(send_single)"))
2348
2349
confusion(OC("output default"),OC("Ratfor command during output"));
2350
opn_output_file(RATFOR_90);
2351
break;
2352
case FORTRAN:opn_output_file(FORTRAN);break;
2353
case FORTRAN_90:opn_output_file(FORTRAN_90);break;
2354
case TEX:opn_output_file(TEX);break;
2355
case LITERAL:opn_output_file(LITERAL);break
2356
2357
;
2358
2359
case NUWEB_OFF:
2360
case NUWEB_ON:
2361
nuweb_mode= BOOLEAN(0x0F&sent);
2362
break;
2363
2364
case no_mac_expand:
2365
mac_protected= no_expand= YES;
2366
break;
2367
2368
case set_line_info:
2369
line_info= *cur_byte++;
2370
break;
2371
}
2372
break;
2373
2374
case dot_const:
2375
cur_val= *cur_byte++;
2376
2377
sent= OUT_CHAR(a);
2378
break;
2379
2380
default:
2381
sent= OUT_CHAR(a);
2382
break;
2383
}
2384
}
2385
2386
2387
2388
#define TEMP_LEN (2*MAX_FILE_NAME_LENGTH)
2389
2390
SRTN
2391
new_out FCN((global_scope,a))
2392
boolean global_scope C0("0 for local, 1 for global")
2393
sixteen_bits a C1("")
2394
{
2395
name_pointer np= name_dir+a;
2396
CONST ASCII HUGE*end;
2397
size_t len;
2398
outer_char temp_from[TEMP_LEN],temp_to[TEMP_LEN];
2399
outer_char temp[MAX_FILE_NAME_LENGTH];
2400
2401
if(global_scope)
2402
{
2403
2404
if(
2405
nsprintf(temp_from,OC("\n\n (This file was continued via @O from %s.)"),1,params.OUTPUT_FILE_NAME)>=(int)(TEMP_LEN))OVERFLW("temp_from","");
2406
}
2407
else
2408
{
2409
2410
if(
2411
nsprintf(temp_from,OC(" "),0)>=(int)(TEMP_LEN))OVERFLW("temp_from","");
2412
}
2413
2414
2415
PROPER_END(end);
2416
len= PTR_DIFF(size_t,end,np->byte_start);
2417
STRNCPY(temp,np->byte_start,len);
2418
TERMINATE(temp,len);
2419
to_outer((ASCII HUGE*)temp);
2420
new_fname(¶ms.OUTPUT_FILE_NAME,temp,NULL);
2421
2422
2423
if(global_scope)
2424
{
2425
outer_char old_name[MAX_FILE_NAME_LENGTH];
2426
2427
STRCPY(old_name,global_params.OUTPUT_FILE_NAME);
2428
new_fname(&global_params.OUTPUT_FILE_NAME,temp,NULL);
2429
2430
if(
2431
nsprintf(temp_to,OC(" (Continued via @O to %s.)"),1,params.OUTPUT_FILE_NAME)>=(int)(TEMP_LEN))OVERFLW("temp_to","");
2432
OUT_MSG(to_ASCII(temp_to),NULL);
2433
close_out(out_file,old_name);
2434
}
2435
else
2436
fflush(out_file);
2437
2438
open_out(temp_from,global_scope);
2439
}
2440
2441
#undef TEMP_LEN
2442
2443
2444
2445
SRTN
2446
i_mod_name_ FCN((n,pargs))
2447
int n C0("")
2448
PARGS pargs C1("")
2449
{
2450
int len;
2451
name_pointer np= cur_name;
2452
eight_bits HUGE*p;
2453
2454
CHK_ARGS("$MODULE_NAME",0);
2455
2456
if(cur_name)
2457
cur_mod_no= (sixteen_bits)(np-name_dir);
2458
else
2459
cur_mod_no= 0;
2460
2461
len= cur_mod_no?(int)length(np):STRLEN(UNNAMED_MOD);
2462
MCHECK(len,"current module name");
2463
2464
if(cur_mod_no)
2465
for(p= np->byte_start;p<(np+1)->byte_start;)
2466
*mp++= *p++;
2467
else
2468
{
2469
STRCPY(mp,UNNAMED_MOD);
2470
to_ASCII(mp);
2471
mp+= len;
2472
}
2473
}
2474
2475
2476
2477
SRTN
2478
i_sect_num_ FCN((n,pargs))
2479
int n C0("")
2480
PARGS pargs C1("")
2481
{
2482
num_to_mbuf(n,pargs,"$SECTION_NUM",0,"section number",cur_mod);
2483
}
2484
2485
2486
2487
SRTN
2488
x_mod_a FCN((a))
2489
sixteen_bits a C1("")
2490
{
2491
2492
{
2493
name_pointer np;
2494
2495
a-= MODULE_NAME;
2496
2497
np= name_dir+a;
2498
2499
if(np->equiv!=(EQUIV)text_info)
2500
push_level(np,NULL,NULL);
2501
else if(a!=UNNAMED_MODULE)
2502
{
2503
CLR_PRINTF(ERRORS_ONLY,error,("\n! Not present: "));
2504
CLR_PRINTF(ERRORS_ONLY,md_name,("<"));
2505
prn_id(np);
2506
2507
err0_print(ERR_NULL,OC(">. "),0);
2508
2509
SET_COLOR(ordinary);
2510
2511
{
2512
#define TEMP_LEN 300
2513
2514
static eight_bits temp[TEMP_LEN],temp1[TEMP_LEN];
2515
sixteen_bits stub;
2516
size_t n= (size_t)length(np);
2517
2518
id_first= x__to_ASCII(OC("$STUB"));
2519
stub= ID_NUM(id_first,id_first+5);
2520
2521
STRNCPY(temp1,np->byte_start,n);
2522
temp1[n]= '\0';
2523
2524
2525
if(
2526
nsprintf(temp,OC("%c%c%c%c%s%c%c"),7,LEFT(stub,ID0),RIGHT(stub),050,stringg,temp1,stringg,051)>=(int)(TEMP_LEN))OVERFLW("temp","");
2527
copy_out(temp,temp+6+n,macro);
2528
OUT_CHAR(012);
2529
2530
#undef TEMP_LEN
2531
}
2532
2533
2534
}
2535
}
2536
2537
2538
}
2539
2540
2541
2542
SRTN
2543
flush0()
2544
{
2545
2546
2547
2548
if(phase==1)
2549
return;
2550
2551
2552
2553
if(msg_level>=EVERYTHING&&cur_line%100==0)
2554
{
2555
if(cur_line%500==0)
2556
{CLR_PRINTF(EVERYTHING,line_num,("%u",cur_line));}
2557
else
2558
{
2559
CLR_PRINTF(EVERYTHING,info,("."));
2560
}
2561
2562
UPDATE_TERMINAL;
2563
}
2564
2565
cur_line++;
2566
OUTPUT_LINE++;
2567
}
2568
2569
2570
2571
SRTN
2572
phase2(VOID)
2573
{
2574
phase= 2;
2575
2576
params= global_params;
2577
frz_params();
2578
set_output_file(global_language);
2579
2580
2581
rst_out(NOT_CONTINUATION);
2582
2583
if(msg_level>=SHORT_INFO)
2584
{
2585
CLR_PRINTF(SHORT_INFO,info,("\nWriting the %soutput file(s):",
2586
compare_outfiles?"temporary ":""));
2587
printf(" ");
2588
UPDATE_TERMINAL;
2589
}
2590
2591
cur_line= 1;
2592
2593
if(CAST(text_pointer,text_info)->text_link==0)
2594
{
2595
CLR_PRINTF(WARNINGS,warning,("\n! No program text was specified."));
2596
mark_harmless;
2597
2598
}
2599
else
2600
{
2601
2602
{
2603
name_pointer np;
2604
2605
npmax= name_ptr-1;
2606
2607
if(truncate_ids)
2608
{
2609
unsigned n= 0;
2610
2611
printf("\nTruncating %u identifiers...",
2612
PTR_DIFF(unsigned,name_ptr,name_dir));
2613
2614
for(np= name_dir+1;np<name_ptr;np++)
2615
n+= trunc_id(np);
2616
2617
printf("\n%u truncation(s) performed.",n);
2618
}
2619
2620
not_unique();
2621
}
2622
2623
;
2624
2625
2626
{
2627
stck_ptr= stack+1;
2628
cur_name= name_dir;
2629
2630
cur_repl= CAST(text_pointer,text_info)->text_link+text_info;
2631
cur_byte= cur_repl->tok_start;
2632
cur_end= cur_byte+cur_repl->nbytes;
2633
2634
cur_mod= UNNAMED_MODULE;
2635
2636
params= cur_params= cur_global_params= global_params;
2637
frz_params();
2638
}
2639
2640
;
2641
2642
{
2643
sixteen_bits a;
2644
text_pointer cur_text;
2645
boolean is_def;
2646
2647
2648
copying_macros= YES;
2649
2650
for(cur_text= text_info+1;cur_text<text_ptr;cur_text++)
2651
if(cur_text->text_link==macro)
2652
{
2653
cur_byte= cur_text->tok_start;
2654
cur_end= cur_byte+cur_text->nbytes;
2655
2656
is_WEB_macro=
2657
BOOLEAN(!((is_def= BOOLEAN(cur_text->nargs==OUTER_MACRO))||
2658
cur_text->nargs==OUTER_UNMACRO));
2659
2660
2661
if(is_WEB_macro)
2662
{
2663
#if(0)
2664
see_macro(cur_byte,cur_end)
2665
#endif
2666
;}
2667
else
2668
{
2669
2670
{
2671
LANGUAGE language0;
2672
T_OUTER*po= &t_style.outer_start[lan_num(language)];
2673
outer_char*outer_macro;
2674
2675
out_state= MISCELLANEOUS;
2676
2677
set_output_file((LANGUAGE)cur_text->Language);
2678
2679
2680
protect= YES;
2681
2682
outer_macro= OC(is_def?po->def:po->undef);
2683
language0= language;
2684
2685
C_sprintf(outer_macro,0);
2686
2687
stck_ptr= stack;
2688
push_level(NULL,cur_byte,cur_end);
2689
2690
WHILE()
2691
2692
{
2693
if(DONE_LEVEL&&!pop_level())
2694
break;
2695
2696
a= *cur_byte++;
2697
2698
if(cur_byte==cur_end&&a==012)
2699
continue;
2700
2701
if(TOKEN1(a))
2702
2703
{
2704
send_single(a);
2705
}
2706
2707
2708
else
2709
{
2710
a= IDENTIFIER(a,*cur_byte++);
2711
2712
if(a<MODULE_NAME)
2713
{
2714
cur_val= a;
2715
OUT_CHAR(identifier);
2716
}
2717
else if(a!=MODULE_NUM)
2718
{
2719
2720
confusion(OC("copy outer"),OC("Macros defs have strange char 0x%x"),a);
2721
}
2722
else
2723
{
2724
cur_mod= (sixteen_bits)(a-MODULE_NUM);
2725
cur_val= (long)cur_mod;
2726
OUT_CHAR(module_number);
2727
}
2728
2729
}
2730
}
2731
2732
2733
2734
cur_state= *stck_ptr;
2735
mp= cur_mp;
2736
2737
set_output_file(language0);
2738
2739
protect= NO;
2740
flush_buffer();
2741
}
2742
2743
2744
FREE_MEM(cur_text->tok_start,
2745
"macro space",cur_text->nbytes,eight_bits);
2746
2747
}
2748
}
2749
2750
copying_macros= NO;
2751
}
2752
2753
;
2754
2755
2756
{
2757
stck_ptr= stack+1;
2758
cur_name= name_dir;
2759
2760
cur_repl= CAST(text_pointer,text_info)->text_link+text_info;
2761
cur_byte= cur_repl->tok_start;
2762
cur_end= cur_byte+cur_repl->nbytes;
2763
2764
cur_mod= UNNAMED_MODULE;
2765
2766
params= cur_params= cur_global_params= global_params;
2767
frz_params();
2768
}
2769
2770
;
2771
2772
while(get_output())
2773
;
2774
2775
flush_buffer();
2776
2777
if(compare_outfiles)
2778
cmp_outfiles();
2779
2780
CLR_PRINTF(SHORT_INFO,info,("\nDone."));
2781
}
2782
}
2783
2784
2785
SRTN
2786
out_version FCN((msg))
2787
CONST outer_char*msg C1("")
2788
{
2789
outer_char HUGE*temp= GET_MEM("version:temp",N_MSGBUF,outer_char);
2790
boolean in_string0= in_string;
2791
OUTPUT_STATE out_state0= out_state;
2792
2793
2794
if(
2795
nsprintf(temp,OC(" FTANGLE v%s,\n created with %s on \"%s, %s at %s.\" %s\n"),6,"1.61",the_system,"Friday","September 25, 1998","8:02",local_banner)>=(int)(N_MSGBUF))OVERFLW("temp","");
2796
STRCAT(temp,cmd_ln_buf);
2797
STRCAT(temp,msg);
2798
2799
in_version= YES;
2800
in_string= NO;
2801
2802
2803
OUT_MSG(to_ASCII(temp),NULL);
2804
FREE_MEM(temp,"version:temp",N_MSGBUF,outer_char);
2805
in_version= NO;
2806
2807
in_string= in_string0;
2808
out_state= out_state0;
2809
2810
if(line_info)
2811
out_pos= 0;
2812
else
2813
{
2814
rst_out(NOT_CONTINUATION);
2815
}
2816
2817
if(FORTRAN_LIKE(language))
2818
{
2819
started_vcmnt= NO;
2820
2821
rst_out(NOT_CONTINUATION);
2822
}
2823
}
2824
2825
2826
2827
SRTN
2828
i_version_ FCN((n,pargs))
2829
int n C0("")
2830
PARGS pargs C1("")
2831
{
2832
CHK_ARGS("$VERSION",0);
2833
2834
mcopy(version);
2835
}
2836
2837
2838
2839
SRTN
2840
i_tm_ FCN((n,pargs))
2841
int n C0("")
2842
PARGS pargs C1("")
2843
{
2844
eight_bits HUGE*p;
2845
struct tm*t;
2846
2847
CHK_ARGS("$TM",1);
2848
2849
p= pargs[0]+1;
2850
2851
if(*p++!=constant)
2852
{
2853
2854
macro_err(OC("! Argument of $TM must be numerical constant"),YES);
2855
return;
2856
}
2857
2858
t= the_localtime();
2859
2860
switch(*p-060)
2861
{
2862
case 0:
2863
mcopy(the_day(t));
2864
break;
2865
2866
case 1:
2867
2868
MCHECK(2,"the_cdate");
2869
*mp++= 0140;
2870
mcopy(the_cdate(t));
2871
*mp++= 0140;
2872
break;
2873
2874
case 2:
2875
mcopy(the_time(t));
2876
break;
2877
2878
default:
2879
2880
macro_err(OC("! Invalid case in _tm_"),YES);
2881
break;
2882
}
2883
}
2884
2885
2886
2887
SRTN
2888
mcopy FCN((s))
2889
CONST outer_char*s C1("")
2890
{
2891
int n= STRLEN(s);
2892
2893
MCHECK(n,"mcopy");
2894
STRCPY(mp,x_to_ASCII(s));
2895
mp+= n;
2896
}
2897
2898
2899
2900
SRTN
2901
not_unique(VOID)
2902
{
2903
TRUNC HUGE*s,HUGE*HUGE*ss,HUGE*HUGE*ss0,HUGE*HUGE*ss1;
2904
LANGUAGE Language;
2905
int l;
2906
size_t n;
2907
size_t num_max;
2908
BP HUGE*HUGE*bb0;
2909
boolean found_dup= NO;
2910
2911
for(l= 0;l<NUM_LANGUAGES;l++)
2912
{
2913
Language= lan_enum(l);
2914
2915
2916
n= 0;
2917
2918
for(s= &sh;s->next;s= s->next)
2919
{
2920
if(!((boolean)s->Language&(boolean)Language))continue;
2921
2922
if(s->num[l]>1)
2923
{
2924
char temp[10];
2925
unsigned len= tr_max[l];
2926
2927
sprintf(temp,len?"%u":"*",len);
2928
2929
if(n==0)
2930
{
2931
printf("\n\n%c! Non-unique \
2932
%s variables (filtered with {%s}, truncated to length %s):",
2933
beep(1),languages[l],filter_char[l],temp);
2934
found_dup= YES;
2935
}
2936
n++;
2937
}
2938
}
2939
2940
if(n==0)continue;
2941
2942
2943
ss1= ss0= ss= GET_MEM("ss",n,TRUNC HUGE*);
2944
num_max= 0;
2945
2946
for(s= &sh;s->next;s= s->next)
2947
{
2948
if(!((boolean)s->Language&(boolean)Language))continue;
2949
2950
if(s->num[l]>1)
2951
{
2952
*ss++= s;
2953
num_max= MAX(num_max,s->num[l]);
2954
}
2955
}
2956
2957
2958
QSORT(ss0,n,sizeof(TRUNC HUGE*),cmpr_trunc);
2959
2960
2961
bb0= GET_MEM("bb",num_max,BP HUGE*);
2962
2963
while(ss1<ss)
2964
see_dup(*ss1++,Language,bb0);
2965
2966
FREE_MEM(ss0,"ss",n,TRUNC HUGE*);
2967
FREE_MEM(bb0,"bb",num_max,BP HUGE*);
2968
}
2969
2970
if(found_dup)
2971
NEWLINE;
2972
}
2973
2974
SRTN
2975
see_dup FCN((s,Language,bb0))
2976
CONST TRUNC HUGE*s C0("")
2977
LANGUAGE Language C0("")
2978
BP HUGE*HUGE*bb0 C1("")
2979
{
2980
BP HUGE*b,HUGE*HUGE*bb,HUGE*HUGE*bb1;
2981
int n;
2982
2983
NEWLINE;
2984
printf(" ");
2985
n= see(s->id,s->id_end);
2986
2987
2988
for(n= tr_max[lan_num(Language)]+1-n;n>0;n--)printf(" ");
2989
printf("<=");
2990
2991
2992
for(b= s->first,bb= bb0;b!=NULL;b= b->next)
2993
{
2994
if(!((boolean)b->Language&(boolean)Language))continue;
2995
2996
*bb++= b;
2997
}
2998
2999
QSORT(bb0,bb-bb0,sizeof(BP HUGE*),cmpr_bp);
3000
3001
for(bb1= bb0;bb1<bb;bb1++)
3002
{
3003
printf(" ");
3004
see((*bb1)->byte_start,(*bb1)->byte_end);
3005
}
3006
}
3007
3008
int
3009
see FCN((c0,c1))
3010
CONST ASCII HUGE*c0 C0("Beginning.")
3011
CONST ASCII HUGE*c1 C1("end.")
3012
{
3013
int n= PTR_DIFF(int,c1,c0);
3014
3015
while(c0<c1)
3016
printf("%c",XCHR(*c0++));
3017
3018
return n;
3019
}
3020
3021
3022
3023
int
3024
cmpr_trunc FCN((t0,t1))
3025
TRUNC HUGE**t0 C0("")
3026
TRUNC HUGE**t1 C1("")
3027
{
3028
switch(web_strcmp((*t0)->id,(*t0)->id_end,(*t1)->id,(*t1)->id_end))
3029
{
3030
case EQUAL:
3031
return 0;
3032
3033
case LESS:
3034
case PREFIX:
3035
return-1;
3036
3037
case GREATER:
3038
case EXTENSION:
3039
return 1;
3040
}
3041
3042
return 0;
3043
}
3044
3045
int cmpr_bp FCN((bb0,bb1))
3046
BP HUGE**bb0 C0("")
3047
BP HUGE**bb1 C1("")
3048
{
3049
switch(web_strcmp((*bb0)->byte_start,(*bb0)->byte_end,
3050
(*bb1)->byte_start,(*bb1)->byte_end))
3051
{
3052
case EQUAL:
3053
return 0;
3054
3055
case LESS:
3056
case PREFIX:
3057
return-1;
3058
3059
case GREATER:
3060
case EXTENSION:
3061
return 1;
3062
}
3063
3064
return 0;
3065
}
3066
3067
3068
3069
3070
BP HUGE*b_link FCN((s,Language,p0,p1))
3071
TRUNC HUGE*s C0("")
3072
LANGUAGE Language C0("")
3073
CONST ASCII HUGE*p0 C0("")
3074
CONST ASCII HUGE*p1 C1("")
3075
{
3076
BP HUGE*bp;
3077
3078
bp= GET_MEM("bp",1,BP);
3079
3080
bp->c= BP_MARKER;
3081
3082
3083
bp->Language= Language;
3084
3085
3086
bp->byte_start= p0;
3087
bp->byte_end= p1;
3088
3089
3090
bp->Root= s;
3091
s->Language|= (boolean)Language;
3092
s->num[lan_num(Language)]++;
3093
3094
return bp;
3095
}
3096
3097
3098
3099
TRUNC HUGE*s_link FCN((s,id,len))
3100
TRUNC HUGE*s C0("Points to the current structure, to be \
3101
filled with info.")
3102
CONST ASCII HUGE*id C0("Truncated identifier.")
3103
unsigned short len C1("Length of truncated identifier.")
3104
{
3105
3106
s->id= GET_MEM("s->id",len,ASCII);
3107
STRNCPY(s->id,id,len);
3108
s->id_end= s->id+len;
3109
3110
3111
s->next= GET_MEM("s->next",1,TRUNC);
3112
3113
return s;
3114
}
3115
3116
3117
3118
name_pointer id0_lookup FCN((start,end,l))
3119
CONST ASCII HUGE*start C0("Start of name.")
3120
CONST ASCII HUGE*end C0("end of name.")
3121
LANGUAGE l C1("")
3122
{
3123
name_pointer np;
3124
CONST ASCII HUGE*p0,HUGE*p1;
3125
3126
for(np= name_dir+1;np<name_ptr;np++)
3127
{
3128
if(!(np->Language&(boolean)l)||
3129
np->equiv!=NULL||*(p0= np->byte_start)==BP_MARKER)
3130
continue;
3131
3132
PROPER_END(p1);
3133
3134
if(web_strcmp(p0,p1,start,end)==EQUAL)
3135
return np;
3136
}
3137
3138
return NULL;
3139
}
3140
3141
3142
3143
unsigned
3144
trunc_id FCN((np0))
3145
CONST name_pointer np0 C1("Points to current id structure.")
3146
{
3147
CONST ASCII HUGE*p,HUGE*p0,HUGE*p1;
3148
ASCII temp[N_IDBUF];
3149
ASCII HUGE*t;
3150
unsigned short n;
3151
TRUNC HUGE*s;
3152
name_pointer np;
3153
unsigned short nmax;
3154
LANGUAGE Language;
3155
int l;
3156
unsigned count= 0;
3157
3158
if(np0->Language==(boolean)NO_LANGUAGE||np0->equiv!=NULL)
3159
return 0;
3160
3161
for(l= 0;l<NUM_LANGUAGES;l++)
3162
{
3163
Language= lan_enum(l);
3164
np= np0;
3165
3166
3167
3168
3169
if((nmax= tr_max[l])==0||!(np->Language&(boolean)Language)
3170
||(np->reserved_word&(boolean)Language)
3171
||(np->intrinsic_word&(boolean)Language)
3172
||(np->keyword&(boolean)Language)
3173
||(np->macro_type!=NOT_DEFINED))
3174
continue;
3175
3176
3177
p0= np->byte_start;
3178
3179
if(*p0==BP_MARKER)
3180
continue;
3181
3182
PROPER_END(p1);
3183
3184
3185
for(p= p0,t= temp,n= 0;p<p1&&n<nmax;p++)
3186
if(STRCHR(filter_char[l],(int)XCHR(*p))==NULL)
3187
{
3188
n++;
3189
*t++= *p;
3190
}
3191
3192
n= PTR_DIFF(unsigned short,t,temp);
3193
3194
if(p1-p0==(long)n)
3195
continue;
3196
3197
count++;
3198
3199
3200
for(s= &sh;s->next!=NULL;s= s->next)
3201
if(s->id_end-s->id==(long)n&&
3202
web_strcmp(s->id,s->id_end,temp,t)==EQUAL)
3203
{
3204
another_bp:
3205
s->last= s->last->next= b_link(s,Language,p0,p1);
3206
3207
np->byte_start= (ASCII*)s->last;
3208
goto next_language;
3209
}
3210
3211
3212
s= s_link(s,temp,n);
3213
s->first= s->last= b_link(s,Language,p0,p1);
3214
np->byte_start= (ASCII*)s->first;
3215
3216
3217
3218
if((np= id0_lookup(temp,t,(LANGUAGE)np->Language))!=NULL)
3219
{
3220
p0= np->byte_start;PROPER_END(p1);
3221
goto another_bp;
3222
}
3223
3224
next_language:;
3225
}
3226
3227
return count;
3228
}
3229
3230
3231
3232
SRTN
3233
open_out FCN((msg,global_scope))
3234
CONST outer_char*msg C0("")
3235
boolean global_scope C1("")
3236
{
3237
boolean is_stdout= BOOLEAN(STRCMP(params.OUTPUT_FILE_NAME,"stdout")==0);
3238
boolean already_opened= NO;
3239
3240
if(is_stdout)
3241
out_file= params.OUT_FILE= stdout;
3242
else
3243
{
3244
already_opened= was_opened(params.OUTPUT_FILE_NAME,global_scope,
3245
NULL,&out_file);
3246
3247
params.OUT_FILE= out_file;
3248
3249
3250
3251
if(top_version&&!(already_opened||compare_outfiles))
3252
out_version(msg);
3253
}
3254
3255
3256
3257
3258
if(global_scope)
3259
cur_global_params.OUT_FILE= global_params.OUT_FILE= out_file;
3260
3261
3262
if(!already_opened)
3263
{
3264
CLR_PRINTF(SHORT_INFO,out_file,("(%s)%s",(char*)params.OUTPUT_FILE_NAME,
3265
is_stdout?"\n":""));
3266
UPDATE_TERMINAL;
3267
}
3268
}
3269
3270
3271
3272
boolean was_opened FCN((file_name,global_scope,pname,pfile_ptr))
3273
CONST outer_char HUGE*file_name C0("")
3274
boolean global_scope C0("")
3275
outer_char HUGE*HUGE*pname C0("")
3276
FILE**pfile_ptr C1("")
3277
{
3278
OPEN_FILE HUGE*f;
3279
3280
if(!*file_name)
3281
{
3282
*pname= (outer_char HUGE*)"";
3283
*pfile_ptr= NULL;
3284
return NO;
3285
}
3286
3287
3288
for(f= open_file;f<last_file;f++)
3289
if(STRCMP(f->name,file_name)==0)
3290
{
3291
if(pname)
3292
{
3293
*pname= f->name;
3294
*pfile_ptr= f->ptr;
3295
return f->previously_opened;
3296
}
3297
else
3298
goto open_it;
3299
}
3300
3301
3302
{
3303
3304
if(last_file==open_file_end)
3305
{
3306
OVERFLW("previously opened files","nf");
3307
}
3308
3309
last_file->name= GET_MEM("last_file",STRLEN(file_name)+1,outer_char);
3310
STRCPY(last_file->name,file_name);
3311
last_file++;
3312
}
3313
3314
3315
3316
if(pname)
3317
{
3318
3319
*pname= f->name;
3320
f->ptr= NULL;
3321
f->previously_opened= NO;
3322
f->global_scope= global_scope;
3323
}
3324
else
3325
3326
{
3327
open_it:
3328
f->previously_opened= BOOLEAN(f->previously_opened||(f->ptr!=NULL));
3329
3330
if(f->previously_opened)
3331
{
3332
if(f->ptr==NULL)
3333
f->ptr= FOPEN(compare_outfiles?f->tmp_name:f->name,"a");
3334
}
3335
else
3336
{
3337
if(compare_outfiles)
3338
3339
{
3340
char*buffer;
3341
IN_COMMON outer_char wbprefix[MAX_FILE_NAME_LENGTH];
3342
3343
#if(HAVE_TEMPNAM)
3344
extern char*tempnam();
3345
3346
if(!*wbprefix)
3347
STRCPY(wbprefix,"./");
3348
3349
buffer= tempnam((char*)wbprefix,"FTMP");
3350
3351
#else
3352
buffer= tmpnam(NULL);
3353
#endif
3354
3355
f->tmp_name= GET_MEM("f->tmp_name",STRLEN(buffer)+1,outer_char);
3356
3357
STRCPY(f->tmp_name,buffer);
3358
3359
f->ptr= FOPEN(f->tmp_name,"w");
3360
}
3361
3362
3363
else
3364
f->ptr= FOPEN(f->name,"w");
3365
3366
if(!(f->ptr))
3367
{
3368
3369
fatal(ERR_T,OC("ABORTING: "),OC("Can't open output file %s."),file_name);
3370
}
3371
}
3372
}
3373
3374
3375
3376
*pfile_ptr= f->ptr;
3377
return f->previously_opened;
3378
}
3379
3380
3381
3382
SRTN
3383
close_out FCN((fp,name))
3384
FILE*fp C0("")
3385
outer_char*name C1("")
3386
{
3387
OPEN_FILE*f;
3388
3389
for(f= open_file;f<last_file;f++)
3390
if(f->ptr==fp)
3391
{
3392
close0(f);
3393
return;
3394
}
3395
3396
confusion(OC("close_out"),
3397
OC("Allegedly open file \"%s\" isn't in list"),name);
3398
}
3399
3400
3401
3402
SRTN
3403
cls_local(VOID)
3404
{
3405
OPEN_FILE*f;
3406
3407
for(f= open_file;f<last_file;f++)
3408
if(f->ptr&&!f->global_scope)
3409
close0(f);
3410
}
3411
3412
3413
SRTN
3414
close0 FCN((f))
3415
OPEN_FILE*f C1("")
3416
{
3417
fclose(f->ptr);
3418
f->ptr= NULL;
3419
f->previously_opened= YES;
3420
}
3421
3422
3423
3424
SRTN
3425
cls_files(VOID)
3426
{}
3427
3428
3429
SRTN
3430
cmp_outfiles(VOID)
3431
{
3432
OPEN_FILE*f;
3433
boolean renamed= NO;
3434
3435
printf("\nRenaming temporary file(s): ");
3436
UPDATE_TERMINAL;
3437
3438
for(f= open_file;f<last_file;f++)
3439
if(f->previously_opened||f->ptr)
3440
{
3441
FILE*old_ptr= FOPEN(f->name,"r");
3442
3443
if(f->ptr)
3444
fflush(f->ptr);
3445
3446
if(old_ptr)
3447
3448
{
3449
int c_old,c_new;
3450
FILE*new_ptr;
3451
3452
if(f->ptr)
3453
new_ptr= freopen((CONST char*)f->tmp_name,"r",f->ptr);
3454
else
3455
new_ptr= FOPEN(f->tmp_name,"r");
3456
3457
if(!new_ptr)
3458
3459
fatal(ERR_T,OC("ABORTING: "),OC("Can't reopen temporary file %s."),f->tmp_name);
3460
3461
do
3462
{
3463
c_old= getc(old_ptr);
3464
c_new= getc(new_ptr);
3465
}
3466
while(c_old==c_new&&c_old!=EOF);
3467
3468
fclose(old_ptr);
3469
fclose(new_ptr);
3470
3471
if(c_old==c_new)
3472
remove((CONST char*)f->tmp_name);
3473
else
3474
3475
{
3476
3477
remove((CONST char*)f->name);
3478
3479
printf("(%s",(char*)f->name);
3480
3481
if(rename((CONST char*)f->tmp_name,(CONST char*)f->name)!=0)
3482
{
3483
3484
3485
3486
#if ANSI_SYSTEM
3487
if(!system(NULL))
3488
{
3489
3490
err0_print(ERR_T,OC("Couldn't rename \"%s\" to \"%s\""),2,f->tmp_name,f->name);
3491
perror("");
3492
}
3493
else
3494
#endif
3495
{
3496
char temp[256];
3497
3498
3499
3500
#ifndef MV
3501
#ifdef ibmpc
3502
#define MV "rename"
3503
#else
3504
#define MV "mv"
3505
#endif
3506
#endif
3507
sprintf(temp,"%s %s %s",MV,(char*)f->tmp_name,
3508
(char*)f->name);
3509
system(temp);
3510
printf("*");
3511
}
3512
}
3513
3514
printf(")");UPDATE_TERMINAL;
3515
3516
renamed= YES;
3517
}
3518
3519
3520
}
3521
3522
3523
else
3524
{
3525
fclose(f->ptr);
3526
3527
3528
{
3529
3530
remove((CONST char*)f->name);
3531
3532
printf("(%s",(char*)f->name);
3533
3534
if(rename((CONST char*)f->tmp_name,(CONST char*)f->name)!=0)
3535
{
3536
3537
3538
3539
#if ANSI_SYSTEM
3540
if(!system(NULL))
3541
{
3542
3543
err0_print(ERR_T,OC("Couldn't rename \"%s\" to \"%s\""),2,f->tmp_name,f->name);
3544
perror("");
3545
}
3546
else
3547
#endif
3548
{
3549
char temp[256];
3550
3551
3552
3553
#ifndef MV
3554
#ifdef ibmpc
3555
#define MV "rename"
3556
#else
3557
#define MV "mv"
3558
#endif
3559
#endif
3560
sprintf(temp,"%s %s %s",MV,(char*)f->tmp_name,
3561
(char*)f->name);
3562
system(temp);
3563
printf("*");
3564
}
3565
}
3566
3567
printf(")");UPDATE_TERMINAL;
3568
3569
renamed= YES;
3570
}
3571
3572
3573
}
3574
}
3575
3576
if(!renamed)
3577
printf("[no changes]");
3578
}
3579
3580
3581
3582
SRTN
3583
out_op FCN((s))
3584
CONST outer_char HUGE*s C1("String to translate.")
3585
{
3586
out_str(s);
3587
3588
out_state= MISCELLANEOUS;
3589
}
3590
3591
CONST outer_char HUGE*out_str FCN((s0))
3592
CONST outer_char HUGE*s0 C1("")
3593
{
3594
CONST outer_char HUGE*s;
3595
3596
for(s= s0;*s;s++)
3597
C_putc(*s);
3598
3599
return s0;
3600
}
3601
3602
3603
3604
eight_bits
3605
x_identifier FCN((cur_char))
3606
eight_bits cur_char C1("")
3607
{
3608
if(!in_cdir)
3609
3610
{
3611
boolean in_macro0= in_macro;
3612
name_pointer np= name_dir+cur_val;
3613
X_FCN(HUGE_FCN_PTR*pf)(VOID);
3614
3615
if(np->expandable&language)
3616
{
3617
expand_special:
3618
in_macro= NO;
3619
3620
pf= np->x_translate[lan_num(language)];
3621
3622
if(pf)
3623
(*pf)();
3624
else
3625
3626
confusion(OC("possibly expand special"),OC("Allegedly expandable keyword has no associated function"));
3627
3628
in_macro= in_macro0;
3629
3630
cur_char= id_keyword;
3631
goto end_identifier;
3632
}
3633
else if(R77&&Fortran88&&!checking_label)
3634
switch(chk_lbl())
3635
{
3636
case YES:goto expand_special;
3637
case-1:goto end_identifier;
3638
case NO:break;
3639
}
3640
}
3641
3642
;
3643
3644
if(is_deferred((sixteen_bits)cur_val))
3645
return cur_char;
3646
3647
3648
3649
3650
3651
if(!mac_protected&&(macro_text= MAC_LOOKUP(cur_val))!=NULL)
3652
{
3653
3654
{
3655
eight_bits HUGE*p1;
3656
3657
3658
in_macro= YES;
3659
3660
3661
#ifdef DEBUG_MACS
3662
printf("\n<<< 0x%x >>>\n",macrobuf);
3663
find_n(cur_val);
3664
#endif
3665
3666
p1= xmacro(macro_text,&cur_byte,&cur_end,YES,macrobuf);
3667
3668
3669
3670
#ifdef DEBUG_MACS
3671
printf("Expanded into (0x%x->0x%x) <<<%lu>>>\n",p1,mp,p1-macrobuf);
3672
#endif
3673
3674
3675
3676
3677
copy_out(p1,mp,macro);
3678
in_macro= NO;
3679
}
3680
3681
3682
return cur_char;
3683
}
3684
else
3685
{
3686
3687
{
3688
#if FANCY_SPLIT
3689
if(C_LIKE(language)&&out_state!=VERBATIM)
3690
split_pos= pC_buffer;
3691
#endif
3692
}
3693
3694
3695
3696
if(out_state==NUM_OR_ID&&!nuweb_mode)
3697
C_putc(' ');
3698
3699
3700
{
3701
name_pointer np;
3702
3703
3704
np= name_dir+cur_val;
3705
3706
if(truncate_ids)
3707
out_trunc(np);
3708
else
3709
see_id(np->byte_start,(np+1)->byte_start);
3710
}
3711
3712
;
3713
3714
if(no_expand)
3715
no_expand= mac_protected= NO;
3716
}
3717
3718
end_identifier:
3719
out_state= in_format?MISCELLANEOUS:NUM_OR_ID;
3720
3721
return cur_char;
3722
}
3723
3724
3725
3726
boolean
3727
is_deferred FCN((cur_val))
3728
sixteen_bits cur_val C1("")
3729
{
3730
name_pointer np;
3731
3732
np= name_dir+cur_val;
3733
3734
if(np->macro_type==DEFERRED_MACRO)
3735
{
3736
text_pointer tp;
3737
eight_bits HUGE*p0,HUGE*p1;
3738
eight_bits a0;
3739
3740
tp= (text_pointer)np->equiv;
3741
3742
3743
p0= tp->tok_start;
3744
p1= p0+tp->nbytes;
3745
3746
while(p0<p1)
3747
{
3748
if(TOKEN1(a0= *p0++))
3749
if(a0==043)
3750
switch(*p0)
3751
{
3752
case 041:
3753
if(*(p0+1)==MACRO_ARGUMENT)
3754
app_repl(a0)
3755
else
3756
3757
{
3758
if(TOKEN1(*++p0))
3759
3760
macro_err(OC("! Macro token `#!' must be followed by identifier"),YES);
3761
else
3762
{
3763
text_pointer m;
3764
3765
if((m= MAC_LOOKUP(IDENTIFIER(*p0,*(p0+1))))==NULL)
3766
3767
macro_err(OC("! Expecting macro identifier after \"#!\""),YES);
3768
else
3769
if(m->nargs>0)
3770
3771
macro_err(OC("! Macro after \"#!\" can't have arguments"),YES);
3772
else
3773
3774
{
3775
eight_bits HUGE*q0,HUGE*q1;
3776
3777
3778
q0= m->tok_start+m->moffset;
3779
q1= m->tok_start+m->nbytes;
3780
3781
3782
while(q0<q1)
3783
app_repl(*q0++);
3784
}
3785
3786
3787
3788
p0+= 2;
3789
}
3790
}
3791
3792
3793
break;
3794
3795
default:
3796
app_repl(a0);
3797
break;
3798
}
3799
else
3800
app_repl(a0)
3801
else
3802
{
3803
app_repl(a0);
3804
app_repl(*p0++);
3805
}
3806
}
3807
3808
cur_text= text_ptr;
3809
3810
cur_text->Language= (boolean)language;
3811
cur_text->nargs= tp->nargs;
3812
cur_text->moffset= tp->moffset;
3813
cur_text->recursive= NO;
3814
cur_text->var_args= tp->var_args;
3815
3816
text_ptr++;
3817
3818
sv_macro();
3819
3820
np= name_dir+IDENTIFIER(tp->tok_start[0],tp->tok_start[1]);
3821
np->macro_type= IMMEDIATE_MACRO;
3822
np->equiv= (EQUIV)cur_text;
3823
3824
return YES;
3825
}
3826
3827
return NO;
3828
}
3829
3830
3831
3832
SRTN
3833
out_ptrunc FCN((cur_val))
3834
sixteen_bits cur_val C1("")
3835
{
3836
3837
{
3838
name_pointer np;
3839
3840
3841
np= name_dir+cur_val;
3842
3843
if(truncate_ids)
3844
out_trunc(np);
3845
else
3846
see_id(np->byte_start,(np+1)->byte_start);
3847
}
3848
3849
3850
}
3851
3852
3853
3854
SRTN
3855
see_id FCN((start,end))
3856
CONST ASCII HUGE*start C0("Beginning of identifier name.")
3857
CONST ASCII HUGE*end C1("End of identifier name.")
3858
{
3859
CONST ASCII HUGE*j;
3860
3861
for(j= start;j<end;j++)C_putc(XCHR(*j));
3862
}
3863
3864
3865
3866
int
3867
id FCN((n))
3868
int n C1("Identifier number.")
3869
{
3870
printf(_Xx("Id %d (0x%x): \"%s\"\n"),n,n,(char*)name_of((sixteen_bits)n));
3871
return n;
3872
}
3873
3874
3875
3876
outer_char HUGE*name_of FCN((id0))
3877
sixteen_bits id0 C1("Identifier token whose name is sought.")
3878
{
3879
static ASCII temp[MAX_ID_LENGTH];
3880
int k,n;
3881
name_pointer np;
3882
CONST ASCII HUGE*end;
3883
3884
np= name_dir+id0;
3885
3886
3887
if(np>=name_ptr)
3888
{
3889
STRCPY(temp,"???");
3890
return(outer_char HUGE*)temp;
3891
}
3892
3893
PROPER_END(end);
3894
3895
#if 0
3896
n= MIN(end-np->byte_start,MAX_ID_LENGTH-1);
3897
#else
3898
if(end-np->byte_start<MAX_ID_LENGTH-1)
3899
n= PTR_DIFF(int,end,np->byte_start);
3900
else
3901
n= MAX_ID_LENGTH-1;
3902
#endif
3903
3904
STRNCPY(temp,np->byte_start,n);
3905
3906
3907
if(breakpoints)
3908
for(k= 0;k<n;k++)
3909
if(temp[k]==0134)temp[k]= 057;
3910
3911
temp[n]= '\0';
3912
3913
return to_outer(temp);
3914
}
3915
3916
3917
3918
CONST ASCII HUGE*proper_end FCN((np))
3919
name_pointer np C1("")
3920
{
3921
CONST ASCII HUGE*end;
3922
3923
PROPER_END(end);
3924
return end;
3925
}
3926
3927
SRTN
3928
out_trunc FCN((np))
3929
CONST name_pointer np C1("")
3930
{
3931
TRUNC HUGE*s;
3932
ASCII HUGE*pc;
3933
3934
pc= np->byte_start;
3935
3936
if(*pc!=BP_MARKER)
3937
{
3938
CONST ASCII HUGE*end;
3939
3940
3941
PROPER_END(end);
3942
see_id((CONST ASCII HUGE*)pc,end);
3943
}
3944
else
3945
{
3946
s= ((BP HUGE*)pc)->Root;
3947
see_id(s->id,s->id_end);
3948
}
3949
}
3950
3951
3952
3953
SRTN
3954
prn_mod_num FCN((fmt,val))
3955
outer_char*fmt C0("")
3956
long val C1("")
3957
{
3958
int l;
3959
3960
if(line_info)
3961
{
3962
l= lan_num(R77_or_F&&!free_90?FORTRAN:language);
3963
3964
if(val<0)
3965
{
3966
val= -val;
3967
}
3968
3969
if(FORTRAN_LIKE(language))
3970
{
3971
if(out_pos>rst_pos)flush_out(YES);
3972
out_pos= 0;
3973
}
3974
3975
C_sprintf(fmt,3,begin_comment_char[l],val,end_comment_char[l]);
3976
}
3977
}
3978
3979
3980
3981
eight_bits
3982
skip_ahead FCN((last_control,skip_over_bars))
3983
eight_bits last_control C0("Last token that was seen.")
3984
boolean skip_over_bars C1("")
3985
{
3986
eight_bits cc;
3987
int ncc= 0;
3988
3989
3990
ASCII last_char;
3991
ASCII HUGE*lc;
3992
ASCII HUGE*l1= limit+1;
3993
3994
WHILE()
3995
{
3996
if(loc>limit)
3997
{
3998
another_line:
3999
if(from_buffer)
4000
{
4001
undivert();
4002
return ignore;
4003
}
4004
else
4005
{
4006
if(!get_line())
4007
return new_module;
4008
4009
l1= limit+1;
4010
}
4011
}
4012
4013
*l1= 0100;
4014
4015
more_stuff:
4016
switch(*loc)
4017
{
4018
case 0100:
4019
break;
4020
4021
case 0174:
4022
if(skip_over_bars)
4023
{
4024
if(skip_bars()==new_module)return new_module;
4025
4026
continue;
4027
}
4028
4029
4030
4031
default:
4032
loc++;
4033
if(loc>limit)
4034
{
4035
ncc= 2;
4036
goto another_line;
4037
}
4038
goto more_stuff;
4039
}
4040
4041
*l1= 040;
4042
4043
if(loc>limit)ncc= 2;
4044
else
4045
{
4046
last_char= 040;
4047
4048
for(lc= loc-1;lc>=cur_buffer;lc--)
4049
if(*lc!=040)
4050
{
4051
last_char= *lc;
4052
break;
4053
}
4054
4055
++loc;
4056
++ncc;
4057
4058
switch(cc= ccode[*(loc++)])
4059
{
4060
4061
4062
case begin_C:
4063
case begin_RATFOR:
4064
case begin_FORTRAN:
4065
case begin_LITERAL
4066
4067
4068
4069
:
4070
loc--;
4071
4072
case L_switch:
4073
{
4074
if(last_char!=0174)
4075
{
4076
4077
{
4078
ASCII l= *loc++;
4079
4080
switch(l)
4081
{
4082
4083
case 0143
4084
4085
:
4086
Cpp= BOOLEAN(*loc==053);
4087
break;
4088
4089
4090
case 0162
4091
4092
:
4093
4094
case 0156
4095
4096
:
4097
Fortran88= BOOLEAN(*loc==071);
4098
break;
4099
4100
4101
case 0166
4102
4103
4104
4105
:
4106
4107
case 0170
4108
4109
:
4110
break;
4111
4112
default:
4113
4114
err0_print(ERR_C,OC("! Invalid language command `@L%c' ignored"),1,XCHR(l));
4115
break;
4116
}
4117
4118
opt_args(l);
4119
4120
}
4121
4122
4123
4124
if(module_count==0)global_params= params;
4125
set_output_file(language);
4126
}
4127
continue;
4128
}
4129
4130
case begin_nuweb:
4131
nuweb_mode1= nuweb_mode= !NUWEB_MODE;
4132
4133
if(module_count==0)
4134
global_params= params;
4135
4136
continue;
4137
4138
case control_text:
4139
while((c= skip_ahead(ignore,NO))==0100);
4140
4141
4142
if(*(loc-1)!=076)
4143
4144
err0_print(ERR_T,OC("Improper %s@%s within control text"),2,SSET_COLOR(character),SSET_COLOR(error));
4145
4146
continue;
4147
4148
case compiler_directive:
4149
case Compiler_Directive:
4150
if(scanning_TeX)
4151
4152
err0_print(ERR_T,OC("Compiler directives are allowed only in code"),0);
4153
loc= limit+1;
4154
continue;
4155
4156
case invisible_cmnt:
4157
loc= limit+1;
4158
continue;
4159
4160
case module_name:
4161
if(ncc==1&&last_control==formatt)
4162
{
4163
loc-= 2;
4164
get_next();
4165
continue;
4166
}
4167
break;
4168
4169
case big_line_break:
4170
if(loc>=limit)continue;
4171
4172
4173
{
4174
boolean mcode;
4175
4176
*limit= ' ';
4177
id_first= loc;
4178
4179
while(isAlpha(*loc))
4180
loc++;
4181
4182
if((mcode= is_mcmd(mcmds,id_first,loc))!=0)
4183
{
4184
while(loc<limit&&(*loc==040||*loc==tab_mark))
4185
loc++;
4186
4187
#ifdef _FWEAVE_h
4188
defd_switch= NO;
4189
#endif
4190
4191
return mcode;
4192
}
4193
4194
loc= id_first;
4195
}
4196
4197
4198
;
4199
continue;
4200
4201
case USED_BY_NEITHER:
4202
4203
err0_print(ERR_T,OC("Invalid `@%c' ignored"),1,XCHR(*(loc-1)));
4204
continue;
4205
}
4206
4207
if(cc!=ignore||(*(loc-1)==076&&(ncc!=2)&&last_control!=formatt))
4208
return cc;
4209
}
4210
4211
4212
}
4213
4214
DUMMY_RETURN(ignore);
4215
}
4216
4217
4218
4219
eight_bits skip_bars(VOID)
4220
{
4221
PARAMS params0;
4222
LANGUAGE language0= language;
4223
eight_bits ret_val;
4224
4225
params0= params;
4226
4227
loc++;
4228
4229
WHILE()
4230
{
4231
if(loc>limit&&!get_line())
4232
{
4233
4234
err0_print(ERR_T,OC("Reached end of file while skipping code text %s"),1,BTRANS);
4235
ret_val= new_module;
4236
goto done;
4237
}
4238
4239
switch(next_control= get_next())
4240
{
4241
case begin_bp:
4242
case insert_bp:
4243
case begin_meta:
4244
case end_meta:
4245
case formatt:
4246
case limbo_text:
4247
case op_def:
4248
case macro_def:
4249
case definition:
4250
case undefinition:
4251
case WEB_definition:
4252
case m_ifdef:
4253
case m_ifndef:
4254
case m_else:
4255
case m_elif:
4256
case m_endif:
4257
case m_for:
4258
case m_endfor:
4259
case m_line:
4260
case m_undef:
4261
case begin_code:
4262
4263
err0_print(ERR_T,OC("Control code not allowed within |...|; \
4264
inserted '|' in %s"),1,MTRANS);
4265
loc-= 2;
4266
ret_val= 0174;
4267
goto done;
4268
4269
case new_module:
4270
4271
err0_print(ERR_T,OC("Module%s ended while skipping code text; \
4272
inserted '|'"),1,MTRANS0);
4273
4274
case 0174:
4275
ret_val= next_control;
4276
goto done;
4277
}
4278
}
4279
4280
done:
4281
params= params0;
4282
frz_params();
4283
set_output_file(language0);
4284
4285
return ret_val;
4286
}
4287
4288
4289
#endif
4290
4291
#if(part == 0 || part == 2)
4292
4293
4294
eight_bits
4295
out_char FCN((cur_char))
4296
eight_bits cur_char C1("Token to control or be sent to the output.")
4297
{
4298
switch(cur_char)
4299
{
4300
case ignore:
4301
if(R77_or_F&&started_vcmnt)C_putc(cur_char);
4302
return 040;
4303
4304
4305
4306
case bell:
4307
return out_dflt(tab_mark);
4308
4309
case 054:
4310
out_dflt(cur_char);
4311
4312
{
4313
#if FANCY_SPLIT
4314
if(C_LIKE(language)&&out_state!=VERBATIM)
4315
split_pos= pC_buffer;
4316
#endif
4317
}
4318
4319
4320
break;
4321
4322
case interior_semi:
4323
if(!(Fortran88||in_string))cur_char= 073;
4324
4325
4326
case 073:
4327
4328
4329
if(send_rp)
4330
{
4331
C_putc(')');
4332
send_rp= NO;
4333
}
4334
4335
;
4336
return out_dflt(cur_char);
4337
4338
case cdir:
4339
in_cdir= BOOLEAN(!in_cdir);
4340
4341
if(FORTRAN_LIKE(language))
4342
{
4343
in_string= NO;
4344
flush_buffer();
4345
in_string= YES;
4346
}
4347
break;
4348
4349
case 012:
4350
if((copying_macros||!nuweb_mode)
4351
&&(protect||out_state==VERBATIM))
4352
{
4353
4354
4355
4356
4357
4358
if(copying_macros&&protect&&!in_string)
4359
C_putc(' ');
4360
4361
out_str(t_style.protect_chars[lan_num(language)]);
4362
4363
}
4364
4365
4366
if(send_rp)
4367
{
4368
C_putc(')');
4369
send_rp= NO;
4370
}
4371
4372
;
4373
flush_buffer();
4374
if(out_state!=VERBATIM)
4375
out_state= MISCELLANEOUS;
4376
break;
4377
4378
4379
case end_format_stmt:
4380
in_format= NO;
4381
C_putc(';');
4382
out_state= NUM_OR_ID;
4383
break;
4384
4385
case begin_format_stmt:
4386
in_format= YES;
4387
OUT_OP(" format");
4388
out_state= MISCELLANEOUS;
4389
break;
4390
4391
case identifier:
4392
cur_char= x_identifier(cur_char);
4393
break;
4394
4395
4396
;
4397
4398
4399
case module_number:
4400
if(cur_val>0)
4401
prn_mod_num(OC("%c* %ld: *%c\n"),cur_val);
4402
else if(cur_val<0)
4403
prn_mod_num(OC("%c* :%ld *%c\n"),cur_val);
4404
else
4405
{
4406
if(line_info)
4407
{
4408
outer_char line_char;
4409
4410
switch(language)
4411
{
4412
case RATFOR:
4413
case RATFOR_90:
4414
case C:
4415
case C_PLUS_PLUS:
4416
case LITERAL:
4417
line_char= '#';
4418
break;
4419
4420
case FORTRAN:
4421
case FORTRAN_90:
4422
line_char= LINE_CHAR;
4423
break;
4424
4425
case TEX:
4426
line_char= '%';
4427
break;
4428
}
4429
4430
nearest_line= (LINE_NUMBER)(BASE2*(*cur_byte++));
4431
nearest_line+= *cur_byte++;
4432
4433
C_sprintf(OC("%cline %u \""),2,
4434
line_char,nearest_line);
4435
4436
4437
cur_val= BASE2*(*cur_byte++);
4438
cur_val+= *cur_byte++;
4439
4440
4441
{
4442
name_pointer np;
4443
4444
4445
np= name_dir+cur_val;
4446
4447
if(truncate_ids)
4448
out_trunc(np);
4449
else
4450
see_id(np->byte_start,(np+1)->byte_start);
4451
}
4452
4453
4454
C_sprintf(OC("\"\n"),0);
4455
}
4456
else
4457
cur_byte+= 4;
4458
}
4459
4460
break;
4461
4462
;
4463
4464
4465
case plus_plus:
4466
if(FORTRAN_LIKE(language))
4467
{
4468
4469
{
4470
outer_char HUGE*l;
4471
4472
4473
4474
C_putc('=');
4475
plast_char--;
4476
out_state= MISCELLANEOUS;
4477
4478
4479
4480
if(compound_assignments)
4481
{
4482
send_rp= YES;
4483
4484
if(last_xpr_overflowed)
4485
OVERFLW("last expression","lx");
4486
4487
for(l= last_char;isdigit(*l)||!isalpha(*l);l++)
4488
;
4489
4490
if(plast_char-l>=3&&STRNCMP(last_char,"if(",3)==0)
4491
4492
err0_print(ERR_T,OC("Sorry, can't expand compound assignment \
4493
operators correctly after simple IF; please use an IF...THEN construction"),0);
4494
4495
while(l<plast_char)
4496
buffer_out(*l++);
4497
4498
send_rp= NO;
4499
}
4500
else
4501
4502
fatal(ERR_T,OC("ABORTING: "),OC("Operators `++', `--', `+=', `-=', `*=', and `/=' \
4503
are not allowed; they were turned off by option `-+'."));
4504
}
4505
4506
;
4507
buffer_out('+');buffer_out('1');
4508
out_state= MISCELLANEOUS;
4509
}
4510
else
4511
{
4512
if(*(pC_buffer-1)=='+'&&!nuweb_mode)
4513
C_putc(' ');
4514
OUT_OP("++");
4515
}
4516
4517
4518
{
4519
#if FANCY_SPLIT
4520
if(C_LIKE(language)&&out_state!=VERBATIM)
4521
split_pos= pC_buffer;
4522
#endif
4523
}
4524
4525
4526
break;
4527
4528
case minus_minus:
4529
if(FORTRAN_LIKE(language))
4530
{
4531
4532
{
4533
outer_char HUGE*l;
4534
4535
4536
4537
C_putc('=');
4538
plast_char--;
4539
out_state= MISCELLANEOUS;
4540
4541
4542
4543
if(compound_assignments)
4544
{
4545
send_rp= YES;
4546
4547
if(last_xpr_overflowed)
4548
OVERFLW("last expression","lx");
4549
4550
for(l= last_char;isdigit(*l)||!isalpha(*l);l++)
4551
;
4552
4553
if(plast_char-l>=3&&STRNCMP(last_char,"if(",3)==0)
4554
4555
err0_print(ERR_T,OC("Sorry, can't expand compound assignment \
4556
operators correctly after simple IF; please use an IF...THEN construction"),0);
4557
4558
while(l<plast_char)
4559
buffer_out(*l++);
4560
4561
send_rp= NO;
4562
}
4563
else
4564
4565
fatal(ERR_T,OC("ABORTING: "),OC("Operators `++', `--', `+=', `-=', `*=', and `/=' \
4566
are not allowed; they were turned off by option `-+'."));
4567
}
4568
4569
;
4570
buffer_out('-');buffer_out('1');
4571
out_state= MISCELLANEOUS;
4572
}
4573
else
4574
{
4575
if(*(pC_buffer-1)=='-'&&!nuweb_mode)
4576
C_putc(' ');
4577
OUT_OP("--");
4578
}
4579
4580
4581
{
4582
#if FANCY_SPLIT
4583
if(C_LIKE(language)&&out_state!=VERBATIM)
4584
split_pos= pC_buffer;
4585
#endif
4586
}
4587
4588
4589
break;
4590
4591
case minus_gt:OUT_OP(FORTRAN_LIKE(language)?".EQV.":"->");break;
4592
4593
case gt_gt:
4594
4595
{
4596
#if FANCY_SPLIT
4597
if(C_LIKE(language)&&out_state!=VERBATIM)
4598
split_pos= pC_buffer;
4599
#endif
4600
}
4601
4602
4603
OUT_OP(">>");break;
4604
4605
case eq_eq:
4606
4607
{
4608
#if FANCY_SPLIT
4609
if(C_LIKE(language)&&out_state!=VERBATIM)
4610
split_pos= pC_buffer;
4611
#endif
4612
}
4613
4614
4615
OUT_OP(R77_or_F?F_OP(".EQ.","=="):"==");break;
4616
4617
case lt_lt:
4618
4619
{
4620
#if FANCY_SPLIT
4621
if(C_LIKE(language)&&out_state!=VERBATIM)
4622
split_pos= pC_buffer;
4623
#endif
4624
}
4625
4626
4627
OUT_OP("<<");break;
4628
4629
case 076:
4630
if(in_string||in_format)
4631
out_dflt(cur_char);
4632
else
4633
{
4634
OUT_OP(R77_or_F?F_OP(".GT.",">"):">");
4635
if(language==C_PLUS_PLUS)
4636
C_putc(' ');
4637
}
4638
4639
4640
{
4641
#if FANCY_SPLIT
4642
if(C_LIKE(language)&&out_state!=VERBATIM)
4643
split_pos= pC_buffer;
4644
#endif
4645
}
4646
4647
4648
break;
4649
4650
case gt_eq:
4651
OUT_OP(R77_or_F?F_OP(".GE.",">="):">=");
4652
4653
{
4654
#if FANCY_SPLIT
4655
if(C_LIKE(language)&&out_state!=VERBATIM)
4656
split_pos= pC_buffer;
4657
#endif
4658
}
4659
4660
4661
break;
4662
4663
case 074:
4664
if(in_string||in_format)
4665
out_dflt(cur_char);
4666
else
4667
OUT_OP(R77_or_F?F_OP(".LT.","<"):"<");
4668
4669
4670
{
4671
#if FANCY_SPLIT
4672
if(C_LIKE(language)&&out_state!=VERBATIM)
4673
split_pos= pC_buffer;
4674
#endif
4675
}
4676
4677
4678
break;
4679
4680
case lt_eq:
4681
OUT_OP(R77_or_F?F_OP(".LE.","<="):"<=");
4682
4683
{
4684
#if FANCY_SPLIT
4685
if(C_LIKE(language)&&out_state!=VERBATIM)
4686
split_pos= pC_buffer;
4687
#endif
4688
}
4689
4690
4691
break;
4692
4693
case not_eq:
4694
OUT_OP(R77_or_F?F_OP(".NE.","/="):"!=");
4695
4696
{
4697
#if FANCY_SPLIT
4698
if(C_LIKE(language)&&out_state!=VERBATIM)
4699
split_pos= pC_buffer;
4700
#endif
4701
}
4702
4703
4704
break;
4705
4706
case and_and:
4707
OUT_OP(R77_or_F?".AND.":"&&");
4708
4709
{
4710
#if FANCY_SPLIT
4711
if(C_LIKE(language)&&out_state!=VERBATIM)
4712
split_pos= pC_buffer;
4713
#endif
4714
}
4715
4716
4717
break;
4718
4719
case or_or:
4720
if(language==TEX)meta_mode= YES;
4721
else
4722
{
4723
OUT_OP(R77_or_F?".OR.":"||");
4724
4725
{
4726
#if FANCY_SPLIT
4727
if(C_LIKE(language)&&out_state!=VERBATIM)
4728
split_pos= pC_buffer;
4729
#endif
4730
}
4731
4732
4733
}
4734
break;
4735
4736
case star_star:
4737
if(language==TEX)meta_mode= NO;
4738
else OUT_OP(C_LIKE(language)?"^^":"**");
4739
break;
4740
4741
case 041:
4742
4743
{
4744
#if FANCY_SPLIT
4745
if(C_LIKE(language)&&out_state!=VERBATIM)
4746
split_pos= pC_buffer;
4747
#endif
4748
}
4749
4750
4751
if(in_string)
4752
return out_dflt(cur_char);
4753
else
4754
OUT_OP(R77_or_F?".NOT.":"!");
4755
break;
4756
4757
case slash_slash:OUT_OP("//");break;
4758
4759
case colon_colon:
4760
if(in_string&&!nuweb_mode)
4761
return out_dflt(cur_char);
4762
4763
4764
else
4765
OUT_OP("::");
4766
break;
4767
4768
case ellipsis:
4769
OUT_OP(FORTRAN_LIKE(language)?".NEQV.":"...");
4770
4771
{
4772
#if FANCY_SPLIT
4773
if(C_LIKE(language)&&out_state!=VERBATIM)
4774
split_pos= pC_buffer;
4775
#endif
4776
}
4777
4778
4779
break;
4780
4781
case paste:OUT_OP("##");break;
4782
4783
case dot_const:
4784
C_putc('.');
4785
STRCPY(dot_op.name+1,dots[cur_val].symbol);
4786
to_outer(dot_op.name+1);
4787
OUT_OP(OC(dot_op.name+1));
4788
C_putc('.');
4789
break;
4790
4791
;
4792
4793
case 053:
4794
case 055:
4795
case 052:
4796
case 057:
4797
4798
4799
if(!FORTRAN_LIKE(language)||
4800
cur_byte==cur_end||*cur_byte!=075||
4801
out_state==VERBATIM||!xpn_Ratfor)
4802
{
4803
if(cur_char==052&&C_LIKE(language)&&out_state!=VERBATIM
4804
&&*(pC_buffer-1)=='/'&&!nuweb_mode)
4805
C_putc(' ');
4806
4807
{
4808
#if FANCY_SPLIT
4809
if(C_LIKE(language)&&out_state!=VERBATIM)
4810
split_pos= pC_buffer;
4811
#endif
4812
}
4813
4814
4815
return out_dflt(cur_char);
4816
}
4817
4818
cur_byte++;
4819
4820
{
4821
outer_char HUGE*l;
4822
4823
4824
4825
C_putc('=');
4826
plast_char--;
4827
out_state= MISCELLANEOUS;
4828
4829
4830
4831
if(compound_assignments)
4832
{
4833
send_rp= YES;
4834
4835
if(last_xpr_overflowed)
4836
OVERFLW("last expression","lx");
4837
4838
for(l= last_char;isdigit(*l)||!isalpha(*l);l++)
4839
;
4840
4841
if(plast_char-l>=3&&STRNCMP(last_char,"if(",3)==0)
4842
4843
err0_print(ERR_T,OC("Sorry, can't expand compound assignment \
4844
operators correctly after simple IF; please use an IF...THEN construction"),0);
4845
4846
while(l<plast_char)
4847
buffer_out(*l++);
4848
4849
send_rp= NO;
4850
}
4851
else
4852
4853
fatal(ERR_T,OC("ABORTING: "),OC("Operators `++', `--', `+=', `-=', `*=', and `/=' \
4854
are not allowed; they were turned off by option `-+'."));
4855
}
4856
4857
;
4858
out_dflt(cur_char);
4859
send_rp= YES;
4860
4861
C_putc('(');
4862
break;
4863
4864
;
4865
4866
case 075:
4867
C_putc('=');
4868
4869
if(out_state!=VERBATIM)
4870
{
4871
if(C_LIKE(language)&&!nuweb_mode)
4872
C_putc(' ');
4873
4874
out_state= MISCELLANEOUS;
4875
}
4876
4877
4878
{
4879
#if FANCY_SPLIT
4880
if(C_LIKE(language)&&out_state!=VERBATIM)
4881
split_pos= pC_buffer;
4882
#endif
4883
}
4884
4885
4886
break;
4887
4888
case join:out_state= UNBREAKABLE;break;
4889
4890
case constant:
4891
if(out_state==VERBATIM)
4892
out_state= in_format?MISCELLANEOUS:NUM_OR_ID;
4893
4894
else
4895
{
4896
4897
{
4898
#if FANCY_SPLIT
4899
if(C_LIKE(language)&&out_state!=VERBATIM)
4900
split_pos= pC_buffer;
4901
#endif
4902
}
4903
4904
4905
4906
if(out_state==NUM_OR_ID&&!nuweb_mode)
4907
C_putc(' ');
4908
4909
out_state= VERBATIM;
4910
}
4911
4912
in_constant= BOOLEAN(!in_constant);
4913
break;
4914
4915
case stringg:
4916
if(in_string)
4917
out_state= MISCELLANEOUS;
4918
else
4919
{
4920
4921
{
4922
#if FANCY_SPLIT
4923
if(C_LIKE(language)&&out_state!=VERBATIM)
4924
split_pos= pC_buffer;
4925
#endif
4926
}
4927
4928
4929
4930
if(out_state==NUM_OR_ID&&!nuweb_mode)
4931
C_putc(' ');
4932
4933
4934
out_state= VERBATIM;
4935
}
4936
4937
in_string= BOOLEAN(!in_string);
4938
break;
4939
4940
case begin_meta:
4941
4942
4943
4944
pmeta= &t_style.meta[lan_num(language)];
4945
4946
switch(language)
4947
{
4948
outer_char*t;
4949
4950
case C:
4951
case C_PLUS_PLUS:
4952
case LITERAL:
4953
case TEX:
4954
if(meta_mode)
4955
break;
4956
4957
if(!nuweb_mode)
4958
{
4959
if(in_string&&!in_version)
4960
OUT_STR(t= pmeta->msg.top);
4961
else
4962
OUT_OP(t= pmeta->hdr.top);
4963
4964
if(*t)
4965
OUT_STR("\n");
4966
}
4967
meta_mode= YES;
4968
break;
4969
4970
case RATFOR:
4971
case RATFOR_90:
4972
case FORTRAN:
4973
case FORTRAN_90:
4974
if(meta_mode)
4975
xpn_Ratfor= NO;
4976
C_putc(cur_char);
4977
out_state= MISCELLANEOUS;
4978
break;
4979
4980
default:
4981
4982
confusion(OC("out_char:begin_meta"),OC("Language %i is not defined"),language);
4983
}
4984
break;
4985
4986
case end_meta:
4987
meta_mode= NO;
4988
4989
switch(language)
4990
{
4991
outer_char*t;
4992
4993
case C:
4994
case C_PLUS_PLUS:
4995
case LITERAL:
4996
case TEX:
4997
if(meta_mode)break;
4998
4999
if(!nuweb_mode)
5000
{
5001
if(in_string&&!in_version)
5002
OUT_OP(t= pmeta->msg.bottom);
5003
else
5004
OUT_OP(t= pmeta->hdr.bottom);
5005
5006
if(*t)OUT_OP("\n");
5007
}
5008
break;
5009
5010
case RATFOR:
5011
case RATFOR_90:
5012
case FORTRAN:
5013
case FORTRAN_90:
5014
xpn_Ratfor= YES;
5015
C_putc(cur_char);
5016
out_state= MISCELLANEOUS;
5017
break;
5018
5019
default:
5020
5021
confusion(OC("out_char:end_meta"),OC("Language %i is invalid"),language);
5022
}
5023
5024
break;
5025
5026
case 0173:
5027
if(R77&&!in_string)
5028
5029
{
5030
cp_fcn_body();
5031
cur_char= 01;
5032
}
5033
5034
5035
else
5036
{
5037
5038
{
5039
#if FANCY_SPLIT
5040
if(C_LIKE(language)&&out_state!=VERBATIM)
5041
split_pos= pC_buffer;
5042
#endif
5043
}
5044
5045
5046
return out_dflt(cur_char);
5047
}
5048
break;
5049
5050
5051
case 0175:
5052
{
5053
if(R77&&!in_string&&brace_level==0)
5054
5055
RAT_error(WARNING,OC("Spurious '}' ignored, \
5056
or missing program, module, subroutine, or function statement"),0);
5057
else
5058
{
5059
out_dflt(cur_char);
5060
5061
{
5062
#if FANCY_SPLIT
5063
if(C_LIKE(language)&&out_state!=VERBATIM)
5064
split_pos= pC_buffer;
5065
#endif
5066
}
5067
5068
5069
}
5070
}
5071
5072
break;
5073
5074
case 0133:
5075
out_bracket(cur_char,050);
5076
break;
5077
5078
case 0135:
5079
out_bracket(cur_char,051);
5080
break;
5081
5082
5083
case 0140:
5084
if(!(in_string||language==LITERAL))
5085
{
5086
mac_protected= BOOLEAN(!mac_protected);
5087
break;
5088
}
5089
else
5090
return out_dflt(cur_char);
5091
5092
case 046:
5093
if(C_LIKE(language)&&out_state!=VERBATIM
5094
&&*(pC_buffer-1)=='&'&&!nuweb_mode)
5095
C_putc(' ');
5096
5097
{
5098
#if FANCY_SPLIT
5099
if(C_LIKE(language)&&out_state!=VERBATIM)
5100
split_pos= pC_buffer;
5101
#endif
5102
}
5103
5104
5105
return out_dflt(cur_char);
5106
5107
case 0134:
5108
if(R66)
5109
cur_char= 044;
5110
5111
5112
default:
5113
return out_dflt(cur_char);
5114
}
5115
5116
return cur_char;
5117
}
5118
5119
5120
5121
eight_bits
5122
out_bracket FCN((cur_char,new_char))
5123
eight_bits cur_char C0("")
5124
eight_bits new_char C1("")
5125
{
5126
if(out_state!=VERBATIM&&FORTRAN_LIKE(language)&&translate_brackets)
5127
cur_char= new_char;
5128
return out_dflt(cur_char);
5129
}
5130
5131
5132
5133
eight_bits
5134
out_dflt FCN((c))
5135
eight_bits c C1("")
5136
{
5137
C_putc(XCHR(c));
5138
5139
if(out_state!=VERBATIM)
5140
out_state= MISCELLANEOUS;
5141
5142
return c;
5143
}
5144
5145
5146
5147
LANGUAGE set_output_file FCN((language0))
5148
LANGUAGE language0 C1("")
5149
{
5150
language= language0;
5151
ini0_language();
5152
out_file= params.OUT_FILE;
5153
5154
return language;
5155
}
5156
5157
5158
5159
LANGUAGE
5160
opn_output_file FCN((language0))
5161
LANGUAGE language0 C1("")
5162
{
5163
set_output_file(language0);
5164
flush_buffer();
5165
open_out(OC(""),LOCAL_SCOPE);
5166
5167
return language;
5168
}
5169
5170
5171
5172
boolean skip_comment(VOID)
5173
{
5174
ASCII c;
5175
PARSING_MODE outer_mode;
5176
5177
outer_mode= parsing_mode;
5178
parsing_mode= OUTER;
5179
5180
if(comment_continues)
5181
loc--;
5182
5183
5184
else if(*(loc-1)==057)
5185
loc++;
5186
5187
5188
WHILE()
5189
{
5190
if(loc>limit)
5191
if(!long_comment)
5192
5193
{
5194
comment_continues= NO;
5195
break;
5196
}
5197
5198
5199
else if(get_line())
5200
{
5201
comment_continues= YES;
5202
break;
5203
}
5204
else
5205
{
5206
5207
err0_print(ERR_T,OC("Input ended in middle of comment %s"),1,BTRANS);
5208
5209
comment_continues= NO;
5210
break;
5211
5212
}
5213
5214
c= *(loc++);
5215
5216
if(c==052&&*loc==057)
5217
{
5218
loc++;
5219
5220
{
5221
comment_continues= NO;
5222
break;
5223
}
5224
5225
5226
}
5227
5228
if(c==0100)
5229
{
5230
if(ccode[*loc]==new_module)
5231
{
5232
5233
err0_print(ERR_T,OC("Section name ended in middle of comment %s"),1,BTRANS);
5234
loc--;
5235
5236
5237
{
5238
comment_continues= NO;
5239
break;
5240
}
5241
5242
5243
}
5244
else loc++;
5245
}
5246
}
5247
5248
parsing_mode= outer_mode;
5249
return comment_continues;
5250
}
5251
5252
5253
5254
eight_bits
5255
get_next(VOID)
5256
{
5257
GOTO_CODE pcode;
5258
5259
strt_point_cmnt= suppress_newline= NO;
5260
5261
WHILE()
5262
{
5263
5264
5265
if(preprocessing&&at_beginning)
5266
{
5267
at_beginning= NO;
5268
5269
5270
5271
for(;loc<limit;loc++)
5272
if(!(*loc==040||*loc==tab_mark))break;
5273
5274
*(loc-1)= 043;
5275
5276
return(eight_bits)prs_regular_code(GOTO_GET_IDENTIFIER);
5277
}
5278
5279
;
5280
5281
5282
if(*loc==cont_char&&loc==limit-1&&(preprocessing||free_Fortran))
5283
{
5284
loc+= 2;
5285
return(eight_bits)CHOICE(free_Fortran,046,cont_char);
5286
5287
5288
}
5289
5290
;
5291
5292
if(loc>limit)
5293
5294
{
5295
if(from_buffer)
5296
{
5297
undivert();
5298
if(stop_the_scan)
5299
return WEB_definition;
5300
continue;
5301
}
5302
else
5303
{
5304
if(preprocessing&&*(limit-1)!=cont_char)
5305
{
5306
preprocessing= NO;
5307
if(in_cdir)
5308
{
5309
id_first= id_loc= mod_text+1;
5310
*id_loc++= cdir;
5311
*id_loc++= '\0';
5312
in_cdir= NO;
5313
return stringg;
5314
}
5315
}
5316
if(stop_the_scan)
5317
return WEB_definition;
5318
else if(!get_line())
5319
return new_module;
5320
5321
if(eat_blank_lines)
5322
{
5323
eat_blank_lines= NO;
5324
5325
while(loc>=limit)
5326
if(!get_line())
5327
return new_module;
5328
}
5329
5330
if(insrt_line)
5331
{
5332
ins_ln_no(0);
5333
insrt_line= NO;
5334
}
5335
5336
at_beginning= BOOLEAN(!preprocessing);
5337
5338
if(prn_where)
5339
{
5340
prn_where= NO;
5341
5342
if(!scanning_defn)
5343
{
5344
app_repl(012);
5345
5346
ins_ln_no(0)
5347
5348
;
5349
}
5350
}
5351
else if(!suppress_newline&&
5352
(!R77_or_F||limit==cur_buffer||free_Fortran))
5353
return 012;
5354
5355
suppress_newline= NO;
5356
}
5357
}
5358
5359
5360
else
5361
at_beginning= BOOLEAN(!preprocessing&&(loc==cur_buffer));
5362
5363
if(preprocessing)
5364
5365
{
5366
boolean found_white_space= NO;
5367
5368
do
5369
{
5370
if((c= *loc++)!=040||c!=tab_mark)
5371
break;
5372
5373
found_white_space= YES;
5374
}
5375
while(loc<limit);
5376
5377
5378
if(found_white_space)
5379
return 040;
5380
}
5381
5382
5383
else
5384
5385
{
5386
if(language==TEX)
5387
c= *loc++;
5388
else
5389
{
5390
ASCII HUGE*loc0= loc;
5391
5392
do
5393
{
5394
c= *loc++;
5395
}
5396
while(loc<=limit&&(c==040||c==tab_mark));
5397
5398
if(nuweb_mode||scanning_meta)
5399
{
5400
if(!(c==0100&&*loc==043))
5401
{
5402
loc= loc0;
5403
c= *loc++;
5404
5405
if(loc>limit)
5406
continue;
5407
}
5408
}
5409
}
5410
}
5411
5412
5413
5414
strt_cmnt= NO;
5415
5416
switch(language)
5417
{
5418
case TEX:
5419
if(!scanning_defn)
5420
{
5421
if((pcode= prs_TeX_code())==MORE_PARSE)
5422
break;
5423
else if(pcode<0)
5424
5425
confusion(OC("prs_TEX_code"),OC("Negative pcode %i"),pcode);
5426
else
5427
RETURN(pcode);
5428
}
5429
5430
default:
5431
if((pcode= prs_regular_code(MORE_PARSE))==MORE_PARSE)
5432
break;
5433
else if((int)pcode<0)
5434
5435
confusion(OC("prs_regular_code"),OC("Negative pcode %i"),pcode);
5436
else
5437
RETURN(pcode);
5438
}
5439
}
5440
5441
DUMMY_RETURN(ignore);
5442
}
5443
5444
5445
5446
GOTO_CODE
5447
prs_TeX_code(VOID)
5448
{
5449
GOTO_CODE icode;
5450
5451
if(loc>limit)
5452
return MORE_PARSE;
5453
5454
if(TeX[c]==TeX_comment)
5455
5456
{
5457
long_comment= NO;
5458
5459
if((all_cmnts_verbatim||(keep_trailing_comments&&!at_beginning))
5460
&&!(scanning_defn&&is_WEB_macro))
5461
{
5462
strt_cmnt= YES;
5463
}
5464
else
5465
{
5466
loc= limit+1;
5467
suppress_newline= YES;
5468
5469
return MORE_PARSE;
5470
}
5471
}
5472
5473
5474
5475
if(c==0100)
5476
{
5477
icode= get_control_code();
5478
5479
if(icode==MORE_PARSE)
5480
return icode;
5481
5482
if((int)(icode)<0)
5483
return prs_regular_code(icode);
5484
else
5485
return(eight_bits)icode;
5486
}
5487
else if(c==044&&STRNCMP(loc-1,LKWD,STRLEN(LKWD))==0)
5488
return prs_regular_code(MORE_PARSE);
5489
else
5490
5491
{
5492
loc--;
5493
id_first= id_loc= mod_text+1;
5494
5495
if(strt_cmnt)
5496
*id_loc++= begin_Xmeta;
5497
5498
while(loc<limit)
5499
{
5500
if(*loc==0100)
5501
{
5502
if(*(loc+1)==0100)
5503
*id_loc++= *loc++;
5504
}
5505
else if(*loc==044&&STRNCMP(loc,LKWD,STRLEN(LKWD))==0)
5506
break;
5507
else if(!strt_cmnt&&TeX[*loc]==TeX_comment&&*(loc-1)!=0134)
5508
break;
5509
5510
*id_loc++= *loc++;
5511
}
5512
5513
if(strt_cmnt)
5514
*id_loc++= end_Xmeta;
5515
5516
return stringg;
5517
}
5518
5519
5520
}
5521
5522
5523
GOTO_CODE
5524
prs_regular_code FCN((iswitch))
5525
GOTO_CODE iswitch C1("")
5526
{
5527
GOTO_CODE icode;
5528
5529
switch(iswitch)
5530
{
5531
case MORE_PARSE:break;
5532
5533
case GOTO_MISTAKE:goto mistake;
5534
case GOTO_GET_IDENTIFIER:goto get_identifier;
5535
case GOTO_GET_A_STRING:goto get_a_string;
5536
case GOTO_SKIP_A_COMMENT:goto skip_a_comment;
5537
}
5538
5539
if(language!=LITERAL)
5540
5541
{
5542
switch(c)
5543
{
5544
case(ASCII)begin_comment0:
5545
long_comment= strt_cmnt= YES;
5546
break;
5547
5548
case(ASCII)begin_comment1:
5549
strt_cmnt= strt_point_cmnt= YES;
5550
long_comment= NO;
5551
break;
5552
5553
case 057:
5554
if(*loc==052)
5555
long_comment= strt_cmnt= YES;
5556
else if(*loc==057&&(C_LIKE(language)||(Cpp_comments&&
5557
!in_format&&FORTRAN_LIKE(language))))
5558
{
5559
long_comment= NO;
5560
strt_cmnt= YES;
5561
}
5562
break;
5563
5564
case 041:
5565
5566
5567
if((*loc==041||point_comments)&&FORTRAN_LIKE(language))
5568
{
5569
*(loc-1)= (ASCII)begin_comment1;
5570
5571
strt_cmnt= strt_point_cmnt= YES;
5572
long_comment= NO;
5573
}
5574
break;
5575
}
5576
5577
if(strt_cmnt&&all_cmnts_verbatim&&!(scanning_defn&&is_WEB_macro))
5578
{
5579
loc--;
5580
5581
5582
switch(icode= get_control_code())
5583
{
5584
case GOTO_MISTAKE:goto mistake;
5585
case GOTO_GET_A_STRING:goto get_a_string;
5586
case GOTO_GET_IDENTIFIER:goto get_identifier;
5587
case GOTO_SKIP_A_COMMENT:goto skip_a_comment;
5588
5589
case m_line:
5590
ins_ln_no(1);
5591
suppress_newline= YES;
5592
return MORE_PARSE;
5593
5594
case MORE_PARSE:
5595
default:return icode;
5596
}
5597
5598
5599
}
5600
else if(strt_cmnt||comment_continues)
5601
{
5602
skip_a_comment:
5603
skip_comment();
5604
5605
if((comment_continues)&&
5606
!(scanning_defn&&is_WEB_macro))return 012;
5607
else return MORE_PARSE;
5608
}
5609
5610
if(loc==limit&&c==cont_char&&
5611
(preprocessing||(auto_semi&&R77)))
5612
return MORE_PARSE;
5613
}
5614
5615
5616
5617
5618
if(c==056&&*loc==056&&*(loc+1)==056)
5619
{
5620
++loc;
5621
compress(ellipsis);
5622
}
5623
5624
5625
else if(FORTRAN_LIKE(language)&&dot_constants&&
5626
(c==wt_style.dot_delimiter.begin)&&!isDigit(*loc))
5627
5628
5629
{
5630
ASCII HUGE*p0;
5631
int n;
5632
eight_bits c;
5633
ASCII dot_end= wt_style.dot_delimiter.end;
5634
5635
5636
5637
for(p0= loc,n= 0;n<MAX_DOT_LENGTH;n++,loc++)
5638
if(*loc==dot_end||!isAlpha(*loc))break;
5639
5640
5641
if(*loc!=dot_end)
5642
{
5643
loc= p0;
5644
goto mistake;
5645
}
5646
5647
c= dot_code(dots,uppercase(p0,n),loc++,dot_const);
5648
5649
if(c)return c;
5650
else
5651
{
5652
loc= p0;
5653
goto mistake;
5654
}
5655
5656
}
5657
5658
5659
5660
5661
else if(isDigit(c)||c==056||(c==0134&&language!=LITERAL))
5662
5663
{
5664
boolean decimal_point;
5665
5666
5667
if(loc==limit&&c==cont_char)
5668
{
5669
if(preprocessing)loc++;
5670
return(eight_bits)c;
5671
}
5672
5673
starts_with_0= hex_constant= bin_constant= floating_constant= NO;
5674
5675
id_first= loc-1;
5676
5677
if(*id_first==056&&!isDigit(*loc))
5678
goto mistake;
5679
5680
if(*id_first==0134)
5681
{
5682
if(*loc==057)
5683
goto mistake;
5684
5685
while(isOdigit(*loc))
5686
loc++;
5687
5688
goto found;
5689
}
5690
else
5691
{
5692
starts_with_0= BOOLEAN(*id_first==060);
5693
if(starts_with_0)
5694
{
5695
hex_constant= BOOLEAN(*loc==0170||*loc==0130);
5696
5697
if(hex_constant)
5698
{
5699
loc++;
5700
5701
while(isXdigit(*loc))
5702
loc++;
5703
5704
goto found;
5705
}
5706
else if((bin_constant= BOOLEAN(*loc==0142||*loc==0102))!=0)
5707
{
5708
loc++;
5709
5710
while(isBdigit(*loc))
5711
loc++;
5712
5713
goto found;
5714
}
5715
}
5716
5717
while(isDigit(*loc))loc++;
5718
decimal_point= BOOLEAN(*loc==056);
5719
if(decimal_point)loc++;
5720
while(isDigit(*loc))loc++;
5721
5722
if(FORTRAN_LIKE(language))
5723
if(*(loc-1)==056)
5724
{
5725
5726
5727
if(is_dot())
5728
{
5729
loc--;
5730
goto found;
5731
}
5732
}
5733
else if(*loc==0150||*loc==0110)
5734
5735
{
5736
int l,n;
5737
5738
5739
*loc++= '\0';
5740
5741
n= ATOI(id_first);
5742
*(loc-1)= 0110;
5743
5744
for(l= 0;l<n;++l)++loc;
5745
5746
goto found;
5747
}
5748
5749
5750
5751
floating_constant= BOOLEAN(*loc==0145||*loc==0105||
5752
(FORTRAN_LIKE(language)
5753
&&(*loc==0144||*loc==0104||*loc==0161||*loc==0121)));
5754
5755
if(floating_constant)
5756
{
5757
if(*++loc==053||*loc==055)loc++;
5758
while(isDigit(*loc))loc++;
5759
}
5760
5761
floating_constant|= decimal_point;
5762
}
5763
5764
found:
5765
if(C_LIKE(language))
5766
{
5767
boolean its_long= NO,its_unsigned= NO,its_constant= NO;
5768
5769
switch(*loc)
5770
{
5771
case 0154:
5772
case 0114:
5773
its_constant= its_long= YES;
5774
break;
5775
5776
case 0165:
5777
case 0125:
5778
its_constant= its_unsigned= YES;
5779
break;
5780
5781
case 0146:
5782
case 0106:
5783
its_constant= YES;
5784
break;
5785
}
5786
5787
if(its_constant)
5788
{
5789
5790
loc++;
5791
5792
5793
if(its_long&&(*loc==0165||*loc==0125))
5794
loc++;
5795
else if(its_unsigned&&(*loc==0154||*loc==0114))
5796
loc++;
5797
}
5798
}
5799
else if(Fortran88)
5800
{
5801
if(*loc==0137)
5802
while(is_kind(*loc))loc++;
5803
}
5804
5805
5806
5807
id_loc= loc;
5808
return constant;
5809
}
5810
5811
5812
5813
5814
else if(is_identifier(c))
5815
5816
{
5817
IN_COMMON ASCII HUGE*pformat,HUGE*pdata;
5818
5819
get_identifier:
5820
5821
{
5822
id_first= --loc;
5823
5824
5825
for(++loc;isAlpha(*loc)||isDigit(*loc)
5826
||*loc==0137||*loc==044||(in_format&&*loc==056);loc++)
5827
;
5828
5829
upcoming_kind= BOOLEAN(Fortran88&&(*loc=='"'||*loc=='\'')
5830
&&loc[-1]=='_');
5831
5832
id_loc= loc-upcoming_kind;
5833
5834
}
5835
5836
5837
5838
5839
if(FORTRAN_LIKE(language))
5840
{
5841
if(web_strcmp(pformat,pformat+6,id_first,id_loc)==EQUAL)
5842
{
5843
5844
in_format= YES;
5845
return begin_format_stmt;
5846
}
5847
else if(program==weave)
5848
{
5849
if(web_strcmp(pdata,pdata+4,id_first,id_loc)==EQUAL)
5850
{
5851
in_data= YES;
5852
return identifier;
5853
}
5854
else if(at_beginning&&*loc==':'&&
5855
!is_in(non_labels,id_first,id_loc))
5856
return stmt_label;
5857
}
5858
}
5859
5860
if(is_include_like())
5861
sharp_include_line= YES;
5862
5863
return identifier;
5864
}
5865
5866
5867
5868
5869
5870
else if((c==047||c==042)
5871
||(is_RATFOR_(language)&&sharp_include_line==YES&&c==050))
5872
{
5873
if(language==LITERAL)
5874
return c;
5875
else
5876
5877
get_a_string:
5878
{
5879
ASCII delim= c;
5880
ASCII right_delim= c;
5881
int level;
5882
boolean equal_delims;
5883
5884
id_first= mod_text+1;
5885
id_loc= mod_text;*++id_loc= delim;
5886
5887
if(delim==050)
5888
{
5889
right_delim= 051;
5890
sharp_include_line= NO;
5891
}
5892
5893
level= 1;
5894
5895
equal_delims= BOOLEAN(right_delim==delim);
5896
5897
WHILE()
5898
{
5899
if(loc>=limit)
5900
{
5901
if((equal_delims||chk_ifelse)&&*(limit-1)!=cont_char)
5902
5903
{
5904
5905
err0_print(ERR_T,OC("String %s with %s'%s%c'%s didn't end"),5,BTRANS,SSET_COLOR(character),delim==047?"\\":"",XCHR(delim),SSET_COLOR(error));
5906
loc= limit;break;
5907
5908
}
5909
5910
if(!get_line())
5911
{
5912
5913
err0_print(ERR_T,OC("Input ended in middle of string \
5914
%s with '%s%c'"),3,BTRANS,delim==047?"\\":"",XCHR(delim));
5915
loc= cur_buffer;
5916
break;
5917
5918
}
5919
else
5920
{
5921
if(C_LIKE(language)&&++id_loc<=mod_end)*id_loc= 012;
5922
5923
5924
5925
5926
if(bslash_continued_strings)
5927
{
5928
for(;loc<limit;loc++)
5929
if(*loc!=040&&*loc!=tab_mark)break;
5930
5931
if(*loc==cont_char)loc++;
5932
else
5933
err0_print(ERR_T,OC("Inserted '%c' at beginning of continued \
5934
string"),1,XCHR(cont_char));
5935
}
5936
}
5937
}
5938
5939
if(!equal_delims)
5940
5941
if(*loc==057&&*(loc+1)==052)
5942
for(loc+= 2;;loc++)
5943
{
5944
if(loc>=limit)
5945
if(!get_line())
5946
{
5947
5948
err0_print(ERR_T,OC("Input ended in middle of embedded comment %s"),1,BTRANS);
5949
loc= cur_buffer;
5950
goto found_string;
5951
}
5952
5953
if(*loc==052&&*(loc+1)==057)
5954
{
5955
loc+= 2;
5956
break;
5957
}
5958
}
5959
5960
;
5961
5962
if((c= *loc++)==delim)
5963
{
5964
level++;
5965
5966
if(++id_loc<=mod_end)*id_loc= c;
5967
5968
if(!equal_delims)continue;
5969
5970
if(*loc==delim&&!(C_LIKE(language)||
5971
(is_RATFOR_(language)&&Ratfor77)))
5972
++loc;
5973
else break;
5974
}
5975
5976
if(c==right_delim)
5977
if(--level==0)
5978
{
5979
if(++id_loc<=mod_end)*id_loc= c;
5980
break;
5981
}
5982
5983
5984
if(R77&&c==047)
5985
if(++id_loc<=mod_end)*id_loc= c;
5986
5987
if(c==cont_char)
5988
{
5989
if(loc>=limit&&(!is_FORTRAN_(language)||free_form_input))
5990
continue;
5991
5992
5993
if(!is_FORTRAN_(language))
5994
{
5995
c= *loc++;
5996
5997
if(R77)
5998
switch(c)
5999
{
6000
#if(0)
6001
#define n c
6002
6003
case 060:n= '\0';break;
6004
case 0134:n= 0134;break;
6005
case 047:n= 047;break;
6006
case 042:n= 042;break;
6007
case 077:n= 077;break;
6008
case 0141:n= 07;break;
6009
case 0142:n= 010;break;
6010
case 0146:n= 014;break;
6011
case 0156:n= 012;break;
6012
case 0162:n= 015;break;
6013
case 0164:n= 011;break;
6014
case 0166:n= 013;break;
6015
6016
6017
#undef n
6018
#endif
6019
6020
case 047:
6021
if(++id_loc<=mod_end)*id_loc= c;
6022
break;
6023
}
6024
else{if(++id_loc<=mod_end)*id_loc= 0134;}
6025
}
6026
}
6027
6028
if(++id_loc<=mod_end)*id_loc= c;
6029
}
6030
6031
found_string:
6032
if(id_loc>=mod_end)
6033
{
6034
SET_COLOR(error);
6035
printf("\n! String too long: ");
6036
6037
ASCII_write(mod_text+1,25);
6038
printf("...");
6039
mark_error;
6040
}
6041
6042
id_loc++;
6043
return stringg;
6044
}
6045
6046
6047
}
6048
6049
6050
else if(c==0100)
6051
6052
switch(icode= get_control_code())
6053
{
6054
case GOTO_MISTAKE:goto mistake;
6055
case GOTO_GET_A_STRING:goto get_a_string;
6056
case GOTO_GET_IDENTIFIER:goto get_identifier;
6057
case GOTO_SKIP_A_COMMENT:goto skip_a_comment;
6058
6059
case m_line:
6060
ins_ln_no(1);
6061
suppress_newline= YES;
6062
return MORE_PARSE;
6063
6064
case MORE_PARSE:
6065
default:return icode;
6066
}
6067
6068
6069
6070
6071
else if(c==040||c==tab_mark)
6072
if(nuweb_mode||scanning_meta)
6073
return(c==tab_mark?bell:c);
6074
else
6075
{
6076
if(!preprocessing||loc>limit)
6077
return MORE_PARSE;
6078
6079
else
6080
return 040;
6081
}
6082
6083
6084
else if(c==043&&!macro_scan&&at_beginning&&C_LIKE(language))
6085
{
6086
preprocessing= YES;
6087
return MORE_PARSE;
6088
}
6089
6090
6091
else if(in_format&&c==073)
6092
{
6093
in_format= NO;
6094
return end_format_stmt;
6095
}
6096
6097
6098
mistake:
6099
if(language!=LITERAL)
6100
6101
switch(c)
6102
{
6103
case 0134:
6104
if(FORTRAN_LIKE(language)&&!in_format&&*loc==057)
6105
compress(slash_slash);
6106
6107
break;
6108
6109
case 057:
6110
if(FORTRAN_LIKE(language)&&!in_format)
6111
{
6112
if(*loc==057)
6113
{
6114
if(Cpp_comments)
6115
break;
6116
6117
6118
6119
compress(slash_slash);
6120
6121
}
6122
else if(*loc==075&&!compound_assignments)
6123
compress(not_eq);
6124
}
6125
break;
6126
case 053:if(*loc==053)compress(plus_plus);break;
6127
6128
case 055:if(*loc==055){compress(minus_minus);}
6129
else if(*loc==076)compress(minus_gt);break;
6130
6131
case 075:if(*loc==075)compress(eq_eq);break;
6132
6133
case 076:if(*loc==075){compress(gt_eq);}
6134
else if(*loc==076){compress(gt_gt);}
6135
break;
6136
6137
case 074:if(*loc==075){compress(lt_eq);}
6138
else if(*loc==074){compress(lt_lt);}
6139
else if(*loc==076){compress(not_eq);}
6140
break;
6141
6142
case 046:if(*loc==046)compress(and_and);break;
6143
6144
case 0174:if(*loc==0174)compress(or_or);break;
6145
6146
case 041:if(*loc==075){compress(not_eq);}break;
6147
6148
case 052:
6149
if(FORTRAN_LIKE(language)&&(*loc==052))
6150
{compress(star_star);}
6151
break;
6152
6153
case 0136:
6154
if(*loc==0136){compress(star_star);}
6155
else if(FORTRAN_LIKE(language)&&(loc<limit))return star_star;
6156
break;
6157
6158
case 043:
6159
if(*loc==043){compress(paste);}
6160
else if(*loc==074)
6161
{
6162
loc++;
6163
mac_mod_name= YES;
6164
6165
{
6166
ASCII HUGE*k;
6167
static ASCII ell[]= "\56\56\56";
6168
6169
6170
6171
{
6172
int arg_num= 0;
6173
TEMPLATE arg_ptr[10];
6174
6175
mod_level= 1;
6176
k= mod_text;
6177
6178
WHILE()
6179
{
6180
if(loc>limit&&!get_line())
6181
{
6182
6183
err0_print(ERR_T,OC("Input ended in section name %s"),1,BTRANS);
6184
6185
loc= cur_buffer+1;
6186
break;
6187
}
6188
6189
c= *loc;
6190
6191
6192
if(c==0100)
6193
{
6194
c= *(loc+1);
6195
6196
if(c==076)
6197
{
6198
if(--mod_level==0)
6199
{
6200
loc+= 2;
6201
break;
6202
}
6203
}
6204
else if(c==074)
6205
mod_level++;
6206
6207
if(ccode[c]==new_module)
6208
{
6209
6210
err0_print(ERR_T,OC("Section name %s didn't end"),1,BTRANS);
6211
6212
break;
6213
}
6214
6215
*(++k)= 0100;
6216
loc++;
6217
}
6218
6219
;
6220
loc++;
6221
6222
if(k<mod_end)
6223
k++;
6224
6225
switch(c)
6226
{
6227
case 040:
6228
case tab_mark:
6229
c= 040;
6230
if(*(k-1)==040)
6231
k--;
6232
break;
6233
6234
case 073:
6235
c= interior_semi;
6236
break;
6237
6238
case 0133:
6239
break;
6240
}
6241
6242
*k= c;
6243
}
6244
6245
6246
if(k>=mod_end)
6247
{
6248
SET_COLOR(warning);
6249
printf("\n! Section name too long: ");
6250
6251
ASCII_write(mod_text+1,25);
6252
printf("...");
6253
mark_harmless;
6254
}
6255
6256
if(*k==040&&k>mod_text)
6257
k--;
6258
}
6259
6260
6261
6262
if(k-mod_text>3&&STRNCMP(k-2,ell,3)==0)
6263
cur_module= prefix_lookup(mod_text+1,k-3);
6264
else
6265
cur_module= mod_lookup(mod_text+1,k);
6266
6267
if(cur_module!=NULL)
6268
{
6269
set_output_file(cur_module->mod_info->language);
6270
}
6271
6272
return module_name;
6273
}
6274
6275
6276
}
6277
break;
6278
6279
case 072:if(*loc==072&&language==C_PLUS_PLUS&&!scanning_meta)
6280
compress(colon_colon);break;
6281
6282
}
6283
6284
6285
6286
6287
return(eight_bits)c;
6288
}
6289
6290
6291
6292
GOTO_CODE
6293
get_control_code(VOID)
6294
{
6295
eight_bits cc;
6296
6297
c= *loc++;
6298
SET_CASE(c);
6299
6300
if(c==(ASCII)begin_comment1||c==(ASCII)begin_comment0)
6301
{
6302
c= *(loc-1)= 057;
6303
6304
strt_cmnt= YES;
6305
}
6306
6307
if(c==076&&mod_level==0)
6308
{
6309
6310
err0_print(ERR_T,OC("Unmatched `%s@>%s' ignored"),2,SSET_COLOR(character),SSET_COLOR(error));
6311
return MORE_PARSE;
6312
}
6313
6314
switch(cc= ccode[c])
6315
{
6316
case ignore:return MORE_PARSE;
6317
6318
6319
6320
6321
6322
6323
case begin_C:
6324
case begin_RATFOR:
6325
case begin_FORTRAN:
6326
case begin_LITERAL
6327
6328
6329
6330
:
6331
loc--;
6332
6333
case L_switch:
6334
{
6335
6336
{
6337
ASCII l= *loc++;
6338
6339
switch(l)
6340
{
6341
6342
case 0143
6343
6344
:
6345
Cpp= BOOLEAN(*loc==053);
6346
break;
6347
6348
6349
case 0162
6350
6351
:
6352
6353
case 0156
6354
6355
:
6356
Fortran88= BOOLEAN(*loc==071);
6357
break;
6358
6359
6360
case 0166
6361
6362
6363
6364
:
6365
6366
case 0170
6367
6368
:
6369
break;
6370
6371
default:
6372
6373
err0_print(ERR_C,OC("! Invalid language command `@L%c' ignored"),1,XCHR(l));
6374
break;
6375
}
6376
6377
opt_args(l);
6378
6379
}
6380
6381
6382
6383
set_output_file(language);
6384
return begin_language;
6385
}
6386
6387
case control_text:while((c= skip_ahead(ignore,NO))==0100);
6388
6389
6390
if(*(loc-1)!=076)
6391
6392
err0_print(ERR_T,OC("Improper @ within control text %s"),1,BTRANS);
6393
6394
6395
return MORE_PARSE;
6396
6397
case module_name:
6398
mac_mod_name= NO;
6399
6400
{
6401
ASCII HUGE*k;
6402
static ASCII ell[]= "\56\56\56";
6403
6404
6405
6406
{
6407
int arg_num= 0;
6408
TEMPLATE arg_ptr[10];
6409
6410
mod_level= 1;
6411
k= mod_text;
6412
6413
WHILE()
6414
{
6415
if(loc>limit&&!get_line())
6416
{
6417
6418
err0_print(ERR_T,OC("Input ended in section name %s"),1,BTRANS);
6419
6420
loc= cur_buffer+1;
6421
break;
6422
}
6423
6424
c= *loc;
6425
6426
6427
if(c==0100)
6428
{
6429
c= *(loc+1);
6430
6431
if(c==076)
6432
{
6433
if(--mod_level==0)
6434
{
6435
loc+= 2;
6436
break;
6437
}
6438
}
6439
else if(c==074)
6440
mod_level++;
6441
6442
if(ccode[c]==new_module)
6443
{
6444
6445
err0_print(ERR_T,OC("Section name %s didn't end"),1,BTRANS);
6446
6447
break;
6448
}
6449
6450
*(++k)= 0100;
6451
loc++;
6452
}
6453
6454
;
6455
loc++;
6456
6457
if(k<mod_end)
6458
k++;
6459
6460
switch(c)
6461
{
6462
case 040:
6463
case tab_mark:
6464
c= 040;
6465
if(*(k-1)==040)
6466
k--;
6467
break;
6468
6469
case 073:
6470
c= interior_semi;
6471
break;
6472
6473
case 0133:
6474
break;
6475
}
6476
6477
*k= c;
6478
}
6479
6480
6481
if(k>=mod_end)
6482
{
6483
SET_COLOR(warning);
6484
printf("\n! Section name too long: ");
6485
6486
ASCII_write(mod_text+1,25);
6487
printf("...");
6488
mark_harmless;
6489
}
6490
6491
if(*k==040&&k>mod_text)
6492
k--;
6493
}
6494
6495
6496
6497
if(k-mod_text>3&&STRNCMP(k-2,ell,3)==0)
6498
cur_module= prefix_lookup(mod_text+1,k-3);
6499
else
6500
cur_module= mod_lookup(mod_text+1,k);
6501
6502
if(cur_module!=NULL)
6503
{
6504
set_output_file(cur_module->mod_info->language);
6505
}
6506
6507
return module_name;
6508
}
6509
6510
6511
6512
case keyword_name:
6513
case stringg:
6514
6515
{
6516
id_first= loc;
6517
6518
6519
*(limit+1)= 0100;*(limit+2)= 076;
6520
6521
while(*loc!=0100||*(loc+1)!=076)
6522
loc++;
6523
6524
if(loc>=limit)
6525
6526
err0_print(ERR_T,OC("Verbatim string %s didn't end"),1,BTRANS);
6527
6528
6529
id_loc= loc;
6530
loc+= 2;
6531
6532
return cc;
6533
}
6534
6535
;
6536
6537
case begin_vcmnt:
6538
6539
6540
if(strt_cmnt||*loc==052||*loc==057)
6541
if(!(scanning_defn&&is_WEB_macro)&&!deferred_macro)
6542
{
6543
if(!strt_point_cmnt)long_comment=
6544
BOOLEAN(!(*loc==057));
6545
6546
{
6547
loc--;
6548
6549
6550
id_first= id_loc= mod_text+1;
6551
6552
6553
if(!C_LIKE(language))
6554
{
6555
loc++;
6556
6557
{
6558
if(R66)*id_loc++= 043;
6559
else*id_loc++= 012;
6560
6561
}
6562
6563
;
6564
}
6565
6566
WHILE()
6567
{
6568
if(loc>limit)
6569
if(!long_comment)
6570
6571
{
6572
if(C_LIKE(language))
6573
{
6574
6575
if(!long_comment&&!Cpp)
6576
{
6577
*id_loc++= id_first[1]= 052;
6578
*id_loc++= id_first[0]= 057;
6579
}
6580
}
6581
else
6582
{
6583
if(long_comment)id_loc-= 2;
6584
}
6585
6586
break;
6587
}
6588
6589
6590
else if(!get_line())
6591
{
6592
6593
err0_print(ERR_T,OC("Input ended in verbatim comment %s"),1,BTRANS);
6594
6595
loc= cur_buffer+1;
6596
break;
6597
}
6598
else
6599
{
6600
*id_loc++= 012;
6601
6602
if(R66)
6603
{
6604
*id_loc++= 043;
6605
*id_loc++= 040;
6606
}
6607
}
6608
6609
if(id_loc<mod_end-3)
6610
{
6611
if(loc[0]==0100)
6612
{
6613
if(loc[1]==0100)
6614
*id_loc++= *loc++;
6615
else if(ccode[loc[1]]==keyword_name)
6616
6617
err0_print(ERR_T,OC("@K and @k aren't (yet) allowed in comments"),0);
6618
}
6619
6620
*id_loc++= *loc++;
6621
}
6622
else
6623
{
6624
SET_COLOR(warning);
6625
printf("\n! Verbatim comment too long: ");
6626
6627
ASCII_write(mod_text,25);
6628
printf("...");mark_harmless;
6629
6630
id_loc= mod_end-3;
6631
*id_loc++= 052;*id_loc++= 057;
6632
6633
comment_continues= YES;
6634
6635
goto finish_vcmnt;
6636
}
6637
6638
6639
if(long_comment&&*loc==057&&*(loc-1)==052)
6640
{
6641
*id_loc++= *loc++;
6642
6643
{
6644
if(C_LIKE(language))
6645
{
6646
6647
if(!long_comment&&!Cpp)
6648
{
6649
*id_loc++= id_first[1]= 052;
6650
*id_loc++= id_first[0]= 057;
6651
}
6652
}
6653
else
6654
{
6655
if(long_comment)id_loc-= 2;
6656
}
6657
6658
break;
6659
}
6660
6661
6662
}
6663
}
6664
6665
finish_vcmnt:
6666
if(!C_LIKE(language))
6667
{
6668
*id_loc++= '\0';
6669
}
6670
return stringg;
6671
}
6672
6673
6674
6675
}
6676
else return GOTO_SKIP_A_COMMENT;
6677
else return MORE_PARSE;
6678
6679
6680
case invisible_cmnt:
6681
6682
6683
6684
6685
if(*loc==045)
6686
eat_blank_lines= YES;
6687
6688
6689
6690
if(auto_line&&!scanning_defn&&loc==cur_buffer+2)
6691
insrt_line= YES;
6692
6693
loc= limit+1;
6694
suppress_newline= YES;
6695
return MORE_PARSE;
6696
6697
case compiler_directive:
6698
{
6699
int n;
6700
outer_char*s= t_style.cdir_start[language_num];
6701
6702
id_first= id_loc= mod_text+1;
6703
6704
*id_loc++= cdir;
6705
6706
6707
STRCPY(id_loc,s);
6708
to_ASCII((outer_char HUGE*)id_loc);
6709
id_loc+= STRLEN(s);
6710
6711
6712
STRNCPY(id_loc,loc,n= PTR_DIFF(int,limit,loc));
6713
id_loc+= n;
6714
6715
*id_loc++= cdir;
6716
*id_loc++= '\0';
6717
6718
loc= limit+1;
6719
return stringg;
6720
}
6721
6722
case Compiler_Directive:
6723
{
6724
outer_char*s= t_style.cdir_start[language_num];
6725
6726
id_first= id_loc= mod_text+1;
6727
6728
*id_loc++= cdir;
6729
preprocessing= in_cdir= YES;
6730
at_beginning= NO;
6731
6732
6733
STRCPY(id_loc,s);
6734
to_ASCII((outer_char HUGE*)id_loc);
6735
id_loc+= STRLEN(s);
6736
6737
return stringg;
6738
}
6739
6740
case new_output_file:
6741
6742
{
6743
while(*loc==' '||*loc==tab_mark)
6744
{
6745
loc++;
6746
if(loc>limit)return ignore;
6747
}
6748
6749
id_first= loc;
6750
while(*loc!=' '&&*loc!=tab_mark)loc++;
6751
id_loc= loc;
6752
if(*id_first=='"')id_first++;
6753
if(*(id_loc-1)=='"')id_loc--;
6754
if(id_loc-id_first>=MAX_FILE_NAME_LENGTH)
6755
{
6756
6757
err0_print(ERR_T,OC("Output file name too long; allowed only %d characters"),1,MAX_FILE_NAME_LENGTH-1);
6758
id_loc= id_first+MAX_FILE_NAME_LENGTH-1;
6759
}
6760
}
6761
6762
6763
6764
loc= limit+1;
6765
return cc;
6766
6767
case ascii_constant:
6768
if(translate_ASCII)
6769
{
6770
ASCII delim= *(loc-1);
6771
6772
id_first= loc-1;
6773
6774
while(*loc!=delim)
6775
{
6776
if(*loc==0134)
6777
if(*++loc==delim)
6778
{
6779
6780
loc++;
6781
continue;
6782
}
6783
6784
loc++;
6785
6786
if(loc>limit)
6787
{
6788
6789
err0_print(ERR_T,OC("ASCII string %s didn't end"),1,BTRANS);
6790
loc= limit-1;break;
6791
}
6792
}
6793
6794
loc++;
6795
return ascii_constant;
6796
}
6797
6798
6799
else
6800
{
6801
c= *(loc-1);
6802
return GOTO_GET_A_STRING;
6803
}
6804
6805
case big_line_break:
6806
6807
if(loc>=limit)return MORE_PARSE;
6808
6809
6810
{
6811
boolean mcode;
6812
6813
*limit= ' ';
6814
id_first= loc;
6815
6816
while(isAlpha(*loc))
6817
loc++;
6818
6819
if((mcode= is_mcmd(mcmds,id_first,loc))!=0)
6820
{
6821
while(loc<limit&&(*loc==040||*loc==tab_mark))
6822
loc++;
6823
6824
#ifdef _FWEAVE_h
6825
defd_switch= NO;
6826
#endif
6827
6828
return mcode;
6829
}
6830
6831
loc= id_first;
6832
}
6833
6834
6835
;
6836
return MORE_PARSE;
6837
6838
case set_line_info:
6839
6840
{
6841
outer_char c= XCHR(*loc++);
6842
6843
if(!isdigit(c))
6844
{
6845
6846
err0_print(ERR_T,OC("You must say `@q0' or `@q1', not `@q%c'"),1,c);
6847
loc--;
6848
}
6849
else
6850
line_info= BOOLEAN((c!='0')&&global_params.Line_info);
6851
}
6852
6853
6854
return cc;
6855
6856
case short_fcn:
6857
return c;
6858
6859
case USED_BY_NEITHER:
6860
6861
err0_print(ERR_T,OC("Invalid `@%c' ignored"),1,XCHR(c));
6862
return ignore;
6863
6864
default:return cc;
6865
}
6866
}
6867
6868
6869
#endif
6870
6871
#if(part == 0 || part == 3)
6872
6873
6874
SRTN
6875
scan_repl FCN((t,stop))
6876
eight_bits t C0("Either |macro| or |module_name|.")
6877
boolean stop C1("IF |YES|, stops the scan at the end of current\
6878
line.")
6879
{
6880
eight_bits a0= ignore;
6881
sixteen_bits a;
6882
LANGUAGE language0;
6883
int ntoken= 2;
6884
boolean auto_bp= YES;
6885
6886
6887
macro_scan= (t==macro);
6888
scanning_meta= NO;
6889
language0= language;
6890
6891
stop_the_scan= stop;
6892
6893
if(t==module_name)
6894
{
6895
ins_ln_no(column_mode);
6896
6897
6898
app_repl(begin_language);
6899
app_repl(NUWEB_OFF|nuweb_mode);
6900
}
6901
else if(stop)
6902
6903
{
6904
*limit= 040;
6905
*(limit+1)= 0100;
6906
*(limit+2)= 0155;
6907
}
6908
6909
6910
6911
WHILE()
6912
{
6913
if(stop)
6914
{
6915
while(loc<=limit)
6916
if(*loc!=040)break;
6917
else loc++;
6918
6919
if(loc>limit)goto done;
6920
}
6921
6922
6923
6924
6925
if(ntoken)
6926
ntoken--;
6927
6928
a0= (ntoken&&nuweb_mode&&t==module_name)
6929
?begin_meta:get_next();
6930
6931
reswitch:
6932
switch(a0)
6933
{
6934
case 0134:
6935
if(loc==limit&&language!=LITERAL)
6936
{
6937
if(!get_line())
6938
6939
fatal(ERR_T,OC("Input ended "),OC("while scanning \
6940
FWEB preprocessor statement."));
6941
6942
{
6943
*limit= 040;
6944
*(limit+1)= 0100;
6945
*(limit+2)= 0155;
6946
}
6947
6948
6949
}
6950
else
6951
{
6952
app_repl(a0);
6953
6954
if(loc==limit&&language==LITERAL)
6955
loc++;
6956
}
6957
break;
6958
6959
case 043:
6960
if(t==macro&&is_WEB_macro)
6961
6962
{
6963
switch(*loc)
6964
{
6965
case 072:
6966
6967
{
6968
outer_char temp[N_IDBUF];
6969
ASCII HUGE*t;
6970
6971
6972
loc++;
6973
6974
6975
6976
if(*loc!=060)
6977
{
6978
app_repl(043);
6979
app_repl(072);
6980
break;
6981
}
6982
6983
loc++;
6984
6985
if(
6986
nsprintf(temp,OC("%lu"),1,max_stmt++)>=(int)(N_IDBUF))OVERFLW("temp","");
6987
to_ASCII(temp);
6988
6989
6990
app_repl(constant);
6991
6992
for(t= (ASCII*)temp;*t!='\0';t++)app_repl(*t);
6993
6994
app_repl(constant);
6995
}
6996
6997
break;
6998
6999
case 041:
7000
if(scanning_defn)
7001
{
7002
sixteen_bits a;
7003
7004
7005
loc++;
7006
7007
if(get_next()!=identifier)
7008
7009
err0_print(ERR_M,OC("Identifier must follow #!; command ignored"),0);
7010
else
7011
{
7012
text_pointer m;
7013
7014
7015
a= ID_NUM(id_first,id_loc);
7016
7017
7018
7019
if((m= MAC_LOOKUP(a))==NULL)
7020
{
7021
app_repl(043);
7022
app_repl(041);
7023
7024
{
7025
app_repl(LEFT(a,ID0));
7026
app_repl(RIGHT(a));
7027
}
7028
7029
;
7030
break;
7031
}
7032
else
7033
if(m->nargs>0)
7034
7035
err0_print(ERR_M,OC("Macro after #! may not have arguments"),0);
7036
else
7037
7038
{
7039
eight_bits HUGE*q0,HUGE*q1;
7040
7041
7042
q0= m->tok_start+m->moffset;
7043
q1= m->tok_start+m->nbytes;
7044
7045
7046
while(q0<q1)
7047
app_repl(*q0++);
7048
}
7049
7050
7051
}
7052
}
7053
7054
7055
else app_repl(043);
7056
break;
7057
7058
case 047:
7059
case 042:
7060
app_repl(a0);
7061
app_repl(*loc++);
7062
break;
7063
7064
default:
7065
7066
{
7067
sixteen_bits a;
7068
7069
7070
if(isDigit(*loc)||*loc==054||*loc==046||*loc==052||*loc==056||
7071
*loc==0133||*loc==0173)
7072
7073
7074
{app_repl(043);}
7075
else if(get_next()!=identifier)
7076
7077
macro_err(OC("! '#' should be followed by identifier"),YES);
7078
else
7079
{
7080
a= ID_NUM(id_first,id_loc);
7081
7082
7083
7084
7085
if((MAC_LOOKUP(a))==NULL)
7086
{
7087
app_repl(043);
7088
7089
{
7090
app_repl(LEFT(a,ID0));
7091
app_repl(RIGHT(a));
7092
}
7093
7094
;
7095
break;
7096
}
7097
7098
7099
7100
macro_err(OC("! Immediate expansion of macro \"%s\" not implemented"),YES,name_of(a));
7101
7102
{
7103
app_repl(LEFT(a,ID0));
7104
app_repl(RIGHT(a));
7105
}
7106
7107
;
7108
}
7109
}
7110
7111
7112
break;
7113
}
7114
}
7115
7116
7117
else
7118
{
7119
app_repl(a0);
7120
}
7121
break;
7122
7123
7124
7125
case identifier:
7126
7127
{
7128
a= ID_NUM(id_first,id_loc);
7129
7130
if(a==lkwd)
7131
7132
{
7133
language0= language;
7134
7135
language= C;
7136
7137
if(get_next()!=050)
7138
{
7139
7140
err0_print(ERR_T,OC("Missing left parenthesis"),0);
7141
goto done_lkwd;
7142
}
7143
7144
if(get_next()!=stringg)
7145
{
7146
7147
err0_print(ERR_T,OC("Expected string argument to $L_KEYWORD"),0);
7148
}
7149
else
7150
{
7151
if(get_next()!=051)
7152
{
7153
7154
err0_print(ERR_T,OC("Missing right parenthesis"),0);
7155
goto done_lkwd;
7156
}
7157
7158
7159
{
7160
while(IS_WHITE(*id_first))
7161
id_first++;
7162
7163
while(IS_WHITE(id_loc[-1]))
7164
id_loc--;
7165
7166
mp= macrobuf;
7167
x_keyword(&mp,macrobuf_end,id_first,id_loc,NO,language0!=TEX,
7168
upper_case_code?WEB_FILE:CUR_FILE);
7169
*mp= 040;
7170
divert((ASCII HUGE*)macrobuf,(ASCII HUGE*)mp,DONT_STOP);
7171
}
7172
7173
7174
}
7175
7176
done_lkwd:
7177
language= language0;
7178
}
7179
7180
7181
else
7182
7183
{
7184
app_repl(LEFT(a,ID0));
7185
app_repl(RIGHT(a));
7186
}
7187
7188
7189
}
7190
7191
7192
break;
7193
7194
case keyword_name:
7195
7196
{
7197
while(IS_WHITE(*id_first))
7198
id_first++;
7199
7200
while(IS_WHITE(id_loc[-1]))
7201
id_loc--;
7202
7203
mp= macrobuf;
7204
x_keyword(&mp,macrobuf_end,id_first,id_loc,NO,language0!=TEX,
7205
upper_case_code?WEB_FILE:CUR_FILE);
7206
*mp= 040;
7207
divert((ASCII HUGE*)macrobuf,(ASCII HUGE*)mp,DONT_STOP);
7208
}
7209
7210
7211
break;
7212
7213
case module_name:
7214
7215
7216
7217
if(t==macro&&!mac_mod_name)
7218
goto done;
7219
else
7220
{
7221
7222
{
7223
}
7224
7225
7226
7227
{
7228
ASCII HUGE*try_loc= loc;
7229
7230
7231
while(*try_loc==040&&try_loc<limit)
7232
try_loc++;
7233
7234
if(*try_loc==053&&try_loc<limit)
7235
try_loc++;
7236
7237
while(*try_loc==040&&try_loc<limit)
7238
try_loc++;
7239
7240
if(*try_loc==075)
7241
7242
err0_print(ERR_T,OC("Nested named modules. Missing `@*' or `@ '?"),0);
7243
7244
}
7245
7246
;
7247
a= (sixteen_bits)(cur_module-name_dir);
7248
app_repl(LEFT(a,0250));
7249
app_repl(RIGHT(a));
7250
ins_ln_no(0);
7251
if(nuweb_mode)
7252
{
7253
a0= begin_meta;
7254
goto reswitch;
7255
}
7256
break;
7257
}
7258
7259
case constant:
7260
case stringg:
7261
7262
7263
if(C_LIKE(language))
7264
{
7265
if(bin_constant&&a0==constant)
7266
7267
{
7268
app_converted(btoi(id_first,id_loc));
7269
}
7270
7271
7272
else
7273
copy_string(a0);
7274
}
7275
else if(a0==constant)
7276
{
7277
if(language==LITERAL)
7278
copy_string(a0);
7279
else if(hex_constant)
7280
7281
{
7282
app_converted(xtoi(id_first,id_loc));
7283
}
7284
7285
7286
else if(bin_constant)
7287
7288
{
7289
app_converted(btoi(id_first,id_loc));
7290
}
7291
7292
7293
else if(starts_with_0&&!floating_constant)
7294
7295
{
7296
app_converted(otoi(id_first,id_loc));
7297
}
7298
7299
7300
else
7301
copy_string(a0);
7302
}
7303
else if(R77&&a0==stringg&&!in_format)
7304
{
7305
if(*id_first==047)
7306
rdc_char_constant();
7307
else
7308
{
7309
7310
7311
if(*id_first==042)*id_first= *(id_loc-1)= 047;
7312
copy_string(a0);
7313
}
7314
}
7315
else
7316
copy_string(a0);
7317
7318
break;
7319
7320
;
7321
7322
case ascii_constant:
7323
cp_ASCII();
7324
break;
7325
7326
case begin_meta:
7327
7328
{
7329
app_repl(stringg);
7330
7331
if(!nuweb_mode)
7332
app_repl(a0);
7333
7334
7335
if(FORTRAN_LIKE(language))
7336
{
7337
column_mode= NO;
7338
app_repl(012);
7339
}
7340
7341
scanning_meta= YES;
7342
7343
}
7344
7345
7346
break;
7347
7348
case end_meta:
7349
7350
7351
if(FORTRAN_LIKE(language)&&!free_form_input)
7352
7353
{
7354
loc= limit+1;
7355
column_mode= YES;
7356
parsing_mode= OUTER;
7357
}
7358
7359
7360
7361
;
7362
get_line();
7363
app_repl(end_meta);
7364
app_repl(stringg);
7365
scanning_meta= NO;
7366
break;
7367
7368
case dot_const:
7369
app_repl(a0);
7370
app_repl(dot_op.num);
7371
break;
7372
7373
case begin_language:
7374
switch(language)
7375
{
7376
case NO_LANGUAGE:
7377
7378
confusion(OC("scan_repl:begin_language"),OC("A language hasn't been defined yet"));
7379
7380
case RATFOR:
7381
case RATFOR_90:
7382
if(!RAT_OK("(scan_repl)"))
7383
7384
confusion(OC("scan_repl:begin_language"),OC("Attempting to append @Lr"));
7385
7386
case C:
7387
case C_PLUS_PLUS:
7388
case LITERAL:
7389
column_mode= NO;
7390
break;
7391
7392
case FORTRAN:
7393
case FORTRAN_90:
7394
case TEX:
7395
if(!(scanning_defn||free_form_input))
7396
{
7397
7398
{
7399
loc= limit+1;
7400
column_mode= YES;
7401
parsing_mode= OUTER;
7402
}
7403
7404
7405
}
7406
break;
7407
7408
default:
7409
7410
confusion(OC("app_id"),OC("Language %i is invalid"),language);
7411
}
7412
7413
7414
7415
7416
set_output_file(language);
7417
if(!scanning_defn)
7418
{app_repl(a0);app_repl((eight_bits)language);}
7419
7420
{
7421
store_two_bytes((sixteen_bits)(LINE_NUM+module_count));
7422
}
7423
7424
7425
ins_ln_no(column_mode);
7426
break;
7427
7428
case no_mac_expand:
7429
app_repl(begin_language);
7430
app_repl(a0);
7431
break;
7432
7433
case set_line_info:
7434
app_repl(begin_language);
7435
app_repl(a0);
7436
app_repl(line_info);
7437
break;
7438
7439
case new_output_file:
7440
if(t==macro)
7441
goto done;
7442
else
7443
{
7444
name_pointer np;
7445
7446
app_repl(begin_language);
7447
app_repl(NO_LANGUAGE);
7448
app_repl(upper_case_code);
7449
7450
a= ID_NUM_ptr(np,id_first,id_loc);
7451
7452
{
7453
app_repl(LEFT(a,ID0));
7454
app_repl(RIGHT(a));
7455
}
7456
7457
7458
np->macro_type= FILE_NAME;
7459
7460
if(nuweb_mode)
7461
{
7462
a0= begin_meta;
7463
goto reswitch;
7464
}
7465
}
7466
break;
7467
7468
case WEB_definition:
7469
if(t==macro)
7470
goto done;
7471
else
7472
{
7473
7474
{
7475
#define NAME_LEN 100
7476
7477
name_pointer np;
7478
eight_bits HUGE*tok_ptr0,HUGE*tok_m_end0;
7479
text_pointer text_ptr0,text_end0;
7480
outer_char new_name[NAME_LEN];
7481
ASCII HUGE*nn,HUGE*b;
7482
sixteen_bits a;
7483
7484
if(!deferred_macros)
7485
{
7486
7487
err0_print(ERR_T,OC("Sorry, deferred FWEB macros (defined in code part) are \
7488
prohibited; use option `-TD' to permit them"),0);
7489
continue;
7490
}
7491
7492
tok_ptr0= tok_ptr;
7493
tok_m_end0= tok_m_end;
7494
text_ptr0= text_ptr;
7495
text_end0= text_end;
7496
7497
tok_ptr= tok_dptr;
7498
tok_m_end= tokd_end;
7499
text_ptr= txt_dptr;
7500
text_end= textd_end;
7501
7502
deferred_macro= YES;
7503
np= app_macro(WEB_definition);
7504
deferred_macro= NO;
7505
7506
tok_dptr= tok_ptr;
7507
tok_ptr= tok_ptr0;
7508
tok_m_end= tok_m_end0;
7509
7510
txt_dptr= text_ptr;
7511
text_ptr= text_ptr0;
7512
text_end= text_end0;
7513
7514
if(np==NULL)
7515
continue;
7516
7517
7518
7519
if(
7520
nsprintf(new_name,OC("@%d"),1,n_unique++)>=(int)(NAME_LEN))OVERFLW("new_name","");
7521
to_ASCII(new_name);
7522
for(nn= (ASCII*)new_name+STRLEN(new_name),b= np->byte_start;
7523
b<(np+1)->byte_start;)
7524
*nn++= *b++;
7525
7526
a= ID_NUM_ptr(np,(ASCII*)new_name,nn);
7527
7528
{
7529
app_repl(LEFT(a,ID0));
7530
app_repl(RIGHT(a));
7531
}
7532
7533
;
7534
7535
np->macro_type= DEFERRED_MACRO;
7536
np->equiv= (EQUIV)cur_text;
7537
7538
#undef NAME_LEN
7539
}
7540
7541
;
7542
continue;
7543
}
7544
7545
case begin_nuweb:
7546
if(t!=module_name)
7547
{
7548
nuweb_mode1= nuweb_mode= !NUWEB_MODE;
7549
goto done;
7550
}
7551
else
7552
{
7553
7554
err0_print(ERR_T,OC("@N ignored; must appear before beginning of code part"),0);
7555
continue;
7556
}
7557
7558
case formatt:
7559
case limbo_text:case op_def:case macro_def:
7560
case definition:case undefinition:
7561
case begin_code:
7562
if(t!=module_name)
7563
goto done;
7564
else
7565
{
7566
7567
err0_print(ERR_T,OC("@d, @l, @v, @W, @u, @f, and @a \
7568
are ignored in code text"),0);
7569
continue;
7570
7571
}
7572
7573
case end_of_buffer:
7574
a0= ignore;
7575
7576
case m_ifdef:case m_ifndef:
7577
case m_if:case m_else:case m_elif:case m_endif:case m_undef:case m_line:
7578
case m_for:case m_endfor:
7579
case new_module:
7580
goto done;
7581
7582
7583
7584
7585
case 012:
7586
7587
7588
if(ntoken)ntoken++;
7589
app_repl(a0);
7590
break;
7591
7592
case 0173:
7593
app_repl(a0);
7594
7595
if(ntoken&&breakpoints&&t==module_name&&auto_bp)
7596
7597
{
7598
ASCII bp_cmd[BP_BUF_SIZE];
7599
7600
if(cur_module!=NULL)
7601
{
7602
7603
if(
7604
nsprintf(bp_cmd,OC("_BP(%d,\"%s\")"),2,module_count,name_of((sixteen_bits)(cur_module-name_dir)))>=(int)(BP_BUF_SIZE))OVERFLW("bp_cmd","");
7605
to_ASCII(OC(bp_cmd));
7606
divert(bp_cmd,bp_cmd+STRLEN(bp_cmd),DONT_STOP);
7607
}
7608
}
7609
7610
7611
7612
break;
7613
7614
case begin_bp:
7615
auto_bp= NO;
7616
app_repl(0173);
7617
break;
7618
7619
case insert_bp:
7620
if(breakpoints)
7621
7622
{
7623
ASCII bp_cmd[BP_BUF_SIZE];
7624
7625
if(cur_module!=NULL)
7626
{
7627
7628
if(
7629
nsprintf(bp_cmd,OC("_BP(%d,\"%s\")"),2,module_count,name_of((sixteen_bits)(cur_module-name_dir)))>=(int)(BP_BUF_SIZE))OVERFLW("bp_cmd","");
7630
to_ASCII(OC(bp_cmd));
7631
divert(bp_cmd,bp_cmd+STRLEN(bp_cmd),DONT_STOP);
7632
}
7633
}
7634
7635
7636
break;
7637
7638
default:
7639
app_repl(a0);
7640
break;
7641
}
7642
}
7643
7644
done:
7645
if(stop_the_scan&&!from_buffer)
7646
{
7647
stop_the_scan= NO;
7648
next_control= ignore;
7649
}
7650
else next_control=
7651
(eight_bits)CHOICE((from_buffer&&loc>limit)||stop,
7652
ignore,a0);
7653
7654
if(t==module_name)
7655
{
7656
7657
if(scanning_meta)
7658
{
7659
if(!nuweb_mode)
7660
app_repl(end_meta);
7661
7662
app_repl(stringg);
7663
scanning_meta= NO;
7664
}
7665
app_repl(begin_language);
7666
app_repl(NUWEB_OFF|nuweb_mode);
7667
}
7668
7669
7670
{
7671
if(text_ptr>text_end)
7672
OVERFLW("texts","x");
7673
7674
cur_text= text_ptr;
7675
cur_text->nbytes= tok_ptr-cur_text->tok_start;
7676
7677
(++text_ptr)->tok_start= tok_ptr;
7678
}
7679
7680
7681
cur_text->Language= (boolean)language0;
7682
macro_scan= NO;
7683
}
7684
7685
7686
SRTN
7687
ins_ln_no FCN((delta))
7688
int delta C1("Increment to line number")
7689
{
7690
name_pointer np;
7691
7692
store_two_bytes((sixteen_bits)LINE_NUM);
7693
7694
id_first= x_to_ASCII(changing?change_file_name:cur_file_name);
7695
id_loc= id_first+STRLEN(id_first);
7696
7697
store_two_bytes((sixteen_bits)((changing?change_line:cur_line)+delta));
7698
7699
store_two_bytes(ID_NUM_ptr(np,id_first,id_loc));
7700
np->Language= (boolean)NO_LANGUAGE;
7701
}
7702
7703
7704
SRTN
7705
copy_string FCN((a0))
7706
eight_bits a0 C1("")
7707
{
7708
app_repl(a0);
7709
7710
for(;id_first<id_loc;id_first++)
7711
{
7712
if(*id_first==0100)
7713
7714
7715
if(language==TEX&&*(id_first+1)==0100)
7716
id_first++;
7717
else
7718
{
7719
id_first++;
7720
7721
switch(ccode[*id_first])
7722
{
7723
case 0100:
7724
break;
7725
7726
7727
7728
case begin_C:
7729
case begin_RATFOR:
7730
case begin_FORTRAN:
7731
case begin_LITERAL
7732
7733
7734
7735
:
7736
case L_switch:
7737
app_repl(0100);
7738
break;
7739
7740
case keyword_name:
7741
case module_name:
7742
7743
err0_print(ERR_T,OC("RCS keywords and module names aren't \
7744
allowed inside strings"),0);
7745
for(id_first++;id_first[0]!=0100&&id_first[1]!=076;
7746
id_first++)
7747
{
7748
app_repl(077);
7749
}
7750
7751
default:
7752
id_first++;
7753
continue;
7754
}
7755
}
7756
7757
7758
7759
app_repl(*id_first);
7760
}
7761
7762
app_repl(a0);
7763
}
7764
7765
7766
7767
unsigned long
7768
xtoi FCN((b,b1))
7769
CONST ASCII HUGE*b C0("Beginning of string.")
7770
CONST ASCII HUGE*b1 C1("End of string.")
7771
{
7772
unsigned long n= 0;
7773
7774
for(b+= 2;b<b1;b++)
7775
{
7776
if(n>ULONG_MAX/16)
7777
{
7778
TOO_BIG;
7779
break;
7780
}
7781
7782
n*= 16;
7783
7784
if(isDigit(*b))
7785
n+= *b-060;
7786
else
7787
n+= A_TO_UPPER(*b)-0101+10;
7788
}
7789
7790
return n;
7791
}
7792
7793
7794
SRTN
7795
app_converted FCN((n))
7796
unsigned long n C1("")
7797
{
7798
ASCII temp[N_IDBUF];
7799
ASCII HUGE*b;
7800
7801
7802
if(
7803
nsprintf((outer_char*)(temp),OC("%lu"),1,n)>=(int)(N_IDBUF))OVERFLW("(outer_char*)(temp)","");
7804
to_ASCII((outer_char*)(temp));
7805
7806
app_repl(constant);
7807
for(b= temp;*b!='\0';b++)app_repl(*b)
7808
app_repl(constant);
7809
}
7810
7811
7812
7813
unsigned long
7814
otoi FCN((b,b1))
7815
CONST ASCII HUGE*b C0("Beginning of string.")
7816
CONST ASCII HUGE*b1 C1("End of string.")
7817
{
7818
unsigned long n= 0;
7819
7820
for(b++;b<b1;b++)
7821
{
7822
if(n>ULONG_MAX/8)
7823
{
7824
TOO_BIG;
7825
break;
7826
}
7827
7828
n= 8*n+(*b-060);
7829
}
7830
7831
return n;
7832
}
7833
7834
7835
7836
unsigned long
7837
btoi FCN((b,b1))
7838
CONST ASCII HUGE*b C0("Beginning of string.")
7839
CONST ASCII HUGE*b1 C1("End of string.")
7840
{
7841
unsigned long n= 0;
7842
7843
for(b+= 2;b<b1;b++)
7844
{
7845
if(n>ULONG_MAX/2)
7846
{
7847
TOO_BIG;
7848
break;
7849
}
7850
7851
n= 2*n+(*b-060);
7852
}
7853
7854
return n;
7855
}
7856
7857
7858
SRTN
7859
rdc_char_constant(VOID)
7860
{
7861
int n;
7862
7863
if(*++id_first==0134)
7864
switch(*++id_first)
7865
{
7866
7867
case 060:n= '\0';break;
7868
case 0134:n= 0134;break;
7869
case 047:n= 047;break;
7870
case 042:n= 042;break;
7871
case 077:n= 077;break;
7872
case 0141:n= 07;break;
7873
case 0142:n= 010;break;
7874
case 0146:n= 014;break;
7875
case 0156:n= 012;break;
7876
case 0162:n= 015;break;
7877
case 0164:n= 011;break;
7878
case 0166:n= 013;break;
7879
7880
7881
default:
7882
7883
err0_print(ERR_T,OC("Invalid escape sequence '\\%c' \
7884
in Ratfor character constant; null assumed"),1,XCHR(*id_first));
7885
n= 0;
7886
break;
7887
}
7888
else n= *id_first;
7889
7890
if(*(id_first+1)!=047)
7891
err0_print(ERR_T,OC("Ratfor character constant longer \
7892
than one byte; extra characters ignored"),0);
7893
7894
app_converted(n);
7895
}
7896
7897
7898
SRTN
7899
cp_ASCII(VOID)
7900
{
7901
if(*id_first++==047)
7902
{
7903
if(C_LIKE(language))
7904
app_aconst('o',YES);
7905
else
7906
app_aconst('d',NO);
7907
7908
if(*id_first!=047)
7909
7910
{
7911
ASCII temp[100],HUGE*t= temp;
7912
7913
id_first--;
7914
7915
if(id_first[-1]==0134)
7916
id_first--;
7917
7918
while(*id_first!=047)
7919
*t++= *id_first++;
7920
7921
*t= '\0';
7922
7923
7924
macro_err(OC("! $A('%c') requires just one character between \
7925
the single quotes; did you mean $A(\"%s\")?"),NO,temp[0],temp);
7926
}
7927
7928
7929
}
7930
else
7931
{
7932
if(C_LIKE(language))
7933
{
7934
app_repl(042);
7935
7936
while(*id_first!=042)
7937
{
7938
app_repl(0134);
7939
app_aconst('o',NO);
7940
}
7941
7942
app_repl(042);
7943
}
7944
else
7945
{
7946
sixteen_bits a;
7947
ASCII delim= (ASCII)(is_RATFOR_(language)?042:047);
7948
int n= STRLEN(t_style.ASCII_fcn);
7949
7950
7951
a= ID_NUM(t_style.ASCII_fcn,t_style.ASCII_fcn+n);
7952
7953
{
7954
app_repl(LEFT(a,ID0));
7955
app_repl(RIGHT(a));
7956
}
7957
7958
7959
app_repl(050);
7960
app_repl(delim);
7961
while(*id_first!=042)
7962
app_repl(*id_first++);
7963
app_repl(delim);
7964
app_repl(051);
7965
}
7966
}
7967
7968
#if(0)
7969
7970
7971
app_repl(0173);
7972
7973
while(*id_first!=042)
7974
{
7975
app_aconst(YES);
7976
app_repl(054);
7977
}
7978
7979
app_repl(060);
7980
app_repl(0175);
7981
}
7982
#endif
7983
}
7984
7985
7986
7987
SRTN
7988
app_aconst FCN((fmt_char,leading_zero))
7989
outer_char fmt_char C0("Either 'o' (octal) or 'd' (decimal)")
7990
boolean leading_zero C1("For octal format")
7991
{
7992
eight_bits n;
7993
outer_char value[10],*v;
7994
7995
if(*id_first==0100)
7996
{
7997
n= *id_first++;
7998
7999
if(*id_first!=0100)
8000
err0_print(ERR_T,OC("Should use double @ within \
8001
ASCII constant"),0);
8002
else id_first++;
8003
}
8004
else if(*id_first==0134)
8005
{
8006
8007
id_first++;
8008
8009
n= esc_achar((CONST ASCII HUGE*HUGE*)&id_first);
8010
8011
}
8012
else n= *id_first++;
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
#ifdef scramble_ASCII
8023
n= xxord[n];
8024
#endif
8025
8026
#ifdef unscramble_ASCII
8027
n= XCHR(n);
8028
#endif
8029
8030
8031
8032
8033
app_repl(constant);
8034
8035
8036
if(
8037
nsprintf(value,OC(fmt_char=='o'?"%s%o":"%s%d"),2,leading_zero?"0":"",n)>=(int)(10))OVERFLW("value","");
8038
8039
for(v= value;*v;v++)
8040
app_repl(XORD(*v));
8041
8042
app_repl(constant);
8043
8044
#if(0)
8045
int l;
8046
8047
if(leading_zero)app_repl(060);
8048
8049
value[0]= 060+(n>>6);
8050
value[1]= 060+((n-0100*(n>>6))>>3);
8051
value[2]= 060+(n-010*(n>>3));
8052
8053
for(l= 0;l<3;l++)
8054
if(value[l]!=060)break;
8055
8056
for(;l<3;l++)
8057
app_repl(value[l]);
8058
8059
#endif
8060
}
8061
8062
8063
8064
SRTN
8065
i_ascii_ FCN((n,pargs))
8066
int n C0("")
8067
PARGS pargs C1("")
8068
{
8069
int len;
8070
eight_bits*start= pargs[0]+1;
8071
8072
CHK_ARGS("$A",1);
8073
8074
if(translate_ASCII)
8075
{
8076
eight_bits HUGE*tok_ptr0= tok_ptr;
8077
8078
if(*start==stringg)
8079
id_first= (ASCII HUGE*)(start+1);
8080
else
8081
{
8082
8083
err0_print(ERR_T,OC("Argument of _A should be quoted; \
8084
just returning argument"),0);
8085
goto just_return;
8086
}
8087
8088
cp_ASCII();
8089
8090
len= PTR_DIFF(int,tok_ptr,tok_ptr0);
8091
MCHECK(len,"_ascii_");
8092
memcpy(mp,tok_ptr0,len);
8093
tok_ptr= tok_ptr0;
8094
}
8095
else
8096
{
8097
just_return:
8098
len= PTR_DIFF(int,pargs[1],start);
8099
MCHECK(len,"_ascii_");
8100
STRNCPY(mp,start,len);
8101
}
8102
8103
mp+= len;
8104
}
8105
8106
8107
8108
SRTN
8109
scan_module(VOID)
8110
{
8111
name_pointer p= NULL;
8112
8113
module_count++;
8114
8115
params= global_params;
8116
frz_params();
8117
set_output_file(global_language);
8118
8119
progress();
8120
8121
8122
{
8123
parsing_mode= INNER;
8124
nuweb_mode1= nuweb_mode;
8125
8126
next_control= ignore;
8127
8128
if(module_count==1)
8129
{
8130
*(mp-1)= 0100;
8131
*mp= 0155;
8132
divert((ASCII HUGE*)macrobuf,(ASCII HUGE*)mp,STOP);
8133
8134
8135
8136
8137
}
8138
8139
8140
scanning_TeX= YES;
8141
scan_text(macro,p,EXPAND);
8142
scanning_TeX= NO;
8143
8144
if(module_count==1)
8145
{
8146
IN_COMMON ASCII HUGE*pbp;
8147
8148
8149
breakpoints= BOOLEAN(MAC_LOOKUP(ID_NUM(pbp,pbp+3))!=NULL);
8150
}
8151
8152
;
8153
8154
if(mlevel!=0)
8155
{
8156
8157
err0_print(ERR_M,OC("Invalid preprocessor block structure (level %d). \
8158
Missing @#endif?"),1,mlevel);
8159
mlevel= 0;
8160
}
8161
}
8162
8163
;
8164
8165
switch(next_control)
8166
{
8167
case begin_code:
8168
{
8169
boolean nuweb_mode0= nuweb_mode;
8170
8171
params= global_params;
8172
nuweb_mode= nuweb_mode0;
8173
frz_params();
8174
set_output_file(global_language);
8175
8176
p= name_dir;
8177
8178
8179
if(FORTRAN_LIKE(language)&&!free_form_input)
8180
8181
{
8182
loc= limit+1;
8183
column_mode= YES;
8184
parsing_mode= OUTER;
8185
}
8186
8187
8188
8189
;
8190
break;
8191
}
8192
8193
case module_name:
8194
if(cur_module)
8195
{
8196
p= cur_module;
8197
params= cur_module->mod_info->params;
8198
}
8199
else
8200
{
8201
8202
while((next_control= skip_ahead(ignore,NO))!=new_module)
8203
;
8204
return;
8205
}
8206
8207
8208
{
8209
}
8210
8211
8212
8213
8214
{
8215
while((next_control= get_next())==053)
8216
;
8217
8218
if(next_control!=075&&next_control!=eq_eq)
8219
{
8220
8221
err0_print(ERR_T,OC("Code text of %s flushed; = sign is missing"),1,MTRANS);
8222
8223
8224
while((next_control= skip_ahead(ignore,NO))!=new_module)
8225
;
8226
8227
return;
8228
}
8229
}
8230
8231
;
8232
frz_params();
8233
8234
8235
if(FORTRAN_LIKE(language)&&!free_form_input)
8236
8237
{
8238
loc= limit+1;
8239
column_mode= YES;
8240
parsing_mode= OUTER;
8241
}
8242
8243
8244
8245
;
8246
break;
8247
8248
default:return;
8249
}
8250
8251
next_control= ignore;
8252
scan_text(module_name,p,EXPAND);
8253
column_mode= NO;
8254
8255
8256
;
8257
}
8258
8259
8260
8261
SRTN
8262
scan_text FCN((text_type,p,expand))
8263
int text_type C0("Either |macro| or |module_name|.")
8264
CONST name_pointer p C0("Module name.")
8265
boolean expand C1("Do we expand?")
8266
{
8267
boolean if_switch;
8268
boolean scanned_if= NO;
8269
boolean first_text= YES;
8270
eight_bits HUGE*pp;
8271
text_pointer q;
8272
8273
scanning_defn= BOOLEAN(text_type==macro);
8274
8275
if(++mlevel>=MAX_LEVEL)
8276
8277
fatal(ERR_T,OC("Conditional nesting depth exceeded."),OC(""));
8278
8279
8280
WHILE()
8281
{
8282
if(scanning_defn&&expand)
8283
{
8284
while(next_control<=ignore_defn)
8285
{
8286
if((next_control=
8287
skip_ahead(next_control,YES))==module_name)
8288
{
8289
loc-= 2;next_control= get_next();
8290
}
8291
}
8292
scanning_TeX= NO;
8293
}
8294
else
8295
if(!expand)
8296
{
8297
while((next_control=
8298
skip_ahead(next_control,YES))==module_name)
8299
if((next_control= skip_ahead(next_control,YES))!=ignore)
8300
8301
err0_print(ERR_T,OC("Expected @> after @<"),0);
8302
}
8303
else
8304
{
8305
8306
{
8307
store_two_bytes((sixteen_bits)(LINE_NUM+module_count));
8308
}
8309
8310
8311
8312
scan_repl(module_name,stop_the_scan);
8313
8314
8315
8316
{
8317
}
8318
8319
8320
8321
8322
{
8323
if(p==name_dir||p==NULL)
8324
{
8325
cur_text->module_text= (first_text&&mlevel==1);
8326
8327
8328
8329
8330
if(cur_text->module_text)
8331
cur_text->Language= (boolean)global_language;
8332
8333
last_unnamed->text_link= (sixteen_bits)(cur_text-text_info);
8334
8335
last_unnamed= cur_text;
8336
}
8337
else if(p->equiv==(EQUIV)text_info)
8338
{
8339
cur_text->module_text= YES;
8340
p->equiv= (EQUIV)cur_text;
8341
}
8342
else
8343
{
8344
LANGUAGE language0;
8345
8346
q= (text_pointer)p->equiv;
8347
language0= (LANGUAGE)q->Language;
8348
8349
8350
8351
8352
8353
8354
cur_text->module_text= (first_text&&mlevel==1);
8355
8356
if(cur_text->module_text)
8357
cur_text->Language= (boolean)language0;
8358
8359
8360
8361
while(q->text_link<module_flag)q= q->text_link+text_info;
8362
8363
q->text_link= (sixteen_bits)(cur_text-text_info);
8364
8365
}
8366
8367
8368
8369
cur_text->text_link= module_flag;
8370
}
8371
8372
8373
first_text= NO;
8374
}
8375
8376
next_macro_token:
8377
switch(next_control)
8378
{
8379
8380
8381
case m_ifdef:
8382
DEF_OR_NDEF(M_TRUE);
8383
break;
8384
8385
case m_ifndef:
8386
DEF_OR_NDEF(M_FALSE);
8387
break;
8388
8389
case m_if:
8390
found_else= NO;
8391
8392
if(!expand)
8393
{
8394
to_endif(m_if);
8395
goto next_macro_token;
8396
}
8397
else
8398
8399
{
8400
8401
{
8402
boolean scan0= scanning_defn;
8403
8404
scanning_defn= YES;
8405
scan_repl(macro,STOP);
8406
scanning_defn= scan0;
8407
8408
cur_text->nargs= UNDEFINED_MACRO;
8409
8410
pp= xmac_text(macrobuf,cur_text->tok_start,tok_ptr);
8411
if_switch= eval(pp,mp);
8412
}
8413
8414
;
8415
GET_LINE;
8416
8417
if(if_switch)
8418
scan_text(text_type,p,if_switch);
8419
else
8420
8421
{
8422
expand= NO;to_else();
8423
8424
if(next_control!=m_endif)
8425
{
8426
scanned_if= YES;
8427
goto next_macro_token;
8428
}
8429
else
8430
{
8431
next_control= ignore;
8432
expand= YES;
8433
GET_LINE;
8434
break;
8435
}
8436
}
8437
8438
8439
}
8440
8441
8442
8443
break;
8444
8445
case m_elif:
8446
8447
8448
8449
8450
8451
8452
next_control= ignore;
8453
8454
if((mlevel==1&&!scanned_if)||found_else)
8455
{
8456
OUT_OF_ORDER("elif");
8457
break;
8458
}
8459
8460
scanned_if= NO;
8461
8462
if(expand)
8463
{
8464
to_endif(m_elif);
8465
goto next_macro_token;
8466
}
8467
else
8468
8469
{
8470
8471
{
8472
boolean scan0= scanning_defn;
8473
8474
scanning_defn= YES;
8475
scan_repl(macro,STOP);
8476
scanning_defn= scan0;
8477
8478
cur_text->nargs= UNDEFINED_MACRO;
8479
8480
pp= xmac_text(macrobuf,cur_text->tok_start,tok_ptr);
8481
if_switch= eval(pp,mp);
8482
}
8483
8484
;
8485
GET_LINE;
8486
8487
if(if_switch)
8488
scan_text(text_type,p,if_switch);
8489
else
8490
8491
{
8492
expand= NO;to_else();
8493
8494
if(next_control!=m_endif)
8495
{
8496
scanned_if= YES;
8497
goto next_macro_token;
8498
}
8499
else
8500
{
8501
next_control= ignore;
8502
expand= YES;
8503
GET_LINE;
8504
break;
8505
}
8506
}
8507
8508
8509
}
8510
8511
8512
8513
expand= YES;
8514
break;
8515
8516
case m_else:
8517
8518
8519
8520
8521
8522
8523
next_control= ignore;
8524
8525
if((mlevel==1&&!scanned_if)||found_else)
8526
{
8527
OUT_OF_ORDER("else");
8528
break;
8529
}
8530
8531
found_else= YES;
8532
scanned_if= NO;
8533
8534
expand= BOOLEAN(!expand);
8535
8536
GET_LINE;
8537
8538
if(expand)
8539
scan_text(text_type,p,expand);
8540
else
8541
{
8542
to_endif(m_else);
8543
expand= YES;
8544
goto next_macro_token;
8545
}
8546
8547
break;
8548
8549
case m_endif:
8550
next_control= ignore;
8551
8552
if(mlevel==1)
8553
{
8554
OUT_OF_ORDER("endif");
8555
break;
8556
}
8557
8558
found_else= NO;
8559
GET_LINE;
8560
mlevel--;
8561
return;
8562
8563
case m_undef:
8564
if(!expand)
8565
next_control= ignore;
8566
else
8567
{
8568
if((next_control= get_next())!=identifier)
8569
8570
err0_print(ERR_M,OC("Identifier must follow @#undef"),0);
8571
else
8572
{
8573
undef(ID_NUM(id_first,id_loc),SILENT);
8574
GET_LINE;
8575
8576
}
8577
}
8578
break;
8579
8580
case m_line:
8581
8582
confusion(OC("preprocessor cases"),OC("m_line shouldn't reach here"));
8583
8584
case m_for:
8585
case m_endfor:
8586
if(!expand)next_control= ignore;
8587
else
8588
{
8589
8590
err0_print(ERR_M,OC("Sorry, preprocessor command isn't implemented yet"),0);
8591
}
8592
break;
8593
8594
8595
8596
case new_output_file:
8597
8598
err0_print(ERR_T,OC("@O and @o are allowed only in the code \
8599
section; command ignored"),0);
8600
next_control= ignore;
8601
loc= limit+1;
8602
break;
8603
8604
case definition:case undefinition:
8605
case WEB_definition:
8606
if(!expand)
8607
next_control= ignore;
8608
else
8609
{
8610
name_pointer np;
8611
eight_bits last_control;
8612
8613
if((np= app_macro(last_control= next_control))
8614
==NULL)continue;
8615
else if(last_control==WEB_definition
8616
&&!(IS_PROTECTED(np)&&(npq->built_in&&!redefine_builtins
8617
||!npq->built_in&&!redefine_macros)))
8618
np->equiv= (EQUIV)cur_text;
8619
}
8620
break;
8621
8622
8623
default:
8624
if(next_control<=ignore_defn)
8625
break;
8626
8627
mlevel--;
8628
return;
8629
}
8630
}
8631
}
8632
8633
8634
8635
SRTN
8636
out_of_order FCN((cmd))
8637
CONST outer_char cmd[]C1("Name of bad preprocessor command.")
8638
{
8639
8640
err0_print(ERR_M,OC("Ignored out-of-order \"@#%s\" (mlevel = %d)"),2,cmd,mlevel);
8641
}
8642
8643
8644
8645
SRTN
8646
to_else(VOID)
8647
{
8648
int elevel= 0,elifs[MAX_LEVEL],elses[MAX_LEVEL],k;
8649
8650
for(k= 0;k<MAX_LEVEL;k++)
8651
elifs[k]= elses[k]= 0;
8652
8653
WHILE()
8654
switch(next_control= skip_ahead(next_control,NO))
8655
{
8656
case m_if:
8657
case m_ifdef:
8658
case m_ifndef:
8659
elevel++;
8660
break;
8661
8662
case m_elif:
8663
if(elses[elevel])
8664
8665
err0_print(ERR_M,OC("Can't have @#elif after @#else"),0);
8666
elifs[elevel]++;
8667
if(elevel==0)return;
8668
break;
8669
8670
case m_else:
8671
if(elses[elevel]++)
8672
8673
err0_print(ERR_M,OC("Only one @#else allowed \
8674
(scanning to @else)"),0);
8675
if(elevel==0)
8676
{
8677
if(language==TEX&&!get_line())
8678
loc= limit+1;
8679
return;
8680
}
8681
break;
8682
8683
case m_endif:
8684
8685
elifs[elevel]= elses[elevel]= 0;
8686
8687
if(elevel--==0)
8688
{
8689
found_else= NO;
8690
if(language==TEX&&!get_line())
8691
loc= limit+1;
8692
return;
8693
}
8694
break;
8695
8696
case new_module:
8697
8698
err0_print(ERR_M,OC("Section ended during scan for \
8699
\"@#else\", \"@#elif\", or \"@#endif\". Inserted \"@#endif\". \
8700
(elevel = %d)"),1,elevel);
8701
if(elevel==0)
8702
found_else= NO;
8703
8704
return;
8705
}
8706
}
8707
8708
8709
8710
SRTN
8711
to_endif FCN((m_case))
8712
int m_case C1("Case that called to_endif")
8713
{
8714
int elevel= 1,elifs[MAX_LEVEL],elses[MAX_LEVEL],k;
8715
8716
for(k= 0;k<MAX_LEVEL;k++)
8717
elifs[k]= elses[k]= 0;
8718
8719
if(m_case==m_elif)
8720
elifs[elevel]= 1;
8721
else
8722
{
8723
if(m_case==m_else)
8724
elses[elevel]= 1;
8725
}
8726
8727
WHILE()
8728
switch(next_control= skip_ahead(next_control,NO))
8729
{
8730
case m_if:
8731
case m_ifdef:
8732
case m_ifndef:
8733
elevel++;
8734
break;
8735
8736
case m_elif:
8737
if(elses[elevel])
8738
8739
err0_print(ERR_M,OC("Can't have @#elif after @#else"),0);
8740
elifs[elevel]++;
8741
break;
8742
8743
case m_else:
8744
if(elses[elevel]++)
8745
8746
err0_print(ERR_M,OC("Only one @#else allowed \
8747
(scanning to @endif)"),0);
8748
break;
8749
8750
case m_endif:
8751
8752
elifs[elevel]= elses[elevel]= 0;
8753
8754
if(--elevel==0)
8755
{
8756
found_else= NO;
8757
if(language==TEX&&!get_line())
8758
loc= limit+1;
8759
return;
8760
}
8761
break;
8762
8763
case new_module:
8764
8765
err0_print(ERR_M,OC("Section ended during scan for \
8766
\"endif\"; inserted \"endif\". (elevel = %d)"),1,elevel);
8767
if(elevel==0)
8768
found_else= NO;
8769
return;
8770
}
8771
}
8772
8773
8774
8775
name_pointer
8776
app_macro FCN((last_control))
8777
eight_bits last_control C1("Last token processed.")
8778
{
8779
sixteen_bits a;
8780
name_pointer np= NULL;
8781
boolean make_recursive= NO;
8782
boolean make_protected= NO;
8783
ASCII insert_type[6];
8784
int insert_num= 0;
8785
eight_bits temp[2];
8786
boolean nuweb_mode0= nuweb_mode;
8787
8788
nuweb_mode= NO;
8789
8790
is_WEB_macro= BOOLEAN(last_control==WEB_definition);
8791
8792
if(is_WEB_macro||C_LIKE(language))
8793
{
8794
while((next_control= get_next())==012)
8795
;
8796
8797
8798
if(is_WEB_macro)
8799
if(next_control==MAKE_RECURSIVE)
8800
{
8801
make_recursive= YES;
8802
next_control= get_next();
8803
}
8804
else if(next_control==AUTO_INSERT)
8805
8806
{
8807
ASCII c;
8808
8809
while((c= *loc++)!=END_AUTO_INSERT)
8810
{
8811
if(*loc==040)
8812
{
8813
8814
err0_print(ERR_M,OC("Found space instead of ']' after automatic \
8815
insertion material"),0);
8816
break;
8817
}
8818
8819
if(loc==limit)
8820
break;
8821
8822
if(insert_num>=6)
8823
{
8824
if(insert_num++==6)
8825
8826
err0_print(ERR_M,OC("Can't have more than 6 types of automatic \
8827
insertion material; remaining ignored"),0);
8828
continue;
8829
}
8830
8831
switch(c)
8832
{
8833
case 052:
8834
STRNCPY(insert_type,"pmsfbi",insert_num= 6);
8835
break;
8836
8837
case 0160:case 0120:
8838
case 0155:case 0115:
8839
case 0163:case 0123:
8840
case 0146:case 0106:
8841
case 0142:case 0102:
8842
case 0151:case 0111:
8843
insert_type[insert_num++]= c;
8844
break;
8845
8846
default:
8847
8848
err0_print(ERR_M,OC("Auto insertion type must be one of \
8849
\"ibfmps\""),0);
8850
continue;
8851
}
8852
}
8853
8854
next_control= get_next();
8855
}
8856
8857
8858
else if(next_control==PROTECTED)
8859
{
8860
make_protected= YES;
8861
next_control= get_next();
8862
}
8863
8864
if(next_control!=identifier)
8865
{
8866
8867
err0_print(ERR_M,OC("Definition flushed in %s; must start with \
8868
identifier"),1,MTRANS);
8869
8870
np= NULL;
8871
goto done_append;
8872
}
8873
8874
a= ID_NUM_ptr(np,id_first,id_loc);
8875
8876
8877
temp[0]= LEFT(a,ID0);temp[1]= RIGHT(a);
8878
8879
{
8880
while(insert_num-->0)
8881
switch(insert_type[insert_num])
8882
{
8883
case 0160:case 0120:
8884
if(insert.program.end>insert.program.start)
8885
8886
err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"program");
8887
STRNCPY(insert.program.start,temp,2);
8888
insert.program.end= insert.program.start+2;
8889
break;
8890
8891
case 0155:case 0115:
8892
if(insert.module.end>insert.module.start)
8893
8894
err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"module");
8895
STRNCPY(insert.module.start,temp,2);
8896
insert.module.end= insert.module.start+2;
8897
break;
8898
8899
case 0163:case 0123:
8900
if(insert.subroutine.end>insert.subroutine.start)
8901
8902
err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"subroutine");
8903
STRNCPY(insert.subroutine.start,temp,2);
8904
insert.subroutine.end= insert.subroutine.start+2;
8905
break;
8906
8907
case 0146:case 0106:
8908
if(insert.function.end>insert.function.start)
8909
8910
err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"function");
8911
STRNCPY(insert.function.start,temp,2);
8912
insert.function.end= insert.function.start+2;
8913
break;
8914
8915
case 0142:case 0102:
8916
if(insert.blockdata.end>insert.blockdata.start)
8917
8918
err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"blockdata");
8919
STRNCPY(insert.blockdata.start,temp,2);
8920
insert.blockdata.end= insert.blockdata.start+2;
8921
break;
8922
8923
case 0151:case 0111:
8924
if(insert.interface.end>insert.interface.start)
8925
8926
err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"interface");
8927
STRNCPY(insert.interface.start,temp,2);
8928
insert.interface.end= insert.interface.start+2;
8929
break;
8930
}
8931
}
8932
8933
8934
8935
8936
app_repl(temp[0]);
8937
app_repl(temp[1]);
8938
8939
np->macro_type= IMMEDIATE_MACRO;
8940
8941
8942
if(*loc!=050)
8943
{
8944
if(is_WEB_macro)
8945
{app_repl(040);}
8946
else if(C_LIKE(language))
8947
{
8948
8949
app_repl(stringg);app_repl(040);app_repl(stringg);
8950
}
8951
}
8952
}
8953
8954
nuweb_mode= nuweb_mode0;
8955
scan_repl((eight_bits)macro,(boolean)(!scanning_defn));
8956
8957
8958
8959
if(is_WEB_macro)
8960
8961
{
8962
#if 0
8963
text_ptr->tok_start=
8964
#endif
8965
tok_ptr= argize(cur_text->tok_start,tok_ptr);
8966
8967
cur_text->Language= (boolean)global_language;
8968
cur_text->recursive= make_recursive;
8969
cur_text->protected= make_protected;
8970
}
8971
8972
8973
else
8974
cur_text->nargs= (eight_bits)CHOICE(last_control==definition,
8975
OUTER_MACRO,OUTER_UNMACRO);
8976
8977
if(is_WEB_macro&&IS_PROTECTED(np)&&(npq->built_in&&!redefine_builtins
8978
||!npq->built_in&&!redefine_macros))
8979
8980
err0_print(ERR_M,OC("Can't redefine protected %s `%s'; definition \
8981
(probably on previous line) ignored. \
8982
Use command-line option `-T%c' to override"),3,npq->built_in?"built-in function":"macro",name_of(a),npq->built_in?'b':'m');
8983
else
8984
sv_macro();
8985
8986
done_append:
8987
is_WEB_macro= NO;
8988
return np;
8989
}
8990
8991
8992
8993
SRTN
8994
sv_macro(VOID)
8995
{
8996
eight_bits HUGE*p;
8997
8998
cur_text->nbytes= tok_ptr-cur_text->tok_start;
8999
p= GET_MEM("macro space",cur_text->nbytes,eight_bits);
9000
memcpy(p,cur_text->tok_start,cur_text->nbytes);
9001
text_ptr->tok_start= tok_ptr= cur_text->tok_start;
9002
cur_text->tok_start= p;
9003
9004
cur_text->text_link= macro;
9005
}
9006
9007
9008
9009
SRTN
9010
app_dmacro FCN((p,p1))
9011
CONST eight_bits HUGE*p C0("Start")
9012
CONST eight_bits HUGE*p1 C1("End.")
9013
{
9014
eight_bits a0,a1;
9015
sixteen_bits a;
9016
name_pointer np;
9017
boolean make_recursive= NO;
9018
boolean make_protected= NO;
9019
9020
if(*p==MAKE_RECURSIVE)
9021
{
9022
make_recursive= YES;
9023
p++;
9024
}
9025
9026
if(p+2>p1)
9027
{
9028
9029
macro_err(OC("! Invalid argument to $DEFINE"),YES);
9030
return;
9031
}
9032
9033
if(TOKEN1(a0= *p++))
9034
{
9035
9036
macro_err(OC("! $DEFINE flushed; must start with identifier"),YES);
9037
return;
9038
}
9039
9040
a= IDENTIFIER(a0,a1= *p++);
9041
app_repl(a0);
9042
app_repl(a1);
9043
9044
np= name_dir+a;
9045
9046
np->macro_type= IMMEDIATE_MACRO;
9047
9048
if(*p==075)
9049
{p++;app_repl(040);}
9050
9051
while(p<p1)
9052
{app_repl(*p++);}
9053
9054
9055
{
9056
if(text_ptr>text_end)
9057
OVERFLW("texts","x");
9058
9059
cur_text= text_ptr;
9060
cur_text->nbytes= tok_ptr-cur_text->tok_start;
9061
9062
(++text_ptr)->tok_start= tok_ptr;
9063
}
9064
9065
9066
9067
9068
9069
{
9070
#if 0
9071
text_ptr->tok_start=
9072
#endif
9073
tok_ptr= argize(cur_text->tok_start,tok_ptr);
9074
9075
cur_text->Language= (boolean)global_language;
9076
cur_text->recursive= make_recursive;
9077
cur_text->protected= make_protected;
9078
}
9079
9080
9081
sv_macro();
9082
9083
np->equiv= (EQUIV)cur_text;
9084
}
9085
9086
9087
9088
SRTN
9089
i_define_ FCN((n,pargs))
9090
int n C0("")
9091
PARGS pargs C1("")
9092
{
9093
CHK_ARGS("$M",1);
9094
9095
app_dmacro(pargs[0]+1,pargs[1]);
9096
}
9097
9098
9099
9100
SRTN
9101
i_undef_ FCN((n,pargs))
9102
int n C0("")
9103
PARGS pargs C1("")
9104
{
9105
eight_bits a0;
9106
eight_bits HUGE*p= pargs[0]+1;
9107
9108
CHK_ARGS("$UNDEF",1);
9109
9110
if(p+2>pargs[1])
9111
{
9112
9113
macro_err(OC("! Invalid argument to $UNDEF(...)"),YES);
9114
return;
9115
}
9116
9117
if(TOKEN1(a0= *p++))
9118
{
9119
9120
macro_err(OC("! $UNDEF(...) flushed; must start with identifier"),YES);
9121
return;
9122
}
9123
9124
undef(IDENTIFIER(a0,*p),NO);
9125
}
9126
9127
9128
9129
SRTN
9130
phase1(VOID)
9131
{
9132
LANGUAGE language0= language;
9133
9134
phase= 1;
9135
module_count= 0;
9136
rst_input();rst_out(NOT_CONTINUATION);
9137
reading(web_file_name,NO);
9138
9139
9140
{
9141
ASCII*pkwd;
9142
9143
pkwd= x__to_ASCII(OC(LKWD));
9144
9145
lkwd= ID_NUM(pkwd,pkwd+STRLEN(LKWD));
9146
}
9147
9148
9149
9150
while((next_control= skip_ahead(ignore,NO))!=new_module)
9151
;
9152
9153
chk_override(language0);
9154
fin_language();
9155
global_params= params;
9156
set_output_file(global_language);
9157
9158
9159
while(!input_has_ended)
9160
scan_module();
9161
9162
chk_complete();
9163
9164
{
9165
name_pointer np;
9166
9167
9168
for(np= name_dir;np<name_ptr;np++)
9169
if(np->equiv!=NULL&&np->equiv!=(EQUIV)text_info
9170
&&np->macro_type==NOT_DEFINED)
9171
num_distinct_modules++;
9172
9173
num_modules= module_count;
9174
}
9175
9176
9177
}
9178
9179
9180
9181
SRTN
9182
i_modules_ FCN((n,pargs))
9183
int n C0("")
9184
PARGS pargs C1("")
9185
{
9186
outer_char temp[50];
9187
int m=
9188
nsprintf(temp,OC("%c%u%c"),3,XCHR(constant),*(pargs[0]+2)=='0'?num_distinct_modules:num_modules,XCHR(constant));
9189
9190
CHK_ARGS("$MODULES",1);
9191
9192
MCHECK(m,"_modules_");
9193
STRCPY(mp,to_ASCII(temp));
9194
mp+= m;
9195
}
9196
9197
9198
9199
SRTN
9200
see_statistics(VOID)
9201
{
9202
CLR_PRINTF(ALWAYS,info,("\n\nMEMORY USAGE STATISTICS:\n"));
9203
STAT0("names",sizeof(*name_ptr),
9204
SUB_PTRS(name_ptr,name_dir),max_names,smin0(MAX_VAL("n")),"n","");
9205
9206
STAT0("replacement texts",sizeof(*text_ptr),
9207
SUB_PTRS(text_ptr,text_info),max_texts,smin0(MAX_VAL("x")),"x","");
9208
9209
STAT0("deferred texts",sizeof(*txt_dptr),
9210
SUB_PTRS(txt_dptr,txt_dinfo),dtexts_max,smin0(MAX_VAL("dx")),"dx",";");
9211
9212
STAT0("bytes",sizeof(*byte_ptr),
9213
SUB_PTRS(byte_ptr,byte_mem),max_bytes,smin0(MAX_VAL("b")),"b","");
9214
9215
STAT0("tokens",sizeof(*tok_ptr),
9216
SUB_PTRS((mx_tok_ptr>tok_ptr?mx_tok_ptr:tok_ptr),tok_mem),
9217
max_toks,smin0(MAX_VAL("tt")),"tt","");
9218
9219
STAT0("deferred tokens",sizeof(*tok_dptr),
9220
SUB_PTRS((mx_dtok_ptr>tok_dptr?mx_dtok_ptr:tok_dptr),tok_dmem),
9221
max_dtoks,smin0(MAX_VAL("dt")),"dt",".");
9222
9223
mem_avail(1);
9224
}
9225
9226
9227
9228
SRTN
9229
t_macros(VOID)
9230
{
9231
9232
9233
SAVE_MACRO("$MODULE_NAME $STRING($$MODULE_NAME)");
9234
9235
9236
9237
#if 0
9238
SAVE_MACRO("_STUB(s)$IFCASE($LANGUAGE_NUM,\
9239
{missing_mod(#s);},{missing_mod(#s);},\
9240
call nomod(#s),call nomod(#s),\
9241
call nomod(#s),call nomod(#s),\
9242
\\missingmod{s},\
9243
%nomod(s),%nomod(s))");
9244
#endif
9245
9246
SAVE_MACRO("$STUB(s)$IFCASE($LANGUAGE_NUM,\
9247
missing_mod(#s);, missing_mod(#s);,\
9248
call nomod(#s), call nomod(#s),\
9249
call nomod(#s), call nomod(#s),\
9250
\\missingmod{s},\
9251
%nomod(s), %nomod(s))");
9252
9253
9254
9255
SAVE_MACRO("$VERSION $STRING($$VERSION)");
9256
9257
9258
9259
9260
SAVE_MACRO("$DAY $TM(0)");
9261
SAVE_MACRO("$DATE $TM(1)");
9262
SAVE_MACRO("$TIME $TM(2)");
9263
9264
SAVE_MACRO("$TM(i)$STRING($$TM(i))");
9265
9266
9267
9268
9269
9270
9271
SAVE_MACRO("$A(s)$$ASCII(s)");
9272
9273
SAVE_MACRO("$ASCII(s)$$ASCII(s)");
9274
9275
9276
9277
SAVE_MACRO("$INCR(N,...)$INCR0(#!N,$EVAL(N+$IFELSE(#0,0,1,#1)))");
9278
9279
SAVE_MACRO("$DECR(N,...)$INCR0(#!N,$EVAL(N-$IFELSE(#0,0,1,#1)))");
9280
9281
SAVE_MACRO("$INCR0(N,N1)$M(#!N N1)");
9282
9283
9284
9285
SAVE_MACRO("$MODULES $$MODULES(0)");
9286
9287
SAVE_MACRO("$SECTIONS $$MODULES(1)");
9288
9289
9290
9291
SAVE_MACRO("$DO(k,kmin,kmax,...)$UNROLL(k,kmin,kmax,$IFCASE(#0,1,#.))");
9292
9293
;
9294
}
9295
9296
9297
9298
SRTN
9299
out_msg FCN((msg,msg1))
9300
CONST ASCII*msg C0("Start of message.")
9301
CONST ASCII*msg1 C1("See the description below.")
9302
{
9303
eight_bits HUGE*temp;
9304
eight_bits HUGE*mp0= mp,
9305
HUGE*macrobuf0= macrobuf,HUGE*macrobuf_end0= macrobuf_end;
9306
char HUGE*new_msg;
9307
boolean nuweb_mode0,in_string0,meta_mode0;
9308
9309
9310
mp= macrobuf= temp= GET_MEM("out_msg:temp",MSG_BUF_SIZE,eight_bits);
9311
macrobuf_end= temp+MSG_BUF_SIZE;
9312
9313
9314
9315
if(msg1==NULL)
9316
msg1= msg+STRLEN(msg);
9317
9318
new_msg= (char HUGE*)str_to_mb((eight_bits HUGE*)msg,
9319
(eight_bits HUGE*)msg1,NO);
9320
9321
9322
spcs_after_cmnt= SPCS_AFTER_CMNT;
9323
9324
9325
9326
9327
nuweb_mode0= nuweb_mode;
9328
in_string0= in_string;
9329
meta_mode0= meta_mode;
9330
9331
meta_mode= nuweb_mode= NO;
9332
#if 0
9333
in_string= YES;
9334
9335
9336
#endif
9337
9338
OUT_CHAR(begin_meta);
9339
OUT_CHAR(begin_meta);
9340
in_string= YES;
9341
while(*new_msg)
9342
OUT_CHAR(*new_msg++);
9343
in_string= NO;
9344
OUT_CHAR(end_meta);
9345
9346
nuweb_mode= nuweb_mode0;
9347
in_string= in_string0;
9348
meta_mode= meta_mode0;
9349
9350
spcs_after_cmnt= 0;
9351
9352
FREE_MEM(temp,"out_msg:temp",MSG_BUF_SIZE,eight_bits);
9353
macrobuf= macrobuf0;mp= mp0;macrobuf_end= macrobuf_end0;
9354
}
9355
9356
9357
9358
static sixteen_bits id_unroll;
9359
9360
SPEC univ_tokens[]= {
9361
{"_UNROLL",0,x_unroll,&id_unroll},
9362
{"$UNROLL",0,x_unroll,&id_unroll},
9363
{"",0,NULL,NULL}
9364
};
9365
9366
SRTN
9367
ini_univ_tokens FCN((language0))
9368
LANGUAGE language0 C1("")
9369
{
9370
ini_special_tokens(language0,univ_tokens);
9371
}
9372
9373
9374
9375
SRTN
9376
ini_tokens FCN((language0))
9377
LANGUAGE language0 C1("")
9378
{
9379
switch(language0)
9380
{
9381
case C:
9382
break;
9383
9384
case C_PLUS_PLUS:
9385
break;
9386
9387
case FORTRAN:
9388
break;
9389
9390
case FORTRAN_90:
9391
break;
9392
9393
case TEX:
9394
break;
9395
9396
default:
9397
break;
9398
}
9399
9400
ini_univ_tokens(language0);
9401
}
9402
9403
9404
9405
int
9406
get_constant FCN((e))
9407
eight_bits HUGE*e C1("")
9408
{
9409
boolean positive= YES;
9410
int i= 1;
9411
9412
if(*e==055)
9413
{
9414
positive= NO;
9415
e++;
9416
}
9417
9418
if(*e++!=constant)
9419
{
9420
9421
err0_print(ERR_T,OC("Invalid loop constant"),0);
9422
return i;
9423
}
9424
9425
to_outer(e);
9426
i= ATOI(e);
9427
return(positive)?i:-i;
9428
}
9429
9430
9431
9432
9433
#endif
9434
9435
Loggerhead is a web-based interface for Breezy
Version: 2.0.1