1
2
3
4
5
6
7
8
9
10
11
12
13
14 copy_expression:
15 procedure (a) returns (pointer);
16
17 dcl a ptr unaligned;
18 dcl father ptr;
19 dcl stepfather ptr;
20
21
22
23 dcl i fixed bin;
24 dcl inptr ptr;
25 dcl nodetype bit (9) aligned;
26 dcl outptr ptr;
27 dcl p ptr;
28
29
30
31 dcl null builtin;
32
33
34
35 dcl pl1_stat_$util_abort
36 external static entry (fixed bin (15), ptr) variable;
37 ^L
38 %include language_utility;
39 %include array;
40 %include symbol;
41 %include declare_type;
42 %include list;
43 %include nodes;
44 %include operator;
45 %include op_codes;
46 %include reference;
47 ^L
48
49
50 inptr = a;
51
52 if inptr = null
53 then return (inptr);
54
55 nodetype = inptr -> node.type;
56
57 if nodetype = operator_node
58 then do;
59 if inptr -> operator.number = 0
60 then return (inptr);
61
62 if inptr -> operator.operand (1) ^= null
63 then if inptr -> operator.operand (1) -> node.type = reference_node
64 then if ^inptr -> operator.operand (1) -> reference.shared
65 then do;
66 inptr -> operator.operand (1) -> reference.ref_count =
67 inptr -> operator.operand (1) -> reference.ref_count + 1;
68 return (inptr);
69 end;
70
71 outptr = create_operator ((inptr -> operator.op_code), (inptr -> operator.number));
72
73 do i = 1 to inptr -> operator.number;
74 if inptr -> operator.operand (i) ^= null
75 then outptr -> operator.operand (i) = copy_expression (inptr -> operator.operand (i));
76 end;
77
78 outptr -> operator.processed = inptr -> operator.processed;
79
80 if outptr -> operator.op_code = std_call
81 then if outptr -> operator.operand (1) ^= null
82 then do;
83 p = outptr -> operator.operand (3) -> operator.operand (2);
84 outptr -> operator.operand (1) = p -> list.element (p -> list.number);
85 end;
86
87 return (outptr);
88 end;
89
90 else if nodetype = list_node
91 then do;
92 outptr = create_list ((inptr -> list.number));
93
94 do i = 1 to inptr -> list.number;
95 outptr -> list.element (i) = copy_expression (inptr -> list.element (i));
96 end;
97
98 return (outptr);
99 end;
100
101 else if nodetype = reference_node
102 then do;
103 if inptr -> reference.symbol ^= null
104 then do;
105 p = inptr -> reference.symbol;
106 if p -> node.type = symbol_node
107 then if p -> symbol.constant & ^p -> symbol.file & ^p -> symbol.entry & ^p -> symbol.format
108 then return (inptr);
109 end;
110
111 if ^inptr -> reference.shared
112 then do;
113 inptr -> reference.ref_count = inptr -> reference.ref_count + 1;
114 return (inptr);
115 end;
116
117 outptr = create_reference ((inptr -> reference.symbol));
118
119 outptr -> reference = inptr -> reference;
120
121 if outptr -> reference.offset ^= null
122 then outptr -> reference.offset = copy_expression (inptr -> reference.offset);
123
124 if outptr -> reference.length ^= null
125 then outptr -> reference.length = copy_expression (inptr -> reference.length);
126
127 if outptr -> reference.qualifier ^= null
128 then outptr -> reference.qualifier = copy_expression (inptr -> reference.qualifier);
129
130 return (outptr);
131 end;
132
133 else if nodetype = token_node | nodetype = label_node | nodetype = sf_par_node | nodetype = block_node
134 then return (inptr);
135
136 else if nodetype = array_node
137 then do;
138 outptr = create_array ();
139 outptr -> array = inptr -> array;
140 outptr -> array.element_size = copy_expression (inptr -> array.element_size);
141 outptr -> array.element_size_bits = copy_expression (inptr -> array.element_size_bits);
142 outptr -> array.virtual_origin = copy_expression (inptr -> array.virtual_origin);
143 outptr -> array.bounds = copy_expression (inptr -> array.bounds);
144 outptr -> array.element_descriptor = copy_expression (inptr -> array.element_descriptor);
145
146 return (outptr);
147 end;
148
149 else if nodetype = bound_node
150 then do;
151 outptr = create_bound ();
152 outptr -> bound = inptr -> bound;
153 outptr -> bound.next = copy_expression (inptr -> bound.next);
154 outptr -> bound.lower = copy_expression (inptr -> bound.lower);
155 outptr -> bound.upper = copy_expression (inptr -> bound.upper);
156 outptr -> bound.desc_multiplier = copy_expression (inptr -> bound.desc_multiplier);
157 outptr -> bound.multiplier = copy_expression (inptr -> bound.multiplier);
158
159 return (outptr);
160 end;
161
162 else if nodetype = symbol_node
163 then return (copy_symbol (inptr, null));
164
165 call pl1_stat_$util_abort (32, inptr);
166
167 return (inptr);
168
169
170
171
172
173
174 copy_sons:
175 entry (father, stepfather);
176
177 stepfather -> symbol.son = null;
178
179 if father -> symbol.son = null
180 then return;
181
182 stepfather -> symbol.son = copy_symbol ((father -> symbol.son), stepfather);
183
184 return;
185 ^L
186
187
188
189
190
191 copy_symbol:
192 procedure (root, stepfather) returns (ptr);
193
194 dcl root ptr;
195 dcl stepfather ptr;
196
197 dcl more_nodes bit (1) aligned;
198 dcl new_s ptr;
199 dcl new_tree ptr;
200 dcl previous ptr;
201 dcl s ptr;
202
203 s = root;
204 new_tree, previous, new_s = copy_symbol_node (root);
205 new_s -> symbol.father = stepfather;
206
207 more_nodes = "1"b;
208 do while (more_nodes);
209 if s -> symbol.son ^= null
210 then do;
211 new_s -> symbol.son, previous -> symbol.next = copy_symbol_node ((s -> symbol.son));
212 new_s -> symbol.son -> symbol.father = new_s;
213 s = s -> symbol.son;
214 previous, new_s = new_s -> symbol.son;
215 end;
216 else do;
217 more_nodes = "0"b;
218 do while (s ^= root -> symbol.father & ^more_nodes);
219 if s -> symbol.brother ^= null & (s ^= root | stepfather ^= null)
220 then more_nodes = "1"b;
221 else do;
222 s = s -> symbol.father;
223 new_s = new_s -> symbol.father;
224 end;
225 end;
226
227 if more_nodes
228 then do;
229 new_s -> symbol.brother,
230 previous -> symbol.next = copy_symbol_node ((s -> symbol.brother));
231 new_s -> symbol.brother -> symbol.father = new_s -> symbol.father;
232 s = s -> symbol.brother;
233 previous, new_s = new_s -> symbol.brother;
234 end;
235 end;
236 end;
237
238 return (new_tree);
239 ^L
240 copy_symbol_node:
241 procedure (s) returns (ptr);
242
243 dcl s ptr;
244
245 dcl p ptr;
246
247 p = create_symbol (null, null, by_compiler);
248
249 p -> symbol = s -> symbol;
250 p -> symbol.dcl_type = by_compiler;
251 p -> symbol.next, p -> symbol.multi_use = null;
252 p -> symbol.reference = copy_expression (s -> symbol.reference);
253 p -> symbol.reference -> reference.symbol = p;
254 p -> symbol.array = copy_expression (s -> symbol.array);
255 p -> symbol.general = copy_expression (s -> symbol.general);
256 p -> symbol.initial = copy_expression (s -> symbol.initial);
257
258 return (p);
259 end copy_symbol_node;
260
261 end copy_symbol;
262
263 end copy_expression;