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