diff --git a/racket/src/ChezScheme/csug/foreign.stex b/racket/src/ChezScheme/csug/foreign.stex
index 53d96c3ba4..3e99d48615 100644
--- a/racket/src/ChezScheme/csug/foreign.stex
+++ b/racket/src/ChezScheme/csug/foreign.stex
@@ -221,9 +221,11 @@ Since \scheme{__cdecl} is the default, specifying \scheme{__cdecl} is
 equivalent to specifying \scheme{#f} or no convention.
 Finally, \var{conv} can be \scheme{__collect_safe} to indicate that garbage
 collection is allowed concurrent to a call of the foreign procedure, or it
-can be \var{conv} can be \scheme{__varargs} to indicate that the procedure
-uses a convention that works with a variable number of arguments (which
-differs from the fixed-argument variant for some platforms and conventions).
+can be \var{conv} can be \scheme{__varargs} or \scheme{(__varargs_after \var{n})} to indicate
+that the procedure uses a convention that works with a variable number of arguments
+after the first \var{n} (which
+differs from the fixed-argument variant for some platforms and conventions),
+where \scheme{__varargs} is a shorthand for \scheme{(__varargs_after 1)}.
 
 Use \scheme{__stdcall} to access most Windows API procedures.
 Use \scheme{__cdecl} for Windows API varargs procedures,
diff --git a/racket/src/ChezScheme/mats/foreign.ms b/racket/src/ChezScheme/mats/foreign.ms
index f49df001b0..6ff0133bfc 100644
--- a/racket/src/ChezScheme/mats/foreign.ms
+++ b/racket/src/ChezScheme/mats/foreign.ms
@@ -1044,10 +1044,13 @@
     (define call-df (foreign-procedure "call_df" (ptr double-float int int) double-float))
     (define call-varargs-df (foreign-procedure "call_varargs_df" (ptr double-float int int) double-float))
     (define call-varargs-i7df (foreign-procedure "call_varargs_i7df" (ptr int
-                                                                          double-float double-float double-float
-                                                                          double-float double-float double-float
-                                                                          double-float)
+                                                                                    double-float double-float double-float
+                                                                                    double-float double-float double-float
+                                                                                    double-float)
                                                  double-float))
+    (define call-varargs-dfii (foreign-procedure "call_varargs_dfii" (ptr double-float int int) double-float))
+    (define call-varargs-dfidf (foreign-procedure "call_varargs_dfidf" (ptr double-float int double-float) double-float))
+    (define call-varargs-dfsfi (foreign-procedure "call_varargs_dfsfi" (ptr double-float single-float int) double-float))
     (define ($test-call-int signed? size call-int make-fc)
       (define n10000 (expt 256 size))
       (define nffff (- n10000 1))
@@ -1178,6 +1181,35 @@
       1 2.2 3.2 4.5 6.7 8.9 10.1 11.5)
     55.1)
 
+  (equal?
+   (call-varargs-dfii
+    (foreign-callable
+     (__varargs_after 2)
+     (lambda (x y z) (+ x y z))
+     (double-float int int) double-float)
+    10.25 20 300)
+   620.25)
+
+  (equal?
+   (call-varargs-dfidf
+    (foreign-callable
+     (__varargs_after 2)
+     (lambda (x y z) (+ x y z))
+     (double-float int double-float) double-float)
+    10.25 20 300.25)
+   330.75)
+
+  (equal?
+   (call-varargs-dfsfi
+    (foreign-callable
+     (__varargs_after 2)
+     (lambda (x y z) (+ x y z))
+     (double-float single-float int) double-float)
+    10.25 20.0 300)
+   620.5)
+  
+  ;(define call-varargs-dfsfi (foreign-procedure #;__varargs #;2 "call_varargs_dfsfi" (ptr double-float single-float int) double-float))
+
   (error?
     (call-i8
       (foreign-callable
@@ -2738,6 +2770,12 @@
         [(i3osx ti3osx a6osx ta6osx ppc32osx tppc32osx arm64osx tarm64osx)
          '(load-shared-object "libc.dylib")]
         [else (error 'load-libc "unrecognized machine type ~s" (machine-type))]))
+    (define varargs_df (foreign-procedure (__varargs_after 1) "varargs_df" (double int int) double))
+    (define varargs_dfii (foreign-procedure (__varargs_after 2) "varargs_dfii" (double int int) double))
+    (define varargs_dfidf (foreign-procedure (__varargs_after 2) "varargs_dfidf" (double int double) double))
+    (define varargs_sfdfi (foreign-procedure (__varargs_after 2) "varargs_sfdfi" (float double int) double))
+    (define varargs_i7df (foreign-procedure (__varargs_after 1) "varargs_i7df" (int double double double double double double double)
+                                            double))
     #t)
   (equal?
     (with-input-from-string
@@ -2798,6 +2836,22 @@
                                  (double-float double-float) single-float)
               3.5 -5.25)))
           3.25)
+
+  (equal?
+   (varargs_df 13.5 7 10)
+   30.5)
+  (equal?
+   (varargs_dfii 13.5 -7 -10)
+   -3.5)
+  (equal?
+   (varargs_dfidf 13.5 10 7.5)
+   31.0)
+  (equal?
+   (varargs_sfdfi 10.5 3.25 8)
+   21.75)
+  (equal?
+   (varargs_i7df 1 2.0 3.0 4.0 5.0 6.0 7.0 8.0)
+   36.0)
 )
 
 (mat structs
diff --git a/racket/src/ChezScheme/mats/foreign2.c b/racket/src/ChezScheme/mats/foreign2.c
index 56b2f5b2db..ae6af8b666 100644
--- a/racket/src/ChezScheme/mats/foreign2.c
+++ b/racket/src/ChezScheme/mats/foreign2.c
@@ -16,6 +16,7 @@
 
 #include <stdio.h>
 #include <wchar.h>
+#include <stdarg.h>
 
 #ifdef _WIN32
 #  define SCHEME_IMPORT
@@ -244,10 +245,27 @@ EXPORT double_float call_df(ptr code, double_float x, int m, int k) {
   return (*((double_float (*) (double_float))Sforeign_callable_entry_point(code)))(x + m) + k;
 }
 
+/* varargs after 1 argument */
 EXPORT double_float call_varargs_df(ptr code, double_float x, int m, int k) {
   return (*((double_float (*) (double, ...))Sforeign_callable_entry_point(code)))(x - m, x + m) + k;
 }
 
+/* varargs after 2 arguments */
+EXPORT double_float call_varargs_dfii(ptr code, double_float x, int m, int k) {
+  return (*((double_float (*) (double, int, ...))Sforeign_callable_entry_point(code)))(x - m, x + m, k) + k;
+}
+
+/* varargs after 2 arguments */
+EXPORT double_float call_varargs_dfidf(ptr code, double_float x, int m, double k) {
+  return (*((double_float (*) (double, int, ...))Sforeign_callable_entry_point(code)))(x - m, x + m, x) + k;
+}
+
+/* varargs after 2 arguments */
+EXPORT double_float call_varargs_dfsfi(ptr code, double_float x, single_float m, int k) {
+  return (*((double_float (*) (double, float, ...))Sforeign_callable_entry_point(code)))(x - m, x + m, k) + k;
+}
+
+/* varargs after 1 argument */
 EXPORT double_float call_varargs_i7df(ptr code, int i,
                                       double_float a, double_float b, double_float c,
                                       double_float d, double_float e, double_float f,
@@ -255,6 +273,62 @@ EXPORT double_float call_varargs_i7df(ptr code, int i,
   return (*((double_float (*) (int, ...))Sforeign_callable_entry_point(code)))(i, a, b, c, d, e, f, g);
 }
 
+EXPORT double_float varargs_df(double_float x, ...) {
+  va_list va;
+  int m, k;
+  va_start(va, x);
+  m = va_arg(va, int);
+  k = va_arg(va, int);
+  va_end(va);
+  return x + m + k;
+}
+
+EXPORT double_float varargs_dfii(double_float x, int m, ...) {
+  va_list va;
+  int k;
+  va_start(va, m);
+  k = va_arg(va, int);
+  va_end(va);
+  return x + m + k;
+}
+
+EXPORT double_float varargs_dfidf(double_float x, int m, ...) {
+  va_list va;
+  double k;
+  va_start(va, m);
+  k = va_arg(va, double);
+  va_end(va);
+  return x + m + k;
+}
+
+EXPORT double_float varargs_sfdfi(single_float x, double_float m, ...) {
+  va_list va;
+  int k;
+  va_start(va, m);
+  k = va_arg(va, int);
+  va_end(va);
+  return x + m + k;
+}
+
+EXPORT double_float varargs_i7df(int i, ...) {
+  va_list va;
+  double_float a, b, c;
+  double_float d, e, f;
+  double_float g;
+
+  va_start(va, i);
+  a = va_arg(va, double_float);
+  b = va_arg(va, double_float);
+  c = va_arg(va, double_float);
+  d = va_arg(va, double_float);
+  e = va_arg(va, double_float);
+  f = va_arg(va, double_float);
+  g = va_arg(va, double_float);
+  va_end(va);
+  
+  return a + b + c + d + e + f + g + i;
+}
+
 EXPORT u8 *u8_star_to_u8_star(u8 *s) {
   return s == (u8 *)0 ? (u8 *)0 : s + 1;
 }
diff --git a/racket/src/ChezScheme/s/arm32.ss b/racket/src/ChezScheme/s/arm32.ss
index 2498e5a5d4..bc89fd2e47 100644
--- a/racket/src/ChezScheme/s/arm32.ss
+++ b/racket/src/ChezScheme/s/arm32.ss
@@ -2770,7 +2770,7 @@
             (safe-assert (reg-callee-save? %tc)) ; no need to save-restore
             (let* ([arg-type* (info-foreign-arg-type* info)]
                    [conv* (info-foreign-conv* info)]
-                   [varargs? (memq 'varargs conv*)]
+                   [varargs? (ormap (lambda (conv) (and (pair? conv) (eq? (car conv) 'varargs))) conv*)]
 		   [result-type (info-foreign-result-type info)]
                    [result-reg* (get-result-regs result-type varargs?)]
 		   [fill-result-here? (indirect-result-that-fits-in-registers? result-type)]
@@ -3240,7 +3240,7 @@
                                  (vector->list regvec)))
             (let* ([arg-type* (info-foreign-arg-type* info)]
                    [conv* (info-foreign-conv* info)]
-		   [varargs? (memq 'varargs conv*)]
+                   [varargs? (ormap (lambda (conv) (and (pair? conv) (eq? (car conv) 'varargs))) conv*)]
 		   [result-type (info-foreign-result-type info)]
                    [synthesize-first? (indirect-result-that-fits-in-registers? result-type)]
                    [adjust-active? (if-feature pthreads (memq 'adjust-active conv*) #f)])
diff --git a/racket/src/ChezScheme/s/arm64.ss b/racket/src/ChezScheme/s/arm64.ss
index 59ba7dd7f2..a0eca90e17 100644
--- a/racket/src/ChezScheme/s/arm64.ss
+++ b/racket/src/ChezScheme/s/arm64.ss
@@ -2421,6 +2421,11 @@
 			(inline ,(make-info-kill*-live* fp-regs '()) ,%pop-fpmultiple))])))])
             (save-and-restore-gp regs (save-and-restore-fp regs e))))))
 
+    (define (extract-varargs-after-conv conv*)
+      (ormap (lambda (conv)
+               (and (pair? conv) (eq? (car conv) 'varargs) (cdr conv)))
+             conv*))
+
     (define-record-type cat
       (nongenerative #{cat jqrttgvpydsbdo0l736l43udu-1})
       (sealed #t)
@@ -2431,11 +2436,11 @@
               indirect-bytes)) ; #f or extra bytes on stack for indirect
 
     (define alignment-via-lookahead
-      (lambda (size types stack-align varargs? k)
+      (lambda (size types stack-align varargs-after k)
         (constant-case machine-type-name
           [(arm64osx tarm64osx)
            (cond
-             [varargs? (k (align 8 size) 0 0)]
+             [(eqv? 0 varargs-after) (k (align 8 size) 0 0)]
              [else
               ;; On Mac OS, a non-varargs stack argument does not have to use a
               ;; multiple of 8, but we need to work out any padding that
@@ -2463,14 +2468,12 @@
            (k (align 8 size) 0 0)])))
 
     (define rest-of
-      (lambda (regs n varargs?)
+      (lambda (regs n next-varargs-after)
         (constant-case machine-type-name
           [(arm64osx tarm64osx)
            (cond
-             [varargs?
-              ;; Assume (arbitraily) that all but the first argument
-              ;; is varargs, which means that all the rest go on the
-              ;; stack.
+             [(eqv? next-varargs-after 0)
+              ;; All the rest go on the stack
               '()]
              [else
               (list-tail regs n)])]
@@ -2478,108 +2481,123 @@
            (list-tail regs n)])))
 
     (define categorize-arguments
-      (lambda (types varargs?)
+      (lambda (types varargs-after)
         (let loop ([types types] [int* (int-argument-regs)] [fp* (fp-argument-regs)]
+                   [varargs-after varargs-after]
                    ;; accumulate alignment from previous args so we can compute any
                    ;; needed padding and alignment after this next argument
                    [stack-align 0])
-          (if (null? types)
-              '()
-              (nanopass-case (Ltype Type) (car types)
-                [(fp-double-float)
-                 (cond
-                   [(null? fp*)
-                    (cons (make-cat 'stack '() 8 0 #f) (loop (cdr types) int* '() 0))]
-                   [else
-                    (cons (make-cat 'fp (list (car fp*)) 8 0 #f)
-                          (loop (cdr types) (rest-of int* 0 varargs?) (rest-of fp* 1 varargs?) stack-align))])]
-                [(fp-single-float)
-                 (cond
-                   [(null? fp*)
-                    (alignment-via-lookahead
-                     4 (cdr types) stack-align varargs?
-                     (lambda (bytes pad stack-align)
-                       (cons (make-cat 'stack '() bytes pad #f) (loop (cdr types) int* '() stack-align))))]
-                   [else
-                    (cons (make-cat 'fp (list (car fp*)) 8 0 #f)
-                          (loop (cdr types) (rest-of int* 0 varargs?)(rest-of fp* 1 varargs?) stack-align))])]
-                [(fp-ftd& ,ftd)
-                 (let* ([size ($ftd-size ftd)]
-                        [members ($ftd->members ftd)]
-                        [num-members (length members)]
-                        [doubles? (and (fx= 8 ($ftd-alignment ftd))
-                                       (fx<= num-members 4)
-                                       (andmap double-member? members))]
-                        [floats? (and (fx= 4 ($ftd-alignment ftd))
-                                      (fx<= num-members 4)
-                                      (andmap float-member? members))])
+          (let ([next-varargs-after (and varargs-after (if (fx> varargs-after 0) (fx- varargs-after 1) 0))])
+            (if (null? types)
+                '()
+                (nanopass-case (Ltype Type) (car types)
+                  [(fp-double-float)
                    (cond
-                     [doubles?
-                      ;; Sequence of up to 4 doubles that may fit in registers
-                      (cond
-                        [(fx>= (length fp*) num-members)
-                         ;; Allocate each double to a register
-                         (cons (make-cat 'fp (list-head fp* num-members) (fx* 8 num-members) 0 #f)
-                               (loop (cdr types) (rest-of int* 0 varargs?) (rest-of fp* num-members varargs?) stack-align))]
-                        [else
-                         ;; Stop using fp registers, put on stack
-                         (cons (make-cat 'stack '() size 0 #f)
-                               (loop (cdr types) int* '() 0))])]
-                     [floats?
-                      ;; Sequence of up to 4 floats that may fit in registers
-                      (cond
-                        [(fx>= (length fp*) num-members)
-                         ;; Allocate each float to a register
-                         (cons (make-cat 'fp (list-head fp* num-members) (fx* 8 num-members) 0 #f)
-                               (loop (cdr types) (rest-of int* 0 varargs?) (rest-of fp* num-members varargs?) stack-align))]
-                        [else
-                         ;; Stop using fp registers, put on stack
-                         (alignment-via-lookahead
-                          size (cdr types) stack-align varargs?
-                          (lambda (size pad stack-align)
-                            (cons (make-cat 'stack '() size pad #f)
-                                  (loop (cdr types) int* '() stack-align))))])]
-                     [(fx> size 16)
-                      ;; Indirect; pointer goes in a register or on the stack
-                      (cond
-                        [(null? int*)
-                         ;; Pointer on the stack
-                         (cons (make-cat 'stack '() (constant ptr-bytes) 0 (align 8 size))
-                               (loop (cdr types) '() fp* 0))]
-                        [else
-                         ;; Pointer in register
-                         (cons (make-cat 'int (list (car int*)) 8 0 (align 8 size))
-                               (loop (cdr types) (rest-of int* 1 varargs?) (rest-of fp* 0 varargs?) stack-align))])]
+                     [(null? fp*)
+                      (cons (make-cat 'stack '() 8 0 #f) (loop (cdr types) int* '() next-varargs-after 0))]
                      [else
-                      ;; Maybe put in integer registers
-                      (let* ([regs (fxquotient (align 8 size) 8)])
+                      (cons (make-cat 'fp (list (car fp*)) 8 0 #f)
+                            (loop (cdr types) (rest-of int* 0 next-varargs-after) (rest-of fp* 1 next-varargs-after)
+                                  next-varargs-after
+                                  stack-align))])]
+                  [(fp-single-float)
+                   (cond
+                     [(null? fp*)
+                      (alignment-via-lookahead
+                       4 (cdr types) stack-align varargs-after
+                       (lambda (bytes pad stack-align)
+                         (cons (make-cat 'stack '() bytes pad #f) (loop (cdr types) int* '() next-varargs-after stack-align))))]
+                     [else
+                      (cons (make-cat 'fp (list (car fp*)) 8 0 #f)
+                            (loop (cdr types) (rest-of int* 0 next-varargs-after)(rest-of fp* 1 next-varargs-after)
+                                  next-varargs-after
+                                  stack-align))])]
+                  [(fp-ftd& ,ftd)
+                   (let* ([size ($ftd-size ftd)]
+                          [members ($ftd->members ftd)]
+                          [num-members (length members)]
+                          [doubles? (and (fx= 8 ($ftd-alignment ftd))
+                                         (fx<= num-members 4)
+                                         (andmap double-member? members))]
+                          [floats? (and (fx= 4 ($ftd-alignment ftd))
+                                        (fx<= num-members 4)
+                                        (andmap float-member? members))])
+                     (cond
+                       [doubles?
+                        ;; Sequence of up to 4 doubles that may fit in registers
                         (cond
-                          [(fx<= regs (length int*))
-                           ;; Fits in registers
-                           (cons (make-cat 'int (list-head int* regs) (align 8 size) 0 #f)
-                                 (loop (cdr types) (rest-of int* regs varargs?) (rest-of fp* 0 varargs?) stack-align))]
+                          [(fx>= (length fp*) num-members)
+                           ;; Allocate each double to a register
+                           (cons (make-cat 'fp (list-head fp* num-members) (fx* 8 num-members) 0 #f)
+                                 (loop (cdr types) (rest-of int* 0 next-varargs-after) (rest-of fp* num-members next-varargs-after)
+                                       next-varargs-after
+                                       stack-align))]
                           [else
-                           ;; Stop using int registers, put on stack
+                           ;; Stop using fp registers, put on stack
+                           (cons (make-cat 'stack '() size 0 #f)
+                                 (loop (cdr types) int* '() next-varargs-after 0))])]
+                       [floats?
+                        ;; Sequence of up to 4 floats that may fit in registers
+                        (cond
+                          [(fx>= (length fp*) num-members)
+                           ;; Allocate each float to a register
+                           (cons (make-cat 'fp (list-head fp* num-members) (fx* 8 num-members) 0 #f)
+                                 (loop (cdr types) (rest-of int* 0 next-varargs-after) (rest-of fp* num-members next-varargs-after)
+                                       next-varargs-after
+                                       stack-align))]
+                          [else
+                           ;; Stop using fp registers, put on stack
                            (alignment-via-lookahead
-                            size (cdr types) stack-align varargs?
+                            size (cdr types) stack-align varargs-after
                             (lambda (size pad stack-align)
                               (cons (make-cat 'stack '() size pad #f)
-                                    (loop (cdr types) '() fp* stack-align))))]))]))]
-                [else
-                 ;; integers, scheme-object, etc.
-                 (cond
-                   [(null? int*) 
-                    (let ([size (nanopass-case (Ltype Type) (car types)
-                                  [(fp-integer ,bits) (fxquotient bits 8)]
-                                  [(fp-unsigned ,bits) (fxquotient bits 8)]
-                                  [else 8])])
-                      (alignment-via-lookahead
-                       size (cdr types) stack-align varargs?
-                       (lambda (size pad stack-align)
-                         (cons (make-cat 'stack '() size pad #f) (loop (cdr types) '() fp* stack-align)))))]
-                   [else
-                    (cons (make-cat 'int (list (car int*)) 8 0 #f)
-                          (loop (cdr types) (rest-of int* 1 varargs?) (rest-of fp* 0 varargs?) stack-align))])])))))
+                                    (loop (cdr types) int* '() next-varargs-after stack-align))))])]
+                       [(fx> size 16)
+                        ;; Indirect; pointer goes in a register or on the stack
+                        (cond
+                          [(null? int*)
+                           ;; Pointer on the stack
+                           (cons (make-cat 'stack '() (constant ptr-bytes) 0 (align 8 size))
+                                 (loop (cdr types) '() fp* next-varargs-after 0))]
+                          [else
+                           ;; Pointer in register
+                           (cons (make-cat 'int (list (car int*)) 8 0 (align 8 size))
+                                 (loop (cdr types) (rest-of int* 1 next-varargs-after) (rest-of fp* 0 next-varargs-after)
+                                       next-varargs-after
+                                       stack-align))])]
+                       [else
+                        ;; Maybe put in integer registers
+                        (let* ([regs (fxquotient (align 8 size) 8)])
+                          (cond
+                            [(fx<= regs (length int*))
+                             ;; Fits in registers
+                             (cons (make-cat 'int (list-head int* regs) (align 8 size) 0 #f)
+                                   (loop (cdr types) (rest-of int* regs next-varargs-after) (rest-of fp* 0 next-varargs-after)
+                                         next-varargs-after
+                                         stack-align))]
+                            [else
+                             ;; Stop using int registers, put on stack
+                             (alignment-via-lookahead
+                              size (cdr types) stack-align varargs-after
+                              (lambda (size pad stack-align)
+                                (cons (make-cat 'stack '() size pad #f)
+                                      (loop (cdr types) '() fp* next-varargs-after stack-align))))]))]))]
+                  [else
+                   ;; integers, scheme-object, etc.
+                   (cond
+                     [(null? int*) 
+                      (let ([size (nanopass-case (Ltype Type) (car types)
+                                    [(fp-integer ,bits) (fxquotient bits 8)]
+                                    [(fp-unsigned ,bits) (fxquotient bits 8)]
+                                    [else 8])])
+                        (alignment-via-lookahead
+                         size (cdr types) stack-align varargs-after
+                         (lambda (size pad stack-align)
+                           (cons (make-cat 'stack '() size pad #f) (loop (cdr types) '() fp* next-varargs-after stack-align)))))]
+                     [else
+                      (cons (make-cat 'int (list (car int*)) 8 0 #f)
+                            (loop (cdr types) (rest-of int* 1 next-varargs-after) (rest-of fp* 0 next-varargs-after)
+                                  next-varargs-after stack-align))])]))))))
 
     (define get-registers
       (lambda (cats kind)
@@ -2892,7 +2910,7 @@
                                   (cdr arg-type*)
                                   arg-type*)]
                    [conv* (info-foreign-conv* info)]
-                   [arg-cat* (categorize-arguments arg-type* (memq 'varargs conv*))]
+                   [arg-cat* (categorize-arguments arg-type* (extract-varargs-after-conv conv*))]
 		   [result-cat (car (categorize-arguments (list result-type) #f))]
                    [result-reg* (cat-regs result-cat)]
 		   [fill-result-here? (and ftd-result?
@@ -3225,7 +3243,7 @@
                                   (cdr arg-type*)
                                   arg-type*)]
 		   [conv* (info-foreign-conv* info)]
-                   [arg-cat* (categorize-arguments arg-type* (memq 'varargs conv*))]
+                   [arg-cat* (categorize-arguments arg-type* (extract-varargs-after-conv conv*))]
                    [result-cat (car (categorize-arguments (list result-type) #f))]
                    [synthesize-first? (and ftd-result?
                                            (not (cat-indirect-bytes result-cat))
diff --git a/racket/src/ChezScheme/s/base-lang.ss b/racket/src/ChezScheme/s/base-lang.ss
index 257d669018..745d6279fa 100644
--- a/racket/src/ChezScheme/s/base-lang.ss
+++ b/racket/src/ChezScheme/s/base-lang.ss
@@ -157,7 +157,9 @@
 
   (define convention?
     (lambda (x)
-      (symbol? x)))
+      (or (symbol? x)
+          (and (pair? x)
+               (eq? 'varargs (car x))))))
 
   (define-record-type preinfo
     (nongenerative #{preinfo e23pkvo5btgapnzomqgegm-2})
diff --git a/racket/src/ChezScheme/s/ftype.ss b/racket/src/ChezScheme/s/ftype.ss
index 6682bf88f6..b2cf68a1d5 100644
--- a/racket/src/ChezScheme/s/ftype.ss
+++ b/racket/src/ChezScheme/s/ftype.ss
@@ -556,7 +556,7 @@ ftype operators:
                       (make-ftd-function rtd/fptr
                         (and defid (symbol->string (syntax->datum defid)))
                         stype #f #f
-                        ($filter-conv 'function-ftype #'(conv ...))
+                        ($filter-conv 'function-ftype #'(conv ...) (length #'(arg-type ...)))
                         (map (lambda (x) (filter-type r x #f)) #'(arg-type ...))
                         (filter-type r #'result-type #t)))]
                    [(packed-kwd ftype)
diff --git a/racket/src/ChezScheme/s/ppc32.ss b/racket/src/ChezScheme/s/ppc32.ss
index 5483cb04c6..cf9bbae6f9 100644
--- a/racket/src/ChezScheme/s/ppc32.ss
+++ b/racket/src/ChezScheme/s/ppc32.ss
@@ -3057,13 +3057,9 @@
                ;; we push all of the int reg args with one push instruction and all of the
                ;; float reg args with another (v)push instruction. It's possible for an argument
                ;; to be split across a register and the stack --- but in that case, there's
-               ;; room just before on the stack to copy in the register. For varrags, the
-               ;; `__varargs` isn't technically enough information, because the ABI is specified
-               ;; in terms of specific unknown arguments (i.e., the part in the "..."); we
-               ;; just assume that all argument except the first are in "...", and that assumption
-               ;; only matters for `double` arguments.
+               ;; room just before on the stack to copy in the register.
                (lambda (types gp-reg-count fp-reg-count init-int-reg-offset float-reg-offset stack-arg-offset
-                              synthesize-first-argument? varargs? return-space-offset)
+                              synthesize-first-argument? varargs-after return-space-offset)
                  (let loop ([types (if synthesize-first-argument? (cdr types) types)]
                             [locs '()]
                             [iint 0]
@@ -3071,133 +3067,144 @@
                             [int-reg-offset init-int-reg-offset]
                             [float-reg-offset float-reg-offset]
                             [stack-arg-offset (fx- stack-arg-offset (fx- stack-arguments-starting-offset
-                                                                         register+stack-arguments-starting-offset))])
-                   (if (null? types)
-                       (let ([locs (reverse locs)])
-                         (if synthesize-first-argument?
-                             (cons (load-stack-address return-space-offset)
-                                   locs)
-                             locs))
-                       (cond
-                         [(nanopass-case (Ltype Type) (car types)
-                            [(fp-double-float) 2]
-                            [(fp-single-float) 1]
-                            [else #f])
-                          => (lambda (width)
-                               (let ([size (fx* width 4)])
-                                 (cond
-                                  [(and (fx< iflt fp-reg-count)
-                                        (or (not varargs?)
-                                            ;; hack: varargs function requires at least one argument
-                                            (fx= int-reg-offset init-int-reg-offset)))
-                                   ;; in FP register
+                                                                         register+stack-arguments-starting-offset))]
+                            [varargs-after varargs-after])
+                   (let ([next-varargs-after (and varargs-after (if (fx> varargs-after 0) (fx- varargs-after 1) 0))])
+                     (if (null? types)
+                         (let ([locs (reverse locs)])
+                           (if synthesize-first-argument?
+                               (cons (load-stack-address return-space-offset)
+                                     locs)
+                               locs))
+                         (cond
+                           [(nanopass-case (Ltype Type) (car types)
+                              [(fp-double-float) 2]
+                              [(fp-single-float) 1]
+                              [else #f])
+                            => (lambda (width)
+                                 (let ([size (fx* width 4)])
+                                   (cond
+                                     [(and (fx< iflt fp-reg-count)
+                                           (not (eq? varargs-after 0)))
+                                      ;; in FP register
+                                      (loop (cdr types)
+                                            (cons (load-double-stack float-reg-offset) locs)
+                                            (fx+ iint width) (fx+ iflt 1) (fx+ int-reg-offset size) (fx+ float-reg-offset size)
+                                            (fx+ stack-arg-offset size)
+                                            next-varargs-after)]
+                                     [(or (not (eq? varargs-after 0))
+                                          (fx>= iint gp-reg-count))
+                                      ;; on stack
+                                      (loop (cdr types)
+                                            (cons (load-double-stack stack-arg-offset) locs)
+                                            iint iflt int-reg-offset float-reg-offset
+                                            (fx+ stack-arg-offset size)
+                                            next-varargs-after)]
+                                     [else ;; => varargs
+                                      ;; in integer register --- but maybe halfway on stack
+                                      (loop (cdr types)
+                                            (cons (if (fx< (fx+ iint 1) gp-reg-count)
+                                                      (load-double-stack int-reg-offset)
+                                                      (load-split-double-stack int-reg-offset (fx+ stack-arg-offset 4)))
+                                                  locs)
+                                            (fx+ iint width) iflt (fx+ int-reg-offset size) float-reg-offset
+                                            (fx+ stack-arg-offset size)
+                                            next-varargs-after)])))]
+                           [(nanopass-case (Ltype Type) (car types)
+                              [(fp-ftd& ,ftd) ftd]
+                              [else #f])
+                            =>
+                            (lambda (ftd)
+                              (let ([members ($ftd->members ftd)])
+                                (cond
+                                  [(and (not ($ftd-union? ftd))
+                                        (pair? members)
+                                        (null? (cdr members))
+                                        (eq? 'float (caar members))
+                                        (fx< iflt fp-reg-count))
+                                   ;; single member as float => in register
+                                   (let ([load-address (case ($ftd-size ftd)
+                                                         [(4) load-stack-address/convert-float]
+                                                         [else load-stack-address])]
+                                         [size ($ftd-size ftd)])
+                                     (loop (cdr types)
+                                           (cons (load-address float-reg-offset) locs)
+                                           (fx+ iint (fxsrl size 2)) (fx+ iflt 1) (fx+ int-reg-offset size) (fx+ float-reg-offset 8)
+                                           (fx+ stack-arg-offset size)
+                                           next-varargs-after))]
+                                  [(memv ($ftd-size ftd) '(1 2))
+                                   ;; byte or word; need to load address into middle
                                    (loop (cdr types)
-                                         (cons (load-double-stack float-reg-offset) locs)
-                                         (fx+ iint width) (fx+ iflt 1) (fx+ int-reg-offset size) (fx+ float-reg-offset size)
-                                         (fx+ stack-arg-offset size))]
-                                  [(or (not varargs?)
-                                       (fx>= iint gp-reg-count))
-                                   ;; on stack
-                                   (loop (cdr types)
-                                         (cons (load-double-stack stack-arg-offset) locs)
-                                         iint iflt int-reg-offset float-reg-offset
-                                         (fx+ stack-arg-offset size))]
-                                  [else ;; => varargs
-                                   ;; in integer register --- but maybe halfway on stack
-                                   (loop (cdr types)
-                                         (cons (if (fx< (fx+ iint 1) gp-reg-count)
-                                                   (load-double-stack int-reg-offset)
-                                                   (load-split-double-stack int-reg-offset (fx+ stack-arg-offset 4)))
+                                         (cons (load-stack-address (fx+ (fx- 4 ($ftd-size ftd))
+                                                                        (if (< iint gp-reg-count)
+                                                                            int-reg-offset
+                                                                            stack-arg-offset)))
                                                locs)
-                                         (fx+ iint width) iflt (fx+ int-reg-offset size) float-reg-offset
-                                         (fx+ stack-arg-offset size))])))]
-                         [(nanopass-case (Ltype Type) (car types)
-                            [(fp-ftd& ,ftd) ftd]
-                            [else #f])
-                          =>
-                          (lambda (ftd)
-                            (let ([members ($ftd->members ftd)])
-                              (cond
-                               [(and (not ($ftd-union? ftd))
-                                     (pair? members)
-                                     (null? (cdr members))
-                                     (eq? 'float (caar members))
-                                     (fx< iflt fp-reg-count))
-                                ;; single member as float => in register
-                                (let ([load-address (case ($ftd-size ftd)
-                                                      [(4) load-stack-address/convert-float]
-                                                      [else load-stack-address])]
-                                      [size ($ftd-size ftd)])
-                                  (loop (cdr types)
-                                        (cons (load-address float-reg-offset) locs)
-                                        (fx+ iint (fxsrl size 2)) (fx+ iflt 1) (fx+ int-reg-offset size) (fx+ float-reg-offset 8)
-                                        (fx+ stack-arg-offset size)))]
-                               [(memv ($ftd-size ftd) '(1 2))
-                                ;; byte or word; need to load address into middle
-                                (loop (cdr types)
-                                      (cons (load-stack-address (fx+ (fx- 4 ($ftd-size ftd))
-                                                                     (if (< iint gp-reg-count)
-                                                                         int-reg-offset
-                                                                         stack-arg-offset)))
-                                            locs)
-                                      (fx+ iint 1) iflt (fx+ int-reg-offset 4) float-reg-offset
-                                      (fx+ stack-arg-offset 4))]
-                               [else
-                                ;; in registers until they run out; copy the registers
-                                ;; to the reserved space just before arguments that
-                                ;; are only on the stack, and then we have a contiguous
-                                ;; object on the stack; except that sizes not a multiple
-                                ;; of 4 are always on the stack and no copying is needed
-                                (let* ([size ($ftd-size ftd)]
-                                       [words (fxsrl (align 4 size) 2)]
-                                       [loc
-                                        (cond
-                                         [(not (fx= size (fx* words 4)))
-                                          (load-stack-address stack-arg-offset)]
-                                         [else
-                                          (let c-loop ([size size] [iint iint] [offset 0])
-                                            (cond
-                                             [(or (fx<= size 0)
-                                                  (fx>= iint gp-reg-count))
+                                         (fx+ iint 1) iflt (fx+ int-reg-offset 4) float-reg-offset
+                                         (fx+ stack-arg-offset 4)
+                                         next-varargs-after)]
+                                  [else
+                                   ;; in registers until they run out; copy the registers
+                                   ;; to the reserved space just before arguments that
+                                   ;; are only on the stack, and then we have a contiguous
+                                   ;; object on the stack; except that sizes not a multiple
+                                   ;; of 4 are always on the stack and no copying is needed
+                                   (let* ([size ($ftd-size ftd)]
+                                          [words (fxsrl (align 4 size) 2)]
+                                          [loc
+                                           (cond
+                                             [(not (fx= size (fx* words 4)))
                                               (load-stack-address stack-arg-offset)]
                                              [else
-                                              (let ([loc (c-loop (fx- size 4) (fx+ iint 1) (fx+ offset 4))]
-                                                    [tmp %Carg8])
-                                                (lambda (lvalue)
-                                                  (%seq
-                                                   (set! ,tmp ,(%mref ,%sp ,(fx+ int-reg-offset offset)))
-                                                   (set! ,(%mref ,%sp ,(fx+ stack-arg-offset offset)) ,tmp)
-                                                   ,(loc lvalue))))]))])])
-                                  (loop (cdr types)
-                                        (cons loc locs)
-                                        (fx+ iint words) iflt (fx+ int-reg-offset (fx* 4 words)) float-reg-offset
-                                        (fx+ stack-arg-offset (fx* 4 words))))])))]
-                         [(nanopass-case (Ltype Type) (car types)
-                            [(fp-integer ,bits) (fx= bits 64)]
-                            [(fp-unsigned ,bits) (fx= bits 64)]
-                            [else #f])
-                          (cond
-                            [(fx< (fx+ iint 1) gp-reg-count)
-                             (loop (cdr types)
-                                   (cons (load-int64-stack int-reg-offset) locs)
-                                   (fx+ iint 2) iflt (fx+ int-reg-offset 8) float-reg-offset (fx+ stack-arg-offset 8))]
-                            [(fx< iint gp-reg-count)
-                             ;; split across a register and the stack
-                             (loop (cdr types)
-                                   (cons (load-split-int64-stack int-reg-offset stack-arg-offset) locs)
-                                   (fx+ iint 1) iflt (fx+ int-reg-offset 4) float-reg-offset (fx+ stack-arg-offset 8))]
-                            [else
-                             (loop (cdr types)
-                                   (cons (load-int64-stack stack-arg-offset) locs)
-                                   iint iflt int-reg-offset float-reg-offset (fx+ stack-arg-offset 8))])]
-                         [else
-                          (if (fx< iint gp-reg-count)
-                              (loop (cdr types)
-                                    (cons (load-int-stack (car types) int-reg-offset) locs)
-                                    (fx+ iint 1) iflt (fx+ int-reg-offset 4) float-reg-offset (fx+ stack-arg-offset 4))
-                              (loop (cdr types)
-                                    (cons (load-int-stack (car types) stack-arg-offset) locs)
-                                    iint iflt int-reg-offset float-reg-offset (fx+ stack-arg-offset 4)))])))))
+                                              (let c-loop ([size size] [iint iint] [offset 0])
+                                                (cond
+                                                  [(or (fx<= size 0)
+                                                       (fx>= iint gp-reg-count))
+                                                   (load-stack-address stack-arg-offset)]
+                                                  [else
+                                                   (let ([loc (c-loop (fx- size 4) (fx+ iint 1) (fx+ offset 4))]
+                                                         [tmp %Carg8])
+                                                     (lambda (lvalue)
+                                                       (%seq
+                                                        (set! ,tmp ,(%mref ,%sp ,(fx+ int-reg-offset offset)))
+                                                        (set! ,(%mref ,%sp ,(fx+ stack-arg-offset offset)) ,tmp)
+                                                        ,(loc lvalue))))]))])])
+                                     (loop (cdr types)
+                                           (cons loc locs)
+                                           (fx+ iint words) iflt (fx+ int-reg-offset (fx* 4 words)) float-reg-offset
+                                           (fx+ stack-arg-offset (fx* 4 words))
+                                           next-varargs-after))])))]
+                           [(nanopass-case (Ltype Type) (car types)
+                              [(fp-integer ,bits) (fx= bits 64)]
+                              [(fp-unsigned ,bits) (fx= bits 64)]
+                              [else #f])
+                            (cond
+                              [(fx< (fx+ iint 1) gp-reg-count)
+                               (loop (cdr types)
+                                     (cons (load-int64-stack int-reg-offset) locs)
+                                     (fx+ iint 2) iflt (fx+ int-reg-offset 8) float-reg-offset (fx+ stack-arg-offset 8)
+                                     next-varargs-after)]
+                              [(fx< iint gp-reg-count)
+                               ;; split across a register and the stack
+                               (loop (cdr types)
+                                     (cons (load-split-int64-stack int-reg-offset stack-arg-offset) locs)
+                                     (fx+ iint 1) iflt (fx+ int-reg-offset 4) float-reg-offset (fx+ stack-arg-offset 8)
+                                     next-varargs-after)]
+                              [else
+                               (loop (cdr types)
+                                     (cons (load-int64-stack stack-arg-offset) locs)
+                                     iint iflt int-reg-offset float-reg-offset (fx+ stack-arg-offset 8)
+                                     next-varargs-after)])]
+                           [else
+                            (if (fx< iint gp-reg-count)
+                                (loop (cdr types)
+                                      (cons (load-int-stack (car types) int-reg-offset) locs)
+                                      (fx+ iint 1) iflt (fx+ int-reg-offset 4) float-reg-offset (fx+ stack-arg-offset 4)
+                                      next-varargs-after)
+                                (loop (cdr types)
+                                      (cons (load-int-stack (car types) stack-arg-offset) locs)
+                                      iint iflt int-reg-offset float-reg-offset (fx+ stack-arg-offset 4)
+                                      next-varargs-after))]))))))
              (define count-reg-args
                (lambda (types gp-reg-count fp-reg-count synthesize-first-argument?)
                  (let f ([types types] [iint (if synthesize-first-argument? -1 0)] [iflt 0])
@@ -3248,7 +3255,7 @@
                ;; we push all of the int reg args with one push instruction and all of the
                ;; float reg args with another (v)push instruction
                (lambda (types gp-reg-count fp-reg-count int-reg-offset float-reg-offset stack-arg-offset
-                              synthesize-first-argument? varargs? return-space-offset)
+                              synthesize-first-argument? varargs-after return-space-offset)
                  (let loop ([types (if synthesize-first-argument? (cdr types) types)]
                             [locs '()]
                             [iint 0]
@@ -3524,7 +3531,8 @@
                        [callee-save-fp-offset (fx+ (fx* isaved 4) callee-save-offset)]
 		       [synthesize-first-argument? (indirect-result-that-fits-in-registers? result-type)]
 		       [adjust-active? (if-feature pthreads (memq 'adjust-active (info-foreign-conv* info)) #f)]
-                       [varargs? (memq 'varargs (info-foreign-conv* info))]
+                       [varargs-after (ormap (lambda (conv) (and (pair? conv) (eq? 'varargs (car conv)) (cdr conv)))
+                                             (info-foreign-conv* info))]
                        [unactivate-mode-offset (fx+ (fx* fpsaved 8) callee-save-fp-offset)]
                        [return-space-offset (align 8 (fx+ unactivate-mode-offset (if adjust-active? 4 0)))]
                        [stack-size (align 16 (fx+ return-space-offset (if synthesize-first-argument? 8 0)))]
@@ -3555,7 +3563,7 @@
                      ; to the Scheme argument locations
                      (do-stack (indirect-result-to-pointer result-type arg-type*)
                                gp-reg-count fp-reg-count int-reg-offset float-reg-offset stack-arg-offset
-			       synthesize-first-argument? varargs? return-space-offset)
+			       synthesize-first-argument? varargs-after return-space-offset)
 		     get-result
 		     (lambda ()
 		       (in-context Tail
diff --git a/racket/src/ChezScheme/s/syntax.ss b/racket/src/ChezScheme/s/syntax.ss
index 0ded1a2fce..aa007026e3 100644
--- a/racket/src/ChezScheme/s/syntax.ss
+++ b/racket/src/ChezScheme/s/syntax.ss
@@ -8934,10 +8934,14 @@
          [else ($oops '$fp-type->pred "unrecognized type ~s" type)])])))
 
 (define $filter-conv
-  (lambda (who conv*)
+  (lambda (who conv* num-args)
     (define squawk
       (lambda (x)
         (syntax-error x (format "invalid ~s convention" who))))
+    (define check-arg-count
+      (lambda (n orig-c)
+        (unless (<= n num-args)
+          (syntax-error orig-c (format "invalid ~s convention with ~a arguments" who num-args)))))
     (let loop ([conv* conv*] [selected #f] [accum '()] [keep-accum '()])
       (cond
         [(null? conv*) (datum->syntax #'filter-conv keep-accum)]
@@ -8948,7 +8952,17 @@
                          (cond
                            [(not c) (values #f #f)]
                            [(eq? c '__collect_safe) (values 'adjust-active #f)]
-                           [(eq? c '__varargs) (values 'varargs #f)]
+                           [(eq? c '__varargs)
+                            (check-arg-count 1 orig-c)
+                            (values (cons 'varargs 1) #f)]
+                           [(and (pair? c) (eq? (car c) '__varargs_after)
+                                 (pair? (cdr c)) (null? (cddr c))
+                                 (let ([i (cadr c)])
+                                   (and (integer? i)
+                                        (exact? i)
+                                        (positive? i))))
+                            (check-arg-count (cadr c) orig-c)
+                            (values (cons 'varargs (cadr c)) #f)]
                            [else
                             (values
                              (case ($target-machine)
@@ -8964,7 +8978,8 @@
                                   [else (squawk orig-c)])]
                                [else (squawk orig-c)])
                              #t)])])
-             (when (member c accum)
+             (when (or (member c accum)
+                       (and (pair? c) (ormap pair? accum)))
                (syntax-error orig-c (format "redundant ~s convention" who)))
              (when (and select? selected)
                (syntax-error orig-c (format "conflicting ~s convention" who)))
@@ -8979,16 +8994,18 @@
       (define (check-strings-allowed)
         (when (memq 'adjust-active (syntax->datum conv*))
           ($oops who "string argument not allowed with __collect_safe procedure")))
-      (define (check-floats-allowed)
-        (when (memq 'varargs (syntax->datum conv*))
-          ($oops who "float argument not allowed for __varargs procedure")))
+      (define (check-floats-allowed pos)
+        (let ([va-n (ormap (lambda (conv) (and (pair? conv) (eq? (car conv) 'varargs) (cdr conv)))
+                           (syntax->datum conv*))])
+          (when (and va-n (>= pos va-n))
+            ($oops who "single-float varargs argument not allowed"))))
       (with-syntax ([conv* conv*]
                     [foreign-name foreign-name]
                     [?foreign-addr ?foreign-addr]
                     [(t ...) (generate-temporaries type*)])
         (with-syntax ([(((check ...) (actual ...) (arg ...)) ...)
                        (map
-                         (lambda (type x)
+                         (lambda (type x pos)
                            (with-syntax ([x x])
                              (or (case type
                                    [(boolean)
@@ -9079,7 +9096,7 @@
                                                         (err ($moi) x)))))
                                        (u32*))]
                                    [(single-float)
-                                    (check-floats-allowed)
+                                    (check-floats-allowed pos)
                                     #f]
                                    [else #f])
                                  (if (or ($ftd? type) ($ftd-as-box? type))
@@ -9092,7 +9109,7 @@
                                        #`(#,(if unsafe? #'() #'((unless (pred x) (err ($moi) x))))
                                           (x)
                                           (type)))))))
-                         type* #'(t ...))]
+                         type* #'(t ...) (enumerate type*))]
                       [(result-filter result)
                        (case result-type
                          [(boolean) #`((lambda (x) (not (eq? x 0)))
@@ -9160,7 +9177,7 @@
       [(_ c ... ?name (arg ...) result)
        (lambda (r)
          ($make-foreign-procedure 'foreign-procedure
-           ($filter-conv 'foreign-procedure #'(c ...))
+           ($filter-conv 'foreign-procedure #'(c ...) (length #'(arg ...)))
            (let ([x (datum ?name)]) (and (string? x) x))
            #'($foreign-entry ?name)
            (map (lambda (x) (filter-type r x #f)) #'(arg ...))
@@ -9176,13 +9193,15 @@
       (define (check-strings-allowed)
         (when (memq 'adjust-active (syntax->datum conv*))
           ($oops who "string result not allowed with __collect_safe callable")))
-      (define (check-floats-allowed)
-        (when (memq 'varargs (syntax->datum conv*))
-          ($oops who "float argument not allowed for __varargs procedure")))
+      (define (check-floats-allowed pos)
+        (let ([va-n (ormap (lambda (conv) (and (pair? conv) (eq? (car conv) 'varargs) (cdr conv)))
+                           (syntax->datum conv*))])
+          (when (and va-n (>= pos va-n))
+            ($oops who "single-float argument not allowed for __varargs procedure"))))
       (with-syntax ([conv* conv*] [?proc ?proc])
         (with-syntax ([((actual (t ...) (arg ...)) ...)
                        (map
-                        (lambda (type)
+                        (lambda (type pos)
                            (or (case type
                                  [(boolean)
                                   (with-syntax ([(x) (generate-temporaries #'(*))])
@@ -9269,12 +9288,12 @@
                                        (x)
                                        (unsigned-64)))]
                                  [(single-float)
-                                  (check-floats-allowed)
+                                  (check-floats-allowed pos)
                                   #f]
                                  [else #f])
                                (with-syntax ([(x) (generate-temporaries #'(*))])
                                  #`(x (x) (#,(datum->syntax #'foreign-callable type))))))
-                         type*)]
+                         type* (enumerate type*))]
                       [(result-filter result [extra-arg ...] [extra ...])
                        (case result-type
                          [(boolean) #`((lambda (x) (if x 1 0))
@@ -9423,7 +9442,7 @@
       [(_ c ... ?proc (arg ...) result)
        (lambda (r)
          ($make-foreign-callable 'foreign-callable
-           ($filter-conv 'foreign-callable #'(c ...))
+           ($filter-conv 'foreign-callable #'(c ...) (length #'(arg ...)))
            #'?proc
            (map (lambda (x) (filter-type r x #f)) #'(arg ...))
            (filter-type r #'result #t)))])))