From aacfb02375b74713a0d88faceca6ac59700125fd Mon Sep 17 00:00:00 2001 From: Cat's Eye Technologies Date: Fri, 11 Apr 2014 20:35:45 +0100 Subject: [PATCH] `reserve`d storage locations can have initial values. --- README.markdown | 3 ++- doc/Checking.markdown | 11 ++++++++ doc/Emitting.markdown | 12 ++++----- src/SixtyPical/Checker.hs | 2 +- src/SixtyPical/Emitter.hs | 12 ++++++--- src/SixtyPical/Model.hs | 8 +++--- src/SixtyPical/Parser.hs | 56 ++++++++++++++++++--------------------- 7 files changed, 59 insertions(+), 45 deletions(-) diff --git a/README.markdown b/README.markdown index 84cf419..870a2fb 100644 --- a/README.markdown +++ b/README.markdown @@ -122,9 +122,10 @@ an added `foldr` or two would not be unwelcome... TODO ---- -* Initial values for reserved, incl. tables +* Initial values for reserved tables * give length for tables, must be there for reserved, if no init val * Character tables ("strings" to everybody else) +* Put uninitialized `reserve`d data in uninitialized data segment * Addressing modes — indexed mode on more instructions * `jsr (vector)` * `jmp routine` diff --git a/doc/Checking.markdown b/doc/Checking.markdown index 98178ba..ffcca1d 100644 --- a/doc/Checking.markdown +++ b/doc/Checking.markdown @@ -69,6 +69,17 @@ to all routines. | } = True +An address declared with `reserve` may be given an initial value. + + | reserve byte lives : 3 + | routine main { + | sta lives + | } + | routine died { + | dec lives + | } + = True + An address may be declared with `locate`, which is like `.alias` in an assembler, with the understanding that the value will be treated "like an address." This is generally an address into the operating system or hardware diff --git a/doc/Emitting.markdown b/doc/Emitting.markdown index ce9a052..db0978a 100644 --- a/doc/Emitting.markdown +++ b/doc/Emitting.markdown @@ -36,29 +36,29 @@ Emitting an `if`. Emitting a `repeat`. | assign byte screen 1024 - | reserve byte zero + | reserve byte four : $04 | routine main { - | ldy zero + | ldy four | repeat bne { | inc screen | dey - | cpy zero + | cpy four | } | sty screen | } = main: - = ldy zero + = ldy four = = _repeat_1: = inc screen = dey - = cpy zero + = cpy four = BNE _repeat_1 = sty screen = rts = = .alias screen 1024 - = zero: .byte 0 + = four: .byte 4 Nested ifs. diff --git a/src/SixtyPical/Checker.hs b/src/SixtyPical/Checker.hs index 29a61d0..f87ef42 100644 --- a/src/SixtyPical/Checker.hs +++ b/src/SixtyPical/Checker.hs @@ -31,7 +31,7 @@ noIndexedAccessOfNonTables p@(Program decls routines) = checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) = case lookupDecl p g of Just (Assign _ ByteTable _) -> j - Just (Reserve _ ByteTable) -> j + Just (Reserve _ ByteTable _) -> j Just _ -> (COPY A A) Nothing -> (COPY A A) checkInstr other = other diff --git a/src/SixtyPical/Emitter.hs b/src/SixtyPical/Emitter.hs index 4034693..24b386a 100644 --- a/src/SixtyPical/Emitter.hs +++ b/src/SixtyPical/Emitter.hs @@ -20,9 +20,15 @@ emitDecls p (decl:decls) = emitDecl p decl ++ "\n" ++ emitDecls p decls emitDecl p (Assign name _ addr) = ".alias " ++ name ++ " " ++ (show addr) -emitDecl p (Reserve name Byte) = name ++ ": .byte 0" -emitDecl p (Reserve name Word) = name ++ ": .word 0" -emitDecl p (Reserve name Vector) = name ++ ": .word 0" +emitDecl p (Reserve name typ value) + | typ == Byte = name ++ ": .byte " ++ val + | typ == Word = name ++ ": .word " ++ val + | typ == Vector = name ++ ": .word " ++ val + where + val = case value of + (Just v) -> (show v) + Nothing -> "0" + emitDecl p (External name addr) = ".alias " ++ name ++ " " ++ (show addr) emitDecl p d = error ( "Internal error: sixtypical doesn't know how to " ++ diff --git a/src/SixtyPical/Model.hs b/src/SixtyPical/Model.hs index cd4cd66..371eb72 100644 --- a/src/SixtyPical/Model.hs +++ b/src/SixtyPical/Model.hs @@ -47,7 +47,7 @@ data StorageLocation = A -- -- -- -- program model -- -- -- -- data Decl = Assign LocationName StorageType Address -- .alias - | Reserve LocationName StorageType -- .word, .byte + | Reserve LocationName StorageType (Maybe DataValue) -- .word, .byte | External RoutineName Address deriving (Show, Ord, Eq) @@ -93,13 +93,13 @@ programSummary p@(Program decls routs) = getRoutineName (Routine name _ _) = name getDeclLocationName (Assign name _ _) = name -getDeclLocationName (Reserve name _) = name +getDeclLocationName (Reserve name _ _) = name getDeclLocationType (Assign _ t _) = t -getDeclLocationType (Reserve _ t) = t +getDeclLocationType (Reserve _ t _) = t isLocationDecl (Assign _ _ _) = True -isLocationDecl (Reserve _ _) = True +isLocationDecl (Reserve _ _ _) = True isLocationDecl _ = False declaredLocationNames (Program decls _) = diff --git a/src/SixtyPical/Parser.hs b/src/SixtyPical/Parser.hs index 52887e7..27ad98b 100644 --- a/src/SixtyPical/Parser.hs +++ b/src/SixtyPical/Parser.hs @@ -11,10 +11,10 @@ import SixtyPical.Model {- Toplevel := {Decl} {Routine}. -Decl := "reserve" StorageType LocationName - | "assign" StorageType LocationName Address +Decl := "reserve" StorageType LocationName [":" Literal] + | "assign" StorageType LocationName Literal | "external" RoutineName Address. -StorageType := "byte" | "word" | "vector". +StorageType := "byte" | "word" | "byte table" | "vector". Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block. Block := "{" {Command} "}". Command := "if" Branch Block "else" Block @@ -68,7 +68,11 @@ reserve = do nspaces sz <- storage_type name <- location_name - return $ Reserve name sz + value <- option Nothing (do{ string ":"; + nspaces; + x <- literal_data_value; + return $ Just x }) + return $ Reserve name sz value assign :: Parser Decl assign = do @@ -76,7 +80,7 @@ assign = do nspaces sz <- storage_type name <- location_name - addr <- address + addr <- literal_address return $ Assign name sz addr external :: Parser Decl @@ -84,7 +88,7 @@ external = do string "external" nspaces name <- routineName - addr <- address + addr <- literal_address return $ External name addr get_storage "byte" = Byte @@ -196,7 +200,7 @@ register_location = do immediate :: Parser AddressingModality immediate = do string "#" - v <- data_value + v <- literal_data_value return $ Immediately v addressing_mode :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction @@ -585,37 +589,29 @@ named_location = do name <- location_name return (NamedLocation Nothing name) -address = hex_address <|> decimal_address +literal_address = do + a <- literal_value + return (a :: Address) -hex_address :: Parser Address -hex_address = do +literal_data_value = do + a <- literal_value + return (a :: DataValue) + +literal_value = hex_literal <|> decimal_literal + +hex_literal :: Parser Int +hex_literal = do char '$' digits <- many hexDigit nspaces let ((d, _):_) = readHex digits - return (d :: Address) + return d -decimal_address :: Parser Address -decimal_address = do +decimal_literal :: Parser Int +decimal_literal = do digits <- many digit nspaces - return (read digits :: Address) - -data_value = hex_data_value <|> decimal_data_value - -hex_data_value :: Parser DataValue -hex_data_value = do - char '$' - digits <- many hexDigit - nspaces - let ((d, _):_) = readHex digits - return (d :: DataValue) - -decimal_data_value :: Parser DataValue -decimal_data_value = do - digits <- many digit - nspaces - return (read digits :: DataValue) + return $ read digits -- -- -- driver -- -- --