Compiler/code generator: Difference between revisions

Line 4,196:

Reusing parse.e from the [[Compiler/syntax_analyzer#Phix|Syntax Analyzer task]]

Deviates somewhat from the task specification in that it generates executable machine code.

<lang Phix>--

--

-- demo\rosetta\Compiler\cgen.e

-- ============================

--

-- The reusable part of cgen.exw

--

--

without js -- (machine code!)

include parse.e

include parse.e

global sequence vars = {},

global sequence vars = {},

strings = {},

strings = {},

stringptrs = {}

stringptrs = {}

global integer chain = 0

global integer chain = 0

global sequence code = {}

global sequence code = {}

function var_idx(sequence inode)

function var_idx(sequence inode)

if inode[1]!=tk_Identifier then ?9/0 end if

if inode[1]!=tk_Identifier then ?9/0 end if

string ident = inode[2]

string ident = inode[2]

integer n = find(ident,vars)

integer n = find(ident,vars)

if n=0 then

if n=0 then

vars = append(vars,ident)

vars = append(vars,ident)

n = length(vars)

n = length(vars)

end if

end if

return n

return n

end function

end function

function string_idx(sequence inode)

function string_idx(sequence inode)

if inode[1]!=tk_String then ?9/0 end if

if inode[1]!=tk_String then ?9/0 end if

string s = inode[2]

string s = inode[2]

integer n = find(s,strings)

integer n = find(s,strings)

if n=0 then

if n=0 then

strings = append(strings,s)

strings = append(strings,s)

stringptrs = append(stringptrs,0)

stringptrs = append(stringptrs,0)

n = length(strings)

n = length(strings)

end if

end if

return n

return n

end function

end function

function gen_size(object t)

function gen_size(object t)

-- note: must be kept precisely in sync with gen_rec!

-- note: must be kept precisely in sync with gen_rec!

-- (relentlessly tested via estsize/actsize)

-- (relentlessly tested via estsize/actsize)

integer size = 0

integer size = 0

if t!=NULL then

if t!=NULL then

integer n_type = t[1]

integer n_type = t[1]

string node_type = tkNames[n_type]

string node_type = tkNames[n_type]

switch n_type do

switch n_type do

case tk_Sequence:

case tk_Sequence:

size += gen_size(t[2])

size += gen_size(t[2])

size += gen_size(t[3])

size += gen_size(t[3])

case tk_assign:

case tk_assign:

size += gen_size(t[3])+6

size += gen_size(t[3])+6

case tk_Integer:

case tk_Integer:

size += 5

size += 5

case tk_Identifier:

case tk_Identifier:

size += 6

size += 6

case tk_String:

case tk_String:

size += 5

size += 5

case tk_while:

case tk_while:

-- emit: @@:<condition><topjmp(@f)><body><tailjmp(@b)>@@:

-- emit: @@:<condition><topjmp(@f)><body><tailjmp(@b)>@@:

size += gen_size(t[2])+3

size += gen_size(t[2])+3

integer body = gen_size(t[3])

integer body = gen_size(t[3])

integer stail = iff(size+body+2>128?5:2)

integer stail = iff(size+body+2>128?5:2)

integer stop = iff(body+stail >127?6:2)

integer stop = iff(body+stail >127?6:2)

size += stop+body+stail

size += stop+body+stail

case tk_lt:

case tk_lt:

case tk_le:

case tk_le:

case tk_ne:

case tk_ne:

case tk_eq:

case tk_eq:

case tk_gt:

case tk_gt:

case tk_ge:

case tk_ge:

size += gen_size(t[2])

size += gen_size(t[2])

size += gen_size(t[3])

size += gen_size(t[3])

size += 10

size += 10

case tk_and:

case tk_and:

case tk_or:

case tk_or:

size += gen_size(t[2])

size += gen_size(t[2])

size += gen_size(t[3])

size += gen_size(t[3])

size += 15

size += 15

case tk_add:

case tk_add:

case tk_sub:

case tk_sub:

size += gen_size(t[2])

size += gen_size(t[2])

size += gen_size(t[3])

size += gen_size(t[3])

size += 4

size += 4

case tk_mul:

case tk_mul:

size += gen_size(t[2])

size += gen_size(t[2])

size += gen_size(t[3])

size += gen_size(t[3])

size += 5

size += 5

case tk_div:

case tk_div:

case tk_mod:

case tk_mod:

size += gen_size(t[2])

size += gen_size(t[2])

size += gen_size(t[3])

size += gen_size(t[3])

size += 6

size += 6

case tk_putc:

case tk_putc:

case tk_Printi:

case tk_Printi:

case tk_Prints:

case tk_Prints:

size += gen_size(t[2])

size += gen_size(t[2])

size += 5

size += 5

case tk_if:

case tk_if:

size += gen_size(t[2])+3

size += gen_size(t[2])+3

if t[3][1]!=tk_if then ?9/0 end if

if t[3][1]!=tk_if then ?9/0 end if

integer truesize = gen_size(t[3][2])

integer truesize = gen_size(t[3][2])

integer falsesize = gen_size(t[3][3])

integer falsesize = gen_size(t[3][3])

integer elsejmp = iff(falsesize=0?0:iff(falsesize>127?5:2))

integer elsejmp = iff(falsesize=0?0:iff(falsesize>127?5:2))

integer mainjmp = iff(truesize+elsejmp>127?6:2)

integer mainjmp = iff(truesize+elsejmp>127?6:2)

size += mainjmp+truesize+elsejmp+falsesize

size += mainjmp+truesize+elsejmp+falsesize

case tk_not:

case tk_not:

size += gen_size(t[2])

size += gen_size(t[2])

size += 9

size += 9

case tk_neg:

case tk_neg:

size += gen_size(t[2])

size += gen_size(t[2])

size += 4

size += 4

else:

else:

?9/0

?9/0

end switch

end switch

end if

end if

return size

return size

end function

end function

procedure gen_rec(object t)

procedure gen_rec(object t)

-- the recursive part of code_gen

-- the recursive part of code_gen

if t!=NULL then

if t!=NULL then

integer initsize = length(code)

integer initsize = length(code)

integer estsize = gen_size(t) -- (test the gen_size function)

integer estsize = gen_size(t) -- (test the gen_size function)

integer n_type = t[1]

integer n_type = t[1]

string node_type = tkNames[n_type]

string node_type = tkNames[n_type]

switch n_type do

switch n_type do

case tk_Sequence:

case tk_Sequence:

gen_rec(t[2])

gen_rec(t[2])

gen_rec(t[3])

gen_rec(t[3])

case tk_assign:

case tk_assign:

integer n = var_idx(t[2])

integer n = var_idx(t[2])

gen_rec(t[3])

gen_rec(t[3])

code &= {0o217,0o005,chain,1,n,0} -- pop [i]

code &= {0o217,0o005,chain,1,n,0} -- pop [i]

chain = length(code)-3

chain = length(code)-3

case tk_Integer:

case tk_Integer:

integer n = t[2]

integer n = t[2]

code &= 0o150&int_to_bytes(n) -- push imm32

code &= 0o150&int_to_bytes(n) -- push imm32

case tk_while:

case tk_while:

-- emit: @@:<condition><topjmp(@f)><body><tailjmp(@b)>@@:

-- emit: @@:<condition><topjmp(@f)><body><tailjmp(@b)>@@:

integer looptop = length(code)

integer looptop = length(code)

gen_rec(t[2])

gen_rec(t[2])

code &= {0o130, -- pop eax

code &= {0o130, -- pop eax

0o205,0o300} -- test eax,eax

0o205,0o300} -- test eax,eax

integer bodysize = gen_size(t[3])

integer bodysize = gen_size(t[3])

-- can we use short jumps?

-- ~~disclaimer~~: ~~size~~ ~~calcs~~ ~~are~~ ~~not heavily tested;~~ if in

-- can we use short jumps?

-- ~~doubt reduce 128/7 by 8, and~~ if ~~that works~~

-- disclaimer: size calcs are not heavily tested; if in

-- ~~then~~ ~~yep,~~ ~~you~~ ~~just~~ ~~found~~ a ~~boundary~~ ~~case.~~

-- doubt reduce 128/7 by 8, and if that works

~~integer~~ ~~stail~~ = ~~iff(length(code)+bodysize+4-looptop~~>~~128?5:2)~~

-- then yep, you just found a boundary case.

integer stail = iff(length(code)+bodysize+4-looptop>128?5:2)

integer offset = bodysize+stail

integer offset = bodysize+stail

integer stop = iff(offset>127?6:2)

integer stop = iff(offset>127?6:2)

if stop=2 then

if stop=2 then

code &= {0o164,offset} -- jz (short) end

code &= {0o164,offset} -- jz (short) end

else

~~code &~~= ~~{0o017,0o204}&int_to_bytes(offset) -- jz (long) end~~

else

code &= {0o017,0o204}&int_to_bytes(offset) -- jz (long) end

end if

end if

gen_rec(t[3])

gen_rec(t[3])

offset = looptop-(length(code)+stail)

offset = looptop-(length(code)+stail)

if stail=2 then

if stail=2 then

code &= 0o353&offset -- jmp looptop (short)

code &= 0o353&offset -- jmp looptop (short)

else

~~code &~~= ~~0o351&int_to_bytes(offset) -- jmp looptop (long)~~

else

code &= 0o351&int_to_bytes(offset) -- jmp looptop (long)

end if

end if

case tk_lt:

case tk_lt:

case tk_le:

case tk_le:

case tk_gt:

case tk_gt:

case tk_ge:

case tk_ge:

case tk_ne:

case tk_ne:

case tk_eq:

case tk_eq:

gen_rec(t[2])

gen_rec(t[2])

gen_rec(t[3])

gen_rec(t[3])

integer xrm

if ~~n_type~~=~~tk_ne~~ ~~then~~ ~~xrm~~ = ~~0o225 -- (~~#~~95)~~

integer xrm

if n_type=tk_ne then xrm = 0o225 -- (#95)

elsif n_type=tk_lt then xrm = 0o234 -- (#9C)

elsif n_type=tk_lt then xrm = 0o234 -- (#9C)

elsif n_type=tk_ge then xrm = 0o235 -- (#9D)

elsif n_type=tk_ge then xrm = 0o235 -- (#9D)

elsif n_type=tk_le then xrm = 0o236 -- (#9E)

elsif n_type=tk_le then xrm = 0o236 -- (#9E)

elsif n_type=tk_gt then xrm = 0o237 -- (#9F)

elsif n_type=tk_gt then xrm = 0o237 -- (#9F)

else ?9/0

else ?9/0

end if

end if

code &= { 0o061,0o300, -- xor eax,eax

code &= { 0o061,0o300, -- xor eax,eax

0o132, -- pop edx

~~0o131~~, -- pop ~~ecx~~

0o132, -- pop edx

~~0o071,0o321~~, -- ~~cmp~~ ecx~~,edx~~

0o131, -- pop ecx

0o071,0o321, -- cmp ecx,edx

0o017,xrm,0o300, -- setcc al

0o017,xrm,0o300, -- setcc al

0o120} -- push eax

0o120} -- push eax

case tk_or:

case tk_or:

case tk_and:

case tk_and:

gen_rec(t[2])

gen_rec(t[2])

gen_rec(t[3])

gen_rec(t[3])

integer op = find(n_type,{tk_or,0,0,tk_and})

integer op = find(n_type,{tk_or,0,0,tk_and})

op *= 0o010

op *= 0o010

code &= { 0o130, -- pop eax

~~0o131~~, -- pop ~~ecx~~

code &= { 0o130, -- pop eax

~~0o205,0o300~~, -- ~~test~~ ~~eax,eax~~

0o131, -- pop ecx

~~0o017,0o225~~,0o300, -- ~~setne~~ al

0o205,0o300, -- test eax,eax

0o017,0o225,0o300, -- setne al

0o205,0o311, -- test ecx,ecx

0o205,0o311, -- test ecx,ecx

0o017,0o225,0o301, -- setne cl

0o017,0o225,0o301, -- setne cl

op,0o310, -- or/and al,cl

~~0o120}~~ -- ~~push~~ ~~eax~~

op,0o310, -- or/and al,cl

0o120} -- push eax

case tk_add:

case tk_add:

case tk_sub:

case tk_sub:

gen_rec(t[2])

gen_rec(t[2])

gen_rec(t[3])

gen_rec(t[3])

integer op = find(n_type,{tk_add,0,0,0,0,tk_sub})

integer op = find(n_type,{tk_add,0,0,0,0,tk_sub})

op = 0o001 + (op-1)*0o010

op = 0o001 + (op-1)*0o010

code &= { 0o130, -- pop eax

code &= { 0o130, -- pop eax

op,0o004,0o044} -- add/or/and/sub [esp],eax

op,0o004,0o044} -- add/or/and/sub [esp],eax

case tk_mul:

case tk_mul:

gen_rec(t[2])

gen_rec(t[2])

gen_rec(t[3])

gen_rec(t[3])

code &= { 0o131, -- pop ecx

~~0o130~~, -- pop ~~eax~~

code &= { 0o131, -- pop ecx

~~0o367,0o341~~, -- ~~mul~~ ~~ecx~~

0o130, -- pop eax

~~0o120}~~ -- ~~push~~ ~~eax~~

0o367,0o341, -- mul ecx

0o120} -- push eax

case tk_div:

case tk_div:

case tk_mod:

case tk_mod:

gen_rec(t[2])

gen_rec(t[2])

gen_rec(t[3])

gen_rec(t[3])

integer push = 0o120+(n_type=tk_mod)*2

integer push = 0o120+(n_type=tk_mod)*2

code &= { 0o131, -- pop ecx

~~0o130~~, -- pop ~~eax~~

code &= { 0o131, -- pop ecx

~~0o231,~~ -- ~~cdq~~ ~~(eax~~ -> ~~edx:~~eax)

0o130, -- pop eax

~~0o367,0o371~~, -- ~~idiv~~ ~~ecx~~

0o231, -- cdq (eax -> edx:eax)

~~push}~~ -- ~~push~~ ~~eax|edx~~

0o367,0o371, -- idiv ecx

push} -- push eax|edx

case tk_Identifier:

case tk_Identifier:

integer n = var_idx(t)

integer n = var_idx(t)

code &= {0o377,0o065,chain,1,n,0} -- push [n]

code &= {0o377,0o065,chain,1,n,0} -- push [n]

chain = length(code)-3

chain = length(code)-3

case tk_putc:

case tk_putc:

case tk_Printi:

case tk_Printi:

case tk_Prints:

case tk_Prints:

gen_rec(t[2])

gen_rec(t[2])

integer n = find(n_type,{tk_putc,tk_Printi,tk_Prints})

integer n = find(n_type,{tk_putc,tk_Printi,tk_Prints})

code &= {0o350,chain,3,n,0} -- call :printc/i/s

code &= {0o350,chain,3,n,0} -- call :printc/i/s

chain = length(code)-3

chain = length(code)-3

case tk_String:

case tk_String:

integer n = string_idx(t)

integer n = string_idx(t)

code &= {0o150,chain,2,n,0} -- push RawStringPtr(string)

code &= {0o150,chain,2,n,0} -- push RawStringPtr(string)

chain = length(code)-3

chain = length(code)-3

case tk_if:

case tk_if:

-- emit: <condition><mainjmp><truepart>[<elsejmp><falsepart>]

-- emit: <condition><mainjmp><truepart>[<elsejmp><falsepart>]

gen_rec(t[2])

gen_rec(t[2])

code &= {0o130, -- pop eax

code &= {0o130, -- pop eax

0o205,0o300} -- test eax,eax

0o205,0o300} -- test eax,eax

if t[3][1]!=tk_if then ?9/0 end if

if t[3][1]!=tk_if then ?9/0 end if

integer truesize = gen_size(t[3][2])

integer truesize = gen_size(t[3][2])

integer falsesize = gen_size(t[3][3])

integer falsesize = gen_size(t[3][3])

integer elsejmp = iff(falsesize=0?0:iff(falsesize>127?5:2))

integer elsejmp = iff(falsesize=0?0:iff(falsesize>127?5:2))

integer offset = truesize+elsejmp

integer offset = truesize+elsejmp

integer mainjmp = iff(offset>127?6:2)

integer mainjmp = iff(offset>127?6:2)

if mainjmp=2 then

if mainjmp=2 then

code &= {0o164,offset} -- jz (short) else/end

code &= {0o164,offset} -- jz (short) else/end

else

~~code &~~= ~~{0o017,0o204}&int_to_bytes(offset) -- jz (long)~~ else/~~end~~

else

code &= {0o017,0o204}&int_to_bytes(offset) -- jz (long) else/end

end if

end if

gen_rec(t[3][2])

gen_rec(t[3][2])

if falsesize!=0 then

if falsesize!=0 then

offset = falsesize

offset = falsesize

if elsejmp=2 then

if elsejmp=2 then

code &= 0o353&offset -- jmp end if (short)

code &= 0o353&offset -- jmp end if (short)

else

~~code &~~= ~~0o351&int_to_bytes(offset) -- jmp end if (long)~~

else

code &= 0o351&int_to_bytes(offset) -- jmp end if (long)

end if

end if

gen_rec(t[3][3])

gen_rec(t[3][3])

end if

end if

case tk_not:

case tk_not:

gen_rec(t[2])

gen_rec(t[2])

code &= {0o132, -- pop edx

code &= {0o132, -- pop edx

0o061,0o300, -- xor eax,eax

~~0o205~~,~~0o322~~, -- ~~test~~ ~~edx~~,~~edx~~

0o061,0o300, -- xor eax,eax

0o205,0o322, -- test edx,edx

0o017,0o224,0o300, -- setz al

0o017,0o224,0o300, -- setz al

0o120} -- push eax

0o120} -- push eax

case tk_neg:

case tk_neg:

gen_rec(t[2])

gen_rec(t[2])

code &= {0o130, -- pop eax

code &= {0o130, -- pop eax

0o367,0o330, -- neg eax

~~0o120}~~ -- ~~push~~ eax

0o367,0o330, -- neg eax

0o120} -- push eax

else:

else:

error("error in code generator - found %d, expecting operator\n", {n_type})

error("error in code generator - found %d, expecting operator\n", {n_type})

end switch

end switch

integer actsize = length(code)

integer actsize = length(code)

if initsize+estsize!=actsize then ?"9/0" end if -- (test gen_size)

if initsize+estsize!=actsize then ?"9/0" end if -- (test gen_size)

end if

end if

end procedure

end procedure

global procedure code_gen(object t)

global procedure code_gen(object t)

--

--

-- Generates proper machine code.

--

-- Example: i=10; print "\n"; print i; print "\n"

-- Result in vars, strings, chain, code (declared above)

-- where vars is: {"i"},

-- ~~strings~~ is {"\n"},

-- where vars is: {"i"},

-- ~~code~~ is { ~~0o150~~,~~#0A,#00,#00,#00, -- 1: push 10~~

-- strings is {"\n"},

-- ~~0o217~~,~~0o005~~,0,1,1,0 -- 6: ~~pop~~ ~~[i]~~

-- code is { 0o150,#0A,#00,#00,#00, -- 1: push 10

-- ~~0o150~~,8,2,1,0, -- 12: ~~push~~ ~~("\n")~~

-- 0o217,0o005,0,1,1,0 -- 6: pop [i]

-- ~~0o350~~,13,3,3,0, -- 17: ~~call~~ ~~:prints~~

-- 0o150,8,2,1,0, -- 12: push ("\n")

-- ~~0o377~~,~~0o065~~,18,~~1,1~~,0, -- 22: ~~push~~ ~~[i]~~

-- 0o350,13,3,3,0, -- 17: call :prints

-- ~~0o350~~,24,3,2,0, -- 28: ~~call~~ ~~:printi~~

-- 0o377,0o065,18,1,1,0, -- 22: push [i]

-- ~~0o150~~,29,2,1,0, -- 33: ~~push~~ ~~("\n")~~

-- 0o350,24,3,2,0, -- 28: call :printi

-- ~~0o350~~,34,3,3,0, -- 38: ~~call~~ ~~:prints~~

-- 0o150,29,2,1,0, -- 33: push ("\n")

-- ~~0o303}~~ -- 43: ~~ret~~

-- 0o350,34,3,3,0, -- 38: call :prints

-- 0o303} -- 43: ret

-- and chain is 39 (->34->29->24->18->13->8->0)

-- The chain connects all places where we need an actual address before

-- the code is executed, with the byte after the link differentiating

-- ~~between~~ ~~var(1),~~ ~~string(2),~~ ~~and builtin(3)~~, ~~and~~ the byte after ~~that~~

-- the code is executed, with the byte after the link differentiating

-- between var(1), string(2), and builtin(3), and the byte after that

-- determining the instance of the given type - not that any of them

-- are actually limited to a byte in the above intermediate form, and

-- of course the trailing 0 of each {link,type,id,0} is just there to

-- reserve the space we will need.

--

--

gen_rec(t)

gen_rec(t)

code = append(code,0o303) -- ret (0o303=#C3)

code = append(code,0o303) -- ret (0o303=#C3)

end procedure

end procedure

include builtins/VM/puts1.e -- low-level console i/o routines

include builtins/VM/puts1.e -- low-level console i/o routines

function setbuiltins()

function setbuiltins()

atom printc,printi,prints

atom printc,printi,prints

#ilASM{

jmp :setbuiltins

::printc

~~lea edi,[esp+4]~~

::printc

~~mov~~ ~~esi~~,1

lea edi,[esp+4]

mov esi,1

call :%puts1ediesi -- (edi=raw text, esi=length)

ret 4

~~::printi~~

ret 4

~~mov eax,[esp+4]~~

::printi

~~push~~ 0 ~~-- no cr~~

mov eax,[esp+4]

~~call~~ ~~:%putsint~~ -- ~~(nb~~ ~~limited~~ to +/-~~9,999,999,999)~~

push 0 -- no cr

call :%putsint -- (nb limited to +/-9,999,999,999)

ret 4

~~::prints~~

ret 4

~~mov edi,[esp+4]~~

::prints

mov ~~esi~~,[~~edi-12~~]

mov edi,[esp+4]

mov esi,[edi-12]

call :%puts1ediesi -- (edi=raw text, esi=length)

ret 4

~~::setbuiltins~~

ret 4

~~mov eax,~~:~~printc~~

::setbuiltins

~~lea~~ ~~edi~~,[printc]

mov eax,:printc

~~call~~ ~~:%pStoreMint~~

lea edi,[printc]

~~mov~~ ~~eax,~~:~~printi~~

call :%pStoreMint

~~lea~~ ~~edi~~,[printi]

mov eax,:printi

~~call~~ ~~:%pStoreMint~~

lea edi,[printi]

~~mov~~ ~~eax,~~:~~prints~~

call :%pStoreMint

~~lea~~ ~~edi~~,[prints]

mov eax,:prints

~~call~~ ~~:%pStoreMint~~

lea edi,[prints]

}

call :%pStoreMint

}

return {printc,printi,prints}

return {printc,printi,prints}

end function

end function

global constant builtin_names = {"printc","printi","prints"}

global constant builtin_names = {"printc","printi","prints"}

global constant builtins = setbuiltins()

global constant builtins = setbuiltins()

global atom var_mem, code_mem

global atom var_mem, code_mem

function RawStringPtr(integer n) -- (based on IupRawStringPtr from pGUI.e)

function RawStringPtr(integer n) -- (based on IupRawStringPtr from pGUI.e)

--

-- Returns a raw string pointer for s, somewhat like allocate_string(s), but using the existing memory.

-- NOTE: The return is only valid as long as the value passed as the parameter remains in existence.

--

--

atom res

atom res

string s = strings[n]

string s = strings[n]

#ilASM{

~~mov eax,[s]~~

#ilASM{

~~lea~~ ~~edi~~,[~~res~~]

mov eax,[s]

~~shl~~ ~~eax~~,2

lea edi,[res]

~~call~~ ~~:%pStoreMint~~

shl eax,2

}

call :%pStoreMint

~~stringptrs[n]~~ = ~~res~~

}

stringptrs[n] = res

return res

return res

end function

end function

global procedure fixup()

global procedure fixup()

var_mem = allocate(length(vars)*4)

var_mem = allocate(length(vars)*4)

mem_set(var_mem,0,length(vars)*4)

mem_set(var_mem,0,length(vars)*4)

code_mem = allocate(length(code))

code_mem = allocate(length(code))

poke(code_mem,code)

poke(code_mem,code)

while chain!=0 do

while chain!=0 do

integer this = chain

integer this = chain

chain = code[this]

chain = code[this]

integer ftype = code[this+1]

integer ftype = code[this+1]

integer id = code[this+2]

integer id = code[this+2]

switch ftype do

switch ftype do

case 1: -- vars

case 1: -- vars

poke4(code_mem+this-1,var_mem+(id-1)*4)

poke4(code_mem+this-1,var_mem+(id-1)*4)

case 2: -- strings

case 2: -- strings

poke4(code_mem+this-1,RawStringPtr(id))

poke4(code_mem+this-1,RawStringPtr(id))

case 3: -- builtins

case 3: -- builtins

poke4(code_mem+this-1,builtins[id]-(code_mem+this+3))

poke4(code_mem+this-1,builtins[id]-(code_mem+this+3))

end switch

end switch

end while

end while

end procedure</lang>

end procedure

And a simple test driver for the specific task:

<lang Phix>--

--

-- demo\rosetta\Compiler\cgen.exw

-- ==============================

--

-- Generates 32-bit machine code (see note in vm.exw)

--

--

without js -- (machine code!)

include cgen.e

include cgen.e

function get_var_name(atom addr)

function get_var_name(atom addr)

integer n = (addr-var_mem)/4+1

integer n = (addr-var_mem)/4+1

if n<1 or n>length(vars) then ?9/0 end if

if n<1 or n>length(vars) then ?9/0 end if

return vars[n]

return vars[n]

end function

end function

function hxl(integer pc, object oh, string fmt, sequence args={})

function hxl(integer pc, object oh, string fmt, sequence args={})

-- helper routine to display the octal/hex bytes just decoded,

-- helper routine to display the octal/hex bytes just decoded,

-- along with the code offset and the human-readable text.

-- along with the code offset and the human-readable text.

if length(args) then fmt = sprintf(fmt,args) end if

if length(args) then fmt = sprintf(fmt,args) end if

sequence octhex = {}

sequence octhex = {}

atom base = code_mem+pc

atom base = code_mem+pc

integer len = 0

integer len = 0

if integer(oh) then -- all octal

if integer(oh) then -- all octal

for i=1 to oh do

for i=1 to oh do

octhex = append(octhex,sprintf("0o%03o",peek(base)))

octhex = append(octhex,sprintf("0o%03o",peek(base)))

base += 1

base += 1

end for

end for

len = oh

len = oh

else -- some octal and some hex

else -- some octal and some hex

for i=1 to length(oh) by 2 do

for i=1 to length(oh) by 2 do

for j=1 to oh[i] do

for j=1 to oh[i] do

octhex = append(octhex,sprintf("0o%03o",peek(base)))

octhex = append(octhex,sprintf("0o%03o",peek(base)))

base += 1

base += 1

end for

end for

len += oh[i]

len += oh[i]

for j=1 to oh[i+1] do

for j=1 to oh[i+1] do

octhex = append(octhex,sprintf("#%02x",peek(base)))

octhex = append(octhex,sprintf("#%02x",peek(base)))

base += 1

base += 1

end for

end for

len += oh[i+1]

len += oh[i+1]

end for

end for

end if

end if

printf(output_file,"%4d: %-30s %s\n",{pc+1,join(octhex,","),fmt})

printf(output_file,"%4d: %-30s %s\n",{pc+1,join(octhex,","),fmt})

return len

return len

end function

end function

constant cccodes = {"o?" ,"no?","b?" ,"ae?","z" ,"ne" ,"be?","a?",

constant cccodes = {"o?" ,"no?","b?" ,"ae?","z" ,"ne" ,"be?","a?",

-- 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 ,

~~"s?"~~ ,~~"ns?"~~,~~"pe?"~~,~~"po?"~~,~~"l"~~ ,~~"ge"~~ ,~~"le"~~ ,~~"g"~~ }

-- 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 ,

"s?" ,"ns?","pe?","po?","l" ,"ge" ,"le" ,"g" }

-- 8 , 9 , 10 , 11 , 12 , 13 , 14 , 15

-- 8 , 9 , 10 , 11 , 12 , 13 , 14 , 15

constant regs = {"eax","ecx","edx"} -- (others as/when needed)

constant regs = {"eax","ecx","edx"} -- (others as/when needed)

procedure decode()

procedure decode()

-- for a much more complete (and better organised) disassembler, see p2asm.e

-- for a much more complete (and better organised) disassembler, see p2asm.e

integer pc = 0, -- nb 0-based

integer pc = 0, -- nb 0-based

opcode, xrm

opcode, xrm

while pc<length(code) do

while pc<length(code) do

opcode = peek(code_mem+pc)

opcode = peek(code_mem+pc)

xrm = -1

xrm = -1

switch opcode do

switch opcode do

case 0o150:

case 0o150:

atom vaddr = peek4s(code_mem+pc+1)

atom vaddr = peek4s(code_mem+pc+1)

integer n = find(vaddr,stringptrs)

integer n = find(vaddr,stringptrs)

object arg = iff(n?enquote(strings[n])

object arg = iff(n?enquote(strings[n])

:sprintf("%d",vaddr))

:sprintf("%d",vaddr))

pc += hxl(pc,{1,4},"push %s",{arg})

pc += hxl(pc,{1,4},"push %s",{arg})

case 0o217:

case 0o217:

case 0o377:

case 0o377:

integer n = find(opcode,{0o217,0o377})

integer n = find(opcode,{0o217,0o377})

string op = {"pop","push"}[n]

string op = {"pop","push"}[n]

xrm = peek(code_mem+pc+1)

xrm = peek(code_mem+pc+1)

if n!=find(xrm,{0o005,0o065}) then exit end if

if n!=find(xrm,{0o005,0o065}) then exit end if

atom addr = peek4u(code_mem+pc+2)

atom addr = peek4u(code_mem+pc+2)

pc += hxl(pc,{2,4},"%s [%s]",{op,get_var_name(addr)})

pc += hxl(pc,{2,4},"%s [%s]",{op,get_var_name(addr)})

case 0o061:

case 0o061:

case 0o071:

case 0o071:

case 0o205:

case 0o205:

integer n = find(opcode,{0o061,0o071,0o205})

integer n = find(opcode,{0o061,0o071,0o205})

string op = {"xor","cmp","test"}[n]

string op = {"xor","cmp","test"}[n]

xrm = peek(code_mem+pc+1)

xrm = peek(code_mem+pc+1)

if and_bits(xrm,0o300)!=0o300 then exit end if

if and_bits(xrm,0o300)!=0o300 then exit end if

string r1 = regs[and_bits(xrm,0o070)/0o010+1]

string r1 = regs[and_bits(xrm,0o070)/0o010+1]

string r2 = regs[and_bits(xrm,0o007)+1]

string r2 = regs[and_bits(xrm,0o007)+1]

pc += hxl(pc,2,"%s %s,%s",{op,r1,r2})

pc += hxl(pc,2,"%s %s,%s",{op,r1,r2})

case 0o017:

case 0o017:

xrm = peek(code_mem+pc+1)

xrm = peek(code_mem+pc+1)

switch xrm do

switch xrm do

case 0o224:

case 0o224:

case 0o225:

case 0o225:

case 0o234:

case 0o234:

case 0o235:

case 0o235:

case 0o236:

case 0o236:

case 0o237:

case 0o237:

string cc = cccodes[and_bits(xrm,0o017)+1]

string cc = cccodes[and_bits(xrm,0o017)+1]

xrm = peek(code_mem+pc+2)

xrm = peek(code_mem+pc+2)

if xrm=0o300 then

if xrm=0o300 then

pc += hxl(pc,3,"set%s al",{cc})

pc += hxl(pc,3,"set%s al",{cc})

elsif xrm=0o301 then

elsif xrm=0o301 then

pc += hxl(pc,3,"set%s cl",{cc})

pc += hxl(pc,3,"set%s cl",{cc})

else

~~exit~~

else

~~end~~ if

exit

~~case~~ ~~0o204~~:

end if

case 0o204:

integer offset = peek4s(code_mem+pc+2)

integer offset = peek4s(code_mem+pc+2)

pc += hxl(pc,{2,4},"jz %d",{pc+6+offset+1})

pc += hxl(pc,{2,4},"jz %d",{pc+6+offset+1})

else

~~exit~~

else

~~end~~ ~~switch~~

exit

end switch

case 0o010:

case 0o010:

case 0o040:

case 0o040:

xrm = peek(code_mem+pc+1)

xrm = peek(code_mem+pc+1)

if xrm=0o310 then

if xrm=0o310 then

string lop = {"or","and"}[find(opcode,{0o010,0o040})]

string lop = {"or","and"}[find(opcode,{0o010,0o040})]

pc += hxl(pc,2,"%s al,cl",{lop})

pc += hxl(pc,2,"%s al,cl",{lop})

else

~~exit~~

else

~~end~~ if

exit

end if

case 0o120:

case 0o120:

case 0o122:

case 0o122:

case 0o130:

case 0o130:

case 0o131:

case 0o131:

case 0o132:

case 0o132:

string op = {"push","pop"}[find(and_bits(opcode,0o070),{0o020,0o030})]

string op = {"push","pop"}[find(and_bits(opcode,0o070),{0o020,0o030})]

string reg = regs[and_bits(opcode,0o007)+1]

string reg = regs[and_bits(opcode,0o007)+1]

pc += hxl(pc,1,"%s %s",{op,reg})

pc += hxl(pc,1,"%s %s",{op,reg})

case 0o231:

case 0o231:

pc += hxl(pc,1,"cdq")

pc += hxl(pc,1,"cdq")

case 0o164:

case 0o164:

case 0o353:

case 0o353:

string jop = iff(opcode=0o164?"jz":"jmp")

string jop = iff(opcode=0o164?"jz":"jmp")

integer offset = peek1s(code_mem+pc+1)

integer offset = peek1s(code_mem+pc+1)

pc += hxl(pc,{1,1},"%s %d",{jop,pc+2+offset+1})

pc += hxl(pc,{1,1},"%s %d",{jop,pc+2+offset+1})

case 0o351:

case 0o351:

integer offset = peek4s(code_mem+pc+1)

integer offset = peek4s(code_mem+pc+1)

pc += hxl(pc,{1,4},"jmp %d",{pc+5+offset+1})

pc += hxl(pc,{1,4},"jmp %d",{pc+5+offset+1})

case 0o303:

case 0o303:

pc += hxl(pc,1,"ret")

pc += hxl(pc,1,"ret")

case 0o350:

case 0o350:

integer offset = peek4s(code_mem+pc+1)

integer offset = peek4s(code_mem+pc+1)

atom addr = offset+code_mem+pc+5

atom addr = offset+code_mem+pc+5

integer n = find(addr,builtins)

integer n = find(addr,builtins)

pc += hxl(pc,{1,4},"call :%s",{builtin_names[n]})

pc += hxl(pc,{1,4},"call :%s",{builtin_names[n]})

case 0o001:

case 0o001:

case 0o041:

case 0o041:

case 0o051:

case 0o051:

integer n = find(opcode,{0o001,0o041,0o051})

integer n = find(opcode,{0o001,0o041,0o051})

string op = {"add","and","sub"}[n]

string op = {"add","and","sub"}[n]

xrm = peek(code_mem+pc+1)

xrm = peek(code_mem+pc+1)

switch xrm do

switch xrm do

case 0o004:

case 0o004:

if peek(code_mem+pc+2)=0o044 then

if peek(code_mem+pc+2)=0o044 then

pc += hxl(pc,3,"%s [esp],eax",{op})

pc += hxl(pc,3,"%s [esp],eax",{op})

else

~~exit~~

else

~~end~~ if

exit

end if

else

~~exit~~

else

~~end~~ ~~switch~~

exit

end switch

case 0o367:

case 0o367:

xrm = peek(code_mem+pc+1)

xrm = peek(code_mem+pc+1)

if and_bits(xrm,0o300)!=0o300 then exit end if

if and_bits(xrm,0o300)!=0o300 then exit end if

integer n = find(and_bits(xrm,0o070),{0o030,0o040,0o070})

integer n = find(and_bits(xrm,0o070),{0o030,0o040,0o070})

if n=0 then exit end if

if n=0 then exit end if

string op = {"neg","mul","idiv"}[n]

string op = {"neg","mul","idiv"}[n]

string reg = regs[and_bits(xrm,0o007)+1]

string reg = regs[and_bits(xrm,0o007)+1]

pc += hxl(pc,2,"%s %s",{op,reg})

pc += hxl(pc,2,"%s %s",{op,reg})

else

~~exit~~

else

exit

end switch

end switch

end while

end while

if pc<length(code) then

if pc<length(code) then

?"incomplete:"

?"incomplete:"

if xrm=-1 then

if xrm=-1 then

?{pc+1,sprintf("0o%03o",opcode)}

?{pc+1,sprintf("0o%03o",opcode)}

else

~~?{pc+1,sprintf(~~"~~0o%03o~~ ~~0o%03o~~"~~,{opcode,xrm})}~~

else

?{pc+1,sprintf("0o%03o 0o%03o",{opcode,xrm})}

end if

end if

end if

end if

end procedure

end procedure

procedure main(sequence cl)

procedure main(sequence cl)

open_files(cl)

open_files(cl)

toks = lex()

toks = lex()

object t = parse()

object t = parse()

code_gen(t)

code_gen(t)

fixup()

fixup()

decode()

decode()

free({var_mem,code_mem})

free({var_mem,code_mem})

close_files()

close_files()

end procedure

end procedure

--main(command_line())

--main(command_line())

main({0,0,"gcd.c"})</lang>

main({0,0,"gcd.c"})

<pre>