diff --git a/makefiles/Mf-install.in b/makefiles/Mf-install.in
index 395effaed4..c60eca99ae 100644
--- a/makefiles/Mf-install.in
+++ b/makefiles/Mf-install.in
@@ -62,7 +62,7 @@ InstallLZ4Target=
 #                 no changes should be needed below this point                #
 ###############################################################################
 
-Version=csv9.5.3.21
+Version=csv9.5.3.22
 Include=boot/$m
 PetiteBoot=boot/$m/petite.boot
 SchemeBoot=boot/$m/scheme.boot
diff --git a/mats/record.ms b/mats/record.ms
index 0f3f3485f8..dbfb1a6e72 100644
--- a/mats/record.ms
+++ b/mats/record.ms
@@ -6358,7 +6358,7 @@
                (let ([b (box 4)])
                  (set-box! b (* 3 (unbox b)))
                  (list (box? b) (unbox b))))))))
-    `(let ([gs (#2%gensym "record-box")])
+    `(let ([gs (#3%gensym "record-box")])
        (let ([g5 (#2%make-record-type-descriptor 'record-box #f gs #f #f '#((mutable x)))]
              [g6 (#2%make-record-type-descriptor 'record-box #f gs #f #f '#((mutable x)))]
              [g4 (#2%make-record-type-descriptor 'record-box #f gs #f #f '#((mutable x)))])
diff --git a/s/base-lang.ss b/s/base-lang.ss
index f6682a8e48..93db537a02 100644
--- a/s/base-lang.ss
+++ b/s/base-lang.ss
@@ -14,7 +14,7 @@
 ;;; limitations under the License.
 
 (module (Lsrc Lsrc? Ltype Ltype? unparse-Ltype unparse-Lsrc count-Lsrc
-         lookup-primref primref? primref-name primref-level primref-flags primref-arity primref-signatures
+         lookup-primref primref? primref-name primref-level primref-flags primref-arity
          sorry! make-preinfo preinfo? preinfo-lambda? preinfo-sexpr preinfo-sexpr-set! preinfo-src
          make-preinfo-lambda preinfo-lambda-name preinfo-lambda-name-set! preinfo-lambda-flags
          preinfo-lambda-flags-set! preinfo-lambda-libspec
@@ -23,7 +23,7 @@
          prelex-source prelex-operand prelex-operand-set! prelex-uname make-prelex*
          target-fixnum? target-bignum?)
 
-  (module (lookup-primref primref? primref-name primref-flags primref-arity primref-signatures primref-level)
+  (module (lookup-primref primref? primref-name primref-flags primref-arity primref-level)
     (include "primref.ss")
 
     (define $lookup-primref
diff --git a/s/cmacros.ss b/s/cmacros.ss
index f3ce562f41..16e2397131 100644
--- a/s/cmacros.ss
+++ b/s/cmacros.ss
@@ -328,7 +328,7 @@
                  [(_ foo e1 e2) e1] ...
                  [(_ bar e1 e2) e2]))))])))
 
-(define-constant scheme-version #x09050315)
+(define-constant scheme-version #x09050316)
 
 (define-syntax define-machine-types
   (lambda (x)
diff --git a/s/cptypes.ss b/s/cptypes.ss
index 42d5a50aa7..5e116a9483 100644
--- a/s/cptypes.ss
+++ b/s/cptypes.ss
@@ -70,8 +70,6 @@ Notes:
   (include "base-lang.ss")
   (include "fxmap.ss")
 
-  (define-pass cptypes : Lsrc (ir) -> Lsrc ()
-    (definitions
   (define (prelex-counter x plxc)
     (or (prelex-operand x)
         (let ([c (unbox plxc)])
@@ -628,51 +626,25 @@ Notes:
              [else
               (primref-name/nqm->predicate type #t)]))))
 
-  (define (signature->argument-predicate signature pos extend?)
-    (let* ([arguments (car signature)]
-           [dots (memq '... arguments)])
-      (cond
-        [(and dots (null? (cdr dots)))
-         (cond
-           [(< pos (- (length arguments) 2))
-            (primref-name/nqm->predicate (list-ref arguments pos) extend?)]
-           [else
-            (primref-name/nqm->predicate (list-ref arguments (- (length arguments) 2)) extend?)])]
-         [dots #f] ; TODO: Extend to handle this case, perhaps knowing the argument count.
-         [else
-          (cond
-            [(< pos (length arguments))
-             (let ([argument (list-ref arguments pos)])
-               (cond
-                 [(equal? argument '(ptr . ptr))
-                  'pair]
-                 [(and extend? (pair? argument))
-                  'pair]
-                 [else
-                  (primref-name/nqm->predicate argument extend?)]))]
-            [else
-             'bottom])])))
-
-  (define-threaded primref->argument-predicate/cache #f)
-
-  (define (primref->argument-predicate pr pos extend?)
-    (unless primref->argument-predicate/cache
-      (set! primref->argument-predicate/cache (make-hashtable equal-hash equal?)))
-    (let ([key (list (primref-name pr) pos extend?)])
-      (if (hashtable-contains? primref->argument-predicate/cache key)
-          (hashtable-ref primref->argument-predicate/cache key #f)
-          (let ([new (primref->argument-predicate/no-cache pr pos extend?)])
-            (when (<= pos 10)
-              (hashtable-set! primref->argument-predicate/cache key new))
-            new))))
-
-  (define (primref->argument-predicate/no-cache pr pos extend?)
-    (let ([signatures (primref-signatures pr)])
-      (and (>= (length signatures) 1)
-           (let ([vals (map (lambda (signature)
-                              (signature->argument-predicate signature pos extend?))
-                            signatures)])
-             (fold-left (if extend? pred-union pred-intersect) (car vals) (cdr vals))))))
+  (define (primref->argument-predicate pr pos arity extend?)
+    (let ([arguments-type ($sgetprop (primref-name pr) '*arguments-type* #f)])
+      (and arguments-type
+           (cond
+             [(fx< pos (vector-length arguments-type))
+              (primref-name/nqm->predicate (vector-ref arguments-type pos) extend?)]
+             [(not arity)
+              #f]
+             [(fx< pos (fx- arity 1))
+              (let ([rest ($sgetprop (primref-name pr) '*rest-type* #f)])
+                (primref-name/nqm->predicate rest extend?))]
+             [else
+              (let ([last ($sgetprop (primref-name pr) '*last-type* #f)])
+                (cond
+                  [last
+                   (primref-name/nqm->predicate last extend?)]
+                  [else
+                   (let ([rest ($sgetprop (primref-name pr) '*rest-type* #f)])
+                     (primref-name/nqm->predicate rest extend?))]))]))))
 
   (define (primref->unsafe-primref pr)
     (lookup-primref 3 (primref-name pr)))
@@ -953,12 +925,12 @@ Notes:
                                       (Expr n 'value oldtypes plxc)]
                                      [(args rargs targs t-targs f-targs)
                                       (Expr args 'value oldtypes plxc)])
-                         (let* ([predn (primref->argument-predicate pr 1 #t)]
+                         (let* ([predn (primref->argument-predicate pr 1 3 #t)]
                                 [tn (if (predicate-implies-not? rn predn)
                                         'bottom
                                         tn)]
                                 [tn (pred-env-add/ref tn n predn plxc)]
-                                [predargs (primref->argument-predicate pr 2 #t)]
+                                [predargs (primref->argument-predicate pr 2 3 #t)]
                                 [targs (if (predicate-implies-not? rargs predargs)
                                         'bottom
                                         targs)]
@@ -1058,7 +1030,7 @@ Notes:
                       (let loop ([e* e*] [r* r*] [n 0] [ret ret] [t t])
                         (if (null? e*)
                             (values ret t)
-                            (let ([pred (primref->argument-predicate pr n #t)])
+                            (let ([pred (primref->argument-predicate pr n (length e*) #t)])
                               (loop (cdr e*)
                                     (cdr r*)
                                     (fx+ n 1)
@@ -1075,7 +1047,7 @@ Notes:
                                     (all-set? (prim-mask safeongoodargs) (primref-flags pr))
                                     (andmap (lambda (r n)
                                               (predicate-implies? r
-                                                                  (primref->argument-predicate pr n #f)))
+                                                                  (primref->argument-predicate pr n (length e*) #f)))
                                             r* (enumerate r*)))]
                     [pr (if to-unsafe
                            (primref->unsafe-primref pr)
@@ -1300,7 +1272,8 @@ Notes:
                                   ir 'procedure plxc)
                 #f #f))]))
   )
-)
+
+  (define-pass cptypes : Lsrc (ir ctxt types plxc) -> Lsrc (ret types t-types f-types)
     (Expr : Expr (ir ctxt types plxc) -> Expr (ret types t-types f-types)
       [(quote ,d)
        (values ir (datum->predicate d ir) types #f #f)]
@@ -1485,11 +1458,22 @@ Notes:
       [(cpvalid-defer ,e) (sorry! who "cpvalid leaked a cpvalid-defer form ~s" ir)]
       [(profile ,src) (values ir #f types #f #f)]
       [else ($oops who "unrecognized record ~s" ir)])
+
+   ; body of cptypes
+   (Expr ir ctxt types plxc)
+
+    )
+
+  ; friendy name to use in other internal functions
+  ; so it is similar to Expr/call and Expr/fix-tf-types
+  (define Expr cptypes)
+
+  ; external version of cptypes: Lsrc -> Lsrc 
+  (define (Scptypes ir)
     (let-values ([(ir ret types t-types f-types)
                   (Expr ir 'value pred-env-empty (box 0))])
       ir))
-
-  (set! $cptypes cptypes)
+  (set! $cptypes Scptypes)
 
 )
 
diff --git a/s/primdata.ss b/s/primdata.ss
index e38a59bd45..4788a4832a 100644
--- a/s/primdata.ss
+++ b/s/primdata.ss
@@ -869,8 +869,8 @@
   (date-zone-offset [sig [(date) -> (fixnum)]] [flags pure mifoldable discard true])
   (date-zone-name [sig [(date) -> (ptr)]] [flags pure mifoldable discard])
   (date->time-utc [sig [(date) -> (time-utc)]] [flags alloc])
-  (make-date [sig [(sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-fixnum) -> (date)]
-                  [(sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum) -> (date)]]
+  (make-date [sig [(sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum) -> (date)]
+                  [(sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-ufixnum sub-fixnum) -> (date)]]
              [flags alloc])
   (make-time [sig [(sub-symbol sub-ufixnum exact-integer) -> (time)]] [flags alloc])
   (set-time-nanosecond! [sig [(time sub-uint) -> (void)]] [flags true])
diff --git a/s/priminfo.ss b/s/priminfo.ss
index 64970ec51d..19a794d85a 100644
--- a/s/priminfo.ss
+++ b/s/priminfo.ss
@@ -13,12 +13,12 @@
 ;;; See the License for the specific language governing permissions and
 ;;; limitations under the License.
 
-(module priminfo (priminfo-unprefixed priminfo-libraries priminfo-mask priminfo-signatures priminfo-arity primvec
-                  get-priminfo priminfo-result-type)
+(module priminfo (priminfo-unprefixed priminfo-libraries priminfo-mask priminfo-arity primvec get-priminfo
+                  priminfo-arguments-type priminfo-rest-type priminfo-last-type priminfo-result-type)
   (define-record-type priminfo
     (nongenerative)
     (sealed #t)
-    (fields unprefixed libraries mask result-type signatures arity))
+    (fields unprefixed libraries mask arity arguments-type rest-type last-type result-type))
 
   (define make-parameterlike box)
 
@@ -113,28 +113,91 @@
           [else 'ptr]))] ; a strange case, like list* and cons*
      [else #f])) ; multivalued
 
-  (define signature->interface
-    (lambda (sig)
-      (define (ellipsis? x) (eq? x '...))
-      (define (type? x)
-        (syntax-case x ()
-          [(t1 . t2) (and (type? #'t1) (type? #'t2))]
-          [t (and (symbol? #'t) (not (ellipsis? #'t)))]))
-      (syntax-case (car sig) ()
-        [(a ...)
-         (andmap type? #'(a ...))
-         (length #'(a ...))]
-        [(a ... b dots)
-         (and (andmap type? #'(a ...))
-              (type? #'b)
-              (ellipsis? #'dots))
-         (- -1 (length #'(a ...)))]
-        [(a ... b dots d)
-         (and (andmap type? #'(a ...))
-              (type? #'b)
-              (ellipsis? #'dots)
-              (type? #'d))
-         (- -2 (length #'(a ...)))])))
+  (define (signature-parse signature*)
+    (define (ellipsis? x) (eq? x '...))
+    (define (type? x)
+      (syntax-case x ()
+        [(t1 . t2) (and (type? #'t1) (type? #'t2))]
+        [t (and (symbol? #'t) (not (ellipsis? #'t)))]))
+    (and (not (null? signature*))
+         (map (lambda (sig)
+                (syntax-case (car sig) ()
+                  [(a ...)
+                   (andmap type? #'(a ...))
+                   (list (list->vector #'(a ...)) #f #f)]
+                  [(a ... b dots)
+                   (and (andmap type? #'(a ...))
+                        (type? #'b)
+                        (ellipsis? #'dots))
+                   (list (list->vector #'(a ...)) #'b #f)]
+                  [(a ... b dots d)
+                   (and (andmap type? #'(a ...))
+                        (type? #'b)
+                        (ellipsis? #'dots)
+                        (type? #'d))
+                   (list (list->vector #'(a ...)) #'b #'d)]
+                  [else
+                   ($oops 'prims "unexpected pattern ~s in signature ~s" sig signature*)]))
+              signature*)))
+
+  (define (parsed-signature->interface psignature*)
+    (and psignature*
+         (map (lambda (sig)
+                (define len (vector-length (car sig)))
+                (cond
+                  [(and (not (cadr sig)) (not (caddr sig)))
+                   len]
+                  [(not (caddr sig))
+                   (- -1 len)]
+                  [else 
+                   (- -2 len)]))
+              psignature*)))
+
+  (define (parsed-signature->arguments-type psignature*)
+    ; the last vector must be longer than the other, and the other must be subvectors
+    (and psignature*
+         (let ([longest (car (car (last-pair psignature*)))]) ; assume they are ordered
+           (cond
+             [(andmap (lambda (sig)
+                        (define other (car sig))
+                        (define l (vector-length other))
+                        (let loop ([i 0])
+                          (or (fx= i l)
+                              (and (equal? (vector-ref longest i) (vector-ref other i))
+                                   (loop (fx+ i 1))))))
+                      psignature*)
+              longest]
+             [else
+              ; the arguments disagree
+              #f]))))
+
+  (define (parsed-signature->rest-type psignature*)
+    ; only one must be not #f
+    (and psignature*
+         (let loop ([psig* (map cadr psignature*)] [found #f])
+           (cond
+             [(null? psig*)
+              found]
+             [(not found)
+              (loop (cdr psig*) (car psig*))]
+             [(not (car psig*))
+              (loop (cdr psig*) found)]
+             [else
+              ($oops 'prims "unexpected two values of rest argument ~s and ~s in signature with ~s" found (car psig*) psignature*)]))))
+
+  (define (parsed-signature->last-type psignature*)
+    ; only one must be not #f
+    (and psignature*
+         (let loop ([psig* (map caddr psignature*)] [found #f])
+           (cond
+             [(null? psig*)
+              found]
+             [(not found)
+              (loop (cdr psig*) (car psig*))]
+             [(not (car psig*))
+              (loop (cdr psig*) found)]
+             [else
+              ($oops 'prims "unexpected two values of last argument ~s and ~s in signature with ~s" found (car psig*) psignature*)]))))
 
   (define put-priminfo!
     (lambda (prim unprefixed lib* mask sig*)
@@ -157,13 +220,19 @@
           ($oops 'prims "inconsistent single-value information for ~s" prim))
         (when (and (eq? result-type 'ptr) (all-set? (prim-mask true) mask))
           ($oops 'prims "inconsistent true information for ~s ~s ~s ~s" prim result-type mask sig*))
-        (let ([mask (fxlogor mask
-                             (if (eq? result-type 'bottom) (prim-mask abort-op) 0)
-                             (if (eq? result-arity 'single) (prim-mask single-valued) 0)
-                             (if (signature-boolean? sig*) (prim-mask boolean-valued) 0)
-                             (if (signature-true? sig*) (prim-mask true) 0))])
+        (let* ([mask (fxlogor mask
+                              (if (eq? result-type 'bottom) (prim-mask abort-op) 0)
+                              (if (eq? result-arity 'single) (prim-mask single-valued) 0)
+                              (if (signature-boolean? sig*) (prim-mask boolean-valued) 0)
+                              (if (signature-true? sig*) (prim-mask true) 0))]
+               [psig* (signature-parse sig*)]
+               [arguments-type (parsed-signature->arguments-type psig*)])
           (eq-hashtable-set! prim-db prim
-            (make-priminfo unprefixed lib* mask result-type sig* (map signature->interface sig*)))))))
+            (make-priminfo unprefixed lib* mask (parsed-signature->interface psig*)
+                           arguments-type
+                           (and arguments-type (parsed-signature->rest-type psig*)) ; if arguments-type is confused, clean rest-type and last-type
+                           (and arguments-type (parsed-signature->last-type psig*))
+                           result-type))))))
 
   (define-syntax define-symbol-flags*
     (lambda (x)
diff --git a/s/primref.ss b/s/primref.ss
index 16438fc667..6f734bb8e8 100644
--- a/s/primref.ss
+++ b/s/primref.ss
@@ -14,9 +14,9 @@
 ;;; limitations under the License.
 
 (define-record-type primref
-  (nongenerative #{primref a0xltlrcpeygsahopkplcn-3})
+  (nongenerative #{primref a0xltlrcpeygsahopkplcn-2})
   (sealed #t)
-  (fields name flags arity signatures))
+  (fields name flags arity))
 
 (define primref-level
   (lambda (pr)
diff --git a/s/primvars.ss b/s/primvars.ss
index 06eebb79bd..9e5523a675 100644
--- a/s/primvars.ss
+++ b/s/primvars.ss
@@ -18,14 +18,16 @@
   (include "primref.ss")
 
   (define record-prim!
-    (lambda (prim unprefixed flags arity result-type signatures)
+    (lambda (prim unprefixed flags arity arguments-type rest-type last-type result-type)
       (unless (eq? unprefixed prim) ($sputprop prim '*unprefixed* unprefixed))
       ($sputprop prim '*flags* flags)
+      (when arguments-type ($sputprop prim '*arguments-type* arguments-type))
+      (when rest-type ($sputprop prim '*rest-type* rest-type))
+      (when last-type ($sputprop prim '*last-type* last-type))
       (when result-type ($sputprop prim '*result-type* result-type))
       (when (any-set? (prim-mask (or primitive system)) flags)
-        (let ([arity (and (not (null? arity)) arity)])
-          ($sputprop prim '*prim2* (make-primref prim flags arity signatures))
-          ($sputprop prim '*prim3* (make-primref prim (fxlogor flags (prim-mask unsafe)) arity signatures))))))
+        ($sputprop prim '*prim2* (make-primref prim flags arity))
+        ($sputprop prim '*prim3* (make-primref prim (fxlogor flags (prim-mask unsafe)) arity)))))
 
   (define-syntax setup
     (lambda (x)
@@ -38,8 +40,10 @@
               '#,(datum->syntax #'* (vector-map priminfo-unprefixed v-info))
               '#,(datum->syntax #'* (vector-map priminfo-mask v-info))
               '#,(datum->syntax #'* (vector-map priminfo-arity v-info))
-              '#,(datum->syntax #'* (vector-map priminfo-result-type v-info))
-              '#,(datum->syntax #'* (vector-map priminfo-signatures v-info)))))))
+              '#,(datum->syntax #'* (vector-map priminfo-arguments-type v-info))
+              '#,(datum->syntax #'* (vector-map priminfo-rest-type v-info))
+              '#,(datum->syntax #'* (vector-map priminfo-last-type v-info))
+              '#,(datum->syntax #'* (vector-map priminfo-result-type v-info)))))))
 
   (for-each (lambda (x) (for-each (lambda (key) ($sremprop x key)) '(*prim2* *prim3* *flags* *unprefixed*))) (oblist))
   setup)