mirror of
https://github.com/catseye/SixtyPical.git
synced 2025-02-16 15:30:26 +00:00
reserve
d storage locations can have initial values.
This commit is contained in:
parent
2fb9621a04
commit
aacfb02375
@ -122,9 +122,10 @@ an added `foldr` or two would not be unwelcome...
|
|||||||
TODO
|
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
|
* give length for tables, must be there for reserved, if no init val
|
||||||
* Character tables ("strings" to everybody else)
|
* Character tables ("strings" to everybody else)
|
||||||
|
* Put uninitialized `reserve`d data in uninitialized data segment
|
||||||
* Addressing modes — indexed mode on more instructions
|
* Addressing modes — indexed mode on more instructions
|
||||||
* `jsr (vector)`
|
* `jsr (vector)`
|
||||||
* `jmp routine`
|
* `jmp routine`
|
||||||
|
@ -69,6 +69,17 @@ to all routines.
|
|||||||
| }
|
| }
|
||||||
= True
|
= 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
|
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
|
assembler, with the understanding that the value will be treated "like an
|
||||||
address." This is generally an address into the operating system or hardware
|
address." This is generally an address into the operating system or hardware
|
||||||
|
@ -36,29 +36,29 @@ Emitting an `if`.
|
|||||||
Emitting a `repeat`.
|
Emitting a `repeat`.
|
||||||
|
|
||||||
| assign byte screen 1024
|
| assign byte screen 1024
|
||||||
| reserve byte zero
|
| reserve byte four : $04
|
||||||
| routine main {
|
| routine main {
|
||||||
| ldy zero
|
| ldy four
|
||||||
| repeat bne {
|
| repeat bne {
|
||||||
| inc screen
|
| inc screen
|
||||||
| dey
|
| dey
|
||||||
| cpy zero
|
| cpy four
|
||||||
| }
|
| }
|
||||||
| sty screen
|
| sty screen
|
||||||
| }
|
| }
|
||||||
= main:
|
= main:
|
||||||
= ldy zero
|
= ldy four
|
||||||
=
|
=
|
||||||
= _repeat_1:
|
= _repeat_1:
|
||||||
= inc screen
|
= inc screen
|
||||||
= dey
|
= dey
|
||||||
= cpy zero
|
= cpy four
|
||||||
= BNE _repeat_1
|
= BNE _repeat_1
|
||||||
= sty screen
|
= sty screen
|
||||||
= rts
|
= rts
|
||||||
=
|
=
|
||||||
= .alias screen 1024
|
= .alias screen 1024
|
||||||
= zero: .byte 0
|
= four: .byte 4
|
||||||
|
|
||||||
Nested ifs.
|
Nested ifs.
|
||||||
|
|
||||||
|
@ -31,7 +31,7 @@ noIndexedAccessOfNonTables p@(Program decls routines) =
|
|||||||
checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) =
|
checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) =
|
||||||
case lookupDecl p g of
|
case lookupDecl p g of
|
||||||
Just (Assign _ ByteTable _) -> j
|
Just (Assign _ ByteTable _) -> j
|
||||||
Just (Reserve _ ByteTable) -> j
|
Just (Reserve _ ByteTable _) -> j
|
||||||
Just _ -> (COPY A A)
|
Just _ -> (COPY A A)
|
||||||
Nothing -> (COPY A A)
|
Nothing -> (COPY A A)
|
||||||
checkInstr other = other
|
checkInstr other = other
|
||||||
|
@ -20,9 +20,15 @@ emitDecls p (decl:decls) =
|
|||||||
emitDecl p decl ++ "\n" ++ emitDecls p decls
|
emitDecl p decl ++ "\n" ++ emitDecls p decls
|
||||||
|
|
||||||
emitDecl p (Assign name _ addr) = ".alias " ++ name ++ " " ++ (show addr)
|
emitDecl p (Assign name _ addr) = ".alias " ++ name ++ " " ++ (show addr)
|
||||||
emitDecl p (Reserve name Byte) = name ++ ": .byte 0"
|
emitDecl p (Reserve name typ value)
|
||||||
emitDecl p (Reserve name Word) = name ++ ": .word 0"
|
| typ == Byte = name ++ ": .byte " ++ val
|
||||||
emitDecl p (Reserve name Vector) = name ++ ": .word 0"
|
| 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 (External name addr) = ".alias " ++ name ++ " " ++ (show addr)
|
||||||
emitDecl p d = error (
|
emitDecl p d = error (
|
||||||
"Internal error: sixtypical doesn't know how to " ++
|
"Internal error: sixtypical doesn't know how to " ++
|
||||||
|
@ -47,7 +47,7 @@ data StorageLocation = A
|
|||||||
-- -- -- -- program model -- -- -- --
|
-- -- -- -- program model -- -- -- --
|
||||||
|
|
||||||
data Decl = Assign LocationName StorageType Address -- .alias
|
data Decl = Assign LocationName StorageType Address -- .alias
|
||||||
| Reserve LocationName StorageType -- .word, .byte
|
| Reserve LocationName StorageType (Maybe DataValue) -- .word, .byte
|
||||||
| External RoutineName Address
|
| External RoutineName Address
|
||||||
deriving (Show, Ord, Eq)
|
deriving (Show, Ord, Eq)
|
||||||
|
|
||||||
@ -93,13 +93,13 @@ programSummary p@(Program decls routs) =
|
|||||||
getRoutineName (Routine name _ _) = name
|
getRoutineName (Routine name _ _) = name
|
||||||
|
|
||||||
getDeclLocationName (Assign name _ _) = name
|
getDeclLocationName (Assign name _ _) = name
|
||||||
getDeclLocationName (Reserve name _) = name
|
getDeclLocationName (Reserve name _ _) = name
|
||||||
|
|
||||||
getDeclLocationType (Assign _ t _) = t
|
getDeclLocationType (Assign _ t _) = t
|
||||||
getDeclLocationType (Reserve _ t) = t
|
getDeclLocationType (Reserve _ t _) = t
|
||||||
|
|
||||||
isLocationDecl (Assign _ _ _) = True
|
isLocationDecl (Assign _ _ _) = True
|
||||||
isLocationDecl (Reserve _ _) = True
|
isLocationDecl (Reserve _ _ _) = True
|
||||||
isLocationDecl _ = False
|
isLocationDecl _ = False
|
||||||
|
|
||||||
declaredLocationNames (Program decls _) =
|
declaredLocationNames (Program decls _) =
|
||||||
|
@ -11,10 +11,10 @@ import SixtyPical.Model
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
Toplevel := {Decl} {Routine}.
|
Toplevel := {Decl} {Routine}.
|
||||||
Decl := "reserve" StorageType LocationName
|
Decl := "reserve" StorageType LocationName [":" Literal]
|
||||||
| "assign" StorageType LocationName Address
|
| "assign" StorageType LocationName Literal
|
||||||
| "external" RoutineName Address.
|
| "external" RoutineName Address.
|
||||||
StorageType := "byte" | "word" | "vector".
|
StorageType := "byte" | "word" | "byte table" | "vector".
|
||||||
Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
|
Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
|
||||||
Block := "{" {Command} "}".
|
Block := "{" {Command} "}".
|
||||||
Command := "if" Branch Block "else" Block
|
Command := "if" Branch Block "else" Block
|
||||||
@ -68,7 +68,11 @@ reserve = do
|
|||||||
nspaces
|
nspaces
|
||||||
sz <- storage_type
|
sz <- storage_type
|
||||||
name <- location_name
|
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 :: Parser Decl
|
||||||
assign = do
|
assign = do
|
||||||
@ -76,7 +80,7 @@ assign = do
|
|||||||
nspaces
|
nspaces
|
||||||
sz <- storage_type
|
sz <- storage_type
|
||||||
name <- location_name
|
name <- location_name
|
||||||
addr <- address
|
addr <- literal_address
|
||||||
return $ Assign name sz addr
|
return $ Assign name sz addr
|
||||||
|
|
||||||
external :: Parser Decl
|
external :: Parser Decl
|
||||||
@ -84,7 +88,7 @@ external = do
|
|||||||
string "external"
|
string "external"
|
||||||
nspaces
|
nspaces
|
||||||
name <- routineName
|
name <- routineName
|
||||||
addr <- address
|
addr <- literal_address
|
||||||
return $ External name addr
|
return $ External name addr
|
||||||
|
|
||||||
get_storage "byte" = Byte
|
get_storage "byte" = Byte
|
||||||
@ -196,7 +200,7 @@ register_location = do
|
|||||||
immediate :: Parser AddressingModality
|
immediate :: Parser AddressingModality
|
||||||
immediate = do
|
immediate = do
|
||||||
string "#"
|
string "#"
|
||||||
v <- data_value
|
v <- literal_data_value
|
||||||
return $ Immediately v
|
return $ Immediately v
|
||||||
|
|
||||||
addressing_mode :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction
|
addressing_mode :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction
|
||||||
@ -585,37 +589,29 @@ named_location = do
|
|||||||
name <- location_name
|
name <- location_name
|
||||||
return (NamedLocation Nothing name)
|
return (NamedLocation Nothing name)
|
||||||
|
|
||||||
address = hex_address <|> decimal_address
|
literal_address = do
|
||||||
|
a <- literal_value
|
||||||
|
return (a :: Address)
|
||||||
|
|
||||||
hex_address :: Parser Address
|
literal_data_value = do
|
||||||
hex_address = do
|
a <- literal_value
|
||||||
|
return (a :: DataValue)
|
||||||
|
|
||||||
|
literal_value = hex_literal <|> decimal_literal
|
||||||
|
|
||||||
|
hex_literal :: Parser Int
|
||||||
|
hex_literal = do
|
||||||
char '$'
|
char '$'
|
||||||
digits <- many hexDigit
|
digits <- many hexDigit
|
||||||
nspaces
|
nspaces
|
||||||
let ((d, _):_) = readHex digits
|
let ((d, _):_) = readHex digits
|
||||||
return (d :: Address)
|
return d
|
||||||
|
|
||||||
decimal_address :: Parser Address
|
decimal_literal :: Parser Int
|
||||||
decimal_address = do
|
decimal_literal = do
|
||||||
digits <- many digit
|
digits <- many digit
|
||||||
nspaces
|
nspaces
|
||||||
return (read digits :: Address)
|
return $ read digits
|
||||||
|
|
||||||
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)
|
|
||||||
|
|
||||||
-- -- -- driver -- -- --
|
-- -- -- driver -- -- --
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user