1
2
3
4
5
6 %;
7
8
9
10
11
12
13
14
15
16 reference_parse:
17 procedure(index,cblock) returns(pointer);
18
19
20
21
22
23
24 dcl (i,j,k,m,n,index) fixed bin(15);
25 dcl (arg,cblock,p,q,qual,arglist,op,sym) ptr;
26 dcl s(512) ptr unaligned;
27 dcl t(128) ptr unaligned;
28
29 dcl (addr,null) builtin;
30
31 %include parse;
32 %include context_codes;
33 %include declare_type;
34 %include list;
35 %include nodes;
36 %include op_codes;
37 %include operator;
38 %include reference;
39 %include symbol;
40 %include token;
41 %include token_list;
42 %include token_types;
43
44
45 begin:
46 qual=null;
47 k=index;
48 if t_table.type = isub
49 then do;
50 index=index+1;
51 return(token_list(k));
52 end;
53
54 reset:
55 i,j=0;
56
57 next:
58 if t_table.type ^= identifier then go to fail;
59 q=token_list(k);
60 k=k+1;
61
62 if t_table.type = left_parn
63 then do;
64 if token_list(k+1)->t_table.type=right_parn
65 then do;
66 call make_reference;
67
68 if i = 0
69 then do;
70 q -> reference.offset = create_list(0);
71 k = k + 2;
72
73 if t_table.type = arrow then goto test_ptr;
74 end;
75
76 goto entry_reference;
77 end;
78
79 next_sub:
80 k=k+1;
81 i=i+1;
82
83 if t_table.type=asterisk
84 then do;
85 if i > hbound(s,1)
86 then goto fail;
87 s(i)=token_list(k);
88 k=k+1;
89 end;
90 else if ^atom() then goto fail;
91
92 if t_table.type = comma then go to next_sub;
93 if t_table.type = colon then go to next_sub;
94 if t_table.type ^= right_parn then go to fail;
95 k=k+1;
96 end;
97
98 if t_table.type = period
99 then do;
100 k=k+1;
101 j=j+1;
102 if j > hbound(t,1)
103 then goto fail;
104 t(j)=q;
105 go to next;
106 end;
107
108 if qual^=null | j+i ^= 0
109 then call make_reference;
110
111 if t_table.type = arrow
112 then do;
113 test_ptr:
114 k=k+1;
115 qual=q;
116 if q->node.type = token_node
117 then if cblock^=null then call context(q,cblock,pointer_context);
118 go to reset;
119 end;
120
121 entry_reference:
122 do while(t_table.type=left_parn);
123 i=0;
124
125 if token_list(k+1)->t_table.type^=right_parn
126 then do;
127 next_arg:
128 k=k+1;
129 i=i+1;
130
131 if ^atom() then goto fail;
132
133 if t_table.type=comma then goto next_arg;
134 if t_table.type^=right_parn then goto fail;
135 end;
136 else k=k+1;
137
138 k=k+1;
139
140 arglist=create_operator(std_arg_list,3);
141 arglist->operand(2)=create_list(i);
142
143 do j=1 to i;
144 arglist->operand(2)->list.element(j)=s(i-j+1);
145 end;
146
147 op=create_operator(std_call,3);
148 op->operand(2)=q;
149 op->operand(3)=arglist;
150
151 q=op;
152 end;
153
154 if t_table.type=arrow
155 then goto test_ptr;
156
157 ret1:
158 index=k;
159 return(q);
160
161 fail:
162 return(null);
163
164
165 make_reference: proc;
166
167 q=create_reference(q);
168 q->reference.qualifier=qual;
169 if i^=0 then do;
170 p=create_list(i);
171 do m=1 to i;
172 p->list.element(m) = s(i+1-m);
173 end;
174 q->reference.offset=p;
175 end;
176 if j^=0 then do;
177 p=create_list(j);
178 do m=1 to j;
179 p->list.element(m) = t(j+1-m);
180 end;
181 q->reference.length=p;
182 end;
183
184 end make_reference;
185
186
187 atom: proc() returns(bit(1)aligned);
188
189 dcl save_index fixed bin(15);
190
191 save_index=k;
192
193 if i > hbound(s,1)
194 then goto fail;
195 s(i) = expression_parse(k,cblock);
196 if s(i)=null then return("0"b);
197
198 if token_list(save_index)->token.type^=left_parn
199 then; else
200
201 if s(i)->node.type=operator_node
202 then; else
203
204 if s(i)->node.type=token_node
205 & s(i)->token.type^=identifier
206 then;
207
208 else do;
209 sym=create_symbol(null,null,by_compiler);
210 sym->symbol.temporary="1"b;
211
212 op=create_operator(assign,2);
213 op->operand(1)=sym->symbol.reference;
214 op->operand(2)=s(i);
215
216 if i > hbound(s,1)
217 then goto fail;
218 s(i)=op;
219 end;
220
221 return("1"b);
222
223 end atom;
224
225 end reference_parse;