1
2
3
4
5
6
7
8
9
10
11 statement_parse: proc(k,label_ptr,conditions,cblock,type);
12
13
14
15
16
17 dcl (i,j,k,libe_no,n initial(0),type) fixed bin(15);
18 dcl (addr,bit,fixed,null,binary) builtin;
19 dcl conditions bit(12) aligned;
20 dcl (p,q,r,s,cblock,label_ptr,stmnt) ptr;
21 dcl stack(128) ptr;
22 dcl op_code bit(9) aligned;
23
24 dcl pl1_stat_$cur_statement ptr ext static;
25
26 dcl action_index(0:37) fixed bin(15) int static initial(
27
28 0,1,2,0,3, 10,0,10,10,10, 0,9,0,0,10, 10,4,10,5,0,
29 10,6,0,10,0, 10,10,7,8,10, 8,11,0,10,10, 10,0,0);
30
31 %include parse;
32 %include block;
33 %include declare_type;
34 %include context_codes;
35 %include label;
36 %include list;
37 %include nodes;
38 %include op_codes;
39 %include operator;
40 %include reference;
41 %include statement;
42 %include statement_types;
43 %include symbol;
44 %include token;
45 %include token_list;
46 %include token_types;
47 %include block_types;
48
49
50 begin:
51
52 make_statement:
53 pl1_stat_$cur_statement ,
54 stmnt=create_statement(bit(fixed(type,9),9),cblock,label_ptr,conditions);
55 if label_ptr^=null
56 then call declare_label(cblock,stmnt,label_ptr,by_explicit_context);
57 label_ptr=null;
58 go to action(action_index(type));
59
60 action(0):
61 return;
62
63 action(1):
64 q,stmnt->statement.root=create_operator(allot_var,2);
65 k=k+1;
66 if t_table.type ^= identifier then call print(454);
67 q->operand(1)=token_list(k);
68
69 alloc_loop:
70 k=k+1;
71 if t_table.string = "set"
72 then do;
73 k=k+1;
74 if q->operand(1)->node.type^=token_node then call print(450);
75 if t_table.type ^= left_parn then call print(451);
76 k=k+1;
77 p = reference_parse(k,cblock);
78 if p = null then call print(454);
79 call context(p,cblock,pointer_context);
80 r = create_reference((q->operand(1)));
81 r->reference.qualifier = p;
82 q->operand(1) = r;
83 if t_table.type ^= right_parn then call print(454);
84 go to alloc_loop;
85 end;
86 if t_table.string ="in"
87 then do;
88 k=k+1;
89 if q->operand(2) ^= null then call print(452);
90 if t_table.type ^= left_parn then call print(453);
91 k=k+1;
92 q -> operand(2) = reference_parse(k,cblock);
93 if q -> operand(2) = null then call print(454);
94 call context((q->operand(2)),cblock,area_context);
95 if t_table.type ^= right_parn then call print(454);
96 go to alloc_loop;
97 end;
98 if t_table.type = comma then go to make_statement;
99 go to check_semi_colon;
100
101 action(2):
102 p = reference_parse(k,cblock);
103 if p = null then call print(1);
104 n=n+1;
105 if n>128 then call print(5);
106 stack(n)=p;
107 if t_table.type = assignment then go to make_op;
108 if t_table.type ^= comma then call print(1);
109 k=k+1;
110 go to action(2);
111
112 make_op:
113 k=k+1;
114 p = expression_parse(k,cblock);
115 if p = null then call print(49);
116 if t_table.type = comma then go to make_assign_by_name;
117 stmnt->statement.root,q=create_operator(assign,2);
118 if n=1 then do;
119 q->operand(1)=stack(1);
120 q->operand(2)=p;
121 go to check_semi_colon;
122 end;
123 if p->node.type = token_node
124 then if p->token.type & is_constant
125 then do;
126 s = p;
127 q->operand(1) = stack(1);
128 q->operand(2) = s;
129 j = 2;
130 go to make_assignment;
131 end;
132
133 s = create_symbol(null,null,by_compiler);
134 s->symbol.temporary = "1"b;
135 s = s->symbol.reference;
136 s->reference.shared="0"b;
137 s->reference.ref_count = n+1;
138 q->operand(1) = s;
139 q->operand(2) = p;
140 j = 1;
141
142 make_assignment:
143 do i = j to n;
144 stmnt = create_statement(assignment_statement,cblock,null,conditions);
145 stmnt->statement.root, q = create_operator(assign,2);
146 stmnt->statement.generated = "1"b;
147 q->operand(1) = stack(i);
148 q->operand(2) = s;
149 end;
150 go to check_semi_colon;
151
152 make_assign_by_name:
153 k=k+1;
154 if t_table.string ^= "by"
155 then call print(371);
156 k=k+1;
157 if t_table.string ^= "name"
158 then call print(371);
159 stmnt->statement.root,q=create_operator(assign_by_name,2);
160 q->operand(2) = p;
161 r = create_list(n);
162 do i=1 to n;
163 r -> list.element(i) = stack(i);
164 end;
165 q->operand(1) = r;
166 k=k+1;
167 go to check_semi_colon;
168
169 action(3):
170 k=k+1;
171 stmnt -> statement.root = reference_parse(k,cblock);
172 if stmnt -> statement.root = null then call print(444);
173 q = stmnt->statement.root;
174 if q->node.type = token_node
175 then do;
176 q = create_reference(q);
177 q->reference.offset = create_list(0);
178 stmnt->statement.root = q;
179 end;
180 else if q->node.type = reference_node
181 then if q->reference.offset = null
182 then q->reference.offset = create_list(0);
183 go to check_semi_colon;
184
185 action(4):
186 k=k+1;
187 q,stmnt->statement.root=create_operator(free_var,2);
188 q -> operand(1) = reference_parse(k,cblock);
189 if q -> operand(1) = null then call print(456);
190 if t_table.string = "in"
191 then do;
192 k=k+1;
193 if t_table.type ^= left_parn then call print(455);
194 k=k+1;
195 q -> operand(2) = reference_parse(k,cblock);
196 if q -> operand(2) = null then call print(456);
197 call context((q->operand(2)),cblock,area_context);
198 if t_table.type ^= right_parn then call print(456);
199 k=k+1;
200 end;
201 if t_table.type = comma then go to make_statement;
202 go to check_semi_colon;
203
204 action(5):
205 if t_table.string ="goto"
206 then k = k + 1;
207 else do;
208 k = k + 1;
209 if t_table.string ^= "to" then call print(446);
210 k = k + 1;
211 end;
212 q,stmnt->statement.root=create_operator(jump,1);
213 q -> operand(1) = reference_parse(k,cblock);
214 if q -> operand(1) = null then call print(446);
215 go to check_semi_colon;
216
217 action(6):
218 if stmnt->statement.labels^=null
219 then stmnt->statement.root = create_operator(nop,0);
220 go to check_semi_colon;
221
222 action(7):
223 k=k+1;
224 if t_table.type = semi_colon
225 then do;
226 q,stmnt->statement.root=create_operator(std_return,0);
227 return;
228 end;
229 if t_table.type ^= left_parn then call print(447);
230 k=k+1;
231 q,stmnt->statement.root=create_operator(return_value,1);
232 q -> operand(1) = expression_parse(k,cblock);
233 if q -> operand(1) = null then call print(447);
234 if t_table.type ^= right_parn then call print(447);
235 k=k+1;
236
237 check_semi_colon:
238 if t_table.type^=semi_colon then call print(1);
239 return;
240
241 action(8):
242 call on_parse$revert(k,stmnt,cblock);
243 if t_table.type = comma
244 then if type = fixed(revert_statement,15)
245 then go to make_statement;
246 go to check_semi_colon;
247
248 action(9):
249 call print(150);
250 return;
251
252 action(10):
253 call print(460);
254 return;
255
256 action(11):
257 k=k+1;
258 stmnt->statement.root=create_operator(stop,0);
259 go to check_semi_colon;
260
261 print: proc(m);
262
263 dcl m fixed bin(15);
264
265 call parse_error(m,null);
266 stmnt->statement.root=null;
267 stmnt->statement.statement_type=null_statement;
268 go to ret;
269 end;
270
271 ret:
272 end statement_parse;