commit 3ad49004bf38631d89ed95d4db57c03c360d40c4
parent d0d3057776b05d688243ddcc08503a6a2c5434ff
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Fri, 1 May 2026 11:21:10 -0700
cc: tidy
Diffstat:
| M | cc/cc.scm | | | 88 | +++++++++++++++++++++++++++++-------------------------------------------------- |
1 file changed, 32 insertions(+), 56 deletions(-)
diff --git a/cc/cc.scm b/cc/cc.scm
@@ -493,6 +493,28 @@
(define (cg-str-pool cg) (world-str-pool (cg-world cg)))
(define (cg-str-pool-set! cg v) (world-str-pool-set! (cg-world cg) v))
+;; ctype predicates used by both cg and parser.
+(define (%ctype-ptr? t)
+ (let ((k (ctype-kind t)))
+ (if (eq? k 'ptr) #t (eq? k 'arr))))
+
+(define (%ctype-pointee t)
+ (cond ((eq? (ctype-kind t) 'ptr) (ctype-ext t))
+ ((eq? (ctype-kind t) 'arr) (car (ctype-ext t)))
+ (else #f)))
+
+(define (%ctype-unsigned? t)
+ (let ((k (ctype-kind t)))
+ (cond ((eq? k 'u8) #t) ((eq? k 'u16) #t) ((eq? k 'u32) #t)
+ ((eq? k 'u64) #t) ((eq? k 'bool) #t)
+ ((eq? k 'ptr) #t) ((eq? k 'arr) #t) ((eq? k 'fn) #t)
+ (else #f))))
+
+(define (%ctype-fp? t)
+ (let ((k (ctype-kind t)))
+ (cond ((eq? k 'flt) #t) ((eq? k 'dbl) #t) ((eq? k 'ldbl) #t)
+ (else #f))))
+
;; --------------------------------------------------------------------
;; Symbol alphabets — canonical alists.
;; --------------------------------------------------------------------
@@ -2785,27 +2807,6 @@
(cg-vstack-set! cg (cons op (cg-vstack cg)))
op))
-(define (%ctype-ptr? t)
- (let ((k (ctype-kind t)))
- (if (eq? k 'ptr) #t (eq? k 'arr))))
-
-(define (%ctype-pointee t)
- (cond ((eq? (ctype-kind t) 'ptr) (ctype-ext t))
- ((eq? (ctype-kind t) 'arr) (car (ctype-ext t)))
- (else #f)))
-
-(define (%ctype-unsigned? t)
- (let ((k (ctype-kind t)))
- (cond ((eq? k 'u8) #t) ((eq? k 'u16) #t) ((eq? k 'u32) #t)
- ((eq? k 'u64) #t) ((eq? k 'bool) #t)
- ((eq? k 'ptr) #t) ((eq? k 'arr) #t) ((eq? k 'fn) #t)
- (else #f))))
-
-(define (%ctype-fp? t)
- (let ((k (ctype-kind t)))
- (cond ((eq? k 'flt) #t) ((eq? k 'dbl) #t) ((eq? k 'ldbl) #t)
- (else #f))))
-
;; Floating-point softening. Real FP arithmetic is not implemented;
;; instead the cg silently treats fp ctypes as same-sized integer
;; bit patterns (flt as 4-byte, dbl/ldbl as 8-byte). Loads, stores,
@@ -2818,8 +2819,6 @@
;; sites stay grep-able if a future bootstrap target needs real FP.
(define (%cg-fp-reject! op-name ty) #t)
-(define (%ctype-size t) (ctype-size t))
-
(define (%reg-by-idx i)
(cond ((= i 0) 'a0) ((= i 1) 'a1) ((= i 2) 'a2) ((= i 3) 'a3)
(else (die #f "cg: param idx > 3 needs ldarg path" i))))
@@ -3401,8 +3400,8 @@
(define (cg-cast cg to-type)
(let* ((p (cg-pop cg))
(from-ty (opnd-type p))
- (from-sz (%ctype-size from-ty))
- (to-sz (%ctype-size to-type))
+ (from-sz (ctype-size from-ty))
+ (to-sz (ctype-size to-type))
(to-kind (ctype-kind to-type)))
(%cg-fp-reject! 'cast-to to-type)
(%cg-fp-reject! 'cast-from from-ty)
@@ -3453,7 +3452,7 @@
(define (cg-promote cg)
(let* ((p (cg-pop cg))
(ty (opnd-type p))
- (sz (%ctype-size ty)))
+ (sz (ctype-size ty)))
(cond
((< sz 4)
(cond
@@ -3473,8 +3472,8 @@
(a (cg-pop cg))
(ta (opnd-type a))
(tb (opnd-type b))
- (sa (%ctype-size ta))
- (sb (%ctype-size tb)))
+ (sa (ctype-size ta))
+ (sb (ctype-size tb)))
(cond
;; Pointer/array arithmetic: leave types alone so cg-binop's
;; ptr-aware add/sub branch fires with the correct pointee type
@@ -3526,20 +3525,20 @@
((and a-ptr? (or (eq? op 'add) (eq? op 'sub)) (not b-ptr?))
(%cg-load-opnd-into cg a 'a0)
(%cg-load-opnd-into cg b 'a1)
- (let ((sz (%ctype-size (%ctype-pointee ta)))
+ (let ((sz (ctype-size (%ctype-pointee ta)))
(mac (if (eq? op 'add) "%ptr_add(" "%ptr_sub(")))
(%cg-emit-many cg (list mac "t0, a0, a1, " (%n sz) ", t1)\n")))
(%cg-spill-reg cg 't0 result-ty))
((and b-ptr? (eq? op 'add) (not a-ptr?))
(%cg-load-opnd-into cg a 'a0)
(%cg-load-opnd-into cg b 'a1)
- (let ((sz (%ctype-size (%ctype-pointee tb))))
+ (let ((sz (ctype-size (%ctype-pointee tb))))
(%cg-emit-many cg (list "%ptr_add(t0, a1, a0, " (%n sz) ", t1)\n")))
(%cg-spill-reg cg 't0 result-ty))
((and a-ptr? b-ptr? (eq? op 'sub))
(%cg-load-opnd-into cg a 'a0)
(%cg-load-opnd-into cg b 'a1)
- (let ((sz (%ctype-size (%ctype-pointee ta))))
+ (let ((sz (ctype-size (%ctype-pointee ta))))
(%cg-emit-many cg (list "%ptr_diff(t0, a0, a1, " (%n sz) ", t1)\n")))
(%cg-spill-reg cg 't0 result-ty))
(else
@@ -5344,29 +5343,6 @@
(cond ((and (pair? ext) (pair? (cdr ext))) (car (cddr ext)))
(else (die #f "init: not a struct" ty)))))
-(define (%find-field fields nm)
- ;; Anon-member-aware lookup; mirrors %cg-find-field. Designated init
- ;; (`.foo = ...`) on a struct with anonymous members descends through
- ;; them and returns a (name ctype offset) triple with composed offset.
- (cond
- ((null? fields) #f)
- (else
- (let* ((f (car fields)) (fn (car f)))
- (cond
- ((and fn (equal? fn nm)) f)
- ((and (not fn)
- (let ((k (ctype-kind (cadr f))))
- (or (eq? k 'struct) (eq? k 'union))))
- (let* ((sub-ext (ctype-ext (cadr f)))
- (sub-fields (car (cddr sub-ext)))
- (hit (%find-field sub-fields nm)))
- (cond
- (hit (list (car hit)
- (cadr hit)
- (+ (car (cddr f)) (car (cddr hit)))))
- (else (%find-field (cdr fields) nm)))))
- (else (%find-field (cdr fields) nm)))))))
-
(define (%pad-piece nbytes)
(make-bytevector nbytes 0))
@@ -5601,7 +5577,7 @@
(cond
((not (eq? (tok-kind nt) 'IDENT))
(die (tok-loc nt) "init: .field expects ident")))
- (let ((f (%find-field fields (tok-value nt))))
+ (let ((f (%cg-find-field fields (tok-value nt))))
(cond
((not f) (die (tok-loc nt) "init: no such field"
(tok-value nt))))
@@ -5828,7 +5804,7 @@
(designated?
(advance ps)
(let ((nt (advance ps)))
- (let ((f (%find-field fields (tok-value nt))))
+ (let ((f (%cg-find-field fields (tok-value nt))))
(cond
((not f) (die (tok-loc nt) "init: no such field"
(tok-value nt))))
