commit 4ff7a113f3caa6ba18e1dbf87be4adbfb515168e
parent 4397e4001298c337bfdae8d1422a8570f904afaf
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sun, 26 Apr 2026 23:02:21 -0700
cc/cg: variadic receive — cg-fn-begin/v + cg-va-{start,arg,end} (§G.2)
cg-fn-begin/v(name, params, ret, variadic?) reserves 4 contiguous
8-byte slots for incoming arg registers a0..a3 and saves them
unconditionally. The first slot past the named-arg count is the
"vararg-first-slot"; va_start sets ap to its address.
va_list is conceptually a `char*` that the user advances. cg-va-arg
reads 8 bytes through ap, increments ap by 8, and pushes the value
under the requested ctype. cg-va-end is a no-op.
Limitation: only the first 4 incoming args (named + variadic) live
in the saved-register area; variadic args at index >= 4 require an
LDARG path and are not yet supported. Sufficient for the printf-shape
calls tcc.c uses.
Diffstat:
3 files changed, 208 insertions(+), 5 deletions(-)
diff --git a/cc/cg.scm b/cc/cg.scm
@@ -257,6 +257,14 @@
":ELF_end\n")))
(define (cg-fn-begin cg name params return-type)
+ (cg-fn-begin/v cg name params return-type #f))
+
+;; Variadic-aware variant. variadic? = #t reserves 4 contiguous 8-byte
+;; slots for incoming arg registers a0..a3 (named + spillover), and
+;; saves all 4 into them unconditionally. va_start computes the address
+;; of the first slot past the named-arg count. Limitation: variadic
+;; args beyond index 4 require LDARG and are not supported here.
+(define (cg-fn-begin/v cg name params return-type variadic?)
(cg-fn-buf-set! cg (make-buf))
(cg-prologue-buf-set! cg (make-buf))
(cg-vstack-set! cg '())
@@ -266,10 +274,9 @@
(%cg-fn-set! cg '%fn-name name)
(%cg-fn-set! cg '%fn-ret-type return-type)
(%cg-fn-set! cg '%indirect-slots '())
+ (%cg-fn-set! cg '%fn-variadic? variadic?)
(let ((ret-slot (cg-alloc-slot cg 8 8)))
(%cg-fn-set! cg '%fn-ret-slot ret-slot)
- ;; Zero-init the ret slot so `int main() { }` (no explicit return)
- ;; falls through to ::ret with a defined 0 value (CC.md §J.2).
(cond
((not (eq? (ctype-kind return-type) 'void))
(buf-push! (cg-prologue-buf cg)
@@ -278,9 +285,34 @@
(%cg-slot-expr cg ret-slot) ")\n"))))))
;; params per CC-CONTRACTS §3.1: list of (name-bv . ctype). We
;; return an alist (name-bv . sym) the parser binds into scope.
- (let walk ((ps params) (idx 0) (out '()))
+ (let walk ((ps params) (idx 0) (out '()) (first-slot #f))
(cond
- ((null? ps) (reverse out))
+ ((null? ps)
+ (cond
+ (variadic?
+ ;; Allocate slots for the remaining a-registers up through 3
+ ;; so the saved-arg area is always exactly 4 slots wide.
+ ;; Track first-vararg-slot as the offset of the slot whose
+ ;; index equals the named-arg count (= idx here on entry).
+ (let pad ((i idx) (vfirst #f) (fs first-slot))
+ (cond
+ ((>= i 4)
+ ;; If named-arg count was 0, vfirst is the very first
+ ;; slot of the save area (= fs).
+ (%cg-fn-set! cg '%fn-vararg-first-slot
+ (or vfirst fs))
+ (reverse out))
+ (else
+ (let ((off (cg-alloc-slot cg 8 8))
+ (ar (%reg-by-idx i)))
+ (buf-push! (cg-prologue-buf cg)
+ (bv-cat (list "%st(" (%cg-reg->bv ar)
+ ", sp, "
+ (%cg-slot-expr cg off) ")\n")))
+ (pad (+ i 1)
+ (or vfirst off)
+ (or fs off)))))))
+ (else (reverse out))))
(else
(let* ((p (car ps))
(nm (car p))
@@ -297,7 +329,8 @@
(buf-push! (cg-prologue-buf cg)
(bv-cat (list "%ldarg(t0, " (%n (- idx 4)) ")\n"
"%st(t0, sp, " (%cg-slot-expr cg off) ")\n")))))
- (walk (cdr ps) (+ idx 1) (cons (cons nm psym) out)))))))
+ (walk (cdr ps) (+ idx 1) (cons (cons nm psym) out)
+ (or first-slot off)))))))
(define (cg-fn-end cg)
(let* ((name (%cg-fn-get cg '%fn-name))
@@ -749,6 +782,94 @@
(%cg-emit-many cg (list "%continue(" tag ")\n")))
;; --------------------------------------------------------------------
+;; Variadic receive (§G.2). Layout: cg-fn-begin/v reserves a 4-slot
+;; saved-register area at known frame offsets; va_start sets ap to the
+;; address of the first slot past the named-arg count; va_arg reads
+;; *ap, advances ap by 8, and pushes the value as the requested type.
+;;
+;; ap is an lval (typically a `va_list` local). cg-va-start pops it,
+;; computes the address, stores into *ap (or the slot directly), and
+;; pushes nothing. cg-va-arg pops ap-lval, loads ap, dereferences for
+;; the value, advances ap, stores back, pushes the loaded value.
+;;
+;; Limitation: only first 4 incoming args (named + variadic) live in
+;; the save area; variadic args at index >= 4 need LDARG and are not
+;; yet supported. See punchlist §G.2 for the gap.
+;; --------------------------------------------------------------------
+(define (%cg-vararg-first-slot cg)
+ (let ((s (%cg-fn-get cg '%fn-vararg-first-slot)))
+ (cond ((not s) (die #f "cg-va-start: not a variadic function"))
+ (else s))))
+
+(define (cg-va-start cg)
+ ;; Pop ap-lval. Materialize "&sp + vararg-first-slot" into a0,
+ ;; store through ap-lval. Pushes nothing.
+ (let* ((ap-lv (cg-pop cg))
+ (vsl (%cg-vararg-first-slot cg)))
+ (cond ((not (opnd-lval? ap-lv))
+ (die #f "cg-va-start: ap not lvalue")))
+ ;; Compute address into a0.
+ (%cg-emit-many cg (list "%mov(a0, sp)\n"
+ "%addi(a0, a0, "
+ (%cg-slot-expr cg vsl) ")\n"))
+ ;; Store a0 at ap-lval.
+ (cond
+ ((eq? (opnd-kind ap-lv) 'frame)
+ (cond
+ ((%cg-indirect? cg (opnd-ext ap-lv))
+ (%cg-emit-ld-slot cg 't0 (opnd-ext ap-lv))
+ (%cg-emit-st cg 'a0 't0 0))
+ (else (%cg-emit-st-slot cg 'a0 (opnd-ext ap-lv)))))
+ ((eq? (opnd-kind ap-lv) 'global)
+ (%cg-emit-la cg 't0 (opnd-ext ap-lv))
+ (%cg-emit-st cg 'a0 't0 0))
+ (else (die #f "cg-va-start: bad ap kind" (opnd-kind ap-lv))))))
+
+(define (cg-va-arg cg ctype)
+ ;; Pop ap-lval. Load ap into a0. Read 8 bytes at [a0] into a1.
+ ;; Advance a0 by 8 and store back through ap-lval. Push a1 as rval
+ ;; of type ctype (caller cg-cast's if needed).
+ (let* ((ap-lv (cg-pop cg)))
+ (cond ((not (opnd-lval? ap-lv))
+ (die #f "cg-va-arg: ap not lvalue")))
+ ;; Load ap into a0.
+ (cond
+ ((eq? (opnd-kind ap-lv) 'frame)
+ (cond
+ ((%cg-indirect? cg (opnd-ext ap-lv))
+ (%cg-emit-ld-slot cg 't0 (opnd-ext ap-lv))
+ (%cg-emit-ld cg 'a0 't0 0))
+ (else (%cg-emit-ld-slot cg 'a0 (opnd-ext ap-lv)))))
+ ((eq? (opnd-kind ap-lv) 'global)
+ (%cg-emit-la cg 't0 (opnd-ext ap-lv))
+ (%cg-emit-ld cg 'a0 't0 0))
+ (else (die #f "cg-va-arg: bad ap kind" (opnd-kind ap-lv))))
+ ;; Load value at [a0] into a1 (full 8 bytes; cg-cast on the rval
+ ;; the caller pushes will narrow if needed).
+ (%cg-emit-ld cg 'a1 'a0 0)
+ ;; Advance ap by 8.
+ (%cg-emit-many cg (list "%addi(a0, a0, 8)\n"))
+ ;; Store advanced ap back.
+ (cond
+ ((eq? (opnd-kind ap-lv) 'frame)
+ (cond
+ ((%cg-indirect? cg (opnd-ext ap-lv))
+ (%cg-emit-ld-slot cg 't0 (opnd-ext ap-lv))
+ (%cg-emit-st cg 'a0 't0 0))
+ (else (%cg-emit-st-slot cg 'a0 (opnd-ext ap-lv)))))
+ ((eq? (opnd-kind ap-lv) 'global)
+ (%cg-emit-la cg 't0 (opnd-ext ap-lv))
+ (%cg-emit-st cg 'a0 't0 0))
+ (else 0))
+ ;; Spill the loaded value (a1) to a fresh frame slot under ctype.
+ (%cg-spill-reg cg 'a1 ctype)))
+
+(define (cg-va-end cg)
+ ;; va_end is a no-op in this design. Pop and discard ap-lval.
+ (cg-pop cg)
+ 0)
+
+;; --------------------------------------------------------------------
;; Labels and unconditional goto (§F.4 / CC-CONTRACTS §5.3).
;; user_<name> namespace keeps the user's label space disjoint from
;; the compiler-internal ::ret and ::lbl_<n>. Labels resolve through
diff --git a/tests/cc-cg/69-vararg-recv.expected-exit b/tests/cc-cg/69-vararg-recv.expected-exit
@@ -0,0 +1 @@
+21
diff --git a/tests/cc-cg/69-vararg-recv.scm b/tests/cc-cg/69-vararg-recv.scm
@@ -0,0 +1,81 @@
+;; tests/cc-cg/69-vararg-recv.scm — variadic receive: va_start / va_arg /
+;; va_end on three int variadic args (§G.2).
+;;
+;; Models:
+;; int sum(int n, ...) {
+;; va_list ap; va_start(ap, n);
+;; int total = 0;
+;; int i = 0;
+;; while (i < n) { total = total + va_arg(ap, int); i = i + 1; }
+;; va_end(ap);
+;; return total;
+;; }
+;; int main(void) { return sum(3, 5, 7, 9); } /* 21 */
+;;
+;; Limitation: only first 4 incoming args (named + variadic) live in
+;; registers. n=1 named, 3 variadic → fits.
+
+(let* ((cg (cg-init))
+ (sum-fnty (%ctype 'fn 8 8 (cons %t-i32 (cons (list %t-i32) #t))))
+ (sum-sym (%sym "sum" 'fn 'extern sum-fnty #f)))
+ ;; int sum(int n, ...)
+ (let* ((params (cg-fn-begin/v cg "sum"
+ (list (cons "n" %t-i32))
+ %t-i32
+ #t))
+ (n* (cdr (car params)))
+ (ap-ty (%ctype 'ptr 8 8 %t-i8)) ; va_list = char* (just a pointer)
+ (ap-sl (cg-alloc-slot cg 8 8))
+ (ap-sym (%sym "ap" 'var 'auto ap-ty ap-sl))
+ (tot-sl (cg-alloc-slot cg 4 4))
+ (tot-sym (%sym "total" 'var 'auto %t-i32 tot-sl))
+ (i-sl (cg-alloc-slot cg 4 4))
+ (i-sym (%sym "i" 'var 'auto %t-i32 i-sl)))
+ ;; va_start(ap)
+ (cg-push-sym cg ap-sym)
+ (cg-va-start cg)
+ ;; total = 0
+ (cg-push-sym cg tot-sym) (cg-push-imm cg %t-i32 0)
+ (cg-assign cg) (cg-pop cg)
+ ;; i = 0
+ (cg-push-sym cg i-sym) (cg-push-imm cg %t-i32 0)
+ (cg-assign cg) (cg-pop cg)
+ ;; while (i < n)
+ (let ((tag (cg-loop
+ cg
+ (lambda ()
+ (cg-push-sym cg i-sym) (cg-load cg)
+ (cg-push-sym cg n*) (cg-load cg)
+ (cg-binop cg 'lt))
+ (lambda (tag)
+ ;; total = total + va_arg(ap, int)
+ (cg-push-sym cg tot-sym)
+ (cg-push-sym cg tot-sym) (cg-load cg)
+ (cg-push-sym cg ap-sym) (cg-va-arg cg %t-i32)
+ (cg-binop cg 'add)
+ (cg-assign cg) (cg-pop cg)
+ ;; i = i + 1
+ (cg-push-sym cg i-sym)
+ (cg-push-sym cg i-sym) (cg-load cg)
+ (cg-push-imm cg %t-i32 1)
+ (cg-binop cg 'add)
+ (cg-assign cg) (cg-pop cg)))))
+ (cg-loop-end cg tag))
+ ;; va_end(ap)
+ (cg-push-sym cg ap-sym)
+ (cg-va-end cg)
+ ;; return total
+ (cg-push-sym cg tot-sym) (cg-load cg)
+ (cg-return cg)
+ (cg-fn-end cg))
+ ;; int main(void) { return sum(3, 5, 7, 9); }
+ (cg-fn-begin cg "main" '() %t-i32)
+ (cg-push-sym cg sum-sym)
+ (cg-push-imm cg %t-i32 3)
+ (cg-push-imm cg %t-i32 5)
+ (cg-push-imm cg %t-i32 7)
+ (cg-push-imm cg %t-i32 9)
+ (cg-call cg 4 #t)
+ (cg-return cg)
+ (cg-fn-end cg)
+ (write-bv-fd 1 (cg-finish cg)))
