1
2
3
4
5
6
7
8
9
10
11 default_parse: proc(k,b,labels);
12
13 dcl (b,labels,d,s,last) ptr;
14 dcl (k,n) fixed bin(15);
15 dcl pl1_stat_$cur_statement ptr ext static;
16 dcl pl1_stat_$unwind external label;
17 dcl pl1_stat_$check_ansi bit(1) aligned ext static;
18 dcl pl1_stat_$root ptr ext static;
19
20 dcl (string,null,addr) builtin;
21 %include parse;
22 %include default;
23 %include symbol;
24 %include block;
25 %include token_list;
26 %include token_types;
27 %include statement_types;
28 %include declare_type;
29
30 if labels ^= null
31 then do;
32 pl1_stat_$cur_statement,d = create_statement(null_statement,b,labels,(b->block.prefix));
33 call declare_label(b,d,labels,by_explicit_context);
34 end;
35
36 k = k+1;
37 d = create_default();
38 string(d->default.source_id) = string(pl1_stat_$statement_id);
39 if t_table.type = left_parn
40 then do;
41 k=k+1;
42 d -> default.predicate = expression_parse(k,b);
43 if d -> default.predicate = null then go to fail;
44 if t_table.type ^= right_parn then go to fail;
45 end;
46 else do;
47 if t_table.type = identifier
48 then do;
49 if t_table.string = "system"
50 then d->default.system = "1"b;
51 else if t_table.string = "none"
52 then d->default.no_defaults = "1"b;
53 else go to fail;
54 k=k+1;
55 if t_table.type = semi_colon then go to done;
56 end;
57 go to fail;
58 end;
59 k=k+1;
60 if t_table.string = "error"
61 then do;
62 d->default.error = "1"b;
63 k=k+1;
64 if t_table.type = semi_colon
65 then go to done;
66 else go to fail;
67 end;
68
69
70
71 pl1_stat_$unwind = check_end;
72 last = null;
73 k=k-1;
74
75 do while("1"b);
76
77 s = create_symbol(null,null,by_compiler);
78 call attribute_parse(b,s,k,"0"b);
79 if last = null
80 then d->default.symbol = s;
81 else last->symbol.next = s;
82 last = s;
83
84 check_end:
85 if t_table.type = semi_colon then go to done;
86 if t_table.type ^= comma then go to fail;
87 end;
88
89 done:
90 if b->block.end_default ^= null
91 then b->block.end_default->default.next = d;
92 else b->block.default = d;
93 b->block.end_default = d;
94
95 if pl1_stat_$check_ansi
96 then if b ^= pl1_stat_$root -> block.son
97 then call parse_error(350,null);
98
99 return;
100
101 fail:
102 call free_node(d);
103 call parse_error(48,null);
104 end default_parse;