without warning
include machine.e


constant calling_convention = 0 -- 0=Linux, 1=Windows


constant 
    eax=#BEEF90, 
    ecx=eax+1, 
    edx=eax+2, 
    ebx=eax+3,
    esp=eax+4, 
    ebp=eax+5, 
    esi=eax+6, 
    edi=eax+7

constant operands = {
eax,eax*2,eax*4,eax*8,
ecx,ecx*2,ecx*4,ecx*8,
edx,edx*2,edx*4,edx*8,
ebx,ebx*2,ebx*4,ebx*8,
ebp,ebp*2,ebp*4,ebp*8,
esi,esi*2,esi*4,esi*8,
edi,edi*2,edi*4,edi*8,
esp}

with trace

function autosize(object word, object byte, integer i)
    if i < -128 or i > 127 then
        return word & int_to_bytes(i)
    else
        return byte & i
    end if
end function

function is_immediate (object o)
  if sequence(o) then return 0 end if
  return find(o, {eax,ecx,edx,ebx,esp,ebp,esi,edi}) = 0
end function

function is_register (object o)
  return find(o, {eax,ecx,edx,ebx,esp,ebp,esi,edi}) != 0
end function

function is_memory_address (object o)
  if atom(o) then return 0 end if
  if length(o) != 1 then return 0 end if
  return find(o[1], operands) = 0
end function

function modrm(integer mod, object rm)
-- rm can be {eax}, {eax,ebx}, {eax,ebx*4,5}, {ebx*4}, {ebx*4,5}, or {5}
  integer reg1, reg2, scale, disp, e
  sequence regs, result
  reg1 = 0
  reg2 = 0
  scale = 0
  disp = 0
  if atom(rm) then
    return {#C0 + mod*8 + and_bits(rm,7)}
  end if

  for i = 1 to length(rm) do
    e = find(rm[i], operands)
    if rm[i] = esp then
      if reg1 = 0 and reg2 = 0 then
	reg1 = esp
	reg2 = esp
      else
	puts(2, "modrm: Warning! esp must be alone in effective address\n")
      end if
    elsif e then
      if and_bits(e, 3) = 1 and reg1 = 0 then 
        reg1 = rm[i]
      elsif reg2 = 0 then 
	scale = and_bits(e-1,3)
	reg2 = rm[i] / power(2,scale)
      else  
	puts(2, "modrm: Warning! Too many registers in effective address\n")
      end if
    else
      disp += rm[i]
    end if
  end for
  
  if reg2 then
    result = {mod*8 + 4, scale*#40 + and_bits(reg1,7) + 8*and_bits(reg2,7)}
  else
    result = {mod*8 + and_bits(reg1,7)}
  end if

  if disp = 0 and reg1 != ebp then
  elsif reg1 = 0 then
      result[length(result)] += 5
      result &= int_to_bytes(disp)
  elsif disp <= 127 and disp >= -128 then
      result[1] += #40
      result &= disp
  else
      result[1] += #80 
      result &= int_to_bytes(disp)
  end if  
  
  return result
end function



function multi_op(integer op, object dst, object src)
  -- ops0-7: add, or, adc, sbb, and, sub, xor, cmp
  if atom(dst) then
    if dst >= eax and dst <= edi then
      dst = and_bits(dst, 7)
      if dst = 0 and is_immediate(src) then
        -- mov eax, mem
	return (op*8+#05) & int_to_bytes(src)
      elsif is_immediate(src) then
    	-- mov reg, immediate
	return autosize({#81,op*8+dst+#C0},{#83,op*8+dst+#C0},src)
      else
        -- mov reg, memory expression
	return (op*8+#03) & modrm(dst, src)
      end if
    else
      -- mov immediate, ...  
    end if
  else 
    if is_register(src) then
      -- mov memory expression, register
      return (op*8+#01) & modrm(and_bits(src,7), dst)
    elsif is_immediate(src) then
      -- mov memory expression, immediate
      return autosize(#81 & modrm(op, dst), #83 & modrm(op, dst), src)
    end if
  end if
  puts(1, "multi_op: Not a valid combination of operands\n")
end function  

function add(object dst, object src) return multi_op(0, dst, src) end function
function Or (object dst, object src) return multi_op(1, dst, src) end function
function adc(object dst, object src) return multi_op(2, dst, src) end function
function sbb(object dst, object src) return multi_op(3, dst, src) end function
function And(object dst, object src) return multi_op(4, dst, src) end function
function sub(object dst, object src) return multi_op(5, dst, src) end function
function Xor(object dst, object src) return multi_op(6, dst, src) end function
function cmp(object dst, object src) return multi_op(7, dst, src) end function


function old_add(object dst, object src)
  if atom(dst) then
    if dst >= eax and dst <= edi then
      dst = and_bits(dst, 7)
      if dst = 0 and is_immediate(src) then
        -- mov eax, mem
	return #05 & int_to_bytes(src)
      elsif is_immediate(src) then
    	-- mov reg, immediate
	return autosize({#81,dst+#C0},{#83,dst+#C0},src)
      else
        -- mov reg, memory expression
	return #03 & modrm(dst, src)
      end if
    else
      -- mov immediate, ...  
    end if
  else 
    if is_register(src) then
      -- mov memory expression, register
      return #01 & modrm(and_bits(src,7), dst)
    elsif is_immediate(src) then
      -- mov memory expression, immediate
      return #81 & modrm(0, dst) & int_to_bytes(src)
    end if
  end if
  puts(1, "add: Not a valid combination of operands\n")
end function  



function mov (object dst, object src)
  if atom(dst) then
    if dst >= eax and dst <= edi then
      dst = and_bits(dst, 7)
      if is_immediate(src) then
    	-- mov reg, immediate
	return (#B8 + dst) & int_to_bytes(src)
      elsif dst = 0 and is_memory_address(src) then
        -- mov eax, mem
	return #A1 & int_to_bytes(src[1])
      else
        -- mov reg, memory expression
	return #8B & modrm(dst, src)
      end if
    else
      -- mov immediate, ...  
    end if
  else 
    if is_memory_address(dst) and equal(src, eax) then
      -- mov mem, eax
      return #A3 & int_to_bytes(dst[1])
    elsif is_register(src) then
      -- mov memory expression, register
      return #89 & modrm(and_bits(src,7), dst)
    elsif is_immediate(src) then
      -- mov memory expression, immediate
      return #C7 & modrm(0, dst) & int_to_bytes(src)
    end if
  end if
  puts(1, "mov: Not a valid combination of operands\n")
end function

function lea (object dst, object src)
  if is_register(dst) and sequence(src) then
    return #8D & modrm(and_bits(src,7), dst)
  end if
  puts(1, "lea: Not a valid combination of operands\n")
end function

function push (object src) 
  if is_immediate(src) then
    return #68 & int_to_bytes(src)
  elsif is_register(src) then
    return #50 + and_bits(src,7)
  end if
  return #FF & modrm(6,src)
end function    

function push_dword (atom i) return #68 & int_to_bytes(i) end function
function push_mem (atom i) return {#FF,#35}&int_to_bytes(i) end function
function push_stk (atom i) return #FF&autosize({#B4,#24},{#74,24},i) end function

function add_esp (integer i) return autosize({#81,#C4},{#83,#C4},i) end function
function mov_eax (atom i) return #B8 & int_to_bytes(i) end function
function mov_eax_stk (atom i) return #8B&autosize({#84,#24},{#44,#24},i) end function
function mov_stk_eax (atom i) return #89&autosize({#84,#24},{#44,#24},i) end function
function mov_eax_mem (atom i) return #A3 & int_to_bytes(i) end function
function mov_mem_eax (atom i) return #A1 & int_to_bytes(i) end function
function ret (integer i) 
  if i then return #C2 & and_bits({i,floor(i/256)},255)
  else return {#C3} end if 
end function
function call_near (object dst) return #FF & modrm(2, dst) end function


function push_at_ebp (integer p) return #FF & autosize(#B5,#75,p) end function
function mov_at_ebp (integer p, atom i)
    return #C7 & autosize(#85,#45,p) & int_to_bytes(i)
end function


constant 
  kind_jumps={"JO","JNO","JB","JNAE","JNB","JAE","JZ","JE","JNZ","JNE","JBE",
  "JNA","JNBE","JA","JS","JNS","JP","JPE","JNP","JPO","JL","JNGE","JNL","JGE",
  "JLE","JNG","JNLE","JG","JMP"},
  short_jumps={#70,#71,#72,#72,#73,#73,#74,#74,#75,#75,#76,#76,#77,#77,#78,#79,
  #7A,#7A,#7B,#7B,#7C,#7C,#7D,#7D,#7E,#7E,#7F,#7F,#EB},
  near_jumps={{#0F,#80},{#0F,#81},{#0F,#82},{#0F,#82},{#0F,#83},{#0F,#83},
  {#0F,#84},{#0F,#84},{#0F,#85},{#0F,#85},{#0F,#86},{#0F,#86},{#0F,#87},
  {#0F,#87},{#0F,#88},{#0F,#89},{#0F,#8A},{#0F,#8A},{#0F,#8B},{#0F,#8B},
  {#0F,#8C},{#0F,#8C},{#0F,#8D},{#0F,#8D},{#0F,#8E},{#0F,#8E},{#0F,#8F},
  {#0F,#8F},{#E9}}
  
function jump_blocks(sequence blocks) 
    -- blocks: {{{code},condition,target1[,target2]},...}
    sequence result
    sequence offsets, deltas
    integer ok
    deltas = repeat(0, length(blocks))
    offsets = repeat(0, length(blocks)+1)
    for i = 1 to length(blocks) do
        offsets[i+1] = offsets[i] + length(blocks[i][1]) + 2
    end for
    ok = 0
    while not ok do
        ok = 1
        ? {deltas,offsets}
        for i = 1 to length(blocks) do
            if deltas[i] < -128 or deltas[i] > 127 then
                deltas[i] = offsets[blocks[i][3]] - offsets[i+1]
            else
                deltas[i] = offsets[blocks[i][3]] - offsets[i+1]
                if deltas[i] < -128 or deltas[i] > 127 then
                    offsets[i+1..length(offsets)] += length(near_jumps[
		    find(blocks[i][2], kind_jumps)])+2
                    ok = 0
                    --exit  
                end if
            end if
        end for
    end while
    result = repeat(0,offsets[length(offsets)])
    for i = 1 to length(blocks) do
        if deltas[i] < -128 or deltas[i] > 127 then
            result[offsets[i]+1..offsets[i+1]] = blocks[i][1] & 
                near_jumps[find(blocks[i][2], kind_jumps)] & int_to_bytes(deltas[i])
        else
            result[offsets[i]+1..offsets[i+1]] = blocks[i][1] & 
                short_jumps[find(blocks[i][2], kind_jumps)] & deltas[i]
        end if           
    end for
    return result
end function



constant 
 ASSIGN=1,
 POKE4=2,
 PEEK4=3,
 ADDTO=4,
 CALLPROC=5,
 CALLFUNC=6,
 RETURN=7,
 WHILE=8,
 IF=9,
 CONST=10,
 VAR=11,

 EQUALS=12,
 NOT_EQUALS=13,
 LESS_THAN=14,
 GREATER_THAN=15,
 LESS_EQUALS=16,
 GREATER_EQUALS=17,
 AND=18,
 OR=19,
 XOR=20
 

sequence
 locals, globals

function find_var(sequence name)
  integer idx
  idx = find(name, locals)
  if idx then return {esp,4*(length(locals)-idx)} end if
  puts(1, "warning: variable not found\n")
  -- don't know what to do with globals yet
  return {}
end function  


function branch_gen(sequence st)
  sequence result, jmps
  if st[2][2][1] = VAR and st[2][3][1] = CONST then
    result = cmp(find_var(st[2][2][2]), st[2][3][2])
  elsif st[2][2][1] = VAR and st[2][3][1] = VAR then
    result = mov(eax,find_var(st[2][3][2])) & cmp(find_var(st[2][2][2]), eax)
  elsif st[2][2][1] = CONST and st[2][3][1] = VAR then
    result = mov(eax,st[2][3][2]) & cmp(eax,find_var(st[2][2][2]))
  elsif st[2][2][1] = CONST and st[2][3][1] = CONST then
    result = mov(eax,st[2][3][2]) & cmp(eax,st[2][2][2])
  end if
  return {result, kind_jumps[find(st[2][1],
--  {0,0,0,0,0,0,0,NOT_EQUALS,0,
--    EQUALS,0,0,0,0,0,0,0,0,0,GREATER_EQUALS,LESS_THAN,0,0,GREATER_THAN,
--    LESS_EQUALS,0,0}
    {"JO","JNO","JB","JNAE","JNB","JAE","JZ",NOT_EQUALS,"JNZ",EQUALS,"JBE",
  "JNA","JNBE","JA","JS","JNS","JP","JPE","JNP","JPO","JL",GREATER_EQUALS,LESS_THAN,"JGE",
  "JLE",GREATER_THAN,LESS_EQUALS,"JG","JMP"}
    
    )], 3}
end function

function code_gen(sequence code)
  sequence result, st
  result = {}
  for i = 1 to length(code) do
    st = code[i]
    if st[1] = ASSIGN then
      if st[3][1] = CONST then
        result &= mov(find_var(st[2]), st[3][2])
      elsif st[3][1] = VAR then
        result &= mov(eax, find_var(st[3][2])) & mov(find_var(st[2]), eax)
      elsif st[3][1] = CALLFUNC then

      elsif st[3][1] = PEEK4 then
        if st[3][2][1] = CONST then
	  result &= mov(eax, {st[3][2][2]})
	elsif st[3][2][1] = VAR then
	  result &= mov(eax, find_var(st[3][2][2])) & mov(eax, {eax})
        else
	  puts(1, "error\n")
	end if
        result &= mov(find_var(st[2]), eax)
      else
        puts(1, "error\n")
      end if
        
    elsif st[1] = POKE4 then
      if st[2][1] = CONST and st[3][1] = CONST then
      	result &= mov({st[2][2]}, st[3][2])
      elsif st[2][1] = CONST and st[3][1] = VAR then
      	result &= mov(eax,find_var(st[3][2])) & mov({st[2][2]}, eax)
      elsif st[2][1] = VAR and st[3][1] = CONST then
      	result &= mov(eax,find_var(st[2][2])) & mov({eax},st[3][2])
      elsif st[2][1] = VAR and st[3][1] = VAR then
      	result &= mov(edi,find_var(st[2][2])) 
	        & mov(eax,find_var(st[3][2])) 
		& mov({edi},eax)
      else
        puts(1, "error\n")
      end if
    
    elsif st[1] = ADDTO then
      if st[3][1] = CONST then
        result &= add(find_var(st[2]), st[3][2])
      elsif st[3][1] = VAR then
        result &= mov(eax, find_var(st[3][2])) & add(find_var(st[2]), eax)
      else
        puts(1, "error\n")
      end if

    elsif st[1] = CALLPROC then
      for a=3 to length(st) do
        if st[a][1] = VAR then
	  result &= push(find_var(st[a][2]))
        elsif st[a][1] = CONST then
	  result &= push(st[a][2])
	end if  
      end for
      result &= mov(eax, st[2]) & call_near(eax)
      if calling_convention = 0 and length(st) > 2 then
        result &= add(esp,4*(length(st)-2))
      end if
    elsif st[1] = RETURN then
      result &= add(esp, 4*(length(locals)-find("_return_address",locals)))
      result &= ret(4*(find("_return_address",locals)-1)*calling_convention)
      
    elsif st[1] = WHILE then
      result &= jump_blocks({
        branch_gen(st),
        {code_gen(st[3]),"JMP",1}})

    elsif st[1] = IF then
      if length(st) = 3 then
        result &= jump_blocks({
          branch_gen(st),
          {code_gen(st[3]),"JMP",3}})
      elsif length(st) = 4 then
        result &= jump_blocks({
          branch_gen(st),
          {code_gen(st[3]),"JMP",4},
          {code_gen(st[4]),"JMP",4}})
      end if
    else
      puts(1, "error\n")
    end if
  end for
  return result
end function


function subroutine(sequence arguments, sequence sub_locals, sequence code)
  locals = arguments & {"_return_address"} & sub_locals
  return 
    sub(esp, 4*length(sub_locals)) &
    code_gen(code) &
    add(esp, 4*length(sub_locals)) &
    ret(4*length(arguments)*calling_convention)
end function

function memorize(sequence code)
  atom c
  c = allocate(length(code))
  poke(c, code)
  return c
end function







function callback(integer i) 
  puts(1,"\ncallback activated: ")
  ? i
  return 1
end function



function hex(object s)
  sequence result
  if sequence(s) then
    result = ""
    for i=1 to length(s) do 
      if i > 1 then result &= "," end if
      result &= hex(s[i])
    end for
    return "{"&result&"}"
  elsif s>=0 and s<=255 then
    return sprintf("#%02x",{s})
  end if
  return sprintf("#%08x",{s})
end function
    


include asm.e
asm_output(1,1)

include dll.e

--? get_asm("mov dword ptr [64], eax")
? get_asm("xor  dword ptr [ebx], 50")
puts(1, "   "&hex(Xor({ebx},50)))
? get_asm("mov eax, 10000  call near eax")
puts(1, "   "&hex(mov(eax,10000) & call_near(eax)))
constant test = subroutine({"a"},{"b"}, {
    {ASSIGN, "b", {CONST,500}},
    {ADDTO, "b", {VAR,"b"}},
    {ADDTO, "b", {CONST,100}},
    {WHILE, {LESS_EQUALS, {VAR, "b"}, {CONST, 2000}}, {
      {ADDTO, "b", {CONST,100}},
      {CALLPROC, call_back(routine_id("callback")), {VAR,"b"}}
    }},
    {RETURN},
    {CALLPROC, call_back(routine_id("callback")), {VAR,"b"}}
    
})
puts(1, "   "&hex(test))
call(memorize(test))