Make your own free website on
-- 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

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