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