-- Look out! We be programming!
-- cradle2b.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
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
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 Term() -- Parse and Translate a Math Expression
puts(1, "MOVE " & GetNum() & " D0 \n")
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
Term() -- check for and move number to DO
puts(1, "MOVE D0,-(SP)\n") -- free up first register for next input
while IsAddop(Look) do -- loop for long addop
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 procedure
-- start
puts(1, "Input a line of characters \n") -- ask for imput
Init()
Expression()