It works!
This commit is contained in:
parent
f10c428309
commit
3e5df86c1b
|
@ -15,4 +15,4 @@ myProgram = do
|
||||||
call "accumulatorLoadNStore"
|
call "accumulatorLoadNStore"
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = print $ execState myProgram emptyState
|
main = print $ runState myProgram emptyState
|
||||||
|
|
|
@ -19,7 +19,7 @@ makeLenses ''InstructionState
|
||||||
emptyState :: InstructionState
|
emptyState :: InstructionState
|
||||||
emptyState = InstructionState { _functionTable = M.empty, _bytestring = B.empty }
|
emptyState = InstructionState { _functionTable = M.empty, _bytestring = B.empty }
|
||||||
|
|
||||||
type Instruction = State InstructionState InstructionState
|
type Instruction = State InstructionState ()
|
||||||
|
|
||||||
-- This function converts the instructions into a usable bytestring. It's the meat and bones of this DSL.
|
-- This function converts the instructions into a usable bytestring. It's the meat and bones of this DSL.
|
||||||
runInstructions :: Instruction -> B.ByteString
|
runInstructions :: Instruction -> B.ByteString
|
||||||
|
@ -60,21 +60,15 @@ appendBytesThenWord bytes word insState = over bytestring (\bs -> B.append bs (B
|
||||||
|
|
||||||
-- This function allows you to define an instruction opcode that takes no argument
|
-- This function allows you to define an instruction opcode that takes no argument
|
||||||
genericNoByteOp :: Word8 -> Instruction
|
genericNoByteOp :: Word8 -> Instruction
|
||||||
genericNoByteOp op = do
|
genericNoByteOp op = modify $ appendBytes [op]
|
||||||
insState <- get
|
|
||||||
return $ appendBytes [op] insState
|
|
||||||
|
|
||||||
-- This function allows you to define an instruction opcode that takes a one byte argument
|
-- This function allows you to define an instruction opcode that takes a one byte argument
|
||||||
genericOp :: Word8 -> Word8 -> Instruction
|
genericOp :: Word8 -> Word8 -> Instruction
|
||||||
genericOp op arg = do
|
genericOp op arg = modify $ appendBytes [op, arg]
|
||||||
insState <- get
|
|
||||||
return $ appendBytes [op, arg] insState
|
|
||||||
|
|
||||||
-- This function allows you to define an instruction opcode that takes a two byte argument
|
-- This function allows you to define an instruction opcode that takes a two byte argument
|
||||||
genericTwoByteOp :: Word8 -> Word16 -> Instruction
|
genericTwoByteOp :: Word8 -> Word16 -> Instruction
|
||||||
genericTwoByteOp op arg = do
|
genericTwoByteOp op arg = modify $ appendBytesThenWord [op] arg
|
||||||
insState <- get
|
|
||||||
return $ appendBytesThenWord [op] arg insState
|
|
||||||
|
|
||||||
-- This allows you to define subroutines which can be called later using `call`.
|
-- This allows you to define subroutines which can be called later using `call`.
|
||||||
-- Note: your function must end with an `rts`, I don't add that automatically
|
-- Note: your function must end with an `rts`, I don't add that automatically
|
||||||
|
@ -83,7 +77,7 @@ define name definition = do
|
||||||
insState <- get
|
insState <- get
|
||||||
let insState' = over functionTable (\fT -> M.insert name (B.length $ insState ^. bytestring) fT) insState
|
let insState' = over functionTable (\fT -> M.insert name (B.length $ insState ^. bytestring) fT) insState
|
||||||
-- TODO: COMBINE THE FUNCTION DEFINITIONS HERE TOO NOT JUST BYTESTRINGS
|
-- TODO: COMBINE THE FUNCTION DEFINITIONS HERE TOO NOT JUST BYTESTRINGS
|
||||||
return $ execState definition insState'
|
put $ execState definition insState'
|
||||||
|
|
||||||
-- This can be used to call subroutines which were previously `define`d.
|
-- This can be used to call subroutines which were previously `define`d.
|
||||||
call :: String -> Instruction
|
call :: String -> Instruction
|
||||||
|
@ -92,7 +86,7 @@ call name = do
|
||||||
let pointer = case (M.lookup name (insState ^. functionTable)) of
|
let pointer = case (M.lookup name (insState ^. functionTable)) of
|
||||||
Just ptr -> ptr
|
Just ptr -> ptr
|
||||||
Nothing -> error ("Couldn't find function " ++ name ++ ". Perhaps it wasn't `define`d?")
|
Nothing -> error ("Couldn't find function " ++ name ++ ". Perhaps it wasn't `define`d?")
|
||||||
jsr (Absolute $ fromIntegral pointer)
|
put $ execState (jsr (Absolute $ fromIntegral pointer)) insState
|
||||||
|
|
||||||
-- THE FOLLOWING WAS GENERATED BY
|
-- THE FOLLOWING WAS GENERATED BY
|
||||||
-- https://github.com/aearnus/assemblicom
|
-- https://github.com/aearnus/assemblicom
|
||||||
|
|
Loading…
Reference in New Issue