1 //: Go from an address to the payload it points at using /lookup.
  2 //:
  3 //: The tests in this layer use unsafe operations so as to stay decoupled from
  4 //: 'new'.
  5 
  6 :(scenario copy_indirect)
  7 def main [
  8   1:address:num <- copy 10/unsafe
  9   10:num <- copy 34
 10   # This loads location 1 as an address and looks up *that* location.
 11   2:num <- copy 1:address:num/lookup
 12 ]
 13 +mem: storing 34 in location 2
 14 
 15 :(before "End Preprocess read_memory(x)")
 16 canonize(x);
 17 
 18 //: similarly, write to addresses pointing at other locations using the
 19 //: 'lookup' property
 20 :(scenario store_indirect)
 21 def main [
 22   1:address:num <- copy 10/unsafe
 23   1:address:num/lookup <- copy 34
 24 ]
 25 +mem: storing 34 in location 10
 26 
 27 :(before "End Preprocess write_memory(x, data)")
 28 canonize(x);
 29 
 30 //: writes to address 0 always loudly fail
 31 :(scenario store_to_0_fails)
 32 % Hide_errors = true;
 33 def main [
 34   1:address:num <- copy 0
 35   1:address:num/lookup <- copy 34
 36 ]
 37 -mem: storing 34 in location 0
 38 +error: can't write to location 0 in '1:address:num/lookup <- copy 34'
 39 
 40 //: attempts to /lookup address 0 always loudly fail
 41 :(scenario lookup_0_fails)
 42 % Hide_errors = true;
 43 def main [
 44   1:address:num <- copy 0
 45   2:num <- copy 1:address:num/lookup
 46 ]
 47 +error: main: tried to /lookup 0 in '2:num <- copy 1:address:num/lookup'
 48 
 49 :(code)
 50 void canonize(reagent& x) {
 51   if (is_literal(x)) return;
 52   // Begin canonize(x) Lookups
 53   while (has_property(x, "lookup"))
 54     lookup_memory(x);
 55 }
 56 
 57 void lookup_memory(reagent& x) {
 58   if (!x.type || x.type->atom || x.type->left->value != get(Type_ordinal, "address")) {
 59     raise << maybe(current_recipe_name()) << "tried to /lookup '" << x.original_string << "' but it isn't an address\n" << end();
 60     return;
 61   }
 62   // compute value
 63   if (x.value == 0) {
 64     raise << maybe(current_recipe_name()) << "tried to /lookup 0\n" << end();
 65     return;
 66   }
 67   lookup_memory_core(x, /*check_for_null*/true);
 68 }
 69 
 70 void lookup_memory_core(reagent& x, bool check_for_null) {
 71   if (x.value == 0) return;
 72   trace("mem") << "location " << x.value << " is " << no_scientific(get_or_insert(Memory, x.value)) << end();
 73   x.set_value(get_or_insert(Memory, x.value));
 74   drop_from_type(x, "address");
 75   if (check_for_null && x.value == 0) {
 76     if (Current_routine)
 77       raise << maybe(current_recipe_name()) << "tried to /lookup 0 in '" << to_original_string(current_instruction()) << "'\n" << end();
 78     else
 79       raise << "tried to /lookup 0\n" << end();
 80   }
 81   drop_one_lookup(x);
 82 }
 83 
 84 :(before "End Preprocess types_strictly_match(reagent to, reagent from)")
 85 if (!canonize_type(to)) return false;
 86 if (!canonize_type(from)) return false;
 87 
 88 :(before "End Preprocess is_mu_array(reagent r)")
 89 if (!canonize_type(r)) return false;
 90 
 91 :(before "End Preprocess is_mu_address(reagent r)")
 92 if (!canonize_type(r)) return false;
 93 
 94 :(before "End Preprocess is_mu_number(reagent r)")
 95 if (!canonize_type(r)) return false;
 96 :(before "End Preprocess is_mu_boolean(reagent r)")
 97 if (!canonize_type(r)) return false;
 98 :(before "End Preprocess is_mu_character(reagent r)")
 99 if (!canonize_type(r)) return false;
100 
101 :(after "Update product While Type-checking Merge")
102 if (!canonize_type(product)) continue;
103 
104 :(before "End Compute Call Ingredient")
105 canonize_type(ingredient);
106 :(before "End Preprocess NEXT_INGREDIENT product")
107 canonize_type(product);
108 :(before "End Check RETURN Copy(lhs, rhs)
109 canonize_type(lhs);
110 canonize_type(rhs);
111 
112 :(before "Compute Container Size(reagent rcopy)")
113 if (!canonize_type(rcopy)) return;
114 
115 :(before "Compute Container Size(element, full_type)")
116 assert(!has_property(element, "lookup"));
117 :(before "Compute Exclusive Container Size(element, full_type)")
118 assert(!has_property(element, "lookup"));
119 
120 :(code)
121 bool canonize_type(reagent& r) {
122   while (has_property(r, "lookup")) {
123     if (!r.type || r.type->atom || !r.type->left || !r.type->left->atom || r.type->left->value != get(Type_ordinal, "address")) {
124       raise << "cannot perform lookup on '" << r.name << "' because it has non-address type " << to_string(r.type) << '\n' << end();
125       return false;
126     }
127     drop_from_type(r, "address");
128     drop_one_lookup(r);
129   }
130   return true;
131 }
132 
133 void drop_one_lookup(reagent& r) {
134   for (vector<pair<string, string_tree*> >::iterator p = r.properties.begin();  p != r.properties.end();  ++p) {
135     if (p->first == "lookup") {
136       r.properties.erase(p);
137       return;
138     }
139   }
140   assert(false);
141 }
142 
143 //: Tedious fixup to support addresses in container/array instructions of previous layers.
144 //: Most instructions don't require fixup if they use the 'ingredients' and
145 //: 'products' variables in run_current_routine().
146 
147 :(scenario get_indirect)
148 def main [
149   1:address:point <- copy 10/unsafe
150   10:num <- copy 34
151   11:num <- copy 35
152   2:num <- get 1:address:point/lookup, 0:offset
153 ]
154 +mem: storing 34 in location 2
155 
156 :(scenario get_indirect2)
157 def main [
158   1:address:point <- copy 10/unsafe
159   10:num <- copy 34
160   11:num <- copy 35
161   2:address:num <- copy 20/unsafe
162   2:address:num/lookup <- get 1:address:point/lookup, 0:offset
163 ]
164 +mem: storing 34 in location 20
165 
166 :(scenario include_nonlookup_properties)
167 def main [
168   1:address:point <- copy 10/unsafe
169   10:num <- copy 34
170   11:num <- copy 35
171   2:num <- get 1:address:point/lookup/foo, 0:offset
172 ]
173 +mem: storing 34 in location 2
174 
175 :(after "Update GET base in Check")
176 if (!canonize_type(base)) break;
177 :(after "Update GET product in Check")
178 if (!canonize_type(product)) break;
179 :(after "Update GET base in Run")
180 canonize(base);
181 
182 :(scenario put_indirect)
183 def main [
184   1:address:point <- copy 10/unsafe
185   10:num <- copy 34
186   11:num <- copy 35
187   1:address:point/lookup <- put 1:address:point/lookup, 0:offset, 36
188 ]
189 +mem: storing 36 in location 10
190 
191 :(after "Update PUT base in Check")
192 if (!canonize_type(base)) break;
193 :(after "Update PUT offset in Check")
194 if (!canonize_type(offset)) break;
195 :(after "Update PUT base in Run")
196 canonize(base);
197 
198 :(scenario put_product_error_with_lookup)
199 % Hide_errors = true;
200 def main [
201   1:address:point <- copy 10/unsafe
202   10:num <- copy 34
203   11:num <- copy 35
204   1:address:point <- put 1:address:point/lookup, x:offset, 36
205 ]
206 +error: main: product of 'put' must be first ingredient '1:address:point/lookup', but got '1:address:point'
207 
208 :(before "End PUT Product Checks")
209 reagent/*copy*/ p = inst.products.at(0);
210 if (!canonize_type(p)) break;  // error raised elsewhere
211 reagent/*copy*/ i = inst.ingredients.at(0);
212 if (!canonize_type(i)) break;  // error raised elsewhere
213 if (!types_strictly_match(p, i)) {
214   raise << maybe(get(Recipe, r).name) << "product of 'put' must be first ingredient '" << inst.ingredients.at(0).original_string << "', but got '" << inst.products.at(0).original_string << "'\n" << end();
215   break;
216 }
217 
218 :(scenario new_error)
219 % Hide_errors = true;
220 def main [
221   1:num/raw <- new number:type
222 ]
223 +error: main: product of 'new' has incorrect type: '1:num/raw <- new number:type'
224 
225 :(after "Update NEW product in Check")
226 canonize_type(product);
227 
228 :(scenario copy_array_indirect)
229 def main [
230   10:array:num:3 <- create-array
231   11:num <- copy 14
232   12:num <- copy 15
233   13:num <- copy 16
234   1:address:array:num <- copy 10/unsafe
235   2:array:num <- copy 1:address:array:num/lookup
236 ]
237 +mem: storing 3 in location 2
238 +mem: storing 14 in location 3
239 +mem: storing 15 in location 4
240 +mem: storing 16 in location 5
241 
242 :(scenario create_array_indirect)
243 def main [
244   1:address:array:num:3 <- copy 1000/unsafe  # pretend allocation
245   1:address:array:num:3/lookup <- create-array
246 ]
247 +mem: storing 3 in location 1000
248 
249 :(after "Update CREATE_ARRAY product in Check")
250 if (!canonize_type(product)) break;
251 :(after "Update CREATE_ARRAY product in Run")
252 canonize(product);
253 
254 :(scenario index_indirect)
255 def main [
256   10:array:num:3 <- create-array
257   11:num <- copy 14
258   12:num <- copy 15
259   13:num <- copy 16
260   1:address:array:num <- copy 10/unsafe
261   2:num <- index 1:address:array:num/lookup, 1
262 ]
263 +mem: storing 15 in location 2
264 
265 :(before "Update INDEX base in Check")
266 if (!canonize_type(base)) break;
267 :(before "Update INDEX index in Check")
268 if (!canonize_type(index)) break;
269 :(before "Update INDEX product in Check")
270 if (!canonize_type(product)) break;
271 
272 :(before "Update INDEX base in Run")
273 canonize(base);
274 :(before "Update INDEX index in Run")
275 canonize(index);
276 
277 :(scenario put_index_indirect)
278 def main [
279   10:array:num:3 <- create-array
280   11:num <- copy 14
281   12:num <- copy 15
282   13:num <- copy 16
283   1:address:array:num <- copy 10/unsafe
284   1:address:array:num/lookup <- put-index 1:address:array:num/lookup, 1, 34
285 ]
286 +mem: storing 34 in location 12
287 
288 :(scenario put_index_indirect_2)
289 def main [
290   1:array:num:3 <- create-array
291   2:num <- copy 14
292   3:num <- copy 15
293   4:num <- copy 16
294   5:address:num <- copy 10/unsafe
295   10:num <- copy 1
296   1:array:num:3 <- put-index 1:array:num:3, 5:address:num/lookup, 34
297 ]
298 +mem: storing 34 in location 3
299 
300 :(scenario put_index_product_error_with_lookup)
301 % Hide_errors = true;
302 def main [
303   10:array:num:3 <- create-array
304   11:num <- copy 14
305   12:num <- copy 15
306   13:num <- copy 16
307   1:address:array:num <- copy 10/unsafe
308   1:address:array:num <- put-index 1:address:array:num/lookup, 1, 34
309 ]
310 +error: main: product of 'put-index' must be first ingredient '1:address:array:num/lookup', but got '1:address:array:num'
311 
312 :(before "End PUT_INDEX Product Checks")
313 reagent/*copy*/ p = inst.products.at(0);
314 if (!canonize_type(p)) break;  // error raised elsewhere
315 reagent/*copy*/ i = inst.ingredients.at(0);
316 if (!canonize_type(i)) break;  // error raised elsewhere
317 if (!types_strictly_match(p, i)) {
318   raise << maybe(get(Recipe, r).name) << "product of 'put-index' must be first ingredient '" << inst.ingredients.at(0).original_string << "', but got '" << inst.products.at(0).original_string << "'\n" << end();
319   break;
320 }
321 
322 :(scenario dilated_reagent_in_static_array)
323 def main [
324   {1: (array (address number) 3)} <- create-array
325   5:address:num <- new number:type
326   {1: (array (address number) 3)} <- put-index {1: (array (address number) 3)}, 0, 5:address:num
327   *5:address:num <- copy 34
328   6:num <- copy *5:address:num
329 ]
330 +run: creating array of size 4
331 +mem: storing 34 in location 6
332 
333 :(before "Update PUT_INDEX base in Check")
334 if (!canonize_type(base)) break;
335 :(before "Update PUT_INDEX index in Check")
336 if (!canonize_type(index)) break;
337 :(before "Update PUT_INDEX value in Check")
338 if (!canonize_type(value)) break;
339 
340 :(before "Update PUT_INDEX base in Run")
341 canonize(base);
342 :(before "Update PUT_INDEX index in Run")
343 canonize(index);
344 
345 :(scenario length_indirect)
346 def main [
347   10:array:num:3 <- create-array
348   11:num <- copy 14
349   12:num <- copy 15
350   13:num <- copy 16
351   1:address:array:num <- copy 10/unsafe
352   2:num <- length 1:address:array:num/lookup
353 ]
354 +mem: storing 3 in location 2
355 
356 :(before "Update LENGTH array in Check")
357 if (!canonize_type(array)) break;
358 :(before "Update LENGTH array in Run")
359 canonize(array);
360 
361 :(scenario maybe_convert_indirect)
362 def main [
363   10:number-or-point <- merge 0/number, 34
364   1:address:number-or-point <- copy 10/unsafe
365   2:num, 3:bool <- maybe-convert 1:address:number-or-point/lookup, i:variant
366 ]
367 +mem: storing 1 in location 3
368 +mem: storing 34 in location 2
369 
370 :(scenario maybe_convert_indirect_2)
371 def main [
372   10:number-or-point <- merge 0/number, 34
373   1:address:number-or-point <- copy 10/unsafe
374   2:address:num <- copy 20/unsafe
375   2:address:num/lookup, 3:bool <- maybe-convert 1:address:number-or-point/lookup, i:variant
376 ]
377 +mem: storing 1 in location 3
378 +mem: storing 34 in location 20
379 
380 :(scenario maybe_convert_indirect_3)
381 def main [
382   10:number-or-point <- merge 0/number, 34
383   1:address:number-or-point <- copy 10/unsafe
384   2:address:bool <- copy 20/unsafe
385   3:num, 2:address:bool/lookup <- maybe-convert 1:address:number-or-point/lookup, i:variant
386 ]
387 +mem: storing 1 in location 20
388 +mem: storing 34 in location 3
389 
390 :(before "Update MAYBE_CONVERT base in Check")
391 if (!canonize_type(base)) break;
392 :(before "Update MAYBE_CONVERT product in Check")
393 if (!canonize_type(product)) break;
394 :(before "Update MAYBE_CONVERT status in Check")
395 if (!canonize_type(status)) break;
396 
397 :(before "Update MAYBE_CONVERT base in Run")
398 canonize(base);
399 :(before "Update MAYBE_CONVERT product in Run")
400 canonize(product);
401 :(before "Update MAYBE_CONVERT status in Run")
402 canonize(status);
403 
404 :(scenario merge_exclusive_container_indirect)
405 def main [
406   1:address:number-or-point <- copy 10/unsafe
407   1:address:number-or-point/lookup <- merge 0/number, 34
408 ]
409 +mem: storing 0 in location 10
410 +mem: storing 34 in location 11
411 
412 :(before "Update size_mismatch Check for MERGE(x)
413 canonize(x);
414 
415 //: abbreviation for '/lookup': a prefix '*'
416 
417 :(scenario lookup_abbreviation)
418 def main [
419   1:address:number <- copy 10/unsafe
420   10:number <- copy 34
421   3:number <- copy *1:address:number
422 ]
423 +parse: ingredient: {1: ("address" "number"), "lookup": ()}
424 +mem: storing 34 in location 3
425 
426 :(before "End Parsing reagent")
427 {
428   while (starts_with(name, "*")) {
429     name.erase(0, 1);
430     properties.push_back(pair<string, string_tree*>("lookup", NULL));
431   }
432   if (name.empty())
433     raise << "illegal name '" << original_string << "'\n" << end();
434 }
435 
436 //:: helpers for debugging
437 
438 :(before "End Primitive Recipe Declarations")
439 _DUMP,
440 :(before "End Primitive Recipe Numbers")
441 put(Recipe_ordinal, "$dump", _DUMP);
442 :(before "End Primitive Recipe Implementations")
443 case _DUMP: {
444   reagent/*copy*/ after_canonize = current_instruction().ingredients.at(0);
445   canonize(after_canonize);
446   cerr << maybe(current_recipe_name()) << current_instruction().ingredients.at(0).name << ' ' << no_scientific(current_instruction().ingredients.at(0).value) << " => " << no_scientific(after_canonize.value) << " => " << no_scientific(get_or_insert(Memory, after_canonize.value)) << '\n';
447   break;
448 }
449 
450 //: grab an address, and then dump its value at intervals
451 //: useful for tracking down memory corruption (writing to an out-of-bounds address)
452 :(before "End Globals")
453 int Bar = -1;
454 :(before "End Primitive Recipe Declarations")
455 _BAR,
456 :(before "End Primitive Recipe Numbers")
457 put(Recipe_ordinal, "$bar", _BAR);
458 :(before "End Primitive Recipe Implementations")
459 case _BAR: {
460   if (current_instruction().ingredients.empty()) {
461     if (Bar != -1) cerr << Bar << ": " << no_scientific(get_or_insert(Memory, Bar)) << '\n';
462     else cerr << '\n';
463   }
464   else {
465     reagent/*copy*/ tmp = current_instruction().ingredients.at(0);
466     canonize(tmp);
467     Bar = tmp.value;
468   }
469   break;
470 }