Merged handling of opcode prefixes.

examples/08_Indirect.hs

@@ -34,16 +34,19 @@ myMain = Method [MaStatic, MaPublic] Void "main" []
   , ldloca 0
   , ldc_i4 1
   , add
-  , unaligned ByteAligned ldind_i2
+  , unalignedPtr ByteAligned
+  $ ldind_i2
   , box int16
 
   , ldloca 0
   , ldc_i4 2
   , add
-  , unaligned DoubleByteAligned ldind_i2
+  , unalignedPtr DoubleByteAligned
+  $ volatilePtr -- Marked as volatile, for no particular reason
+  $ ldind_i2
   , box int16
 
   , call [] Void "mscorlib" "System.Console" "WriteLine" [String, Object, Object, Object]
 
   , ret
-  ]
+  ]

src/Language/Cil/Build.hs

@@ -124,7 +124,10 @@ module Language.Cil.Build (
   , tailcall
   , throw
   , unaligned
+  , unalignedPtr
   , unbox
+  , volatile
+  , volatilePtr
   , xor
 
   -- * Convenient AST functions
@@ -140,8 +143,8 @@ module Language.Cil.Build (
   , mscorlibRef
   ) where
 
--- If someone uses the `rem' or `tail' opcode, they can deal with the ambiguous
--- occurence themselves!
+-- Ambiguous occurences of functions can be resolved when by importing this
+-- module qualified, or by hiding Prelude functions.
 import Prelude hiding (rem, tail, and, or, not, break, div)
 import Data.Char (ord)
 
@@ -522,9 +525,19 @@ tailcall _                   = error $ "Language.Cil.Build.tailcall: Can't tailc
 throw :: MethodDecl
 throw = mdecl $ Throw
 
-unaligned :: Alignment -> MethodDecl -> MethodDecl
-unaligned a (Instr (OpCode oc)) | supportsUnaligned oc = Instr (OpCode (Unaligned a oc))
-unaligned _ _                                          = error $ "Language.Cil.Build.unaligned: Supplied argument doesn't require alignment"
+unaligned :: Alignment -> MethodDecl
+unaligned a = mdecl $ Unaligned a
+
+unalignedPtr :: Alignment -> MethodDecl -> MethodDecl
+unalignedPtr a (Instr (OpCode oc)) | supportsUnaligned oc = mdecl $ UnalignedPtr a oc
+unalignedPtr _ _                                          = error $ "Language.Cil.Build.unalignedPtr: Supplied argument doesn't require alignment"
+
+volatile :: MethodDecl
+volatile = mdecl $ Volatile
+
+volatilePtr :: MethodDecl -> MethodDecl
+volatilePtr (Instr (OpCode oc)) | supportsVolatile oc = mdecl $ VolatilePtr oc
+volatilePtr _                                         = error $ "Language.Cil.Build.volatilePtr: Supplied argument cannot be marked volatile"
 
 xor :: MethodDecl
 xor = mdecl $ Xor
@@ -535,33 +548,41 @@ mdecl :: OpCode -> MethodDecl
 mdecl i = Instr $ OpCode i
 
 supportsUnaligned :: OpCode -> Bool
-supportsUnaligned Ldind_i   = True
-supportsUnaligned Ldind_i1  = True
-supportsUnaligned Ldind_i2  = True
-supportsUnaligned Ldind_i4  = True
-supportsUnaligned Ldind_i8  = True
-supportsUnaligned Ldind_r4  = True
-supportsUnaligned Ldind_r8  = True
-supportsUnaligned Ldind_ref = True
-supportsUnaligned Ldind_u1  = True
-supportsUnaligned Ldind_u2  = True
-supportsUnaligned Ldind_u4  = True
-supportsUnaligned Stind_i   = True
-supportsUnaligned Stind_i1  = True
-supportsUnaligned Stind_i2  = True
-supportsUnaligned Stind_i4  = True
-supportsUnaligned Stind_i8  = True
-supportsUnaligned Stind_r4  = True
-supportsUnaligned Stind_r8  = True
-supportsUnaligned Stind_ref = True
-supportsUnaligned (Ldfld _ _ _ _) = True
-supportsUnaligned (Stfld _ _ _ _) = True
+supportsUnaligned (VolatilePtr oc) = supportsPrefix oc
+supportsUnaligned oc               = supportsPrefix oc
+
+supportsVolatile :: OpCode -> Bool
+supportsVolatile (UnalignedPtr _ oc) = supportsPrefix oc
+supportsVolatile oc                  = supportsPrefix oc
+
+supportsPrefix :: OpCode -> Bool
+supportsPrefix Ldind_i   = True
+supportsPrefix Ldind_i1  = True
+supportsPrefix Ldind_i2  = True
+supportsPrefix Ldind_i4  = True
+supportsPrefix Ldind_i8  = True
+supportsPrefix Ldind_r4  = True
+supportsPrefix Ldind_r8  = True
+supportsPrefix Ldind_ref = True
+supportsPrefix Ldind_u1  = True
+supportsPrefix Ldind_u2  = True
+supportsPrefix Ldind_u4  = True
+supportsPrefix Stind_i   = True
+supportsPrefix Stind_i1  = True
+supportsPrefix Stind_i2  = True
+supportsPrefix Stind_i4  = True
+supportsPrefix Stind_i8  = True
+supportsPrefix Stind_r4  = True
+supportsPrefix Stind_r8  = True
+supportsPrefix Stind_ref = True
+supportsPrefix (Ldfld _ _ _ _) = True
+supportsPrefix (Stfld _ _ _ _) = True
 -- there are several cases for not-yet-supported opcodes
--- supportsUnaligned (Ldobj ...)
--- supportsUnaligned (Stobj ...)
--- supportsUnaligned (Initblk ...)
--- supportsUnaligned (Cpblk ...)
-supportsUnaligned _         = False
+-- supportsPrefix (Ldobj ...)
+-- supportsPrefix (Stobj ...)
+-- supportsPrefix (Initblk ...)
+-- supportsPrefix (Cpblk ...)
+supportsPrefix _         = False
 
 
 

src/Language/Cil/Pretty.hs

@@ -292,8 +292,11 @@ instance Pretty OpCode where
   pr (Tail)                = ("tail." ++)
   pr (Tailcall opcode)     = ("tail. " ++) . pr opcode
   pr (Throw)               = ("throw" ++)
-  pr (Unaligned a opcode)  = ("unaligned. " ++) . pr a . sp . pr opcode
+  pr (Unaligned a)         = ("unaligned. " ++) . pr a
+  pr (UnalignedPtr a opcode)  = ("unaligned. " ++) . pr a . sp . pr opcode
   pr (Unbox t)             = ("unbox " ++) . pr t
+  pr (Volatile)            = ("volatile." ++)
+  pr (VolatilePtr opcode)  = ("volatile. " ++) . pr opcode
   pr (Xor)                 = ("xor" ++)
 
 instance Pretty CallConv where

src/Language/Cil/Syntax.hs

@@ -398,8 +398,11 @@ data OpCode
   | Tail               -- ^ Performs subsequent call as a tail call, by replacing current stack frame with callee stack frame.
   | Tailcall OpCode    -- ^ Performs provided call as a tail call, by replacing current stack frame with callee stack frame.
   | Throw              -- ^ Pops an object reference from the stack and throws it as an exception.
-  | Unaligned Alignment OpCode -- ^ Performs the subsequent load or store operation under a weaker-than-usual alignment precondition.
+  | Unaligned Alignment -- ^ Performs subsequent load or store operation under a weaker-than-usual alignment precondition.
+  | UnalignedPtr  Alignment OpCode -- ^ Performs provided load or store operation under a weaker-than-usual alignment precondition.
   | Unbox PrimitiveType  -- ^ Pops 1 value, unboxes object reference, pushes value type.
+  | Volatile           -- ^ Marks subsequent pointer reference as volatile, i.e. the value it points at can be modified from another thread.
+  | VolatilePtr OpCode -- ^ Marks provided pointer reference as volatile, i.e. the value it points at can be modified from another thread.
   | Xor                -- ^ Pops 2 values, do bitwise XOR between the values, pushes result.
   deriving Show