arm-hyp haskell: rephrase VIRQ inject decode after kernel changes

spec/haskell/src/SEL4/API/Invocation/ARM_HYP.lhs

@@ -123,13 +123,13 @@ IO pages are invoked using InvokePage (cap contains a bit indicating it is an IO
 
 FIXME ARMHYP move HyperReg definition (to Hardware?)
 
-> type HyperReg = Word32 -- FIXME ARMHYP can abstract
+> type HyperReg = Int -- FIXME ARMHYP can abstract
 > type HyperRegVal = Word32 -- FIXME ARMHYP can abstract
 
 > data VCPUInvocation
 >     = VCPUSetTCB (PPtr VCPU) (PPtr TCB)
->     -- XXX ARMHYP vcpu index group priority virq
->     | VCPUInjectIRQ (PPtr VCPU) Word8 Word8 Word8 Word16
+>     -- XXX ARMHYP vcpu index virq
+>     | VCPUInjectIRQ (PPtr VCPU) Int VIRQ
 >     | VCPUReadRegister (PPtr VCPU) HyperReg
 >     | VCPUWriteRegister (PPtr VCPU) HyperReg HyperRegVal
 >     deriving (Show, Eq)

spec/haskell/src/SEL4/Object/Structures/ARM_HYP.lhs

@@ -165,13 +165,15 @@ but this structure is never manipulated as a whole.
 
 FIXME ARMHYP move to platform
 
+> type VIRQ = Word32
+
 > gicVCPUMaxNumLR = (64 :: Int)
 
 > data GICVCPUInterface = VGICInterface {
 >                        vgicHCR :: Word32,
 >                        vgicVMCR :: Word32,
 >                        vgicAPR :: Word32,
->                        vgicLR :: Array Int Word32
+>                        vgicLR :: Array Int VIRQ
 >                        }
 >     deriving Show
 

spec/haskell/src/SEL4/Object/VCPU/ARM_HYP.lhs

@@ -141,15 +141,27 @@ Currently, there is only one VCPU register available for reading/writing by the
 
 \subsection{VCPU: inject IRQ}
 
+FIXME ARMHYP: this does not at this instance correspond to exactly what the C
+    does, but it is the value that is stored inside of lr in the vgic
+
+> makeVIRQ :: Word32 -> Word32 -> Word32 -> VIRQ
+> makeVIRQ group prio irq =
+>     (group `shiftL` groupShift) .|. (prio `shiftL` prioShift) .|. irq .|.
+>         irqPending .|. eoiirqen
+>     where groupShift = 30
+>           prioShift = 23
+>           irqPending = bit 28
+>           eoiirqen = bit 19
+
 > decodeVCPUInjectIRQ :: [Word] -> ArchCapability ->
 >         KernelF SyscallError ArchInv.Invocation
 > decodeVCPUInjectIRQ (mr0:mr1:_) cap@(VCPUCap {}) =
 >   do
 >     let vcpuPtr = capVCPUPtr cap
->     let vid = (fromIntegral (mr0 .&. 0xffff) :: Word16)
->     let priority = fromIntegral $ (mr0 `shiftR` 16) .&. 0xff
->     let group = fromIntegral $ (mr0 `shiftR` 24) .&. 0xff
->     let index = ((fromIntegral $ mr1 .&. 0xff) :: Word8)
+>     let vid = mr0 .&. 0xffff
+>     let priority = (mr0 `shiftR` 16) .&. 0xff
+>     let group = (mr0 `shiftR` 24) .&. 0xff
+>     let index = mr1 .&. 0xff
 >
 >     rangeCheck vid (0::Int) ((1 `shiftL` 10) - 1)
 >     rangeCheck priority (0::Int) 31
@@ -157,11 +169,11 @@ Currently, there is only one VCPU register available for reading/writing by the
 >     gic_vcpu_num_list_regs <- withoutFailure $
 >         gets (armKSGICVCPUNumListRegs . ksArchState)
 >     rangeCheck index 0 gic_vcpu_num_list_regs
->     vcpu <- withoutFailure $ getObject vcpuPtr
->     let x = addressTranslateS1CPR
->     let vcpuLR = vgicLR $ vcpuVGIC vcpu
->     when (vcpuLR ! (fromIntegral index) .&. vgicIRQMask == vgicIRQActive) $ throw DeleteFirst
->     return $ InvokeVCPU $ VCPUInjectIRQ vcpuPtr (fromIntegral index) group priority vid
+>     vcpuLR <- withoutFailure $ liftM (vgicLR . vcpuVGIC) $ getObject vcpuPtr
+>     when (vcpuLR ! (fromIntegral index) .&. vgicIRQMask == vgicIRQActive) $
+>         throw DeleteFirst
+>     let virq = makeVIRQ (fromIntegral group) (fromIntegral priority) (fromIntegral vid)
+>     return $ InvokeVCPU $ VCPUInjectIRQ vcpuPtr (fromIntegral index) virq
 > decodeVCPUInjectIRQ _ _ = throw TruncatedMessage
 
 \subsection{VCPU: perform and decode main functions}
@@ -173,7 +185,7 @@ Currently, there is only one VCPU register available for reading/writing by the
 >     invokeVCPUReadReg vcpuPtr reg
 > performARMVCPUInvocation (VCPUWriteRegister vcpuPtr reg val) =
 >     invokeVCPUWriteReg vcpuPtr reg val
-> performARMVCPUInvocation (VCPUInjectIRQ vcpuPtr _ _ _ _)  = error "FIXME ARMHYP TODO"
+> performARMVCPUInvocation (VCPUInjectIRQ vcpuPtr _ _)  = error "FIXME ARMHYP TODO"
 
 > decodeARMVCPUInvocation :: Word -> [Word] -> CPtr -> PPtr CTE ->
 >         ArchCapability -> [(Capability, PPtr CTE)] ->