[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Change most alien-type slots to readonly
From:       Douglas Katzman via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2022-11-29 20:59:49
Message-ID: 1669755589.177963.6920 () sfp-scm-4 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  03dec9fe5152060cb1973cb990175d9ea3d3c7f2 (commit)
      from  bb01761544f2ffc12040f4f4a8dca3f9b44abca7 (commit)

- Log -----------------------------------------------------------------
commit 03dec9fe5152060cb1973cb990175d9ea3d3c7f2
Author: Douglas Katzman <dougk@google.com>
Date:   Tue Nov 29 15:40:57 2022 -0500

    Change most alien-type slots to readonly
---
 src/code/alieneval.lisp        | 25 +++++++++++++------------
 src/code/c-call.lisp           |  6 +++---
 src/code/target-alieneval.lisp |  9 ++++++---
 3 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/src/code/alieneval.lisp b/src/code/alieneval.lisp
index 72db076f8..6e47ab1b4 100644
--- a/src/code/alieneval.lisp
+++ b/src/code/alieneval.lisp
@@ -499,6 +499,7 @@
 ;;;; the INTEGER type
 
 (define-alien-type-class (integer)
+  ;; -SIGNED is mutable because of redefined ENUMs.
   (signed t :type (member t nil)))
 
 (define-alien-type-translator signed (&optional (bits sb-vm:n-word-bits))
@@ -736,7 +737,7 @@
 ;;;; the FLOAT types
 
 (define-alien-type-class (float)
-  (type (missing-arg) :type symbol))
+  (type (missing-arg) :type symbol :read-only t))
 
 (define-alien-type-method (float :unparse) (type)
   (alien-float-type-type type))
@@ -832,7 +833,7 @@
 
 (define-alien-type-class (pointer :include (alien-value (bits
                                                          sb-vm:n-machine-word-bits)))
-  (to nil :type (or alien-type null)))
+  (to nil :type (or alien-type null) :read-only t))
 
 (define-alien-type-translator * (to &environment env)
   (make-alien-pointer-type :to (if (eq to t) nil (parse-alien-type to env))))
@@ -903,8 +904,8 @@
 ;;;; the ARRAY type
 
 (define-alien-type-class (array :include mem-block)
-  (element-type (missing-arg) :type alien-type)
-  (dimensions (missing-arg) :type list))
+  (element-type (missing-arg) :type alien-type :read-only t)
+  (dimensions (missing-arg) :type list :read-only t))
 
 (define-alien-type-translator array (ele-type &rest dims &environment env)
 
@@ -967,9 +968,9 @@
 (!set-load-form-method alien-record-field (:xc :target))
 
 (define-alien-type-class (record :include mem-block)
-  (kind :struct :type (member :struct :union))
-  (name nil :type (or symbol null))
-  (fields nil :type list))
+  (kind :struct :type (member :struct :union) :read-only t)
+  (name nil :type (or symbol null) :read-only t)
+  (fields nil :type list)) ; mutable because of structural recursion and parser
 
 (define-alien-type-translator struct (name &rest fields &environment env)
   (parse-alien-record-type :struct name fields env))
@@ -1145,13 +1146,13 @@
 ;;; translation as well.
 
 (define-alien-type-class (fun :include mem-block)
-  (result-type (missing-arg) :type alien-type)
-  (arg-types (missing-arg) :type list)
+  (result-type (missing-arg) :type alien-type :read-only t)
+  (arg-types (missing-arg) :type list :read-only t)
   ;; The 3rd-party CFFI library uses presence of &REST in an argument list
   ;; as indicative of "..." in the C prototype. We can record that too.
-  (varargs nil :type (or boolean fixnum (eql :unspecified)))
+  (varargs nil :type (or boolean fixnum (eql :unspecified)) :read-only t)
   (stub nil :type (or null function))
-  (convention nil :type calling-convention))
+  (convention nil :type calling-convention :read-only t))
 ;;; The safe default is to assume that everything is varargs.
 ;;; On x86-64 we have to emit a spurious instruction because of it.
 ;;; So until all users fix their lambda lists to be explicit about &REST
@@ -1214,7 +1215,7 @@
               (alien-fun-type-arg-types type2))))
 
 (define-alien-type-class (values)
-  (values (missing-arg) :type list))
+  (values (missing-arg) :type list :read-only t))
 
 (define-alien-type-translator values (&rest values &environment env)
   (unless *values-type-okay*
diff --git a/src/code/c-call.lisp b/src/code/c-call.lisp
index 8f10a1239..1436078cc 100644
--- a/src/code/c-call.lisp
+++ b/src/code/c-call.lisp
@@ -12,9 +12,9 @@
 ;;;; C string support.
 
 (define-alien-type-class (c-string :include pointer :include-args (to))
-  (external-format :default :type keyword)
-  (element-type 'character :type (member character base-char))
-  (not-null nil :type boolean))
+  (external-format :default :type keyword :read-only t)
+  (element-type 'character :type (member character base-char) :read-only t)
+  (not-null nil :type boolean :read-only t))
 
 (define-alien-type-translator c-string
     (&key (external-format :default)
diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index cf3f3e461..c9371fd53 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -262,9 +262,12 @@ Examples:
                    (error
                     "cannot override the size of zero-dimensional arrays"))
                  (when (constantp size)
-                   (setf alien-type (copy-structure alien-type))
-                   (setf (alien-array-type-dimensions alien-type)
-                         (cons (constant-form-value size) (cdr dims)))))
+                   (setf alien-type
+                         (make-alien-array-type
+                          :dimensions (cons (constant-form-value size) (cdr dims))
+                          :element-type (alien-array-type-element-type alien-type)
+                          :bits (alien-type-bits alien-type)
+                          :alignment (alien-type-alignment alien-type)))))
                 (dims
                  (setf size (car dims)))
                 (t

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]