No results
5
Recipes
dxtr edited this page 2026-10-18 16:13:19 +02:00
Recipes
- Clearing the screen every frame
- Choosing a GPU
- Calling raw commands on cl-vk's objects
- Structs reused every frame
- Checking a program with validation
- Handling a lost device
Clearing the screen every frame
A complete program: a frame loop that clears each swapchain image to a colour and presents it. It shows every part a renderer has: a command pool and buffer, image layout barriers with synchronization2, a submission that waits for the acquired image, a fence that keeps the CPU one frame ahead at most, and swapchain recreation.
Command pools and command buffers have no wrapper in cl-vk yet, so they are made with the raw layer, on cl-vk's device. The program runs as is on a headless surface, under synchronization validation, which reports nothing.
(asdf:load-system :cl-vk)
(defpackage #:clear-screen
(:use #:cl)
(:local-nicknames (#:vk #:cl-vk) (#:vks #:cl-vk/structs) (#:vk-ffi #:cl-vk/ffi)))
(in-package #:clear-screen)
;;; Command pools and command buffers have no wrapper in cl-vk yet, so they
;;; are made with the raw layer, on cl-vk's device.
(defun create-command-pool (device family)
"Return a raw VkCommandPool for the queue family FAMILY of DEVICE."
(vk:with-structs ((info vks:command-pool-create-info
:flags :reset-command-buffer
:queue-family-index family))
(cl-ffi:with-foreign-object (pool :uint64)
(vk:check (vk-ffi:vk-create-command-pool (vk:device-commands device) (vk:raw-handle device)
info (cl-ffi:null-pointer) pool)
"vkCreateCommandPool")
(cl-ffi:mem-ref pool :uint64))))
(defun destroy-command-pool (device pool)
"Destroy POOL, and the command buffers allocated from it."
(vk-ffi:vk-destroy-command-pool (vk:device-commands device) (vk:raw-handle device)
pool (cl-ffi:null-pointer)))
(defun allocate-command-buffer (device pool)
"Return a raw VkCommandBuffer, a pointer, from POOL."
(vk:with-structs ((info vks:command-buffer-allocate-info
:command-pool pool :level :primary :command-buffer-count 1))
(cl-ffi:with-foreign-object (buffer :pointer)
(vk:check (vk-ffi:vk-allocate-command-buffers (vk:device-commands device) (vk:raw-handle device)
info buffer)
"vkAllocateCommandBuffers")
(cl-ffi:mem-ref buffer :pointer))))
(defun record-clear (device buffer image color)
"Record into BUFFER: clear IMAGE, a swapchain image, to COLOR, a list of
four floats, and leave it ready to present."
(let ((commands (vk:device-commands device))
(ignored vk-ffi:+vk-queue-family-ignored+))
(vk:with-structs ((begin vks:command-buffer-begin-info :flags :one-time-submit)
(to-transfer vks:image-memory-barrier2
(:src-stage-mask :clear
:dst-stage-mask :clear :dst-access-mask :transfer-write
:old-layout :undefined :new-layout :transfer-dst-optimal
:src-queue-family-index ignored
:dst-queue-family-index ignored
:image image
:subresource-range (:aspect-mask :color :level-count 1
:layer-count 1)))
(to-present vks:image-memory-barrier2
(:src-stage-mask :clear :src-access-mask :transfer-write
:old-layout :transfer-dst-optimal :new-layout :present-src-khr
:src-queue-family-index ignored
:dst-queue-family-index ignored
:image image
:subresource-range (:aspect-mask :color :level-count 1
:layer-count 1)))
(before vks:dependency-info :image-memory-barriers to-transfer)
(after vks:dependency-info :image-memory-barriers to-present)
(clear-color vks:clear-color-value :float32 color)
(range vks:image-subresource-range
:aspect-mask :color :level-count 1 :layer-count 1))
(vk-ffi:vk-reset-command-buffer commands buffer 0)
(vk:check (vk-ffi:vk-begin-command-buffer commands buffer begin) "vkBeginCommandBuffer")
(vk-ffi:vk-cmd-pipeline-barrier2 commands buffer before)
(vk-ffi:vk-cmd-clear-color-image commands buffer image
vk-ffi:+vk-image-layout-transfer-dst-optimal+
clear-color 1 range)
(vk-ffi:vk-cmd-pipeline-barrier2 commands buffer after)
(vk:check (vk-ffi:vk-end-command-buffer commands buffer) "vkEndCommandBuffer"))))
(defun submit (queue buffer wait signal fence)
"Submit BUFFER to QUEUE: wait for the semaphore WAIT before clearing,
then signal the semaphore SIGNAL and FENCE."
(vk:with-structs ((waits vks:semaphore-submit-info (:semaphore wait :stage-mask :clear))
(signals vks:semaphore-submit-info (:semaphore signal :stage-mask :all-commands))
(buffers vks:command-buffer-submit-info (:command-buffer buffer))
(info vks:submit-info2
:wait-semaphore-infos waits
:command-buffer-infos buffers
:signal-semaphore-infos signals))
(vk:check (vk-ffi:vk-queue-submit2 (vk:device-commands (vk:queue-device queue))
(vk:raw-handle queue) 1 info (vk:raw-handle fence))
"vkQueueSubmit2")))
(defun clear-screen (instance surface &key (frames 3) (extent '(640 480)))
"Clear SURFACE to a colour for FRAMES frames, and return each frame's
acquire status."
(let ((gpu (first (vk:physical-devices instance))))
(vk:with-device (device gpu :extensions '("VK_KHR_swapchain")
:features '((vks:physical-device-vulkan13-features
:synchronization2)))
(let* ((queue (vk:device-queue device))
(pool (create-command-pool device (vk:queue-family-index (vk:queue-family queue))))
(buffer (allocate-command-buffer device pool))
(swapchain (vk:create-swapchain device surface
:extent extent
:usage '(:color-attachment :transfer-dst)))
(in-flight (vk:create-fence device :signaled t))
(acquired (vk:create-binary-semaphore device))
;; One per image: a present may still wait on the last one.
(rendered (loop repeat (length (vk:swapchain-images swapchain))
collect (vk:create-binary-semaphore device)))
(statuses '()))
(flet ((recreate ()
(vk:device-wait-idle device)
(setf swapchain (vk:recreate-swapchain swapchain))))
(unwind-protect
(dotimes (frame frames)
(vk:wait-for-fence in-flight)
(multiple-value-bind (index status)
(vk:acquire-next-image swapchain :semaphore acquired)
(push status statuses)
(if (eq status :out-of-date)
(recreate)
(let ((image (nth index (vk:swapchain-images swapchain)))
(done (nth index rendered)))
(vk:reset-fence in-flight)
(record-clear device buffer image '(0.1 0.2 0.3 1.0))
(submit queue buffer acquired done in-flight)
(unless (eq (vk:present queue swapchain index :wait-semaphore done)
:success)
(recreate))))))
(vk:device-wait-idle device)
(destroy-command-pool device pool)
(mapc #'vk:destroy-binary-semaphore rendered)
(vk:destroy-binary-semaphore acquired)
(vk:destroy-fence in-flight)
(vk:destroy-swapchain swapchain)))
(nreverse statuses)))))
(defun headless-test ()
(vk:with-instance (instance :extensions '("VK_KHR_surface" "VK_EXT_headless_surface")
:validation-checks '(:synchronization))
(let ((surface (vk:create-headless-surface instance)))
(unwind-protect
(list (clear-screen instance surface)
(remove-if-not (lambda (message)
(member (vk:debug-message-severity message) '(:warning :error)))
(vk:take-debug-messages instance)))
(vk:destroy-surface surface)))))
(headless-test)
;; => ((:SUCCESS :SUCCESS :SUCCESS) NIL) ; three frames, no warnings or errors
Points worth noticing:
- The first barrier's
:src-stage-maskis the stage the submission waits for the acquired image in (:clear). That chains the layout transition after the semaphore wait. Without it, synchronization validation reportsSYNC-HAZARD-WRITE-AFTER-READ: the transition could run while the presentation engine still reads the image. - One "rendered" semaphore per swapchain image, picked by the image's
index:
presentmay still be waiting on a semaphore when the next frame starts.recreate-swapchainkeeps the image count, so the list stays right. - The fence starts signaled, so the first
wait-for-fencereturns at once, and is reset only once an image is acquired, so an:out-of-dateframe cannot leave it unsignaled forever. :transfer-dstis added to the swapchain usage because the images are cleared with a transfer command.VK_IMAGE_LAYOUT_PRESENT_SRC_KHRis:present-src-khr: theKHRstays becauseVkImageLayoutis a core type. Enum names are explained in Concepts.
For a window instead of a headless surface, make the instance with the window system's extensions and pass the window's surface; see Surfaces and Swapchains.
Choosing a GPU
Prefer a discrete GPU, then an integrated one, among those that have what the program needs:
(defparameter *required-features*
'((vks:physical-device-vulkan13-features :dynamic-rendering :synchronization2)))
(defun suitable-p (gpu surface)
"Return true if GPU can render to and present on SURFACE."
(and (member "VK_KHR_swapchain" (vk:physical-device-extensions gpu) :test #'string=)
(every (lambda (request)
(every (lambda (field) (vk:physical-device-feature-p gpu (first request) field))
(rest request)))
*required-features*)
(vk:find-queue-family gpu (lambda (family)
(and (member :graphics (vk:queue-family-flags family))
(vk:surface-supported-p gpu (vk:queue-family-index family)
surface))))))
(defun choose-gpu (instance surface)
"Return the best physical device of INSTANCE for SURFACE: a discrete GPU
if there is one, then an integrated one, then anything else."
(let ((candidates (remove-if-not (lambda (gpu) (suitable-p gpu surface))
(vk:physical-devices instance))))
(or (first (sort (copy-list candidates) #'<
:key (lambda (gpu)
(or (position (vk:physical-device-type gpu)
'(:discrete-gpu :integrated-gpu :virtual-gpu :cpu))
4))))
(error "No GPU can present to this surface with the features this program needs."))))
Then create the device with the same requests:
(vk:create-device gpu :extensions '("VK_KHR_swapchain") :features *required-features*).
Calling raw commands on cl-vk's objects
Everything the idiomatic layer does not wrap yet is called through the
raw layer, cl-vk/ffi, with three things from cl-vk:
vk:instance-commandsorvk:device-commands: the command table, the first argument of every raw command. Device-level commands (those taking aVkDevice,VkQueueorVkCommandBuffer) use the device's table; the rest use the instance's.vk:raw-handle: the Vulkan handle of a cl-vk object.vk:check: turns the returnedVkResultinto a keyword, or signals aresult-error.
Structs are filled with with-structs, and handles the command returns
are read from foreign memory: a pointer for dispatchable handles
(VkCommandBuffer), a :uint64 for the others (VkCommandPool,
VkImageView, VkBuffer and the rest). The command pool functions in
the first recipe are the pattern. Another, an image view for a swapchain
image:
(defun create-image-view (device image format)
(vk:with-structs ((info vks:image-view-create-info
:image image
:view-type :type-2d
:format format
:subresource-range (:aspect-mask :color :level-count 1 :layer-count 1)))
(cl-ffi:with-foreign-object (view :uint64)
(vk:check (vk-ffi:vk-create-image-view (vk:device-commands device) (vk:raw-handle device)
info (cl-ffi:null-pointer) view)
"vkCreateImageView")
(cl-ffi:mem-ref view :uint64))))
(create-image-view device (first (vk:swapchain-images swapchain)) (vk:swapchain-format swapchain))
Objects made this way are not tracked by cl-vk: destroy them yourself, before the device. See Raw FFI Layer.
Structs reused every frame
with-structs allocates foreign memory for strings and lists. For
structs filled every frame, allocate once and refill with set-struct,
which allocates nothing:
(defstruct frame-submit
(info (vk:allocate-struct 'vks:submit-info2) :type cl-ffi:foreign-pointer)
(wait (vk:allocate-struct 'vks:semaphore-submit-info) :type cl-ffi:foreign-pointer)
(buffer (vk:allocate-struct 'vks:command-buffer-submit-info) :type cl-ffi:foreign-pointer))
(defun fill-submit (submit semaphore command-buffer)
"Fill SUBMIT for COMMAND-BUFFER, waiting for SEMAPHORE. Allocates nothing."
(vk:set-struct (frame-submit-wait submit) vks:semaphore-submit-info
:semaphore semaphore :stage-mask :color-attachment-output)
(vk:set-struct (frame-submit-buffer submit) vks:command-buffer-submit-info
:command-buffer command-buffer)
(vk:set-struct (frame-submit-info submit) vks:submit-info2
:wait-semaphore-info-count 1 :wait-semaphore-infos (frame-submit-wait submit)
:command-buffer-info-count 1 :command-buffer-infos (frame-submit-buffer submit)))
(defun free-frame-submit (submit)
(vk:free-struct (frame-submit-info submit))
(vk:free-struct (frame-submit-wait submit))
(vk:free-struct (frame-submit-buffer submit)))
Calling fill-submit a thousand times conses zero bytes. Arrays are
passed as pointers with their counts set explicitly; set-struct refuses
lists rather than allocate.
Checking a program with validation
Turn on validation, and the synchronization checks, in development builds and in tests, and fail on any error it reports:
(defun validation-errors (instance)
(mapcar #'vk:debug-message-text
(remove :error (vk:take-debug-messages instance)
:key #'vk:debug-message-severity :test-not #'eq)))
(vk:with-instance (instance :validation-checks '(:synchronization))
(run-the-program instance)
(assert (null (validation-errors instance))))
On a machine without the validation layers, :validation signals an
unsupported-error. To run with validation only where it is installed:
(member "VK_LAYER_KHRONOS_validation" (vk:available-layers) :test #'string=)
Handling a lost device
A driver crash, a GPU reset or a hang loses the device; every command on
it then fails with VK_ERROR_DEVICE_LOST, which cl-vk signals as
device-lost-error. The device and everything made from it must be
destroyed and made again:
(handler-case (render-frame)
(vk:device-lost-error ()
(destroy-everything-made-from-the-device)
(vk:destroy-device device)
(setf device (vk:create-device gpu ...))
(recreate-everything)))
Do not call device-wait-idle on a lost device: it signals
device-lost-error too.