1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31 declare_parse: proc(i,cur_block,labels);
32
33 dcl i fixed bin(15) parameter;
34 dcl (cur_block,labels) ptr parameter;
35
36 declare p ptr;
37 declare (cblock,previous_symbol) ptr internal static;
38
39 declare (n,j) fixed binary(15);
40 declare (k,l,factored_level) fixed binary(15) static internal;
41
42 dcl type bit(9);
43
44 dcl pl1_stat_$cur_statement ptr ext static;
45 dcl pl1_stat_$unwind label external static;
46
47
48 dcl (null,addr,string) builtin;
49
50 %include parse;
51 %include block;
52 %include token_types;
53 %include statement_types;
54 %include symbol;
55 %include token_list;
56 %include token;
57 %include declare_type;
58 %include reference;
59
60 ^L
61 begin:
62 k,l=i;
63 cblock=cur_block;
64
65
66 if labels ^= null
67 then do;
68 pl1_stat_$cur_statement ,
69 p = create_statement(null_statement,cblock,labels,(cblock -> block.prefix));
70 call declare_label(cblock,p,labels,by_explicit_context);
71 end;
72
73 pl1_stat_$unwind=error_restart;
74 previous_symbol = null;
75
76 error_restart:
77 if t_table.type = semi_colon then return;
78 factored_level = 0;
79 call declare_parse_factored;
80 if t_table.type = semi_colon then return;
81 call parse_error(1,null);
82 return;
83
84 declare_parse$abort: entry(m,bad_node);
85
86 dcl m fixed bin(15) parameter;
87 dcl bad_node pointer;
88
89 call parse_error(m,bad_node);
90 n=0;
91 j=k;
92 do k=l by 1;
93 type = t_table.type;
94 if type=left_parn then n=n+1;
95 if type=right_parn then n=n-1;
96 if type=semi_colon then go to pl1_stat_$unwind;
97 if type=comma then if n=0 then if k>j then go to pl1_stat_$unwind;
98 end;
99 ^L
100 declare_parse_factored: procedure;
101
102 dcl (last_dcl,s) ptr;
103 dcl (current_level,level) fixed bin(15);
104
105 current_level = factored_level;
106
107 do while("1"b);
108 k=k+1;
109
110 level = current_level;
111 if t_table.type = dec_integer
112 then do;
113 if current_level = 0
114 then level = token_to_binary(token_list(k));
115 else call parse_error(1,null);
116 k=k+1;
117 end;
118
119 if t_table.type=left_parn
120 then do;
121 l=k-1;
122 last_dcl = cblock->block.end_declaration;
123 factored_level = level;
124 call declare_parse_factored;
125 s = create_symbol(null,create_token("a factored attribute list",(identifier)),by_compiler);
126 if t_table.type^=right_parn then call declare_parse$abort(3,null);
127 call attribute_parse(cblock,s,k,"0"b);
128 if last_dcl = null
129 then last_dcl = cblock->block.declaration;
130 else last_dcl = last_dcl->symbol.next;
131 do last_dcl = last_dcl repeat last_dcl->symbol.next while(last_dcl^=null);
132 if last_dcl->symbol.dcl_type = by_declare
133 then if merge_attributes(last_dcl,s) then call parse_error(27,null);
134 end;
135 call free_node(s);
136 end;
137 else do;
138 if t_table.type ^= identifier then call declare_parse$abort(3,null);
139 s = create_symbol(cblock,token_list(k),by_declare);
140 string(s->symbol.source_id) = string(pl1_stat_$statement_id);
141 s->symbol.level = level;
142 call link_symbol(previous_symbol,s);
143 call attribute_parse(cblock,s,k,"0"b);
144 end;
145 if t_table.type ^= comma then return;
146 end;
147 end declare_parse_factored;
148 %include link_symbol;
149
150 end declare_parse;