« back to all changes in this revision
Viewing changes to .pc/24-Web--ratfor.c.patch/Web/ratfor.c
- browse files at revision 4
- compare with another revision
- download diff
- download tarball
- view history from revision 4
- Committer: Package Import Robot
- Author(s): Jari Aalto
- Date: 2011-11-18 21:05:43 UTC
- Revision ID: package-import@ubuntu.com-20111118210543-i4gn84g98pi86war
Tags: 1.62-11.1
* Non-maintainer upload.
- Move to packaging format "3.0 (quilt)".
* debian/compat
- Update to 8.
* debian/control
- (Build-Depends): update to debhelper 8.
- (Description): Adjust first line (lintian).
- (Homepage): Add.
- (Recommends): Change to tetex-base to texlive (Closes: #601268).
- (Standards-Version): Update to 3.9.2.
- (Suggests): Remove tetex-base.
Package fweb-doc
- (Description): Extend first line (Lintian).
- (Depends): Add ${misc:Depends}, add dpkg (>= 1.15.4) | install-info
- (Section): Add doc.
* debian/copyright
- Remove obsolete FSF address. Correct GPL path.
* debian/idxmerge.1
- Fix hyphen-used-as-minus-sign (Lintian).
* debian/patches
- New. Convert embedded changes to upstream code into individual patches.
* debian/rules
- Replace obsolete dh_clean with dh_prep
- (build-arch, build-indep): New (W: Lintian).
- (clean): Adjust make call Web/Makefile (Lintian).
Delete generated files: Web/fweave.mds Web/fweave.ndx
- (docdir): Install docs to $package-doc.
- (infodir): New variable.
- (install): Don't create directory doc-base (lintian).
Don't create empty info dir (Lintian).
- (tmpdir): Install to $package, not tmp dir thus no longer needing
dh_movefiles.
* debian/source/format
- New file.
* fweb-doc.doc-base
- (Section): Update from Apps/Programming to Programming.
- Move to packaging format "3.0 (quilt)".
* debian/compat
- Update to 8.
* debian/control
- (Build-Depends): update to debhelper 8.
- (Description): Adjust first line (lintian).
- (Homepage): Add.
- (Recommends): Change to tetex-base to texlive (Closes: #601268).
- (Standards-Version): Update to 3.9.2.
- (Suggests): Remove tetex-base.
Package fweb-doc
- (Description): Extend first line (Lintian).
- (Depends): Add ${misc:Depends}, add dpkg (>= 1.15.4) | install-info
- (Section): Add doc.
* debian/copyright
- Remove obsolete FSF address. Correct GPL path.
* debian/idxmerge.1
- Fix hyphen-used-as-minus-sign (Lintian).
* debian/patches
- New. Convert embedded changes to upstream code into individual patches.
* debian/rules
- Replace obsolete dh_clean with dh_prep
- (build-arch, build-indep): New (W: Lintian).
- (clean): Adjust make call Web/Makefile (Lintian).
Delete generated files: Web/fweave.mds Web/fweave.ndx
- (docdir): Install docs to $package-doc.
- (infodir): New variable.
- (install): Don't create directory doc-base (lintian).
Don't create empty info dir (Lintian).
- (tmpdir): Install to $package, not tmp dir thus no longer needing
dh_movefiles.
* debian/source/format
- New file.
* fweb-doc.doc-base
- (Section): Update from Apps/Programming to Programming.
- files added:
- .pc
- .pc/01-Web--Makefile.patch
- .pc/01-Web--Makefile.patch/Web
- .pc/02-Web--configure.patch
- .pc/02-Web--configure.patch/Web
- .pc/10-Manual--fweb.texi.patch
- .pc/10-Manual--fweb.texi.patch/Manual
- .pc/12-Web--common.web.patch
- .pc/12-Web--common.web.patch/Web
- .pc/14-Web--fweave.web.patch
- .pc/14-Web--fweave.web.patch/Web
- .pc/16-Web--ratfor.web.patch
- .pc/16-Web--ratfor.web.patch/Web
- .pc/18-Web--style.web.patch
- .pc/18-Web--style.web.patch/Web
- .pc/20-Web--common.c.patch
- .pc/20-Web--common.c.patch/Web
- .pc/22-Web--fweave.c.patch
- .pc/22-Web--fweave.c.patch/Web
- .pc/24-Web--ratfor.c.patch
- .pc/24-Web--ratfor.c.patch/Web
- .pc/26-Web--style.c.patch
- .pc/26-Web--style.c.patch/Web
- debian/patches
- debian/source
- files removed:
- Web/fweave.mds
- files modified:
- debian/changelog
added
removed
.pc/24-Web--ratfor.c.patch/Web/ratfor.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/ratfor -A -# --F -= 1.62/Web/ratfor.c"\
5
RUN TIME: "Friday, September 25, 1998 at 8:02."\
6
WEB FILE: "Web/ratfor.web"\
7
CHANGE FILE: (none)
8
#endif
9
#define _RATFOR_h
10
#define _ratfor_ \
11
12
#define stringg (eight_bits)02 \
13
14
#define constant (eight_bits)03
15
#define begin_Xmeta or_or
16
#define end_Xmeta star_star
17
#define cdir (eight_bits)06
18
#define colon_colon (eight_bits)011 \
19
20
#define join (eight_bits)0177 \
21
22
#define ID0 0200
23
#define TOKEN1(a)((a)<ID0) \
24
25
#define MACRO_ARGUMENT 0377 \
26
27
#define BASE2 0400 \
28
29
#define MODULE_NAME 10240
30
#define MODULE_NUM 20480
31
#define LINE_NUM 53248L \
32
33
#define IDENTIFIER(left,right) \
34
((sixteen_bits)(((left)-ID0)*BASE2+(sixteen_bits)(right))) \
35
\
36
37
#define LEFT(a,id)((eight_bits)(((a)/BASE2+(id)))) \
38
39
#define RIGHT(a)((eight_bits)(((a)%BASE2))) \
40
41
#define ignore 0 \
42
43
#define begin_comment0 (eight_bits)0376
44
#define begin_comment1 (eight_bits)0375 \
45
46
#define module_number (eight_bits)0201
47
#define identifier (eight_bits)0202
48
#define id_keyword (eight_bits)0203 \
49
50
#define L_switch (eight_bits)0257
51
#define begin_FORTRAN (eight_bits)0260
52
#define begin_RATFOR (eight_bits)0261
53
#define begin_C (eight_bits)0262
54
#define begin_LITERAL (eight_bits)0263 \
55
56
#define verbatim (eight_bits)0264 \
57
\
58
59
#define invisible_cmnt (eight_bits)0265
60
#define compiler_directive (eight_bits)0266
61
#define Compiler_Directive (eight_bits)0267 \
62
63
#define keyword_name (eight_bits)0270 \
64
65
#define no_index (eight_bits)0300
66
#define yes_index (eight_bits)0301 \
67
68
#define ascii_constant (eight_bits)0302
69
#define begin_vcmnt (eight_bits)0303
70
#define big_line_break (eight_bits)0304 \
71
72
#define begin_bp (eight_bits)0305
73
#define insert_bp (eight_bits)0306 \
74
75
#define begin_meta (eight_bits)017
76
#define end_meta (eight_bits)027 \
77
78
#define TeX_string (eight_bits)0307
79
#define xref_roman (eight_bits)0310
80
#define xref_typewriter (eight_bits)0311
81
#define xref_wildcard (eight_bits)0312 \
82
83
#define control_text (eight_bits)0313 \
84
85
#define begin_nuweb (eight_bits)0314
86
#define no_mac_expand (eight_bits)0315
87
#define set_line_info (eight_bits)0316
88
#define short_fcn (eight_bits)0317 \
89
90
#define formatt (eight_bits)0320 \
91
92
#define limbo_text (eight_bits)0323
93
#define op_def (eight_bits)0324
94
#define macro_def (eight_bits)0325 \
95
96
#define ignore_defn (eight_bits)0327 \
97
98
#define new_output_file (eight_bits)0331 \
99
100
#define definition (eight_bits)0332
101
#define undefinition (eight_bits)0333
102
#define WEB_definition (eight_bits)0334 \
103
104
#define m_ifdef (eight_bits)0335
105
#define m_ifndef (eight_bits)0336
106
#define m_if (eight_bits)0337
107
#define m_else (eight_bits)0340
108
#define m_elif (eight_bits)0341
109
#define m_endif (eight_bits)0342
110
#define m_for (eight_bits)0343
111
#define m_endfor (eight_bits)0344
112
#define m_line (eight_bits)0345
113
#define m_undef (eight_bits)0346 \
114
115
#define end_of_buffer (eight_bits)0347 \
116
117
#define begin_code (eight_bits)0350
118
#define module_name (eight_bits)0351 \
119
120
#define new_module (eight_bits)0352 \
121
122
#define cur_end cur_state.end_field
123
#define cur_byte cur_state.byte_field
124
#define cur_name cur_state.name_field
125
#define cur_repl cur_state.repl_field
126
#define cur_mod cur_state.mod_field \
127
128
#define cur_language cur_state.language
129
#define cur_global_language cur_state.global_params.Language \
130
\
131
\
132
133
#define cur_params cur_state.params
134
#define cur_global_params cur_state.global_params \
135
\
136
137
#define macrobuf cur_state.macro_buf
138
#define cur_mp cur_state.mp
139
#define macrobuf_end cur_state.macro_buf_end \
140
141
#define semi 01 \
142
143
#define SILENT (boolean)NO
144
#define COMPLAIN (boolean)YES \
145
146
#define OUTER_MACRO 0xFF
147
#define OUTER_UNMACRO 0xFE
148
#define UNDEFINED_MACRO 0xFD \
149
150
#define MAX_XLEVELS 200 \
151
152
#define equiv equiv_or_xref
153
#define EQUIV ASCII HUGE* \
154
\
155
\
156
157
#define MAC_LOOKUP(cur_val)(cur_val<MODULE_NAME? \
158
(text_pointer)(name_dir+(cur_val))->equiv:NULL) \
159
160
#define macro 0 \
161
\
162
\
163
\
164
165
#define NOT_DEFINED 0
166
#define DEFERRED_MACRO 1 \
167
168
#define IMMEDIATE_MACRO 2
169
#define FILE_NAME 3 \
170
\
171
172
#define MCHECK(n,reason)if(mp+(n)>macrobuf_end) \
173
mbuf_full((unsigned long)(n),(outer_char*)reason) \
174
175
#define BP_MARKER 1 \
176
177
#define PROPER_END(end) \
178
end= (np+1)->byte_start; \
179
if(*end==BP_MARKER&&np!=npmax)end= ((BP*)end)->byte_start \
180
181
#define MAX_ID_LENGTH 32 \
182
183
#define UNNAMED_MODULE 0
184
#define N_IDBUF 100 \
185
186
#define fatal_RAT_ERROR(s1,s2,s3){ \
187
RAT_error(ERROR,OC(s1),0); \
188
fatal(ERR_R,OC(s2),OC(s3));} \
189
190
#define COPY_COMMENTS NO
191
#define SAVE_COMMENTS YES \
192
193
#define current_cmd lbl[wlevel].cmd
194
#define do_or_while (current_cmd==do_CMD||current_cmd==while_CMD) \
195
196
#define s_top lbl[wlevel].Top
197
#define s_next lbl[wlevel].Next
198
#define was_next lbl[wlevel].was_Next
199
#define s_break lbl[wlevel].Break
200
#define was_break lbl[wlevel].was_Break
201
#define s_case lbl[wlevel].Case
202
#define s_default lbl[wlevel].Default
203
#define icase lbl[wlevel].Icase \
204
205
#define DONT_PRINT_IF_0 YES
206
#define PRINT_IF_0 NO \
207
208
#define TO_OUTPUT NO
209
#define TO_MEMORY YES \
210
211
#define SAVE_IN_MEM(a){if(cur_case->txt.next>=cur_case->txt.end) \
212
resize(&cur_case->txt.start,BIG_SAVE8, \
213
&cur_case->txt.next, \
214
&cur_case->txt.end); \
215
*(cur_case->txt.next++)= (eight_bits)(a);} \
216
217
#define SAVE_16 {SAVE_IN_MEM(a0)SAVE_IN_MEM(a1)} \
218
219
#define XPN_CASES YES
220
#define DONT_XPN_CASES NO \
221
222
#define BLEVELS 100 \
223
224
#define copy_to(r_after)copy_2to(NOT_BEFORE,r_after) \
225
226
#define BRACE_ONLY 1 \
227
\
228
229
#define unmatched(l,r) \
230
RAT_error(WARNING,OC("Ignored '%c' not matched with %s"),2,XCHR(r),qdelim(l)) \
231
232
#define inserted(n,l0,r0,l,level) \
233
RAT_error(WARNING,OC("Inserted %d '%c' to balance '%c' at %s level %d"),5,n,XCHR(r0),XCHR(l0),qdelim(l),level) \
234
\
235
236
#define COPY_TO(r)psave_buffer= SAVE_AFTER(&save_buffer,BIG_SAVE8,r); \
237
copy_out(save_buffer,psave_buffer,!macro) \
238
239
#define COPY_2TO(r_before,r_after) \
240
psave_buffer= save_out(&save_buffer,BIG_SAVE8,r_before,r_after); \
241
copy_out(save_buffer,psave_buffer,!macro) \
242
243
#define INDENT indent_level++;blank_out(1)
244
#define OUTDENT indent_level--;out_pos-= indnt_size \
245
246
#define LABEL(lbl)out_label(DONT_PRINT_IF_0,(STMT_LBL)(lbl))
247
#define NUMBER(lbl)out_label(PRINT_IF_0,(STMT_LBL)(lbl)) \
248
\
249
250
#define PARENS copyd(TO_OUTPUT,XPN_CASES,050,051,NO) \
251
\
252
253
#define NL out_char(012)
254
#define LP out_char(050)
255
#define RP out_char(051)
256
#define COMMA out_char(054)
257
#define NOT out_char(041)
258
#define EQUALS out_char(075)
259
#define MINUS out_char(055)
260
#define EQ_EQ out_char(eq_eq)
261
#define OR out_char(or_or)
262
#define LT out_char(074)
263
#define GT out_char(076) \
264
265
#define IF(stmt_num)LABEL(stmt_num);id0(id__IF)
266
#define THEN id0(id__THEN);NL
267
#define ELSE id0(id__ELSE)
268
#define ENDIF id0(id__ENDIF);if(symbolic_label)id0(symbolic_label);NL
269
#define ENDWHERE id0(id__ENDWHERE);NL
270
#define GOTO(stmt)id0(id__GOTO);LABEL(stmt);NL
271
#define CONTINUE(stmt)LABEL(stmt);id0(id__CONTINUE);NL
272
#define RETURN id0(id__RETURN);NL
273
#define END id0(id__END);NL \
274
275
#define END_DO id0(id__END);id0(id__DO);NL
276
#define END_SELECT id0(id__END);id0(id__SELECT);NL \
277
278
#define NOT_LOOP(id,msg)not_loop(OC(id),OC(msg)) \
279
280
#define SAVE8 200 \
281
282
#define BIG_SAVE8 10000 \
283
284
#define id__ignore ignore \
285
286
#define UNEXPECTED(id)unexpected(OC(id)) \
287
288
#define NSWITCHES 20
289
#define NCASES 257
290
#define cur_switch switches[switch_level] \
291
292
293
294
295
#ifndef part
296
#define part 0
297
#else
298
#if(part != 1 && part != 2 && part != 3)
299
#define part 1
300
#endif
301
#endif
302
303
304
305
306
#if(part == 0 || part == 1)
307
#define part1_or_extern
308
#define SET1(stuff) = stuff
309
#define TSET1(stuff) = stuff
310
#else
311
#define part1_or_extern extern
312
#define SET1(stuff)
313
#define TSET1(stuff)
314
#endif
315
316
317
318
319
320
#include "typedefs.h"
321
322
323
324
325
326
327
#include "map.h"
328
329
330
331
332
typedef struct
333
{
334
eight_bits HUGE*tok_start;
335
336
sixteen_bits text_link;
337
boolean Language;
338
eight_bits nargs;
339
unsigned
340
moffset:8,
341
recursive:1,
342
var_args:1,
343
module_text:1,
344
built_in:1,
345
protected:1,
346
nbytes:19;
347
}text;
348
349
typedef text HUGE*text_pointer;
350
351
352
353
typedef struct{
354
eight_bits HUGE*end_field;
355
eight_bits HUGE*byte_field;
356
name_pointer name_field;
357
text_pointer repl_field;
358
sixteen_bits mod_field;
359
PARAMS global_params,params;
360
eight_bits HUGE*macro_buf,HUGE*mp,HUGE*macro_buf_end;
361
362
}output_state;
363
364
typedef output_state HUGE*stack_pointer;
365
366
367
368
369
typedef enum{BAD_TOKEN,OR_OR,AND_AND,BIT_OR,BIT_XOR,BIT_AND,LOG_EQ,LOG_LT,
370
BIT_SHIFT,PLUS_MINUS,TIMES,EXP,UNARY,HIGHEST_UNARY}PRECEDENCE;
371
372
373
typedef struct
374
{
375
eight_bits token;
376
PRECEDENCE precedence;
377
}OP;
378
379
380
typedef union
381
{
382
long i;
383
double d;
384
sixteen_bits id;
385
OP op;
386
}VALUE;
387
388
389
390
typedef enum{Int,Double,Id,Op}TYPE;
391
392
393
394
typedef struct val
395
{
396
VALUE value;
397
TYPE type;
398
struct val HUGE*last,HUGE*next;
399
}VAL;
400
401
402
403
typedef struct
404
{
405
sixteen_bits token[MAX_XLEVELS];
406
int level;
407
}XIDS;
408
409
410
411
#if(0)
412
IN_COMMON boolean truncate_ids;
413
IN_COMMON unsigned short tr_max[];
414
IN_COMMON name_pointer npmax;
415
#endif
416
417
418
typedef struct Bp
419
{
420
ASCII c;
421
LANGUAGE Language;
422
CONST ASCII HUGE*byte_start,HUGE*byte_end;
423
424
struct Bp HUGE*next;
425
426
struct Trunc HUGE*Root;
427
}BP;
428
429
430
typedef struct Trunc
431
{
432
boolean Language;
433
size_t num[NUM_LANGUAGES];
434
435
ASCII HUGE*id,HUGE*id_end;
436
BP HUGE*first,HUGE*last;
437
struct Trunc HUGE*next;
438
}TRUNC;
439
440
441
442
IN_RATFOR int switch_level RSET(0);
443
444
445
typedef struct
446
{
447
eight_bits HUGE*start,HUGE*next,HUGE*end;
448
}TEXT;
449
450
451
typedef struct
452
{
453
STMT_LBL label;
454
TEXT case_txt;
455
CASE_TYPE value;
456
TEXT txt;
457
boolean is_default;
458
}CASE;
459
460
IN_RATFOR CASE HUGE*cur_case;
461
462
463
typedef struct
464
{
465
CASE HUGE*cases;
466
unsigned short ncases;
467
boolean has_default;
468
}SWITCH;
469
470
IN_RATFOR SWITCH HUGE*switches;
471
472
473
474
475
#include "t_type.h"
476
477
478
479
480
481
482
483
#ifdef SMALL_MEMORY
484
#define N_MSGBUF 2000
485
#else
486
#define N_MSGBUF 10000
487
#endif
488
489
490
491
492
493
EXTERN long max_texts;
494
EXTERN text HUGE*text_info;
495
EXTERN text_pointer text_end;
496
497
EXTERN long dtexts_max;
498
EXTERN text HUGE*txt_dinfo;
499
EXTERN text_pointer textd_end;
500
501
EXTERN text_pointer text_ptr,txt_dptr;
502
503
504
EXTERN long max_toks;
505
EXTERN eight_bits HUGE*tok_mem;
506
EXTERN eight_bits HUGE*tok_m_end;
507
508
EXTERN long max_dtoks;
509
EXTERN eight_bits HUGE*tok_dmem;
510
EXTERN eight_bits HUGE*tokd_end;
511
512
EXTERN eight_bits HUGE*tok_ptr,HUGE*tok_dptr;
513
514
EXTERN eight_bits HUGE*mx_tok_ptr,HUGE*mx_dtok_ptr;
515
516
517
EXTERN text_pointer macro_text;
518
519
520
521
EXTERN output_state cur_state;
522
523
524
EXTERN long stck_size;
525
EXTERN output_state HUGE*stack;
526
EXTERN stack_pointer stck_end;
527
EXTERN stack_pointer stck_ptr;
528
529
530
531
IN_COMMON STMT_LBL max_stmt;
532
533
EXTERN sixteen_bits outp_line[NUM_LANGUAGES]
534
#ifdef _FTANGLE_h
535
#if(part == 0 || part == 1)
536
= {1,1,1,1,1,1,1,1}
537
#endif
538
#endif
539
;
540
541
542
543
EXTERN boolean mac_protected,in_string;
544
EXTERN text_pointer macro_text;
545
EXTERN long cur_val;
546
EXTERN OUTPUT_STATE out_state;
547
EXTERN int indent_level,out_pos,rst_pos,indnt_size;
548
EXTERN eight_bits sent;
549
550
IN_COMMON STMT_LBL max_stmt;
551
IN_COMMON sixteen_bits outp_line[];
552
553
554
555
556
IN_RATFOR sixteen_bits
557
id_block,id_blockdata,id_break,
558
id_case,
559
#if(0)
560
id_continue,
561
#endif
562
id_default,id_do,
563
id_else,id_elseif,id_end,
564
id_endif,
565
id_for,
566
#if(0)
567
id_goto,
568
#endif
569
id_if,
570
id_next,id_procedure,id_repeat,
571
id_return,id_switch,id_then,id_until,
572
id_while;
573
574
IN_RATFOR sixteen_bits id_function,id_program,id_subroutine;
575
576
IN_RATFOR sixteen_bits
577
id_contains,id_elsewhere,id_endinterface,id_endtype,id_endmodule,
578
id_endselect,id_endwhere,id_interface,id_module,id_type,id_where;
579
580
581
IN_RATFOR sixteen_bits id_data;
582
583
584
IN_RATFOR sixteen_bits
585
id__CASE,id__CONTINUE,id__DEFAULT,
586
id__DO,id__ELSE,id__ELSEIF,id__END,
587
id__ENDIF,id__EXIT,id__GOTO,id__IF,
588
id__RETURN,id__THEN,
589
id__WHILE;
590
591
592
IN_RATFOR sixteen_bits
593
id__CONTAINS,id__CYCLE,id__ENDWHERE,id__INTERFACE,id__MODULE,
594
id__SELECT,id__TYPE,id__WHERE;
595
596
597
598
599
IN_RATFOR SPEC out_tokens[]
600
#if(part == 0 || part == 1)
601
= {
602
{"CASE",0,NULL,&id__CASE},
603
{"CONTINUE",0,NULL,&id__CONTINUE},
604
{"DEFAULT",0,NULL,&id__DEFAULT},
605
{"DO",0,NULL,&id__DO},
606
{"ELSE",0,NULL,&id__ELSE},
607
{"ELSEIF",0,NULL,&id__ELSEIF},
608
{"END",0,NULL,&id__END},
609
{"ENDIF",0,NULL,&id__ENDIF},
610
{"EXIT",0,NULL,&id__EXIT},
611
{"GOTO",0,NULL,&id__GOTO},
612
{"IF",0,NULL,&id__IF},
613
{"RETURN",0,NULL,&id__RETURN},
614
{"THEN",0,NULL,&id__THEN},
615
{"WHILE",0,NULL,&id__WHILE},
616
{"",0,NULL,NULL}
617
}
618
#endif
619
;
620
621
IN_RATFOR SPEC out90_tokens[]
622
#if(part == 0 || part == 1)
623
= {
624
{"CONTAINS",0,NULL,&id__CONTAINS},
625
{"CYCLE",0,NULL,&id__CYCLE},
626
{"ENDWHERE",0,NULL,&id__ENDWHERE},
627
{"INTERFACE",0,NULL,&id__INTERFACE},
628
{"MODULE",0,NULL,&id__MODULE},
629
{"SELECT",0,NULL,&id__SELECT},
630
{"TYPE",0,NULL,&id__TYPE},
631
{"WHERE",0,NULL,&id__WHERE},
632
{"",0,NULL,NULL}
633
}
634
#endif
635
;
636
637
638
639
eight_bits break_tokens[3];
640
641
642
IN_RATFOR SPEC spec_tokens[]
643
#if(part == 0 || part == 1)
644
= {
645
{"block",0,x_block,&id_block},
646
{"blockdata",0,x_blockdata,&id_blockdata},
647
{"break",0,x_break,&id_break},
648
{"case",0,(X_FCN(*)(VOID))x_case,&id_case},
649
{"default",0,(X_FCN(*)(VOID))x_default,&id_default},
650
{"do",0,x_do,&id_do},
651
{"else",0,x_else,&id_else},
652
{"elseif",0,x_els_if,&id_elseif},
653
{"end",0,x_end,&id_end},
654
{"endif",0,x_en_if,&id_endif},
655
{"for",0,x_for,&id_for},
656
{"function",0,x_function,&id_function},
657
{"if",0,x_if,&id_if},
658
{"next",0,x_next,&id_next},
659
{"procedure",0,x_procedure,&id_procedure},
660
{"program",0,x_program,&id_program},
661
{"repeat",0,x_repeat,&id_repeat},
662
{"return",0,x_return,&id_return},
663
{"switch",0,x_switch,&id_switch},
664
{"subroutine",0,x_subroutine,&id_subroutine},
665
{"then",0,x_then,&id_then},
666
{"until",0,x_until,&id_until},
667
{"while",0,x_while,&id_while},
668
{"",0,NULL,NULL}
669
}
670
#endif
671
;
672
673
674
IN_RATFOR SPEC spec90_tokens[]
675
#if(part == 0 || part == 1)
676
= {
677
{"contains",0,x_contains,&id_contains},
678
{"endinterface",0,x_en_interface,&id_endinterface},
679
{"endmodule",0,x_en_module,&id_endmodule},
680
{"endselect",0,x_en_select,&id_endselect},
681
{"endtype",0,x_en_type,&id_endtype},
682
{"endwhere",0,x_en_where,&id_endwhere},
683
{"interface",0,x_interface,&id_interface},
684
{"module",0,x_module,&id_module},
685
{"type",0,x_type,&id_type},
686
{"where",0,x_where,&id_where},
687
{"",0,NULL,NULL}
688
}
689
#endif
690
;
691
692
693
694
IN_RATFOR sixteen_bits sym_label RSET(0);
695
696
697
698
IN_RATFOR boolean saved_token RSET(NO);
699
IN_RATFOR eight_bits last_a;
700
IN_RATFOR int last_bytes;
701
702
703
704
705
706
IN_RATFOR eight_bits HUGE*cmnt_buf RSET(NULL),
707
HUGE*cmnt_buf_end RSET(NULL),
708
HUGE*cmnt_pos RSET(NULL);
709
710
711
typedef struct
712
{
713
CMD cmd;
714
STMT_LBL Top,Next,Break;
715
STMT_LBL Case,Default;
716
sixteen_bits Icase;
717
unsigned was_Break:1,
718
was_Next:1;
719
}LBL;
720
721
IN_RATFOR LBL HUGE*lbl,HUGE*lbl_end;
722
IN_RATFOR BUF_SIZE max_lbls;
723
724
IN_RATFOR int wlevel RSET(0);
725
726
727
728
729
730
731
732
IN_RATFOR boolean balanced RSET(YES);
733
IN_RATFOR ASCII cur_delim RSET('\0');
734
735
736
737
IN_RATFOR eight_bits HUGE*save_buffer RSET(NULL),HUGE*psave_buffer;
738
739
740
741
IN_RATFOR outer_char HUGE*cmd_fmt;
742
IN_RATFOR ASCII HUGE*cmd_msg,HUGE*cmd_end;
743
IN_RATFOR BUF_SIZE cmd_fsize,cmd_size;
744
745
746
747
IN_COMMON double g_ratio;
748
IN_COMMON CASE_TYPE max_spread;
749
IN_COMMON unsigned short marginal_cases;
750
751
IN_EVAL VAL HUGE*val_ptr,HUGE*val_heap;
752
753
754
755
756
757
#if(part != 2)
758
759
760
SRTN
761
is_Rat_present(VOID)
762
{
763
Rat_is_loaded= YES;
764
}
765
766
767
768
boolean
769
Rat_OK FCN((msg))
770
outer_char*msg C1("")
771
{
772
return YES;
773
}
774
775
776
777
SRTN
778
ini_RAT_tokens FCN((language0))
779
LANGUAGE language0 C1("")
780
{
781
switch(language0)
782
{
783
case RATFOR_90:
784
ini_special_tokens(language0,spec90_tokens);
785
ini_out_tokens(out90_tokens);
786
787
788
case RATFOR:
789
ini_special_tokens(language0,spec_tokens);
790
ini_out_tokens(out_tokens);
791
break;
792
793
default:
794
795
confusion(OC("ini_RAT_tokens"),OC("Language should be RATFOR-like here"));
796
}
797
798
ini_univ_tokens(language0);
799
800
{
801
ASCII HUGE*pd;
802
803
804
break_tokens[0]= LEFT(id_break,ID0);
805
break_tokens[1]= RIGHT(id_break);
806
break_tokens[2]= 073;
807
808
pd= x_to_ASCII(OC("data"));
809
id_data= ID_NUM(pd,pd+4);
810
}
811
812
813
}
814
815
816
817
int
818
chk_lbl(VOID)
819
{
820
sixteen_bits a;
821
822
if(next_byte()==072)
823
{
824
sym_label= (sixteen_bits)cur_val;
825
826
if(TOKEN1(a= next_byte()))BACK_UP
827
else
828
{
829
a= IDENTIFIER(a,next_byte());
830
831
if(name_dir[a].expandable)
832
{
833
cur_val= a;
834
return YES;
835
}
836
else
837
{
838
BACK_UP
839
cur_val= sym_label;
840
sym_label= ignore;
841
842
checking_label= YES;
843
out_char(identifier);
844
checking_label= NO;
845
846
return-1;
847
}
848
}
849
}
850
851
852
sym_label= ignore;
853
BACK_UP
854
return NO;
855
}
856
857
858
859
SRTN
860
RAT_error FCN(VA_ALIST((err_type,msg,n VA_ARGS)))
861
VA_DCL(
862
ERR_TYPE err_type C0("Is it warning or error?")
863
CONST outer_char msg[]C0("Error message.")
864
int n C2("Number of arguments to follow."))
865
{
866
VA_LIST(arg_ptr)
867
outer_char HUGE*temp,HUGE*temp1;
868
int last_level;
869
#if(NUM_VA_ARGS == 1)
870
ERR_TYPE err_type;
871
CONST outer_char*msg;
872
int n;
873
#endif
874
875
temp= GET_MEM("RAT_error:temp",N_MSGBUF,outer_char);
876
temp1= GET_MEM("RAT_error:temp1",N_MSGBUF,outer_char);
877
878
VA_START(arg_ptr,n);
879
880
#if(NUM_VA_ARGS == 1)
881
err_type= va_arg(arg_ptr,ERR_TYPE);
882
msg= va_arg(arg_ptr,char*);
883
va_arg(arg_ptr,int);
884
#endif
885
886
vsprintf((char*)temp1,(CONST char*)msg,arg_ptr);
887
va_end(arg_ptr);
888
889
890
if(
891
nsprintf(temp,OC("RATFOR %s (Output l. %u in %s): %s."),4,err_type==ERROR?"ERROR":"WARNING",OUTPUT_LINE,params.OUTPUT_FILE_NAME,temp1)>=(int)(N_MSGBUF))OVERFLW("temp","");
892
893
last_level= MAX(rlevel-1,0);
894
895
896
if(
897
nsprintf(temp1,OC("%s Expanding \"%s\" (loop level %d) beginning at output line %u. \
898
In \"%s %s\" beginning at line %u."),7,(char*)temp,(char*)cmd_name(begun[last_level].cmd),begun[last_level].level,begun[last_level].line,(char*)cmd_name(begun[0].cmd),(char*)name_of(begun[0].name),begun[0].line)>=(int)(N_MSGBUF))OVERFLW("temp1","");
899
900
printf("\n%s\n",(char*)temp1);
901
OUT_MSG(to_ASCII(temp1),NULL);
902
903
mark_error;
904
905
FREE_MEM(temp,"RAT_error:temp",N_MSGBUF,char);
906
FREE_MEM(temp1,"RAT_error:temp1",N_MSGBUF,char);
907
}
908
909
910
911
SRTN
912
output_ended FCN(VA_ALIST((msg,n VA_ARGS)))
913
VA_DCL(
914
CONST outer_char msg[]C0("Error message.")
915
int n C2("Number of arguments to follow."))
916
{
917
VA_LIST(arg_ptr)
918
char HUGE*temp;
919
920
temp= GET_MEM("output_ended:temp",N_MSGBUF,char);
921
922
VA_START(arg_ptr,n);
923
924
#if(NUM_VA_ARGS==1)
925
{
926
char*fmt0= va_arg(arg_ptr,char*);
927
928
va_arg(arg_ptr,int);
929
vsprintf((char*)temp,fmt0,arg_ptr);
930
}
931
#else
932
vsprintf(temp,(CONST char*)msg,arg_ptr);
933
#endif
934
va_end(arg_ptr);
935
936
937
RAT_error(ERROR,OC("Output ended %s"),1,temp);
938
939
fatal(ERR_R,OC("ABORTING!"),OC(""));
940
}
941
942
943
944
outer_char HUGE*
945
cmd_name FCN((cmd))
946
CMD cmd C1("Type of command.")
947
{
948
switch(cmd)
949
{
950
case _DO_CMD:
951
return OC("$DO");
952
953
case blockdata_CMD:return OC("blockdata");
954
case break_CMD:return OC("break");
955
case case_CMD:return OC("case");
956
case contains_CMD:return OC("contains");
957
case default_CMD:return OC("default");
958
case do_CMD:return OC("do");
959
case for_CMD:return OC("for");
960
case function_CMD:return OC("function");
961
case if_CMD:return OC("if");
962
case interface_CMD:return OC("interface");
963
case module_CMD:return OC("module");
964
case next_CMD:return OC("next");
965
case program_CMD:return OC("program");
966
case repeat_CMD:return OC("repeat");
967
case return_CMD:return OC("return");
968
case subroutine_CMD:return OC("subroutine");
969
case switch_CMD:return OC("switch");
970
case type_CMD:return OC("type");
971
case until_CMD:return OC("until");
972
case where_CMD:return OC("where");
973
case while_CMD:return OC("while");
974
default:return OC("UNKNOWN CMD");
975
}
976
}
977
978
979
980
SRTN
981
not_switch FCN((s))
982
CONST outer_char s[]C1("Error message.")
983
{
984
985
RAT_error(ERROR,OC("Misplaced keyword: \
986
\"%s\" must be used only inside \"switch\""),1,s);
987
}
988
989
990
SRTN didnt_expand FCN((c0,c,op))
991
eight_bits c0 C0("")
992
eight_bits c C0("")
993
CONST char*op C1("")
994
{
995
996
RAT_error(ERROR,OC("Was expecting '%c', not '%c', after \"%s\"; \
997
expansion aborted"),3,XCHR(c0),XCHR(c),op);
998
}
999
1000
1001
boolean
1002
char_after FCN((c))
1003
outer_char c C1("Character expected next.")
1004
{
1005
if((ASCII)(next_byte())!=XORD(c))
1006
{
1007
1008
RAT_error(WARNING,OC("Inserted '%c' after \"%s\""),1,c,cmd_name(begun[rlevel-1].cmd));
1009
BACK_UP
1010
return NO;
1011
}
1012
1013
return YES;
1014
}
1015
1016
1017
1018
eight_bits
1019
next_byte(VOID)
1020
{
1021
eight_bits a0;
1022
sixteen_bits a;
1023
static boolean ended_module= NO;
1024
long cur_val0;
1025
1026
1027
if(saved_token)
1028
{
1029
saved_token= NO;
1030
return last_a;
1031
}
1032
1033
cur_val0= cur_val;
1034
1035
WHILE()
1036
{
1037
if(DONE_LEVEL)
1038
{
1039
if(!ended_module)
1040
{
1041
cur_val= -(long)cur_mod;
1042
if(cur_val!=ignore)OUT_CHAR(module_number);
1043
ended_module= YES;
1044
}
1045
1046
if(!pop_level())
1047
{
1048
a0= ignore;
1049
break;
1050
}
1051
1052
ended_module= NO;
1053
}
1054
1055
if(TOKEN1(a0= *cur_byte++))
1056
{
1057
if(a0==ignore&&!in_string)
1058
continue;
1059
1060
if(rlevel>0&&a0==begin_language)
1061
{
1062
cur_byte++;
1063
continue;
1064
}
1065
1066
last_bytes= 1;
1067
break;
1068
}
1069
1070
1071
{
1072
a= IDENTIFIER(a0,last_a= *cur_byte++);
1073
last_bytes= 2;
1074
1075
1076
switch(a/MODULE_NAME)
1077
{
1078
case 0:
1079
1080
if(is_deferred(a))continue;
1081
1082
1083
if(!mac_protected&&
1084
(macro_text= (text_pointer)mac_lookup(a))!=NULL)
1085
{
1086
eight_bits HUGE*p;
1087
long cur_val0= cur_val;
1088
1089
cur_val= a;
1090
p= xmacro(macro_text,&cur_byte,&cur_end,YES,
1091
macrobuf);
1092
cur_val= cur_val0;
1093
push_level(NULL,p,mp);
1094
break;
1095
}
1096
else if(!balanced&&language==RATFOR&&
1097
(a==id_function||a==id_program||a==id_subroutine))
1098
{
1099
1100
RAT_error(ERROR,OC("Inserted missing '%c' at beginning of function"),1,XCHR(cur_delim));
1101
cur_byte-= 2;
1102
saved_token= NO;
1103
a0= cur_delim;
1104
goto return_next_byte;
1105
}
1106
else
1107
{
1108
saved_token= YES;
1109
goto return_next_byte;
1110
}
1111
1112
case 1:
1113
x_mod_a(a);
1114
break;
1115
1116
default:
1117
cur_val= a-MODULE_NUM;
1118
if(cur_val>UNNAMED_MODULE)cur_mod= (sixteen_bits)cur_val;
1119
OUT_CHAR(module_number);
1120
}
1121
}
1122
1123
1124
}
1125
1126
return_next_byte:
1127
cur_val= cur_val0;
1128
return a0;
1129
}
1130
1131
1132
1133
SRTN
1134
skip_newlines FCN((save_comments))
1135
boolean save_comments C1("")
1136
{
1137
eight_bits a;
1138
1139
if(save_comments)
1140
{
1141
cmnt_pos= cmnt_buf= GET_MEM("cmnt_buf",SAVE8,eight_bits);
1142
cmnt_buf_end= cmnt_buf+SAVE8;
1143
}
1144
1145
while((a= copy_comment(save_comments))==012);
1146
1147
if(a==ignore)
1148
output_ended(OC("while skipping newlines"),0);
1149
1150
BACK_UP
1151
}
1152
1153
1154
eight_bits
1155
copy_comment FCN((save_comments))
1156
boolean save_comments C1("")
1157
{
1158
eight_bits a;
1159
1160
WHILE()
1161
if((a= next_byte())!=stringg)return a;
1162
1163
else if(save_comments)
1164
{
1165
1166
*cmnt_pos++= a;
1167
in_string= YES;
1168
while((a= next_byte())!=stringg)
1169
{
1170
if(cmnt_pos==cmnt_buf_end)
1171
resize(&cmnt_buf,SAVE8,&cmnt_pos,&cmnt_buf_end);
1172
1173
*cmnt_pos++= a;
1174
}
1175
*cmnt_pos++= a;
1176
in_string= NO;
1177
}
1178
else
1179
{
1180
OUT_CHAR(stringg);
1181
while((a= get_output())!=stringg);
1182
}
1183
1184
DUMMY_RETURN(ignore);
1185
}
1186
1187
1188
1189
SRTN
1190
flush_comments(VOID)
1191
{
1192
eight_bits*p;
1193
1194
if(!cmnt_buf)return;
1195
1196
for(p= cmnt_buf;p<cmnt_pos;p++)out_char(*p);
1197
if(cmnt_pos>cmnt_buf)NL;
1198
1199
FREE_MEM(cmnt_buf,"cmnt_buf",SAVE8,eight_bits);
1200
cmnt_buf= cmnt_buf_end= cmnt_pos= NULL;
1201
}
1202
1203
1204
1205
SRTN
1206
id0 FCN((cur_val))
1207
sixteen_bits cur_val C1("Token to print out.")
1208
{
1209
if(cur_val==ignore)return;
1210
1211
if(out_state==NUM_OR_ID)C_putc(' ');
1212
1213
out_ptrunc(cur_val);
1214
1215
out_state= NUM_OR_ID;
1216
}
1217
1218
1219
1220
int
1221
save_lbls FCN((cmd,top0,next0,break0,n_used))
1222
CMD cmd C0("The current command.")
1223
STMT_LBL top0 C0("Label number for top of block.")
1224
STMT_LBL next0 C0("Go here on |next|.")
1225
STMT_LBL break0 C0("Go here on |break|.")
1226
int n_used C1("Number of labels used in this expansion.")
1227
{
1228
1229
if(++wlevel>=(int)max_lbls)OVERFLW("stmt labels","");
1230
1231
current_cmd= cmd;
1232
s_top= top0;
1233
s_next= next0;
1234
s_break= break0;
1235
was_break= was_next= NO;
1236
1237
max_stmt+= n_used;
1238
1239
1240
s_case= s_default= 0;
1241
icase= ignore;
1242
1243
return wlevel;
1244
}
1245
1246
1247
1248
SRTN
1249
out_label FCN((suppress_0,stmt_num))
1250
boolean suppress_0 C0("Suppress if zero?")
1251
STMT_LBL stmt_num C1("Statement number to print.")
1252
{
1253
outer_char temp[N_IDBUF];
1254
outer_char*p;
1255
1256
if(stmt_num==(STMT_LBL)0&&suppress_0)return;
1257
1258
1259
if(stmt_num>(STMT_LBL)99999)
1260
{
1261
stmt_num= (STMT_LBL)99999;
1262
1263
RAT_error(WARNING,OC("Automatic statement number out of bounds; %ld assumed"),1,stmt_num);
1264
}
1265
1266
1267
if(
1268
nsprintf(temp,OC("%ld"),1,stmt_num)>=(int)(N_IDBUF))OVERFLW("temp","");
1269
1270
OUT_CHAR(constant);
1271
for(p= temp;*p;p++)
1272
OUT_CHAR(XORD(*p));
1273
OUT_CHAR(constant);
1274
}
1275
1276
1277
1278
SRTN
1279
copyd FCN((to_memory,xpn_cases,l,r,semi_allowed))
1280
boolean to_memory C0("To memory?")
1281
boolean xpn_cases C0("Expand |case| statements?")
1282
ASCII l C0("Left-hand delimiter.")
1283
ASCII r C0("Right-hand delimiter.")
1284
boolean semi_allowed C1("Is a semicolon allowed in the text to be \
1285
copied?")
1286
{
1287
int bal,bal0[BLEVELS];
1288
LINE_NUMBER starting_line;
1289
eight_bits(*output_rtn)(VOID);
1290
sixteen_bits a,last_token;
1291
sixteen_bits l0= ignore,r0= ignore;
1292
boolean found_semi;
1293
boolean balanced0= balanced;
1294
ASCII cur_delim0= cur_delim;
1295
1296
1297
1298
switch(l)
1299
{
1300
case 0173:
1301
l0= 050;r0= 051;
1302
break;
1303
1304
case 050:
1305
l0= 0173;r0= 0175;
1306
break;
1307
1308
default:
1309
1310
confusion(OC("copyd"),OC("Invalid left delimiter 0x%x"),l);
1311
}
1312
1313
1314
1315
if(l==0173&&xpn_cases)
1316
{
1317
if(DONE_LEVEL&&!pop_level())
1318
output_ended(OC("after '{'"),0);
1319
1320
bal0[bal= 1]= 0;
1321
}
1322
else
1323
{
1324
if((ASCII)(next_byte())!=l)
1325
{
1326
1327
RAT_error(ERROR,OC("Missing opening delimiter '%c'; \
1328
text not copied"),1,XCHR(l));
1329
return;
1330
}
1331
1332
1333
BACK_UP
1334
bal0[bal= 0]= 0;
1335
}
1336
1337
starting_line= OUTPUT_LINE;
1338
1339
1340
1341
output_rtn= to_memory?next_byte:get_output;
1342
1343
1344
1345
last_token= ignore;
1346
found_semi= NO;
1347
1348
1349
balanced= NO;
1350
cur_delim= r;
1351
1352
WHILE()
1353
{
1354
a= (sixteen_bits)(*output_rtn)();
1355
1356
1357
if(to_memory&&a==(sixteen_bits)stringg)
1358
in_string= BOOLEAN(!in_string);
1359
1360
if(!in_string)
1361
{
1362
if(a==ignore)
1363
output_ended(OC("while scanning for '%c'. Scan began \
1364
with delimiter '%c' at line %u"),3,XCHR(r),XCHR(l),starting_line);
1365
1366
if(a==(sixteen_bits)l)bal0[++bal]= 0;
1367
else if(a==(sixteen_bits)r)
1368
{
1369
if(bal<=0)
1370
{
1371
if(!to_memory)out_pos--;
1372
unmatched(l,r);
1373
continue;
1374
}
1375
else
1376
{
1377
if(bal0[bal]!=0)
1378
{
1379
inserted(bal0[bal],l0,r0,l,bal);
1380
1381
while(bal0[bal]--)
1382
if(to_memory)SAVE_IN_MEM(r0)
1383
else OUT_CHAR(r0);
1384
}
1385
1386
if(--bal==0)
1387
{
1388
if(semi_allowed&&last_token&&last_token!=073)
1389
{
1390
1391
RAT_error(WARNING,OC("Supplied missing ';' before \
1392
delimiter '%c'"),1,r);
1393
1394
if(to_memory)SAVE_IN_MEM(073)
1395
else OUT_CHAR(073);
1396
}
1397
1398
if(to_memory)SAVE_IN_MEM(r)
1399
1400
1401
balanced= YES;
1402
cur_delim= '\0';
1403
break;
1404
}
1405
}
1406
}
1407
1408
1409
else if(a==l0)bal0[bal]++;
1410
else if(a==r0)
1411
{
1412
if(bal0[bal]<=0)
1413
{
1414
if(!to_memory)out_pos--;
1415
unmatched((ASCII)l0,(ASCII)r0);
1416
continue;
1417
}
1418
else bal0[bal]--;
1419
}
1420
1421
1422
else if(a!=stringg)
1423
{
1424
if(a==073)
1425
if(semi_allowed)found_semi= YES;
1426
else
1427
RAT_error(ERROR,OC("Spurious semicolon"),0);
1428
1429
if(chk_stmts)
1430
if(!to_memory&&a==id_keyword)last_token= ignore;
1431
else last_token= a;
1432
1433
}
1434
}
1435
1436
1437
1438
if(to_memory)
1439
{
1440
if(TOKEN1(a))
1441
{
1442
SAVE_IN_MEM(a)
1443
1444
switch(a)
1445
{
1446
case dot_const:
1447
case begin_language:
1448
SAVE_IN_MEM(*cur_byte++);
1449
break;
1450
1451
case new_output_file:
1452
1453
RAT_error(ERROR,OC("@o command not allowed inside switch"),0);
1454
}
1455
}
1456
else
1457
{
1458
if(xpn_cases)
1459
1460
{
1461
eight_bits a0,a1;
1462
1463
1464
a= IDENTIFIER(a0= (eight_bits)a,a1= next_byte());
1465
1466
if(a==id_switch)
1467
{
1468
SAVE_16;
1469
copyd(TO_MEMORY,DONT_XPN_CASES,050,051,NO);
1470
skip_newlines(COPY_COMMENTS);
1471
copyd(TO_MEMORY,DONT_XPN_CASES,0173,0175,YES);
1472
}
1473
else if(a==id_case)x_case();
1474
else if(a==id_default)x_default();
1475
else SAVE_16;
1476
}
1477
1478
1479
else
1480
{
1481
SAVE_IN_MEM(a)
1482
SAVE_IN_MEM(next_byte())
1483
}
1484
}
1485
}
1486
1487
1488
}
1489
1490
balanced= balanced0;
1491
cur_delim= cur_delim0;
1492
}
1493
1494
1495
1496
SRTN
1497
cp_fcn_body(VOID)
1498
{
1499
brace_level++;
1500
copyd(TO_OUTPUT,XPN_CASES,0173,0175,YES);
1501
1502
if(--brace_level==0)
1503
{
1504
END;
1505
cur_fcn= NO_FCN;
1506
rlevel--;
1507
}
1508
}
1509
1510
1511
1512
SRTN
1513
stmt FCN((to_memory,brace_only))
1514
boolean to_memory C0("")
1515
boolean brace_only C1("Is only a left brace allowed next?")
1516
{
1517
sixteen_bits a;
1518
1519
EAT_AUTO_SEMI;
1520
skip_newlines(COPY_COMMENTS);
1521
1522
if((a= next_byte())!=0173)
1523
{
1524
if(a==ignore)
1525
output_ended(OC("at beginning of statement"),0);
1526
1527
1528
if(brace_only)
1529
{
1530
1531
RAT_error(WARNING,OC("Inserted '{'"),0);
1532
BACK_UP
1533
copyd(to_memory,XPN_CASES,0173,0175,YES);
1534
return;
1535
}
1536
1537
if(TOKEN1(a))
1538
{
1539
BACK_UP
1540
x_stmt();
1541
}
1542
else
1543
{
1544
1545
SPEC HUGE*s;
1546
1547
a= IDENTIFIER(a,next_byte());
1548
1549
for(s= spec_tokens;s->len!=0;s++)
1550
if(a==*s->pid&&s->expand!=NULL)
1551
{
1552
(*s->expand)();
1553
return;
1554
}
1555
BACK_UP
1556
x_stmt();
1557
}
1558
}
1559
else copyd(to_memory,XPN_CASES,0173,0175,YES);
1560
1561
}
1562
1563
1564
1565
1566
SRTN
1567
x_stmt(VOID)
1568
{
1569
eight_bits a;
1570
1571
WHILE()
1572
{
1573
if((a= get_output())==ignore)
1574
output_ended(OC("during scan of simple \
1575
statement "),0);
1576
1577
if(a==073&&!in_string)break;
1578
}
1579
1580
1581
if((a= next_byte())!=stringg){BACK_UP return;}
1582
1583
if(*cur_byte!=012){BACK_UP return;}
1584
1585
1586
OUT_CHAR(a);
1587
while((a= get_output())!=stringg);
1588
}
1589
1590
1591
1592
1593
eight_bits HUGE*
1594
save_out FCN((pp,nmax,r_before,r_after))
1595
eight_bits HUGE**pp C0("Address of pointer to buffer where result is \
1596
saved.")
1597
int nmax C0("Length of above buffer.")
1598
eight_bits r_before C0("Stop before here.")
1599
eight_bits r_after C1("Stop after here.")
1600
{
1601
eight_bits a,l;
1602
eight_bits HUGE*p,HUGE*p_end;
1603
LINE_NUMBER starting_line;
1604
int bal,bal0[BLEVELS];
1605
1606
1607
if(!(*pp))
1608
*pp= GET_MEM("*pp",nmax,eight_bits);
1609
1610
p= *pp;
1611
p_end= p+nmax-1;
1612
1613
1614
1615
switch(r_after)
1616
{
1617
case 051:
1618
l= (eight_bits)050;
1619
bal= 1;
1620
break;
1621
1622
case 0175:
1623
l= (eight_bits)0173;
1624
bal= 1;
1625
break;
1626
1627
default:
1628
l= '\0';
1629
bal= 0;
1630
break;
1631
}
1632
1633
bal0[bal]= 0;
1634
1635
starting_line= OUTPUT_LINE;
1636
1637
1638
if(in_string)
1639
1640
confusion(OC("save_out"),OC("Shouldn't be inside string here"));
1641
1642
WHILE()
1643
{
1644
if(p>=p_end)resize(pp,nmax,&p,&p_end);
1645
1646
1647
if(TOKEN1(a= next_byte()))
1648
{
1649
if(!in_string)
1650
1651
{
1652
if(a==ignore)
1653
output_ended(OC("while scanning from line %u \
1654
for delimiter (r_before = '%c', r_after = '%c')"),3,starting_line,XCHR(r_before),XCHR(r_after));
1655
1656
if(a==l)bal0[++bal]= 0;
1657
else if(a==r_after&&r_after!=NOT_AFTER)
1658
{
1659
if(l&&bal<=0)
1660
{
1661
p--;
1662
unmatched(l,r_after);
1663
continue;
1664
}
1665
else
1666
{
1667
if(bal0[bal]!=0)
1668
{
1669
inserted(bal0[bal],0173,0175,l,bal);
1670
1671
while(bal0[bal]--)
1672
{
1673
*p++= 0175;
1674
if(p>=p_end)resize(pp,nmax,&p,&p_end);
1675
}
1676
}
1677
1678
if(l)bal--;
1679
if(bal==0)
1680
{
1681
*p= '\0';
1682
return p;
1683
}
1684
}
1685
}
1686
1687
1688
else if(a==r_before&&r_before!=NOT_BEFORE)
1689
{
1690
BACK_UP;
1691
*p= '\0';
1692
return p;
1693
}
1694
else if(a==0173)bal0[bal]++;
1695
else if(a==0175)
1696
{
1697
if(bal0[bal]<=0)
1698
{
1699
p--;
1700
unmatched(0173,0175);
1701
continue;
1702
}
1703
else bal0[bal]--;
1704
}
1705
1706
1707
}
1708
1709
1710
1711
1712
{
1713
*p++= a;
1714
1715
switch(a)
1716
{
1717
case stringg:
1718
in_string= BOOLEAN(!in_string);
1719
break;
1720
1721
case dot_const:
1722
case begin_language:
1723
*p++= *cur_byte++;
1724
break;
1725
}
1726
}
1727
1728
1729
}
1730
else
1731
{
1732
*p++= a;
1733
*p++= next_byte();
1734
}
1735
}
1736
1737
DUMMY_RETURN(NULL);
1738
}
1739
1740
1741
1742
1743
outer_char*
1744
qdelim FCN((delim))
1745
ASCII delim C1("")
1746
{
1747
static outer_char q0[4];
1748
1749
sprintf((char*)q0,delim?"'%c'":"?",XCHR(delim));
1750
return q0;
1751
}
1752
1753
1754
1755
SRTN
1756
resize FCN((pp,nmax,pq,pp_end))
1757
eight_bits HUGE**pp C0("Addr of ptr to beginning of buffer")
1758
int nmax C0("Resizing increment")
1759
eight_bits HUGE**pq C0("Address of current pointer")
1760
eight_bits HUGE**pp_end C1("Addr of ptr to end of buffer")
1761
{
1762
int old_len= PTR_DIFF(int,*pq,*pp);
1763
int new_len= old_len+nmax;
1764
1765
*pp= (eight_bits HUGE*)REALLOC(*pp,
1766
new_len*sizeof(eight_bits),
1767
old_len*sizeof(eight_bits));
1768
*pq= *pp+old_len;
1769
*pp_end= *pp+new_len-1;
1770
}
1771
1772
1773
#endif
1774
1775
#if(part != 1)
1776
1777
1778
SRTN
1779
alloc_Rat(VOID)
1780
{
1781
1782
1783
ALLOC(LBL,lbl,"lb",max_lbls,0);
1784
lbl_end= lbl+max_lbls;
1785
1786
1787
1788
ALLOC(outer_char,cmd_fmt,"cf",cmd_fsize,0);
1789
ALLOC(ASCII,cmd_msg,"cg",cmd_size,0);
1790
cmd_end= cmd_msg+cmd_size;
1791
1792
1793
1794
begun= GET_MEM("begun",max_lbls,BEGUN);
1795
1796
1797
}
1798
1799
1800
1801
SRTN
1802
out_cmd FCN(VA_ALIST((emit_continue,abbrev,beginning,fmt0,n VA_ARGS)))
1803
VA_DCL(
1804
boolean emit_continue C0("Put a |continue| in case of label.")
1805
outer_char abbrev C0("Abbreviation of command.")
1806
CONST outer_char beginning[]C0("Beginning part of message.")
1807
CONST outer_char*fmt0 C0("Format of the message.")
1808
int n C2("Number of arguments to message."))
1809
{
1810
VA_LIST(arg_ptr)
1811
#if(NUM_VA_ARGS == 1)
1812
boolean emit_continue;
1813
char abbrev;
1814
CONST outer_char*beginning;
1815
CONST outer_char*fmt0;
1816
int n;
1817
#endif
1818
1819
VA_START(arg_ptr,n);
1820
1821
#if(NUM_VA_ARGS == 1)
1822
emit_continue= va_arg(arg_ptr,boolean);
1823
abbrev= va_arg(arg_ptr,char);
1824
beginning= va_arg(arg_ptr,char*);
1825
fmt0= va_arg(arg_ptr,char*);
1826
va_arg(arg_ptr,int);
1827
#endif
1828
1829
1830
{
1831
static outer_char brkset[3]= "*?";
1832
1833
char*strpbrk();
1834
boolean found_abbrev;
1835
1836
1837
brkset[1]= abbrev;
1838
found_abbrev= BOOLEAN(STRPBRK(abbrev_cmds,brkset)!=NULL);
1839
1840
if(suppress_cmds){if(found_abbrev)return;}
1841
else{if(!found_abbrev)return;}
1842
}
1843
1844
1845
1846
if(emit_continue)
1847
{
1848
CONTINUE(ignore);
1849
}
1850
1851
1852
1853
if(
1854
nsprintf(cmd_fmt,OC("--- %s \"%s%s\" ---"),3,beginning,cmd_name(begun[rlevel-1].cmd),fmt0)>=(int)(cmd_fsize))OVERFLW("cmd_fmt","");
1855
1856
1857
{
1858
outer_char HUGE*p;
1859
ASCII HUGE*q;
1860
eight_bits HUGE*s,HUGE*s1;
1861
1862
1863
p= cmd_fmt;
1864
q= cmd_msg;
1865
1866
while(*p)
1867
{
1868
if(q>=cmd_end)
1869
OVERFLW("cmd_msg","cg");
1870
1871
if(*p=='%'&&*(p+1)=='s')
1872
{
1873
p+= 2;
1874
1875
1876
1877
1878
1879
1880
1881
s= va_arg(arg_ptr,eight_bits*);
1882
s1= va_arg(arg_ptr,eight_bits*);
1883
1884
while(s<s1)
1885
*q++= *s++;
1886
}
1887
else
1888
*q++= XORD(*p++);
1889
}
1890
1891
va_end(arg_ptr);
1892
1893
1894
OUT_MSG(cmd_msg,q);
1895
}
1896
1897
;
1898
1899
if(Fortran88&&symbolic_label)
1900
{
1901
id0(symbolic_label);OUT_CHAR(072);
1902
}
1903
}
1904
1905
1906
1907
SRTN
1908
expanding FCN((cmd))
1909
CMD cmd C1("Type of identifier being expanded.")
1910
{
1911
if(rlevel>=(int)max_lbls)OVERFLW("Nesting","");
1912
1913
begun[rlevel].cmd= cmd;
1914
begun[rlevel].name= rlevel?cur_fcn:NO_FCN;
1915
begun[rlevel].symbolic= sym_label;
1916
begun[rlevel].function= BOOLEAN(CHOICE(rlevel,is_function,NO));
1917
begun[rlevel].line= OUTPUT_LINE;
1918
begun[rlevel].level= wlevel;
1919
rlevel++;
1920
}
1921
1922
1923
1924
X_FCN
1925
x_while(VOID)
1926
{
1927
eight_bits HUGE*a= NULL,HUGE*pa;
1928
1929
expanding(while_CMD);
1930
save_lbls(while_CMD,max_stmt,max_stmt,max_stmt+1,2);
1931
1932
1933
1934
{
1935
eight_bits c;
1936
1937
if((c= next_byte())!='(')
1938
{
1939
didnt_expand('(',c,"while");
1940
return;
1941
}
1942
};
1943
pa= SAVE_AFTER(&a,SAVE8,051);
1944
1945
1946
out_cmd(YES,'w',OC(""),OC("(%s)"),2,a,pa);
1947
1948
if(Fortran88)
1949
{
1950
id0(id__DO);id0(id__WHILE);LP;copy_out(a,pa,!macro);RP;
1951
NL;
1952
}
1953
else
1954
{
1955
IF(s_top);LP;copy_out(a,pa,!macro);RP;THEN;
1956
}
1957
INDENT;
1958
stmt(TO_OUTPUT,0);
1959
if(!Fortran88){GOTO(s_top);}
1960
OUTDENT;
1961
1962
if(Fortran88){END_DO;}
1963
else
1964
{
1965
ENDIF;
1966
if(was_break){CONTINUE(s_break);}
1967
}
1968
1969
wlevel--;
1970
rlevel--;
1971
FREE_MEM(a,"while:a",SAVE8,eight_bits);
1972
}
1973
1974
1975
1976
X_FCN
1977
x_break(VOID)
1978
{
1979
sixteen_bits a;
1980
1981
1982
if(wlevel==0&&switch_level==0)
1983
{
1984
NOT_LOOP("break"," or \"switch\"");
1985
COPY_TO(073);
1986
return;
1987
}
1988
1989
expanding(break_CMD);
1990
1991
was_break= YES;
1992
1993
1994
1995
out_cmd(YES,'b',OC(""),OC(""),0);
1996
1997
if(Fortran88&&do_or_while)
1998
{
1999
id0(id__EXIT);
2000
2001
if(TOKEN1(a= next_byte()))BACK_UP
2002
else id0(IDENTIFIER(a,next_byte()));
2003
2004
NL;
2005
2006
}
2007
else{GOTO(s_break);}
2008
2009
char_after(';');
2010
rlevel--;
2011
}
2012
2013
2014
2015
SRTN
2016
not_loop FCN((id,msg))
2017
CONST outer_char id[]C0("Errant identifier name.")
2018
CONST outer_char msg[]C1("Error message.")
2019
{
2020
2021
RAT_error(WARNING,OC("Misplaced keyword: \
2022
\"%s\" must appear inside loop%s; command ignored"),2,id,msg);
2023
}
2024
2025
2026
2027
X_FCN
2028
x_next(VOID)
2029
{
2030
sixteen_bits a;
2031
2032
2033
if(wlevel==0)
2034
{
2035
NOT_LOOP("next","");
2036
COPY_TO(073);
2037
return;
2038
}
2039
2040
expanding(next_CMD);
2041
2042
was_next= YES;
2043
2044
out_cmd(YES,'n',OC(""),OC(""),0);
2045
2046
if(Fortran88&&do_or_while)
2047
{
2048
id0(id__CYCLE);
2049
2050
if(TOKEN1(a= next_byte()))BACK_UP
2051
else id0(IDENTIFIER(a,next_byte()));
2052
2053
NL;
2054
}
2055
else{GOTO(s_next);}
2056
2057
char_after(';');
2058
rlevel--;
2059
}
2060
2061
2062
2063
X_FCN
2064
x_repeat(VOID)
2065
{
2066
sixteen_bits a;
2067
eight_bits HUGE*u= NULL,HUGE*pu;
2068
2069
expanding(repeat_CMD);
2070
save_lbls(repeat_CMD,max_stmt,max_stmt+1,max_stmt+2,3);
2071
2072
2073
out_cmd(YES,'p',OC(""),OC(""),0);
2074
2075
CONTINUE(s_top);
2076
INDENT;
2077
stmt(TO_OUTPUT,0);
2078
OUTDENT;
2079
if(was_next)LABEL(s_next);
2080
2081
skip_newlines(SAVE_COMMENTS);
2082
2083
2084
if(TOKEN1(a= next_byte()))BACK_UP
2085
else
2086
{
2087
a= IDENTIFIER(a,next_byte());
2088
2089
if(a==id_until)
2090
{
2091
flush_comments();
2092
rlevel--;
2093
expanding(until_CMD);
2094
2095
2096
{
2097
eight_bits c;
2098
2099
if((c= next_byte())!='(')
2100
{
2101
didnt_expand('(',c,"until");
2102
return;
2103
}
2104
};
2105
pu= SAVE_AFTER(&u,SAVE8,051);
2106
2107
out_cmd(NO,'p',OC(""),OC("(%s)"),2,u,pu);
2108
2109
IF(ignore);LP;NOT;
2110
LP;copy_out(u,pu,!macro);RP;
2111
RP;
2112
FREE_MEM(u,"repeat:u",SAVE8,eight_bits);
2113
}
2114
else BACK_UP
2115
}
2116
2117
GOTO(s_top);
2118
flush_comments();
2119
2120
if(was_break){CONTINUE(s_break);}
2121
2122
wlevel--;
2123
rlevel--;
2124
}
2125
2126
2127
X_FCN
2128
x_do(VOID)
2129
{
2130
eight_bits b;
2131
sixteen_bits a;
2132
2133
2134
b= next_byte();BACK_UP
2135
2136
2137
if(b==constant)
2138
{
2139
id0(id_do);
2140
return;
2141
}
2142
2143
2144
expanding(do_CMD);
2145
save_lbls(do_CMD,0L,max_stmt,max_stmt+1,2);
2146
2147
2148
out_cmd(YES,'d',OC(""),OC(""),0);
2149
2150
2151
2152
if(!TOKEN1(a= next_byte()))
2153
a= IDENTIFIER(a,next_byte());
2154
2155
BACK_UP
2156
2157
if(!(a==id_while))
2158
{
2159
id0(id__DO);if(!Fortran88)LABEL(s_next);COPY_2TO(0173,073);NL;
2160
INDENT;
2161
stmt(TO_OUTPUT,0);
2162
OUTDENT;
2163
if(Fortran88)
2164
{
2165
id0(id__END);id0(id__DO);
2166
if(symbolic_label)id0(symbolic_label);
2167
NL;
2168
}
2169
else
2170
{
2171
CONTINUE(s_next);
2172
if(was_break){CONTINUE(s_break);}
2173
}
2174
}
2175
2176
wlevel--;
2177
rlevel--;
2178
}
2179
2180
2181
2182
X_FCN
2183
x_for(VOID)
2184
{
2185
eight_bits HUGE*a= NULL,HUGE*b= NULL,HUGE*c= NULL,
2186
HUGE*pa,HUGE*pb,HUGE*pc;
2187
2188
expanding(for_CMD);
2189
save_lbls(for_CMD,max_stmt,max_stmt+1,max_stmt+2,3);
2190
2191
2192
2193
{
2194
eight_bits c;
2195
2196
if((c= next_byte())!='(')
2197
{
2198
didnt_expand('(',c,"for");
2199
return;
2200
}
2201
};
2202
pa= SAVE_AFTER(&a,SAVE8,073);
2203
pb= SAVE_AFTER(&b,SAVE8,073);
2204
pc= SAVE_AFTER(&c,SAVE8,051);
2205
2206
2207
out_cmd(YES,'f',OC(""),OC("(%s;%s;%s)"),6,a,pa,b,pb,c,pc);
2208
2209
2210
if(pa>a){copy_out(a,pa,!macro);NL;}
2211
2212
2213
if(pb>b)
2214
{IF(s_top);LP;copy_out(b,pb,!macro);RP;THEN;}
2215
else{CONTINUE(s_top);}
2216
2217
2218
INDENT;
2219
stmt(TO_OUTPUT,0);
2220
2221
2222
if(was_next){CONTINUE(s_next);}
2223
if(pc>c)
2224
{
2225
2226
out_cmd(NO,'f',OC("Reinitialization of"),OC("(%s;%s;%s)"),6,a,pa,b,pb,c,pc);
2227
copy_out(c,pc,!macro);NL;
2228
}
2229
GOTO(s_top);
2230
OUTDENT;
2231
if(pb>b){ENDIF;}
2232
if(was_break){CONTINUE(s_break);}
2233
wlevel--;
2234
rlevel--;
2235
FREE_MEM(a,"for:a",SAVE8,eight_bits);
2236
FREE_MEM(b,"for:b",SAVE8,eight_bits);
2237
FREE_MEM(c,"for:c",SAVE8,eight_bits);
2238
}
2239
2240
2241
2242
X_FCN
2243
x_if(VOID)
2244
{
2245
expanding(if_CMD);
2246
2247
out_cmd(YES,'i',OC(""),OC(""),0);
2248
2249
xpn_body(id__IF,YES,id__THEN);
2250
2251
2252
WHILE()
2253
if(!
2254
xpn_else(id_if,id_elseif,id__IF,YES,id__THEN))break;
2255
2256
ENDIF;
2257
flush_comments();
2258
rlevel--;
2259
}
2260
2261
2262
2263
2264
SRTN
2265
xpn_body FCN((token1,scan_parens,token2))
2266
sixteen_bits token1 C0("")
2267
boolean scan_parens C0("")
2268
sixteen_bits token2 C1("")
2269
{
2270
LABEL(ignore);id0(token1);
2271
2272
if(scan_parens)PARENS;
2273
if(token2)id0(token2);
2274
NL;
2275
2276
INDENT;
2277
stmt(TO_OUTPUT,0);
2278
OUTDENT;
2279
}
2280
2281
2282
2283
boolean
2284
xpn_else FCN((id_x,id_else_x,token1,scan_parens,token2))
2285
sixteen_bits id_x C0("")
2286
sixteen_bits id_else_x C0("")
2287
sixteen_bits token1 C0("")
2288
boolean scan_parens C0("")
2289
sixteen_bits token2 C1("")
2290
{
2291
sixteen_bits a;
2292
2293
skip_newlines(SAVE_COMMENTS);
2294
2295
if(TOKEN1(a= next_byte()))
2296
{
2297
BACK_UP
2298
return NO;
2299
}
2300
else
2301
{
2302
a= IDENTIFIER(a,next_byte());
2303
2304
if(a==id_else_x)
2305
{
2306
flush_comments();
2307
ELSE;
2308
xpn_body(token1,scan_parens,token2);
2309
return YES;
2310
}
2311
2312
if(a!=id_else)
2313
{
2314
BACK_UP
2315
return NO;
2316
}
2317
else
2318
{
2319
flush_comments();
2320
ELSE;
2321
2322
if(TOKEN1(a= next_byte()))BACK_UP
2323
else
2324
{
2325
a= IDENTIFIER(a,next_byte());
2326
2327
if(a==id_x)
2328
{
2329
xpn_body(token1,scan_parens,token2);
2330
return YES;
2331
}
2332
else BACK_UP
2333
}
2334
2335
if(out_pos>rst_pos)NL;
2336
2337
INDENT;
2338
stmt(TO_OUTPUT,0);
2339
OUTDENT;
2340
return NO;
2341
}
2342
}
2343
}
2344
2345
2346
2347
X_FCN
2348
x_else(VOID)
2349
{
2350
UNEXPECTED("else");
2351
}
2352
2353
X_FCN
2354
x_els_if(VOID)
2355
{
2356
UNEXPECTED("elseif");
2357
}
2358
2359
2360
2361
X_FCN
2362
x_end(VOID)
2363
{
2364
UNEXPECTED("end");
2365
}
2366
2367
X_FCN
2368
x_en_if(VOID)
2369
{
2370
UNEXPECTED("endif");
2371
}
2372
2373
X_FCN
2374
x_en_interface(VOID)
2375
{
2376
UNEXPECTED("endinterface");
2377
}
2378
2379
X_FCN
2380
x_en_module(VOID)
2381
{
2382
UNEXPECTED("endmodule");
2383
}
2384
2385
X_FCN
2386
x_en_select(VOID)
2387
{
2388
UNEXPECTED("endselect");
2389
}
2390
2391
X_FCN
2392
x_en_type(VOID)
2393
{
2394
UNEXPECTED("endtype");
2395
}
2396
2397
X_FCN
2398
x_en_where(VOID)
2399
{
2400
UNEXPECTED("endwhere");
2401
}
2402
2403
X_FCN
2404
x_procedure(VOID)
2405
{
2406
UNEXPECTED("procedure");
2407
}
2408
2409
X_FCN
2410
x_then(VOID)
2411
{
2412
UNEXPECTED("then");
2413
}
2414
2415
X_FCN
2416
x_until(VOID)
2417
{
2418
UNEXPECTED("until");
2419
}
2420
2421
2422
2423
X_FCN
2424
x_where(VOID)
2425
{
2426
expanding(where_CMD);
2427
2428
out_cmd(YES,'h',OC(""),OC(""),0);
2429
2430
xpn_body(id__WHERE,YES,id__ignore);
2431
2432
xpn_else(id_where,id_elsewhere,id__WHERE,NO,id__ignore);
2433
2434
ENDWHERE;
2435
rlevel--;
2436
}
2437
2438
2439
2440
SRTN
2441
unexpected FCN((id))
2442
CONST outer_char id[]C1("Error message.")
2443
{
2444
2445
RAT_error(WARNING,OC("Unexpected keyword \"%s\" ignored"),1,id);
2446
}
2447
2448
2449
2450
X_FCN
2451
x_switch(VOID)
2452
{
2453
eight_bits HUGE*a= NULL,HUGE*pa;
2454
outer_char temp[N_IDBUF];
2455
unsigned short k;
2456
boolean computed_goto= NO;
2457
CASE_TYPE cmin= 0,cmax;
2458
CASE_TYPE mcases= 0;
2459
unsigned short num_cases;
2460
2461
expanding(switch_CMD);
2462
2463
if(switches==NULL)switches= GET_MEM("switches",NSWITCHES,SWITCH);
2464
2465
++switch_level;
2466
if(cur_switch.cases==NULL)
2467
cur_switch.cases= GET_MEM("cur_switch.cases",NCASES,CASE);
2468
cur_switch.ncases= 0;
2469
cur_switch.has_default= NO;
2470
2471
2472
2473
cur_case= &cur_switch.cases[0];
2474
cur_case->txt.next= cur_case->txt.start=
2475
GET_MEM("cur_case->txt.start",BIG_SAVE8,eight_bits);
2476
cur_case->txt.end= cur_case->txt.start+BIG_SAVE8;
2477
2478
save_lbls(switch_CMD,0L,s_next,max_stmt,1);
2479
2480
2481
2482
{
2483
eight_bits c;
2484
2485
if((c= next_byte())!='(')
2486
{
2487
didnt_expand('(',c,"switch");
2488
return;
2489
}
2490
};
2491
pa= SAVE_AFTER(&a,SAVE8,051);
2492
2493
2494
out_cmd(YES,'s',OC(""),OC("(%s)"),2,a,pa);
2495
2496
if(Fortran88)
2497
{
2498
id0(id__SELECT);id0(id__CASE);LP;copy_out(a,pa,!macro);RP;NL;
2499
}
2500
INDENT;
2501
stmt(TO_MEMORY,BRACE_ONLY);
2502
2503
if(Fortran88)
2504
{
2505
computed_goto= NO;
2506
}
2507
else
2508
{
2509
unsigned short k;
2510
VAL val;
2511
2512
2513
2514
cmin= LONG_MAX;
2515
cmax= LONG_MIN+1;
2516
2517
for(k= 1;k<=cur_switch.ncases;k++)
2518
{
2519
cur_case= &cur_switch.cases[k];
2520
2521
if(cur_case->is_default)continue;
2522
2523
2524
2525
{
2526
extern boolean eval_msgs;
2527
2528
eval_msgs= NO;
2529
EVALUATE(val,cur_case->case_txt.start,cur_case->case_txt.next);
2530
eval_msgs= YES;
2531
}
2532
2533
switch(val.type)
2534
{
2535
case Int:
2536
cur_case->value= (CASE_TYPE)(val.value.i);
2537
break;
2538
2539
case Double:
2540
2541
RAT_error(WARNING,OC("Case value %#g of type double truncated to int"),1,val.value.d);
2542
cur_case->value= (CASE_TYPE)(val.value.d);
2543
break;
2544
2545
default:
2546
2547
computed_goto= NO;
2548
goto not_integer;
2549
}
2550
2551
2552
if(cur_case->value<cmin)cmin= cur_case->value;
2553
if(cur_case->value>cmax)cmax= cur_case->value;
2554
}
2555
2556
if(cur_switch.ncases==1&&s_default!=0)
2557
{
2558
mcases= 0;
2559
computed_goto= YES;
2560
goto not_integer;
2561
}
2562
else mcases= (cmax-cmin+1);
2563
2564
if((num_cases= cur_switch.ncases-(unsigned short)(s_default!=0))==0)
2565
{
2566
computed_goto= NO;
2567
goto not_integer;
2568
}
2569
computed_goto= BOOLEAN((num_cases>marginal_cases&&
2570
mcases<max_spread)?YES:
2571
((double)mcases)/num_cases<=g_ratio);
2572
2573
not_integer:;
2574
}
2575
2576
;
2577
2578
if(computed_goto)
2579
{
2580
CASE_TYPE m;
2581
unsigned short k;
2582
2583
2584
2585
OUTDENT;
2586
if(mcases>0){id0(id__GOTO);LP;}
2587
2588
for(m= 0;m<mcases;m++,m<mcases?COMMA:RP)
2589
LABEL(label_case(cmin,m));
2590
2591
if(mcases>0)
2592
{
2593
COMMA;LP;copy_out(a,pa,!macro);RP;
2594
MINUS;LP;NUMBER(cmin-1);RP;NL;
2595
}
2596
2597
2598
2599
GOTO(s_default?s_default:(was_break= YES,s_break));
2600
INDENT;
2601
2602
2603
for(k= 1;k<=cur_switch.ncases;k++)
2604
{
2605
cur_case= &cur_switch.cases[k];
2606
2607
show_cmd(cur_case);
2608
OUTDENT;
2609
CONTINUE(cur_case->label);
2610
INDENT;
2611
copy_out(cur_case->txt.start,cur_case->txt.next,!macro);
2612
rlevel--;
2613
}
2614
}
2615
2616
2617
else
2618
{
2619
boolean case_ended_with_break= NO;
2620
boolean made_temp= YES;
2621
2622
2623
2624
if(!Fortran88&&(made_temp= BOOLEAN(!((pa-a)==2&&!TOKEN1(*a)))))
2625
{
2626
2627
2628
if(
2629
nsprintf(temp,OC("I%d"),1,s_break)>=(int)(N_IDBUF))OVERFLW("temp","");
2630
to_ASCII(temp);
2631
icase= ID_NUM((ASCII HUGE*)temp,(ASCII HUGE*)(temp+STRLEN(temp)));
2632
2633
id0(icase);EQUALS;copy_out(a,pa,!macro);NL;
2634
}
2635
2636
for(k= 1;k<=cur_switch.ncases;k++)
2637
2638
{
2639
cur_case= &cur_switch.cases[k];
2640
2641
if(Fortran88)
2642
if(k==1)s_case= max_stmt++;
2643
else
2644
{
2645
2646
{
2647
CASE HUGE*last_case= &cur_switch.cases[k-1];
2648
2649
2650
if(PTR_DIFF(long,last_case->txt.next,last_case->txt.start)>=3)
2651
case_ended_with_break=
2652
BOOLEAN(MEMCMP(last_case->txt.next-3,break_tokens,3)==0);
2653
else case_ended_with_break= NO;
2654
}
2655
2656
2657
if(!case_ended_with_break){GOTO(s_case);}
2658
}
2659
2660
show_cmd(cur_case);
2661
OUTDENT;
2662
if(Fortran88)
2663
{
2664
id0(id__CASE);
2665
2666
if(cur_case->is_default)id0(id__DEFAULT);
2667
else
2668
{
2669
if(*cur_case->case_txt.start!=050)LP;
2670
copy_out(cur_case->case_txt.start,cur_case->case_txt.next,
2671
!macro);
2672
if(*(cur_case->case_txt.next-1)!=051)RP;
2673
}
2674
NL;
2675
INDENT;
2676
if(k>1&&!case_ended_with_break)
2677
{
2678
CONTINUE(s_case);
2679
s_case= max_stmt++;
2680
}
2681
}
2682
else
2683
{
2684
if(cur_case->is_default){CONTINUE(s_default);}
2685
else
2686
{
2687
IF(s_case);LP;NOT;LP;
2688
2689
2690
if(made_temp)id0(icase);else copy_out(a,pa,!macro);
2691
EQ_EQ;
2692
copy_out(cur_case->case_txt.start,
2693
cur_case->case_txt.next,!macro);
2694
RP;RP;
2695
GOTO(s_case= max_stmt++);
2696
}
2697
INDENT;
2698
}
2699
2700
2701
copy_out(cur_case->txt.start,cur_case->txt.next,!macro);
2702
2703
rlevel--;
2704
}
2705
2706
2707
2708
if(!Fortran88)
2709
{
2710
CONTINUE(s_case);
2711
if(s_default)
2712
{
2713
GOTO(s_default);
2714
}
2715
}
2716
}
2717
2718
2719
OUTDENT;
2720
2721
if(Fortran88)
2722
{
2723
if(was_break)LABEL(s_break);
2724
id0(id__END);id0(id__SELECT);
2725
if(symbolic_label)id0(symbolic_label);
2726
NL;
2727
}
2728
else if(was_break){CONTINUE(s_break);}
2729
2730
wlevel--;
2731
rlevel--;
2732
switch_level--;
2733
2734
FREE_MEM(a,"switch:a",SAVE8,eight_bits);
2735
}
2736
2737
2738
2739
SRTN
2740
show_cmd FCN((cur_case))
2741
CONST CASE HUGE*cur_case C1("")
2742
{
2743
if(cur_case->is_default)
2744
{
2745
expanding(default_CMD);
2746
2747
out_cmd(NO,'t',OC(""),OC(":"),0);
2748
}
2749
else
2750
{
2751
expanding(case_CMD);
2752
2753
out_cmd(NO,'c',OC(""),OC(" %s:"),2,cur_case->case_txt.start,cur_case->case_txt.next);
2754
}
2755
}
2756
2757
2758
2759
STMT_LBL
2760
label_case FCN((cmin,m))
2761
CASE_TYPE cmin C0("")
2762
CASE_TYPE m C1("")
2763
{
2764
CASE_TYPE num= cmin+m;
2765
unsigned short k;
2766
2767
2768
for(k= 1;k<=cur_switch.ncases;k++)
2769
{
2770
cur_case= &cur_switch.cases[k];
2771
2772
if(!cur_case->is_default&&cur_case->value==num)
2773
return cur_case->label= s_case= max_stmt++;
2774
}
2775
2776
2777
for(k= 1;k<=cur_switch.ncases;k++)
2778
if(cur_case->is_default)return s_default;
2779
2780
return s_break;
2781
}
2782
2783
2784
X_FCN x_case(VOID)
2785
{
2786
if(switch_level==0)
2787
{
2788
not_switch(OC("case"));
2789
return;
2790
}
2791
2792
expanding(case_CMD);
2793
2794
2795
2796
*cur_case->txt.next= '\0';
2797
2798
2799
cur_case= &cur_switch.cases[++cur_switch.ncases];
2800
2801
2802
if(cur_case->case_txt.start==NULL)
2803
{
2804
cur_case->case_txt.start=
2805
GET_MEM("cur_case->case_txt.start",SAVE8,eight_bits);
2806
cur_case->case_txt.end= cur_case->case_txt.start+SAVE8;
2807
2808
cur_case->txt.start=
2809
GET_MEM("cur_case->txt.start",BIG_SAVE8,eight_bits);
2810
cur_case->txt.end= cur_case->txt.start+BIG_SAVE8;
2811
}
2812
2813
2814
cur_case->txt.next= cur_case->txt.start;
2815
2816
;
2817
cur_case->case_txt.next= SAVE_AFTER(&cur_case->case_txt.start,SAVE8,072);
2818
cur_case->is_default= NO;
2819
2820
2821
{
2822
unsigned short k;
2823
CONST CASE HUGE*old_case;
2824
2825
for(k= 1;k<cur_switch.ncases;k++)
2826
{
2827
old_case= &cur_switch.cases[k];
2828
2829
if(web_strcmp((CONST ASCII HUGE*)cur_case->case_txt.start,
2830
(CONST ASCII HUGE*)cur_case->case_txt.next,
2831
(CONST ASCII HUGE*)old_case->case_txt.start,
2832
(CONST ASCII HUGE*)old_case->case_txt.next)==EQUAL)
2833
{
2834
2835
RAT_error(ERROR,OC("Duplicate case value in switch"),0);
2836
break;
2837
}
2838
}
2839
}
2840
2841
2842
2843
rlevel--;
2844
}
2845
2846
2847
2848
X_FCN
2849
x_default(VOID)
2850
{
2851
if(switch_level==0)
2852
{
2853
not_switch(OC("default"));
2854
return;
2855
}
2856
2857
expanding(default_CMD);
2858
2859
if(cur_switch.has_default)
2860
2861
RAT_error(ERROR,OC("Only one default allowed per switch"),0);
2862
else cur_switch.has_default= YES;
2863
2864
2865
2866
*cur_case->txt.next= '\0';
2867
2868
2869
cur_case= &cur_switch.cases[++cur_switch.ncases];
2870
2871
2872
if(cur_case->case_txt.start==NULL)
2873
{
2874
cur_case->case_txt.start=
2875
GET_MEM("cur_case->case_txt.start",SAVE8,eight_bits);
2876
cur_case->case_txt.end= cur_case->case_txt.start+SAVE8;
2877
2878
cur_case->txt.start=
2879
GET_MEM("cur_case->txt.start",BIG_SAVE8,eight_bits);
2880
cur_case->txt.end= cur_case->txt.start+BIG_SAVE8;
2881
}
2882
2883
2884
cur_case->txt.next= cur_case->txt.start;
2885
2886
;
2887
cur_case->case_txt.next= cur_case->case_txt.start;
2888
cur_case->is_default= YES;
2889
2890
cur_case->label= s_default= max_stmt++;
2891
2892
char_after(':');
2893
rlevel--;
2894
}
2895
2896
2897
2898
2899
X_FCN x_program(VOID)
2900
{
2901
sixteen_bits a;
2902
eight_bits b;
2903
2904
expanding(program_CMD);
2905
2906
2907
2908
WHILE()
2909
{
2910
a= next_byte();
2911
2912
if(!(a==040||a==tab_mark))
2913
break;
2914
}
2915
2916
if(TOKEN1(a))
2917
{
2918
#if(YES)
2919
2920
RAT_error(ERROR,OC("Expected identifier after \"%s\""),1,"program");
2921
#endif
2922
BACK_UP
2923
cur_fcn= NO_FCN;
2924
is_function= NO;
2925
}
2926
else
2927
{
2928
cur_fcn= IDENTIFIER(a,next_byte());
2929
is_function= NO;
2930
}
2931
2932
id0(id_program);id0(cur_fcn);
2933
2934
if(cur_fcn==id_procedure)
2935
{
2936
COPY_TO(073);NL;
2937
}
2938
else
2939
{
2940
b= next_byte();BACK_UP
2941
if(b==050)PARENS;
2942
NL;
2943
EAT_AUTO_SEMI;
2944
skip_newlines(COPY_COMMENTS);
2945
INDENT;
2946
copy_out(insert.program.start,insert.program.end,!macro);
2947
out_char(073);
2948
COPY_2TO(0173,NOT_AFTER);
2949
if(psave_buffer>save_buffer)NL;
2950
brace_level++;
2951
stmt(TO_OUTPUT,BRACE_ONLY);
2952
brace_level--;
2953
OUTDENT;
2954
2955
id0(id__END);
2956
if(Fortran88){id0(id_program);id0(cur_fcn);}
2957
NL;
2958
}
2959
2960
cur_fcn= NO_FCN;
2961
2962
rlevel--;
2963
}
2964
2965
X_FCN x_module(VOID)
2966
{
2967
sixteen_bits a;
2968
eight_bits b;
2969
2970
expanding(module_CMD);
2971
2972
2973
2974
WHILE()
2975
{
2976
a= next_byte();
2977
2978
if(!(a==040||a==tab_mark))
2979
break;
2980
}
2981
2982
if(TOKEN1(a))
2983
{
2984
#if(YES)
2985
2986
RAT_error(ERROR,OC("Expected identifier after \"%s\""),1,"module");
2987
#endif
2988
BACK_UP
2989
cur_fcn= NO_FCN;
2990
is_function= NO;
2991
}
2992
else
2993
{
2994
cur_fcn= IDENTIFIER(a,next_byte());
2995
is_function= NO;
2996
}
2997
2998
id0(id_module);id0(cur_fcn);
2999
3000
if(cur_fcn==id_procedure)
3001
{
3002
COPY_TO(073);NL;
3003
}
3004
else
3005
{
3006
b= next_byte();BACK_UP
3007
if(b==050)PARENS;
3008
NL;
3009
EAT_AUTO_SEMI;
3010
skip_newlines(COPY_COMMENTS);
3011
INDENT;
3012
copy_out(insert.module.start,insert.module.end,!macro);
3013
out_char(073);
3014
COPY_2TO(0173,NOT_AFTER);
3015
if(psave_buffer>save_buffer)NL;
3016
brace_level++;
3017
stmt(TO_OUTPUT,BRACE_ONLY);
3018
brace_level--;
3019
OUTDENT;
3020
3021
id0(id__END);
3022
if(Fortran88){id0(id_module);id0(cur_fcn);}
3023
NL;
3024
}
3025
3026
cur_fcn= NO_FCN;
3027
3028
rlevel--;
3029
}
3030
3031
X_FCN x_subroutine(VOID)
3032
{
3033
sixteen_bits a;
3034
eight_bits b;
3035
3036
expanding(subroutine_CMD);
3037
3038
3039
3040
WHILE()
3041
{
3042
a= next_byte();
3043
3044
if(!(a==040||a==tab_mark))
3045
break;
3046
}
3047
3048
if(TOKEN1(a))
3049
{
3050
#if(YES)
3051
3052
RAT_error(ERROR,OC("Expected identifier after \"%s\""),1,"subroutine");
3053
#endif
3054
BACK_UP
3055
cur_fcn= NO_FCN;
3056
is_function= NO;
3057
}
3058
else
3059
{
3060
cur_fcn= IDENTIFIER(a,next_byte());
3061
is_function= NO;
3062
}
3063
3064
id0(id_subroutine);id0(cur_fcn);
3065
3066
if(cur_fcn==id_procedure)
3067
{
3068
COPY_TO(073);NL;
3069
}
3070
else
3071
{
3072
b= next_byte();BACK_UP
3073
if(b==050)PARENS;
3074
NL;
3075
EAT_AUTO_SEMI;
3076
skip_newlines(COPY_COMMENTS);
3077
INDENT;
3078
copy_out(insert.subroutine.start,insert.subroutine.end,!macro);
3079
out_char(073);
3080
COPY_2TO(0173,NOT_AFTER);
3081
if(psave_buffer>save_buffer)NL;
3082
brace_level++;
3083
stmt(TO_OUTPUT,BRACE_ONLY);
3084
brace_level--;
3085
OUTDENT;
3086
3087
id0(id__END);
3088
if(Fortran88){id0(id_subroutine);id0(cur_fcn);}
3089
NL;
3090
}
3091
3092
cur_fcn= NO_FCN;
3093
3094
rlevel--;
3095
}
3096
3097
X_FCN x_function(VOID)
3098
{
3099
sixteen_bits a;
3100
eight_bits b;
3101
3102
expanding(function_CMD);
3103
3104
3105
3106
WHILE()
3107
{
3108
a= next_byte();
3109
3110
if(!(a==040||a==tab_mark))
3111
break;
3112
}
3113
3114
if(TOKEN1(a))
3115
{
3116
#if(YES)
3117
3118
RAT_error(ERROR,OC("Expected identifier after \"%s\""),1,"function");
3119
#endif
3120
BACK_UP
3121
cur_fcn= NO_FCN;
3122
is_function= NO;
3123
}
3124
else
3125
{
3126
cur_fcn= IDENTIFIER(a,next_byte());
3127
is_function= YES;
3128
}
3129
3130
id0(id_function);id0(cur_fcn);
3131
3132
if(cur_fcn==id_procedure)
3133
{
3134
COPY_TO(073);NL;
3135
}
3136
else
3137
{
3138
b= next_byte();BACK_UP
3139
if(b==050)PARENS;
3140
NL;
3141
EAT_AUTO_SEMI;
3142
skip_newlines(COPY_COMMENTS);
3143
INDENT;
3144
copy_out(insert.function.start,insert.function.end,!macro);
3145
out_char(073);
3146
COPY_2TO(0173,NOT_AFTER);
3147
if(psave_buffer>save_buffer)NL;
3148
brace_level++;
3149
stmt(TO_OUTPUT,BRACE_ONLY);
3150
brace_level--;
3151
OUTDENT;
3152
3153
id0(id__END);
3154
if(Fortran88){id0(id_function);id0(cur_fcn);}
3155
NL;
3156
}
3157
3158
cur_fcn= NO_FCN;
3159
3160
rlevel--;
3161
}
3162
3163
X_FCN x_blockdata(VOID)
3164
{
3165
sixteen_bits a;
3166
eight_bits b;
3167
3168
expanding(blockdata_CMD);
3169
3170
3171
3172
WHILE()
3173
{
3174
a= next_byte();
3175
3176
if(!(a==040||a==tab_mark))
3177
break;
3178
}
3179
3180
if(TOKEN1(a))
3181
{
3182
#if(NO)
3183
3184
RAT_error(ERROR,OC("Expected identifier after \"%s\""),1,"blockdata");
3185
#endif
3186
BACK_UP
3187
cur_fcn= NO_FCN;
3188
is_function= NO;
3189
}
3190
else
3191
{
3192
cur_fcn= IDENTIFIER(a,next_byte());
3193
is_function= NO;
3194
}
3195
3196
id0(id_blockdata);id0(cur_fcn);
3197
3198
if(cur_fcn==id_procedure)
3199
{
3200
COPY_TO(073);NL;
3201
}
3202
else
3203
{
3204
b= next_byte();BACK_UP
3205
if(b==050)PARENS;
3206
NL;
3207
EAT_AUTO_SEMI;
3208
skip_newlines(COPY_COMMENTS);
3209
INDENT;
3210
copy_out(insert.blockdata.start,insert.blockdata.end,!macro);
3211
out_char(073);
3212
COPY_2TO(0173,NOT_AFTER);
3213
if(psave_buffer>save_buffer)NL;
3214
brace_level++;
3215
stmt(TO_OUTPUT,BRACE_ONLY);
3216
brace_level--;
3217
OUTDENT;
3218
3219
id0(id__END);
3220
if(Fortran88){id0(id_blockdata);id0(cur_fcn);}
3221
NL;
3222
}
3223
3224
cur_fcn= NO_FCN;
3225
3226
rlevel--;
3227
}
3228
3229
X_FCN x_interface(VOID)
3230
{
3231
sixteen_bits a;
3232
eight_bits b;
3233
3234
expanding(interface_CMD);
3235
3236
3237
3238
WHILE()
3239
{
3240
a= next_byte();
3241
3242
if(!(a==040||a==tab_mark))
3243
break;
3244
}
3245
3246
if(TOKEN1(a))
3247
{
3248
#if(NO)
3249
3250
RAT_error(ERROR,OC("Expected identifier after \"%s\""),1,"interface");
3251
#endif
3252
BACK_UP
3253
cur_fcn= NO_FCN;
3254
is_function= NO;
3255
}
3256
else
3257
{
3258
cur_fcn= IDENTIFIER(a,next_byte());
3259
is_function= NO;
3260
}
3261
3262
id0(id_interface);id0(cur_fcn);
3263
3264
if(cur_fcn==id_procedure)
3265
{
3266
COPY_TO(073);NL;
3267
}
3268
else
3269
{
3270
b= next_byte();BACK_UP
3271
if(b==050)PARENS;
3272
NL;
3273
EAT_AUTO_SEMI;
3274
skip_newlines(COPY_COMMENTS);
3275
INDENT;
3276
copy_out(insert.interface.start,insert.interface.end,!macro);
3277
out_char(073);
3278
COPY_2TO(0173,NOT_AFTER);
3279
if(psave_buffer>save_buffer)NL;
3280
brace_level++;
3281
stmt(TO_OUTPUT,BRACE_ONLY);
3282
brace_level--;
3283
OUTDENT;
3284
3285
id0(id__END);
3286
if(Fortran88){id0(id_interface);id0(cur_fcn);}
3287
NL;
3288
}
3289
3290
cur_fcn= NO_FCN;
3291
3292
rlevel--;
3293
}
3294
3295
3296
3297
X_FCN
3298
x_block(VOID)
3299
{
3300
sixteen_bits a;
3301
3302
if(TOKEN1(a= next_byte()))
3303
{
3304
BACK_UP
3305
id0(id_block);
3306
}
3307
else
3308
{
3309
a= IDENTIFIER(a,next_byte());
3310
3311
if(a==id_data)x_blockdata();
3312
else
3313
{
3314
BACK_UP
3315
id0(a);
3316
}
3317
}
3318
}
3319
3320
3321
3322
X_FCN
3323
x_contains(VOID)
3324
{
3325
OUTDENT;
3326
id0(id__CONTAINS);
3327
char_after(':');
3328
NL;
3329
INDENT;
3330
}
3331
3332
3333
3334
3335
X_FCN x_type(VOID)
3336
{
3337
sixteen_bits a;
3338
eight_bits b;
3339
3340
b= next_byte();BACK_UP
3341
if(b==054){}
3342
else if(b==050)
3343
{
3344
id0(id_type);
3345
return;
3346
}
3347
3348
expanding(type_CMD);
3349
3350
if(TOKEN1(a= next_byte()))
3351
{
3352
3353
RAT_error(ERROR,OC("Expected identifier after \"%s\""),1,"type");
3354
BACK_UP
3355
cur_struct= NO_FCN;
3356
}
3357
else
3358
{
3359
cur_struct= IDENTIFIER(a,next_byte());
3360
}
3361
3362
id0(id_type);id0(cur_struct);
3363
NL;
3364
INDENT;
3365
brace_level++;
3366
stmt(TO_OUTPUT,BRACE_ONLY);
3367
brace_level--;
3368
OUTDENT;
3369
3370
id0(id__END);id0(id_type);id0(cur_struct);
3371
char_after(';');OUT_CHAR(';');
3372
3373
wlevel--;
3374
rlevel--;
3375
}
3376
3377
3378
3379
X_FCN
3380
x_return(VOID)
3381
{
3382
eight_bits HUGE*return_expr= NULL,HUGE*pr;
3383
3384
expanding(return_CMD);
3385
3386
3387
if((pr= SAVE_AFTER(&return_expr,SAVE8,073))>return_expr)
3388
{
3389
if(!is_function)
3390
3391
RAT_error(ERROR,OC("Can't return value from program or subroutine"),0);
3392
else
3393
{
3394
3395
out_cmd(YES,'r',OC(""),OC(" %s"),2,return_expr,pr);
3396
id0(cur_fcn);EQUALS;
3397
copy_out(return_expr,pr,!macro);NL;
3398
}
3399
}
3400
3401
RETURN;
3402
rlevel--;
3403
FREE_MEM(return_expr,"return_expr",SAVE8,eight_bits);
3404
}
3405
3406
3407
3408
X_FCN
3409
x_unroll(VOID)
3410
{
3411
eight_bits HUGE*I= NULL,HUGE*pI;
3412
eight_bits HUGE*Imin= NULL,HUGE*pImin;
3413
eight_bits HUGE*Imax= NULL,HUGE*pImax;
3414
eight_bits HUGE*Di= NULL,HUGE*pDi;
3415
eight_bits HUGE*txt= NULL,HUGE*ptxt;
3416
int i,imin,imax,di;
3417
name_pointer n;
3418
text_pointer t;
3419
eight_bits temp[20];
3420
extern int last_bytes;
3421
extern boolean saved_token;
3422
eight_bits c;
3423
3424
expanding(_DO_CMD);
3425
3426
3427
{
3428
eight_bits c;
3429
3430
if((c= next_byte())!='(')
3431
{
3432
didnt_expand('(',c,"$DO");
3433
return;
3434
}
3435
};
3436
3437
pI= SAVE_AFTER(&I,SAVE8,054);
3438
3439
if(TOKEN1(*I))
3440
{
3441
3442
RAT_error(ERROR,OC("Expected identifier for first argument of $DO; \
3443
expansion aborted"),0);
3444
return;
3445
}
3446
3447
pImin= SAVE_AFTER(&Imin,SAVE8,054);
3448
imin= neval(Imin,pImin);
3449
3450
pImax= SAVE_AFTER(&Imax,SAVE8,054);
3451
imax= neval(Imax,pImax);
3452
3453
pDi= SAVE_AFTER(&Di,SAVE8,051);
3454
di= neval(Di,pDi);
3455
3456
EAT_AUTO_SEMI;
3457
skip_newlines(NO);
3458
3459
c= next_byte();
3460
3461
if(!(c==0173||c==050))
3462
{
3463
3464
RAT_error(ERROR,OC("Was expecting '{' or '(', not '%c', after $DO(); \
3465
expansion aborted"),1,XCHR(c));
3466
return;
3467
}
3468
3469
3470
3471
mac_protected= YES;
3472
ptxt= SAVE_AFTER(&txt,BIG_SAVE8,c==0173?0175:051);
3473
mac_protected= NO;
3474
3475
n= name_dir+IDENTIFIER(*I,*(I+1));
3476
n->info.Macro_type= IMMEDIATE_MACRO;
3477
t= GET_MEM("equiv",2,text);
3478
n->equiv_or_xref= (EQUIV)t;
3479
t->tok_start= temp;
3480
t->moffset= 2;
3481
3482
if(!((di>=0&&imax<imin)||(di<0&&imax>imin)))
3483
for(i= imin;di>=0?i<=imax:i>=imax;i+= di)
3484
{
3485
STRNCPY(temp,I,2);
3486
sprintf((char*)(temp+2),"%c%d%c",XCHR(constant),i,XCHR(constant));
3487
to_ASCII(temp+2);
3488
#if 0
3489
(t+1)->tok_start= temp+STRLEN(temp);
3490
#endif
3491
t->nbytes= STRLEN(temp);
3492
copy_out(txt,ptxt,!macro);
3493
3494
if(i==imax)
3495
break;
3496
}
3497
3498
rlevel--;
3499
3500
FREE_MEM(t,"t",2,text);
3501
n->equiv_or_xref= NULL;
3502
n->info.Macro_type= NOT_DEFINED;
3503
3504
FREE_MEM(I,"unroll:I",SAVE8,eight_bits);
3505
FREE_MEM(Imin,"unroll:Imin",SAVE8,eight_bits);
3506
FREE_MEM(Imax,"unroll:Imax",SAVE8,eight_bits);
3507
FREE_MEM(txt,"unroll:txt",SAVE8,eight_bits);
3508
}
3509
3510
3511
3512
SRTN
3513
ini_Ratfor(VOID)
3514
{
3515
insert.program.start= insert.program.end=
3516
GET_MEM("program",2,eight_bits);
3517
insert.module.start= insert.module.end=
3518
GET_MEM("module",2,eight_bits);
3519
insert.subroutine.start= insert.subroutine.end=
3520
GET_MEM("subroutine",2,eight_bits);
3521
insert.function.start= insert.function.end=
3522
GET_MEM("function",2,eight_bits);
3523
insert.blockdata.start= insert.blockdata.end=
3524
GET_MEM("blockdata",2,eight_bits);
3525
insert.interface.start= insert.interface.end=
3526
GET_MEM("interface",2,eight_bits);
3527
}
3528
3529
3530
#endif
3531
3532
3533
3534
3535
Loggerhead is a web-based interface for Breezy
Version: 2.0.1