changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: add static-vector

changeset 695: 2bad47888dbf
parent 694: a36280d2ef4e
child 696: 38e9c3be2392
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 16:14:44 -0400
files: lisp/bin/skel.lisp lisp/ffi/sndfile/pkg.lisp lisp/lib/io/fast.lisp lisp/lib/io/pkg.lisp lisp/lib/io/ring.lisp lisp/lib/io/static-vector.lisp lisp/lib/packy/pkg.lisp lisp/lib/skel/core/obj.lisp lisp/lisp.sk lisp/std/alien.lisp lisp/std/pkg.lisp
description: add static-vector
     1.1--- a/lisp/bin/skel.lisp	Thu Oct 03 21:54:07 2024 -0400
     1.2+++ b/lisp/bin/skel.lisp	Fri Oct 04 16:14:44 2024 -0400
     1.3@@ -181,7 +181,7 @@
     1.4 
     1.5 (defcmd skc-make
     1.6   (let ((sk (find-skelfile #P"." :load t)))
     1.7-    (sb-ext:enable-debugger)
     1.8+    ;; (sb-ext:enable-debugger)
     1.9     (log:debug! "cli args" *args*)
    1.10     ;; (setq *no-exit* t)
    1.11     (if *args*
     2.1--- a/lisp/ffi/sndfile/pkg.lisp	Thu Oct 03 21:54:07 2024 -0400
     2.2+++ b/lisp/ffi/sndfile/pkg.lisp	Fri Oct 04 16:14:44 2024 -0400
     2.3@@ -13,6 +13,10 @@
     2.4 
     2.5 (define-alien-loader "sndfile" t "/usr/lib/")
     2.6 
     2.7+(define-opaque sndfile t)
     2.8+
     2.9+(define-opaque sf-chunk-iterator)
    2.10+
    2.11 (define-alien-type sf-count long)
    2.12 
    2.13 (define-alien-type sf-info
    2.14@@ -273,8 +277,6 @@
    2.15                    :set-add-dither-on-read #x1071)
    2.16 
    2.17 ;;; Functions
    2.18-(define-opaque sndfile t)
    2.19-
    2.20 (define-alien-routine sf-open (* sndfile) (path c-string) (mode int) (sfinfo (* sf-info)))
    2.21 (define-alien-routine sf-open-fd (* sndfile) (fd int) (mode int) (sfinfo (* sf-info)))
    2.22 (define-alien-routine sf-error int (sndfile (* sndfile)))
    2.23@@ -309,8 +311,6 @@
    2.24   (sndfile (* sndfile))
    2.25   (chunk-info (* sf-chunk-info)))
    2.26 
    2.27-(define-opaque sf-chunk-iterator)
    2.28-
    2.29 (define-alien-routine sf-get-chunk-iterator (* sf-chunk-iterator)
    2.30   (sndfile (* sndfile))
    2.31   (chunk-info (* sf-chunk-info)))
     3.1--- a/lisp/lib/io/fast.lisp	Thu Oct 03 21:54:07 2024 -0400
     3.2+++ b/lisp/lib/io/fast.lisp	Fri Oct 04 16:14:44 2024 -0400
     3.3@@ -47,9 +47,10 @@
     3.4              (type octet-vector vec)
     3.5              (type non-negative-fixnum pos vec-len new-pos))
     3.6     ;; Only need to update if pos or new-pos is in stream range.
     3.7-    (when-let ((stream-update-needed? (or (> pos vec-len)
     3.8-                                          (> new-pos vec-len)))
     3.9-               (stream (input-buffer-stream buffer)))
    3.10+    (when-let ((stream (and
    3.11+                        (or (> pos vec-len)
    3.12+                            (> new-pos vec-len))
    3.13+                        (input-buffer-stream buffer))))
    3.14       (let* ((stream-file-pos (file-position stream))
    3.15              (pos-diff (- new-pos pos))
    3.16              (stream-diff (cond ((and (> pos vec-len)
    3.17@@ -78,12 +79,9 @@
    3.18 (defun concat-buffer (buffer)
    3.19   (let* ((len (output-buffer-len buffer))
    3.20          (array
    3.21-           #+fast-io-sv
    3.22            (if (eq :static (output-buffer-output buffer))
    3.23-               (static-vectors:make-static-vector (the array-index len))
    3.24-               (make-octet-vector len))
    3.25-           #-fast-io-sv
    3.26-           (make-octet-vector len)))
    3.27+               (make-static-vector (the array-index len))
    3.28+               (make-octet-vector len))))
    3.29     (loop as i = 0 then (+ i (length a))
    3.30           for a in (output-buffer-queue buffer) do
    3.31             (replace (the octet-vector array)
    3.32@@ -369,7 +367,7 @@
    3.33 
    3.34 ;; fast-stream
    3.35 
    3.36-(defclass fast-io-stream (fundamental-stream)
    3.37+(defclass fast-io-stream (sb-gray:fundamental-stream)
    3.38   ((openp :type boolean :initform t)))
    3.39 
    3.40 (defmethod stream-file-position ((stream fast-io-stream))
    3.41@@ -381,7 +379,7 @@
    3.42 
    3.43  ;; fast-output-stream
    3.44 
    3.45-(defclass fast-output-stream (fast-io-stream fundamental-output-stream)
    3.46+(defclass fast-output-stream (fast-io-stream sb-gray:fundamental-output-stream)
    3.47   ((buffer :type output-buffer)))
    3.48 
    3.49 (defmethod initialize-instance ((self fast-output-stream) &key stream
    3.50@@ -424,7 +422,7 @@
    3.51 
    3.52  ;; fast-input-stream
    3.53 
    3.54-(defclass fast-input-stream (fast-io-stream fundamental-input-stream)
    3.55+(defclass fast-input-stream (fast-io-stream sb-gray:fundamental-input-stream)
    3.56   ((buffer :type input-buffer)))
    3.57 
    3.58 (defmethod initialize-instance ((self fast-input-stream) &key stream
     4.1--- a/lisp/lib/io/pkg.lisp	Thu Oct 03 21:54:07 2024 -0400
     4.2+++ b/lisp/lib/io/pkg.lisp	Fri Oct 04 16:14:44 2024 -0400
     4.3@@ -16,8 +16,26 @@
     4.4   (:use :cl :std/condition)
     4.5   (:export :io-error))
     4.6 
     4.7+(defpackage :io/static-vector
     4.8+  (:use :cl :std :sb-alien)
     4.9+  (:shadow :constantp)
    4.10+  (:export
    4.11+   ;; Constructors and destructors
    4.12+   :make-static-vector
    4.13+   :free-static-vector
    4.14+   :with-static-vector
    4.15+   :with-static-vectors
    4.16+   ;; Accessors
    4.17+   :static-vector-pointer
    4.18+   ;; Alien wrapper type
    4.19+   :static-vector
    4.20+   ;; Foreign memory operations
    4.21+   :replace-foreign-memory
    4.22+   :fill-foreign-memory))
    4.23+
    4.24 (defpackage :io/fast
    4.25   (:use :cl :std :io/proto)
    4.26+  (:import-from :io/static-vector :make-static-vector)
    4.27   (:export
    4.28    #:fast-read-byte #:fast-write-byte
    4.29    #:fast-read-sequence #:fast-write-sequence
     5.1--- a/lisp/lib/io/ring.lisp	Thu Oct 03 21:54:07 2024 -0400
     5.2+++ b/lisp/lib/io/ring.lisp	Fri Oct 04 16:14:44 2024 -0400
     5.3@@ -19,4 +19,3 @@
     5.4 
     5.5 ;; (defun enter-io (ring))
     5.6 ;; (defun exit-io (ring))
     5.7-
     6.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2+++ b/lisp/lib/io/static-vector.lisp	Fri Oct 04 16:14:44 2024 -0400
     6.3@@ -0,0 +1,299 @@
     6.4+;;; static-vector.lisp --- Static Vectors
     6.5+
     6.6+;; Vectors allocated in static memory. Useful for things like IO buffers
     6.7+;; created from Lisp and shared with C code.
     6.8+
     6.9+;;; Commentary:
    6.10+
    6.11+;; The source here is pulled directly from the STATIC-VECTORS package on
    6.12+;; Quicklisp: https://github.com/sionescu/static-vectors
    6.13+
    6.14+;;; Code:
    6.15+(in-package :io/static-vector)
    6.16+;;; --- Checking for compile-time constants and evaluating such forms
    6.17+
    6.18+(defun quotedp (form)
    6.19+  (and (listp form)
    6.20+       (= 2 (length form))
    6.21+       (eql 'quote (car form))))
    6.22+
    6.23+(defun constantp (form &optional env)
    6.24+  (let ((form (if (symbolp form)
    6.25+                  (macroexpand form env)
    6.26+                  form)))
    6.27+    (or (quotedp form)
    6.28+        (cl:constantp form))))
    6.29+
    6.30+(defun eval-constant (form &optional env)
    6.31+  (declare (ignorable env))
    6.32+  (cond
    6.33+    ((quotedp form)
    6.34+     (second form))
    6.35+    (t
    6.36+     #+clozure
    6.37+     (ccl::eval-constant form)
    6.38+     #+sbcl
    6.39+     (sb-int:constant-form-value form env)
    6.40+     #-(or clozure sbcl)
    6.41+     (eval form))))
    6.42+
    6.43+(defun canonicalize-args (env element-type length)
    6.44+  (let* ((eltype-spec (or (and (constantp element-type)
    6.45+                               (ignore-errors
    6.46+                                (upgraded-array-element-type
    6.47+                                 (eval-constant element-type))))
    6.48+                          '*))
    6.49+         (length-spec (if (constantp length env)
    6.50+                          `,(eval-constant length env)
    6.51+                          '*))
    6.52+         (type-decl (if (eql '* eltype-spec)
    6.53+                        'simple-array
    6.54+                        `(simple-array ,eltype-spec (,length-spec)))))
    6.55+    (values (if (eql '* eltype-spec)
    6.56+                element-type
    6.57+                `(quote ,eltype-spec))
    6.58+            (if (eql '* length-spec)
    6.59+                length
    6.60+                length-spec)
    6.61+            type-decl)))
    6.62+
    6.63+;;; --- SBCL implementation
    6.64+(declaim (inline fill-foreign-memory))
    6.65+(defun fill-foreign-memory (pointer length value)
    6.66+  "Fill LENGTH octets in foreign memory area POINTER with VALUE."
    6.67+  (std/alien:memset pointer value length)
    6.68+  pointer)
    6.69+
    6.70+(declaim (inline replace-foreign-memory))
    6.71+(defun replace-foreign-memory (dst-ptr src-ptr length)
    6.72+  "Copy LENGTH octets from foreign memory area SRC-PTR to DST-PTR."
    6.73+  (std/alien:memcpy dst-ptr src-ptr length)
    6.74+  dst-ptr)
    6.75+
    6.76+;;; We have to handle all the low-level bits including setting the array header
    6.77+;;; and keeping around the info about the original pointer returned by the
    6.78+;;; foreign allocator.
    6.79+;;;
    6.80+;;; It goes like this:
    6.81+;;;
    6.82+;;; 1. Compute the data size for the Lisp-visible memory (that means an extra #\Nul
    6.83+;;;    at the end for strings)
    6.84+;;; 2. Sum the data size, the SBCL header size, and our extra header size to get
    6.85+;;;    the total foreign size required
    6.86+;;; 3. Adjust the total foreign size to the required alignment, compute the header offset
    6.87+;;;    and write the headers.
    6.88+;;;
    6.89+;;; Array layout:
    6.90+;;;
    6.91+;;;    +-------------------+
    6.92+;;;    | Allocated address | <-- Original pointer
    6.93+;;;    +-------------------+
    6.94+;;;    | Start gap ...     | <-- For large alignments, there's a gap between
    6.95+;;;    |                   |     the data block and the headers.
    6.96+;;;    +-------------------+
    6.97+;;;    | SV header         | <-- The offset from the original pointer (DWORD)
    6.98+;;;    +-------------------+
    6.99+;;;    | Lisp array header | <-- Array element-type and size (DWORD)
   6.100+;;;    +-------------------+
   6.101+;;;    | Lisp array data   | <-- Lisp-visible data
   6.102+;;;    +-------------------+
   6.103+;;;
   6.104+;;; There's no end gap because when a alignment is requested,
   6.105+;;; the requested size must also be a multiple of the alignment.
   6.106+
   6.107+(defconstant +array-header-size+
   6.108+  (* sb-vm:vector-data-offset sb-vm:n-word-bytes))
   6.109+
   6.110+(declaim (inline vector-widetag-and-n-bytes))
   6.111+(defun vector-widetag-and-n-bytes (type)
   6.112+  "Returns the widetag and octet size of the upgraded array element type
   6.113+for a given type specifier."
   6.114+  (let ((upgraded-type (upgraded-array-element-type type)))
   6.115+    (case upgraded-type
   6.116+      ((nil t) (error "~A is not a specializable array element type" type))
   6.117+      (t
   6.118+       #+#.(cl:if (cl:find-symbol "%VECTOR-WIDETAG-AND-N-BITS" "SB-IMPL")
   6.119+                  '(and) '(or))
   6.120+       (sb-impl::%vector-widetag-and-n-bits type)
   6.121+       #+#.(cl:if (cl:find-symbol "%VECTOR-WIDETAG-AND-N-BITS-SHIFT" "SB-IMPL")
   6.122+                  '(and) '(or))
   6.123+       (multiple-value-bind (widetag shift)
   6.124+           (sb-impl::%vector-widetag-and-n-bits-shift type)
   6.125+         (values widetag (expt 2 (- shift 3))))))))
   6.126+
   6.127+(declaim (inline align))
   6.128+(defun align (size boundary)
   6.129+  (* boundary
   6.130+     (ceiling size boundary)))
   6.131+
   6.132+(declaim (inline %memalign))
   6.133+(defun %memalign (size alignment)
   6.134+  (with-alien ((box (* t)))
   6.135+    (let ((errno (std/alien:posix-memalign box alignment size)))
   6.136+      (when (not (zerop errno))
   6.137+        (error "posix_memalign() returned error ~A" errno))
   6.138+      ;; (mem-ref box :pointer)
   6.139+      (deref box))))
   6.140+
   6.141+(defun %allocate-static-vector (length element-type alignment)
   6.142+  (declare (type (unsigned-byte 16) alignment))
   6.143+  (flet ((allocation-sizes (length widetag n-bytes)
   6.144+           (values
   6.145+            ;; We're allocating two headers: one for SBCL and
   6.146+            ;; the other one for our bookkeeping.
   6.147+            (align (* 2 +array-header-size+) alignment)
   6.148+            ;; Align data size.
   6.149+            (align
   6.150+             (* (if (= widetag sb-vm:simple-character-string-widetag)
   6.151+                    (1+ length)         ; for the final #\Nul
   6.152+                    length)
   6.153+                n-bytes)
   6.154+             alignment))))
   6.155+    (multiple-value-bind (widetag n-bytes)
   6.156+        (vector-widetag-and-n-bytes element-type)
   6.157+      (multiple-value-bind (header-size data-size)
   6.158+          (allocation-sizes length widetag n-bytes)
   6.159+        (let* ((total-size (+ header-size data-size))
   6.160+               (foreign-block (%memalign total-size alignment))
   6.161+               (data-offset header-size )
   6.162+               (lisp-header-offset
   6.163+                 (- data-offset +array-header-size+))
   6.164+               (lisp-header-pointer
   6.165+                 (sb-sys:sap+ foreign-block lisp-header-offset))
   6.166+               (extra-header-offset
   6.167+                 (- data-offset (* 2 +array-header-size+)))
   6.168+               (extra-header-pointer
   6.169+                 (sb-sys:sap+ foreign-block extra-header-offset)))
   6.170+          ;; Write Lisp header: tag and length
   6.171+          (setf (sb-sys:sap-ref-word lisp-header-pointer 0) widetag)
   6.172+          (setf (sb-sys:sap-ref-word lisp-header-pointer sb-vm:n-word-bytes)
   6.173+                (sb-vm:fixnumize length))
   6.174+          ;; Save the relative position from the start of the foreign block
   6.175+          (setf (sb-sys:sap-ref-word extra-header-pointer 0)
   6.176+                (- data-offset (* 2 +array-header-size+)))
   6.177+          ;; Instantiate Lisp object
   6.178+          (sb-kernel:%make-lisp-obj (logior (sb-sys:sap-int lisp-header-pointer)
   6.179+                                            sb-vm:other-pointer-lowtag)))))))
   6.180+
   6.181+(declaim (inline static-vector-address))
   6.182+(defun static-vector-address (vector)
   6.183+  "Return a foreign pointer to start of the Lisp VECTOR(including its header).
   6.184+VECTOR must be a vector created by MAKE-STATIC-VECTOR."
   6.185+  (logandc2 (sb-kernel:get-lisp-obj-address vector)
   6.186+            sb-vm:lowtag-mask))
   6.187+
   6.188+(declaim (inline static-vector-pointer))
   6.189+(defun static-vector-pointer (vector &key (offset 0))
   6.190+  "Return a foreign pointer to the beginning of VECTOR + OFFSET octets.
   6.191+VECTOR must be a vector created by MAKE-STATIC-VECTOR."
   6.192+  (check-type offset unsigned-byte)
   6.193+  (sb-sys:int-sap (+ (static-vector-address vector)
   6.194+                   +array-header-size+
   6.195+                   offset)))
   6.196+
   6.197+(declaim (inline free-static-vector))
   6.198+(defun free-static-vector (vector)
   6.199+  "Free VECTOR, which must be a vector created by MAKE-STATIC-VECTOR."
   6.200+  (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
   6.201+  (let* ((extra-header-pointer
   6.202+           (sb-sys:int-sap (- (static-vector-address vector) +array-header-size+)))
   6.203+         (start-offset
   6.204+           (sb-sys:sap-ref-word extra-header-pointer 0)))
   6.205+    (free-alien (sap-alien (sb-sys:sap+ extra-header-pointer (- start-offset)) (* (unsigned 8)))))
   6.206+  (values))
   6.207+
   6.208+(defmacro with-static-vector ((var length &rest args
   6.209+                               &key (element-type ''(unsigned-byte 8))
   6.210+                                 initial-contents initial-element)
   6.211+                              &body body &environment env)
   6.212+  "Bind PTR-VAR to a static vector of length LENGTH and execute BODY
   6.213+within its dynamic extent. The vector is freed upon exit."
   6.214+  (declare (ignorable element-type initial-contents initial-element))
   6.215+  (multiple-value-bind (real-element-type length type-spec)
   6.216+      (canonicalize-args env element-type length)
   6.217+    (let ((args (copy-list args)))
   6.218+      (remf args :element-type)
   6.219+      `(sb-sys:without-interrupts
   6.220+         (let ((,var (make-static-vector ,length ,@args
   6.221+                                         :element-type ,real-element-type)))
   6.222+           (declare (type ,type-spec ,var))
   6.223+           (unwind-protect
   6.224+                (sb-sys:with-local-interrupts ,@body)
   6.225+             (when ,var (free-static-vector ,var))))))))
   6.226+
   6.227+
   6.228+;;; --- MAKE-STATIC-VECTOR
   6.229+(declaim (inline check-initial-element))
   6.230+(defun check-initial-element (element-type initial-element)
   6.231+  (when (not (typep initial-element element-type))
   6.232+    ;; FIXME: signal SUBTYPE-ERROR
   6.233+    (error "MAKE-STATIC-VECTOR: The type of :INITIAL-ELEMENT ~S is not a subtype ~
   6.234+of the array's :ELEMENT-TYPE ~S"
   6.235+           initial-element element-type)))
   6.236+
   6.237+(declaim (inline check-initial-contents))
   6.238+(defun check-initial-contents (length initial-contents)
   6.239+  (let ((initial-contents-length (length initial-contents)))
   6.240+    (when (/= length initial-contents-length)
   6.241+      ;; FIXME: signal TYPE-ERROR
   6.242+      (error "MAKE-STATIC-VECTOR: There are ~A elements in the :INITIAL-CONTENTS, ~
   6.243+but requested vector length is ~A."
   6.244+             initial-contents-length length))))
   6.245+
   6.246+(declaim (inline check-initialization-arguments))
   6.247+(defun check-initialization-arguments (initial-element-p initial-contents-p)
   6.248+  (when (and initial-element-p initial-contents-p)
   6.249+    ;; FIXME: signal ARGUMENT-LIST-ERROR
   6.250+    (error "MAKE-STATIC-VECTOR: You must not specify both ~
   6.251+:INITIAL-ELEMENT and :INITIAL-CONTENTS")))
   6.252+
   6.253+(defun check-arguments (length element-type
   6.254+                        initial-element initial-element-p
   6.255+                        initial-contents initial-contents-p)
   6.256+  (check-initialization-arguments initial-element-p initial-contents-p)
   6.257+  (check-type length non-negative-fixnum)
   6.258+  (when initial-element-p
   6.259+    (check-initial-element element-type initial-element))
   6.260+  (when initial-contents-p
   6.261+    (check-initial-contents length initial-contents)))
   6.262+
   6.263+(defconstant +default-alignment+ 16)
   6.264+(defconstant +max-alignment+ 4096)
   6.265+
   6.266+(declaim (inline make-static-vector))
   6.267+(defun make-static-vector (length &key (element-type '(unsigned-byte 8))
   6.268+                           (initial-element nil initial-element-p)
   6.269+                           (initial-contents nil initial-contents-p)
   6.270+                           (alignment nil alignp))
   6.271+  "Create a simple vector of length LENGTH and type ELEMENT-TYPE which will
   6.272+not be moved by the garbage collector. The vector might be allocated in
   6.273+foreign memory so you must always call FREE-STATIC-VECTOR to free it."
   6.274+  (declare #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note)
   6.275+           (optimize speed))
   6.276+  (check-arguments length element-type initial-element initial-element-p
   6.277+                   initial-contents initial-contents-p)
   6.278+  (when alignp
   6.279+    ;; Check that the alignment is a power of 2 beteeen 16 and 4096.
   6.280+    #+(and sbcl unix)
   6.281+    (assert (and (<= +default-alignment+ alignment +max-alignment+)
   6.282+                 (= 1 (logcount alignment))))
   6.283+    #-(and sbcl unix)
   6.284+    (error "Allocation alignment not supported on this implementation."))
   6.285+  ;; TODO: fix %allocate-static-vector for all implementations
   6.286+  (let ((vector
   6.287+          (%allocate-static-vector length element-type
   6.288+                                   #+sbcl
   6.289+                                   (or alignment +default-alignment+))))
   6.290+    (if initial-element-p
   6.291+        (fill vector initial-element)
   6.292+        (replace vector initial-contents))))
   6.293+
   6.294+(defmacro with-static-vectors (((var length &rest args) &rest more-clauses)
   6.295+                               &body body)
   6.296+  "Allocate multiple static vectors at once."
   6.297+  `(with-static-vector (,var ,length ,@args)
   6.298+     ,@(if more-clauses
   6.299+           `((with-static-vectors ,more-clauses
   6.300+               ,@body))
   6.301+           body)))
   6.302+
     7.1--- a/lisp/lib/packy/pkg.lisp	Thu Oct 03 21:54:07 2024 -0400
     7.2+++ b/lisp/lib/packy/pkg.lisp	Fri Oct 04 16:14:44 2024 -0400
     7.3@@ -4,7 +4,7 @@
     7.4 
     7.5 ;;; Code:
     7.6 (defpackage :packy/core
     7.7-  (:use :cl :std :obj/id :dat/proto)
     7.8+  (:use :cl :std :obj/id :dat/proto :io/flate)
     7.9   (:export
    7.10    :*packy-url*
    7.11    :pack
     8.1--- a/lisp/lib/skel/core/obj.lisp	Thu Oct 03 21:54:07 2024 -0400
     8.2+++ b/lisp/lib/skel/core/obj.lisp	Fri Oct 04 16:14:44 2024 -0400
     8.3@@ -303,17 +303,6 @@
     8.4     (write (sk-rule-source self) :stream stream)
     8.5     (write (sk-rule-recipe self) :stream stream)))
     8.6 
     8.7-(defun sk-run-with-sources (obj rule)
     8.8-  (when-let ((sources (sk-rule-source rule)))
     8.9-    (mapcar
    8.10-     (lambda (src)
    8.11-       (if-let* ((sr (sk-find-rule src obj)))
    8.12-                ;; TODO: check if we need to rerun sources
    8.13-                (sk-make obj sr)
    8.14-                (warn! "unhandled source:" src "for rule:" rule)))
    8.15-     sources))
    8.16-  (sk-run rule))
    8.17-
    8.18 (defun sk-make (obj &rest rules)
    8.19   (if rules
    8.20       (mapc
    8.21@@ -325,6 +314,17 @@
    8.22               (sk-make obj rule)
    8.23               (sk-run rule))))))
    8.24 
    8.25+(defun sk-run-with-sources (obj rule)
    8.26+  (when-let ((sources (sk-rule-source rule)))
    8.27+    (mapcar
    8.28+     (lambda (src)
    8.29+       (if-let* ((sr (sk-find-rule src obj)))
    8.30+                ;; TODO: check if we need to rerun sources
    8.31+                (sk-make obj sr)
    8.32+                (error "unhandled source: ~A for rule ~A" src rule)))
    8.33+     sources))
    8.34+  (sk-run rule))
    8.35+
    8.36 ;;; Version Control
    8.37 (defstruct sk-vc-remote-meta
    8.38   (name :default :type keyword)
     9.1--- a/lisp/lisp.sk	Thu Oct 03 21:54:07 2024 -0400
     9.2+++ b/lisp/lisp.sk	Fri Oct 04 16:14:44 2024 -0400
     9.3@@ -1,6 +1,5 @@
     9.4 ;;; lisp.sk --- core/lisp skelfile -*- mode: skel; -*-
     9.5 :name "core/lisp"
     9.6-:src "lisp"
     9.7 :description "CC Lisp Core"
     9.8 :components
     9.9 ((:asd "prelude")
    10.1--- a/lisp/std/alien.lisp	Thu Oct 03 21:54:07 2024 -0400
    10.2+++ b/lisp/std/alien.lisp	Fri Oct 04 16:14:44 2024 -0400
    10.3@@ -54,7 +54,8 @@
    10.4        
    10.5 (defmacro define-opaque (ty &optional no-export foreign-type)
    10.6   `(prog1
    10.7-       (define-alien-type ,ty (struct ,(or foreign-type (symbolicate ty '-t))))
    10.8+       (eval-when (:compile-toplevel :load-toplevel :execute)
    10.9+         (define-alien-type ,ty (struct ,(or foreign-type (symbolicate ty '-t)))))
   10.10      ,(unless no-export `(export '(,ty)))))
   10.11 
   10.12 (defun setfa (place from) 
   10.13@@ -216,3 +217,5 @@
   10.14 (define-alien-type loff-t long-long)
   10.15 
   10.16 (define-alien-routine memset void (ptr (* t)) (constant int) (size size-t))
   10.17+(define-alien-routine memcpy void (dst (* t)) (src (* t)) (size size-t))
   10.18+(define-alien-routine posix-memalign int (box (* t)) (alignment size-t) (size size-t))
    11.1--- a/lisp/std/pkg.lisp	Thu Oct 03 21:54:07 2024 -0400
    11.2+++ b/lisp/std/pkg.lisp	Fri Oct 04 16:14:44 2024 -0400
    11.3@@ -94,9 +94,84 @@
    11.4   (:import-from :std/list :ensure-car)
    11.5   (:export :+default-element-type+
    11.6    :array-index :array-length
    11.7-   :negative-integer :non-negative-integer
    11.8-   :positive-integer :octet
    11.9-   :octet-vector))
   11.10+   #:negative-double-float
   11.11+   #:negative-fixnum-p
   11.12+   #:negative-float
   11.13+   #:negative-float-p
   11.14+   #:negative-long-float
   11.15+   #:negative-long-float-p
   11.16+   #:negative-rational
   11.17+   #:negative-rational-p
   11.18+   #:negative-real
   11.19+   #:negative-single-float-p
   11.20+   #:non-negative-double-float
   11.21+   #:non-negative-double-float-p
   11.22+   #:non-negative-fixnum
   11.23+   #:non-negative-fixnum-p
   11.24+   #:non-negative-float
   11.25+   #:non-negative-float-p
   11.26+   #:non-negative-integer-p
   11.27+   #:non-negative-long-float
   11.28+   #:non-negative-rational
   11.29+   #:non-negative-real-p
   11.30+   #:non-negative-short-float-p
   11.31+   #:non-negative-single-float
   11.32+   #:non-negative-single-float-p
   11.33+   #:non-positive-double-float
   11.34+   #:non-positive-double-float-p
   11.35+   #:non-positive-fixnum
   11.36+   #:non-positive-fixnum-p
   11.37+   #:non-positive-float
   11.38+   #:non-positive-float-p
   11.39+   #:non-positive-integer
   11.40+   #:non-positive-rational
   11.41+   #:non-positive-real
   11.42+   #:non-positive-real-p
   11.43+   #:non-positive-short-float
   11.44+   #:non-positive-short-float-p
   11.45+   #:non-positive-single-float-p
   11.46+   #:positive-double-float
   11.47+   #:positive-double-float-p
   11.48+   #:positive-fixnum
   11.49+   #:positive-fixnum-p
   11.50+   #:positive-float
   11.51+   #:positive-float-p
   11.52+   #:positive-integer
   11.53+   #:positive-rational
   11.54+   #:positive-real
   11.55+   #:positive-real-p
   11.56+   #:positive-short-float
   11.57+   #:positive-short-float-p
   11.58+   #:positive-single-float
   11.59+   #:positive-single-float-p
   11.60+   :negative-integer
   11.61+   #:negative-double-float-p
   11.62+   #:negative-fixnum
   11.63+   #:negative-integer
   11.64+   #:negative-integer-p
   11.65+   #:negative-real-p
   11.66+   #:negative-short-float
   11.67+   #:negative-short-float-p
   11.68+   #:negative-single-float
   11.69+   #:non-negative-integer
   11.70+   #:non-negative-long-float-p
   11.71+   #:non-negative-rational-p
   11.72+   #:non-negative-real
   11.73+   #:non-negative-short-float
   11.74+   #:non-positive-integer-p
   11.75+   #:non-positive-long-float
   11.76+   #:non-positive-long-float-p
   11.77+   #:non-positive-rational-p
   11.78+   #:non-positive-single-float
   11.79+   :coercef
   11.80+   :octet
   11.81+   :octet-vector
   11.82+   #:positive-integer-p
   11.83+   #:positive-long-float
   11.84+   #:positive-long-float-p
   11.85+   #:positive-rational-p
   11.86+   :of-type
   11.87+   :type=))
   11.88 
   11.89 (defpkg :std/num
   11.90   (:use :cl)
   11.91@@ -172,7 +247,9 @@
   11.92    :num-cpus
   11.93    :*cpus*
   11.94    :loff-t
   11.95-   :memset))
   11.96+   :memset
   11.97+   :memcpy
   11.98+   :posix-memalign))
   11.99 
  11.100 (defpkg :std/mop
  11.101   (:use :cl :sb-mop :sb-pcl)