-- Look out! We be programming!
-- cradle2c.ex a Euphoria compiler by A.R.S. KA9QLQ Alvin Koffman Copy right 2002
include get.e -- for get character functions
include wildcard.e -- for upper()
with trace
--trace(1) -- output to screen
constant
alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", -- Define alphas
nums = "0123456789", -- Define numerics
addop = "-+", -- Define addops
mulop = "*/" -- Define mulops
integer exp_id -- this is a numeric id used for routine_id()
object Look -- Look ahead character
procedure GetChar() -- Read New Character From Input Stream
Look = getc(0) -- this grabs a line of characters
Look = upper(Look)
-- run alpha characters from Look through upper to ignore capitalisation
end procedure
function IsAlpha(object c) -- Recognize an Alpha Character
return find(upper(c),alpha)
end function
function IsDigit(object c) -- Recognize a Decimal Digit
return find(c,nums)
end function
function IsAddop(object c) -- Recognize an Alpha Character
return find(upper(c),addop)
end function
function IsMulop(object c) -- Recognize an Alpha Character
return find(upper(c),mulop)
end function
procedure Error(sequence s) -- called from Abort to
puts(1,"\n Error: " & s & ".") -- output error
end procedure
procedure Abort(sequence s) -- Report Error and Halt
atom x
Error(s)
x = wait_key() -- wait so you can see results
abort(1) -- when using Windows or Linux
end procedure
procedure Expected(sequence s) -- Report What Was Expected
Abort(s & " Expected\n")
end procedure
procedure Match(integer x) -- test for integer
if Look = x then GetChar() -- if integer advance 1 character
else Expected("' + x + '") -- or crash and burn
end if
end procedure
function GetNum() -- test for valid number
object x
if not find(Look,nums) then Expected("Integer")
end if
x = Look -- this will pass the character back
GetChar() -- ready Look with another character
return x -- pass the number back to Term
end function
procedure Init() -- initialize program
GetChar() -- grab a character
end procedure
procedure Factor() -- Parse and Translate a Math Expression
if Look ='(' then -- look for parens in input
Match('(')
call_proc(exp_id,{}) -- bounce between Expression and Factor
Match(')')
else
puts(1, "MOVE " & GetNum() & " D0 \n")
end if
end procedure
procedure Multiply() --Recognize and Translate a Multiply
Match('*')
Factor()
puts(1, "MULS (SP)+,D0\n")
end procedure
procedure Divide() -- Recognize and Translate a Divide
Match('/')
Factor()
puts(1, "MOVE (SP)+,D1\n")
puts(1, "DIVS D1,D0\n")
end procedure
procedure Term() --Parse and Translate a Math Term
Factor()
while IsMulop(Look) do -- check for mulop
puts(1, "MOVE D0,-(SP)\n")
if Look = '*' then Multiply()
elsif Look = '/' then Divide()
elsif Look ='\n' then exit
else Expected("Mulop ")
end if
end while
end procedure
procedure Add() --Recognize and Translate an Add
Match('+') -- advance to netx character
Term() -- check for and move number to AX
puts(1, "ADD (SP)+,D0\n") -- run the number
end procedure
procedure Subtract() --Recognize and Translate a Subtract
Match('-') -- advance to netx character
Term()
puts(1, "SUB (SP)+,D0\n") -- run the number
puts(1, "NEG D1\n") -- make sign change
end procedure
procedure Expression() -- Parse and Translate an Expression
if IsAddop(Look) then -- check for leading minus
puts(1,"CLR D0/n")
else
Term() -- check for and move number to DO
while IsAddop(Look) do -- loop for long addop
puts(1, "MOVE D0,-(SP)\n") -- free up first register for next input
if Look = '+' then Add() -- add the registers
elsif Look = '-' then Subtract() -- subtract the registers
elsif Look = '\n' then exit -- end of line check
else Expected("Addop ") -- trap error
end if
end while
end if
end procedure
-- start
exp_id = routine_id("Expression")
puts(1, "Input a line of characters \n") -- ask for imput
Init()
Expression()