X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=3a_asm%2FMain.hs;fp=3a_asm%2FMain.hs;h=5385b0e80c1cadc6793f31597ddb49601ec037ee;hb=1a5edb9509baec96133668773da0f7ad8de75e2a;hp=17ffc864871add022ce59ba8c4df954df600e823;hpb=203259b0ae275054da47075be18cfe25d7d7ed7a;p=calu.git

diff --git a/3a_asm/Main.hs b/3a_asm/Main.hs
index 17ffc86..5385b0e 100644
--- a/3a_asm/Main.hs
+++ b/3a_asm/Main.hs
@@ -18,6 +18,7 @@ import qualified Data.Map as M
 import Data.List
 import Data.Word
 import qualified Data.ByteString.Lazy as BL
+import Control.Monad
 -- import Data.Binary.Put
 
 main :: IO ()
@@ -25,7 +26,7 @@ main = do
 	args <- getArgs
 	content <- getContents
 	let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content)))
-	let (dict,formatedsrc) = convertDTF src 0x00 0x00 init_labels
+	let (dict,formatedsrc) = convertDTF src NoState 0x00 0x00 init_labels
 	print args
 	print formatedsrc
 
@@ -41,9 +42,6 @@ type Counter = Word32
 inc :: Counter -> Counter
 inc = ((+) 4)
 
-setabsolute :: Counter -> Counter
-setabsolute x = x
-
 
 type DictLabel = (String -> Word32)
 
@@ -52,6 +50,7 @@ init_labels _ = 0xffffffff
 
 add_label :: DictLabel -> (String,Word32) -> DictLabel
 add_label dic (s,w)
+	| s == "" = dic -- ignore empty string
 	| dic s /= 0xffffffff = error ("Label " ++ s ++ " already exists")
 	| otherwise = newdict
 	where
@@ -60,33 +59,136 @@ add_label dic (s,w)
 		| otherwise = dic str
 
 
-convertDTF :: [(Int,String)] -> Counter -> Counter -> DictLabel -> (DictLabel, [DTF])
-convertDTF [] _ _ d = (d,[])
-convertDTF ((lno,str):xs) datacnt instrcnt dict =
-	(newdict, (DTF_Comment str):next)
+convertDTF :: [(Int,String)] -> DT_State -> Counter -> Counter -> DictLabel -> (DictLabel, [DTF])
+convertDTF [] _ _ _ d = (d,[])
+convertDTF ((lno,str):xs) state datacnt instrcnt dict = (newdict, newdtf:next)
 	where
-	(newdict,next) = convertDTF xs (inc datacnt) (inc instrcnt) dict
+	(newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf)
+
+	ndatacnt (DTF_Org adr)
+		| state == InData = adr
+		| otherwise = datacnt
+	ndatacnt (DTF_Data _ _ _ _ _) = inc datacnt
+
+	ninstrcnt (DTF_Org adr)
+		| state == InText = adr
+		| otherwise = instrcnt
+	ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt
+
+	nstate (DTF_State s) = s
+	nstate _ = state
+
+	ndict (DTF_Label l _ a) = dict `add_label` (l,a)
+	ndict (DTF_SectionToDet a _ _ l _) = dict `add_label` (l,a)
+	ndict (DTF_InstrToParse a _ _ l _) = dict `add_label` (l,a)
+	ndict (DTF_Data a _ _ l _) = dict `add_label` (l,a)
+	ndict (DTF_Instr a _ _ l _) = dict `add_label` (l,a)
+
+	newdtf = case (parse parseDTFLine "" (str++"\n")) of
+		Left err -> error "couldn't parse line " ++ (show lno) ++ ": " ++ (show err)
+		Right (DTF_SectionToDet _ v c l s) ->
+			case state of
+				NoState -> error "missing .data or .text"
+				InData -> (DTF_Data datacnt v c l s)
+				InText -> (DTF_Instr instrcnt v c l s)
+		Right (DTF_InstrToParse _ v c l s) ->
+			(DTF_InstrToParse instrcnt v c l s)
+		Right y@(DTF_Org _) ->
+			case state of
+				NoState -> error "missing .data or .text"
+				_ -> y
+		Right (DTF_Label l c _) ->
+			case state of
+				NoState -> error "missing .data or .text"
+				InData -> (DTF_Label l c datacnt)
+				InText -> (DTF_Label l c instrcnt)
+		Right z -> z -- DTF_Comment, DTF_State
+
+
 
 testDTF :: String -> IO ()
 testDTF input =
 	case (parse parseDTFLine "" (input++"\n")) of
-		Left err -> do { putStr "failz"; print err}
+		Left err -> do { putStr "failz ;(\n"; print err}
 		Right x -> do { print x }
 
 parseDTFLine :: Parser DTF
 parseDTFLine = foldl1 (<|>) (fmap try lineFormats) <* char '\n'
 
-lineFormats = [lf_data, lf_comment, lf_label, lf_toparse, lf_org]
+lineFormats = [lf_sdata, lf_stext, lf_org, lf_data, lf_comment, lf_toparse, lf_label]
 
-lf_data = do string "data"; return $ DTF_Comment "lolz0"
+-- helper
+parseLabel :: Parser String
+parseLabel = do
+	label <- letter 
+	labels <- many $ (letter <|> digit <|> char '_')
+	char ':'
+	return $ (label:labels)
 
-lf_comment = do
+parseComment :: Parser String
+parseComment = do
 	skipMany space
 	char ';'
-	comment <- many $ noneOf ['\n']
-	newline
+	comment <- many $ noneOf "\n"
+	return $ comment
+
+parseConst :: Parser Word32
+parseConst = do
+	skipMany space
+	-- TODO: only decimal and hex (since this is supported by read)
+	-- TODO: how to check to big values?
+	str <- try(do pref <- string "0x"; z <- many1 hexDigit; return $ (pref ++ z)) <|> (many1 digit)
+	let val = read str
+	return $ val
+
+parseMySpaces :: Parser String
+parseMySpaces = do
+	ret <- many $ oneOf "\t "
+	return $ ret
+
+-- teh pars0rs
+lf_data = do
+	l <- try (parseLabel) <|> string ""
+	skipMany space
+	fill <- string ".fill "
+	-- TODO: atm 32bit imm only
+	code <- many1 $ noneOf "\n;"
+	-- TODO: this is quite ugly here :/
+	let (Right val) = parse parseConst "" code
+	comment <- try(parseComment) <|> parseMySpaces
+	return $ DTF_SectionToDet 0 val (fill ++ code) l comment
+
+lf_comment = do
+	comment <- parseComment
 	return $ DTF_Comment comment
 
-lf_label = do string "label"; return $ DTF_Comment "lolz1"
-lf_toparse = do string "toparse"; return $ DTF_Comment "lolz2"
-lf_org = do string "org"; return $ DTF_Comment "lolz3"
+lf_label = do
+	l <- parseLabel
+	comment <- try(parseComment) <|> parseMySpaces
+	return $ DTF_Label l comment 0
+
+lf_toparse = do
+	l <- try(parseLabel) <|> string ""
+	skipMany space
+	code <- many1 $ noneOf "\n;"
+	comment <- try(parseComment) <|> parseMySpaces
+	return $ DTF_InstrToParse 0 code code l comment
+
+lf_org = do
+	skipMany space
+	string ".org"
+	val <- parseConst
+	parseMySpaces
+	return $ DTF_Org val
+
+lf_sdata = do
+	skipMany space
+	string ".data"
+	parseMySpaces
+	return $ DTF_State InData
+
+lf_stext = do
+	skipMany space
+	string ".text"
+	parseMySpaces
+	return $ DTF_State InText