1
0
mirror of https://github.com/catseye/SixtyPical.git synced 2024-06-26 16:29:28 +00:00

Capture indirectnesss/literalness/indexness in StorageLocation.

This commit is contained in:
Cat's Eye Technologies 2014-04-02 17:56:08 +01:00
parent 061a1661dd
commit 40afeae0b6
4 changed files with 29 additions and 26 deletions

View File

@ -63,7 +63,7 @@ checkRoutine (Routine name (instr : instrs)) progCtx routCtx =
in
checkRoutine (Routine name instrs) progCtx routCtx'
checkInstr (PUT dst imm) progCtx routCtx =
checkInstr (COPY (Immediate imm) dst) progCtx routCtx =
Map.insert dst (Value imm) routCtx
checkInstr (COPY src dst) progCtx routCtx =
Map.insert dst (Map.findWithDefault Unknown src routCtx) routCtx

View File

@ -32,15 +32,15 @@ emitInstrs _ _ [] = ""
emitInstrs p r (instr:instrs) =
" " ++ emitInstr p r instr ++ "\n" ++ emitInstrs p r instrs
emitInstr p r (PUT A val) = "lda #" ++ (show val)
emitInstr p r (PUT X val) = "ldx #" ++ (show val)
emitInstr p r (PUT Y val) = "ldy #" ++ (show val)
emitInstr p r (COPY (Immediate val) A) = "lda #" ++ (show val)
emitInstr p r (COPY (Immediate val) X) = "ldx #" ++ (show val)
emitInstr p r (COPY (Immediate val) Y) = "ldy #" ++ (show val)
emitInstr p r (PUT FlagC 0) = "clc"
emitInstr p r (PUT FlagD 0) = "cld"
emitInstr p r (PUT FlagV 0) = "clv"
emitInstr p r (PUT FlagC 1) = "sec"
emitInstr p r (PUT FlagD 1) = "sed"
emitInstr p r (COPY (Immediate 0) FlagC) = "clc"
emitInstr p r (COPY (Immediate 0) FlagD) = "cld"
emitInstr p r (COPY (Immediate 0) FlagV) = "clv"
emitInstr p r (COPY (Immediate 1) FlagC) = "sec"
emitInstr p r (COPY (Immediate 1) FlagD) = "sed"
emitInstr p r (COPY A (NamedLocation label)) = "sta " ++ label
emitInstr p r (COPY X (NamedLocation label)) = "stx " ++ label

View File

@ -28,6 +28,10 @@ data StorageLocation = A
| FlagD
| FlagZ
| FlagC
| Immediate DataValue
| Indirect StorageLocation
| Indexed StorageLocation StorageLocation
| IndirectIndexed StorageLocation StorageLocation
| NamedLocation LocationName
deriving (Show, Ord, Eq)
@ -54,8 +58,7 @@ type RoutineName = String
data Branch = BCC | BCS | BEQ | BMI | BNE | BPL | BVC | BVS
deriving (Show, Ord, Eq)
data Instruction = PUT StorageLocation DataValue
| COPY StorageLocation StorageLocation
data Instruction = COPY StorageLocation StorageLocation
| COPYINDEXED StorageLocation StorageLocation StorageLocation
| COPYINDIRECTINDEXED StorageLocation StorageLocation StorageLocation
| CMPIMM StorageLocation DataValue

View File

@ -132,8 +132,8 @@ index = do
"x" -> X
"y" -> Y
data Directness = Direct LocationName
| Indirect LocationName
data Directness = Directly LocationName
| Indirectly LocationName
deriving (Ord, Show, Eq)
indirect_location :: Parser Directness
@ -143,12 +143,12 @@ indirect_location = do
l <- locationName
string ")"
spaces
return $ Indirect l
return $ Indirectly l
direct_location :: Parser Directness
direct_location = do
l <- locationName
return $ Direct l
return $ Directly l
directness_location = (try indirect_location) <|> direct_location
@ -197,31 +197,31 @@ clc :: Parser Instruction
clc = do
string "clc"
spaces
return $ PUT FlagC 0
return $ COPY (Immediate 0) FlagC
cld :: Parser Instruction
cld = do
string "cld"
spaces
return $ PUT FlagD 0
return $ COPY (Immediate 0) FlagD
clv :: Parser Instruction
clv = do
string "clv"
spaces
return $ PUT FlagV 0
return $ COPY (Immediate 0) FlagV
sec :: Parser Instruction
sec = do
string "sec"
spaces
return $ PUT FlagC 1
return $ COPY (Immediate 1) FlagC
sed :: Parser Instruction
sed = do
string "sed"
spaces
return $ PUT FlagD 1
return $ COPY (Immediate 1) FlagD
inx :: Parser Instruction
inx = do
@ -314,7 +314,7 @@ lda :: Parser Instruction
lda = do
string "lda"
spaces
(try $ immediate (\v -> PUT A v) <|> absolute_indexed gen)
(try $ immediate (\v -> COPY (Immediate v) A) <|> absolute_indexed gen)
where
gen l [] = COPY (NamedLocation l) A
gen l [reg] = COPYINDEXED (NamedLocation l) A reg
@ -323,14 +323,14 @@ ldx :: Parser Instruction
ldx = do
string "ldx"
spaces
(try $ immediate (\v -> PUT X v) <|>
(try $ immediate (\v -> COPY (Immediate v) X) <|>
absolute (\l -> COPY (NamedLocation l) X))
ldy :: Parser Instruction
ldy = do
string "ldy"
spaces
(try $ immediate (\v -> PUT Y v) <|>
(try $ immediate (\v -> COPY (Immediate v) Y) <|>
absolute (\l -> COPY (NamedLocation l) Y))
sta :: Parser Instruction
@ -339,9 +339,9 @@ sta = do
spaces
indirect_indexed gen
where
gen (Direct l) [] = COPY A (NamedLocation l)
gen (Direct l) [reg] = COPYINDEXED A (NamedLocation l) reg
gen (Indirect l) [reg] = COPYINDIRECTINDEXED A (NamedLocation l) reg
gen (Directly l) [] = COPY A (NamedLocation l)
gen (Directly l) [reg] = COPYINDEXED A (NamedLocation l) reg
gen (Indirectly l) [reg] = COPYINDIRECTINDEXED A (NamedLocation l) reg
stx :: Parser Instruction
stx = do