diff --git a/src/Z80/Assembler.hs b/src/Z80/Assembler.hs index 8d2e2e9..f19c61d 100644 --- a/src/Z80/Assembler.hs +++ b/src/Z80/Assembler.hs @@ -1,5 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE CPP #-} + {-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Z80.Assembler @@ -10,6 +13,7 @@ module Z80.Assembler , code , Bytes (..) , db + , resb , equ , label , labelled @@ -25,8 +29,10 @@ import Data.ByteString (ByteString) import Control.Monad.RWS import Data.Maybe +#if !MIN_VERSION_base(4,8,0) import Control.Applicative import Data.Traversable (traverse) +#endif import Prelude import Z80.Operands @@ -34,6 +40,7 @@ import Z80.Operands data ASMState = ASMState { loc :: Location + , lastLoc :: Location , entry :: Maybe Location } @@ -48,13 +55,29 @@ data ASMBlock , asmData :: ByteString } deriving (Eq, Show) -incrementLoc :: Location -> ASMState -> ASMState -incrementLoc x st = st { loc = loc st + x } +fillToLoc :: Z80ASM +fillToLoc = Z80 $ do + padding <- gets $ \st -> loc st - lastLoc st + tell $ BS.replicate (fromIntegral padding) 0x00 + +incrementLoc :: Location -> Z80ASM +incrementLoc x = do + fillToLoc + Z80 $ modify $ \st -> let loc' = loc st + x in st{ loc = loc', lastLoc = loc' } + +reserveLoc :: Location -> ASMState -> ASMState +reserveLoc x st = st{ loc = loc st + x } + +tellBytes :: [Word8] -> Z80ASM +tellBytes bytes = do + Z80 $ tell $ BS.pack bytes + incrementLoc . fromIntegral $ length bytes + -- The new location has to be computed lazily in the actual + -- content of the bytes, so that we can emit byte values + -- referring to later labels. code :: [Word8] -> Z80ASM -code bytes = Z80 $ do - tell $ BS.pack bytes - modify (incrementLoc . fromIntegral $ length bytes) +code = tellBytes class Bytes a where defb :: a -> Z80ASM @@ -62,15 +85,19 @@ class Bytes a where instance Bytes ByteString where defb = defByteString instance (b ~ Word8) => Bytes [b] where - defb = defByteString . BS.pack + defb = tellBytes db :: Bytes a => a -> Z80ASM db = defb +resb :: Word16 -> Z80ASM +resb n = Z80 $ do + modify $ reserveLoc n + defByteString :: ByteString -> Z80ASM -defByteString bs = Z80 $ do - tell bs - modify (incrementLoc . fromIntegral $ BS.length bs) +defByteString bs = do + Z80 $ tell bs + incrementLoc . fromIntegral $ BS.length bs label :: Z80 Location label = loc <$> Z80 get @@ -92,16 +119,18 @@ beginExecution :: Z80ASM beginExecution = do l <- label Z80 . modify $ setEntry l - where setEntry l st@(ASMState _ Nothing) = st { entry = Just l } - setEntry l st@(ASMState _ (Just e)) = - error $ "Cannot set execution start point twice. First start point: " ++ show e ++ - " This start point: " ++ show l + where setEntry l st = case entry st of + Nothing -> st{ entry = Just l } + Just e -> + error $ "Cannot set execution start point twice. First start point: " ++ show e ++ + " This start point: " ++ show l org :: Location -> Z80ASM -> ASMBlock org addr (Z80 mc) = ASMBlock { asmOrg = addr, asmEntry = fromMaybe addr $ entry finalState, - asmData = asm } - where ((), finalState, asm) = runRWS mc () (ASMState addr Nothing) + asmData = truncate asm } + where ((), finalState, asm) = runRWS mc () (ASMState addr addr Nothing) + truncate = BS.take (fromIntegral $ lastLoc finalState - addr) equ :: a -> Z80 a equ = return diff --git a/src/Z80/Operations.hs b/src/Z80/Operations.hs index 01542a9..4d6af08 100644 --- a/src/Z80/Operations.hs +++ b/src/Z80/Operations.hs @@ -1,8 +1,10 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Z80.Operations @@ -107,7 +109,9 @@ import Data.Word import Z80.Assembler import Z80.Operands +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) +#endif import Control.Monad ((>=>)) import Prelude hiding (and, or) diff --git a/z80.cabal b/z80.cabal index 7a2b064..2d3a3f5 100644 --- a/z80.cabal +++ b/z80.cabal @@ -19,7 +19,7 @@ library Z80.Operands, Z80.Operands.LowerCase, Z80.Macros - build-depends: base >=4.7 && <4.9, + build-depends: base >=4.7, bytestring, mtl hs-source-dirs: src