Complete runtime arrays and condition hierarchy

src/package.lisp

@@ -123,9 +123,14 @@
      #:rt-make-instance-0
      #:*rt-class-registry* #:*rt-generic-function-registry*
     ;; Conditions
-    #:rt-runtime-condition #:rt-runtime-error
+    #:rt-runtime-condition #:rt-runtime-error #:rt-serious-condition #:rt-warning
+    #:rt-type-error #:rt-simple-type-error #:rt-program-error #:rt-control-error
+    #:rt-storage-condition #:rt-stream-error #:rt-file-error #:rt-cell-error
+    #:rt-unbound-variable #:rt-undefined-function #:rt-arithmetic-error
+    #:rt-division-by-zero #:rt-floating-point-overflow #:rt-floating-point-underflow
     #:rt-signal-error #:rt-signal #:rt-warn-fn #:rt-cerror
     #:rt-invoke-restart
+    #:*rt-debugger-hook* #:rt-invoke-debugger-hook #:rt-with-debugger-hook
     #:*handler-stack* #:*restart-stack*
     #:rt-handler #:rt-handler-p #:make-rt-handler
     #:rt-handler-condition-type #:rt-handler-handler-function
@@ -180,6 +185,7 @@
    #:+nan-boxing-quiet-nan+
    #:+ptr-base+ #:+ptr-mask+ #:+tag-mask+ #:+addr-mask+
    #:+tag-object+ #:+tag-cons+ #:+tag-symbol+ #:+tag-function+ #:+tag-string+
+   #:+rt-array-type-tag+ #:+rt-array-metadata-version+
    #:+tag-char+
    #:+fixnum-tag+ #:+fixnum-mask+ #:+fixnum-shift+
    #:+val-nil+ #:+val-t+ #:+val-unbound+

src/runtime-conditions.lisp

@@ -18,6 +18,47 @@
 (define-condition rt-runtime-error (error rt-runtime-condition) ()
   (:documentation "Base of every error cl-cc/runtime signals."))
 
+;;; ANSI condition taxonomy used by runtime-generated errors.  The RT prefix
+;;; keeps these classes distinct from host conditions while retaining the
+;;; standard superclass relationships callers use with TYPEP.
+(define-condition rt-serious-condition (serious-condition rt-runtime-condition) ())
+(define-condition rt-warning (warning rt-runtime-condition) ())
+(define-condition rt-type-error (type-error rt-runtime-error) ())
+(define-condition rt-simple-type-error (simple-type-error rt-type-error) ())
+(define-condition rt-program-error (program-error rt-runtime-error) ())
+(define-condition rt-control-error (control-error rt-runtime-error) ())
+(define-condition rt-storage-condition (storage-condition rt-runtime-error) ())
+(define-condition rt-stream-error (stream-error rt-runtime-error) ())
+(define-condition rt-file-error (file-error rt-stream-error) ())
+(define-condition rt-cell-error (cell-error rt-runtime-error) ())
+(define-condition rt-unbound-variable (unbound-variable rt-cell-error) ())
+(define-condition rt-undefined-function (undefined-function rt-cell-error) ())
+(define-condition rt-arithmetic-error (arithmetic-error rt-runtime-error) ())
+(define-condition rt-division-by-zero (division-by-zero rt-arithmetic-error) ())
+(define-condition rt-floating-point-overflow
+    (floating-point-overflow rt-arithmetic-error) ())
+(define-condition rt-floating-point-underflow
+    (floating-point-underflow rt-arithmetic-error) ())
+
+(defvar *rt-debugger-hook* nil
+  "Runtime debugger hook, called with an unhandled condition before escalation.
+
+The hook receives the condition and must not return a replacement value.  A
+dynamic binding shadows this variable for one runtime signal, matching the
+scope of the host Common Lisp debugger hook without mutating the host hook.")
+
+(defun rt-invoke-debugger-hook (condition)
+  "Invoke the current runtime debugger hook for CONDITION, if any."
+  (when *rt-debugger-hook*
+    (funcall *rt-debugger-hook* condition))
+  condition)
+
+(defun rt-with-debugger-hook (hook thunk)
+  "Run THUNK with HOOK installed as the runtime debugger hook."
+  (check-type thunk (or function symbol rt-closure-obj))
+  (let ((*rt-debugger-hook* hook))
+    (rt-call-fn thunk)))
+
 (defvar *rt-method-context-stack* nil
   "Dynamic stack of native-runtime generic-function method contexts.
 

src/runtime-math-io.lisp

@@ -69,7 +69,9 @@
     (multiple-value-bind (result handled-p) (rt-dispatch-signal condition)
       (if handled-p
           result
-          (error condition)))))
+          (progn
+            (rt-invoke-debugger-hook condition)
+            (error condition))))))
 
 (defun rt-signal (condition)
   (%rt-with-signal-gc-inhibit

src/runtime-ops.lisp

@@ -10,12 +10,30 @@
 ;;; Arrays / Vectors
 ;;; ------------------------------------------------------------
 
-(defun rt-make-array (dims &key (element-type t) initial-element fill-pointer adjustable)
-  (if initial-element
-      (make-array dims :element-type element-type :initial-element initial-element
-                  :fill-pointer fill-pointer :adjustable adjustable)
-      (make-array dims :element-type element-type
-                  :fill-pointer fill-pointer :adjustable adjustable)))
+(defun rt-make-array (dims &key (element-type t)
+                               (initial-element nil initial-element-p)
+                               (initial-contents nil initial-contents-p)
+                               fill-pointer adjustable
+                               displaced-to displaced-index-offset)
+  "Create a runtime array while preserving all ANSI array shape options.
+
+The INITIAL-ELEMENT supplied-p distinction matters for NIL, which is a valid
+initial element rather than an omitted keyword.  Displaced arrays are kept as
+real host arrays so their backing-array identity remains visible to the GC and
+FFI integration layers."
+  (let ((arguments (list :element-type element-type
+                         :fill-pointer fill-pointer
+                         :adjustable adjustable)))
+    (when initial-element-p
+      (setf arguments (append arguments (list :initial-element initial-element))))
+    (when initial-contents-p
+      (setf arguments (append arguments (list :initial-contents initial-contents))))
+    (when displaced-to
+      (setf arguments (append arguments
+                              (list :displaced-to displaced-to
+                                    :displaced-index-offset
+                                    (or displaced-index-offset 0)))))
+    (apply #'make-array dims arguments)))
 
 (defun rt-aref (a &rest indices) (apply #'aref a indices))
 (defun rt-aset (a &rest indices-then-value)

src/value-tags.lisp

@@ -67,6 +67,14 @@
 
 (defconstant +tag-string+   #x0005000000000000  "String sub-tag.")
 
+;;; Managed-heap array metadata tags.  NaN-boxed arrays continue to use the
+;;; general object pointer tag because the five NaN pointer sub-tags are already
+;;; allocated and the next bit pattern aliases the character space.
+(defconstant +rt-array-type-tag+ 5
+  "Managed-heap object header tag reserved for array storage.")
+(defconstant +rt-array-metadata-version+ 1
+  "Version of the metadata stored in a managed array's metadata slot.")
+
 ;;; Character: quiet NaN with bit[50] clear but bit[49] set.
 ;;; Base = #x7FFE_... gives bit[49]=1, bit[50]=0 → distinct from pointers.
 (defconstant +tag-char+     #x7FFE000000000000

src/value.lisp

@@ -40,6 +40,12 @@
 ;;;
 ;;;   SSO string: bits[63:59]=#b01110, bits[58:3] store up to 7 character
 ;;;               bytes little-endian by index, bits[2:0] store byte length.
+;;;
+;;; Managed arrays use the general object pointer sub-tag. Their heap header
+;;; carries +RT-ARRAY-TYPE-TAG+ and the metadata word records element type,
+;;; rank/dimensions, capacity, fill-pointer, displacement, and bit packing.
+;;; Host-facing RT-MAKE-ARRAY preserves these properties through the ANSI
+;;; array object, so no property is inferred from the pointer tag alone.
 
 (in-package :cl-cc/runtime)
 

t/runtime-conditions-test.lisp

@@ -62,6 +62,14 @@
       (expect result :to-be-null)
       (expect handled-p :to-be-falsy))))
 
+(it-sequential
+  "runtime condition subclasses retain ANSI type relationships."
+  (let ((condition (make-condition 'cl-cc/runtime:rt-division-by-zero)))
+    (expect (typep condition 'division-by-zero) :to-be-truthy)
+    (expect (typep condition 'arithmetic-error) :to-be-truthy)
+    (expect (typep condition 'cl-cc/runtime:rt-runtime-error) :to-be-truthy)
+    (expect (typep condition 'cl-cc/runtime:rt-runtime-condition) :to-be-truthy)))
+
 (it-sequential
   "rt-establish-handler runs its thunk with the handler and pops it afterwards."
   (let ((cl-cc/runtime::*handler-stack* nil))

t/runtime-ops-test.lisp

@@ -59,6 +59,17 @@
       (expect to :to-be base)
       (expect offset :to-equal 1))))
 
+(it-sequential
+  "rt-make-array accepts displaced-to and preserves writes through the base."
+  (let* ((base (cl-cc/runtime:rt-make-array 4 :initial-element 0))
+         (disp (cl-cc/runtime:rt-make-array 2 :displaced-to base
+                                             :displaced-index-offset 1)))
+    (cl-cc/runtime:rt-aset disp 0 42)
+    (expect (cl-cc/runtime:rt-aref base 1) :to-equal 42)
+    (multiple-value-bind (to offset) (cl-cc/runtime:rt-array-displacement disp)
+      (expect to :to-be base)
+      (expect offset :to-equal 1))))
+
 (it-sequential
   "rt-array-has-fill-pointer-p / rt-array-adjustable-p return 0 for simple arrays."
   (let ((a (cl-cc/runtime:rt-make-array 3)))