add car-cas! and cdr-cas!

boot/pb/equates.h

@@ -1,4 +1,4 @@
-/* equates.h for Chez Scheme Version 10.3.0-pre-release.3 */
+/* equates.h for Chez Scheme Version 10.3.0-pre-release.4 */
 
 /* Do not edit this file.  It is automatically generated and */
 /* specifically tailored to the version of Chez Scheme named */
@@ -335,7 +335,7 @@ typedef uint64_t U64;
 #define int_bits 0x20
 #define integer_divide_instruction 1
 #define keyboard_interrupt_index 0x3
-#define library_entry_vector_size 0x276
+#define library_entry_vector_size 0x27A
 #define libspec_closure_index 0xD
 #define libspec_does_not_expect_headroom_index 0x0
 #define libspec_error_index 0xE
@@ -1015,7 +1015,7 @@ typedef uint64_t U64;
 #define rtd_sealed 0x4
 #define sbwp (ptr)0x4E
 #define scaled_shot_1_shot_flag -0x8
-#define scheme_version 0xA030003
+#define scheme_version 0xA030004
 #define seginfo_generation_disp 0x1
 #define seginfo_list_bits_disp 0x8
 #define seginfo_space_disp 0x0
@@ -1649,5 +1649,5 @@ typedef uint64_t U64;
 /* library entries we access from C code */
 #define library_nonprocedure_code 162
 #define library_dounderflow 164
-#define library_popcount_slow 626
-#define library_cpu_features 628
+#define library_popcount_slow 630
+#define library_cpu_features 632

boot/pb/scheme.h

@@ -1,4 +1,4 @@
-/* scheme.h for Chez Scheme Version 10.3.0-pre-release.3 (pb) */
+/* scheme.h for Chez Scheme Version 10.3.0-pre-release.4 (pb) */
 
 /* Do not edit this file.  It is automatically generated and */
 /* specifically tailored to the version of Chez Scheme named */
@@ -40,7 +40,7 @@
 #endif
 
 /* Chez Scheme Version and machine type */
-#define VERSION "10.3.0-pre-release.3"
+#define VERSION "10.3.0-pre-release.4"
 #define MACHINE_TYPE "pb"
 
 /* Integer typedefs */

csug/objects.stex

@@ -346,6 +346,38 @@ indiscriminately.
 \endschemedisplay
 
 
+%----------------------------------------------------------------------------
+\entryheader
+\formdef{car-cas!}{\categoryprocedure}{(car-cas! \var{pair} \var{old-obj} \var{new-obj})}
+\formdef{cdr-cas!}{\categoryprocedure}{(cdr-cas! \var{pair} \var{old-obj} \var{new-obj})}
+\returns \scheme{#t} if \var{pair} is changed, \scheme{#f} otherwise
+\listlibraries
+\endentryheader
+
+\noindent
+\scheme{car-cas!} and \scheme{cdr-cas!}  atomically change the content of \var{pair},
+either its \scheme{car} or \scheme{cdr} respectively, to \var{new-obj}
+if the replaced content is \scheme{eq?} to \var{old-obj}.
+If the content of \var{pair} that would be replaced is not \scheme{eq?} to \var{old-obj}, then
+\var{pair} is unchanged.
+
+On an architecture with a weak memory model, \scheme{car-cas!} and \scheme{cdr-cas!} can
+spuriously fail, leaving \var{pair} unchanged and returning
+\scheme{#f} even if the current value in \var{pair} is \var{old-obj}.
+On success, no memory ordering is implied, which means that
+\scheme{memory-order-acquire} and/or \scheme{memory-order-release} may be
+needed to complete an intended synchronization.
+
+\schemedisplay
+(define p (cons 'old-a 'old-d))
+(car-cas! p 'old-a 'new-a) ;=> #t, assuming no spurious failure
+(car p) ;=> 'new-a
+(cdr-cas! p 'old-d 'new-d) ;=> #t, assuming no spurious failure
+(cdr p) ;=> 'new-d
+(car-cas! p 'other 'wrong) ;=> #f
+(car p) ;=> 'new-a
+\endschemedisplay
+
 
 \section{Characters}
 

mats/5_2.ms

@@ -52,6 +52,81 @@
     (error? (set-cdr! 'a 'b))
  )
 
+(mat car-cas!
+  (not (car-cas! (cons 1 2) 0 3))
+  (let ((x (list 'a 'b)))
+    (let loop ()
+      (unless (car-cas! x 'a 3)
+        (loop)))
+    (equal? x '(3 b)))
+  (error? (car-cas! 'a 'b 'c))
+  (let ()
+    (define ps
+      (let loop ([i 100])
+        (if (zero? i)
+            '()
+            (cons 0 (loop (sub1 i))))))
+    (define ts
+      (let loop ([j 6])
+        (if (zero? j)
+            '()
+            (cons ((if (threaded?)
+                       fork-thread
+                       (lambda (f) (f)))
+                   (lambda ()
+                     (let loop ([i 1000])
+                       (unless (zero? i)
+                         (let loop ([ps ps])
+                           (unless (null? ps)
+                             (let retry ()
+                               (let ([v (car ps)])
+                                 (unless (car-cas! ps v (add1 v))
+                                   (retry))))
+                             (loop (cdr ps))))
+                         (loop (sub1 i))))))
+                  (loop (sub1 j))))))
+    (when (threaded?)
+      (for-each thread-join ts))
+    (= 600000 (apply + ps)))
+ )
+
+(mat cdr-cas!
+  (not (cdr-cas! (cons 1 2) 0 3))
+  (let ((x (cons 'a 'b)))
+    (let loop ()
+      (unless (cdr-cas! x 'b 3)
+        (loop)))
+    (equal? x '(a . 3)))
+  (error? (cdr-cas! 'a 'b 'c))
+  (let ()
+    (define ps
+      (let loop ([i 100])
+        (if (zero? i)
+            '()
+            (cons (cons 0 0) (loop (sub1 i))))))
+    (define ts
+      (let loop ([j 6])
+        (if (zero? j)
+            '()
+            (cons ((if (threaded?)
+                       fork-thread
+                       (lambda (f) (f)))                   
+                   (lambda ()
+                     (let loop ([i 1000])
+                       (unless (zero? i)
+                         (for-each (lambda (p)
+                                     (let retry ()
+                                       (let ([v (cdr p)])
+                                         (unless (cdr-cas! p v (add1 v))
+                                           (retry)))))
+                                   ps)
+                         (loop (sub1 i))))))
+                  (loop (sub1 j))))))
+    (when (threaded?)
+      (for-each thread-join ts))
+    (= 600000 (apply + (map cdr ps))))
+ )
+
 (set! bush
    (lambda (n)
       (let f ((n n) (x '()))

mats/patch-compile-0-f-f-t

@@ -1,15 +1,15 @@
-*** output-compile-0-f-f-f-experr/errors-compile-0-f-f-f	2025-07-03 12:18:51.007389699 +0800
---- output-compile-0-f-f-t-experr/errors-compile-0-f-f-t	2025-07-03 12:18:47.223833688 +0800
+*** output-compile-0-f-f-f-experr/errors-compile-0-f-f-f	Tue Aug 12 19:49:32 2025
+--- output-compile-0-f-f-t-experr/errors-compile-0-f-f-t	Tue Aug 12 19:49:26 2025
 ***************
-*** 4057,4063 ****
+*** 4059,4065 ****
   misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
   misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
   misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
 ! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 5".
   misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
   misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
   misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments 1 to #<procedure find-next>".
---- 4057,4063 ----
+--- 4059,4065 ----
   misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
   misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
   misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
@@ -18,7 +18,7 @@
   misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
   misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments 1 to #<procedure find-next>".
 ***************
-*** 8042,8052 ****
+*** 8044,8054 ****
   7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
@@ -30,7 +30,7 @@
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
---- 8042,8052 ----
+--- 8044,8054 ----
   7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
@@ -43,7 +43,7 @@
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
 ***************
-*** 9583,9595 ****
+*** 9585,9597 ****
   fx.mo:Expected error in mat fx-/wraparound: "fx-: <-int> is not a fixnum".
   fx.mo:Expected error in mat fx-/wraparound: "fx-: <-int> is not a fixnum".
   fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
@@ -57,7 +57,7 @@
   fx.mo:Expected error in mat r6rs:fx*: "fx*: <int> is not a fixnum".
   fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
   fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
---- 9583,9595 ----
+--- 9585,9597 ----
   fx.mo:Expected error in mat fx-/wraparound: "fx-: <-int> is not a fixnum".
   fx.mo:Expected error in mat fx-/wraparound: "fx-: <-int> is not a fixnum".
   fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".

mats/patch-compile-0-f-t-f

@@ -1,5 +1,5 @@
-*** output-compile-0-f-f-f-experr/errors-compile-0-f-f-f	2025-07-03 12:18:51.007389699 +0800
---- output-compile-0-f-t-f-experr/errors-compile-0-f-t-f	2025-07-03 12:18:45.851369000 +0800
+*** output-compile-0-f-f-f-experr/errors-compile-0-f-f-f	Tue Aug 12 19:49:32 2025
+--- output-compile-0-f-t-f-experr/errors-compile-0-f-t-f	Tue Aug 12 19:49:25 2025
 ***************
 *** 212,218 ****
   3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
@@ -18,22 +18,24 @@
   3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
   3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
 ***************
-*** 231,237 ****
+*** 231,238 ****
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
-! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
+- 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
   3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
---- 231,237 ----
+  3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable x".
+--- 231,238 ----
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
-! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
++ 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
   3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
   3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
+  3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable x".
 ***************
 *** 278,287 ****
   3.mo:Expected error in mat mrvs: "returned 3 values to single value return context".
@@ -58,15 +60,15 @@
   3.mo:Expected error in mat mrvs: "attempt to apply non-procedure 17".
   3.mo:Expected error in mat mrvs: "returned 2 values to single value return context".
 ***************
-*** 4101,4107 ****
+*** 4103,4109 ****
   misc.mo:Expected error in mat cpletrec: "foreign-procedure: no entry for "foo"".
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable q".
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar".
 ! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable foo at line 1, char 108 of testfile.ss".
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable a".
---- 4101,4107 ----
+--- 4103,4109 ----
   misc.mo:Expected error in mat cpletrec: "foreign-procedure: no entry for "foo"".
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable q".
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar".
@@ -75,7 +77,7 @@
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
   misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable a".
 ***************
-*** 8052,8059 ****
+*** 8054,8061 ****
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
   7.mo:Expected error in mat error: "a: hit me!".
   7.mo:Expected error in mat error: "f: n is 0".
@@ -84,7 +86,7 @@
   record.mo:Expected error in mat record2: "invalid value 3 for foreign type double-float".
   record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
   record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
---- 8052,8059 ----
+--- 8054,8061 ----
   7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
   7.mo:Expected error in mat error: "a: hit me!".
   7.mo:Expected error in mat error: "f: n is 0".
@@ -94,7 +96,7 @@
   record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
   record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
 ***************
-*** 8061,8075 ****
+*** 8063,8077 ****
   record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
   record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
   record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
@@ -110,7 +112,7 @@
   record.mo:Expected error in mat record9: "record-reader: invalid input #f".
   record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
   record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
---- 8061,8075 ----
+--- 8063,8077 ----
   record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
   record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
   record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
@@ -127,7 +129,7 @@
   record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
   record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
 ***************
-*** 8082,8107 ****
+*** 8084,8109 ****
   record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
   record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
   record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
@@ -154,7 +156,7 @@
   record.mo:Expected error in mat foreign-data: "foreign-alloc: 0 is not a positive fixnum".
   record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
   record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
---- 8082,8107 ----
+--- 8084,8109 ----
   record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
   record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
   record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
@@ -182,7 +184,7 @@
   record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
   record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
 ***************
-*** 8244,8282 ****
+*** 8246,8284 ****
   record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
   record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
   record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo> as bar".
@@ -222,7 +224,7 @@
   record.mo:Expected error in mat record?: "record?: 4 is not a record type descriptor".
   record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
   record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
---- 8244,8282 ----
+--- 8246,8284 ----
   record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
   record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
   record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo> as bar".
@@ -263,7 +265,7 @@
   record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
   record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
 ***************
-*** 8293,8350 ****
+*** 8295,8352 ****
   record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: invalid protocol flimflam".
   record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure not-a-procedure".
   record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure spam".
@@ -322,7 +324,7 @@
   record.mo:Expected error in mat r6rs-records-syntactic: "define-record-type: incompatible record type cpoint - different parent".
   record.mo:Expected error in mat r6rs-records-syntactic: "define-record-type: incompatible record type cpoint - different parent".
   record.mo:Expected error in mat r6rs-records-syntactic: "cannot extend define-record-type parent fratrat".
---- 8293,8350 ----
+--- 8295,8352 ----
   record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: invalid protocol flimflam".
   record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure not-a-procedure".
   record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure spam".

mats/patch-compile-0-f-t-t

@@ -1,7 +1,7 @@
-*** output-compile-0-f-t-f-experr/errors-compile-0-f-t-f	2025-07-03 12:18:45.851369000 +0800
---- output-compile-0-f-t-t-experr/errors-compile-0-f-t-t	2025-07-03 12:24:00.436030074 +0800
+*** output-compile-0-f-t-f-experr/errors-compile-0-f-t-f	Tue Aug 12 19:49:25 2025
+--- output-compile-0-f-t-t-experr/errors-compile-0-f-t-t	Tue Aug 12 19:49:22 2025
 ***************
-*** 9583,9595 ****
+*** 9585,9597 ****
   fx.mo:Expected error in mat fx-/wraparound: "fx-: <-int> is not a fixnum".
   fx.mo:Expected error in mat fx-/wraparound: "fx-: <-int> is not a fixnum".
   fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
@@ -15,7 +15,7 @@
   fx.mo:Expected error in mat r6rs:fx*: "fx*: <int> is not a fixnum".
   fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
   fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
---- 9583,9595 ----
+--- 9585,9597 ----
   fx.mo:Expected error in mat fx-/wraparound: "fx-: <-int> is not a fixnum".
   fx.mo:Expected error in mat fx-/wraparound: "fx-: <-int> is not a fixnum".
   fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".