summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorrose <>2019-05-15 15:58:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-05-15 15:58:00 (GMT)
commit492a8f87ce6ea365b5e5f2f56a404f3791ae51c3 (patch)
treec24e54a67bcf1cd8237457c26b86af3065d8b6d8
version 0.2.0.1HEAD0.2.0.1master
-rw-r--r--ChangeLog.md14
-rw-r--r--LICENSE30
-rw-r--r--README.md55
-rw-r--r--Setup.hs2
-rw-r--r--lazyboy.cabal70
-rw-r--r--src/Lazyboy.hs12
-rw-r--r--src/Lazyboy/Constants.hs87
-rw-r--r--src/Lazyboy/Control.hs87
-rw-r--r--src/Lazyboy/IO.hs127
-rw-r--r--src/Lazyboy/Target/ASM.hs230
-rw-r--r--src/Lazyboy/Types.hs170
-rw-r--r--templates/bare.mustache15
-rw-r--r--test/Spec.hs137
13 files changed, 1036 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..72219a6
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,14 @@
+# Changelog for Lazyboy
+
+# 0.2.0.0
+- Started versioning.
+- Formatted as a library package.
+
+## 0.2.0.1
+- Removed some useless instances of Show and Read.
+- Refactored most of the documentation.
+
+# 0.1.0.0
+- Initial version.
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..bcbfa95
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Rose (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Author name here nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..b4bc417
--- /dev/null
+++ b/README.md
@@ -0,0 +1,55 @@
+![LAZYBOY](meta/logo.png)
+[![Build Status](https://travis-ci.org/ix/lazyboy.svg?branch=master)](https://travis-ci.org/ix/lazyboy)
+[![Coverage Status](https://coveralls.io/repos/github/ix/lazyboy/badge.svg?branch=master)](https://coveralls.io/github/ix/lazyboy?branch=master)
+---
+
+An embedded domain-specific language + compiler written in Haskell for producing code to run on the Nintendo Game Boy.
+
+Also features a library for manipulating constructs such as memory and graphics.
+
+Currently, RGBASM is the only output target, but in the future native machine code generation is planned.
+
+Syntax example (will be updated as more complex constructs are added):
+```haskell
+main :: IO ()
+main = rom >>= T.putStrLn
+ where rom = compileROM $ do
+ smiley <- embedBytes image
+ -- set scroll values
+ write (Address scx) 0
+ write (Address scy) 0
+ -- set background palette
+ setBackgroundPalette defaultPalette
+ -- perform graphics operations
+ onVblank $ do
+ disableLCD
+ memcpy (Name smiley) (Address $ 0x9010) $ fromIntegral $ length image
+ memset (Address 0x9904) (0x992F - 0x9904) 0 -- clear the background tilemap
+ write (Address background1) 1 -- write the background tile data
+ setLCDControl $ defaultLCDControl { lcdDisplayEnable = True, lcdBackgroundEnable = True }
+ -- halt indefinitely
+ freeze
+
+image :: [Word8]
+image = [0x00,0x00,0x00,0x00,0x24,0x24,0x00,0x00,0x81,0x81,0x7e,0x7e,0x00,0x00,0x00,0x00]
+```
+
+See `app/Main.hs` for a full usage example.
+
+Build a ROM (output will be named `main.gb`):
+```
+stack run > examples/main.asm
+cd examples && make NAME=main
+```
+
+# About issues
+I mostly use the issue tracker on here as a place to write about planned features and compiler development,
+don't take the count as an indicator of active bugs, and be sure to filter to show only issues that are bugs if you are curious on the state of the project.
+
+# Contributing
+Please see the [Contributing](https://github.com/ix/lazyboy/wiki/Contributing) page on the Wiki.
+
+Additional information about the project can also be found on the Wiki.
+
+# Special thanks
+Thanks to [Francesco149](https://github.com/Francesco149) and [Bonzi](https://github.com/bnzis) for kindly devoting their time and knowledge to the project. The graphics functionality in particular would not be where it is without their assistance.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/lazyboy.cabal b/lazyboy.cabal
new file mode 100644
index 0000000..7584d14
--- /dev/null
+++ b/lazyboy.cabal
@@ -0,0 +1,70 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.31.1.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: adf7789c9ad4079eecaed83a9a636259d71db49774524381e2019d335985207e
+
+name: lazyboy
+version: 0.2.0.1
+synopsis: An EDSL for programming the Game Boy.
+description: An EDSL for programming the Nintendo Game Boy. <https://github.com/ix/lazyboy#readme>
+category: DSL, Compiler
+homepage: https://github.com/ix/lazyboy#readme
+bug-reports: https://github.com/ix/lazyboy/issues
+author: Rose
+maintainer: rose@lain.org.uk
+copyright: 2019 Rose
+license: BSD3
+license-file: LICENSE
+build-type: Simple
+extra-source-files:
+ README.md
+ ChangeLog.md
+data-files:
+ templates/bare.mustache
+
+source-repository head
+ type: git
+ location: https://github.com/ix/lazyboy
+
+library
+ exposed-modules:
+ Lazyboy
+ Lazyboy.Constants
+ Lazyboy.Control
+ Lazyboy.IO
+ Lazyboy.Target.ASM
+ Lazyboy.Types
+ other-modules:
+ Paths_lazyboy
+ hs-source-dirs:
+ src
+ ghc-options: -optP-Wno-nonportable-include-path
+ build-depends:
+ aeson >=1.4.2.0 && <1.5
+ , base >=4.7 && <5
+ , hspec >=2.6.1 && <2.7
+ , microstache >=1.0.1.1 && <1.1
+ , text >=1.2.3.1 && <1.3
+ , transformers >=0.5.6.2 && <0.6
+ default-language: Haskell2010
+
+test-suite lazyboy-test
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ other-modules:
+ Paths_lazyboy
+ hs-source-dirs:
+ test
+ ghc-options: -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ aeson >=1.4.2.0 && <1.5
+ , base >=4.7 && <5
+ , hspec >=2.6.1 && <2.7
+ , lazyboy
+ , microstache >=1.0.1.1 && <1.1
+ , text >=1.2.3.1 && <1.3
+ , transformers >=0.5.6.2 && <0.6
+ default-language: Haskell2010
diff --git a/src/Lazyboy.hs b/src/Lazyboy.hs
new file mode 100644
index 0000000..a4a5f7e
--- /dev/null
+++ b/src/Lazyboy.hs
@@ -0,0 +1,12 @@
+module Lazyboy ( module Lazyboy.Control
+ , module Lazyboy.Types
+ , module Lazyboy.IO
+ , module Lazyboy.Constants
+ , module Control.Monad.Trans.RWS
+ ) where
+
+import Control.Monad.Trans.RWS
+import Lazyboy.Constants
+import Lazyboy.Control
+import Lazyboy.IO
+import Lazyboy.Types
diff --git a/src/Lazyboy/Constants.hs b/src/Lazyboy/Constants.hs
new file mode 100644
index 0000000..0349bfe
--- /dev/null
+++ b/src/Lazyboy/Constants.hs
@@ -0,0 +1,87 @@
+{-|
+ Module : Lazyboy.Constants
+ Description : Constant definitions for Lazyboy
+ Copyright : (c) Rose 2019
+ License : BSD3
+ Maintainer : rose@lain.org.uk
+ Stability : experimental
+ Portability : POSIX
+
+ This module provides definitions of constants referring to the Game Boy hardware.
+-}
+
+module Lazyboy.Constants where
+
+import Data.Word
+
+-- | Work RAM (WRAM) Bank 0
+wram0 :: Word16
+wram0 = 0xC000
+
+-- | Work RAM (WRAM) Bank 1
+wram1 :: Word16
+wram1 = 0xD000
+
+-- | Player 1 Joypad
+joypad :: Word16
+joypad = 0xFF00
+
+-- | LCD Control
+lcdc :: Word16
+lcdc = 0xFF40
+
+-- | LCD state
+lcdstate :: Word16
+lcdstate = 0xFF41
+
+-- | Scroll X
+scx :: Word16
+scx = 0xFF42
+
+-- | Scroll Y
+scy :: Word16
+scy = 0xFF43
+
+-- | LCDC Y-coordinate
+ly :: Word16
+ly = 0xFF44
+
+-- | LCDC Y-compare
+lyc :: Word16
+lyc = 0xFF45
+
+-- | DMA start address
+dma :: Word16
+dma = 0xFF46
+
+-- | Background Palette Data
+bgp :: Word16
+bgp = 0xFF47
+
+-- | Video RAM (VRAM)
+vram :: Word16
+vram = 0x8000
+
+-- | Start of 32x32 tile background map #1
+background1 :: Word16
+background1 = 0x9800
+
+-- | Start of 32x32 tile background map #2
+background2 :: Word16
+background2 = 0x9C00
+
+-- | High RAM (HRAM)
+hram :: Word16
+hram = 0xFF80
+
+-- | OAM
+oam :: Word16
+oam = 0xFE00
+
+-- | Screen width
+screenWidth :: Word8
+screenWidth = 160
+
+-- | Screen height
+screenHeight :: Word8
+screenHeight = 144 \ No newline at end of file
diff --git a/src/Lazyboy/Control.hs b/src/Lazyboy/Control.hs
new file mode 100644
index 0000000..edcf503
--- /dev/null
+++ b/src/Lazyboy/Control.hs
@@ -0,0 +1,87 @@
+{-|
+ Module : Lazyboy.Control
+ Description : Control flow features for Lazyboy
+ Copyright : (c) Rose 2019
+ License : BSD3
+ Maintainer : rose@lain.org.uk
+ Stability : experimental
+ Portability : POSIX
+
+ This module defines methods of controlling the flow of execution for Lazyboy.
+-}
+
+module Lazyboy.Control where
+
+import Control.Monad.Trans.RWS
+import Data.Word
+import Lazyboy.Types
+
+-- | Get a label, and in the process increment the counter used to track labels.
+-- this provides a safe interface to label retrieval and utilization.
+getLabel :: Lazyboy Integer
+getLabel = do
+ label <- get
+ modify (+ 1)
+ return label
+
+-- | Get a local label. The name is guaranteed to be unique.
+getLocalLabel :: Lazyboy Label
+getLocalLabel = Local <$> getLabel
+
+-- | Get a global label. The name is guaranteed to be unique.
+getGlobalLabel :: Lazyboy Label
+getGlobalLabel = Global <$> getLabel
+
+-- | Execute an action within a global label and pass the action the label.
+withLabel :: (Label -> Lazyboy ()) -> Lazyboy ()
+withLabel block = do
+ label <- getGlobalLabel
+ tell [LABEL label]
+ block label
+
+-- | Execute an action within a local label and pass the action the label.
+withLocalLabel :: (Label -> Lazyboy ()) -> Lazyboy ()
+withLocalLabel block = do
+ label <- getLocalLabel
+ tell [LABEL label]
+ block label
+
+-- | Embed a file and return a global label for it.
+-- A jump over the block of data is added to prevent the image data being executed.
+embedFile :: FilePath -> Lazyboy Label
+embedFile file = do
+ label <- getGlobalLabel
+ skipLabel <- getGlobalLabel
+ tell [JP $ Name skipLabel]
+ tell [LABEL label, INCLUDE file]
+ tell [LABEL skipLabel]
+ return label
+
+-- | Embed an image and return a (global) label for it.
+-- A jump over the block of data is added to prevent the image data being executed.
+embedImage = embedFile
+
+-- | Embed a sequence of bytes into the file and return a (global) label for it.
+-- A jump over the block of data is added to prevent the image data being executed.
+embedBytes :: [Word8] -> Lazyboy Label
+embedBytes bytes = do
+ label <- getGlobalLabel
+ skipLabel <- getGlobalLabel
+ tell [JP $ Name skipLabel]
+ tell [LABEL label, BYTES bytes]
+ tell [LABEL skipLabel]
+ return label
+
+-- | Suspend execution indefinitely by disabling interrupts and halting.
+freeze :: Lazyboy ()
+freeze = withLabel $ \label -> do
+ tell [DI, HALT]
+ tell [JP $ Name label]
+
+-- | Executes the given action provided condition flag is set.
+cond :: Condition -> Lazyboy () -> Lazyboy ()
+cond condition block = do
+ label <- getLocalLabel
+ tell [JPif condition (Name label)]
+ block
+ tell [LABEL label]
diff --git a/src/Lazyboy/IO.hs b/src/Lazyboy/IO.hs
new file mode 100644
index 0000000..b6636d1
--- /dev/null
+++ b/src/Lazyboy/IO.hs
@@ -0,0 +1,127 @@
+{-|
+ Module : Lazyboy.IO
+ Description : IO library for Lazyboy
+ Copyright : (c) Rose 2019
+ License : BSD3
+ Maintainer : rose@lain.org.uk
+ Stability : experimental
+ Portability : POSIX
+
+ This module defines IO and primitive graphics operations for Lazyboy.
+-}
+
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE RecordWildCards #-}
+module Lazyboy.IO where
+
+import Control.Monad.Trans.RWS.Lazy
+import Data.Bits
+import Data.Word
+import Lazyboy.Constants
+import Lazyboy.Control
+import Lazyboy.Types
+
+-- | A typeclass for packing types into Word8.
+class Bitfield a where
+ pack :: a -> Word8
+
+-- | A type representing the monochrome shades available on the hardware.
+data Color = White | Light | Dark | Black
+ deriving (Eq, Ord)
+
+instance Bitfield Color where
+ pack White = 0b00
+ pack Light = 0b01
+ pack Dark = 0b10
+ pack Black = 0b11
+
+-- | A type representing the LCD screen control state.
+data LCDControl = LCDControl { lcdDisplayEnable :: Bool
+ , lcdWindowTileMap :: Bool
+ , lcdEnableWindowDisplay :: Bool
+ , lcdWindowSelect :: Bool
+ , lcdTileMapSelect :: Bool
+ , lcdObjSize :: Bool
+ , lcdEnableObjects :: Bool
+ , lcdBackgroundEnable :: Bool
+ }
+
+-- | The default LCDControl state - all flags set to False (0).
+-- In effect, this turns the screen off.
+defaultLCDControl :: LCDControl
+defaultLCDControl = LCDControl False False False False False False False False
+
+instance Bitfield LCDControl where
+ pack lcds = zeroBits .|. lcdDE .|. lcdWTM .|. lcdEWD .|. lcdWS .|. lcdTMS .|. lcdOS .|. lcdEO .|. lcdBE
+ where lcdDE = if lcdDisplayEnable lcds then 0b10000000 else 0
+ lcdWTM = if lcdWindowTileMap lcds then 0b01000000 else 0
+ lcdEWD = if lcdEnableWindowDisplay lcds then 0b00100000 else 0
+ lcdWS = if lcdWindowSelect lcds then 0b00010000 else 0
+ lcdTMS = if lcdTileMapSelect lcds then 0b00001000 else 0
+ lcdOS = if lcdObjSize lcds then 0b00000100 else 0
+ lcdEO = if lcdEnableObjects lcds then 0b00000010 else 0
+ lcdBE = if lcdBackgroundEnable lcds then 0b00000001 else 0
+
+-- | A convenience function which executes setLCDControl with the defaultLCDControl state.
+-- This turns the screen off.
+disableLCD :: Lazyboy ()
+disableLCD = setLCDControl defaultLCDControl
+
+-- | Sets the LCD control state to a given value.
+setLCDControl :: LCDControl -> Lazyboy ()
+setLCDControl lcd = write (Address lcdc) $ pack lcd
+
+-- | A type representing the background palette.
+data BackgroundPalette = BackgroundPalette { bgpColor3 :: Color
+ , bgpColor2 :: Color
+ , bgpColor1 :: Color
+ , bgpColor0 :: Color
+ }
+-- | The default monochrome background palette.
+defaultPalette :: BackgroundPalette
+defaultPalette = BackgroundPalette Black Dark Light White
+
+instance Bitfield BackgroundPalette where
+ pack BackgroundPalette {..} = zeroBits .|. zero .|. one .|. two .|. three
+ where zero = pack bgpColor0
+ one = pack bgpColor1 `shiftL` 2
+ two = pack bgpColor2 `shiftL` 4
+ three = pack bgpColor3 `shiftL` 6
+
+-- | Sets the background palette to a given palette.
+setBackgroundPalette :: BackgroundPalette -> Lazyboy ()
+setBackgroundPalette pal = write (Address bgp) $ pack pal
+
+-- | Writes a Word8 to a Register8.
+byte :: Register8 -> Word8 -> Lazyboy ()
+byte reg val = tell [LDrn reg val]
+
+-- | Loads a Word8 into a Location.
+write :: Location -> Word8 -> Lazyboy ()
+write addr val = tell [LDrrnn HL addr, LDHLn val]
+
+-- | Copy a region of memory (limit 255 bytes) to a destination.
+memcpy :: Location -> Location -> Word8 -> Lazyboy ()
+memcpy src dest len = do
+ -- load the destination into DE, source into HL and length into B
+ 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, JPif NonZero (Name label)]
+
+-- | Sets a region of memory to a Word8 value (limit 255 bytes).
+memset :: Location -> Word8 -> Word8 -> Lazyboy ()
+memset dest len value = do
+ -- load the destination into HL, length into B and value into A
+ tell [LDrrnn HL dest, LDrn B len, LDrn A value]
+ withLocalLabel $ \label -> do
+ tell [LDHLAI] -- load A into [HL] and increment
+ tell [DECr B, JPif NonZero (Name label)]
+
+-- | Executes an action when vertical blank occurs.
+onVblank :: Lazyboy () -> Lazyboy ()
+onVblank block = do
+ withLocalLabel $ \label -> do
+ tell [LDAnn $ Address ly, CPn 145]
+ tell [JPif NonZero $ Name label]
+ block
diff --git a/src/Lazyboy/Target/ASM.hs b/src/Lazyboy/Target/ASM.hs
new file mode 100644
index 0000000..3c42ae7
--- /dev/null
+++ b/src/Lazyboy/Target/ASM.hs
@@ -0,0 +1,230 @@
+{-|
+ Module : Lazyboy.Target.ASM
+ Description : ASM backend for Lazyboy
+ Copyright : (c) Rose 2019
+ License : BSD3
+ Maintainer : rose@lain.org.uk
+ Stability : experimental
+ Portability : POSIX
+
+ This module provides a backend to format opcodes as ASM and
+ produce assembly files which are then buildable into ROMs (with RGBDS).
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+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
+import Paths_lazyboy
+import Text.Microstache
+import Text.Printf
+
+-- | A custom Show instance which formats Instructions as assembly.
+instance Show Instruction where
+ show (LDrr r1 r2) = printf "ld %s, %s" r1 r2
+ show (LDrn r1 v1) = printf "ld %s, %d" r1 v1
+ show (LDrHL r1) = printf "ld %s, [HL]" r1
+ show (LDHLr r1) = printf "ld [HL], %s" r1
+ show (LDHLn v1) = printf "ld [HL], %d" v1
+ show (LDArr BC) = printf "ld A, [BC]"
+ show (LDArr DE) = printf "ld A, [DE]"
+ show (LDArr HL) = printf "ld A, [HL]"
+ show (LDArr r1) = error "16 bit register '%s' cannot be loaded into A" r1
+ show (LDrrA BC) = printf "ld [BC], A"
+ show (LDrrA DE) = printf "ld [DE], A"
+ show (LDrrA HL) = printf "ld [HL], A"
+ show (LDrrA r1) = error "A cannot be loaded into 16 bit register '%s'" r1
+ show (LDAnn v1) = printf "ld A, [%s]" v1
+ show (LDnnA v1) = printf "ld [%s], A" v1
+ show (LDAIO v1) = printf "ldh A, [$FF00+$%X]" v1
+ show (LDIOA v1) = printf "ldh [$FF00+$%X], A" v1
+ show (LDAIOC) = printf "ldh A, [$FF00+C]"
+ show (LDIOCA) = printf "ldh [$FF00+C], A"
+ show (LDHLAI) = printf "ld [HL+], A"
+ show (LDAHLI) = printf "ld A, [HL+]"
+
+ -- handle some special cases for ld rr,nn
+ show (LDrrnn AF _) = error "You cannot load a 16 bit value directly into the register AF"
+ show (LDrrnn PC _) = error "You cannot load a 16 bit value directly into the program counter"
+ show (LDrrnn r1 v1) = printf "ld %s, %s" r1 v1
+
+ show (LDSPHL) = printf "%ld SP, HL"
+
+ -- stack manipulation
+ show (PUSH SP) = error "You cannot push the stack pointer onto the stack"
+ show (PUSH PC) = error "You cannot push the program counter onto the stack"
+ show (PUSH r1) = printf "PUSH %s" r1
+
+ show (POP SP) = error "You cannot pop the stack pointer from the stack"
+ show (POP PC) = error "You cannot pop the program counter from the stack"
+ show (POP r1) = printf "POP %s" r1
+
+ -- jumps
+ show (JP v1@(Address _)) = printf "jp %s" v1
+ show (JP v1@(Name (Global _))) = printf "jp %s" v1
+ show (JP v1@(Name (Local _))) = printf "jr %s" v1
+ show (JPHL) = printf "jp HL"
+ show (JPif c v1@(Address _)) = printf "jp %s, %s" c v1
+ show (JPif c v1@(Name (Global _))) = printf "jp %s, %s" c v1
+ show (JPif c v1@(Name (Local _))) = printf "jr %s, %s" c v1
+
+ -- call and return
+ show (CALL v1) = printf "call $%X" v1
+ show (CALLif c v1) = printf "call %s, $%X" c v1
+ show (RET) = printf "ret"
+ show (RETif c) = printf "ret %s" c
+ show (RETi) = printf "reti"
+
+ show (RST 0x00) = printf "RST $00"
+ show (RST 0x08) = printf "RST $08"
+ show (RST 0x10) = printf "RST $10"
+ show (RST 0x18) = printf "RST $18"
+ show (RST 0x20) = printf "RST $20"
+ show (RST 0x28) = printf "RST $28"
+ show (RST 0x30) = printf "RST $30"
+ show (RST 0x38) = printf "RST $38"
+ show (RST _) = error "Invalid RST vector specified!"
+
+ -- arithmetic and comparisons
+ show (ADDAr r1) = printf "add A, %s" r1
+ show (ADDAn v) = printf "add A, %d" v
+ show (ADDHL) = printf "add A, [HL]"
+ show (ADCAr r1) = printf "adc A, %s" r1
+ show (ADCAn v) = printf "adc A, %d" v
+ show (ADCHL) = printf "adc A, [HL]"
+ show (SUBAr r1) = printf "sub A, %s" r1
+ show (SUBAn v) = printf "sub A, %d" v
+ show (SUBHL) = printf "sub A, [HL]"
+ show (SBCAr r1) = printf "sbc A, %s" r1
+ show (SBCAn v) = printf "sbc A, %d" v
+ show (SBCAHL) = printf "sbc A, [HL]"
+
+ show (ANDr r1) = printf "and A, %s" r1
+ show (ANDn v) = printf "and A, %d" v
+ show (ANDHL) = printf "and A, [HL]"
+ show (XORr r1) = printf "xor A, %s" r1
+ show (XORn v) = printf "xor A, %d" v
+ show (XORHL) = printf "xor A, [HL]"
+ show (ORr r1) = printf "or A, %s" r1
+ show (ORn v) = printf "or A, %d" v
+ show (ORHL) = printf "or A, [HL]"
+ show (CPr r1) = printf "cp A, %s" r1
+ show (CPn v) = printf "cp A, %d" v
+ show (CPHL) = printf "cp A, [HL]"
+ show (INCr r1) = printf "inc %s" r1
+ show (INCHL) = printf "inc [HL]"
+ show (DECr r1) = printf "dec %s" r1
+ show (DECHL) = printf "dec [HL]"
+ show (DAA) = printf "daa"
+ show (CPL) = printf "cpl"
+ show (ADDHLrr BC) = printf "add HL, BC"
+ show (ADDHLrr DE) = printf "add HL, DE"
+ show (ADDHLrr HL) = printf "add HL, HL"
+ show (ADDHLrr SP) = printf "add HL, SP"
+ show (ADDHLrr r1) = error "Cannot add the given the 16 bit register to HL"
+ show (INCrr BC) = printf "inc BC"
+ show (INCrr DE) = printf "inc DE"
+ show (INCrr HL) = printf "inc HL"
+ show (INCrr SP) = printf "inc SP"
+ show (INCrr r1) = error "Cannot increment the given 16 bit register"
+ show (DECrr BC) = printf "dec BC"
+ show (DECrr DE) = printf "dec DE"
+ show (DECrr HL) = printf "dec HL"
+ show (DECrr SP) = printf "dec SP"
+ show (DECrr r1) = error "Cannot decrement the given 16 bit register"
+
+ -- Rotate & shift
+ show (RLCA) = printf "rlca"
+ show (RLA) = printf "rla"
+ show (RRCA) = printf "rrca"
+ show (RRA) = printf "rra"
+ show (RLC r1) = printf "rlc %s" r1
+ show (RLCHL) = printf "rlc [HL]"
+ show (RL r1) = printf "rl %s" r1
+ show (RLHL) = printf "rl [HL]"
+ show (RRC r1) = printf "rrc %s" r1
+ show (RRCHL) = printf "rrc [HL]"
+ show (RR r1) = printf "rr %s" r1
+ show (RRHL) = printf "rr [HL]"
+ show (SLA r1) = printf "sla %s" r1
+ show (SLAHL) = printf "sla [HL]"
+ show (SWAP r1) = printf "swap %s" r1
+ show (SWAPHL) = printf "swap [HL]"
+ show (SRA r1) = printf "sra %s" r1
+ show (SRAHL) = printf "sra [HL]"
+ show (SRL r1) = printf "srl %s" r1
+ show (SRLHL) = printf "srl [HL]"
+
+ -- CPU control
+ show (CCF) = printf "ccf"
+ show (SCF) = printf "scf"
+ show (NOP) = printf "nop"
+ show (HALT) = printf "halt"
+ show (STOP) = printf "stop"
+ show (DI) = printf "di"
+ show (EI) = printf "ei"
+
+ -- Bit manipulation
+ show (BITnr v r1)
+ | v >= 0 && v <= 7 = printf "bit %d, %s" v r1
+ | otherwise = error "invalid value provided to an instruction expecting a 3-bit value"
+ show (BITnHL v)
+ | v >= 0 && v <= 7 = printf "bit %d, HL" v
+ | otherwise = error "invalid value provided to an instruction expecting a 3-bit value"
+ show (SETnr v r1)
+ | v >= 0 && v <= 7 = printf "set %d, %s" v r1
+ | otherwise = error "invalid value provided to an instruction expecting a 3-bit value"
+ show (SETnHL v)
+ | v >= 0 && v <= 7 = printf "set %d, HL" v
+ | otherwise = error "invalid value provided to an instruction expecting a 3-bit value"
+ show (RESnr v r1)
+ | v >= 0 && v <= 7 = printf "res %d, %s" v r1
+ | otherwise = error "invalid value provided to an instruction expecting a 3-bit value"
+ show (RESnHL v)
+ | v >= 0 && v <= 7 = printf "res %d, HL" v
+ | otherwise = error "invalid value provided to an instruction expecting a 3-bit value"
+
+ -- RGBASM specific stuff
+ show (LABEL l) = printf "%s:" l
+ show (INCLUDE file) = printf "INCBIN \"%s\"" file
+ show (BYTES bytes) = printf "db " ++ intercalate "," (map (printf "$%X") bytes)
+
+ show _ = error "Use of unimplemented instruction"
+
+-- | Instances of PrintfArg
+instance PrintfArg Register16 where
+ formatArg = formatString . show
+
+instance PrintfArg Register8 where
+ formatArg = formatString . show
+
+instance PrintfArg Condition where
+ formatArg Zero = formatString "z"
+ formatArg NonZero = formatString "nz"
+ formatArg Carry = formatString "c"
+ formatArg NoCarry = formatString "nc"
+
+instance PrintfArg Label where
+ formatArg (Local v) = formatString $ ".L" ++ show v
+ formatArg (Global v) = formatString $ "L" ++ show v
+
+instance PrintfArg Location where
+ formatArg (Address v) = formatString $ (printf "$%X" v :: String)
+ formatArg (Name label) = formatString $ (printf "%s" label :: String)
+
+-- | Compiles an action to an assembly source file.
+-- This function makes use of a "bare" template, which
+-- sets up an appropriate start location for the body of the program
+-- and defines an entry point label 'main'.
+compileROM :: Lazyboy a -> IO Text
+compileROM code = do
+ templatePath <- getDataFileName "templates/bare.mustache"
+ tem <- compileMustacheFile templatePath
+ return $ renderMustache tem $ object [ "body" .= body ]
+ where body = map show $ execLazyboy code
diff --git a/src/Lazyboy/Types.hs b/src/Lazyboy/Types.hs
new file mode 100644
index 0000000..5f3fd1f
--- /dev/null
+++ b/src/Lazyboy/Types.hs
@@ -0,0 +1,170 @@
+{-|
+ Module : Lazyboy.Types
+ Description : Hardware type definitions for Lazyboy
+ Copyright : (c) Rose 2019
+ License : BSD3
+ Maintainer : rose@lain.org.uk
+ Stability : experimental
+ Portability : POSIX
+
+ This module defines datatypes for the various aspects of the target hardware
+ including registers and instructions.
+-}
+
+module Lazyboy.Types where
+
+import Control.Monad (replicateM)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.RWS.Lazy
+import Data.Int
+import Data.Word
+
+-- | A type alias that defines Lazyboy as a specialization of the
+-- RWS monad transformer stack. Reader goes unused, Writer is utilized
+-- for an output list of Instructions, and State is merely an integer
+-- which counts labels, thus naming them.
+type Lazyboy a = RWS () [Instruction] Integer a
+
+-- | Executes an action and returns a list of Instructions.
+execLazyboy :: Lazyboy a -> [Instruction]
+execLazyboy m = snd $ execRWS m () 1
+
+-- | A type which represents an address or label.
+data Location = Address Word16 | Name Label
+ deriving (Eq)
+
+-- | A type representing Condition flags on the hardware.
+data Condition = Zero | NonZero | Carry | NoCarry
+ deriving (Eq)
+
+-- | Named 8-bit registers.
+data Register8 = A | B | C | D | E | H | L
+ deriving (Read, Show, Eq)
+
+-- | Named 16-bit registers.
+data Register16 = BC | DE | HL | AF | SP | PC
+ deriving (Read, Show, Eq)
+
+-- | A type which represents a label, which may be local or global in scope.
+data Label = Local Integer | Global Integer
+ deriving (Eq)
+
+-- | Type-level representations of instructions and primitive special forms.
+data Instruction =
+ LDrr Register8 Register8 -- ^ Load the value in one Register8 into another.
+ | LDrn Register8 Word8 -- ^ Load the immediate Word8 into a Register8.
+ | LDrHL Register8 -- ^ Load the Word8 stored at the address in HL into a Register8.
+ | LDHLr Register8 -- ^ Load the Word8 stored in a Register8 into the address in HL.
+ | LDHLn Word8 -- ^ Load the immediate Word8 into the address in HL.
+ | LDArr Register16 -- ^ Load the value at the address contained in a Register16 into A.
+ | LDrrA Register16 -- ^ Load A into the address contained in a Register16.
+ | LDAnn Location -- ^ Load the Word8 stored in the Location into A.
+ | LDnnA Location -- ^ Load the Word8 stored in A into the Location.
+ | LDAIO Word8 -- ^ Read into A from IO port n (FF00 + Word8).
+ | LDIOA Word8 -- ^ Store the Word8 in A into IO port n (FF00 + Word8).
+ | LDAIOC -- ^ Read from IO port FF00+C into A.
+ | LDIOCA -- ^ Store the Word8 in A into IO port FF00+C.
+ | LDHLAI -- ^ Store value in register A into byte pointed by HL and post-increment HL.
+ | LDAHLI -- ^ Store value in address in HL in A and post-increment HL.
+ | LDHLAD -- ^ Store value in register A into byte pointed by HL and post-decrement HL.
+ | LDAHLD -- ^ Store value in address in HL in A and post-decrement HL.
+ | LDrrnn Register16 Location -- ^ Load a Location into a Register16.
+ | LDSPHL -- ^ Set the stack pointer (SP) to the value in HL.
+ | PUSH Register16 -- ^ Push Register16 onto the stack.
+ | POP Register16 -- ^ Pop Register16 from the stack.
+
+ -- Jump & Call instructions
+ | JP Location -- ^ Immediately and unconditionally jump to a Location.
+ | JPHL -- ^ Immediately and unconditionally jump to the value contained in HL.
+ | JPif Condition Location -- ^ Conditionally jump to a Location.
+ | CALL Location -- ^ Call a Location.
+ | CALLif Condition Location -- ^ Conditionally call a Location.
+ | RET -- ^ Return from a labelled block.
+ | RETif Condition -- ^ Conditionally return from a labelled block.
+ | RETi -- ^ Return and enable interrupts.
+ | RST Word8 -- ^ Call a restart vector.
+
+ -- Arithmetic & Logical instructions
+ | ADDAr Register8 -- ^ Add the value contained in a Register8 to A.
+ | ADDAn Word8 -- ^ Add a Word8 to the value contained in A.
+ | ADDHL -- ^ Add the value contained in the address stored in HL to A.
+ | ADCAr Register8 -- ^ Add the value in a Register8 + the carry flag to A.
+ | ADCAn Word8 -- ^ Add a Word8 + the carry flag to A.
+ | ADCHL -- ^ Add the value pointed to by HL + the carry flag to A.
+ | SUBAr Register8 -- ^ Subtract the value contained in a Register8 from A.
+ | SUBAn Word8 -- ^ Subtract a Word8 from A.
+ | SUBHL -- ^ Subtract from A the value contained at the address in HL.
+ | SBCAr Register8 -- ^ Subtract from A the value contained in a Register8 + the carry flag.
+ | SBCAn Word8 -- ^ Subtract from A a Word8 + the carry flag.
+ | SBCAHL -- ^ Subtract from A the value contained in the address in HL + the carry flag.
+ | ANDr Register8 -- ^ Assign to A the value contained in a Register8 & A itself.
+ | ANDn Word8 -- ^ Assign to A a Word8 & A itself.
+ | ANDHL -- ^ Assign to A itself & the value in the address in HL.
+ | XORr Register8 -- ^ Assign to A the value contained in a register ^ A itself
+ | XORn Word8 -- ^ Assign to A a Word8 ^ itself.
+ | XORHL -- ^ Assign to A itself ^ the value in the address in HL.
+ | ORr Register8 -- ^ Assign to A the value contained in a register | A itself.
+ | ORn Word8 -- ^ Assign to A a Word8 | itself.
+ | ORHL -- ^ Assign to A itself | the value in the address in HL
+ | CPr Register8 -- ^ Subtract from A the value in a Register8 and set flags accordingly, but don't store the result.
+ | CPn Word8 -- ^ Subtract from A a Word8 and set flags accordingly, but don't store the result.
+ | CPHL -- ^ Subtract from A the value in the address in HL, set flags, but don't store the result.
+ | INCr Register8 -- ^ Increment the value in a Register8.
+ | INCHL -- ^ Increment the value at the address in HL.
+ | DECr Register8 -- ^ Decrement the value in a Register8.
+ | DECHL -- ^ Decrement the value at the address in HL.
+ | DAA -- ^ Decimal-adjust register A.
+ | CPL -- ^ Complement accumulator (A = ~A).
+ | ADDHLrr Register16 -- ^ Add the value contained in a Register16 to HL.
+ | INCrr Register16 -- ^ Increment the value in a Register16.
+ | DECrr Register16 -- ^ Decrement the value in a Register16.
+ | ADDSPn Int8 -- ^ Add an Int8 to the stack pointer.
+ | LDHLSPn Int8 -- ^ Load into HL the stack pointer + an Int8.
+
+ -- Single-bit instructions
+ | BITnr Word8 Register8 -- ^ Test bit n in a Register8, set the zero flag if not set.
+ | BITnHL Word8 -- ^ Test bit n in the Word8 pointed by HL, set the zero flag if not set.
+ | SETnr Word8 Register8 -- ^ Set bit n in a Register8.
+ | SETnHL Word8 -- ^ Set bit n in the Word8 pointed by HL.
+ | RESnr Word8 Register8 -- ^ Unset bit n in Register8.
+ | RESnHL Word8 -- ^ Unset bit n in the Word8 pointed by HL.
+
+ -- Rotate & shift instructions
+ | RLCA -- ^ Rotate accumulator left.
+ | RLA -- ^ Rotate accumulator left through carry.
+ | RRCA -- ^ Rotate accumulator right.
+ | RRA -- ^ Rotate accumulator rit through carry.
+ | RLC Register8 -- ^ Rotate Register8 left.
+ | RLCHL -- ^ Rotate value contained at address in HL left.
+ | RL Register8 -- ^ Rotate Register8 left through carry.
+ | RLHL -- ^ Rotate value contained at address in HL left through carry.
+ | RRC Register8 -- ^ Rotate Register8 right.
+ | RRCHL -- ^ Rotate value contained at address in HL right.
+ | RR Register8 -- ^ Rotate Register8 right through carry.
+ | RRHL -- ^ Rotate value contained at address in HL right through carry.
+ | SLA Register8 -- ^ Shift Register8 left arithmetic.
+ | SLAHL -- ^ Shift left arithmetic (HL pointer).
+ | SWAP Register8 -- ^ Exchange low and high nibbles in Register8.
+ | SWAPHL -- ^ Exchange low and high nibbles in HL pointer.
+ | SRA Register8 -- ^ Shift Register8 right arithmetic.
+ | SRAHL -- ^ Shift right arithmetic in HL pointer.
+ | SRL Register8 -- ^ Shift Register8 right logical.
+ | SRLHL -- ^ Shift right logical in HL pointer.
+
+ -- CPU control instructions
+ | CCF -- ^ Complement carry flag.
+ | SCF -- ^ Set carry flag.
+ | NOP -- ^ No operation.
+ | HALT -- ^ Halt until interrupt.
+ | STOP -- ^ Standby mode.
+ | DI -- ^ Disable interrupts.
+ | EI -- ^ Enable interrupts.
+
+ -- RGBASM-specific convenience stuff.
+ -- these would need revamping if we were to start generating native machine code
+ | LABEL Label -- ^ Create a numbered label.
+ | INCLUDE FilePath -- ^ Include the file at FilePath.
+ | BYTES [Word8] -- ^ Define some bytes in the form of a Word8 list with a global label.
+
+ deriving (Eq) \ No newline at end of file
diff --git a/templates/bare.mustache b/templates/bare.mustache
new file mode 100644
index 0000000..5791078
--- /dev/null
+++ b/templates/bare.mustache
@@ -0,0 +1,15 @@
+;; DEFINE THE ROM START LOCATION
+SECTION "rom", ROM0
+
+;; DEFINE THE START LOCATION AS 0x100
+SECTION "start", ROM0[$0100]
+ nop
+ jp main
+
+;; PLACE THE MAIN BLOCK AT 0x150
+SECTION "main", ROM0[$0150]
+
+main:
+{{#body}}
+{{{.}}}
+{{/body}} \ No newline at end of file
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..007c770
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,137 @@
+{-|
+ Module : Main (Test)
+ Description : Test suite for Lazyboy
+ Copyright : (c) Rose 2019
+ License : BSD3
+ Maintainer : rose@lain.org.uk
+ Stability : experimental
+ Portability : POSIX
+
+ A test suite for Lazyboy.
+-}
+
+import Control.Exception (evaluate)
+import Lazyboy
+import Lazyboy.Target.ASM
+import Test.Hspec
+
+disallow cmd = evaluate cmd `shouldThrow` anyException
+
+main :: IO ()
+main = hspec $ do
+ describe "Lazyboy.IO" $ do
+ context "when asked to pack an LCDControl" $ do
+ it "packs an LCDControl of all False values to 0" $ do
+ pack defaultLCDControl `shouldBe` 0
+ it "packs an LCDControl with background and display enabled to 129" $ do
+ pack (LCDControl True False False False False False False True) `shouldBe` 129
+ it "packs other LCDControls correctly" $ do
+ pack (defaultLCDControl { lcdEnableObjects = True }) `shouldBe` 2
+ context "when asked to pack a BackgroundPalette" $ do
+ it "packs a BackgroundPalette of all-black to 255" $ do
+ pack (BackgroundPalette Black Black Black Black) `shouldBe` 255
+ it "packs a BackgroundPalette of all-white to 0" $ do
+ pack (BackgroundPalette White White White White) `shouldBe` 0
+ it "correctly packs other BackgroundPalettes" $ do
+ pack (BackgroundPalette White Light White White) `shouldBe` 16
+
+ describe "Lazyboy.Types.execLazyboy" $ do
+ it "compiles nested sequences in order" $ do
+ let sequence = execLazyboy $ do
+ write (Address 0x2000) 0x97
+ write (Address 0x1000) 0x98
+ sequence `shouldBe` [LDrrnn HL (Address 0x2000), LDHLn 0x97, LDrrnn HL (Address 0x1000), LDHLn 0x98]
+
+ describe "Lazyboy.Control" $ do
+ describe "cond" $ do
+ it "correctly implements conditionals" $ do
+ let program = execLazyboy $ do
+ cond NonZero $ do
+ freeze
+ program `shouldBe` [JPif NonZero $ Name $ Local 1, LABEL $ Global 2, DI, HALT, JP $ Name $ Global 2, LABEL $ Local 1]
+ it "handles nested conditionals correctly" $ do
+ let program = execLazyboy $ do
+ cond Zero $ do
+ cond NonZero $ do
+ freeze
+ program `shouldBe` [ JPif Zero $ Name $ Local 1
+ , JPif NonZero $ Name $ Local 2
+ , LABEL $ Global 3
+ , DI
+ , HALT
+ , JP $ Name $ Global 3
+ , LABEL $ Local 2
+ , LABEL $ Local 1
+ ]
+ describe "withLabel" $ do
+ it "creates an appropriately formatted global label" $ do
+ let program = map show $ execLazyboy $ do
+ withLabel $ \label -> do
+ write (Address 0xC000) 0x97
+ program `shouldBe` [ "L1:"
+ , "ld HL, $C000"
+ , "ld [HL], 151"
+ ]
+ describe "withLocalLabel" $ do
+ it "creates an appropriately formatted local label" $ do
+ let program = map show $ execLazyboy $ do
+ withLocalLabel $ \label -> do
+ write (Address 0xC000) 0x97
+ program `shouldBe` [ ".L1:"
+ , "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` [JP $ Name $ Global 2, LABEL $ Global 1, INCLUDE "test.bin", LABEL $ Global 2]
+ describe "embedBytes" $ do
+ it "defines a raw sequence of bytes" $ do
+ let program = execLazyboy $ embedBytes [0x00, 0x01, 0x02]
+ program `shouldBe` [JP $ Name $ Global 2, LABEL $ Global 1, BYTES [0x00, 0x01, 0x02], LABEL $ Global 2]
+
+ 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 $ Address 0x00
+ it "disallows loading a 16 bit value into PC" $ do
+ disallow $ show $ LDrrnn PC $ Address 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" ]