set oc_map(0) brk_imp
unset oc_map

set decode(0) "exception = 1;"

set core_start 300
set core_count 299

set take_branch 270

proc check_exist {opcode root} {
  global oc_map

  if {![catch {set foo $oc_map($opcode)}]} {
    puts "...!!!!! found $root on top of existing $foo"
  }
}

proc a {} {return a}
proc x {} {return x}
proc y {} {return y}

#proc get_byte {addr} {return "(this:get_byte($addr))"}
proc get_byte {addr} {return "($addr < 49152 || $addr >= 53248 ? memory\[$addr + 1\] | this:get_byte($addr))"}


####proc get_word {addr} {return "this:get_word($addr)"}
#proc get_word {addr} {return "(this:get_byte($addr) + 256* this:get_byte($addr + 1))"}
proc get_word {addr} {return "(memory\[($addr) + 1\] + 256 * memory\[($addr) + 2\])"}



proc get_ea {} {return "[get_byte ea]"}

proc push_byte {b} {return "
  sp = this.sp; 
  [set_byte (sp+256) $b] 
  sp = sp - 1;
  if (sp == -1)
    sp = 255;
  endif
  this.sp = sp;
"}

proc push_word {w} {return "
  hi = ($w) / 256;
  lo = ($w) % 256;
  [push_byte hi]
  [push_byte lo]
"}

proc pull_byte_into {v} {return "
  sp = (this.sp + 1) % 256;
  $v = [get_byte (sp+256)];
  this.sp = sp;
"}

proc pull_word_into {v} {return "
  [pull_byte_into lo]
  [pull_byte_into hi]
  $v = 256 * hi + lo;
"}


#proc set_byte {addr value} {return "this:set_byte($addr, $value);"}
proc set_byte {addr value} {return "if ($addr < 49152 || $addr >53248) memory\[$addr + 1\] = $value; else this:set_byte($addr, $value); endif"}


proc status_nz {v} {return "p_z = $v == 0; p_n = $v >= 128;"}

proc status_byte {} {return "((((((p_n ? 128 | 0) + (p_z ? 2 | 0)) + (p_c ? 1 | 0)) + (p_i ? 4 | 0)) + (p_d ? 8 | 0)) + (p_v ? 64 | 0) + 48)"}

proc set_status_byte {v} {return "p_n = $v / 128;
p_z = ($v / 2) % 2;
p_c = $v % 2;
p_i = ($v / 4) % 2;
p_d = ($v / 8) % 2;
p_v = ($v / 64) % 2;
"}



set addr(imm) {ea = pc; pc = pc + 1;}
set addr(zpg) "ea = [get_byte pc]; pc = pc + 1;"
set addr(abs) "ea = [get_word pc]; pc = pc + 2;"
set addr(zpx) "ea = ([get_byte pc] + x) % 256; pc = pc + 1;"
set addr(zpy) "ea = ([get_byte pc] + y) % 256; pc = pc + 1;"
set addr(abx) "ea = ([get_word pc] + x) % 65536; pc = pc + 2;"
set addr(aby) "ea = ([get_word pc] + y) % 65536; pc = pc + 2;"
set addr(idx) "tmp = ([get_byte pc] + x) % 256; ea = [get_word tmp]; pc = pc + 1;"
set addr(idy) "ea = ([get_word [get_byte pc]] + y) % 65536; pc = pc + 1;"
set addr(acc) "ea = -1;"
set addr(ind) "ea = [get_word [get_word pc]]; pc = pc + 2;"

proc ins_std {root modes fragment} {
  global core_count core decode

puts $root

    incr core_count
    set core($core_count) "\"core_$root\";\n$fragment"

  foreach p $modes {
    global oc_map addr
    set mode [lindex $p 0]
    set byte [expr [lindex $p 1]]
    set pair "[set root]_[set mode]"
    check_exist $byte $pair
    set oc_map($byte) $pair
    set verb "opcode_$pair"

      set decode($byte) "\"$pair\"; $addr($mode) instr = $core_count; continue;"

    #puts "@rmverb 6502:$verb"
    #puts "@verb 6502:$verb tnt"
    #puts "@program 6502:$verb tnt"
    # puts "this:ea_[set mode]();"
    # puts "this:core_[set root]();"
    #puts "."
  }
}

proc ins_imp {ins byte fragment} {
  global oc_map decode
  set byte [expr $byte]
  set pair "[set ins]_imp"
  set verb "opcode_$pair"
  check_exist $byte $pair
  set oc_map($byte) $pair
  
    set decode($byte) "\"$pair\"; $fragment"

  #puts "@copy 6502:$verb to 6502:__tmp"
  #puts "@rmverb 6502:$verb"
  #puts "@verb 6502:$verb tnt"
  #puts "@copy 6502:__tmp to 6502:$verb"
  #puts "@rmverb 6502:__tmp"
}

proc ins_acc {ins byte fragment} {
  global oc_map decode
  set byte [expr $byte]
  set pair "[set ins]_acc"
  set verb "opcode_$pair"
  # check_exist $byte $pair
  set oc_map($byte) $pair
  
    set decode($byte) "\"$pair\"; $fragment"

  #puts "@copy 6502:$verb to 6502:__tmp"
  #puts "@rmverb 6502:$verb"
  #puts "@verb 6502:$verb tnt"
  #puts "@copy 6502:__tmp to 6502:$verb"
  #puts "@rmverb 6502:__tmp"
}


proc ins_imp_simple {ins byte mooexpr} {
    ins_imp $ins $byte $mooexpr
}

proc ins_imp_simple_dontuse {ins byte mooexpr} {
  global oc_map
  set byte [expr $byte]
  set pair "[set ins]_imp"
  set verb "opcode_$pair"
  check_exist $byte $pair
  set oc_map($byte) $pair

  puts "@rmverb 6502:$verb tnt"
  puts "@verb 6502:$verb tnt"
  puts "@program 6502:$verb tnt"
  puts "$mooexpr"
  puts "."
}


proc ins_bra {ins byte mooexpr} {
  global oc_map decode
  set byte [expr $byte]
  set pair "[set ins]_rel"
  set verb "opcode_$pair"
  check_exist $byte $pair
  set oc_map($byte) $pair

    set decode($byte) "\"$pair\"; if ($mooexpr) instr = 270; continue; else pc = pc + 1; endif"

  #puts "@rmverb 6502:$verb"
  #puts "@verb 6502:$verb tnt"
  #puts "@program 6502:$verb tnt"
  ## puts "this:ea_rel();"
  #puts "this:core_branch($mooexpr);"
  #puts "."
}


proc dump_opcodes {} {
  global oc_map

  puts "@rmverb 6502:init_opcodes"
  puts "@verb 6502:init_opcodes tnt"
  puts "@program 6502:init_opcodes tnt"
  puts {l = $list_utils:make(256, "invalid");}

  set keys [array names oc_map]
  set keys [lsort -integer $keys]
  
  foreach key $keys {
    puts "l\[$key + 1\] = \"$oc_map($key)\";"
  }

  puts "this.opcodes = l;"
  puts "."
}

proc dump_case {} {
    global decode core

    set keys [array names decode]
    set keys [lsort -integer $keys]

    foreach key $keys {
	puts "case ($key)\n  $decode($key)";
    }

    set keys [array names core]
    set keys [lsort -integer $keys]

    foreach key $keys {
	puts "case ($key)\n  $core($key)";
    }
}

proc save_vars {} {
return "\
this.a = a;
this.x = x;
this.y = y;
this.p_n = p_n;
this.p_z = p_z;
this.p_c = p_c;
this.p_i = p_i;
this.p_d = p_d;
this.p_v = p_v;
this.pc = pc;
this.exception = exception;
"
}

proc restore_vars {} {
return "\
a = this.a;
x = this.x;
y = this.y;
p_n = this.p_n;
p_z = this.p_z;
p_c = this.p_c;
p_i = this.p_i;
p_d = this.p_d;
p_v = this.p_v;
pc = this.pc;
exception = this.exception || exception;
"
}

proc verbstart {} {
puts "
@rmverb 6502:new_do_instructions 
@verb 6502:new_do_instructions tnt
@program 6502:new_do_instructions
remaining = args\[1\];
[restore_vars]
try
while (!exception && !this.exception)
\$command_utils:suspend_if_needed(0);
remaining = 30;
while (!exception && remaining > 0)
remaining = remaining - 1;
instr = [get_byte pc];
pc = pc + 1;
switch (instr)
"
}

proc verbend {} {
puts "\
case (270)
offset = [get_byte pc];
pc = pc + 1;
if (offset >= 128)
  offset = offset - 256;
endif
pc = pc + offset;

default
  exception = 1;
  player:tell(\"invalid opcode\");
  this:look_self();
endswitch
endwhile
endwhile
finally
[save_vars]
endtry
.
"
}

ins_std adc "{imm 0x69} {zpg 0x65} {zpx 0x75} {abs 0x6D} {abx 0x7D} {aby 0x79} {idx 0x61} {idy 0x71}" "
    t = [get_ea];
    carry = 0;
    if (p_c)
      carry = 1;
    endif
    sum = (t + a) + carry;
    p_c = sum > 255;
    a6 = (sum / 64) % 2;
    a7 = (sum / 128) % 2;
    m6 = (t / 64) % 2;
    m7 = (t / 128) % 2;
    ts = (a6 == m6) && (a7 == m7);
    p_v = !ts;
    sum = sum % 256;
    a = sum;
    [status_nz a]
"


ins_std and "{imm 0x29} {zpg 0x25} {zpx 0x35} {abs 0x2D} {abx 0x3D} {aby 0x39} {idx 0x21} {idy 0x31}" "
    a = this:AND(a, [get_ea]);
    [status_nz a]
"
    
ins_std asl "{acc 0x0A} {zpg 0x06} {zpx 0x16} {abs 0x0E} {abx 0x1E}" "
    m = [get_ea];
    p_c = m >= 128;
    m = (m * 2) % 256;
    [status_nz m]
    [set_byte ea m]
"

ins_acc asl 0x0A "
    p_c = a >= 128;
    a = (a * 2) % 256;
    [status_nz a]
"

ins_bra bcc 0x90 {!p_c}
ins_bra bcs 0xB0 {p_c}
ins_bra beq 0xF0 {p_z}

ins_std bit "{zpg 0x24} {abs 0x2C}" "
    m = [get_ea];
    res = this:AND(m, a);
    p_z = res == 0;
    m7 = m / 128;
    m6 = (m / 64) % 2;
    p_n = m7;
    p_v = m6;
"

ins_bra bmi 0x30 {p_n}
ins_bra bne 0xD0 {!p_z}
ins_bra bpl 0x10 {!p_n}

ins_imp brk 0x00 {
    exception = 1;
}

ins_bra bvc 0x50 {!p_v}
ins_bra bvs 0x70 {p_v}

ins_imp clc 0x18 {p_c = 0;}
ins_imp cld 0xD8 {p_d = 0;}
ins_imp cli 0x58 {p_i = 0;}
ins_imp clv 0xB8 {p_v = 0;}

ins_std cmp "{imm 0xC9} {zpg 0xC5} {zpx 0xD5} {abs 0xCD} {abx 0xDD} {aby 0xD9} {idx 0xC1} {idy 0xD1}" "
    m = [get_ea];
    p_c = a >= m;
    res = a - m;
    if (res < 0)
      res = res + 256;
    endif
    [status_nz res]
"


ins_std cpx "{imm 0xE0} {zpg 0xE4} {abs 0xEC}" "
  m = [get_ea];
  p_c = x >= m;
  res = x - m;
  if (res < 0)
    res = res + 256;
  endif
  [status_nz res]
"

ins_std cpy "{imm 0xC0} {zpg 0xC4} {abs 0xCC}" "
  m = [get_ea];
  p_c = y >= m;
  res = y - m;
  if (res < 0)
    res = res + 256;
  endif
  [status_nz res]
"

ins_std dec "{zpg 0xC6} {zpx 0xD6} {abs 0xCE} {abx 0xDE}" "
  m = [get_ea];
  m = m - 1;
  if (m == -1)
    m = 255;
  endif
  [set_byte ea m]
  [status_nz m]
"

ins_imp dex 0xCA "x = x - 1; if (x == -1) x = 255; endif [status_nz x]"
ins_imp dey 0x88 "y = y - 1; if (y == -1) y = 255; endif [status_nz y]"

ins_std eor "{imm 0x49} {zpg 0x45} {zpx 0x55} {abs 0x40} {abx 0x5D} {aby 0x59} {idx 0x41} {idy 0x51}" "
    a = this:XOR(a, [get_ea]);
    [status_nz a]
"

ins_std inc "{zpg 0xE6} {zpx 0xF6} {abs 0xEE} {abx 0xFE}" "
  m = [get_ea];
  m = (m + 1) % 256;
  [set_byte ea m]
  [status_nz m]
"

ins_imp inx 0xE8 "x = (x + 1) % 256; [status_nz x]"
ins_imp iny 0xC8 "y = (y + 1) % 256; [status_nz y]"

ins_std jmp "{abs 0x4C} {ind 0x6C}" "pc = ea;"
ins_std jsr "{abs 0x20}" "
  pc = pc - 1;
  [push_word pc]
  pc = ea;
"

ins_std lda "{imm 0xa9} {zpg 0xa5} {zpx 0xb5} {abs 0xad} {abx 0xbd} {aby 0xb9} {idx 0xa1} {idy 0xb1}" "
  a = [get_ea];
  [status_nz a];
"

ins_std ldx "{imm 0xA2} {zpg 0xA6} {zpy 0xB6} {abs 0xAE} {aby 0xBE}" "
  x = [get_ea];
  [status_nz x]
"

ins_std ldy "{imm 0xA0} {zpg 0xA4} {zpx 0xB4} {abs 0xAC} {abx 0xBC}" "
  y = [get_ea];
  [status_nz y]
"

ins_std lsr "{acc 0x4A} {zpg 0x46} {zpx 0x56} {abs 0x4E} {abx 0x5E}" "
  m = [get_ea];
  p_c = m % 2;
  m = m / 2;
  [status_nz m]
  [set_byte ea m]
"

ins_acc lsr 0x4A "
  p_c = a % 2;
  a = a / 2;
  [status_nz a]
"

ins_imp_simple nop 0xEA {"@nop.com";}

ins_std ora "{imm 0x09} {zpg 0x05} {zpx 0x15} {abs 0x0D} {abx 0x1D} {aby 0x19} {idx 0x01} {idy 0x11}" "
    a = this:OR(a, [get_ea]);
    [status_nz a]
"

ins_imp_simple pha 0x48 "[push_byte a]"
ins_imp_simple php 0x08 "
  res = [status_byte];
  [push_byte res]
"

ins_imp_simple pla 0x68 "
  [pull_byte_into a]
  [status_nz a]
"

ins_imp_simple plp 0x28 "
  [pull_byte_into res]
  [set_status_byte res]
"

ins_std rol "{acc 0x2A} {zpg 0x26} {zpx 0x36} {abs 0x2E} {abx 0x3E}" "
  m = [get_ea];
  m7 = m / 128;
  m = ((m * 2) % 256) + p_c;
  p_c = m7;
  [status_nz m]
  [set_byte ea m]
"

ins_acc rol 0x2A "
  m7 = a / 128;
  a = ((a * 2) % 256) + p_c;
  p_c = m7;
  [status_nz a]
"



ins_std ror "{acc 0x6A} {zpg 0x66} {zpx 0x76} {abs 0x6E} {abx 0x7E}" "
  m = [get_ea];
  m0 = m % 2;
  m = (m / 2) + (128 * p_c);
  p_c = m0;
  [status_nz m]
  [set_byte ea m]
"

ins_acc ror 0x6A "
  m0 = a % 2;
  a = (a / 2) + (128 * p_c);
  p_c = m0;
  [status_nz a]
"

ins_imp_simple rti 0x4D "
  [pull_byte_into res]
  [set_status_byte res]
  [pull_word_into pc]
"

ins_imp_simple rts 0x60 "
  [pull_word_into pc]
  pc = pc + 1;
"

ins_std sbc "{imm 0xE9} {zpg 0xE5} {zpx 0xF5} {abs 0xED} {abx 0xFD} {aby 0xF9} {idx 0xE1} {idy 0xF1}" "
    t = [get_ea];
    carry = 0;
    if (!p_c)
      carry = 1;
    endif
    sum = (a - t) - carry;
    p_c = sum >= 0;
    if (sum < 0)
      sum = sum + 256;
    endif
    sum = sum % 256;
    a6 = (sum / 64) % 2;
    a7 = (sum / 128) % 2;
    m6 = (t / 64) % 2;
    m7 = (t / 128) % 2;
    ts = (a6 == m6) && (a7 == m7);
    p_v = !ts;
    a = sum;
    [status_nz a]
"


ins_imp_simple sec 0x38 {p_c = 1;}
ins_imp_simple sed 0xF8 {p_d = 1; player:tell("attempt to set decimal flag");}
ins_imp_simple sei 0x78 {p_i = 1;}

ins_std sta "{zpg 0x85} {zpx 0x95} {abs 0x8d} {abx 0x9D} {aby 0x99} {idx 0x81} {idy 0x91}" "
  [set_byte ea a]
"

ins_std stx "{zpg 0x86} {zpy 0x96} {abs 0x8E}" "[set_byte ea x]"
ins_std sty "{zpg 0x84} {zpx 0x94} {abs 0x8C}" "[set_byte ea y]"

ins_imp_simple tax 0xAA "x = a; [status_nz a]"
ins_imp_simple tay 0xA8 "y = a; [status_nz a]"
ins_imp_simple tsx 0xBA "x = this.sp; [status_nz x]"

ins_imp_simple txa 0x8A "a = x; [status_nz a]"

ins_imp_simple txs 0x9A {this.sp = x;}

ins_imp_simple tya 0x98 "a = y; [status_nz a]"

#dump_opcodes
verbstart
dump_case
verbend