commit a835d6b3630add6a1700ddcb6103208e5bf9d9bf
parent c0af21b7d2e5511016c8989f404945b0d697b8ba
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sun, 26 Apr 2026 22:34:12 -0700
cc/cg: add cg-push-field + array decay (§D.1)
cg-push-field cg fname pops a struct/union lval, looks up the field
in ext's (tag complete? fields) field list, and pushes a new lval
at the field's offset with its ctype. Three lval input cases:
direct frame (shift slot), indirect frame (addr+fo into new
indirect slot), global (la + addi via new indirect slot).
cg-decay-array converts an arr-typed lval at the top into a
ptr-rval to its first element. Wired into cg-load (arr lvals
decay) and cg-take-addr (&arr yields T*, not (T[N])*) so existing
pointer-arithmetic paths see plain pointers.
Locks the contract via cc-cg/36-struct-load.scm: 5 stored to s.a
and 7 to s.b through cg-push-field, then s.b - s.a == 2 returned
as exit 1. The pre-fix parser stub used offset 0 for both fields;
the cg path is independent so this fixture validates the cg API
directly per CC-INTERNALS §Feature workflow.
Diffstat:
3 files changed, 159 insertions(+), 1 deletion(-)
diff --git a/cc/cg.scm b/cc/cg.scm
@@ -398,12 +398,119 @@
(cg-push cg (%opnd 'frame pe off #t)))))))
;; --------------------------------------------------------------------
+;; Aggregate field access (§D.1–D.4)
+;; --------------------------------------------------------------------
+;; cg-push-field cg fname:
+;; pop a struct/union lval; look up `fname` in the struct's fields
+;; list (data.scm: ext = (tag complete? fields), where each field
+;; is (name-bv ctype offset)); push a new lval at the field's
+;; offset with the field's ctype.
+;;
+;; Three input cases:
+;; - direct frame lval at slot `off` -> frame lval at off+fo
+;; - indirect frame lval (slot holds addr) -> new indirect slot for
+;; addr+fo
+;; - global lval at label L -> indirect slot for
+;; la(L)+fo
+;; In all cases the resulting lval has the field's ctype.
+
+(define (%cg-find-field fields fname)
+ (let loop ((xs fields))
+ (cond
+ ((null? xs) #f)
+ ((bv= (car (car xs)) fname) (car xs))
+ (else (loop (cdr xs))))))
+
+(define (cg-push-field cg fname)
+ (let* ((s (cg-pop cg))
+ (sty (opnd-type s))
+ (k (ctype-kind sty)))
+ (cond
+ ((not (or (eq? k 'struct) (eq? k 'union)))
+ (die #f "cg-push-field: not a struct/union" k))
+ ((not (opnd-lval? s))
+ (die #f "cg-push-field: not an lvalue" k))
+ (else
+ (let* ((fields (car (cddr (ctype-ext sty))))
+ (f (%cg-find-field fields fname)))
+ (cond
+ ((not f) (die #f "cg-push-field: no such field" fname))
+ (else
+ (let* ((fty (cadr f)) (fo (car (cddr f))))
+ (cond
+ ;; direct frame lval: just shift the slot offset.
+ ((and (eq? (opnd-kind s) 'frame)
+ (not (%cg-indirect? cg (opnd-ext s))))
+ (cg-push cg (%opnd 'frame fty (+ (opnd-ext s) fo) #t)))
+ ;; indirect frame lval: addr lives in the slot. Compute
+ ;; addr+fo into a new indirect slot.
+ ((eq? (opnd-kind s) 'frame)
+ (%cg-emit-ld-slot cg 't0 (opnd-ext s))
+ (cond
+ ((> fo 0)
+ (%cg-emit-many cg (list "%addi(t0, t0, " (%n fo) ")\n"))))
+ (let ((no (cg-alloc-slot cg 8 8)))
+ (%cg-emit-st-slot cg 't0 no)
+ (%cg-mark-indirect! cg no)
+ (cg-push cg (%opnd 'frame fty no #t))))
+ ;; global lval: load addr, add offset, indirect slot.
+ ((eq? (opnd-kind s) 'global)
+ (%cg-emit-la cg 't0 (opnd-ext s))
+ (cond
+ ((> fo 0)
+ (%cg-emit-many cg (list "%addi(t0, t0, " (%n fo) ")\n"))))
+ (let ((no (cg-alloc-slot cg 8 8)))
+ (%cg-emit-st-slot cg 't0 no)
+ (%cg-mark-indirect! cg no)
+ (cg-push cg (%opnd 'frame fty no #t))))
+ (else
+ (die #f "cg-push-field: unsupported lval kind"
+ (opnd-kind s))))))))))))
+
+;; cg-decay-array:
+;; if top of vstack is an arr-typed lval, replace it with a ptr-rval
+;; to the first element. C arrays decay to T* in most contexts;
+;; parse calls this before rval-style operations. No-op otherwise.
+(define (cg-decay-array cg)
+ (let ((tp (cg-top cg)))
+ (cond
+ ((and (opnd-lval? tp) (eq? (ctype-kind (opnd-type tp)) 'arr))
+ (let* ((p (cg-pop cg))
+ (et (car (ctype-ext (opnd-type p))))
+ (pty (%ctype 'ptr 8 8 et)))
+ (cond
+ ;; direct frame lval: address is sp+off.
+ ((and (eq? (opnd-kind p) 'frame)
+ (not (%cg-indirect? cg (opnd-ext p))))
+ (%cg-emit-many cg (list "%mov(t0, sp)\n"
+ "%addi(t0, t0, "
+ (%cg-slot-expr cg (opnd-ext p)) ")\n"))
+ (%cg-spill-reg cg 't0 pty))
+ ;; indirect frame lval (rare for arrays, but support it):
+ ;; the slot holds the address already.
+ ((eq? (opnd-kind p) 'frame)
+ (%cg-emit-ld-slot cg 't0 (opnd-ext p))
+ (%cg-spill-reg cg 't0 pty))
+ ;; global array: la(label) is the address.
+ ((eq? (opnd-kind p) 'global)
+ (%cg-emit-la cg 't0 (opnd-ext p))
+ (%cg-spill-reg cg 't0 pty))
+ (else (die #f "cg-decay-array: unsupported lval kind"
+ (opnd-kind p))))))
+ (else tp))))
+
+;; --------------------------------------------------------------------
;; Address & deref
;; --------------------------------------------------------------------
(define (cg-take-addr cg)
(let* ((p (cg-pop cg))
(ty (opnd-type p))
- (pty (%ctype 'ptr 8 8 ty)))
+ ;; &arr yields T*, not (T[N])*. Result type is ptr-to-elem
+ ;; for arrays so subsequent pointer arithmetic scales by
+ ;; element size, not by array size.
+ (pty (cond ((eq? (ctype-kind ty) 'arr)
+ (%ctype 'ptr 8 8 (car (ctype-ext ty))))
+ (else (%ctype 'ptr 8 8 ty)))))
(cond
((not (opnd-lval? p))
(die #f "cg-take-addr: not an lvalue"))
@@ -429,6 +536,11 @@
(let* ((p (cg-pop cg)) (ty (opnd-type p)))
(cond
((not (opnd-lval? p)) (die #f "cg-load: not an lvalue"))
+ ;; Array lvalues decay to a ptr-rval addressing the first
+ ;; element (C array-to-pointer decay). We push the lval back
+ ;; and route through cg-decay-array for a single source of truth.
+ ((eq? (ctype-kind ty) 'arr)
+ (cg-push cg p) (cg-decay-array cg))
((and (eq? (opnd-kind p) 'frame)
(%cg-indirect? cg (opnd-ext p)))
;; Indirect frame-lval: slot holds the address. Stage the
diff --git a/tests/cc-cg/36-struct-load.expected-exit b/tests/cc-cg/36-struct-load.expected-exit
@@ -0,0 +1 @@
+1
diff --git a/tests/cc-cg/36-struct-load.scm b/tests/cc-cg/36-struct-load.scm
@@ -0,0 +1,45 @@
+;; tests/cc-cg/36-struct-load.scm — struct member load via cg-push-field
+;; (§D.1 of docs/CC-PUNCHLIST.md).
+;;
+;; Models:
+;; struct S { int a; int b; };
+;; struct S s;
+;; s.a = 5; s.b = 7; <- using direct cg-push-field + cg-assign
+;; return s.b - s.a; <- 2; assert (s.b - s.a == 2) -> exit 1
+;;
+;; If cg-push-field is the broken stub it would access offset 0 for
+;; both fields, so loading s.b would also yield 5 and the equality
+;; check would fail (exit 0). With correct field-offset arithmetic
+;; the result is 2 and exit is 1.
+
+(let* ((cg (cg-init))
+ (st-ty (%ctype 'struct 8 4
+ (list "S" #t
+ (list (list "a" %t-i32 0)
+ (list "b" %t-i32 4))))))
+ (cg-fn-begin cg "main" '() %t-i32)
+ (let* ((off-s (cg-alloc-slot cg 8 4))
+ (sym-s (%sym "s" 'var 'auto st-ty off-s)))
+ ;; s.a = 5
+ (cg-push-sym cg sym-s)
+ (cg-push-field cg "a")
+ (cg-push-imm cg %t-i32 5)
+ (cg-assign cg) (cg-pop cg)
+ ;; s.b = 7
+ (cg-push-sym cg sym-s)
+ (cg-push-field cg "b")
+ (cg-push-imm cg %t-i32 7)
+ (cg-assign cg) (cg-pop cg)
+ ;; return (s.b - s.a) == 2
+ (cg-push-sym cg sym-s)
+ (cg-push-field cg "b")
+ (cg-load cg)
+ (cg-push-sym cg sym-s)
+ (cg-push-field cg "a")
+ (cg-load cg)
+ (cg-binop cg 'sub)
+ (cg-push-imm cg %t-i32 2)
+ (cg-binop cg 'eq)
+ (cg-return cg))
+ (cg-fn-end cg)
+ (write-bv-fd 1 (cg-finish cg)))
