diff --git a/src/Lazyboy/Control.hs b/src/Lazyboy/Control.hs index cc6d4ac..7173269 100644 --- a/src/Lazyboy/Control.hs +++ b/src/Lazyboy/Control.hs @@ -13,6 +13,7 @@ module Lazyboy.Control where import Control.Monad.Trans.RWS +import Data.Word import Lazyboy.Types -- | Execute an action within a global label and pass the action the label. @@ -31,6 +32,23 @@ withLocalLabel block = do tell [LABEL label] block label +-- | Embed a file and return a (global) label for it. +embedFile :: FilePath -> Lazyboy Label +embedFile file = do + label <- Global <$> get + tell [LABEL label, INCLUDE file] + return label + +-- | Embed an image and return a (global) label for it. +embedImage = embedFile + +-- | Embed a sequence of bytes into the file and return a (global) label for it. +embedBytes :: [Word8] -> Lazyboy Label +embedBytes bytes = do + label <- Global <$> get + tell [LABEL label, BYTES bytes] + return label + -- | Suspend execution indefinitely by jumping infinitely. freeze :: Lazyboy () freeze = loop $ return () diff --git a/src/Lazyboy/IO.hs b/src/Lazyboy/IO.hs index 6ef9322..b7c73fb 100644 --- a/src/Lazyboy/IO.hs +++ b/src/Lazyboy/IO.hs @@ -94,5 +94,4 @@ memcpy src dest len = do tell [LDrrnn HL src, LDrrnn DE dest, LDrn B len] withLocalLabel $ \label -> do tell [LDAHLI] -- load a byte from [HL] into A and increment - tell [LDrrA DE, INCrr DE, DECr B, JUMPif NonZero label] - + tell [LDrrA DE, INCrr DE, DECr B, JUMPif NonZero label] \ No newline at end of file diff --git a/src/Lazyboy/Target/ASM.hs b/src/Lazyboy/Target/ASM.hs index 9822411..9b51a06 100644 --- a/src/Lazyboy/Target/ASM.hs +++ b/src/Lazyboy/Target/ASM.hs @@ -17,6 +17,7 @@ module Lazyboy.Target.ASM where import Control.Monad.Trans.RWS.Lazy import Data.Aeson import Data.Char (toLower) +import Data.List (intercalate) import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.IO as T import Lazyboy.Types @@ -191,6 +192,8 @@ instance Show Instruction where show (LABEL l) = printf "%s:" l show (JUMP l) = printf "jp %s" l show (JUMPif c l) = printf "jp %s, %s" c l + show (INCLUDE file) = printf "INCBIN \"%s\"" file + show (BYTES bytes) = printf "db " ++ intercalate "," (map (printf "$%X") bytes) show _ = error "Use of unimplemented instruction" diff --git a/src/Lazyboy/Types.hs b/src/Lazyboy/Types.hs index a3c0115..1006d25 100644 --- a/src/Lazyboy/Types.hs +++ b/src/Lazyboy/Types.hs @@ -159,5 +159,7 @@ data Instruction = | LABEL Label -- create a numbered label | JUMP Label -- jump to a label | JUMPif Condition Label -- conditional jumping to a label + | INCLUDE FilePath -- include a file + | BYTES [Word8] -- define some bytes with a global label deriving (Read, Eq) diff --git a/templates/bare.mustache b/templates/bare.mustache index 9c3c4ca..5791078 100644 --- a/templates/bare.mustache +++ b/templates/bare.mustache @@ -11,5 +11,5 @@ SECTION "main", ROM0[$0150] main: {{#body}} -{{.}} +{{{.}}} {{/body}} \ No newline at end of file diff --git a/test/Spec.hs b/test/Spec.hs index e06ddaf..97b57ab 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -79,45 +79,57 @@ main = hspec $ do , "ld HL, $C000" , "ld [HL], 151" ] + describe "embedImage" $ do + it "leverages RGBASM to include a binary" $ do + let program = execLazyboy $ embedImage "test.bin" + program `shouldBe` [LABEL $ Global 1, INCLUDE "test.bin"] + describe "embedBytes" $ do + it "defines a raw sequence of bytes" $ do + let program = execLazyboy $ embedBytes [0x00, 0x01, 0x02] + program `shouldBe` [LABEL $ Global 1, BYTES [0x00, 0x01, 0x02]] - describe "Prelude.show" $ do - it "disallows loading [AF] into A" $ do - disallow (show $ LDArr AF) - it "disallows loading [SP] into A" $ do - disallow (show $ LDArr SP) - it "disallows loading [PC] into A" $ do - disallow (show $ LDArr PC) - it "disallows loading A into [AF]" $ do - disallow (show $ LDrrA AF) - it "disallows loading A into [SP]" $ do - disallow (show $ LDrrA SP) - it "disallows loading A into [PC]" $ do - disallow (show $ LDrrA PC) - it "disallows loading a 16 bit value into AF" $ do - disallow (show $ LDrrnn AF 0x00) - it "disallows loading a 16 bit value into PC" $ do - disallow (show $ LDrrnn PC 0x00) - it "disallows pushing stack pointer" $ do - disallow (show $ PUSH SP) - it "disallows pushing program counter" $ do - disallow (show $ PUSH PC) - it "disallows popping stack pointer" $ do - disallow (show $ POP SP) - it "disallows popping program counter" $ do - disallow (show $ POP PC) - it "disallows an invalid RST vector value" $ do - disallow (show $ RST 0x02) - it "disallows adding AF to HL" $ do - disallow (show $ ADDHLrr AF) - it "disallows adding PC to HL" $ do - disallow (show $ ADDHLrr PC) - it "disallows incrementing AF" $ do - disallow (show $ INCrr AF) - it "disallows incrementing PC" $ do - disallow (show $ INCrr PC) - it "disallows decrementing AF" $ do - disallow (show $ DECrr AF) - it "disallows decrementing PC" $ do - disallow (show $ DECrr PC) - it "enforces only 3-bit values can be passed to BIT instructions" $ do - disallow (show $ BITnr 0x80 A) + describe "Lazyboy.Target.ASM" $ do + describe "show" $ do + it "disallows loading [AF] into A" $ do + disallow (show $ LDArr AF) + it "disallows loading [SP] into A" $ do + disallow (show $ LDArr SP) + it "disallows loading [PC] into A" $ do + disallow (show $ LDArr PC) + it "disallows loading A into [AF]" $ do + disallow (show $ LDrrA AF) + it "disallows loading A into [SP]" $ do + disallow (show $ LDrrA SP) + it "disallows loading A into [PC]" $ do + disallow (show $ LDrrA PC) + it "disallows loading a 16 bit value into AF" $ do + disallow (show $ LDrrnn AF 0x00) + it "disallows loading a 16 bit value into PC" $ do + disallow (show $ LDrrnn PC 0x00) + it "disallows pushing stack pointer" $ do + disallow (show $ PUSH SP) + it "disallows pushing program counter" $ do + disallow (show $ PUSH PC) + it "disallows popping stack pointer" $ do + disallow (show $ POP SP) + it "disallows popping program counter" $ do + disallow (show $ POP PC) + it "disallows an invalid RST vector value" $ do + disallow (show $ RST 0x02) + it "disallows adding AF to HL" $ do + disallow (show $ ADDHLrr AF) + it "disallows adding PC to HL" $ do + disallow (show $ ADDHLrr PC) + it "disallows incrementing AF" $ do + disallow (show $ INCrr AF) + it "disallows incrementing PC" $ do + disallow (show $ INCrr PC) + it "disallows decrementing AF" $ do + disallow (show $ DECrr AF) + it "disallows decrementing PC" $ do + disallow (show $ DECrr PC) + it "enforces only 3-bit values can be passed to BIT instructions" $ do + disallow (show $ BITnr 0x80 A) + it "formats embedded byte sequences correctly" $ do + let program = map show $ execLazyboy $ tell [BYTES [97, 98]] + program `shouldBe` ["db $61,$62" ]