commit 7f277cdbe7b4960775d934f9cba0e02520909e67
parent 8df96c90a922b7aef70f245f4dc22278c4d50eb6
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Mon, 27 Apr 2026 13:43:10 -0700
cc: struct return — one-word and two-word direct conventions (A1)
Wires the ≤8B and 9–16B direct return conventions from P1.md
§Arguments and return values:
- cg-fn-begin/v sizes the return slot to max(8, ctype-size(ret-type)),
zeros the full slot in the prologue.
- cg-fn-end loads a0 always; loads a1 too when ret-type size > 8.
- cg-return on a struct/union ret-type copies bytes from the source
lval into the function's return slot (per-byte %lb/%sb pairs).
- cg-call detects struct/union returns ≤16B, allocates a fresh frame
slot per call site, stores back from a0 (and a1 for 9–16B), and
pushes a struct frame-lval — so chained `f().field` and consecutive
calls with the result aliased into separate locals both work.
- New cg-copy-struct primitive (per-byte memcpy between two struct
lvals) for parser-side struct = call() initialization.
- parse-return-stmt skips rval!/cg-cast for struct returns and lets
cg-return do the slot copy directly.
- parse-init-local handles `struct T x = expr;` via cg-copy-struct.
Updates CC-CONTRACTS.md §3.2 to describe the three conventions and
point at the P1.md spec; A2 (indirect-result, >16B) is the next step.
Tests:
- New cc-cg fixtures 70-struct-ret-1word, 71-struct-ret-2word.
- cc/111-struct-ret-1word, cc/112-struct-ret-2word now pass.
- cc/114 and cc/116 (2-word returns + many args / variadic) pass
incidentally — A1's two-word receive composes with the existing
stack-stage and variadic save-area paths.
- cc/113, 115, 117, 118, 082, 087 still fail (other streams).
Diffstat:
6 files changed, 283 insertions(+), 18 deletions(-)
diff --git a/cc/cc.scm b/cc/cc.scm
@@ -2526,14 +2526,27 @@
(%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)))
+ ;; Return slot. Per P1.md §Arguments and return values, results ≤8B
+ ;; ride a single word; 9–16B aggregates ride two words. We size the
+ ;; slot to max(8, ctype-size), 8-byte aligned, so cg-fn-end can load
+ ;; a0 (always) and a1 (when size > 8) directly from it.
+ (let* ((rsz (cond ((eq? (ctype-kind return-type) 'void) 8)
+ (else (align-up (max 8 (ctype-size return-type)) 8))))
+ (ret-slot (cg-alloc-slot cg rsz 8)))
(%cg-fn-set! cg '%fn-ret-slot ret-slot)
(cond
((not (eq? (ctype-kind return-type) 'void))
- (buf-push! (cg-prologue-buf cg)
- (bv-cat (list "%li(t0, 0)\n"
- "%st(t0, sp, "
- (%cg-slot-expr cg ret-slot) ")\n"))))))
+ ;; Zero the full ret slot (one %st per 8 bytes).
+ (let zinit ((k 0))
+ (cond
+ ((>= k rsz) #t)
+ (else
+ (buf-push! (cg-prologue-buf cg)
+ (bv-cat (list "%li(t0, 0)\n"
+ "%st(t0, sp, "
+ (%cg-slot-expr cg (+ ret-slot k))
+ ")\n")))
+ (zinit (+ k 8))))))))
;; 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 '()) (first-slot #f))
@@ -2626,7 +2639,9 @@
;; prologue + body, drained byte-for-byte
(buf-drain! tb (cg-prologue-buf cg))
(buf-drain! tb (cg-fn-buf cg))
- ;; ret block
+ ;; ret block — per P1.md §Arguments and return values, ≤8B uses
+ ;; the one-word direct convention (result in a0); 9–16B uses the
+ ;; two-word direct convention (a0 = word 0, a1 = word 1).
(buf-push! tb "::ret\n")
(cond
((eq? (ctype-kind ret-type) 'void)
@@ -2634,7 +2649,12 @@
(else
(buf-push! tb "%ld(a0, sp, ")
(buf-push! tb (%cg-slot-expr cg ret-slot))
- (buf-push! tb ")\n")))
+ (buf-push! tb ")\n")
+ (cond
+ ((> (ctype-size ret-type) 8)
+ (buf-push! tb "%ld(a1, sp, ")
+ (buf-push! tb (%cg-slot-expr cg (+ ret-slot 8)))
+ (buf-push! tb ")\n")))))
(buf-push! tb "})\n")
(cg-vstack-set! cg '())
(cg-frame-hi-set! cg 0)
@@ -2859,6 +2879,60 @@
;; --------------------------------------------------------------------
;; Address & deref
;; --------------------------------------------------------------------
+
+;; Materialize the address of an lval `op` directly into `reg`.
+;; Variant of cg-take-addr that doesn't spill — used by struct copy
+;; primitives (cg-return on struct, cg-call's struct receive). Caller
+;; owns the lval (already popped).
+(define (%cg-emit-addr-of cg op reg)
+ (cond
+ ((not (opnd-lval? op)) (die #f "cg-emit-addr-of: not an lvalue"))
+ (else
+ (let ((reg-bv (%cg-reg->bv reg)))
+ (pmatch op
+ (($ opnd? (kind frame) (ext ,off))
+ (guard (%cg-indirect? cg off))
+ (%cg-emit-ld-slot cg reg off))
+ (($ opnd? (kind frame) (ext ,off))
+ (%cg-emit-many cg (list "%mov(" reg-bv ", sp)\n"
+ "%addi(" reg-bv ", " reg-bv ", "
+ (%cg-slot-expr cg off) ")\n")))
+ (($ opnd? (kind global) (ext ,lbl))
+ (%cg-emit-la cg reg lbl))
+ (else (die #f "cg-emit-addr-of: unsupported lval kind"
+ (opnd-kind op))))))))
+
+;; cg-copy-struct: pop src lval, pop dst lval, emit per-byte copy
+;; from src to dst (both must be lvals of the same struct/union type).
+;; Used by parser for struct-typed assignment / initializer-from-call
+;; targets. Pushes nothing.
+(define (cg-copy-struct cg)
+ (let* ((src (cg-pop cg))
+ (dst (cg-pop cg))
+ (sty (opnd-type dst))
+ (sz (ctype-size sty)))
+ (cond
+ ((not (opnd-lval? src)) (die #f "cg-copy-struct: src not lvalue"))
+ ((not (opnd-lval? dst)) (die #f "cg-copy-struct: dst not lvalue")))
+ (%cg-emit-addr-of cg src 't0)
+ (%cg-emit-addr-of cg dst 't2)
+ (%cg-emit-byte-copy cg 't2 't0 't1 sz)))
+
+;; Per-byte struct copy. dst-reg and src-reg hold addresses; emits
+;; size byte-load/byte-store pairs using tmp-reg as the byte staging
+;; register. All three regs are assumed caller-saved temporaries.
+(define (%cg-emit-byte-copy cg dst-reg src-reg tmp-reg size)
+ (let ((dr (%cg-reg->bv dst-reg))
+ (sr (%cg-reg->bv src-reg))
+ (tr (%cg-reg->bv tmp-reg)))
+ (let loop ((k 0))
+ (cond
+ ((>= k size) #t)
+ (else
+ (%cg-emit-many cg (list "%lb(" tr ", " sr ", " (%n k) ")\n"
+ "%sb(" tr ", " dr ", " (%n k) ")\n"))
+ (loop (+ k 1)))))))
+
(define (cg-take-addr cg)
(let* ((p (cg-pop cg))
(ty (opnd-type p))
@@ -3169,19 +3243,56 @@
((eq? (ctype-kind fty) 'ptr)
(let ((p (ctype-ext fty)))
(if (eq? (ctype-kind p) 'fn) (car (ctype-ext p)) %t-i64)))
- (else %t-i64))))
- (%cg-spill-reg cg 'a0 rty)))
+ (else %t-i64)))
+ (rk (ctype-kind rty)))
+ (cond
+ ;; Struct/union return ≤16B (Stream A1, P1.md §Arguments
+ ;; and return values). Allocate a fresh frame slot sized to
+ ;; the struct, store back from a0 (word 0) and a1 (word 1
+ ;; when size > 8), and push a struct frame-lval. Fresh slot
+ ;; per call site so chained `f().field` and consecutive
+ ;; calls don't alias.
+ ((and (or (eq? rk 'struct) (eq? rk 'union))
+ (<= (ctype-size rty) 16))
+ (let* ((sz (ctype-size rty))
+ (al (max 8 (ctype-align rty)))
+ (slot (cg-alloc-slot cg (align-up sz 8) al)))
+ (%cg-emit-st-slot cg 'a0 slot)
+ (cond
+ ((> sz 8)
+ (%cg-emit-st-slot cg 'a1 (+ slot 8))))
+ (cg-push cg (%opnd 'frame rty slot #t))))
+ (else
+ (%cg-spill-reg cg 'a0 rty)))))
(else #f))))
;; --------------------------------------------------------------------
;; Return
;; --------------------------------------------------------------------
(define (cg-return cg)
- (let ((ret-slot (%cg-fn-get cg '%fn-ret-slot))
- (ret-type (%cg-fn-get cg '%fn-ret-type)))
+ (let* ((ret-slot (%cg-fn-get cg '%fn-ret-slot))
+ (ret-type (%cg-fn-get cg '%fn-ret-type))
+ (rk (ctype-kind ret-type)))
(cond
- ((eq? (ctype-kind ret-type) 'void)
+ ((eq? rk 'void)
(%cg-emit-many cg (list "%b(&::ret)\n")))
+ ((or (eq? rk 'struct) (eq? rk 'union))
+ ;; Struct-by-value return (Stream A1, P1.md §Arguments and
+ ;; return values): copy bytes from the source lval into the
+ ;; function's return slot. cg-fn-end then loads a0 (and a1
+ ;; for 9–16B) at the epilogue.
+ (let* ((p (cg-pop cg))
+ (sz (ctype-size ret-type)))
+ (cond
+ ((not (opnd-lval? p))
+ (die #f "cg-return: struct value must be an lvalue")))
+ ;; Materialize src addr into t0; dst (ret-slot) addr into t2.
+ (%cg-emit-addr-of cg p 't0)
+ (%cg-emit-many cg (list "%mov(t2, sp)\n"
+ "%addi(t2, t2, "
+ (%cg-slot-expr cg ret-slot) ")\n"))
+ (%cg-emit-byte-copy cg 't2 't0 't1 sz)
+ (%cg-emit-many cg (list "%b(&::ret)\n"))))
(else
(let ((p (cg-pop cg)))
(%cg-load-opnd-into cg p 'a0)
@@ -4261,6 +4372,15 @@
(and (eq? (ctype-kind ty) 'arr)
(eq? (tok-kind (peek ps)) 'STR)))
(parse-init-local-aggregate ps sm ty))
+ ;; Struct/union initializer from a non-brace expression
+ ;; (typically a function call returning by-value, per
+ ;; Stream A1). The expr produces a struct lval; we copy
+ ;; bytes into the destination slot.
+ ((or (eq? (ctype-kind ty) 'struct)
+ (eq? (ctype-kind ty) 'union))
+ (cg-push-sym (ps-cg ps) sm)
+ (parse-expr-bp ps 4)
+ (cg-copy-struct (ps-cg ps)))
(else
(cg-push-sym (ps-cg ps) sm)
(parse-expr-bp ps 4) (rval! ps)
@@ -5035,13 +5155,23 @@
(cond
((at-punct? ps 'semi) (advance ps) (cg-return (ps-cg ps)))
(else
- (parse-expr ps) (rval! ps)
- (let ((fc (ps-fn-ctx ps)))
+ (let* ((fc (ps-fn-ctx ps))
+ (rty (and fc (fn-ctx-return-type fc)))
+ (rk (and rty (ctype-kind rty))))
(cond
- ((and fc (not (eq? (ctype-kind (fn-ctx-return-type fc)) 'void)))
- (cg-cast (ps-cg ps) (fn-ctx-return-type fc)))
- (else #t)))
- (cg-return (ps-cg ps))
+ ;; Struct/union return — leave the source as a struct lval;
+ ;; cg-return copies bytes into the function's return slot.
+ ;; (Stream A1, P1.md §Arguments and return values.)
+ ((or (eq? rk 'struct) (eq? rk 'union))
+ (parse-expr ps)
+ (cg-return (ps-cg ps)))
+ (else
+ (parse-expr ps) (rval! ps)
+ (cond
+ ((and fc (not (eq? rk 'void)))
+ (cg-cast (ps-cg ps) rty))
+ (else #t))
+ (cg-return (ps-cg ps)))))
(expect-punct ps 'semi))))
(define (parse-goto-stmt ps)
diff --git a/docs/CC-CONTRACTS.md b/docs/CC-CONTRACTS.md
@@ -300,6 +300,7 @@ cg:
<fn-buf bytes>
::ret
LD a0, [sp + <return-slot>]
+ ; LD a1, [sp + <return-slot> + 8] when ret-type size > 8
})
```
4. Flushes the result into `cg-text`, clears `fn-buf` and the
@@ -309,6 +310,21 @@ cg:
The frame size is rounded up to 16 to satisfy the P1 stack-align
contract.
+The return slot itself is sized to `max(8, ctype-size(ret-type))`
+rounded up to 8, 8-byte aligned. Slot width is what dispatches the
+load epilogue across the three result conventions defined in
+[P1.md §Arguments and return values](P1.md#arguments-and-return-values):
+
+| Width | Convention | Epilogue |
+|---|---|---|
+| ≤ 8B | one-word direct | `LD a0, [sp + slot]` |
+| 9–16B | two-word direct | `LD a0, [sp + slot]; LD a1, [sp + slot + 8]` |
+| > 16B | indirect-result | (Stream A2) caller passes buffer in a0; callee writes through it; epilogue restores a0 |
+
+The cg lowers all three conventions; the parser surface (return
+statement, struct-typed call result) is identical regardless of
+which convention applies.
+
### 3.3 Loop tag protocol
```scheme
diff --git a/tests/cc-cg/70-struct-ret-1word.expected-exit b/tests/cc-cg/70-struct-ret-1word.expected-exit
@@ -0,0 +1 @@
+97
diff --git a/tests/cc-cg/70-struct-ret-1word.scm b/tests/cc-cg/70-struct-ret-1word.scm
@@ -0,0 +1,59 @@
+;; tests/cc-cg/70-struct-ret-1word.scm — one-word direct struct return.
+;;
+;; Models:
+;; struct S { int a; int b; };
+;; struct S make(int a, int b) { struct S s; s.a = a; s.b = b; return s; }
+;; int main(void) {
+;; struct S r = make(7, 9);
+;; return r.a + r.b * 10; /* 97 */
+;; }
+;;
+;; Exercises Stream A1's one-word direct return convention (P1.md
+;; §Arguments and return values): result word 0 in a0; cg-fn-end emits
+;; LD a0, [sp + ret-slot] at exit; cg-call's receive side allocates a
+;; fresh frame slot sized to the return ctype, stores back from a0,
+;; and pushes a struct frame-lval so chained .field works.
+
+(let* ((cg (cg-init))
+ (st-ty (%ctype 'struct 8 4
+ (list "S" #t
+ (list (list "a" %t-i32 0)
+ (list "b" %t-i32 4)))))
+ (fn-ty (%ctype 'fn 8 8
+ (cons st-ty (cons (list %t-i32 %t-i32) #f))))
+ (make-sym (%sym "make" 'fn 'extern fn-ty #f)))
+ ;; struct S make(int a, int b) { ... return s; }
+ (let* ((params (cg-fn-begin cg "make"
+ (list (cons "a" %t-i32) (cons "b" %t-i32))
+ st-ty))
+ (a* (cdr (car params)))
+ (b* (cdr (cadr params)))
+ (s-off (cg-alloc-slot cg 8 4))
+ (s-sym (%sym "s" 'var 'auto st-ty s-off)))
+ ;; s.a = a
+ (cg-push-sym cg s-sym) (cg-push-field cg "a")
+ (cg-push-sym cg a*) (cg-load cg)
+ (cg-assign cg) (cg-pop cg)
+ ;; s.b = b
+ (cg-push-sym cg s-sym) (cg-push-field cg "b")
+ (cg-push-sym cg b*) (cg-load cg)
+ (cg-assign cg) (cg-pop cg)
+ ;; return s — struct-typed return
+ (cg-push-sym cg s-sym)
+ (cg-return cg)
+ (cg-fn-end cg))
+ ;; int main(void) { struct S r = make(7, 9); return r.a + r.b * 10; }
+ (cg-fn-begin cg "main" '() %t-i32)
+ (cg-push-sym cg make-sym)
+ (cg-push-imm cg %t-i32 7)
+ (cg-push-imm cg %t-i32 9)
+ (cg-call cg 2 #t) ; pushes struct lval (recv slot)
+ ;; The result is a struct lval. Read .a and .b.
+ (let ((r-lval (cg-pop cg)))
+ (cg-push cg r-lval) (cg-push-field cg "a") (cg-load cg)
+ (cg-push cg r-lval) (cg-push-field cg "b") (cg-load cg)
+ (cg-push-imm cg %t-i32 10) (cg-binop cg 'mul)
+ (cg-binop cg 'add))
+ (cg-return cg)
+ (cg-fn-end cg)
+ (write-bv-fd 1 (cg-finish cg)))
diff --git a/tests/cc-cg/71-struct-ret-2word.expected-exit b/tests/cc-cg/71-struct-ret-2word.expected-exit
@@ -0,0 +1 @@
+33
diff --git a/tests/cc-cg/71-struct-ret-2word.scm b/tests/cc-cg/71-struct-ret-2word.scm
@@ -0,0 +1,58 @@
+;; tests/cc-cg/71-struct-ret-2word.scm — two-word direct struct return.
+;;
+;; Models:
+;; struct P { long a; long b; }; /* 16 bytes */
+;; struct P pair(long a, long b) {
+;; struct P p; p.a = a; p.b = b; return p;
+;; }
+;; int main(void) {
+;; struct P q = pair(11, 22);
+;; return (int)(q.a + q.b); /* 33 */
+;; }
+;;
+;; Exercises Stream A1's two-word direct return convention (P1.md
+;; §Arguments and return values): word 0 in a0, word 1 in a1; cg-fn-end
+;; loads both at exit; cg-call's receive side allocates a 16-byte slot
+;; and stores back from a0 (word 0) and a1 (word 1).
+
+(let* ((cg (cg-init))
+ (pair-ty (%ctype 'struct 16 8
+ (list "P" #t
+ (list (list "a" %t-i64 0)
+ (list "b" %t-i64 8)))))
+ (fn-ty (%ctype 'fn 8 8
+ (cons pair-ty (cons (list %t-i64 %t-i64) #f))))
+ (pair-sym (%sym "pair" 'fn 'extern fn-ty #f)))
+ ;; struct P pair(long a, long b) { ... return p; }
+ (let* ((params (cg-fn-begin cg "pair"
+ (list (cons "a" %t-i64) (cons "b" %t-i64))
+ pair-ty))
+ (a* (cdr (car params)))
+ (b* (cdr (cadr params)))
+ (p-off (cg-alloc-slot cg 16 8))
+ (p-sym (%sym "p" 'var 'auto pair-ty p-off)))
+ ;; p.a = a
+ (cg-push-sym cg p-sym) (cg-push-field cg "a")
+ (cg-push-sym cg a*) (cg-load cg)
+ (cg-assign cg) (cg-pop cg)
+ ;; p.b = b
+ (cg-push-sym cg p-sym) (cg-push-field cg "b")
+ (cg-push-sym cg b*) (cg-load cg)
+ (cg-assign cg) (cg-pop cg)
+ ;; return p
+ (cg-push-sym cg p-sym)
+ (cg-return cg)
+ (cg-fn-end cg))
+ ;; int main(void) { struct P q = pair(11, 22); return q.a + q.b; }
+ (cg-fn-begin cg "main" '() %t-i32)
+ (cg-push-sym cg pair-sym)
+ (cg-push-imm cg %t-i64 11)
+ (cg-push-imm cg %t-i64 22)
+ (cg-call cg 2 #t)
+ (let ((q-lval (cg-pop cg)))
+ (cg-push cg q-lval) (cg-push-field cg "a") (cg-load cg)
+ (cg-push cg q-lval) (cg-push-field cg "b") (cg-load cg)
+ (cg-binop cg 'add))
+ (cg-return cg)
+ (cg-fn-end cg)
+ (write-bv-fd 1 (cg-finish cg)))
