ac-os/cl: scaffold Common Lisp edition of AC Native OS

Phase 1 scaffolding:
- ASDF system definition + packages
- Syscalls (CFFI bindings for open/close/ioctl/mmap/mount)
- Color (ARGB32 pack/blend)
- Framebuffer (foreign-memory pixel buffer)
- DRM display (libdrm bindings, connector/CRTC setup stubs)
- Graphics (wipe, ink, plot, line, box, circle — Bresenham + midpoint)
- Input (evdev polling, struct input_event)
- Audio (ALSA PCM, voice mixing thread, synth oscillators)
- Config (minimal JSON parser for USB config.json)
- Main loop (60fps frame sync, demo color cycle)
- Build script (sb-ext:save-lisp-and-die standalone binary)

Uses SBCL + CFFI + bordeaux-threads. Targets the same initramfs
slot as the C binary — init script doesn't change.

Co-Authored-By: Claude Opus 4.6 (1M context) <[e-mail]>

fedac/native/cl/ac-native.asd

···
+;;; AC Native OS — Common Lisp Edition
+;;; ASDF system definition
+
+(defsystem "ac-native"
+  :description "Aesthetic Computer Native OS runtime"
+  :version "0.1.0"
+  :author "Aesthetic Computer"
+  :license "MIT"
+  :depends-on ("cffi" "bordeaux-threads" "alexandria")
+  :serial t
+  :components
+  ((:file "packages")
+   ;; Core infrastructure
+   (:file "util")
+   (:file "syscalls")
+   ;; Display
+   (:file "color")
+   (:file "framebuffer")
+   (:file "drm-constants")
+   (:file "drm-display")
+   ;; Graphics
+   (:file "graph")
+   (:file "font-data")
+   (:file "font")
+   ;; Input
+   (:file "input-keycodes")
+   (:file "input")
+   ;; Audio
+   (:file "alsa-bindings")
+   (:file "audio-synth")
+   (:file "audio")
+   ;; Main
+   (:file "config")
+   (:file "main")
+   ;; Build
+   (:file "build")))

fedac/native/cl/alsa-bindings.lisp

···
+;;; ALSA PCM bindings via CFFI
+
+(in-package :ac-native.alsa)
+
+(cffi:define-foreign-library libasound
+  (:unix "libasound.so.2"))
+
+(cffi:use-foreign-library libasound)
+
+;;; PCM
+(cffi:defcfun ("snd_pcm_open" pcm-open%) :int
+  (pcm :pointer) (name :string) (stream :int) (mode :int))
+
+(defun pcm-open (name &key (stream 0) (mode 0))
+  "Open an ALSA PCM device. Returns (values pcm-handle error-code)."
+  (cffi:with-foreign-object (handle :pointer)
+    (let ((err (pcm-open% handle name stream mode)))
+      (values (if (zerop err) (cffi:mem-ref handle :pointer) nil) err))))
+
+(cffi:defcfun ("snd_pcm_close" pcm-close) :int (pcm :pointer))
+(cffi:defcfun ("snd_pcm_prepare" pcm-prepare) :int (pcm :pointer))
+(cffi:defcfun ("snd_pcm_writei" pcm-writei) :long
+  (pcm :pointer) (buffer :pointer) (size :unsigned-long))
+(cffi:defcfun ("snd_pcm_recover" pcm-recover) :int
+  (pcm :pointer) (err :int) (silent :int))
+
+;;; Simplified setup
+(cffi:defcfun ("snd_pcm_set_params" pcm-set-params) :int
+  (pcm :pointer) (format :int) (access :int) (channels :unsigned-int)
+  (rate :unsigned-int) (soft-resample :int) (latency :unsigned-int))
+
+;;; Constants
+(defconstant +snd-pcm-stream-playback+ 0)
+(defconstant +snd-pcm-stream-capture+ 1)
+(defconstant +snd-pcm-format-s16-le+ 2)
+(defconstant +snd-pcm-format-float-le+ 14)
+(defconstant +snd-pcm-access-rw-interleaved+ 3)
+
+;;; Error strings
+(cffi:defcfun ("snd_strerror" snd-strerror) :string (errnum :int))

fedac/native/cl/audio-synth.lisp

···
+;;; Audio synthesis — oscillators, envelopes
+
+(in-package :ac-native.audio)
+
+(defconstant +twopi+ (* 2.0d0 pi))
+
+(declaim (inline osc-sine osc-square osc-triangle osc-sawtooth))
+
+(defun osc-sine (phase)
+  (declare (optimize (speed 3) (safety 0)) (type double-float phase))
+  (sin phase))
+
+(defun osc-square (phase)
+  (declare (optimize (speed 3) (safety 0)) (type double-float phase))
+  (if (< (mod phase +twopi+) pi) 1.0d0 -1.0d0))
+
+(defun osc-triangle (phase)
+  (declare (optimize (speed 3) (safety 0)) (type double-float phase))
+  (let ((p (mod (/ phase +twopi+) 1.0d0)))
+    (if (< p 0.5d0)
+        (- (* 4.0d0 p) 1.0d0)
+        (- 3.0d0 (* 4.0d0 p)))))
+
+(defun osc-sawtooth (phase)
+  (declare (optimize (speed 3) (safety 0)) (type double-float phase))
+  (- (* 2.0d0 (mod (/ phase +twopi+) 1.0d0)) 1.0d0))
+
+(defstruct voice
+  "A synthesizer voice."
+  (active nil :type boolean)
+  (osc-type 0 :type fixnum)  ; 0=sine 1=square 2=tri 3=saw 4=noise
+  (phase 0.0d0 :type double-float)
+  (phase-inc 0.0d0 :type double-float)
+  (volume 0.7d0 :type double-float)
+  (pan 0.0d0 :type double-float)
+  (attack 0.01d0 :type double-float)
+  (decay 0.1d0 :type double-float)
+  (duration 0.0d0 :type double-float)  ; 0 = infinite
+  (elapsed 0.0d0 :type double-float)
+  (fade 1.0d0 :type double-float)
+  (id 0 :type fixnum))
+
+(defun generate-sample (v)
+  "Generate one sample from voice V."
+  (declare (optimize (speed 3) (safety 0))
+           (type voice v))
+  (case (voice-osc-type v)
+    (0 (osc-sine (voice-phase v)))
+    (1 (osc-square (voice-phase v)))
+    (2 (osc-triangle (voice-phase v)))
+    (3 (osc-sawtooth (voice-phase v)))
+    (4 (- (random 2.0d0) 1.0d0))  ; white noise
+    (t 0.0d0)))

fedac/native/cl/audio.lisp

···
+;;; Audio subsystem — ALSA output + voice mixing
+
+(in-package :ac-native.audio)
+
+(defconstant +max-voices+ 32)
+(defconstant +sample-rate+ 48000)
+
+(defstruct ac-audio
+  "Audio subsystem state."
+  (pcm nil)  ; ALSA PCM handle
+  (voices (make-array +max-voices+ :initial-element nil))
+  (thread nil)
+  (running nil :type boolean)
+  (next-id 1 :type fixnum)
+  (lock (bordeaux-threads:make-lock "audio")))
+
+(defun audio-init ()
+  "Initialize ALSA audio output and start the mixing thread."
+  (multiple-value-bind (pcm err) (ac-native.alsa:pcm-open "default")
+    (unless pcm
+      (ac-native.util:ac-log "[audio] failed to open: ~A~%"
+                              (ac-native.alsa:snd-strerror err))
+      ;; Try hw:0,0
+      (multiple-value-setq (pcm err) (ac-native.alsa:pcm-open "hw:0,0"))
+      (unless pcm
+        (ac-native.util:ac-log "[audio] hw:0,0 also failed~%")
+        (return-from audio-init nil)))
+
+    ;; Set params: S16_LE, stereo, 48kHz, 50ms latency
+    (let ((ret (ac-native.alsa:pcm-set-params
+                pcm
+                ac-native.alsa:+snd-pcm-format-s16-le+
+                ac-native.alsa:+snd-pcm-access-rw-interleaved+
+                2 +sample-rate+ 1 50000)))
+      (unless (zerop ret)
+        (ac-native.util:ac-log "[audio] set-params failed: ~A~%"
+                                (ac-native.alsa:snd-strerror ret))
+        (ac-native.alsa:pcm-close pcm)
+        (return-from audio-init nil)))
+
+    (let ((audio (make-ac-audio :pcm pcm :running t)))
+      ;; Init voice slots
+      (dotimes (i +max-voices+)
+        (setf (aref (ac-audio-voices audio) i) (make-voice)))
+
+      ;; Start audio thread
+      (setf (ac-audio-thread audio)
+            (bordeaux-threads:make-thread
+             (lambda () (audio-thread-fn audio))
+             :name "audio"))
+
+      (ac-native.util:ac-log "[audio] OK (48kHz stereo)~%")
+      audio)))
+
+(defun audio-thread-fn (audio)
+  "Audio mixing thread — fills PCM buffer."
+  (let* ((period-frames 256)
+         (buf-samples (* period-frames 2))  ; stereo
+         (buf (cffi:foreign-alloc :int16 :count buf-samples)))
+    (unwind-protect
+        (loop while (ac-audio-running audio) do
+          ;; Mix all active voices
+          (dotimes (f period-frames)
+            (let ((mix-l 0.0d0) (mix-r 0.0d0))
+              (bordeaux-threads:with-lock-held ((ac-audio-lock audio))
+                (dotimes (i +max-voices+)
+                  (let ((v (aref (ac-audio-voices audio) i)))
+                    (when (voice-active v)
+                      (let* ((s (generate-sample v))
+                             (vol (* (voice-volume v) (voice-fade v)))
+                             (l-gain (if (<= (voice-pan v) 0) 1.0d0
+                                         (- 1.0d0 (* (voice-pan v) 0.6d0))))
+                             (r-gain (if (>= (voice-pan v) 0) 1.0d0
+                                         (+ 1.0d0 (* (voice-pan v) 0.6d0)))))
+                        (incf mix-l (* s vol l-gain))
+                        (incf mix-r (* s vol r-gain))
+                        ;; Advance phase
+                        (incf (voice-phase v) (voice-phase-inc v))
+                        (incf (voice-elapsed v) (/ 1.0d0 +sample-rate+))
+                        ;; Check duration
+                        (when (and (> (voice-duration v) 0)
+                                   (> (voice-elapsed v) (voice-duration v)))
+                          (setf (voice-active v) nil)))))))
+              ;; Clamp and write S16LE stereo
+              (let ((sl (max -32767 (min 32767 (round (* mix-l 32767)))))
+                    (sr (max -32767 (min 32767 (round (* mix-r 32767))))))
+                (setf (cffi:mem-aref buf :int16 (* f 2)) sl)
+                (setf (cffi:mem-aref buf :int16 (1+ (* f 2))) sr))))
+          ;; Write to ALSA
+          (let ((ret (ac-native.alsa:pcm-writei (ac-audio-pcm audio) buf period-frames)))
+            (when (< ret 0)
+              (ac-native.alsa:pcm-recover (ac-audio-pcm audio) (truncate ret) 0))))
+      ;; Cleanup
+      (cffi:foreign-free buf))))
+
+(defun audio-synth (audio &key (type 0) (tone 440.0) (volume 0.7) (duration 0)
+                            (pan 0.0) (attack 0.01) (decay 0.1))
+  "Start a synth voice. Returns voice ID."
+  (bordeaux-threads:with-lock-held ((ac-audio-lock audio))
+    ;; Find free slot
+    (let ((slot (dotimes (i +max-voices+ 0)
+                 (unless (voice-active (aref (ac-audio-voices audio) i))
+                   (return i))))
+          (id (incf (ac-audio-next-id audio))))
+      (let ((v (aref (ac-audio-voices audio) slot)))
+        (setf (voice-active v) t
+              (voice-osc-type v) type
+              (voice-phase v) 0.0d0
+              (voice-phase-inc v) (/ (* +twopi+ (coerce tone 'double-float)) +sample-rate+)
+              (voice-volume v) (coerce volume 'double-float)
+              (voice-pan v) (coerce pan 'double-float)
+              (voice-attack v) (coerce attack 'double-float)
+              (voice-decay v) (coerce decay 'double-float)
+              (voice-duration v) (coerce duration 'double-float)
+              (voice-elapsed v) 0.0d0
+              (voice-fade v) 1.0d0
+              (voice-id v) id))
+      id)))
+
+(defun audio-synth-kill (audio id)
+  "Kill a synth voice by ID."
+  (bordeaux-threads:with-lock-held ((ac-audio-lock audio))
+    (dotimes (i +max-voices+)
+      (let ((v (aref (ac-audio-voices audio) i)))
+        (when (and (voice-active v) (= (voice-id v) id))
+          (setf (voice-active v) nil)
+          (return))))))
+
+(defun audio-destroy (audio)
+  "Shutdown audio."
+  (when audio
+    (setf (ac-audio-running audio) nil)
+    (when (ac-audio-thread audio)
+      (bordeaux-threads:join-thread (ac-audio-thread audio)))
+    (when (ac-audio-pcm audio)
+      (ac-native.alsa:pcm-close (ac-audio-pcm audio)))
+    (ac-native.util:ac-log "[audio] destroyed~%")))

fedac/native/cl/build.lisp

···
+;;; Build script — produce standalone ac-native binary
+
+(in-package :ac-native.build)
+
+(defun build (&optional (output "ac-native"))
+  "Save a standalone executable."
+  (format t "Building AC Native OS (Common Lisp)...~%")
+  (format t "  Output: ~A~%" output)
+  (sb-ext:save-lisp-and-die output
+    :toplevel #'ac-native:main
+    :executable t
+    :compression t
+    :purify t))

fedac/native/cl/color.lisp

···
+;;; Color — ARGB32 pixel operations
+
+(in-package :ac-native.color)
+
+(defstruct (color (:constructor make-color (&key (r 0) (g 0) (b 0) (a 255))))
+  (r 0 :type (unsigned-byte 8))
+  (g 0 :type (unsigned-byte 8))
+  (b 0 :type (unsigned-byte 8))
+  (a 255 :type (unsigned-byte 8)))
+
+(declaim (inline color-pack-argb32))
+(defun color-pack-argb32 (c)
+  "Pack a color struct into a 32-bit ARGB value."
+  (declare (optimize (speed 3) (safety 0)))
+  (logior (ash (color-a c) 24)
+          (ash (color-r c) 16)
+          (ash (color-g c) 8)
+          (color-b c)))
+
+(declaim (inline blend-channel))
+(defun blend-channel (src dst alpha)
+  "Blend a single channel: src over dst with alpha [0..255]."
+  (declare (optimize (speed 3) (safety 0))
+           (type (unsigned-byte 8) src dst alpha))
+  (the (unsigned-byte 8)
+       (ash (+ (* src alpha) (* dst (- 255 alpha)) 128) -8)))
+
+(defun color-blend (src dst)
+  "Alpha-blend src over dst, return packed ARGB32."
+  (declare (optimize (speed 3) (safety 0)))
+  (let ((sa (color-a src)))
+    (if (= sa 255)
+        (color-pack-argb32 src)
+        (if (zerop sa)
+            (color-pack-argb32 dst)
+            (logior
+             #xFF000000
+             (ash (blend-channel (color-r src) (color-r dst) sa) 16)
+             (ash (blend-channel (color-g src) (color-g dst) sa) 8)
+             (blend-channel (color-b src) (color-b dst) sa))))))

fedac/native/cl/config.lisp

···
+;;; Config — parse config.json from USB
+
+(in-package :ac-native.config)
+
+(defstruct config
+  (handle "unknown" :type string)
+  (piece nil :type (or null string))
+  (email nil :type (or null string)))
+
+(defun load-config (&optional (path "/mnt/config.json"))
+  "Load config from USB. Returns a config struct."
+  (if (probe-file path)
+      (let ((text (with-open-file (s path :direction :input)
+                    (let ((buf (make-string (file-length s))))
+                      (read-sequence buf s)
+                      buf))))
+        ;; Minimal JSON parsing — just extract "handle" and "piece"
+        (make-config
+         :handle (or (json-extract text "handle") "unknown")
+         :piece (json-extract text "piece")
+         :email (json-extract text "email")))
+      (make-config)))
+
+(defun json-extract (text key)
+  "Extract a string value for KEY from a JSON text. Very minimal."
+  (let* ((needle (format nil "\"~A\"" key))
+         (pos (search needle text)))
+    (when pos
+      (let* ((colon (position #\: text :start (+ pos (length needle))))
+             (quote1 (and colon (position #\" text :start (1+ colon))))
+             (quote2 (and quote1 (position #\" text :start (1+ quote1)))))
+        (when (and quote1 quote2)
+          (subseq text (1+ quote1) quote2))))))

fedac/native/cl/drm-constants.lisp

···
+;;; DRM/KMS constants and struct definitions
+
+(in-package :ac-native.drm)
+
+;;; DRM ioctl numbers (from <drm.h> and <drm_mode.h>)
+(defconstant +drm-ioctl-base+ #x64) ; 'd'
+
+;;; libdrm function bindings (higher-level than raw ioctls)
+(cffi:define-foreign-library libdrm
+  (:unix "libdrm.so.2"))
+
+(cffi:use-foreign-library libdrm)
+
+;; drmModeRes *drmModeGetResources(int fd)
+(cffi:defcfun ("drmModeGetResources" drm-mode-get-resources) :pointer
+  (fd :int))
+
+;; void drmModeFreeResources(drmModeRes *ptr)
+(cffi:defcfun ("drmModeFreeResources" drm-mode-free-resources) :void
+  (ptr :pointer))
+
+;; drmModeConnector *drmModeGetConnector(int fd, uint32_t id)
+(cffi:defcfun ("drmModeGetConnector" drm-mode-get-connector) :pointer
+  (fd :int) (id :uint32))
+
+;; void drmModeFreeConnector(drmModeConnector *ptr)
+(cffi:defcfun ("drmModeFreeConnector" drm-mode-free-connector) :void
+  (ptr :pointer))
+
+;; drmModeEncoder *drmModeGetEncoder(int fd, uint32_t id)
+(cffi:defcfun ("drmModeGetEncoder" drm-mode-get-encoder) :pointer
+  (fd :int) (id :uint32))
+
+;; void drmModeFreeEncoder(drmModeEncoder *ptr)
+(cffi:defcfun ("drmModeFreeEncoder" drm-mode-free-encoder) :void
+  (ptr :pointer))
+
+;; int drmModeSetCrtc(int fd, uint32_t crtc_id, uint32_t fb_id,
+;;                    uint32_t x, uint32_t y, uint32_t *connectors,
+;;                    int count, drmModeModeInfo *mode)
+(cffi:defcfun ("drmModeSetCrtc" drm-mode-set-crtc) :int
+  (fd :int) (crtc-id :uint32) (fb-id :uint32)
+  (x :uint32) (y :uint32) (connectors :pointer)
+  (count :int) (mode :pointer))
+
+;; int drmModeAddFB(int fd, uint32_t width, uint32_t height, uint8_t depth,
+;;                  uint8_t bpp, uint32_t pitch, uint32_t bo_handle, uint32_t *buf_id)
+(cffi:defcfun ("drmModeAddFB" drm-mode-add-fb) :int
+  (fd :int) (width :uint32) (height :uint32) (depth :uint8)
+  (bpp :uint8) (pitch :uint32) (bo-handle :uint32) (buf-id :pointer))
+
+;; int drmModeRmFB(int fd, uint32_t fb_id)
+(cffi:defcfun ("drmModeRmFB" drm-mode-rm-fb) :int
+  (fd :int) (fb-id :uint32))
+
+;; int drmModePageFlip(int fd, uint32_t crtc_id, uint32_t fb_id,
+;;                     uint32_t flags, void *user_data)
+(cffi:defcfun ("drmModePageFlip" drm-mode-page-flip) :int
+  (fd :int) (crtc-id :uint32) (fb-id :uint32)
+  (flags :uint32) (user-data :pointer))
+
+(defconstant +drm-mode-page-flip-event+ 1)
+
+;;; DRM dumb buffer ioctls
+(cffi:defcstruct drm-mode-create-dumb
+  (height :uint32)
+  (width :uint32)
+  (bpp :uint32)
+  (flags :uint32)
+  ;; output
+  (handle :uint32)
+  (pitch :uint32)
+  (size :uint64))
+
+(cffi:defcstruct drm-mode-map-dumb
+  (handle :uint32)
+  (pad :uint32)
+  (offset :uint64))
+
+(cffi:defcstruct drm-mode-destroy-dumb
+  (handle :uint32))
+
+;;; DRM_IOCTL_MODE_CREATE_DUMB = DRM_IOWR(0xB2, struct drm_mode_create_dumb)
+;;; These are computed from the ioctl macros
+(defconstant +drm-ioctl-mode-create-dumb+ #xC02064B2)
+(defconstant +drm-ioctl-mode-map-dumb+    #xC01064B3)
+(defconstant +drm-ioctl-mode-destroy-dumb+ #xC00464B4)
+
+;;; Connector status
+(defconstant +drm-mode-connected+ 1)
+(defconstant +drm-mode-disconnected+ 2)

fedac/native/cl/drm-display.lisp

···
+;;; DRM display — Linux DRM/KMS for direct framebuffer access
+
+(in-package :ac-native.drm)
+
+(defstruct display
+  "DRM display state."
+  (fd -1 :type fixnum)
+  (width 0 :type fixnum)
+  (height 0 :type fixnum)
+  (crtc-id 0 :type (unsigned-byte 32))
+  (connector-id 0 :type (unsigned-byte 32))
+  ;; Double-buffered dumb buffers
+  (fb-ids (make-array 2 :element-type '(unsigned-byte 32) :initial-element 0))
+  (bo-handles (make-array 2 :element-type '(unsigned-byte 32) :initial-element 0))
+  (maps (make-array 2 :initial-element (cffi:null-pointer)))
+  (buf-sizes (make-array 2 :element-type 'fixnum :initial-element 0))
+  (pitches (make-array 2 :element-type 'fixnum :initial-element 0))
+  (back 0 :type fixnum)  ; which buffer is back (0 or 1)
+  (mode-ptr (cffi:null-pointer) :type cffi:foreign-pointer))
+
+(defun try-open-drm ()
+  "Try /dev/dri/card0, card1. Return fd or -1."
+  (loop for card in '("/dev/dri/card0" "/dev/dri/card1" "/dev/dri/card2")
+        for fd = (ac-native.syscalls:sys-open card
+                   (logior ac-native.syscalls:+o-rdwr+
+                           ac-native.syscalls:+o-cloexec+)
+                   0)
+        when (>= fd 0) do
+          (ac-native.util:ac-log "[drm] opened ~A (fd ~D)~%" card fd)
+          (return fd)
+        finally (return -1)))
+
+(defun create-dumb-buffer (fd width height)
+  "Create a DRM dumb buffer. Returns (values handle pitch size) or nil."
+  (cffi:with-foreign-object (req '(:struct drm-mode-create-dumb))
+    (cffi:foreign-funcall "memset" :pointer req :int 0
+                          :unsigned-long (cffi:foreign-type-size '(:struct drm-mode-create-dumb))
+                          :pointer)
+    (setf (cffi:foreign-slot-value req '(:struct drm-mode-create-dumb) 'height) height)
+    (setf (cffi:foreign-slot-value req '(:struct drm-mode-create-dumb) 'width) width)
+    (setf (cffi:foreign-slot-value req '(:struct drm-mode-create-dumb) 'bpp) 32)
+    (let ((ret (ac-native.syscalls:sys-ioctl fd +drm-ioctl-mode-create-dumb+ :pointer req)))
+      (if (zerop ret)
+          (values
+           (cffi:foreign-slot-value req '(:struct drm-mode-create-dumb) 'handle)
+           (cffi:foreign-slot-value req '(:struct drm-mode-create-dumb) 'pitch)
+           (cffi:foreign-slot-value req '(:struct drm-mode-create-dumb) 'size))
+          nil))))
+
+(defun map-dumb-buffer (fd handle size)
+  "Mmap a dumb buffer. Returns foreign pointer or null."
+  (cffi:with-foreign-object (req '(:struct drm-mode-map-dumb))
+    (cffi:foreign-funcall "memset" :pointer req :int 0
+                          :unsigned-long (cffi:foreign-type-size '(:struct drm-mode-map-dumb))
+                          :pointer)
+    (setf (cffi:foreign-slot-value req '(:struct drm-mode-map-dumb) 'handle) handle)
+    (let ((ret (ac-native.syscalls:sys-ioctl fd +drm-ioctl-mode-map-dumb+ :pointer req)))
+      (if (zerop ret)
+          (let ((offset (cffi:foreign-slot-value req '(:struct drm-mode-map-dumb) 'offset)))
+            (ac-native.syscalls:sys-mmap
+             (cffi:null-pointer) size
+             (logior ac-native.syscalls:+prot-read+ ac-native.syscalls:+prot-write+)
+             ac-native.syscalls:+map-shared+
+             fd offset))
+          (cffi:null-pointer)))))
+
+(defun drm-init ()
+  "Initialize DRM display. Returns a display struct or nil."
+  (let ((fd (try-open-drm)))
+    (when (< fd 0)
+      (ac-native.util:ac-log "[drm] no DRM device found~%")
+      (return-from drm-init nil))
+
+    ;; Get resources
+    (let ((res (drm-mode-get-resources fd)))
+      (when (cffi:null-pointer-p res)
+        (ac-native.util:ac-log "[drm] drmModeGetResources failed~%")
+        (ac-native.syscalls:sys-close fd)
+        (return-from drm-init nil))
+
+      ;; Find first connected connector
+      ;; TODO: iterate connectors, find encoder, find CRTC
+      ;; For now, return a placeholder
+      (ac-native.util:ac-log "[drm] resources obtained, setting up display...~%")
+
+      ;; Placeholder — real implementation needs connector/encoder/CRTC setup
+      ;; This is the most hardware-specific part
+      (drm-mode-free-resources res)
+
+      (let ((disp (make-display :fd fd :width 1366 :height 768)))
+        ;; TODO: actually detect resolution from connector modes
+        disp))))
+
+(defun drm-present (display screen scale)
+  "Copy the render framebuffer to the DRM back buffer and flip."
+  (declare (ignore display screen scale))
+  ;; TODO: implement fb-copy-scaled to mmap'd buffer + page flip
+  )
+
+(defun drm-destroy (display)
+  "Clean up DRM resources."
+  (when display
+    (when (>= (display-fd display) 0)
+      (ac-native.syscalls:sys-close (display-fd display))
+      (ac-native.util:ac-log "[drm] closed~%"))))

fedac/native/cl/font-data.lisp

···
+;;; Font bitmap data — placeholder, will be generated from C headers
+
+(in-package :ac-native.font)
+
+;; 8x8 font — 95 printable ASCII characters (space through ~)
+;; Each character is 8 bytes (8 rows of 8 pixels)
+;; TODO: port from fedac/native/src/font-8x8.h
+(defvar *font-8x8* (make-array (* 95 8) :element-type '(unsigned-byte 8) :initial-element 0))

fedac/native/cl/font.lisp

···
+;;; Font rendering — bitmap font draw/measure
+
+(in-package :ac-native.font)
+
+(defun font-init ()
+  "Load font data. Called once at startup."
+  ;; TODO: populate *font-8x8* from header data
+  )
+
+(defun font-draw (graph text x y &key (size 1))
+  "Draw TEXT at (X, Y) using the 8x8 bitmap font."
+  (declare (ignore graph text x y size))
+  ;; TODO: implement
+  )
+
+(defun font-measure (text &key (size 1))
+  "Return the pixel width of TEXT in the 8x8 font."
+  (declare (ignore size))
+  (* (length text) 8))
+
+(defun font-draw-matrix (graph text x y size)
+  "Draw TEXT using the MatrixChunky8 font."
+  (declare (ignore graph text x y size))
+  ;; TODO: implement
+  )
+
+(defun font-measure-matrix (text size)
+  "Return pixel width of TEXT in MatrixChunky8."
+  (declare (ignore size))
+  (* (length text) 10))

fedac/native/cl/framebuffer.lisp

···
+;;; Framebuffer — foreign-memory pixel buffer for DRM/fbdev
+
+(in-package :ac-native.framebuffer)
+
+(defstruct framebuffer
+  "A 2D pixel buffer backed by CFFI foreign memory (for DRM mmap compat)."
+  (pixels (cffi:null-pointer) :type cffi:foreign-pointer)
+  (width 0 :type fixnum)
+  (height 0 :type fixnum)
+  (stride 0 :type fixnum)  ; in pixels (= width for our buffers)
+  (owned t :type boolean))  ; if t, we allocated pixels and must free
+
+(defun fb-create (width height)
+  "Allocate a new framebuffer with WIDTH x HEIGHT pixels (ARGB32)."
+  (let* ((stride width)
+         (nbytes (* stride height 4))
+         (ptr (cffi:foreign-alloc :uint32 :count (* stride height) :initial-element 0)))
+    (make-framebuffer :pixels ptr :width width :height height
+                      :stride stride :owned t)))
+
+(defun fb-destroy (fb)
+  "Free the framebuffer's pixel memory (if we own it)."
+  (when (and fb (framebuffer-owned fb)
+               (not (cffi:null-pointer-p (framebuffer-pixels fb))))
+    (cffi:foreign-free (framebuffer-pixels fb))
+    (setf (framebuffer-pixels fb) (cffi:null-pointer))))
+
+(declaim (inline fb-pixel-offset))
+(defun fb-pixel-offset (fb x y)
+  (declare (optimize (speed 3) (safety 0))
+           (type fixnum x y)
+           (type framebuffer fb))
+  (the fixnum (+ x (* y (framebuffer-stride fb)))))
+
+(defun fb-clear (fb color-u32)
+  "Fill the entire framebuffer with a packed ARGB32 color."
+  (declare (optimize (speed 3) (safety 0))
+           (type (unsigned-byte 32) color-u32))
+  (let* ((n (* (framebuffer-stride fb) (framebuffer-height fb)))
+         (ptr (framebuffer-pixels fb)))
+    (dotimes (i n)
+      (setf (cffi:mem-aref ptr :uint32 i) color-u32))))
+
+(declaim (inline fb-put-pixel))
+(defun fb-put-pixel (fb x y color-u32)
+  "Write a pixel (no blending, no bounds check in optimized mode)."
+  (declare (optimize (speed 3) (safety 0))
+           (type fixnum x y)
+           (type (unsigned-byte 32) color-u32)
+           (type framebuffer fb))
+  (when (and (>= x 0) (< x (framebuffer-width fb))
+             (>= y 0) (< y (framebuffer-height fb)))
+    (setf (cffi:mem-aref (framebuffer-pixels fb) :uint32
+                         (fb-pixel-offset fb x y))
+          color-u32)))
+
+(defun fb-blend-pixel (fb x y src-color)
+  "Alpha-blend a color onto the framebuffer at (x, y)."
+  (declare (optimize (speed 3) (safety 0))
+           (type fixnum x y))
+  (when (and (>= x 0) (< x (framebuffer-width fb))
+             (>= y 0) (< y (framebuffer-height fb)))
+    (let* ((off (fb-pixel-offset fb x y))
+           (dst-u32 (cffi:mem-aref (framebuffer-pixels fb) :uint32 off))
+           (dst (make-color :r (ldb (byte 8 16) dst-u32)
+                            :g (ldb (byte 8 8) dst-u32)
+                            :b (ldb (byte 8 0) dst-u32)
+                            :a 255)))
+      (setf (cffi:mem-aref (framebuffer-pixels fb) :uint32 off)
+            (color-blend src-color dst)))))
+
+(defun fb-copy-scaled (src dst-ptr dst-w dst-h dst-stride scale)
+  "Copy SRC framebuffer to a foreign memory region at DST-PTR, scaling up by SCALE.
+   Used by DRM present to blit the small render buffer to the display."
+  (declare (optimize (speed 3) (safety 0))
+           (type fixnum dst-w dst-h dst-stride scale)
+           (type framebuffer src))
+  (let ((sw (framebuffer-width src))
+        (sh (framebuffer-height src))
+        (sp (framebuffer-pixels src)))
+    (dotimes (sy sh)
+      (dotimes (sx sw)
+        (let ((pixel (cffi:mem-aref sp :uint32 (+ sx (* sy sw)))))
+          ;; Replicate pixel into scale x scale block
+          (dotimes (dy scale)
+            (let ((oy (* (+ (* (+ (* sy scale) dy) 1) 0) 1))) ; row offset placeholder
+              (declare (ignore oy))
+              (let ((row (+ (* sy scale) dy)))
+                (when (< row dst-h)
+                  (dotimes (dx scale)
+                    (let ((col (+ (* sx scale) dx)))
+                      (when (< col dst-w)
+                        (setf (cffi:mem-aref dst-ptr :uint32
+                                             (+ col (* row dst-stride)))
+                              pixel)))))))))))))

fedac/native/cl/graph.lisp

···
+;;; Graphics primitives — wipe, ink, plot, line, box, circle
+
+(in-package :ac-native.graph)
+
+(defstruct graph
+  "Immediate-mode 2D graphics context."
+  (fb nil :type (or null ac-native.framebuffer:framebuffer))
+  (screen nil :type (or null ac-native.framebuffer:framebuffer))
+  (ink-color (make-color :r 255 :g 255 :b 255 :a 255) :type color))
+
+(defun graph-wipe (g color)
+  "Clear the screen with COLOR."
+  (fb-clear (graph-fb g) (color-pack-argb32 color)))
+
+(defun graph-ink (g color)
+  "Set the current drawing color."
+  (setf (graph-ink-color g) color))
+
+(defun graph-plot (g x y)
+  "Plot a single pixel at (X, Y) using the current ink."
+  (let ((c (graph-ink-color g)))
+    (if (= (color-a c) 255)
+        (fb-put-pixel (graph-fb g) x y (color-pack-argb32 c))
+        (fb-blend-pixel (graph-fb g) x y c))))
+
+(defun graph-line (g x0 y0 x1 y1)
+  "Draw a line from (X0,Y0) to (X1,Y1) using Bresenham's algorithm."
+  (declare (optimize (speed 3) (safety 1))
+           (type fixnum x0 y0 x1 y1))
+  (let ((dx (abs (- x1 x0)))
+        (dy (- (abs (- y1 y0))))
+        (sx (if (< x0 x1) 1 -1))
+        (sy (if (< y0 y1) 1 -1)))
+    (let ((err (+ dx dy))
+          (x x0) (y y0))
+      (declare (type fixnum err x y))
+      (loop
+        (graph-plot g x y)
+        (when (and (= x x1) (= y y1)) (return))
+        (let ((e2 (* 2 err)))
+          (when (>= e2 dy)
+            (incf err dy)
+            (incf x sx))
+          (when (<= e2 dx)
+            (incf err dx)
+            (incf y sy)))))))
+
+(defun graph-box (g x y w h &optional (filled t))
+  "Draw a rectangle. If FILLED, fill it; otherwise draw outline."
+  (declare (optimize (speed 3) (safety 1))
+           (type fixnum x y w h))
+  (let ((c (graph-ink-color g))
+        (fb (graph-fb g)))
+    (if filled
+        ;; Filled box — hot path, optimize
+        (let ((c32 (color-pack-argb32 c))
+              (opaque (= (color-a c) 255)))
+          (dotimes (row h)
+            (let ((py (+ y row)))
+              (when (and (>= py 0) (< py (fb-height fb)))
+                (dotimes (col w)
+                  (let ((px (+ x col)))
+                    (when (and (>= px 0) (< px (fb-width fb)))
+                      (if opaque
+                          (fb-put-pixel fb px py c32)
+                          (fb-blend-pixel fb px py c)))))))))
+        ;; Outline
+        (progn
+          (graph-line g x y (+ x w -1) y)
+          (graph-line g x (+ y h -1) (+ x w -1) (+ y h -1))
+          (graph-line g x y x (+ y h -1))
+          (graph-line g (+ x w -1) y (+ x w -1) (+ y h -1))))))
+
+(defun graph-circle (g cx cy r &optional (filled t))
+  "Draw a circle using the midpoint algorithm."
+  (declare (optimize (speed 3) (safety 1))
+           (type fixnum cx cy r))
+  (if filled
+      ;; Filled circle — draw horizontal spans
+      (let ((x 0) (y r) (d (- 1 r)))
+        (declare (type fixnum x y d))
+        (loop while (<= x y) do
+          (graph-line g (- cx x) (+ cy y) (+ cx x) (+ cy y))
+          (graph-line g (- cx x) (- cy y) (+ cx x) (- cy y))
+          (graph-line g (- cx y) (+ cy x) (+ cx y) (+ cy x))
+          (graph-line g (- cx y) (- cy x) (+ cx y) (- cy x))
+          (incf x)
+          (if (< d 0)
+              (incf d (+ (* 2 x) 1))
+              (progn (decf y) (incf d (+ (* 2 (- x y)) 1))))))
+      ;; Outline circle
+      (let ((x 0) (y r) (d (- 1 r)))
+        (declare (type fixnum x y d))
+        (loop while (<= x y) do
+          (graph-plot g (+ cx x) (+ cy y))
+          (graph-plot g (- cx x) (+ cy y))
+          (graph-plot g (+ cx x) (- cy y))
+          (graph-plot g (- cx x) (- cy y))
+          (graph-plot g (+ cx y) (+ cy x))
+          (graph-plot g (- cx y) (+ cy x))
+          (graph-plot g (+ cx y) (- cy x))
+          (graph-plot g (- cx y) (- cy x))
+          (incf x)
+          (if (< d 0)
+              (incf d (+ (* 2 x) 1))
+              (progn (decf y) (incf d (+ (* 2 (- x y)) 1))))))))

fedac/native/cl/input-keycodes.lisp

···
+;;; Linux input keycodes
+
+(in-package :ac-native.input)
+
+(defconstant +key-esc+ 1)
+(defconstant +key-1+ 2)
+(defconstant +key-backspace+ 14)
+(defconstant +key-tab+ 15)
+(defconstant +key-enter+ 28)
+(defconstant +key-leftctrl+ 29)
+(defconstant +key-a+ 30)
+(defconstant +key-space+ 57)
+(defconstant +key-f1+ 59)
+(defconstant +key-up+ 103)
+(defconstant +key-left+ 105)
+(defconstant +key-right+ 106)
+(defconstant +key-down+ 108)
+(defconstant +key-home+ 102)
+(defconstant +key-end+ 107)
+(defconstant +key-power+ 116)
+
+;;; Event types
+(defconstant +ev-key+ 1)
+(defconstant +ev-rel+ 2)
+(defconstant +ev-abs+ 3)
+
+;;; struct input_event (24 bytes on x86-64)
+(cffi:defcstruct input-event
+  (tv-sec :long)
+  (tv-usec :long)
+  (type :uint16)
+  (code :uint16)
+  (value :int32))

fedac/native/cl/input.lisp

···
+;;; Input — evdev keyboard/mouse/touch
+
+(in-package :ac-native.input)
+
+(defstruct ac-input
+  "Input subsystem state."
+  (fds (make-array 16 :element-type 'fixnum :initial-element -1))
+  (fd-count 0 :type fixnum)
+  (display-w 0 :type fixnum)
+  (display-h 0 :type fixnum)
+  (pixel-scale 1 :type fixnum))
+
+(defstruct event
+  "An input event."
+  (type :none :type keyword)  ; :key-down :key-up :touch :draw :lift
+  (key nil)                    ; key name string
+  (code 0 :type fixnum)        ; raw keycode
+  (x 0 :type fixnum)
+  (y 0 :type fixnum))
+
+(defun input-init (display-w display-h pixel-scale)
+  "Open all /dev/input/event* devices."
+  (let ((input (make-ac-input :display-w display-w :display-h display-h
+                               :pixel-scale pixel-scale)))
+    ;; Scan /dev/input/ for event devices
+    (loop for i from 0 to 15
+          for path = (format nil "/dev/input/event~D" i)
+          for fd = (ac-native.syscalls:sys-open path
+                     (logior ac-native.syscalls:+o-rdonly+
+                             ac-native.syscalls:+o-nonblock+)
+                     0)
+          when (>= fd 0) do
+            (setf (aref (ac-input-fds input) (ac-input-fd-count input)) fd)
+            (incf (ac-input-fd-count input))
+            (ac-native.util:ac-log "[input] opened ~A (fd ~D)~%" path fd))
+    (ac-native.util:ac-log "[input] ~D event devices~%" (ac-input-fd-count input))
+    input))
+
+(defun input-poll (input)
+  "Poll all input devices, return a list of events."
+  (let ((events nil))
+    (dotimes (i (ac-input-fd-count input))
+      (let ((fd (aref (ac-input-fds input) i)))
+        (cffi:with-foreign-object (ev '(:struct input-event))
+          (loop for n = (ac-native.syscalls:sys-read
+                         fd ev (cffi:foreign-type-size '(:struct input-event)))
+                while (= n (cffi:foreign-type-size '(:struct input-event))) do
+                  (let ((type (cffi:foreign-slot-value ev '(:struct input-event) 'type))
+                        (code (cffi:foreign-slot-value ev '(:struct input-event) 'code))
+                        (value (cffi:foreign-slot-value ev '(:struct input-event) 'value)))
+                    (when (= type +ev-key+)
+                      (push (make-event
+                             :type (if (plusp value) :key-down :key-up)
+                             :code code)
+                            events)))))))
+    (nreverse events)))
+
+(defun input-destroy (input)
+  "Close all input fds."
+  (when input
+    (dotimes (i (ac-input-fd-count input))
+      (let ((fd (aref (ac-input-fds input) i)))
+        (when (>= fd 0)
+          (ac-native.syscalls:sys-close fd))))))

fedac/native/cl/main.lisp

···
+;;; Main entry point — AC Native OS (Common Lisp edition)
+
+(in-package :ac-native)
+
+(defvar *running* t "Main loop flag.")
+
+(defun compute-pixel-scale (display-w)
+  "Compute pixel scale targeting ~300px wide."
+  (let ((target (max 1 (min 16 (floor display-w 300)))))
+    ;; Prefer clean divisors within ±3
+    (loop for delta from 0 to 3 do
+      (let ((s (+ target delta)))
+        (when (and (>= s 1) (<= s 16)
+                   (zerop (mod display-w s)))
+          (return-from compute-pixel-scale s)))
+      (let ((s (- target delta)))
+        (when (and (>= s 1)
+                   (zerop (mod display-w s)))
+          (return-from compute-pixel-scale s))))
+    target))
+
+(defun mount-minimal-fs ()
+  "Mount essential pseudo-filesystems (PID 1 only)."
+  (ac-native.syscalls:sys-mount "proc" "/proc" "proc")
+  (ac-native.syscalls:sys-mount "sysfs" "/sys" "sysfs")
+  (ac-native.syscalls:sys-mount "devtmpfs" "/dev" "devtmpfs")
+  (ac-log "mounted proc, sysfs, devtmpfs~%"))
+
+(defun main ()
+  "AC Native OS entry point."
+  (ac-log "~%═══════════════════════════════════════~%")
+  (ac-log "  AC Native OS (Common Lisp)~%")
+  (ac-log "  SBCL ~A~%" (lisp-implementation-version))
+  (ac-log "═══════════════════════════════════════~%~%")
+
+  ;; PID 1 duties
+  (when (= (ac-native.syscalls:sys-getpid) 1)
+    (mount-minimal-fs))
+
+  ;; Init display
+  (let ((display (ac-native.drm:drm-init)))
+    (unless display
+      (ac-log "FATAL: no display~%")
+      (return-from main 1))
+
+    (let* ((dw (ac-native.drm:display-width display))
+           (dh (ac-native.drm:display-height display))
+           (scale (compute-pixel-scale dw))
+           (sw (floor dw scale))
+           (sh (floor dh scale))
+           (screen (fb-create sw sh))
+           (graph (make-graph :fb screen :screen screen)))
+
+      (ac-log "display: ~Dx~D  scale: ~D  screen: ~Dx~D~%"
+              dw dh scale sw sh)
+
+      ;; Main loop
+      (setf *running* t)
+      (unwind-protect
+          (loop while *running* do
+            ;; TODO: input-poll
+            ;; TODO: js-call-act
+            ;; TODO: js-call-sim
+
+            ;; Demo: cycle background color
+            (let* ((t-ms (monotonic-time-ms))
+                   (r (floor (+ 128 (* 127 (sin (* t-ms 0.001))))))
+                   (g (floor (+ 128 (* 127 (sin (* t-ms 0.0013))))))
+                   (b (floor (+ 128 (* 127 (sin (* t-ms 0.0017)))))))
+              (graph-wipe graph (make-color :r r :g g :b b))
+              ;; Draw a box in the center
+              (graph-ink graph (make-color :r 255 :g 255 :b 255 :a 200))
+              (graph-box graph (- (floor sw 2) 20) (- (floor sh 2) 20) 40 40)
+              ;; Draw a circle
+              (graph-ink graph (make-color :r 255 :g 100 :b 50))
+              (graph-circle graph (floor sw 2) (floor sh 2) 15))
+
+            ;; Present
+            (ac-native.drm:drm-present display screen scale)
+            (frame-sync-60fps))
+
+        ;; Cleanup
+        (fb-destroy screen)
+        (ac-native.drm:drm-destroy display)
+        (ac-log "shutdown complete~%")))))

fedac/native/cl/packages.lisp

···
+;;; Package definitions for AC Native OS
+
+(defpackage :ac-native.util
+  (:use :cl)
+  (:export #:ac-log #:monotonic-time-ms #:frame-sync-60fps))
+
+(defpackage :ac-native.syscalls
+  (:use :cl :cffi)
+  (:export #:sys-open #:sys-close #:sys-read #:sys-write
+           #:sys-ioctl #:sys-mmap #:sys-munmap
+           #:sys-mount #:sys-umount
+           #:sys-reboot #:sys-poweroff
+           #:+o-rdonly+ #:+o-rdwr+ #:+o-nonblock+ #:+o-cloexec+
+           #:+prot-read+ #:+prot-write+ #:+map-shared+
+           #:+clock-monotonic+))
+
+(defpackage :ac-native.color
+  (:use :cl)
+  (:export #:make-color #:color-r #:color-g #:color-b #:color-a
+           #:color-pack-argb32 #:color-blend))
+
+(defpackage :ac-native.framebuffer
+  (:use :cl :cffi :ac-native.color)
+  (:export #:make-framebuffer #:fb-create #:fb-destroy
+           #:fb-width #:fb-height #:fb-stride #:fb-pixels
+           #:fb-clear #:fb-put-pixel #:fb-blend-pixel
+           #:fb-copy-scaled))
+
+(defpackage :ac-native.drm
+  (:use :cl :cffi :ac-native.syscalls :ac-native.framebuffer)
+  (:export #:drm-init #:drm-destroy #:drm-present #:drm-flip
+           #:display-width #:display-height))
+
+(defpackage :ac-native.graph
+  (:use :cl :ac-native.color :ac-native.framebuffer)
+  (:export #:make-graph #:graph-wipe #:graph-ink
+           #:graph-plot #:graph-line #:graph-box #:graph-circle))
+
+(defpackage :ac-native.font
+  (:use :cl :ac-native.graph :ac-native.framebuffer)
+  (:export #:font-init #:font-draw #:font-measure
+           #:font-draw-matrix #:font-measure-matrix))
+
+(defpackage :ac-native.input
+  (:use :cl :cffi :ac-native.syscalls)
+  (:export #:input-init #:input-destroy #:input-poll
+           #:make-event #:event-type #:event-key #:event-x #:event-y))
+
+(defpackage :ac-native.alsa
+  (:use :cl :cffi)
+  (:export #:pcm-open #:pcm-close #:pcm-writei #:pcm-prepare
+           #:pcm-set-params #:mixer-set-capture-volume))
+
+(defpackage :ac-native.audio
+  (:use :cl :cffi :bordeaux-threads
+        :ac-native.alsa :ac-native.util)
+  (:export #:audio-init #:audio-destroy
+           #:audio-synth #:audio-synth-kill
+           #:audio-sample-play #:audio-sample-load-data))
+
+(defpackage :ac-native.config
+  (:use :cl)
+  (:export #:load-config #:config-handle #:config-piece))
+
+(defpackage :ac-native
+  (:use :cl :ac-native.util :ac-native.color :ac-native.framebuffer
+        :ac-native.drm :ac-native.graph :ac-native.font
+        :ac-native.input :ac-native.audio :ac-native.config)
+  (:export #:main))
+
+(defpackage :ac-native.build
+  (:use :cl)
+  (:export #:build))

fedac/native/cl/syscalls.lisp

···
+;;; Linux syscall bindings via CFFI
+
+(in-package :ac-native.syscalls)
+
+;;; File operations
+(cffi:defcfun ("open" sys-open) :int
+  (pathname :string) (flags :int) (mode :int))
+
+(cffi:defcfun ("close" sys-close) :int (fd :int))
+
+(cffi:defcfun ("read" sys-read) :long
+  (fd :int) (buf :pointer) (count :unsigned-long))
+
+(cffi:defcfun ("write" sys-write) :long
+  (fd :int) (buf :pointer) (count :unsigned-long))
+
+(cffi:defcfun ("ioctl" sys-ioctl) :int
+  (fd :int) (request :unsigned-long) &rest)
+
+;;; Memory mapping
+(cffi:defcfun ("mmap" sys-mmap) :pointer
+  (addr :pointer) (length :unsigned-long) (prot :int)
+  (flags :int) (fd :int) (offset :long))
+
+(cffi:defcfun ("munmap" sys-munmap) :int
+  (addr :pointer) (length :unsigned-long))
+
+;;; Filesystem
+(cffi:defcfun ("mount" %mount) :int
+  (source :string) (target :string) (fstype :string)
+  (flags :unsigned-long) (data :pointer))
+
+(defun sys-mount (source target fstype &optional (flags 0))
+  (%mount source target fstype flags (cffi:null-pointer)))
+
+(cffi:defcfun ("umount" sys-umount) :int (target :string))
+
+;;; System control
+(cffi:defcfun ("reboot" %reboot) :int (cmd :int))
+
+(defconstant +reboot-power-off+ #x4321FEDC)
+(defconstant +reboot-restart+ #x01234567)
+
+(defun sys-poweroff ()
+  ;; sync first
+  (cffi:foreign-funcall "sync" :void)
+  (%reboot +reboot-power-off+))
+
+(defun sys-reboot ()
+  (cffi:foreign-funcall "sync" :void)
+  (%reboot +reboot-restart+))
+
+;;; Process
+(cffi:defcfun ("getpid" sys-getpid) :int)
+(cffi:defcfun ("fork" sys-fork) :int)
+(cffi:defcfun ("execvp" sys-execvp) :int
+  (file :string) (argv :pointer))
+(cffi:defcfun ("waitpid" sys-waitpid) :int
+  (pid :int) (status :pointer) (options :int))
+
+;;; Constants
+(defconstant +o-rdonly+ 0)
+(defconstant +o-wronly+ 1)
+(defconstant +o-rdwr+ 2)
+(defconstant +o-nonblock+ #o4000)
+(defconstant +o-cloexec+ #o2000000)
+
+(defconstant +prot-read+ 1)
+(defconstant +prot-write+ 2)
+(defconstant +map-shared+ 1)
+
+(defconstant +clock-monotonic+ 1)

fedac/native/cl/util.lisp

···
+;;; Utility functions — logging, timing
+
+(in-package :ac-native.util)
+
+(defvar *log-stream* *error-output*
+  "Where ac-log writes. Rebound to a file stream when USB is mounted.")
+
+(defvar *log-file* nil "Open file stream for USB log, or nil.")
+
+(defun ac-log (fmt &rest args)
+  "Log a message to stderr and optionally to USB log file."
+  (let ((msg (apply #'format nil fmt args)))
+    (write-string msg *error-output*)
+    (force-output *error-output*)
+    (when *log-file*
+      (write-string msg *log-file*)
+      (force-output *log-file*))))
+
+(defun open-usb-log (path)
+  "Open a log file on the USB drive (append mode)."
+  (setf *log-file* (open path :direction :output
+                               :if-exists :append
+                               :if-does-not-exist :create)))
+
+(defun close-usb-log ()
+  (when *log-file*
+    (close *log-file*)
+    (setf *log-file* nil)))
+
+;;; Monotonic clock
+
+(cffi:defcfun ("clock_gettime" %clock-gettime) :int
+  (clk-id :int)
+  (tp :pointer))
+
+(defconstant +clock-monotonic+ 1)
+
+(defun monotonic-time-ms ()
+  "Return monotonic time in milliseconds as a double-float."
+  (cffi:with-foreign-object (ts '(:struct timespec))
+    (%clock-gettime +clock-monotonic+ ts)
+    (let ((sec (cffi:foreign-slot-value ts '(:struct timespec) 'tv-sec))
+          (nsec (cffi:foreign-slot-value ts '(:struct timespec) 'tv-nsec)))
+      (+ (* sec 1000.0d0) (/ nsec 1000000.0d0)))))
+
+(cffi:defcstruct timespec
+  (tv-sec :long)
+  (tv-nsec :long))
+
+(cffi:defcfun ("clock_nanosleep" %clock-nanosleep) :int
+  (clk-id :int)
+  (flags :int)
+  (request :pointer)
+  (remain :pointer))
+
+(defconstant +timer-abstime+ 1)
+
+(defvar *frame-target-ns* (floor 1000000000 60)
+  "Nanoseconds per frame at 60fps.")
+
+(defvar *next-frame-sec* 0)
+(defvar *next-frame-nsec* 0)
+
+(defun frame-sync-60fps ()
+  "Sleep until the next 60fps frame boundary. Call once per frame."
+  (incf *next-frame-nsec* *frame-target-ns*)
+  (when (>= *next-frame-nsec* 1000000000)
+    (decf *next-frame-nsec* 1000000000)
+    (incf *next-frame-sec*))
+  ;; Initialize on first call
+  (when (zerop *next-frame-sec*)
+    (cffi:with-foreign-object (ts '(:struct timespec))
+      (%clock-gettime +clock-monotonic+ ts)
+      (setf *next-frame-sec*
+            (cffi:foreign-slot-value ts '(:struct timespec) 'tv-sec))
+      (setf *next-frame-nsec*
+            (cffi:foreign-slot-value ts '(:struct timespec) 'tv-nsec))
+      (return-from frame-sync-60fps)))
+  ;; Sleep until target time
+  (cffi:with-foreign-object (ts '(:struct timespec))
+    (setf (cffi:foreign-slot-value ts '(:struct timespec) 'tv-sec) *next-frame-sec*)
+    (setf (cffi:foreign-slot-value ts '(:struct timespec) 'tv-nsec) *next-frame-nsec*)
+    (%clock-nanosleep +clock-monotonic+ +timer-abstime+ ts (cffi:null-pointer))))