keid-core 0.1.3.0 → 0.1.3.1
raw patch · 4 files changed
+116/−17 lines, 4 files
Files
- ChangeLog.md +6/−0
- keid-core.cabal +1/−1
- src/Engine/Setup.hs +53/−2
- src/Engine/Setup/Device.hs +56/−14
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog for keid-core +## 0.1.3.1++- Added `Engine.Setup.setupHeadless` to use without a surface.+- Added queue assignment fallback when there are no distinct queues for compute and transfer.+ Fixes startup crash on Intel iGPUs.+ ## 0.1.3.0 - Changed mesh codec to use `Serialise` class instead of `Storable`.
keid-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: keid-core-version: 0.1.3.0+version: 0.1.3.1 synopsis: Core parts of Keid engine. category: Game Engine author: IC Rainbow
src/Engine/Setup.hs view
@@ -19,7 +19,7 @@ import Engine.Types (GlobalHandles(..)) import Engine.Types.Options (Options(..)) import Engine.Vulkan.Swapchain (SwapchainResources)-import Engine.Vulkan.Types (PhysicalDeviceInfo(..))+import Engine.Vulkan.Types (PhysicalDeviceInfo(..), Queues) import Engine.Worker qualified as Worker import Engine.StageSwitch (newStageSwitchVar) @@ -49,7 +49,7 @@ logDebug "Creating physical device" (ghPhysicalDeviceInfo, ghPhysicalDevice) <- allocatePhysical ghInstance- ghSurface+ (Just ghSurface) pdiTotalMemory logDebug "Creating logical device"@@ -79,6 +79,57 @@ ghStageSwitch <- newStageSwitchVar pure (GlobalHandles{..}, Nothing)++setupHeadless+ :: ( HasLogFunc env+ , MonadResource (RIO env)+ )+ => Options+ -> RIO env Headless+setupHeadless opts = do+ logDebug $ displayShow opts++ let windowReqs = []++ logDebug "Creating instance"+ ghInstance <- createInstanceFromRequirements+ (deviceProps : debugUtils : windowReqs)+ mempty+ zero++ logDebug "Creating physical device"+ (ghPhysicalDeviceInfo, ghPhysicalDevice) <- allocatePhysical+ ghInstance+ Nothing+ pdiTotalMemory++ logDebug "Creating logical device"+ ghDevice <- allocateLogical ghPhysicalDeviceInfo ghPhysicalDevice++ logDebug "Creating VMA"+ let+ allocatorCI :: VMA.AllocatorCreateInfo+ allocatorCI = zero+ { VMA.physicalDevice = Vk.physicalDeviceHandle ghPhysicalDevice+ , VMA.device = Vk.deviceHandle ghDevice+ , VMA.instance' = Vk.instanceHandle ghInstance+ }+ (_vmaKey, ghAllocator) <- VMA.withAllocator allocatorCI Resource.allocate+ toIO (logDebug "Releasing VMA") >>= Resource.register++ ghQueues <- liftIO $ pdiGetQueues ghPhysicalDeviceInfo ghDevice+ logDebug $ "Got command queues: " <> displayShow (fmap (unQueueFamilyIndex . fst) ghQueues)++ pure (ghInstance, ghPhysicalDeviceInfo, ghPhysicalDevice, ghDevice, ghAllocator, ghQueues)++type Headless =+ ( Vk.Instance+ , PhysicalDeviceInfo+ , Vk.PhysicalDevice+ , Vk.Device+ , VMA.Allocator+ , Queues (QueueFamilyIndex, Vk.Queue)+ ) deviceProps :: InstanceRequirement deviceProps = RequireInstanceExtension
src/Engine/Setup/Device.hs view
@@ -6,6 +6,7 @@ import Control.Monad.Trans.Maybe (MaybeT(..)) import GHC.IO.Exception (IOException(..), IOErrorType(NoSuchThing))+import RIO.Text qualified as Text import RIO.Vector qualified as V import UnliftIO.Resource (MonadResource) import UnliftIO.Resource qualified as Resource@@ -34,16 +35,16 @@ , MonadResource m ) => Vk.Instance- -> Khr.SurfaceKHR+ -> Maybe Khr.SurfaceKHR -> (PhysicalDeviceInfo -> Word64) -> m (PhysicalDeviceInfo, Vk.PhysicalDevice)-allocatePhysical vkInstance surface score = do+allocatePhysical vkInstance presentSurface score = do UnliftIO unliftIO <- askUnliftIO let create = unliftIO do logDebug "Picking physical device..."- pickPhysicalDevice vkInstance (physicalDeviceInfo surface) score >>= \case+ pickPhysicalDevice vkInstance (physicalDeviceInfo presentSurface) score >>= \case Nothing -> noSuchThing "Unable to find appropriate PhysicalDevice" Just res@(pdi, _dev) -> do@@ -63,11 +64,22 @@ , MonadReader env m , HasLogFunc env )- => Khr.SurfaceKHR -> Vk.PhysicalDevice -> m (Maybe PhysicalDeviceInfo)-physicalDeviceInfo surf phys = runMaybeT do+ => Maybe Khr.SurfaceKHR+ -> Vk.PhysicalDevice+ -> m (Maybe PhysicalDeviceInfo)+physicalDeviceInfo presentSurface phys = runMaybeT do pdiName <- physicalDeviceName phys- logDebug $ "Considering " <> displayShow pdiName + let+ ignoreDevice =+ "llvmpipe" `Text.isPrefixOf` pdiName++ if ignoreDevice then do+ logDebug $ "Ignoring " <> displayShow pdiName+ mzero+ else+ logDebug $ "Considering " <> displayShow pdiName+ hasTimelineSemaphores <- deviceHasTimelineSemaphores phys unless hasTimelineSemaphores do logWarn $ mconcat@@ -75,6 +87,7 @@ , displayShow pdiName , " because it doesn't support timeline semaphores" ]+ mzero hasSwapchainSupport <- deviceHasSwapchain phys unless hasSwapchainSupport do@@ -83,10 +96,29 @@ , displayShow pdiName , " because it doesn't support swapchains" ]+ mzero - (pdiQueueCreateInfos, pdiGetQueues) <- MaybeT $- Utils.assignQueues phys (queueRequirements phys surf)+ assigned <- Utils.assignQueues phys (queueRequirements phys presentSurface)+ (pdiQueueCreateInfos, pdiGetQueues) <- case assigned of+ Nothing -> do+ logDebug "Queue assignment failed"+ fallback <- Utils.assignQueues @_ @_ @IO phys (Identity $ QueueSpec 1.0 isFallbackQ)+ case fallback of+ Nothing -> do+ logWarn "Fallback assignment failed too"+ mzero+ Just (infos, getQueues) -> do+ logDebug "Fallback assignment succeeded"+ pure+ ( infos+ , \dev -> do+ Identity q <- getQueues dev+ pure $ Queues q q q+ ) + Just queues ->+ pure queues+ pdiTotalMemory <- do props <- Vk.getPhysicalDeviceMemoryProperties phys pure . sum $@@ -97,6 +129,9 @@ pdiProperties <- Vk.getPhysicalDeviceProperties phys pure PhysicalDeviceInfo{..}+ where+ isFallbackQ _queueFamilyIndex queueFamilyProperties =+ pure $ Utils.isGraphicsQueueFamily queueFamilyProperties {- | Requirements for a 'Queue' which has graphics support and can present to@@ -107,17 +142,24 @@ -} queueRequirements :: MonadIO m- => Vk.PhysicalDevice -> Khr.SurfaceKHR -> Queues (QueueSpec m)-queueRequirements phys surf = Queues+ => Vk.PhysicalDevice+ -> Maybe Khr.SurfaceKHR+ -> Queues (QueueSpec m)+queueRequirements phys presentSurface = Queues { qGraphics = QueueSpec 1.0 isGraphicsPresentQueue , qCompute = QueueSpec 0.5 isComputeQueue , qTransfer = QueueSpec 0.0 isTransferQueue } where- isGraphicsPresentQueue queueFamilyIndex queueFamilyProperties = do- pq <- Utils.isPresentQueueFamily phys surf queueFamilyIndex- let gq = Utils.isGraphicsQueueFamily queueFamilyProperties- pure $ pq && gq+ isGraphicsPresentQueue queueFamilyIndex queueFamilyProperties =+ case presentSurface of+ Just surf -> do+ pq <- Utils.isPresentQueueFamily phys surf queueFamilyIndex+ pure $ pq && gq+ Nothing ->+ pure gq+ where+ gq = Utils.isGraphicsQueueFamily queueFamilyProperties isTransferQueue _queueFamilyIndex queueFamilyProperties = pure $ Utils.isTransferQueueFamily queueFamilyProperties