-- cg.e
-- Code Generation module for Euphoria
-- Pete Eberlein <pete@eberlein.org>
-- 8 Sep 2002


global 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



include machine.e
include misc.e

constant calling_convention =  -- 0=Linux, 1=Windows
    (platform() = WIN32) 


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}


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 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    

constant pushad = #60, popad = #61

function call_near (object dst) return #FF & modrm(2, dst) 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




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



 

sequence
 locals, return_code

function find_var(object name)
  integer idx
  if atom(name) then return {name} end if
  idx = find(name, locals)
  if idx then return {esp,4*(idx-1)} end if
  printf(2, "Could not find var %s\n", {name})
end function  


function branch_gen(sequence st)
  sequence result
  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],
    {"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
        result &= code_gen({st[3]})
        result &= mov(find_var(st[2]), eax)
	
      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] = CALLPROC or st[1] = CALLFUNC then
      for a=length(st) to 3 by -1 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  
        locals = prepend(locals,0)
      end for
      locals = locals[length(st)-1..length(locals)]

      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
      if length(st) = 2 then
        if st[2][1] = VAR then
	  result &= mov(eax, find_var(st[2][2]))
        elsif st[2][1] = CONST then
	  result &= mov(eax,st[2][2])
	end if  
      end if
      --result &= add(esp, 4*(find("_return_address",locals)-1))
      --result &= ret(4*(length(locals)-find("_return_address",locals))*calling_convention)
      result &= return_code
    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] = 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


global function subroutine(sequence arguments, sequence sub_locals, sequence code, integer main)
  sequence result
  locals = sub_locals & {"_return_address"} & arguments
  result = {}
  return_code = {}
  if main then
    result &= pushad
    return_code &= popad
  end if
  if length(sub_locals) then
    result &= sub(esp, 4*length(sub_locals))
    return_code = add(esp, 4*length(sub_locals)) & return_code
  end if
  return_code &= ret(4*length(arguments)*calling_convention)

  return result & code_gen(code) & return_code
end function

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