1 # some utilities for converting numbers from hex
  2 # lowercase letters only for now
  3 
  4 == code
  5 #   instruction                     effective address                                                   register    displacement    immediate
  6 # . op          subop               mod             rm32          base        index         scale       r32
  7 # . 1-3 bytes   3 bits              2 bits          3 bits        3 bits      3 bits        2 bits      2 bits      0/1/2/4 bytes   0/1/2/4 bytes
  8 
  9 hex-int?:  # in: (addr slice) -> result/eax: boolean
 10     # . prologue
 11     55/push-ebp
 12     89/copy                         3/mod/direct    5/rm32/ebp    .           .             .           4/r32/esp   .               .                 # copy esp to ebp
 13     # . save registers
 14     51/push-ecx
 15     52/push-edx
 16     53/push-ebx
 17     # ecx = s
 18     8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .             .           1/r32/ecx   8/disp8         .                 # copy *(ebp+8) to ecx
 19     # edx = s->end
 20     8b/copy                         1/mod/*+disp8   1/rm32/ecx    .           .             .           2/r32/edx   4/disp8         .                 # copy *(ecx+4) to edx
 21     # var curr/ecx: (addr byte) = s->start
 22     8b/copy                         0/mod/indirect  1/rm32/ecx    .           .             .           1/r32/ecx   .               .                 # copy *ecx to ecx
 23     # if s is empty return false
 24     b8/copy-to-eax  0/imm32/false
 25     39/compare                      3/mod/direct    1/rm32/ecx    .           .             .           2/r32/edx   .               .                 # compare ecx with edx
 26     73/jump-if-addr>=  $hex-int?:end/disp8
 27     # skip past leading '-'
 28     # . if (*curr == '-') ++curr
 29     31/xor                          3/mod/direct    3/rm32/ebx    .           .             .           3/r32/ebx   .               .                 # clear ebx
 30     8a/copy-byte                    0/mod/indirect  1/rm32/ecx    .           .             .           3/r32/BL    .               .                 # copy byte at *ecx to BL
 31     81          7/subop/compare     3/mod/direct    3/rm32/ebx    .           .             .           .           .               0x2d/imm32/-      # compare ebx
 32     75/jump-if-!=  $hex-int?:initial-0/disp8
 33     # . ++curr
 34     41/increment-ecx
 35     # skip past leading '0x'
 36 $hex-int?:initial-0:
 37     # . if (*curr != '0') jump to loop
 38     31/xor                          3/mod/direct    3/rm32/ebx    .           .             .           3/r32/ebx   .               .                 # clear ebx
 39     8a/copy-byte                    0/mod/indirect  1/rm32/ecx    .           .             .           3/r32/BL    .               .                 # copy byte at *ecx to BL
 40     81          7/subop/compare     3/mod/direct    3/rm32/ebx    .           .             .           .           .               0x30/imm32/0      # compare ebx
 41     75/jump-if-!=  $hex-int?:loop/disp8
 42     # . ++curr
 43     41/increment-ecx
 44 $hex-int?:initial-0x:
 45     # . if (curr >= in->end) return true
 46     39/compare                      3/mod/direct    1/rm32/ecx    .           .             .           2/r32/edx   .               .                 # compare ecx with edx
 47     73/jump-if-addr>=  $hex-int?:true/disp8
 48     # . if (*curr != 'x') jump to loop  # the previous '0' is still valid so doesn't need to be checked again
 49     31/xor                          3/mod/direct    3/rm32/ebx    .           .             .           3/r32/ebx   .               .                 # clear ebx
 50     8a/copy-byte                    0/mod/indirect  1/rm32/ecx    .           .             .           3/r32/BL    .               .                 # copy byte at *ecx to BL
 51     81          7/subop/compare     3/mod/direct    3/rm32/ebx    .           .             .           .           .               0x78/imm32/x      # compare ebx
 52     75/jump-if-!=  $hex-int?:loop/disp8
 53     # . ++curr
 54     41/increment-ecx
 55 $hex-int?:loop:
 56     # if (curr >= in->end) return true
 57     39/compare                      3/mod/direct    1/rm32/ecx    .           .             .           2/r32/edx   .               .                 # compare ecx with edx
 58     73/jump-if-addr>=  $hex-int?:true/disp8
 59     # var eax: boolean = hex-digit?(*curr)
 60     # . . push args
 61     8a/copy-byte                    0/mod/indirect  1/rm32/ecx    .           .             .           0/r32/AL    .               .                 # copy byte at *ecx to AL
 62     50/push-eax
 63     # . . call
 64     e8/call  hex-digit?/disp32
 65     # . . discard args
 66     81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               4/imm32           # add to esp
 67     # if (eax == false) return false
 68     3d/compare-eax-and  0/imm32/false
 69     74/jump-if-=  $hex-int?:end/disp8
 70     # ++curr
 71     41/increment-ecx
 72     # loop
 73     eb/jump  $hex-int?:loop/disp8
 74 $hex-int?:true:
 75     # return true
 76     b8/copy-to-eax  1/imm32/true
 77 $hex-int?:end:
 78     # . restore registers
 79     5b/pop-to-ebx
 80     5a/pop-to-edx
 81     59/pop-to-ecx
 82     # . epilogue
 83     89/copy                         3/mod/direct    4/rm32/esp    .           .             .           5/r32/ebp   .               .                 # copy ebp to esp
 84     5d/pop-to-ebp
 85     c3/return
 86 
 87 test-hex-int:
 88     # . prologue
 89     55/push-ebp
 90     89/copy                         3/mod/direct    5/rm32/ebp    .           .             .           4/r32/esp   .               .                 # copy esp to ebp
 91     # (eax..ecx) = "34"
 92     b8/copy-to-eax  "34"/imm32
 93     8b/copy                         0/mod/indirect  0/rm32/eax    .           .             .           1/r32/ecx   .               .                 # copy *eax to ecx
 94     8d/copy-address                 1/mod/*+disp8   4/rm32/sib    0/base/eax  1/index/ecx   .           1/r32/ecx   4/disp8         .                 # copy eax+ecx+4 to ecx
 95     05/add-to-eax  4/imm32
 96     # var slice/ecx: slice = {eax, ecx}
 97     51/push-ecx
 98     50/push-eax
 99     89/copy                         3/mod/direct    1/rm32/ecx    .           .             .           4/r32/esp   .               .                 # copy esp to ecx
100     # eax = hex-int?(slice)
101     # . . push args
102     51/push-ecx
103     # . . call
104     e8/call  hex-int?/disp32
105     # . . discard args
106     81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               4/imm32           # add to esp
107     # check-ints-equal(eax, 1, msg)
108     # . . push args
109     68/push  "F - test-hex-int"/imm32
110     68/push  1/imm32/true
111     50/push-eax
112     # . . call
113     e8/call  check-ints-equal/disp32
114     # . . discard args
115     81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               0xc/imm32         # add to esp
116     # . epilogue
117     89/copy                         3/mod/direct    4/rm32/esp    .           .             .           5/r32/ebp   .               .                 :number <- copy 1:literal
  6:array:number <- copy 5:address:array:number/deref
]
+mem: storing 3 in location 6
+mem: storing 14 in location 7
+mem: storing 15 in location 8
+mem: storing 16 in location 9

//: disable the size mismatch check since the destination array need not be initialized
:(after "bool size_mismatch(const reagent& x, const vector<double>& data)")
if (x.types.at(0) == Type_number["array"]) return false;
:(after "long long int size_of(const reagent& r)")
  if (r.types.at(0) == Type_number["array"]) {
    assert(SIZE(r.types) > 1);
    // skip the 'array' type to get at the element type
    return 1 + Memory[r.value]*size_of(array_element(r.types));
  }

//:: To access elements of an array, use 'index'

:(scenario index)
recipe main [
  1:number <- copy 3:literal  # length
  2:number <- copy 14:literal
  3:number <- copy 15:literal
  4:number <- copy 16:literal
  5:number <- index 1:array:number/raw, 0:literal  # unsafe
]
+mem: storing 14 in location 5

:(scenario index_direct_offset)
recipe main [
  1:number <- copy 3:literal  # length
  2:number <- copy 14:literal
  3:number <- copy 15:literal
  4:number <- copy 16:literal
  5:number <- copy 0:literal
  6:number <- index 1:array:number/raw, 5:number  # unsafe
]
+mem: storing 14 in location 6

:(before "End Primitive Recipe Declarations")
INDEX,
:(before "End Primitive Recipe Numbers")
Recipe_number["index"] = INDEX;
:(before "End Primitive Recipe Implementations")
case INDEX: {
//?   if (Trace_stream) Trace_stream->dump_layer = "run"; //? 1
  reagent base = canonize(current_instruction().ingredients.at(0));
//?   trace(Primitive_recipe_depth, "run") << "ingredient 0 after canonize: " << base.to_string(); //? 1
  long long int base_address = base.value;
  assert(base.types.at(0) == Type_number["array"]);
  reagent offset = canonize(current_instruction().ingredients.at(1));
//?   trace(Primitive_recipe_depth, "run") << "ingredient 1 after canonize: " << offset.to_string(); //? 1
  vector<double> offset_val(read_memory(offset));
  vector<type_number> element_type = array_element(base.types);
//?   trace(Primitive_recipe_depth, "run") << "offset: " << offset_val.at(0); //? 1
//?   trace(Primitive_recipe_depth, "run") << "size of elements: " << size_of(element_type); //? 1
  long long int src = base_address + 1 + offset_val.at(0)*size_of(element_type);
  trace(Primitive_recipe_depth, "run") << "address to copy is " << src;
  trace(Primitive_recipe_depth, "run") << "its type is " << Type[element_type.at(0)].name;
  reagent tmp;
  tmp.set_value(src);
  copy(element_type.begin(), element_type.end(), inserter(tmp.types, tmp.types.begin()));
  products.push_back(read_memory(tmp));
  break;
}

:(code)
vector<type_number> array_element(const vector<type_number>& types) {
  return vector<type_number>(++types.begin(), types.end());
}

:(scenario index_address)
recipe main [
  1:number <- copy 3:literal  # length
  2:number <- copy 14:literal
  3:number <- copy 15:literal
  4:number <- copy 16:literal
  5:number <- index-address 1:array:number/raw, 0:literal  # unsafe
]
+mem: storing 2 in location 5

//:: To write to elements of containers, you need their address.

:(scenario index_indirect)
recipe main [
  1:number <- copy 3:literal  # length
  2:number <- copy 14:literal
  3:number <- copy 15:literal
  4:number <- copy 16:literal
  5:address:array:number <- copy 1:literal
  6:number <- index 5:address:array:number/deref, 1:literal
]
+mem: storing 15 in location 6

:(before "End Primitive Recipe Declarations")
INDEX_ADDRESS,
:(before "End Primitive Recipe Numbers")
Recipe_number["index-address"] = INDEX_ADDRESS;
:(before "End Primitive Recipe Implementations")
case INDEX_ADDRESS: {
  reagent base = canonize(current_instruction().ingredients.at(0));
  long long int base_address = base.value;
  assert(base.types.at(0) == Type_number["array"]);
  reagent offset = canonize(current_instruction().ingredients.at(1));
  vector<double> offset_val(read_memory(offset));
  vector<type_number> element_type = array_element(base.types);
  long long int result = base_address + 1 + offset_val.at(0)*size_of(element_type);
  products.resize(1);
  products.at(0).push_back(result);
  break;
}

//:: compute the length of an array

:(scenario array_length)
recipe main [
  1:number <- copy 3:literal  # length
  2:number <- copy 14:literal
  3:number <- copy 15:literal
  4:number <- copy 16:literal
  5:number <- length 1:array:number/raw  # unsafe
]
+mem: storing 3 in location 5

:(before "End Primitive Recipe Declarations")
LENGTH,
:(before "End Primitive Recipe Numbers")
Recipe_number["length"] = LENGTH;
:(before "End Primitive Recipe Implementations")
case LENGTH: {
  reagent x = canonize(current_instruction().ingredients.at(0));
  if (x.types.at(0) != Type_number["array"]) {
    raise << "tried to calculate length of non-array " << x.to_string() << '\n';
    break;
  }
  products.resize(1);
  products.at(0).push_back(Memory[x.value]);
  break;
}