diff options
Diffstat (limited to '033address.cc')
-rw-r--r-- | 033address.cc | 387 |
1 files changed, 387 insertions, 0 deletions
diff --git a/033address.cc b/033address.cc new file mode 100644 index 00000000..1b956fe0 --- /dev/null +++ b/033address.cc @@ -0,0 +1,387 @@ +//: Instructions can read from addresses pointing at other locations using the +//: 'lookup' property. + +:(scenario copy_indirect) +def main [ + 1:address:number <- copy 2/unsafe + 2:number <- copy 34 + # This loads location 1 as an address and looks up *that* location. + 3:number <- copy 1:address:number/lookup +] ++mem: storing 34 in location 3 + +:(before "End Preprocess read_memory(x)") +canonize(x); + +//: similarly, write to addresses pointing at other locations using the +//: 'lookup' property +:(scenario store_indirect) +def main [ + 1:address:number <- copy 2/unsafe + 1:address:number/lookup <- copy 34 +] ++mem: storing 34 in location 2 + +:(before "End Preprocess write_memory(x)") +canonize(x); +if (x.value == 0) { + raise << "can't write to location 0 in '" << to_original_string(current_instruction()) << "'\n" << end(); + return; +} + +//: writes to address 0 always loudly fail +:(scenario store_to_0_fails) +% Hide_errors = true; +def main [ + 1:address:number <- copy 0 + 1:address:number/lookup <- copy 34 +] +-mem: storing 34 in location 0 ++error: can't write to location 0 in '1:address:number/lookup <- copy 34' + +:(code) +void canonize(reagent& x) { + if (is_literal(x)) return; + // End canonize(x) Special-cases + while (has_property(x, "lookup")) + lookup_memory(x); +} + +void lookup_memory(reagent& x) { + if (!x.type || x.type->value != get(Type_ordinal, "address")) { + raise << maybe(current_recipe_name()) << "tried to /lookup " << x.original_string << " but it isn't an address\n" << end(); + return; + } + // compute value + if (x.value == 0) { + raise << maybe(current_recipe_name()) << "tried to /lookup 0\n" << end(); + return; + } + trace(9999, "mem") << "location " << x.value << " is " << no_scientific(get_or_insert(Memory, x.value)) << end(); + x.set_value(get_or_insert(Memory, x.value)); + drop_from_type(x, "address"); + // End Drop Address In lookup_memory(x) + drop_one_lookup(x); +} + +:(after "bool types_strictly_match(reagent to, reagent from)") + if (!canonize_type(to)) return false; + if (!canonize_type(from)) return false; + +:(after "bool is_mu_array(reagent r)") + if (!canonize_type(r)) return false; + +:(after "bool is_mu_address(reagent r)") + if (!canonize_type(r)) return false; + +:(after "bool is_mu_number(reagent r)") + if (!canonize_type(r)) return false; +:(after "bool is_mu_boolean(reagent r)") + if (!canonize_type(r)) return false; + +:(after "Update product While Type-checking Merge") +if (!canonize_type(product)) continue; + +:(before "End Compute Call Ingredient") +canonize_type(ingredient); +:(before "End Preprocess NEXT_INGREDIENT product") +canonize_type(product); +:(before "End Check REPLY Copy(lhs, rhs) +canonize_type(lhs); +canonize_type(rhs); + +:(code) +bool canonize_type(reagent& r) { + while (has_property(r, "lookup")) { + if (!r.type || r.type->value != get(Type_ordinal, "address")) { + raise << "can't lookup non-address: " << to_string(r) << ": " << to_string(r.type) << '\n' << end(); + return false; + } + drop_from_type(r, "address"); + // End Drop Address In canonize_type(r) + drop_one_lookup(r); + } + return true; +} + +void drop_from_type(reagent& r, string expected_type) { + if (r.type->name != expected_type) { + raise << "can't drop2 " << expected_type << " from " << to_string(r) << '\n' << end(); + return; + } + type_tree* tmp = r.type; + r.type = tmp->right; + tmp->right = NULL; + delete tmp; +} + +void drop_one_lookup(reagent& r) { + for (vector<pair<string, string_tree*> >::iterator p = r.properties.begin(); p != r.properties.end(); ++p) { + if (p->first == "lookup") { + r.properties.erase(p); + return; + } + } + assert(false); +} + +//:: 'get' can read from container address +:(scenario get_indirect) +def main [ + 1:number <- copy 2 + 2:number <- copy 34 + 3:number <- copy 35 + 4:number <- get 1:address:point/lookup, 0:offset +] ++mem: storing 34 in location 4 + +:(scenario get_indirect2) +def main [ + 1:number <- copy 2 + 2:number <- copy 34 + 3:number <- copy 35 + 4:address:number <- copy 5/unsafe + *4:address:number <- get 1:address:point/lookup, 0:offset +] ++mem: storing 34 in location 5 + +:(scenario include_nonlookup_properties) +def main [ + 1:number <- copy 2 + 2:number <- copy 34 + 3:number <- copy 35 + 4:number <- get 1:address:point/lookup/foo, 0:offset +] ++mem: storing 34 in location 4 + +:(after "Update GET base in Check") +if (!canonize_type(base)) break; +:(after "Update GET product in Check") +if (!canonize_type(product)) break; +:(after "Update GET base in Run") +canonize(base); + +:(scenario put_indirect) +# 'put' can read from container address +def main [ + 1:number <- copy 2 + 2:number <- copy 34 + 3:number <- copy 35 + 1:address:point/lookup <- put 1:address:point/lookup, 0:offset, 36 +] ++mem: storing 36 in location 2 + +:(after "Update PUT base in Check") +if (!canonize_type(base)) break; +:(after "Update PUT offset in Check") +if (!canonize_type(offset)) break; +:(after "Update PUT base in Run") +canonize(base); + +:(scenario copy_array_indirect) +def main [ + 1:array:number:3 <- create-array + 2:number <- copy 14 + 3:number <- copy 15 + 4:number <- copy 16 + 5:address:array:number <- copy 1/unsafe + 6:array:number <- copy *5:address:array:number +] ++mem: storing 3 in location 6 ++mem: storing 14 in location 7 ++mem: storing 15 in location 8 ++mem: storing 16 in location 9 + +:(before "Update CREATE_ARRAY product in Check") +// 'create-array' does not support indirection. Static arrays are meant to be +// allocated on the 'stack'. +assert(!has_property(product, "lookup")); +:(before "Update CREATE_ARRAY product in Run") +// 'create-array' does not support indirection. Static arrays are meant to be +// allocated on the 'stack'. +assert(!has_property(product, "lookup")); + +:(scenario index_indirect) +def main [ + 1:array:number:3 <- create-array + 2:number <- copy 14 + 3:number <- copy 15 + 4:number <- copy 16 + 5:address:array:number <- copy 1/unsafe + 6:number <- index 5:address:array:number/lookup, 1 +] ++mem: storing 15 in location 6 + +:(before "Update INDEX base in Check") +if (!canonize_type(base)) break; +:(before "Update INDEX index in Check") +if (!canonize_type(index)) break; +:(before "Update INDEX product in Check") +if (!canonize_type(product)) break; + +:(before "Update INDEX base in Run") +canonize(base); +:(before "Update INDEX index in Run") +canonize(index); + +:(scenario put_index_indirect) +def main [ + 1:array:number:3 <- create-array + 2:number <- copy 14 + 3:number <- copy 15 + 4:number <- copy 16 + 5:address:array:number <- copy 1/unsafe + 5:address:array:number/lookup <- put-index 5:address:array:number/lookup, 1, 34 +] ++mem: storing 34 in location 3 + +:(scenario put_index_indirect_2) +def main [ + 1:array:number:3 <- create-array + 2:number <- copy 14 + 3:number <- copy 15 + 4:number <- copy 16 + 5:address:number <- copy 6/unsafe + 6:number <- copy 1 + 5:address:array:number/lookup <- put-index 1:array:number:3, 5:address:number/lookup, 34 +] ++mem: storing 34 in location 3 + +:(before "Update PUT_INDEX base in Check") +if (!canonize_type(base)) break; +:(before "Update PUT_INDEX index in Check") +if (!canonize_type(index)) break; +:(before "Update PUT_INDEX value in Check") +if (!canonize_type(value)) break; + +:(before "Update PUT_INDEX base in Run") +canonize(base); +:(before "Update PUT_INDEX index in Run") +canonize(index); + +:(scenario length_indirect) +def main [ + 1:array:number:3 <- create-array + 2:number <- copy 14 + 3:number <- copy 15 + 4:number <- copy 16 + 5:address:array:number <- copy 1/unsafe + 6:number <- length 5:address:array:number/lookup +] ++mem: storing 3 in location 6 + +:(before "Update LENGTH array in Check") +if (!canonize_type(array)) break; +:(before "Update LENGTH array in Run") +canonize(array); + +:(scenario maybe_convert_indirect) +def main [ + 1:number-or-point <- merge 0/number, 34 + 10:address:number-or-point <- copy 1/unsafe + 11:number, 12:boolean <- maybe-convert 10:address:number-or-point/lookup, i:variant +] ++mem: storing 34 in location 11 ++mem: storing 1 in location 12 + +:(scenario maybe_convert_indirect_2) +def main [ + 1:number-or-point <- merge 0/number, 34 + 10:address:number-or-point <- copy 1/unsafe + 11:address:number <- copy 20/unsafe + 11:address:number/lookup, 12:boolean <- maybe-convert 10:address:number-or-point/lookup, i:variant +] ++mem: storing 34 in location 20 ++mem: storing 1 in location 12 + +:(scenario maybe_convert_indirect_3) +def main [ + 1:number-or-point <- merge 0/number, 34 + 10:address:number-or-point <- copy 1/unsafe + 12:address:boolean <- copy 20/unsafe + 11:number, 12:address:boolean/lookup <- maybe-convert 10:address:number-or-point/lookup, i:variant +] ++mem: storing 34 in location 11 ++mem: storing 1 in location 20 + +:(before "Update MAYBE_CONVERT base in Check") +if (!canonize_type(base)) break; +:(before "Update MAYBE_CONVERT product in Check") +if (!canonize_type(product)) break; +:(before "Update MAYBE_CONVERT status in Check") +if (!canonize_type(status)) break; + +:(before "Update MAYBE_CONVERT base in Run") +canonize(base); +:(before "Update MAYBE_CONVERT product in Run") +canonize(product); +:(before "Update MAYBE_CONVERT status in Run") +canonize(status); + +:(scenario merge_exclusive_container_indirect) +def main [ + 1:address:number-or-point <- copy 10/unsafe + 1:address:number-or-point/lookup <- merge 0/number, 34 +] ++mem: storing 0 in location 10 ++mem: storing 34 in location 11 + +:(before "Update size_mismatch Check for MERGE(x) +canonize(x); + +//:: abbreviation for '/lookup': a prefix '*' + +:(scenario lookup_abbreviation) +def main [ + 1:address:number <- copy 2/unsafe + 2:number <- copy 34 + 3:number <- copy *1:address:number +] ++parse: ingredient: {1: ("address" "number"), "lookup": ()} ++mem: storing 34 in location 3 + +:(before "End Parsing reagent") +{ + while (!name.empty() && name.at(0) == '*') { + name.erase(0, 1); + properties.push_back(pair<string, string_tree*>("lookup", NULL)); + } + if (name.empty()) + raise << "illegal name " << original_string << '\n' << end(); +} + +//:: helpers for debugging + +:(before "End Primitive Recipe Declarations") +_DUMP, +:(before "End Primitive Recipe Numbers") +put(Recipe_ordinal, "$dump", _DUMP); +:(before "End Primitive Recipe Implementations") +case _DUMP: { + reagent after_canonize = current_instruction().ingredients.at(0); + canonize(after_canonize); + 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'; + break; +} + +//: grab an address, and then dump its value at intervals +//: useful for tracking down memory corruption (writing to an out-of-bounds address) +:(before "End Globals") +int Bar = -1; +:(before "End Primitive Recipe Declarations") +_BAR, +:(before "End Primitive Recipe Numbers") +put(Recipe_ordinal, "$bar", _BAR); +:(before "End Primitive Recipe Implementations") +case _BAR: { + if (current_instruction().ingredients.empty()) { + if (Bar != -1) cerr << Bar << ": " << no_scientific(get_or_insert(Memory, Bar)) << '\n'; + else cerr << '\n'; + } + else { + reagent tmp = current_instruction().ingredients.at(0); + canonize(tmp); + Bar = tmp.value; + } + break; +} |