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