//: Go from an address to the payload it points at (skipping the refcount) //: using /lookup. //: //: Let's say we have this address (read the top of the address layer for //: details on these diagrams): //: //: +---+------------+ //: x -------> | 1 | number | //: +---+------------+ //: //: Once you have an address you can read or modify its payload by performing //: a lookup: //: //: x/lookup <- copy 34 //: //: or more concisely: //: //: *x <- copy 34 //: //: This modifies not x, but the payload x points to: //: //: +---+------------+ //: x -------> | 1 | 34 | //: +---+------------+ //: //: You can also read from the payload in instructions like this: //: //: z:num <- add *x, 1 //: //: After this instruction runs the value of z will be 35. //: //: The tests in this layer use unsafe operations so as to stay decoupled from //: 'new'. :(scenario copy_indirect) def main [ 1:address:num <- copy 10/unsafe 11:num <- copy 34 # This loads location 1 as an address and looks up *that* location. 2:num <- copy 1:address:num/lookup ] # 1 contains 10. Skip refcount and lookup location 11. +mem: storing 34 in location 2 :(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:num <- copy 10/unsafe 1:address:num/lookup <- copy 34 ] +mem: storing 34 in location 11 :(before "End Preprocess write_memory(x, data)") canonize(x); //: writes to address 0 always loudly fail :(scenario store_to_0_fails) % Hide_errors = true; def main [ 1:address:num <- copy 0 1:address:num/lookup <- copy 34 ] -mem: storing 34 in location 0 +error: can't write to location 0 in '1:address:num/lookup <- copy 34' //: attempts to /lookup address 0 always loudly fail :(scenario lookup_0_fails) % Hide_errors = true; def main [ 1:address:num <- copy 0 2:num <- copy 1:address:num/lookup ] +error: tried to /lookup 0 in '2:num <- copy 1:address:num/lookup' :(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->atom || x.type->left->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; } lookup_memory_core(x, /*check_for_null*/true); } void lookup_memory_core(reagent& x, bool check_for_null) { if (x.value == 0) 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"); if (x.value) { trace(9999, "mem") << "skipping refcount at " << x.value << end(); x.set_value(x.value+1); // skip refcount } else if (check_for_null) { if (Current_routine) raise << "tried to /lookup 0 in '" << to_original_string(current_instruction()) << "'\n" << end(); else raise << "tried to /lookup 0\n" << end(); } drop_one_lookup(x); } void test_lookup_address_skips_refcount() { reagent x("*x:address:num"); x.set_value(34); // unsafe put(Memory, 34, 1000); lookup_memory(x); CHECK_TRACE_CONTENTS("mem: skipping refcount at 1000"); CHECK_EQ(x.value, 1001); } void test_lookup_zero_address_does_not_skip_refcount() { Hide_errors = true; reagent x("*x:address:num"); x.set_value(34); // unsafe put(Memory, 34, 0); lookup_memory(x); CHECK_TRACE_DOESNT_CONTAIN("mem: skipping refcount at 0"); CHECK_EQ(x.value, 0); } :(before "End Preprocess types_strictly_match(reagent to, reagent from)") if (!canonize_type(to)) return false; if (!canonize_type(from)) return false; :(before "End Preprocess is_mu_array(reagent r)") if (!canonize_type(r)) return false; :(before "End Preprocess is_mu_address(reagent r)") if (!canonize_type(r)) return false; :(before "End Preprocess is_mu_number(reagent r)") if (!canonize_type(r)) return false; :(before "End Preprocess is_mu_boolean(reagent r)") i
# example program: compute the factorial of 5

def main [
  local-scope
  x:num <- factorial 5
  $print [result: ], x, [ 
]
]

def factorial n:num -> result:num [
  local-scope
  load-inputs
  {
    # if n=0 return 1
    zero?:bool <- equal n, 0
    break-unless zero?
    return 1
  }
  # return n * factorial(n-1)
  x:num <- subtract n, 1
  subresult:num <- factorial x
  result <- multiply subresult, n
]

# unit test
scenario factorial-test [
  run [
    1:num <- factorial 5
  ]
  memory-should-contain [
    1 <- 120
  ]
]
ddress, 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/*copy*/ tmp = current_instruction().ingredients.at(0); canonize(tmp); Bar = tmp.value; } break; }