commit 07aa6dbc034fab8c9f43999169b2192e7569e0d5
parent bc60420d39eb7005a0f28306a697d40171461f43
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Mon, 27 Apr 2026 11:54:47 -0700
cc/cg: use pmatch record patterns for opnd/sym dispatch
Migrates 6 opnd-kind / sym-kind dispatch sites from cond+(eq? (opnd-kind p)
'frame) chains to pmatch with ($ opnd? (kind ...) (ext ...) ...) patterns:
%cg-load-opnd-into, cg-push-sym, cg-push-field, cg-decay-array,
cg-take-addr, cg-assign, cg-va-arg. cg-va-arg shrinks the most since the
same dispatch ran twice (load ap, store ap). cg-push-sym's nested
sym-kind/sym-storage cond flattens into one pattern per kind+storage pair.
Pure refactor; no behavior change.
Diffstat:
| M | cc/cg.scm | | | 201 | +++++++++++++++++++++++++++++++++++++------------------------------------------ |
1 file changed, 95 insertions(+), 106 deletions(-)
diff --git a/cc/cg.scm b/cc/cg.scm
@@ -182,25 +182,21 @@
(else (%cg-emit-st cg reg base off)))))
(define (%cg-load-opnd-into cg op reg)
- (let ((kind (opnd-kind op)) (lv? (opnd-lval? op))
- (ext (opnd-ext op)) (ty (opnd-type op)))
- (cond
- ((eq? kind 'imm) (%cg-emit-li cg reg ext))
- ;; frame lval: load value at type width. frame rval is a spilled
- ;; word (alloc-slot 8 8 in %cg-spill-reg) — always 8-byte load.
- ((eq? kind 'frame)
- (cond (lv? (%cg-emit-ld-slot-typed cg reg ty ext))
- (else (%cg-emit-ld-slot cg reg ext))))
- ((eq? kind 'global)
- (cond
- ((not lv?) (%cg-emit-la cg reg ext))
- (else
- ;; Width > 1 byte-gathers must not alias dest with base —
- ;; the first %lb would otherwise clobber the address before
- ;; subsequent byte loads. Stage the address in t2.
- (%cg-emit-la cg 't2 ext)
- (%cg-emit-ld-typed cg reg ty 't2 0))))
- (else (die #f "cg internal: unknown opnd-kind" kind)))))
+ ;; frame lval: load at type width. frame rval is a spilled word
+ ;; (alloc-slot 8 8 in %cg-spill-reg) — always 8-byte load.
+ ;; global lval width > 1 byte-gathers must not alias dest with base —
+ ;; the first %lb would otherwise clobber the address before subsequent
+ ;; byte loads. Stage the address in t2.
+ (pmatch op
+ (($ opnd? (kind imm) (ext ,n)) (%cg-emit-li cg reg n))
+ (($ opnd? (kind frame) (lval? #t) (type ,ty) (ext ,off))
+ (%cg-emit-ld-slot-typed cg reg ty off))
+ (($ opnd? (kind frame) (ext ,off)) (%cg-emit-ld-slot cg reg off))
+ (($ opnd? (kind global) (lval? #f) (ext ,lbl)) (%cg-emit-la cg reg lbl))
+ (($ opnd? (kind global) (type ,ty) (ext ,lbl))
+ (%cg-emit-la cg 't2 lbl)
+ (%cg-emit-ld-typed cg reg ty 't2 0))
+ (else (die #f "cg internal: unknown opnd-kind" (opnd-kind op)))))
(define (%cg-spill-reg cg reg ty)
(let* ((off (cg-alloc-slot cg 8 8))
@@ -455,24 +451,20 @@
(cg-push cg (%opnd 'global cp-ty label #f))))
(define (cg-push-sym cg sym)
- (let ((k (sym-kind sym)) (ty (sym-type sym)))
- (cond
- ((eq? k 'fn)
- (cg-push cg (%opnd 'global ty (%cg-mangle-global (sym-name sym)) #f)))
- ((eq? k 'enum-const)
- (cg-push cg (%opnd 'imm ty (sym-slot sym) #f)))
- ((eq? k 'var)
- (let ((stg (sym-storage sym)))
- (cond
- ((eq? stg 'extern)
- (cg-push cg (%opnd 'global ty (%cg-mangle-global (sym-name sym)) #t)))
- ((eq? stg 'static)
- (cg-push cg (%opnd 'global ty (%cg-mangle-global (sym-name sym)) #t)))
- (else
- (cg-push cg (%opnd 'frame ty (sym-slot sym) #t))))))
- ((eq? k 'param)
- (cg-push cg (%opnd 'frame ty (sym-slot sym) #t)))
- (else (die #f "cg-push-sym: unsupported sym-kind" k)))))
+ (pmatch sym
+ (($ sym? (kind fn) (type ,ty) (name ,nm))
+ (cg-push cg (%opnd 'global ty (%cg-mangle-global nm) #f)))
+ (($ sym? (kind enum-const) (type ,ty) (slot ,v))
+ (cg-push cg (%opnd 'imm ty v #f)))
+ (($ sym? (kind var) (storage extern) (type ,ty) (name ,nm))
+ (cg-push cg (%opnd 'global ty (%cg-mangle-global nm) #t)))
+ (($ sym? (kind var) (storage static) (type ,ty) (name ,nm))
+ (cg-push cg (%opnd 'global ty (%cg-mangle-global nm) #t)))
+ (($ sym? (kind var) (type ,ty) (slot ,off))
+ (cg-push cg (%opnd 'frame ty off #t)))
+ (($ sym? (kind param) (type ,ty) (slot ,off))
+ (cg-push cg (%opnd 'frame ty off #t)))
+ (else (die #f "cg-push-sym: unsupported sym-kind" (sym-kind sym)))))
;; A cg-push-deref result is a frame-lval whose slot HOLDS THE ADDRESS
;; (not the value). To distinguish from ordinary frame-lvals (whose
@@ -543,15 +535,15 @@
((not f) (die #f "cg-push-field: no such field" fname))
(else
(let* ((fty (cadr f)) (fo (car (cddr f))))
- (cond
+ (pmatch s
;; 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)))
+ (($ opnd? (kind frame) (ext ,off))
+ (guard (not (%cg-indirect? cg off)))
+ (cg-push cg (%opnd 'frame fty (+ off 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))
+ (($ opnd? (kind frame) (ext ,off))
+ (%cg-emit-ld-slot cg 't0 off)
(cond
((> fo 0)
(%cg-emit-many cg (list "%addi(t0, t0, " (%n fo) ")\n"))))
@@ -560,8 +552,8 @@
(%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))
+ (($ opnd? (kind global) (ext ,lbl))
+ (%cg-emit-la cg 't0 lbl)
(cond
((> fo 0)
(%cg-emit-many cg (list "%addi(t0, t0, " (%n fo) ")\n"))))
@@ -581,25 +573,25 @@
(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))))
+ (let* ((p (cg-pop cg))
+ (et (car (ctype-ext (opnd-type p))))
(pty (%ctype 'ptr 8 8 et)))
- (cond
+ (pmatch p
;; direct frame lval: address is sp+off.
- ((and (eq? (opnd-kind p) 'frame)
- (not (%cg-indirect? cg (opnd-ext p))))
+ (($ opnd? (kind frame) (ext ,off))
+ (guard (not (%cg-indirect? cg off)))
(%cg-emit-many cg (list "%mov(t0, sp)\n"
"%addi(t0, t0, "
- (%cg-slot-expr cg (opnd-ext p)) ")\n"))
+ (%cg-slot-expr cg off) ")\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))
+ (($ opnd? (kind frame) (ext ,off))
+ (%cg-emit-ld-slot cg 't0 off)
(%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))
+ (($ opnd? (kind global) (ext ,lbl))
+ (%cg-emit-la cg 't0 lbl)
(%cg-spill-reg cg 't0 pty))
(else (die #f "cg-decay-array: unsupported lval kind"
(opnd-kind p))))))
@@ -616,24 +608,22 @@
;; &arr + 1 is one-past-end. Array-to-pointer decay happens
;; on use via cg-decay-array, not at the & operator.
(pty (%ctype 'ptr 8 8 ty)))
- (cond
- ((not (opnd-lval? p))
- (die #f "cg-take-addr: not an lvalue"))
- ((eq? (opnd-kind p) 'frame)
- (cond
- ((%cg-indirect? cg (opnd-ext p))
- ;; The address itself lives at sp+slot — &*p degenerates to p.
- (%cg-emit-ld-slot cg 't0 (opnd-ext p))
- (%cg-spill-reg cg 't0 pty))
- (else
- ;; %mov(rd, sp) gives the portable-sp pointer (the backend
- ;; handles any hidden frame-header offset). Then add slot.
- (%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))))
- ((eq? (opnd-kind p) 'global)
- (%cg-emit-la cg 't0 (opnd-ext p))
+ (pmatch p
+ (($ opnd? (lval? #f)) (die #f "cg-take-addr: not an lvalue"))
+ ;; The address itself lives at sp+slot — &*p degenerates to p.
+ (($ opnd? (kind frame) (ext ,off))
+ (guard (%cg-indirect? cg off))
+ (%cg-emit-ld-slot cg 't0 off)
+ (%cg-spill-reg cg 't0 pty))
+ ;; %mov(rd, sp) gives the portable-sp pointer (the backend
+ ;; handles any hidden frame-header offset). Then add slot.
+ (($ opnd? (kind frame) (ext ,off))
+ (%cg-emit-many cg (list "%mov(t0, sp)\n"
+ "%addi(t0, t0, "
+ (%cg-slot-expr cg off) ")\n"))
+ (%cg-spill-reg cg 't0 pty))
+ (($ opnd? (kind global) (ext ,lbl))
+ (%cg-emit-la cg 't0 lbl)
(%cg-spill-reg cg 't0 pty))
(else (die #f "cg-take-addr: non-addressable" (opnd-kind p))))))
@@ -873,20 +863,19 @@
(cg-push cg rhs0)
(cg-cast cg ty)
(let ((rhs (cg-pop cg)))
- (%cg-load-opnd-into cg rhs 'a0)
- (cond
- ((eq? (opnd-kind lhs) 'frame)
- (cond
- ((%cg-indirect? cg (opnd-ext lhs))
- (%cg-emit-ld-slot cg 't0 (opnd-ext lhs))
- (%cg-emit-st-typed cg 'a0 ty 't0 0))
- (else
- (%cg-emit-st-slot-typed cg 'a0 ty (opnd-ext lhs)))))
- ((eq? (opnd-kind lhs) 'global)
- (%cg-emit-la cg 't0 (opnd-ext lhs))
- (%cg-emit-st-typed cg 'a0 ty 't0 0))
- (else (die #f "cg-assign: unsupported lhs kind" (opnd-kind lhs))))
- (%cg-spill-reg cg 'a0 ty))))
+ (%cg-load-opnd-into cg rhs 'a0)
+ (pmatch lhs
+ (($ opnd? (kind frame) (ext ,off))
+ (guard (%cg-indirect? cg off))
+ (%cg-emit-ld-slot cg 't0 off)
+ (%cg-emit-st-typed cg 'a0 ty 't0 0))
+ (($ opnd? (kind frame) (ext ,off))
+ (%cg-emit-st-slot-typed cg 'a0 ty off))
+ (($ opnd? (kind global) (ext ,lbl))
+ (%cg-emit-la cg 't0 lbl)
+ (%cg-emit-st-typed cg 'a0 ty 't0 0))
+ (else (die #f "cg-assign: unsupported lhs kind" (opnd-kind lhs))))
+ (%cg-spill-reg cg 'a0 ty))))
;; --------------------------------------------------------------------
;; Calls
@@ -1059,19 +1048,19 @@
;; 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)))
+ (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))
+ (pmatch ap-lv
+ (($ opnd? (kind frame) (ext ,off))
+ (guard (%cg-indirect? cg off))
+ (%cg-emit-ld-slot cg 't0 off)
+ (%cg-emit-ld cg 'a0 't0 0))
+ (($ opnd? (kind frame) (ext ,off))
+ (%cg-emit-ld-slot cg 'a0 off))
+ (($ opnd? (kind global) (ext ,lbl))
+ (%cg-emit-la cg 't0 lbl)
(%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
@@ -1080,15 +1069,15 @@
;; 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))
+ (pmatch ap-lv
+ (($ opnd? (kind frame) (ext ,off))
+ (guard (%cg-indirect? cg off))
+ (%cg-emit-ld-slot cg 't0 off)
+ (%cg-emit-st cg 'a0 't0 0))
+ (($ opnd? (kind frame) (ext ,off))
+ (%cg-emit-st-slot cg 'a0 off))
+ (($ opnd? (kind global) (ext ,lbl))
+ (%cg-emit-la cg 't0 lbl)
(%cg-emit-st cg 'a0 't0 0))
(else 0))
;; Spill the loaded value (a1) to a fresh frame slot under ctype.
