boot2

cc.scm (363129B)

---

 ;; cc/util.scm — leaf helpers. Depends only on the scheme1 prelude.
 
 ;; --------------------------------------------------------------------
 ;; byte-oriented helpers. R7RS strings and bytevectors are disjoint;
 ;; micro+boot2's bytes? / bytes=? and bytevector operations provide the
 ;; explicit bridge used by this byte-oriented compiler.
 ;; --------------------------------------------------------------------
 (define (bv= a b) (bytes=? a b))
 
 (define (bv-prefix? p s)
   ;; Is s a bv that starts with the bytes of p?
   (let ((plen (bytevector-length p))
         (slen (bytevector-length s)))
     (if (< slen plen)
         #f
         (let loop ((i 0))
           (cond ((= i plen) #t)
                 ((= (bytevector-u8-ref p i) (bytevector-u8-ref s i))
                  (loop (+ i 1)))
                 (else #f))))))
 
 (define (bv-find bv byte from)
   ;; Linear scan for the first byte == `byte` at index >= from.
   ;; Returns the index, or #f if not found.
   (let ((n (bytevector-length bv)))
     (let loop ((i from))
       (cond ((>= i n) #f)
             ((= (bytevector-u8-ref bv i) byte) i)
             (else (loop (+ i 1)))))))
 
 (define (bv-slice bv start end)
   ;; Fresh copy of bytes in [start, end). bytevector-copy already does
   ;; this in scheme1 (3-arg form returns a fresh bv).
   (bytevector-copy bv start end))
 
 (define (bv-of-byte b) (make-bytevector 1 b))
 
 (define (bv-cat lst-of-bv)
   ;; Concat a list of bytevectors with one allocation. bytevector-append
   ;; is variadic, so apply does this in a single linear pass.
   (apply bytevector-append lst-of-bv))
 
 (define (bv->fixnum bv radix)
   ;; (values ok? val) — #t/n on parse, #f/#f on fail.
   ;; string->number is pure and returns #f on parse failure.
   (let ((n (string->number bv radix)))
     (if n (values #t n) (values #f #f))))
 
 (define (fixnum->bv n radix)
   (bytevector-append (number->string n radix)))
 
 ;; --------------------------------------------------------------------
 ;; lists / alists
 ;; --------------------------------------------------------------------
 (define (key=? a b)
   (if (and (bytes? a) (bytes? b)) (bytes=? a b) (equal? a b)))
 
 (define (assoc/key key al)
   (cond ((null? al) #f)
         ((key=? key (car (car al))) (car al))
         (else (assoc/key key (cdr al)))))
 
 (define (alist-ref    key al) (let ((p (assoc/key key al))) (and p (cdr p))))
 (define (alist-ref/eq key al) (let ((p (assq  key al))) (and p (cdr p))))
 
 (define (alist-set key val al) (cons (cons key val) al))
 
 ;; Compiler-wide maps use scheme1's private GC-aware open-addressed table.
 ;; Bytevector/string keys compare by bytes, matching key=? above; symbol and
 ;; integer keys compare by identity. Small per-call environments remain alists
 ;; because constructing a table for a handful of macro parameters would cost
 ;; more than scanning them.
 (define (alist->hash al)
   (let ((h (%make-hash-table 16)))
     (let loop ((xs al))
       (cond ((null? xs) h)
             (else
              (%hash-set! h (car (car xs)) (cdr (car xs)))
              (loop (cdr xs)))))))
 
 (define (alist-update key f al)
   ;; Functional update by byte-aware key equality. If found, replace its value with
   ;; (f old-val). If not found, prepend (cons key (f #f)) so callers
   ;; can use this as upsert-with-default.
   (let loop ((xs al) (acc '()))
     (cond ((null? xs)
            (cons (cons key (f #f)) (reverse acc)))
           ((key=? (car (car xs)) key)
            (append (reverse acc)
                    (cons (cons key (f (cdr (car xs))))
                          (cdr xs))))
           (else (loop (cdr xs) (cons (car xs) acc))))))
 
 (define (any p xs)
   (cond ((null? xs) #f)
         ((p (car xs)) #t)
         (else (any p (cdr xs)))))
 
 (define (every p xs)
   (cond ((null? xs) #t)
         ((p (car xs)) (every p (cdr xs)))
         (else #f)))
 
 (define (count p xs)
   (let loop ((xs xs) (n 0))
     (cond ((null? xs) n)
           ((p (car xs)) (loop (cdr xs) (+ n 1)))
           (else (loop (cdr xs) n)))))
 
 ;; --------------------------------------------------------------------
 ;; ints
 ;; --------------------------------------------------------------------
 (define (min3 a b c)                 (min a (min b c)))
 (define (align-up n k)
   ;; round n up to the nearest multiple of k (k must be a power of 2)
   (let ((mask (- k 1)))
     (bit-and (+ n mask) (bit-not mask))))
 
 ;; --------------------------------------------------------------------
 ;; Fixed-width C integer carrier
 ;; --------------------------------------------------------------------
 ;;
 ;; scheme1 fixnums have three tag bits, so a P1-32 host cannot carry every
 ;; 32-bit C value directly (and a P1-64 host cannot carry every u64 either).
 ;; Keep out-of-range C values as an exact, little-endian 64-bit bytevector.
 ;; Small results normalize back to fixnums so sizes, offsets, and loop counts
 ;; keep using the cheap representation. All helpers accept either shape.
 
 (define-record-type c-value
   (%c-value bytes)
   c-value?
   (bytes c-value-bytes))
 
 (define-record-type c-int-lit
   (%c-int-lit value unsigned? long-count decimal?)
   c-int-lit?
   (value      c-int-lit-value)
   (unsigned?  c-int-lit-unsigned?)
   (long-count c-int-lit-long-count)
   (decimal?   c-int-lit-decimal?))
 
 (define %C-VALUE-BYTES 8)
 
 (define (%c-value-coerce v)
   (cond
     ((c-int-lit? v) (%c-value-coerce (c-int-lit-value v)))
     ((c-value? v) v)
     (else
      (let ((bv (make-bytevector %C-VALUE-BYTES 0)))
        (let loop ((i 0) (n v))
          (cond
            ((= i %C-VALUE-BYTES) (%c-value bv))
            (else
             (bytevector-u8-set! bv i (bit-and n 255))
             (loop (+ i 1) (arithmetic-shift n -8)))))))))
 
 (define (%c-value-copy v)
   (let ((bv (c-value-bytes (%c-value-coerce v))))
     (%c-value (bytevector-copy bv 0 (bytevector-length bv)))))
 
 (define (%c-value-zero) (%c-value (make-bytevector %C-VALUE-BYTES 0)))
 
 (define (%c-value-zero? v)
   (cond
     ((not (c-value? v)) (= v 0))
     (else
      (let ((bv (c-value-bytes v)))
        (let loop ((i 0))
          (cond ((= i %C-VALUE-BYTES) #t)
                ((not (= (bytevector-u8-ref bv i) 0)) #f)
                (else (loop (+ i 1)))))))))
 
 (define (%c-value-positive-small cv)
   ;; Conservative common subset of both Scheme fixnum ranges: [0,2^27).
   (let ((bv (c-value-bytes cv)))
     (cond
       ((or (not (= (bytevector-u8-ref bv 7) 0))
            (not (= (bytevector-u8-ref bv 6) 0))
            (not (= (bytevector-u8-ref bv 5) 0))
            (not (= (bytevector-u8-ref bv 4) 0))
            (>= (bytevector-u8-ref bv 3) 8)) #f)
       (else
        (let loop ((i 3) (n 0))
          (cond ((< i 0) n)
                (else
                 (loop (- i 1)
                       (+ (* n 256) (bytevector-u8-ref bv i))))))))))
 
 (define (%c-value-negate/raw v)
   (let* ((src (c-value-bytes (%c-value-coerce v)))
          (out (make-bytevector %C-VALUE-BYTES 0)))
     (let loop ((i 0) (carry 1))
       (cond
         ((= i %C-VALUE-BYTES) (%c-value out))
         (else
          (let ((z (+ (- 255 (bytevector-u8-ref src i)) carry)))
            (bytevector-u8-set! out i (bit-and z 255))
            (loop (+ i 1) (if (> z 255) 1 0))))))))
 
 (define (%c-value-normalize v)
   (cond
     ((not (c-value? v)) v)
     (else
      (let ((p (%c-value-positive-small v)))
        (cond
          (p p)
          ((>= (bytevector-u8-ref (c-value-bytes v) 7) 128)
           (let* ((mag (%c-value-negate/raw v))
                  (m (%c-value-positive-small mag)))
             (if m (- 0 m) v)))
          (else v))))))
 
 (define (%c-value-normalize-unsigned v)
   ;; Lexer accumulation starts from an unsigned source spelling. Preserve
   ;; values with bit 63 set as c-values rather than collapsing (for example)
   ;; 18446744073709551615 to the signed fixnum -1.
   (cond
     ((not (c-value? v)) v)
     (else
      (let ((p (%c-value-positive-small v)))
        (if p p v)))))
 
 (define (%c-value->fixnum v context)
   (let ((n (%c-value-normalize v)))
     (cond ((c-value? n) (die #f context "value does not fit host fixnum"))
           (else n))))
 
 (define (%c-value-mul-small-add v scale addend)
   ;; Used by the lexer. scale <= 16 and addend <= 15, so every step is
   ;; far below even RV32's fixnum ceiling.
   (let* ((src (c-value-bytes (%c-value-coerce v)))
          (out (make-bytevector %C-VALUE-BYTES 0)))
     (let loop ((i 0) (carry addend))
       (cond
         ((= i %C-VALUE-BYTES) (%c-value-normalize-unsigned (%c-value out)))
         (else
          (let ((z (+ (* (bytevector-u8-ref src i) scale) carry)))
            (bytevector-u8-set! out i (remainder z 256))
            (loop (+ i 1) (quotient z 256))))))))
 
 (define (%c-value-add a b)
   (let* ((av (c-value-bytes (%c-value-coerce a)))
          (bv (c-value-bytes (%c-value-coerce b)))
          (out (make-bytevector %C-VALUE-BYTES 0)))
     (let loop ((i 0) (carry 0))
       (cond
         ((= i %C-VALUE-BYTES) (%c-value-normalize (%c-value out)))
         (else
          (let ((z (+ (bytevector-u8-ref av i)
                      (bytevector-u8-ref bv i) carry)))
            (bytevector-u8-set! out i (remainder z 256))
            (loop (+ i 1) (quotient z 256))))))))
 
 (define (%c-value-negate v)
   (%c-value-normalize (%c-value-negate/raw v)))
 
 (define (%c-value-sub a b)
   (%c-value-add a (%c-value-negate/raw b)))
 
 (define (%c-value-mul a b)
   (let* ((av (c-value-bytes (%c-value-coerce a)))
          (bv (c-value-bytes (%c-value-coerce b)))
          (out (make-bytevector %C-VALUE-BYTES 0)))
     (let outer ((i 0))
       (cond
         ((= i %C-VALUE-BYTES) (%c-value-normalize (%c-value out)))
         (else
          (let inner ((j 0) (carry 0))
            (cond
              ((= (+ i j) %C-VALUE-BYTES) (outer (+ i 1)))
              (else
               (let* ((k (+ i j))
                      (z (+ (bytevector-u8-ref out k)
                            (* (bytevector-u8-ref av i)
                               (bytevector-u8-ref bv j))
                            carry)))
                 (bytevector-u8-set! out k (remainder z 256))
                 (inner (+ j 1) (quotient z 256)))))))))))
 
 (define (%c-value-bitop op a b)
   (let* ((av (c-value-bytes (%c-value-coerce a)))
          (bv (c-value-bytes (%c-value-coerce b)))
          (out (make-bytevector %C-VALUE-BYTES 0)))
     (let loop ((i 0))
       (cond
         ((= i %C-VALUE-BYTES) (%c-value-normalize (%c-value out)))
         (else
          (bytevector-u8-set! out i
            (op (bytevector-u8-ref av i) (bytevector-u8-ref bv i)))
          (loop (+ i 1)))))))
 
 (define (%c-value-and a b) (%c-value-bitop bit-and a b))
 (define (%c-value-or  a b) (%c-value-bitop bit-or  a b))
 (define (%c-value-xor a b) (%c-value-bitop bit-xor a b))
 (define (%c-value-not a)   (%c-value-xor a -1))
 
 (define (%c-value-ucmp a b)
   ;; -1 / 0 / 1 under unsigned 64-bit ordering.
   (let ((av (c-value-bytes (%c-value-coerce a)))
         (bv (c-value-bytes (%c-value-coerce b))))
     (let loop ((i (- %C-VALUE-BYTES 1)))
       (cond ((< i 0) 0)
             ((< (bytevector-u8-ref av i) (bytevector-u8-ref bv i)) -1)
             ((> (bytevector-u8-ref av i) (bytevector-u8-ref bv i)) 1)
             (else (loop (- i 1)))))))
 
 (define (%c-value-eq? a b) (= (%c-value-ucmp a b) 0))
 
 (define (%c-value-trunc v nbytes signed?)
   (let* ((src (c-value-bytes (%c-value-coerce v)))
          (out (bytevector-copy src 0 (bytevector-length src)))
          (fill (if (and signed? (> nbytes 0)
                         (>= (bytevector-u8-ref src (- nbytes 1)) 128))
                    255 0)))
     (let loop ((i nbytes))
       (cond ((= i %C-VALUE-BYTES)
              (%c-value-normalize (%c-value out)))
             (else
              (bytevector-u8-set! out i fill)
              (loop (+ i 1)))))))
 
 (define (%c-value-signed-negative? v nbytes)
   (and (> nbytes 0)
        (>= (bytevector-u8-ref
              (c-value-bytes (%c-value-coerce v)) (- nbytes 1))
            128)))
 
 (define (%c-value-cmp a b nbytes unsigned?)
   (let ((aa (%c-value-trunc a nbytes (not unsigned?)))
         (bb (%c-value-trunc b nbytes (not unsigned?))))
     (cond
       (unsigned? (%c-value-ucmp aa bb))
       ((and (%c-value-signed-negative? aa %C-VALUE-BYTES)
             (not (%c-value-signed-negative? bb %C-VALUE-BYTES))) -1)
       ((and (not (%c-value-signed-negative? aa %C-VALUE-BYTES))
             (%c-value-signed-negative? bb %C-VALUE-BYTES)) 1)
       (else (%c-value-ucmp aa bb)))))
 
 (define (%c-value-shift-one-left/raw cv)
   (let* ((src (c-value-bytes cv))
          (out (make-bytevector %C-VALUE-BYTES 0)))
     (let loop ((i 0) (carry 0))
       (cond ((= i %C-VALUE-BYTES) (%c-value out))
             (else
              (let ((z (+ (* (bytevector-u8-ref src i) 2) carry)))
                (bytevector-u8-set! out i (remainder z 256))
                (loop (+ i 1) (quotient z 256))))))))
 
 (define (%c-value-shift-one-right/raw cv arithmetic?)
   (let* ((src (c-value-bytes cv))
          (out (make-bytevector %C-VALUE-BYTES 0))
          (initial (if (and arithmetic?
                            (>= (bytevector-u8-ref src 7) 128)) 1 0)))
     (let loop ((i 7) (carry initial))
       (cond ((< i 0) (%c-value out))
             (else
              (let ((byte (bytevector-u8-ref src i)))
                (bytevector-u8-set! out i
                  (+ (quotient byte 2) (* carry 128)))
                (loop (- i 1) (remainder byte 2))))))))
 
 (define (%c-value-shift v count arithmetic-right?)
   (let ((start (%c-value-coerce v)))
     (cond
       ((>= count 64)
        (if (and arithmetic-right?
                 (%c-value-signed-negative? start %C-VALUE-BYTES))
            -1 0))
       ((<= count -64) 0)
       ((>= count 0)
        (let loop ((n count) (x start))
          (cond ((= n 0) (%c-value-normalize x))
                (else
                 (loop (- n 1)
                       (%c-value-shift-one-right/raw x arithmetic-right?))))))
       (else
        (let loop ((n (- 0 count)) (x start))
          (cond ((= n 0) (%c-value-normalize x))
                (else
                 (loop (- n 1) (%c-value-shift-one-left/raw x)))))))))
 
 (define (%c-value-bv-sub! dst rhs)
   (let loop ((i 0) (borrow 0))
     (cond
       ((= i %C-VALUE-BYTES) dst)
       (else
        (let ((z (- (bytevector-u8-ref dst i)
                    (bytevector-u8-ref rhs i) borrow)))
          (cond ((< z 0)
                 (bytevector-u8-set! dst i (+ z 256))
                 (loop (+ i 1) 1))
                (else
                 (bytevector-u8-set! dst i z)
                 (loop (+ i 1) 0))))))))
 
 (define (%c-value-bv-shl1! bv incoming)
   (let loop ((i 0) (carry incoming))
     (cond ((= i %C-VALUE-BYTES) bv)
           (else
            (let ((z (+ (* (bytevector-u8-ref bv i) 2) carry)))
              (bytevector-u8-set! bv i (remainder z 256))
              (loop (+ i 1) (quotient z 256)))))))
 
 (define (%c-value-bv-ucmp a b)
   (let loop ((i 7))
     (cond ((< i 0) 0)
           ((< (bytevector-u8-ref a i) (bytevector-u8-ref b i)) -1)
           ((> (bytevector-u8-ref a i) (bytevector-u8-ref b i)) 1)
           (else (loop (- i 1))))))
 
 (define (%c-value-udivmod a b)
   ;; Returns (quotient . remainder), both c-values. Binary long division
   ;; keeps every Scheme temporary byte-sized.
   (let* ((num (c-value-bytes (%c-value-coerce a)))
          (den (c-value-bytes (%c-value-coerce b)))
          (q (make-bytevector %C-VALUE-BYTES 0))
          (r (make-bytevector %C-VALUE-BYTES 0)))
     (cond ((%c-value-zero? (%c-value den))
            (die #f "C constant division by zero")))
     (let loop ((bit 63))
       (cond
         ((< bit 0)
          (cons (%c-value-normalize (%c-value q))
                (%c-value-normalize (%c-value r))))
         (else
          (let* ((byte-index (quotient bit 8))
                 (bit-index (remainder bit 8))
                 (incoming
                  (bit-and (arithmetic-shift
                             (bytevector-u8-ref num byte-index)
                             (- 0 bit-index))
                           1)))
            (%c-value-bv-shl1! r incoming)
            (cond
              ((>= (%c-value-bv-ucmp r den) 0)
               (%c-value-bv-sub! r den)
               (bytevector-u8-set! q byte-index
                 (bit-or (bytevector-u8-ref q byte-index)
                         (arithmetic-shift 1 bit-index)))))
            (loop (- bit 1))))))))
 
 (define (%c-value-divmod a b nbytes unsigned?)
   (let* ((aa (%c-value-trunc a nbytes (not unsigned?)))
          (bb (%c-value-trunc b nbytes (not unsigned?)))
          (aneg (and (not unsigned?)
                     (%c-value-signed-negative? aa %C-VALUE-BYTES)))
          (bneg (and (not unsigned?)
                     (%c-value-signed-negative? bb %C-VALUE-BYTES)))
          (amag (if aneg (%c-value-negate/raw aa) aa))
          (bmag (if bneg (%c-value-negate/raw bb) bb))
          (qr (%c-value-udivmod amag bmag))
          (q (if (if aneg (not bneg) bneg)
                 (%c-value-negate (car qr)) (car qr)))
          (r (if aneg (%c-value-negate (cdr qr)) (cdr qr))))
     (cons (%c-value-trunc q nbytes (not unsigned?))
           (%c-value-trunc r nbytes (not unsigned?)))))
 
 (define (%c-value->decimal-bv v)
   (cond
     ((not (c-value? v)) (fixnum->bv v 10))
     ((%c-value-zero? v) "0")
     (else
      (let* ((src (c-value-bytes v))
             (work (bytevector-copy src 0 (bytevector-length src))))
        (let digits ((acc '()))
          (let divide ((i 7) (rem 0))
            (cond
              ((< i 0)
               (let ((acc2 (cons (bv-of-byte (+ 48 rem)) acc)))
                 (if (= (%c-value-bv-ucmp work
                          (make-bytevector %C-VALUE-BYTES 0)) 0)
                     (bv-cat acc2)
                     (digits acc2))))
              (else
               (let ((z (+ (* rem 256) (bytevector-u8-ref work i))))
                 (bytevector-u8-set! work i (quotient z 10))
                 (divide (- i 1) (remainder z 10)))))))))))
 
 (define (%c-value->hex-bv v)
   (let* ((src (c-value-bytes (%c-value-coerce v)))
          (hex "0123456789abcdef")
          (out (make-bytevector 18 48)))
     (bytevector-u8-set! out 0 48)
     (bytevector-u8-set! out 1 120)
     (let loop ((i 7) (j 2))
       (cond ((< i 0) out)
             (else
              (let ((b (bytevector-u8-ref src i)))
                (bytevector-u8-set! out j
                  (bytevector-u8-ref hex (quotient b 16)))
                (bytevector-u8-set! out (+ j 1)
                  (bytevector-u8-ref hex (remainder b 16)))
                (loop (- i 1) (+ j 2))))))))
 
 (define (%c-value-source-bv v)
   (%c-value->decimal-bv (if (c-int-lit? v) (c-int-lit-value v) v)))
 (define (%c-value-literal-bv v)
   (let ((n (if (c-int-lit? v) (c-int-lit-value v) v)))
     (if (c-value? n) (%c-value->hex-bv n) (fixnum->bv n 10))))
 
 (define (%c-value-u32-literal-bv v word-index)
   ;; Render one little-endian 32-bit limb without ever converting it to a
   ;; Scheme integer. This is used when an RV32 %li materializes one half of
   ;; an i64/u64 C constant.
   (let ((full (%c-value->hex-bv v)))
     (cond
       ((= word-index 0) (bv-cat (list "0x" (bv-slice full 10 18))))
       ((= word-index 1) (bv-cat (list "0x" (bv-slice full 2 10))))
       (else (die #f "C constant: bad u32 limb index" word-index)))))
 
 (define (%c-value-parse-decimal-bv bv)
   (let ((n (bytevector-length bv)))
     (let loop ((i 0) (v 0))
       (cond
         ((= i n) (cons #t v))
         (else
          (let ((b (bytevector-u8-ref bv i)))
            (cond ((or (< b 48) (> b 57)) (cons #f #f))
                  (else
                   (loop (+ i 1)
                         (%c-value-mul-small-add v 10 (- b 48)))))))))))
 
 (define (%c-value-fits-unsigned-bits? v bits)
   (let* ((cv (%c-value-coerce v))
          (bv (c-value-bytes cv))
          (whole (quotient bits 8))
          (part (remainder bits 8)))
     (let loop ((i (+ whole (if (= part 0) 0 1))))
       (cond
         ((= i %C-VALUE-BYTES)
          (if (= part 0) #t
              (< (bytevector-u8-ref bv whole)
                 (arithmetic-shift 1 part))))
         ((not (= (bytevector-u8-ref bv i) 0)) #f)
         (else (loop (+ i 1)))))))
 
 (define (%c-int-raw v)
   (if (c-int-lit? v) (c-int-lit-value v) v))
 
 ;; --------------------------------------------------------------------
 ;; output buffer (fixed-size pre-allocated byte storage)
 ;;
 ;; Every buf owns one bytevector of `cap` bytes, plus a write `offset`.
 ;; buf-push! is bytevector-copy! into storage — zero allocation per
 ;; push, no chunks list to chase. The destination storage has stable
 ;; identity, so byte-level mutations survive collection.
 ;;
 ;; Sizing knobs live in one place so they're easy to tune as inputs
 ;; grow. cg-init picks per-buf caps; the per-fn bufs are reused
 ;; across functions (reset, not re-allocated).
 ;; --------------------------------------------------------------------
 
 ;; Tuning constants — total fixed pre-allocation is about 12.58 MiB on
 ;; 64-bit targets and 12.33 MiB on RV32. Bump these when a workload overflows; the buf-overflow
 ;; die() reports off/len/cap so misses are easy to diagnose.
 ;;
 ;; Each cap is a power of two. scheme1's bv_capacity_for rounds the
 ;; requested length up to the smallest power of two ≥ n, so asking for
 ;; 2^k bytes consumes exactly 2^k of heap.
 (define %BUF-CAP-TEXT     8388608)   ; 8 MiB:   .text + entry stub
 (define %BUF-CAP-DATA     2097152)   ; 2 MiB:   .data (strings, globals)
 (define %BUF-CAP-BSS      2097152)   ; 2 MiB:   .bss
 (define %BUF-CAP-FN       (if (= (target-word-bytes) 4) 262144 524288))
                                         ; 256/512 KiB: per-fn body asm
 (define %BUF-CAP-PROLOGUE 16384)     ; 16 KiB:  per-fn prologue
 (define %BUF-CAP-DEFAULT  65536)     ; 64 KiB:  make-buf fallback
 
 (define-record-type buf
   (%buf storage offset cap)
   buf?
   (storage buf-storage)                     ; bv: pre-allocated, never resized
   (offset  buf-offset  buf-offset-set!)     ; fixnum: bytes written so far
   (cap     buf-cap))                        ; fixnum: storage capacity
 
 (define (make-buf/cap cap)
   (%buf (make-bytevector cap 0) 0 cap))
 
 (define (make-buf) (make-buf/cap %BUF-CAP-DEFAULT))
 
 (define (buf-push! b bv)
   (let* ((n      (bytevector-length bv))
          (off    (buf-offset b))
          (newoff (+ off n)))
     (cond
       ((> newoff (buf-cap b))
        (die #f "buf overflow" off n (buf-cap b))))
     (bytevector-copy! (buf-storage b) off bv 0 n)
     (buf-offset-set! b newoff)))
 
 (define (buf-flush b)
   ;; Snapshot the used prefix as a fresh bv. One allocation; the
   ;; underlying storage is unchanged.
   (bytevector-copy (buf-storage b) 0 (buf-offset b)))
 
 (define (buf-reset! b) (buf-offset-set! b 0))
 
 (define (buf-drain! dst src)
   ;; Copy src's used bytes into dst at dst's current write head; reset
   ;; src to empty. dst and src must be distinct bufs.
   (let* ((slen   (buf-offset src))
          (doff   (buf-offset dst))
          (newoff (+ doff slen)))
     (cond
       ((> newoff (buf-cap dst))
        (die #f "buf-drain overflow" doff slen (buf-cap dst))))
     (bytevector-copy! (buf-storage dst) doff (buf-storage src) 0 slen)
     (buf-offset-set! dst newoff)
     (buf-offset-set! src 0)))
 
 ;; --------------------------------------------------------------------
 ;; diagnostics + I/O
 ;; --------------------------------------------------------------------
 (define (die loc msg . irritants)
   ;; Format:
   ;;   <file>:<line>:<col>: error: <msg>: <irritant> <irritant> ...
   ;; When loc is #f, the "<file>:<line>:<col>: " prefix is omitted.
   ;; irritants are written via display semantics (no quoting); format's
   ;; ~a handles bv/fixnum/pair/symbol the same way display does.
   ;;
   ;; All output is built into a single bv and sent to fd 2 with one
   ;; sys-write loop, so a partial write doesn't interleave fragments
   ;; from a concurrent process.
   (let* ((prefix (if loc
                      (format "~a:~d:~d: error: "
                              (loc-file loc) (loc-line loc) (loc-col loc))
                      "error: "))
          (head (bytevector-append prefix (format "~a" msg)))
          ;; Irritants get ": " before the first and " " between the rest.
          (tail (if (null? irritants)
                    (list NL-BV)
                    (let walk ((xs irritants) (sep ": ") (acc '()))
                      (if (null? xs)
                          (reverse (cons NL-BV acc))
                          (walk (cdr xs)
                                " "
                                (cons (format "~a" (car xs))
                                      (cons sep acc)))))))
          (out (bv-cat (cons head tail))))
     (write-bv-fd 2 out)
     (sys-exit 1)))
 
 (define (slurp-fd fd)
   ;; Read fd to EOF. Uses BUFSIZE chunks (same constant the prelude's
   ;; port layer uses); bv-concat-reverse builds the result in one
   ;; allocation so a multi-MB tcc.c stays linear.
   (let ((buf (make-bytevector BUFSIZE)))
     (let loop ((acc '()))
       (let ((r (sys-read fd buf 0 BUFSIZE)))
         (cond ((not (car r))
                (die #f "slurp-fd: sys-read failed" (cdr r)))
               ((zero? (cdr r))
                (bv-concat-reverse acc))
               (else
                (loop (cons (bytevector-copy buf 0 (cdr r)) acc))))))))
 
 (define (write-bv-fd fd bv)
   ;; Full write or die. sys-write may write fewer bytes than requested;
   ;; advance the offset and retry the unwritten tail.
   ;;
   ;; On failure we sys-exit directly instead of routing through `die`
   ;; — `die` itself uses write-bv-fd, so a write failure to fd 2 must
   ;; not recurse infinitely. Status 1 matches the contract for `die`.
   (let ((len (bytevector-length bv)))
     (let loop ((off 0))
       (if (= off len)
           #t
           (let ((r (sys-write fd bv off (- len off))))
             (cond ((not (car r))      (sys-exit 1))
                   ((zero? (cdr r))    (sys-exit 1))
                   (else (loop (+ off (cdr r))))))))))
 
 (define (write-bv-range-fd fd bv start len)
   ;; Write exactly LEN bytes starting at START without first copying the
   ;; range into a right-sized bytevector. This is important for the large,
   ;; fixed-capacity codegen buffers: their used prefixes can be streamed
   ;; without requiring another contiguous managed allocation.
   (let loop ((off start) (left len))
     (if (= left 0)
         #t
         (let ((r (sys-write fd bv off left)))
           (cond ((not (car r))      (sys-exit 1))
                 ((zero? (cdr r))    (sys-exit 1))
                 (else (loop (+ off (cdr r)) (- left (cdr r)))))))))
 
 ;; --------------------------------------------------------------------
 ;; debug logging
 ;;
 ;; Cheap sticky on/off: the cc compiler is single-threaded and short-
 ;; lived, so a top-level mutable flag is fine. Toggle via
 ;; (debug-log-on!) / (debug-log-off!). When on, (debug-log msg . irr)
 ;; writes one line to fd 2 in the same display-style format as `die`,
 ;; but doesn't abort. The intent is to trace heap usage between cc
 ;; phases (lex/pp/parse/cg-finish) without compile-time conditionals.
 ;; --------------------------------------------------------------------
 (define %debug-log-enabled #f)
 (define (debug-log-on!)  (set! %debug-log-enabled #t))
 (define (debug-log-off!) (set! %debug-log-enabled #f))
 (define (debug-log? )    %debug-log-enabled)
 
 ;; --cc-trace-emit: if on, cg-fn-end injects a `%trace(MANGLED)` line
 ;; at the top of each emitted function body (right after the prologue's
 ;; argument-spill, so the macro is free to clobber a0..a3). Pairs with
 ;; libp1pp's %trace macro + libp1pp__trace runtime helper to produce a
 ;; stderr line per function entry, with the runtime address of the
 ;; first body instruction. See P1/P1pp.P1pp's "Tracepoint" section.
 (define %trace-emit-enabled #f)
 (define (trace-emit-on!)  (set! %trace-emit-enabled #t))
 (define (trace-emit-off!) (set! %trace-emit-enabled #f))
 (define (trace-emit?)     %trace-emit-enabled)
 
 (define (debug-log msg . irritants)
   (cond
     (%debug-log-enabled
      (let* ((head (bytevector-append "[cc] " (format "~a" msg)))
             (tail (if (null? irritants)
                       (list NL-BV)
                       (let walk ((xs irritants) (sep ": ") (acc '()))
                         (if (null? xs)
                             (reverse (cons NL-BV acc))
                             (walk (cdr xs)
                                   " "
                                   (cons (format "~a" (car xs))
                                         (cons sep acc)))))))
             (out (bv-cat (cons head tail))))
        (write-bv-fd 2 out)))
     (else #t)))
 
 ;; --------------------------------------------------------------------
 ;; fresh-name generator (used for cg label counters, etc.)
 ;; --------------------------------------------------------------------
 (define (make-namer prefix)
   ;; Returns a thunk; each call yields prefix0, prefix1, ... as a fresh
   ;; bv. The counter lives in the closure's lexical environment; scheme1
   ;; closures heap-capture by reference, so set! on ctr is sticky.
   (let ((ctr 0))
     (lambda ()
       (let ((s (bytevector-append prefix (number->string ctr 10))))
         (set! ctr (+ ctr 1))
         s))))
 ;; cc/data.scm — record types and symbol alphabets shared across modules.
 
 ;; --------------------------------------------------------------------
 ;; loc — source location for diagnostics
 ;; --------------------------------------------------------------------
 (define-record-type loc
   (%loc file line col)
   loc?
   (file loc-file)            ; bv
   (line loc-line)            ; fixnum
   (col  loc-col))            ; fixnum
 
 ;; --------------------------------------------------------------------
 ;; tok — lexer token.
 ;; --------------------------------------------------------------------
 (define-record-type tok
   (%tok kind value loc hide)
   tok?
   (kind  tok-kind)           ; IDENT | INT | STR | CHAR | KW | PUNCT
                              ; | NL | HASH | EOF
   (value tok-value)          ; bv | fixnum/c-value/c-int-lit | symbol | #f
   (loc   tok-loc)            ; loc
   (hide  tok-hide))          ; list of bv (macro names already expanded)
 
 (define (make-tok kind value loc)
   (%tok kind value loc '()))
 
 ;; --------------------------------------------------------------------
 ;; macro — preprocessor macro definition
 ;; --------------------------------------------------------------------
 (define-record-type macro
   (%macro kind params body)
   macro?
   (kind   macro-kind)        ; 'obj | 'fn | 'fn-vararg
   (params macro-params)      ; list of bv
   (body   macro-body))       ; list of tok
 
 ;; --------------------------------------------------------------------
 ;; ctype — C type.
 ;;
 ;; size/align/ext mutate only on forward struct/union completion (see
 ;; complete-agg!). Every other ctype is constructed in its final shape
 ;; and treated as immutable thereafter.
 ;; --------------------------------------------------------------------
 (define-record-type ctype
   (%ctype kind size align ext)
   ctype?
   (kind  ctype-kind)
   (size  ctype-size  ctype-size-set!)
   (align ctype-align ctype-align-set!)
   (ext   ctype-ext   ctype-ext-set!))
 
 ;; Active P1 data model. scheme1 supplies these from the selected backend,
 ;; so cc.scm emits ILP32 for RV32 and LP64 for the existing targets.
 (define %CC-WORD-BYTES (target-word-bytes))
 (define %CC-WORD-BITS  (target-word-bits))
 (define %CC-PAIR-BYTES (* 2 %CC-WORD-BYTES))
 
 ;; Interned primitive ctypes. Equality is eq?.
 (define %t-void  (%ctype 'void  -1 -1 #f))
 (define %t-i8    (%ctype 'i8     1  1 #f))
 (define %t-u8    (%ctype 'u8     1  1 #f))
 (define %t-i16   (%ctype 'i16    2  2 #f))
 (define %t-u16   (%ctype 'u16    2  2 #f))
 (define %t-i32   (%ctype 'i32    4  4 #f))
 (define %t-u32   (%ctype 'u32    4  4 #f))
 (define %t-i64   (%ctype 'i64    8  8 #f))
 (define %t-u64   (%ctype 'u64    8  8 #f))
 (define %t-word-i (if (= %CC-WORD-BYTES 4) %t-i32 %t-i64))
 (define %t-word-u (if (= %CC-WORD-BYTES 4) %t-u32 %t-u64))
 (define %t-bool  (%ctype 'bool   1  1 #f))
 ;; Floating-point ctypes are parsed but never codegen'd; see CC.md §Cut.
 ;; Sizes/aligns match the SysV ABI so struct layout containing fp fields
 ;; works even when the cg refuses to emit fp ops.
 (define %t-flt   (%ctype 'flt    4  4 #f))
 (define %t-dbl   (%ctype 'dbl    8  8 #f))
 (define %t-ldbl  (%ctype 'ldbl   8  8 #f))
 
 ;; Select the first type in C11 6.4.4.1's candidate list that can represent
 ;; an integer constant. CType intentionally interns same-width C types into
 ;; one representation (for example, int and long are both i32 on ILP32), so
 ;; this returns the correct width and signedness even where their ranks differ.
 (define (%c-int-type lit)
   (let* ((v (%c-int-raw lit))
          (u? (and (c-int-lit? lit) (c-int-lit-unsigned? lit)))
          (lc (if (c-int-lit? lit) (c-int-lit-long-count lit) 0))
          (decimal? (if (c-int-lit? lit) (c-int-lit-decimal? lit) #t))
          (fits-i32? (%c-value-fits-unsigned-bits? v 31))
          (fits-u32? (%c-value-fits-unsigned-bits? v 32))
          (fits-i64? (%c-value-fits-unsigned-bits? v 63)))
     (cond
       ;; LL / ULL have only a 64-bit candidate in the supported data models.
       ((>= lc 2)
        (cond (u? %t-u64) (fits-i64? %t-i64) (else %t-u64)))
       ;; L / UL begin at the target's C long width.
       ((= lc 1)
        (cond
          (u?
           (if (= %CC-WORD-BITS 32)
               (if fits-u32? %t-u32 %t-u64)
               %t-u64))
          (decimal?
           (if (= %CC-WORD-BITS 32)
               (cond (fits-i32? %t-i32) (fits-i64? %t-i64) (else %t-u64))
               (if fits-i64? %t-i64 %t-u64)))
          ((= %CC-WORD-BITS 32)
           (cond (fits-i32? %t-i32) (fits-u32? %t-u32)
                 (fits-i64? %t-i64) (else %t-u64)))
          (else (if fits-i64? %t-i64 %t-u64))))
       ;; A bare U suffix starts at unsigned int on both targets.
       (u? (if fits-u32? %t-u32 %t-u64))
       ;; Unsuffixed decimal has no unsigned candidates before the extension
       ;; fallback; octal/hex may select unsigned int or unsigned long.
       (decimal?
        (cond (fits-i32? %t-i32) (fits-i64? %t-i64) (else %t-u64)))
       (else
        (cond (fits-i32? %t-i32) (fits-u32? %t-u32)
              (fits-i64? %t-i64) (else %t-u64))))))
 
 ;; --------------------------------------------------------------------
 ;; sym — declared identifier (function, variable, typedef, …)
 ;; defined? distinguishes a forward declaration (extern fn proto, extern
 ;; var) from a definition (fn body, var with initializer, tentative def
 ;; without `extern`). scope-bind! merges compatible decls; only two
 ;; defined? syms with the same name fire a redefinition error.
 ;;
 ;; sym is immutable — no `sym-*-set!` accessor exists. scope-bind!'s
 ;; merge logic constructs a fresh sym rather than mutating in place.
 ;; Keeping it immutable also makes shared world bindings straightforward.
 ;; --------------------------------------------------------------------
 (define-record-type sym
   (%sym name kind storage type slot defined?)
   sym?
   (name     sym-name)         ; bv
   (kind     sym-kind)         ; symbol from §1.7
   (storage  sym-storage)      ; symbol from §1.8 or #f
   (type     sym-type)         ; ctype
   (slot     sym-slot)         ; fixnum (auto local / param / enum-const value)
                               ; | #f (fn / global var / typedef)
   (defined? sym-defined?))    ; #t = definition, #f = decl-only
 
 ;; --------------------------------------------------------------------
 ;; opnd — operand on cg's vstack.
 ;; --------------------------------------------------------------------
 (define-record-type opnd
   (%opnd kind type ext lval?)
   opnd?
   (kind  opnd-kind)
   (type  opnd-type)
   (ext   opnd-ext)
   (lval? opnd-lval?))
 
 ;; --------------------------------------------------------------------
 ;; loop-ctx — entry on parser's loop/switch context stack.
 ;; --------------------------------------------------------------------
 (define-record-type loop-ctx
   (%loop-ctx kind tag has-continue?)
   loop-ctx?
   (kind          loop-ctx-kind)
   (tag           loop-ctx-tag)
   (has-continue? loop-ctx-has-continue?))
 
 ;; --------------------------------------------------------------------
 ;; fn-ctx — current-function context inside the parser.
 ;; --------------------------------------------------------------------
 (define-record-type fn-ctx
   (%fn-ctx name return-type params variadic? labels static-counter)
   fn-ctx?
   (name        fn-ctx-name)
   (return-type fn-ctx-return-type)
   (params      fn-ctx-params)
   (variadic?   fn-ctx-variadic?)
   (labels      fn-ctx-labels      fn-ctx-labels-set!)
   ;; Monotonic declaration identity for block-scope static objects.  The C
   ;; identifier alone is not unique: separate lexical scopes in one function
   ;; may each declare `static ... order[]` and must emit distinct labels.
   (static-counter fn-ctx-static-counter fn-ctx-static-counter-set!))
 
 ;; --------------------------------------------------------------------
 ;; world — cross-decl persistent parser/cg state. The same world record
 ;; is shared by pstate and cg so its slots — scope/tag hash-frame stacks,
 ;; the interned-string hash, and tentative-definition list + membership
 ;; hash — can be reasoned about as one persistent root graph.
 ;; --------------------------------------------------------------------
 (define-record-type world
   (%world scope tags str-pool tentatives)
   world?
   (scope      world-scope      world-scope-set!)
   (tags       world-tags       world-tags-set!)
   (str-pool   world-str-pool   world-str-pool-set!)
   (tentatives world-tentatives world-tentatives-set!))
 
 (define (make-world)
   (%world (list (%make-hash-table 64))
           (list (%make-hash-table 16))
           (%make-hash-table 16)
           (cons '() (%make-hash-table 16))))
 
 ;; --------------------------------------------------------------------
 ;; pstate — parser state. Owned by parse.scm; read-only to cg.
 ;; --------------------------------------------------------------------
 ;; iter holds a tok-iter (typically a pp-iter chained over a lex-iter).
 ;; peek / peek2 / advance go through iter-peek / iter-peek2 / iter-next
 ;; so the parser pulls one token at a time, with no full materialized
 ;; token list.
 (define-record-type pstate
   (%pstate iter world loops fn-ctx cg)
   pstate?
   (iter   ps-iter   ps-iter-set!)
   (world  ps-world)
   (loops  ps-loops  ps-loops-set!)
   (fn-ctx ps-fn-ctx ps-fn-ctx-set!)
   (cg     ps-cg))
 
 (define (ps-scope ps)        (world-scope (ps-world ps)))
 (define (ps-scope-set! ps v) (world-scope-set! (ps-world ps) v))
 (define (ps-tags ps)         (world-tags (ps-world ps)))
 (define (ps-tags-set! ps v)  (world-tags-set! (ps-world ps) v))
 
 ;; --------------------------------------------------------------------
 ;; cg — codegen state. Owned by cg.scm.
 ;; --------------------------------------------------------------------
 ;; fn-buf and prologue-buf are pre-allocated (cg-init) and reused across
 ;; functions — cg-fn-begin/v calls buf-reset! on them, cg-fn-end drains
 ;; them into cg-text via buf-drain!. Fixed-storage byte writes remain
 ;; stable while ordinary transient parser data is reclaimed by the GC.
 ;;
 ;; in-fn? discriminates "currently inside a function body" so
 ;; %cg-emit-buf can route emits to fn-buf during the body and cg-text
 ;; outside it (entry stub, etc.).
 ;;
 ;; cg-fn-meta: transient per-function state (fn-name, ret-slot, ret-type,
 ;; vararg-first-slot, indirect-slots, switch-case lists, ...). Reset on
 ;; cg-fn-begin/v; reads via %cg-fn-get / writes via %cg-fn-set!.
 ;; lib? / str-prefix encode the --lib=PFX flag from cc-main:
 ;;   #f / ""        — exec mode (default): cg-finish emits the
 ;;                    p1_main entry stub and trailing :ELF_end, and
 ;;                    cg-intern-string labels strings cc__str_N.
 ;;   #t / "<pfx>"   — library mode: skip the stub and :ELF_end so the
 ;;                    output catm's into a larger TU, and label strings
 ;;                    <pfx>cc__str_N so two cc.scm outputs in the same
 ;;                    link don't collide on cc__str_0..N.
 (define-record-type cg
   (%cg text data bss vstack frame-hi label-ctr world fn-meta fn-buf prologue-buf max-outgoing in-fn? lib? str-prefix)
   cg?
   (text         cg-text)
   (data         cg-data)
   (bss          cg-bss)
   (vstack       cg-vstack       cg-vstack-set!)
   (frame-hi     cg-frame-hi     cg-frame-hi-set!)
   (label-ctr    cg-label-ctr    cg-label-ctr-set!)
   (world        cg-world)
   (fn-meta      cg-fn-meta      cg-fn-meta-set!)
   (fn-buf       cg-fn-buf)
   (prologue-buf cg-prologue-buf)
   (max-outgoing cg-max-outgoing cg-max-outgoing-set!)
   (in-fn?       cg-in-fn?       cg-in-fn?-set!)
   (lib?         cg-lib?)
   (str-prefix   cg-str-prefix))
 
 (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-arith? t)
   (let ((k (ctype-kind t)))
     (cond ((eq? k 'i8) #t) ((eq? k 'i16) #t) ((eq? k 'i32) #t)
           ((eq? k 'i64) #t) ((eq? k 'u8) #t) ((eq? k 'u16) #t)
           ((eq? k 'u32) #t) ((eq? k 'u64) #t) ((eq? k 'bool) #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))))
 
 (define (%ctype-wide-int? t)
   ;; P1-32 lowers C's 64-bit integer types through a two-word pair. P1-64
   ;; keeps the historical one-register representation.
   (and (= %CC-WORD-BYTES 4)
        (let ((k (ctype-kind t)))
          (or (eq? k 'i64) (eq? k 'u64)))))
 
 ;; --------------------------------------------------------------------
 ;; Symbol alphabets — canonical alists.
 ;; --------------------------------------------------------------------
 
 ;; Keyword bytevector → keyword symbol.
 (define %keyword-alist
   '(;; storage
     ("auto" . auto) ("register" . register) ("static" . static)
     ("extern" . extern) ("typedef" . typedef)
     ;; qualifiers (parsed and discarded by parse)
     ("const" . const) ("volatile" . volatile) ("restrict" . restrict)
     ("inline" . inline) ("_Noreturn" . _Noreturn)
     ;; GNU attribute spec — parsed and discarded; see skip-gnu-attribute!
     ("__attribute__" . __attribute__)
     ;; type specifiers
     ("void" . void) ("char" . char) ("short" . short)
     ("int" . int) ("long" . long)
     ("signed" . signed) ("unsigned" . unsigned) ("_Bool" . _Bool)
     ;; rejected type specifiers (KW so diagnostics are crisp)
     ("float" . float) ("double" . double)
     ;; aggregates
     ("struct" . struct) ("union" . union) ("enum" . enum)
     ;; statements
     ("if" . if) ("else" . else)
     ("while" . while) ("do" . do) ("for" . for)
     ("switch" . switch) ("case" . case) ("default" . default)
     ("break" . break) ("continue" . continue)
     ("return" . return) ("goto" . goto)
     ;; operators
     ("sizeof" . sizeof)
     ;; reserved-and-rejected (KW so diagnostics are crisp)
     ("_Generic" . _Generic) ("_Atomic" . _Atomic)
     ("_Thread_local" . _Thread_local)
     ("_Alignof" . _Alignof) ("__alignof" . _Alignof)
     ("__alignof__" . _Alignof) ("_Alignas" . _Alignas)
     ("_Static_assert" . _Static_assert)
     ("_Complex" . _Complex) ("_Imaginary" . _Imaginary)))
 
 (define %keyword-map (alist->hash %keyword-alist))
 
 ;; Punctuator bytevector → punct symbol.
 ;; Listed longest-match-first; the lexer scans this list in order.
 ;; Digraphs (<: :> <% %> %: %:%:) lex to their standard equivalents.
 (define %punct-alist
   '(;; 4-byte
     ("%:%:" . paste)
     ;; 3-byte
     ("..." . ellipsis) ("<<=" . shl-eq) (">>=" . shr-eq)
     ;; 2-byte
     ("##" . paste) ("->" . arrow)
     ("++" . inc) ("--" . dec)
     ("<<" . shl) (">>" . shr)
     ("<=" . le) (">=" . ge) ("==" . eq2) ("!=" . ne)
     ("&&" . land) ("||" . lor)
     ("+=" . plus-eq) ("-=" . minus-eq) ("*=" . star-eq)
     ("/=" . slash-eq) ("%=" . pct-eq)
     ("&=" . amp-eq) ("^=" . caret-eq) ("|=" . bar-eq)
     ;; digraphs (mapped to the standard equivalent symbol)
     ("<:" . lbrack) (":>" . rbrack)
     ("<%" . lbrace) ("%>" . rbrace) ("%:" . hash)
     ;; 1-byte
     ("[" . lbrack) ("]" . rbrack)
     ("(" . lparen) (")" . rparen)
     ("{" . lbrace) ("}" . rbrace)
     ("." . dot) ("," . comma) (";" . semi) (":" . colon) ("?" . qmark)
     ("+" . plus) ("-" . minus) ("*" . star) ("/" . slash) ("%" . pct)
     ("&" . amp) ("|" . bar) ("^" . caret) ("~" . tilde) ("!" . bang)
     ("<" . lt) (">" . gt) ("=" . assign)
     ("#" . hash)))
 ;; cc/lex.scm — bytestream → token list. Pure function; no I/O,
 ;; no macro awareness.
 ;;
 ;; The lexer walks `src` byte-by-byte, threading (pos, line, col)
 ;; explicitly through every helper (no mutable state). Each token
 ;; captures its starting loc; helpers return (tok npos nline ncol).
 ;; Trigraphs and `\<newline>` line splicing are handled via a single
 ;; logical-byte primitive `%lex-peek`: it advances over splices and
 ;; translates trigraphs in-place, so downstream code only ever sees
 ;; the "translation phase 2" stream. Comments are stripped at the
 ;; same level as whitespace. NL tokens are emitted at every physical
 ;; newline so pp can use them to terminate directives.
 ;;
 (define (%lex-init!) #t)
 
 ;; --------------------------------------------------------------------
 ;; Byte-class predicates (raw u8 values, not chars).
 ;; --------------------------------------------------------------------
 (define (%digit? b)        (if (< b 48) #f (if (< 57 b) #f #t)))     ; '0'..'9'
 (define (%hex? b)
   (cond ((%digit? b) #t)
         ((if (< b 65) #f (if (< 70 b) #f #t)) #t)                    ; 'A'..'F'
         ((if (< b 97) #f (if (< 102 b) #f #t)) #t)                   ; 'a'..'f'
         (else #f)))
 (define (%octal? b)        (if (< b 48) #f (if (< 55 b) #f #t)))     ; '0'..'7'
 (define (%alpha? b)
   (cond ((if (< b 65) #f (if (< 90 b) #f #t)) #t)                    ; 'A'..'Z'
         ((if (< b 97) #f (if (< 122 b) #f #t)) #t)                   ; 'a'..'z'
         (else #f)))
 (define (%ident-start? b)  (or (%alpha? b) (= b 95)))                ; '_'
 (define (%ident-cont?  b)  (or (%ident-start? b) (%digit? b)))
 (define (%hspace? b)       (or (= b 32) (= b 9) (= b 11) (= b 12)))  ; SP TAB VT FF
 (define (%newline? b)      (= b 10))                                 ; '\n'
 
 ;; --------------------------------------------------------------------
 ;; Logical byte access. %lex-peek returns
 ;;   (byte npos nline ncol)
 ;; where (npos, nline, ncol) points *just past* the consumed physical
 ;; bytes. On EOF it returns (#f pos line col).
 ;;
 ;; Two transformations folded in here:
 ;;
 ;;   - Trigraphs:  ??=  ??(  ??/  ??)  ??'  ??<  ??!  ??>  ??-
 ;;                  #    [    \    ]    ^    {    |    }    ~
 ;;     The pair `??` followed by one of the nine trigraph completers
 ;;     produces the translated byte and advances 3 source bytes.
 ;;   - Line splice: a backslash immediately followed by `\n` is removed
 ;;     as a unit (incrementing line, resetting col to 1) and we recurse
 ;;     to fetch the next logical byte.
 ;;
 ;; Other escapes (e.g. `\<not-newline>`) are returned as-is — string and
 ;; char literals do their own escape-handling.
 ;; --------------------------------------------------------------------
 (define (%trigraph-byte b)
   ;; Map the third trigraph byte to its replacement, or #f.
   (cond ((= b 61) 35)   ; '=' -> '#'
         ((= b 40) 91)   ; '(' -> '['
         ((= b 47) 92)   ; '/' -> '\\'
         ((= b 41) 93)   ; ')' -> ']'
         ((= b 39) 94)   ; '\'' -> '^'
         ((= b 60) 123)  ; '<' -> '{'
         ((= b 33) 124)  ; '!' -> '|'
         ((= b 62) 125)  ; '>' -> '}'
         ((= b 45) 126)  ; '-' -> '~'
         (else #f)))
 
 (define (%lex-peek src pos line col)
   (let ((n (bytevector-length src)))
     (cond
       ((>= pos n) (list #f pos line col))
       (else
        (let ((b (bytevector-u8-ref src pos)))
          (cond
            ;; Trigraph: ?? + completer
            ((and (= b 63)
                  (< (+ pos 2) n)
                  (= (bytevector-u8-ref src (+ pos 1)) 63))
             (let ((tr (%trigraph-byte (bytevector-u8-ref src (+ pos 2)))))
               (if tr
                   (list tr (+ pos 3) line (+ col 3))
                   (list b (+ pos 1) line (+ col 1)))))
            ;; Line splice: backslash + newline (consume both, no token)
            ((and (= b 92)
                  (< (+ pos 1) n)
                  (= (bytevector-u8-ref src (+ pos 1)) 10))
             (%lex-peek src (+ pos 2) (+ line 1) 1))
            ;; Newline: pass through but caller decides line/col bump
            ((%newline? b)
             (list b (+ pos 1) (+ line 1) 1))
            (else
             (list b (+ pos 1) line (+ col 1)))))))))
 
 ;; Convenience accessors over the 4-list.
 (define (%pk-byte p)  (car p))
 (define (%pk-pos  p)  (car (cdr p)))
 (define (%pk-line p)  (car (cdr (cdr p))))
 (define (%pk-col  p)  (car (cdr (cdr (cdr p)))))
 
 ;; Fast-byte test. When (%fast-byte? b) is #t, reading b directly with
 ;; bytevector-u8-ref is exactly equivalent to %lex-peek's result: the
 ;; logical byte is b, npos = pos+1, nline unchanged, ncol = col+1, and
 ;; no list allocation is needed. Excludes the three bytes that %lex-peek
 ;; can transform: '?' (trigraph), '\\' (line splice), '\n' (line bump).
 (define (%fast-byte? b)
   (cond ((= b 63) #f)
         ((= b 92) #f)
         ((= b 10) #f)
         (else #t)))
 
 ;; --------------------------------------------------------------------
 ;; Whitespace + comment skipper.  Returns (pos line col).
 ;; Handles spaces/tabs, // line comments, /* block */ comments. Does
 ;; *not* consume `\n` — newlines are tokens.
 ;; --------------------------------------------------------------------
 (define (%skip-ws-and-comments src pos line col file)
   (let ((n (bytevector-length src)))
     (cond
       ((>= pos n) (list pos line col))
       (else
        (let ((b (bytevector-u8-ref src pos)))
          (cond
            ((and (%fast-byte? b) (%hspace? b))
             (%skip-ws-and-comments src (+ pos 1) line (+ col 1) file))
            ((%fast-byte? b)
             ;; Fast-byte that isn't hspace. Only '/' is interesting;
             ;; everything else terminates the skip.
             (cond
               ((= b 47) (%maybe-comment src pos line col file))
               (else (list pos line col))))
            (else
             ;; Slow path: trigraph / splice / newline.
             (let* ((p (%lex-peek src pos line col))
                    (b2 (%pk-byte p)))
               (cond
                 ((not b2) (list pos line col))
                 ((%hspace? b2)
                  (%skip-ws-and-comments src (%pk-pos p) (%pk-line p) (%pk-col p)
                                         file))
                 ((= b2 47) (%maybe-comment src pos line col file))
                 (else (list pos line col)))))))))))
 
 (define (%maybe-comment src pos line col file)
   ;; Source byte at pos resolves to '/'. Decide between // line comment,
   ;; /* block comment, or "leave the slash alone" (it's a punctuator).
   (let* ((p (%lex-peek src pos line col))
          (q (%lex-peek src (%pk-pos p) (%pk-line p) (%pk-col p)))
          (b2 (%pk-byte q)))
     (cond
       ((and b2 (= b2 47))
        (%skip-line-comment src (%pk-pos q) (%pk-line q) (%pk-col q) file))
       ((and b2 (= b2 42))
        (%skip-block-comment src (%pk-pos q) (%pk-line q) (%pk-col q)
                             file line col))
       (else (list pos line col)))))
 
 (define (%skip-line-comment src pos line col file)
   ;; Consume bytes until end-of-stream or until we *see* '\n' (do not
   ;; consume the newline itself; outer loop emits the NL).
   (let ((n (bytevector-length src)))
     (cond
       ((>= pos n) (%skip-ws-and-comments src pos line col file))
       (else
        (let ((b (bytevector-u8-ref src pos)))
          (cond
            ;; '\n' terminates without consuming.
            ((= b 10) (%skip-ws-and-comments src pos line col file))
            ((%fast-byte? b)
             (%skip-line-comment src (+ pos 1) line (+ col 1) file))
            (else
             ;; Slow path: ?/\ — let %lex-peek handle trigraph/splice.
             (let* ((p (%lex-peek src pos line col))
                    (b2 (%pk-byte p)))
               (cond
                 ((not b2) (%skip-ws-and-comments src pos line col file))
                 ((%newline? b2) (%skip-ws-and-comments src pos line col file))
                 (else
                  (%skip-line-comment src (%pk-pos p) (%pk-line p) (%pk-col p)
                                      file)))))))))))
 
 (define (%skip-block-comment src pos line col file start-line start-col)
   (let ((n (bytevector-length src)))
     (cond
       ((>= pos n)
        (die (%loc file start-line start-col)
             "unterminated /* block comment"))
       (else
        (let ((b (bytevector-u8-ref src pos)))
          (cond
            ;; Fast path for plain content bytes that aren't '*'.
            ((and (%fast-byte? b) (not (= b 42)))
             (%skip-block-comment src (+ pos 1) line (+ col 1)
                                  file start-line start-col))
            (else
             ;; Slow path: '*', '\n', '?' (trigraph), '\\' (splice).
             (let* ((p (%lex-peek src pos line col))
                    (b1 (%pk-byte p)))
               (cond
                 ((not b1)
                  (die (%loc file start-line start-col)
                       "unterminated /* block comment"))
                 ((= b1 42)
                  (let* ((q  (%lex-peek src (%pk-pos p) (%pk-line p) (%pk-col p)))
                         (b2 (%pk-byte q)))
                    (cond
                      ((not b2)
                       (die (%loc file start-line start-col)
                            "unterminated /* block comment"))
                      ((= b2 47)
                       (%skip-ws-and-comments src (%pk-pos q) (%pk-line q) (%pk-col q)
                                              file))
                      (else
                       ;; Re-scan starting at the byte after '*'; the '*' was
                       ;; not the closer, but the next byte might itself be '*'.
                       (%skip-block-comment src (%pk-pos p) (%pk-line p) (%pk-col p)
                                            file start-line start-col)))))
                 (else
                  (%skip-block-comment src (%pk-pos p) (%pk-line p) (%pk-col p)
                                       file start-line start-col)))))))))))
 
 ;; --------------------------------------------------------------------
 ;; Byte-run scanners.
 ;;
 ;; Tail-recursive walkers used by ident/number/string readers. None
 ;; allocate per scanned byte on the fast path (only %lex-peek 4-lists
 ;; on trigraph/splice/newline); tail recursion keeps the native call path
 ;; bounded and unreachable Scheme environments are collected normally.
 ;;
 ;; - %scan-while:    count bytes that satisfy pred. (count npos nline ncol)
 ;; - %fill-while-bv: write matching bytes into a pre-sized bv.
 ;; - %accum-int-while: accumulate a base-N integer over digit bytes.
 ;;     (val count npos nline ncol)
 ;; - %accum-octal-bounded: same, but stops after k digits.
 ;; --------------------------------------------------------------------
 (define (%scan-while pred src pos line col)
   (let ((n (bytevector-length src)))
     (let loop ((pos pos) (line line) (col col) (cnt 0))
       (cond
         ((>= pos n) (list cnt pos line col))
         (else
          (let ((b (bytevector-u8-ref src pos)))
            (cond
              ((%fast-byte? b)
               (if (pred b)
                   (loop (+ pos 1) line (+ col 1) (+ cnt 1))
                   (list cnt pos line col)))
              (else
               (let* ((p (%lex-peek src pos line col))
                      (b2 (%pk-byte p)))
                 (if (and b2 (pred b2))
                     (loop (%pk-pos p) (%pk-line p) (%pk-col p) (+ cnt 1))
                     (list cnt pos line col)))))))))))
 
 (define (%fill-while-bv pred src pos line col bv idx)
   (let ((n (bytevector-length src)))
     (let loop ((pos pos) (line line) (col col) (idx idx))
       (cond
         ((>= pos n) idx)
         (else
          (let ((b (bytevector-u8-ref src pos)))
            (cond
              ((%fast-byte? b)
               (cond
                 ((pred b)
                  (bytevector-u8-set! bv idx b)
                  (loop (+ pos 1) line (+ col 1) (+ idx 1)))
                 (else idx)))
              (else
               (let* ((p (%lex-peek src pos line col))
                      (b2 (%pk-byte p)))
                 (cond
                   ((and b2 (pred b2))
                    (bytevector-u8-set! bv idx b2)
                    (loop (%pk-pos p) (%pk-line p) (%pk-col p) (+ idx 1)))
                   (else idx)))))))))))
 
 (define (%digit-val-byte b)
   ;; ASCII digit byte → integer value. Caller guarantees b is a valid
   ;; digit in the relevant base (0-9 / 0-7 / 0-9a-fA-F).
   (cond ((%digit? b) (- b 48))
         ((if (< b 65) #f (if (< 70 b) #f #t)) (+ (- b 65) 10))
         ((if (< b 97) #f (if (< 102 b) #f #t)) (+ (- b 97) 10))
         (else 0)))
 
 (define (%accum-int-while pred src pos line col base)
   (let ((n (bytevector-length src)))
     (let loop ((pos pos) (line line) (col col) (val 0) (cnt 0))
       (cond
         ((>= pos n) (list val cnt pos line col))
         (else
          (let ((b (bytevector-u8-ref src pos)))
            (cond
              ((%fast-byte? b)
               (if (pred b)
                   (loop (+ pos 1) line (+ col 1)
                         (%c-value-mul-small-add
                           val base (%digit-val-byte b))
                         (+ cnt 1))
                   (list val cnt pos line col)))
              (else
               (let* ((p (%lex-peek src pos line col))
                      (b2 (%pk-byte p)))
                 (if (and b2 (pred b2))
                     (loop (%pk-pos p) (%pk-line p) (%pk-col p)
                           (%c-value-mul-small-add
                             val base (%digit-val-byte b2))
                           (+ cnt 1))
                     (list val cnt pos line col)))))))))))
 
 (define (%accum-octal-bounded src pos line col k)
   ;; Up to k octal digits. Returns (val count npos nline ncol).
   (let ((n (bytevector-length src)))
     (let loop ((pos pos) (line line) (col col) (k k) (val 0) (cnt 0))
       (cond
         ((zero? k) (list val cnt pos line col))
         ((>= pos n) (list val cnt pos line col))
         (else
          (let ((b (bytevector-u8-ref src pos)))
            (cond
              ((%fast-byte? b)
               (if (%octal? b)
                   (loop (+ pos 1) line (+ col 1) (- k 1)
                         (+ (* val 8) (- b 48)) (+ cnt 1))
                   (list val cnt pos line col)))
              (else
               (let* ((p (%lex-peek src pos line col))
                      (b2 (%pk-byte p)))
                 (if (and b2 (%octal? b2))
                     (loop (%pk-pos p) (%pk-line p) (%pk-col p) (- k 1)
                           (+ (* val 8) (- b2 48)) (+ cnt 1))
                     (list val cnt pos line col)))))))))))
 
 ;; --------------------------------------------------------------------
 ;; Identifier / keyword reader.
 ;;
 ;; Returns (tok npos nline ncol). Caller has already verified that the
 ;; first byte at `pos` satisfies %ident-start?.
 ;;
 ;; Two-pass: pass 1 (%scan-while) sizes the run, then pass 2
 ;; (%fill-while-bv) writes directly into the exact-size bytevector.
 ;; --------------------------------------------------------------------
 (define (lex-read-ident src pos file)
   ;; Public for tests. Threads line/col from a fresh start.
   (%lex-read-ident src pos 1 (+ pos 1) file))
 
 (define (%lex-read-ident src pos line col file)
   (let ((start-loc (%loc file line col))
         (count 0) (npos 0) (nline 0) (ncol 0))
     (let ((sres (%scan-while %ident-cont? src pos line col)))
       (set! count (car sres))
       (set! npos  (car (cdr sres)))
       (set! nline (car (cdr (cdr sres))))
       (set! ncol  (car (cdr (cdr (cdr sres))))))
     (let ((name (make-bytevector count 0)))
       (%fill-while-bv %ident-cont? src pos line col name 0)
       (let ((kw (%hash-ref %keyword-map name)))
         (cons (if kw
                   (make-tok 'KW kw start-loc)
                   (make-tok 'IDENT name start-loc))
               (list npos nline ncol))))))
 
 ;; --------------------------------------------------------------------
 ;; Number reader.
 ;;
 ;; Decimal: [1-9][0-9]*  (suffix: u U l L ll LL combinations)
 ;; Hex:     0x[0-9a-fA-F]+ | 0X...
 ;; Octal:   0[0-7]*
 ;; Float:   anything looking like 1.0, 1e3, .5 → die crisply.
 ;;
 ;; Returns (tok npos nline ncol) on success. Aborts via `die` on float.
 ;;
 ;; %accum-int-while folds digit collection and value computation into
 ;; one walk — no per-byte cons cells, no separate digits-list pass.
 ;; --------------------------------------------------------------------
 (define (lex-read-number src pos file)
   (%lex-read-number src pos 1 (+ pos 1) file))
 
 (define (%lex-finish-int val start-loc decimal? after)
   ;; AFTER carries the scanner position followed by the parsed suffix flags.
   ;; Keep only the position in the public lexer result; retain the flags on
   ;; the INT token so the parser can apply the target C data model.
   (let ((npos       (car after))
         (nline      (car (cdr after)))
         (ncol       (car (cdr (cdr after))))
         (unsigned?  (car (cdr (cdr (cdr after)))))
         (long-count (car (cdr (cdr (cdr (cdr after)))))))
     (cons (make-tok 'INT
                     (%c-int-lit val unsigned? long-count decimal?)
                     start-loc)
           (list npos nline ncol))))
 
 (define (%lex-read-number src pos line col file)
   (let* ((start-loc (%loc file line col))
          (p (%lex-peek src pos line col))
          (b (%pk-byte p)))
     (cond
       ;; '0x' / '0X' hex prefix
       ((and (= b 48)
             (let* ((q (%lex-peek src (%pk-pos p) (%pk-line p) (%pk-col p)))
                    (b2 (%pk-byte q)))
               (and b2 (or (= b2 120) (= b2 88)))))   ; 'x' or 'X'
        (let* ((q (%lex-peek src (%pk-pos p) (%pk-line p) (%pk-col p)))
               (r (%accum-int-while %hex? src
                                     (%pk-pos q) (%pk-line q) (%pk-col q) 16))
               (val   (car r))
               (cnt   (car (cdr r)))
               (pos2  (car (cdr (cdr r))))
               (line2 (car (cdr (cdr (cdr r)))))
               (col2  (car (cdr (cdr (cdr (cdr r)))))))
          (if (zero? cnt)
              (die start-loc "expected hex digits after 0x")
              (let ((after (%lex-strip-int-suffix src pos2 line2 col2 file)))
                (%lex-finish-int val start-loc #f after)))))
       ;; '0' alone → octal sequence (could be just zero)
       ((= b 48)
        (let* ((r (%accum-int-while %octal? src
                                     (%pk-pos p) (%pk-line p) (%pk-col p) 8))
               (val   (car r))
               (pos2  (car (cdr (cdr r))))
               (line2 (car (cdr (cdr (cdr r)))))
               (col2  (car (cdr (cdr (cdr (cdr r)))))))
          ;; Reject '.' / 'e' / 'E' immediately after the octal run — float.
          (%check-no-float src pos2 line2 col2 file start-loc)
          ;; Reject stray digits 8/9 in an octal context (e.g. 089).
          (let* ((p3 (%lex-peek src pos2 line2 col2))
                 (b3 (%pk-byte p3)))
            (if (and b3 (%digit? b3))
                (die start-loc "invalid octal digit" (bv-of-byte b3))
                (let ((after (%lex-strip-int-suffix src pos2 line2 col2 file)))
                  (%lex-finish-int val start-loc #f after))))))
       ;; '1'-'9' → decimal
       ((%digit? b)
        (let* ((r (%accum-int-while %digit? src pos line col 10))
               (val   (car r))
               (pos2  (car (cdr (cdr r))))
               (line2 (car (cdr (cdr (cdr r)))))
               (col2  (car (cdr (cdr (cdr (cdr r)))))))
          (%check-no-float src pos2 line2 col2 file start-loc)
          (let ((after (%lex-strip-int-suffix src pos2 line2 col2 file)))
            (%lex-finish-int val start-loc #t after))))
       ;; '.' followed by a digit = float-style literal — reject.
       ((= b 46)
        (let* ((q (%lex-peek src (%pk-pos p) (%pk-line p) (%pk-col p)))
               (b2 (%pk-byte q)))
          (if (and b2 (%digit? b2))
              (die start-loc "floating-point literal not supported")
              ;; Otherwise '.' was a punctuator — caller wouldn't have
              ;; routed here unless it was a digit-led prefix.
              (die start-loc "internal: number reader on non-number"))))
       (else
        (die start-loc "internal: number reader on non-number")))))
 
 (define (%check-no-float src pos line col file start-loc)
   ;; If the byte at pos starts a fractional/exponent part, abort.
   (let* ((p (%lex-peek src pos line col))
          (b (%pk-byte p)))
     (cond
       ((not b) #t)
       ((= b 46)  ; '.'
        (die start-loc "floating-point literal not supported"))
       ((or (= b 101) (= b 69))  ; 'e' / 'E'
        ;; Only a float exponent if followed by [+-]?digit.
        (let* ((q (%lex-peek src (%pk-pos p) (%pk-line p) (%pk-col p)))
               (b2 (%pk-byte q)))
          (cond
            ((and b2 (%digit? b2))
             (die start-loc "floating-point literal not supported"))
            ((and b2 (or (= b2 43) (= b2 45)))
             (let* ((r (%lex-peek src (%pk-pos q) (%pk-line q) (%pk-col q)))
                    (b3 (%pk-byte r)))
               (if (and b3 (%digit? b3))
                   (die start-loc "floating-point literal not supported")
                   #t)))
            (else #t))))
       (else #t))))
 
 (define (%lex-strip-int-suffix src pos line col file)
   ;; Consume any combination of u U l L (the long can be doubled). We
   ;; don't validate orderings strictly; tcc.c uses the canonical forms.
   ;; Returns (npos nline ncol unsigned? long-count).
   (let loop ((pos pos) (line line) (col col) (unsigned? #f) (long-count 0))
     (let* ((p (%lex-peek src pos line col))
            (b (%pk-byte p)))
       (cond
         ((not b) (list pos line col unsigned? long-count))
         ((or (= b 117) (= b 85))    ; u U
          (loop (%pk-pos p) (%pk-line p) (%pk-col p) #t long-count))
         ((or (= b 108) (= b 76))    ; l L
          (loop (%pk-pos p) (%pk-line p) (%pk-col p)
                unsigned? (+ long-count 1)))
         (else (list pos line col unsigned? long-count))))))
 
 ;; --------------------------------------------------------------------
 ;; Escape sequence reader.
 ;;
 ;; %scan-or-fill-escape decodes one escape sequence starting at `pos`
 ;; (which points one past the leading `\\`). When `bv` is a bytevector,
 ;; the resulting byte is written to (bv idx); when it is #f, no write
 ;; occurs (used during the string-pass scan phase). Returns the 4-list
 ;; (val npos nline ncol).
 ;; --------------------------------------------------------------------
 (define (%scan-or-fill-escape src pos line col file start-loc bv idx)
   (let* ((p (%lex-peek src pos line col))
          (b (%pk-byte p)))
     (cond
       ((not b) (die start-loc "unterminated escape sequence"))
       ;; \xNN — 1+ hex digits (tcc.c uses 1- and 2-digit forms).
       ((or (= b 120) (= b 88))   ; 'x' / 'X'
        (let* ((r (%accum-int-while %hex? src
                                     (%pk-pos p) (%pk-line p) (%pk-col p) 16))
               (val0  (car r))
               (cnt   (car (cdr r)))
               (pos2  (car (cdr (cdr r))))
               (line2 (car (cdr (cdr (cdr r)))))
               (col2  (car (cdr (cdr (cdr (cdr r)))))))
          (cond
            ((zero? cnt) (die start-loc "expected hex digits after \\x"))
            (else
             (let ((val (bit-and val0 255)))
               (cond (bv (bytevector-u8-set! bv idx val))
                     (else #f))
               (list val pos2 line2 col2))))))
       ;; \NNN — 1..3 octal digits.
       ((%octal? b)
        (let* ((r (%accum-octal-bounded src pos line col 3))
               (val0  (car r))
               (pos2  (car (cdr (cdr r))))
               (line2 (car (cdr (cdr (cdr r)))))
               (col2  (car (cdr (cdr (cdr (cdr r))))))
               (val   (bit-and val0 255)))
          (cond (bv (bytevector-u8-set! bv idx val))
                (else #f))
          (list val pos2 line2 col2)))
       (else
        (let ((val (cond ((= b 110) 10)        ; n
                         ((= b 116) 9)         ; t
                         ((= b 114) 13)        ; r
                         ((= b 92)  92)        ; \\
                         ((= b 39)  39)        ; '
                         ((= b 34)  34)        ; "
                         ((= b 48)  0)         ; 0 (already handled by octal but be safe)
                         ((= b 97)  7)         ; \a -> BEL
                         ((= b 98)  8)         ; \b
                         ((= b 102) 12)        ; \f
                         ((= b 118) 11)        ; \v
                         ((= b 63)  63)        ; \?
                         (else
                          (die start-loc "unknown escape" (bv-of-byte b))))))
          (cond (bv (bytevector-u8-set! bv idx val))
                (else #f))
          (list val (%pk-pos p) (%pk-line p) (%pk-col p)))))))
 
 ;; --------------------------------------------------------------------
 ;; String reader.
 ;;
 ;; Caller has verified src[pos] == '"' (raw byte 34). Returns
 ;; (tok npos nline ncol) with the raw decoded bytes (no NUL appended).
 ;;
 ;; Two-pass: %string-pass with bv=#f counts effective bytes (escapes
 ;; collapse to 1 byte each); then allocate the final bv and rerun with
 ;; bv set so the bytes are written directly into it.
 ;; --------------------------------------------------------------------
 (define (lex-read-string src pos file)
   (%lex-read-string src pos 1 (+ pos 1) file))
 
 (define (%lex-read-string src pos line col file)
   (let ((start-loc (%loc file line col))
         (cnt 0) (npos 0) (nline 0) (ncol 0))
     ;; '"' (34) is a fast-byte and never a trigraph result, so the
     ;; physical byte at `pos` is exactly the opening quote.
     (cond
       ((or (>= pos (bytevector-length src))
            (not (= (bytevector-u8-ref src pos) 34)))
        (die start-loc "internal: string reader on non-quote"))
       (else
        (let ((sres (%string-pass src (+ pos 1) line (+ col 1)
                                   file start-loc #f)))
          (set! cnt   (car sres))
          (set! npos  (car (cdr sres)))
          (set! nline (car (cdr (cdr sres))))
          (set! ncol  (car (cdr (cdr (cdr sres))))))
        (let ((bv (make-bytevector cnt 0)))
          (%string-pass src (+ pos 1) line (+ col 1) file start-loc bv)
          (cons (make-tok 'STR bv start-loc)
                (list npos nline ncol)))))))
 
 (define (%string-pass src pos line col file start-loc bv)
   ;; Walk the string body (after opening "). When `bv` is #f, count
   ;; effective bytes; when it is a bytevector, write bytes into it at
   ;; index 0..count-1. Returns (count npos nline ncol).
   (let ((n (bytevector-length src)))
     (let loop ((pos pos) (line line) (col col) (idx 0))
       (cond
         ((>= pos n) (die start-loc "unterminated string literal"))
         (else
          (let ((b (bytevector-u8-ref src pos)))
            (cond
              ;; Closing quote — fast byte but special.
              ((= b 34)
               (list idx (+ pos 1) line (+ col 1)))
              ((%fast-byte? b)
               (cond (bv (bytevector-u8-set! bv idx b))
                     (else #f))
               (loop (+ pos 1) line (+ col 1) (+ idx 1)))
              (else
               ;; Slow path: ?/\ (trigraph/splice/escape) or '\n'.
               (let* ((p (%lex-peek src pos line col))
                      (b2 (%pk-byte p)))
                 (cond
                   ((not b2)
                    (die start-loc "unterminated string literal"))
                   ((= b2 34)
                    (list idx (%pk-pos p) (%pk-line p) (%pk-col p)))
                   ((%newline? b2)
                    (die start-loc "newline in string literal"))
                   ((= b2 92)
                    (let* ((er    (%scan-or-fill-escape
                                    src (%pk-pos p) (%pk-line p) (%pk-col p)
                                    file start-loc bv idx))
                           (epos  (car (cdr er)))
                           (eline (car (cdr (cdr er))))
                           (ecol  (car (cdr (cdr (cdr er))))))
                      (loop epos eline ecol (+ idx 1))))
                   (else
                    (cond (bv (bytevector-u8-set! bv idx b2))
                          (else #f))
                    (loop (%pk-pos p) (%pk-line p) (%pk-col p) (+ idx 1)))))))))))))
 
 ;; --------------------------------------------------------------------
 ;; Char reader.
 ;;
 ;; Caller has verified src[pos] == '\''. Multi-character constants
 ;; ('AB') are rejected via die.
 ;; --------------------------------------------------------------------
 (define (lex-read-char src pos file)
   (%lex-read-char src pos 1 (+ pos 1) file))
 
 (define (%lex-read-char src pos line col file)
   (let* ((start-loc (%loc file line col))
          (p0 (%lex-peek src pos line col))
          (b0 (%pk-byte p0)))
     (if (not (and b0 (= b0 39)))
         (die start-loc "internal: char reader on non-quote")
         (%collect-char src (%pk-pos p0) (%pk-line p0) (%pk-col p0)
                        file start-loc))))
 
 (define (%collect-char src pos line col file start-loc)
   ;; Read exactly one byte (handling escapes), then expect closing '\''.
   (let* ((p (%lex-peek src pos line col))
          (b (%pk-byte p)))
     (cond
       ((not b) (die start-loc "unterminated char literal"))
       ((= b 39) (die start-loc "empty char literal"))
       ((%newline? b) (die start-loc "newline in char literal"))
       ((= b 92)   ; escape
        (let* ((r     (%scan-or-fill-escape src
                                             (%pk-pos p) (%pk-line p) (%pk-col p)
                                             file start-loc #f 0))
               (val   (car r))
               (pos2  (car (cdr r)))
               (line2 (car (cdr (cdr r))))
               (col2  (car (cdr (cdr (cdr r))))))
          (%expect-char-close src pos2 line2 col2 file start-loc val)))
       (else
        (%expect-char-close src (%pk-pos p) (%pk-line p) (%pk-col p)
                            file start-loc b)))))
 
 (define (%expect-char-close src pos line col file start-loc val)
   (let* ((p (%lex-peek src pos line col))
          (b (%pk-byte p)))
     (cond
       ((not b) (die start-loc "unterminated char literal"))
       ((= b 39)
        (cons (make-tok 'CHAR val start-loc)
              (list (%pk-pos p) (%pk-line p) (%pk-col p))))
       (else
        (die start-loc "multi-character char constant not supported")))))
 
 ;; --------------------------------------------------------------------
 ;; Punctuator reader.
 ;;
 ;; Greedy longest-match against %punct-alist. The alist
 ;; is already ordered longest-first. We additionally bucket entries by
 ;; their first byte so %lex-read-punct only loops over the small set of
 ;; patterns that can start at the current source byte.
 ;; --------------------------------------------------------------------
 
 (define (%alist-ref-int k al)
   ;; Lookup in an int-keyed alist (linear scan, '= compare).
   (cond ((null? al) #f)
         ((= (car (car al)) k) (cdr (car al)))
         (else (%alist-ref-int k (cdr al)))))
 
 (define (%mem-int? k xs)
   (cond ((null? xs) #f)
         ((= (car xs) k) #t)
         (else (%mem-int? k (cdr xs)))))
 
 (define (%filter-by-first-byte b al)
   ;; Subset of `al` whose pattern starts with byte b, preserving order.
   (cond
     ((null? al) '())
     ((= (bytevector-u8-ref (car (car al)) 0) b)
      (cons (car al) (%filter-by-first-byte b (cdr al))))
     (else (%filter-by-first-byte b (cdr al)))))
 
 (define (%group-by-first-byte al)
   ;; Build ((first-byte . sub-alist) ...) over `al`, one bucket per
   ;; distinct first byte; sub-alist preserves longest-match-first
   ;; order from the source list.
   (let loop ((xs al) (seen '()) (out '()))
     (cond
       ((null? xs) (reverse out))
       (else
        (let* ((entry (car xs))
               (pat   (car entry))
               (b     (bytevector-u8-ref pat 0)))
          (cond
            ((%mem-int? b seen) (loop (cdr xs) seen out))
            (else
             (loop (cdr xs)
                   (cons b seen)
                   (cons (cons b (%filter-by-first-byte b al)) out)))))))))
 
 (define %punct-buckets (%group-by-first-byte %punct-alist))
 
 (define (lex-read-punct src pos file)
   (%lex-read-punct src pos 1 (+ pos 1) file))
 
 (define (%lex-read-punct src pos line col file)
   (let* ((start-loc (%loc file line col))
          (p (%lex-peek src pos line col))
          (b (%pk-byte p)))
     (cond
       ((not b) (die start-loc "unrecognized byte" "EOF"))
       (else
        (let ((bucket (%alist-ref-int b %punct-buckets)))
          (cond
            ((not bucket) (die start-loc "unrecognized byte" (bv-of-byte b)))
            (else (%punct-loop src pos line col file start-loc bucket))))))))
 
 (define (%punct-loop src pos line col file start-loc al)
   (cond
     ((null? al)
      (let* ((p (%lex-peek src pos line col)))
        (die start-loc "unrecognized byte"
             (if (%pk-byte p) (bv-of-byte (%pk-byte p)) "EOF"))))
     (else
      (let* ((entry (car al))
             (pat   (car entry))
             (sym   (cdr entry))
             (m     (%match-bytes src pos line col pat 0)))
        (if m
            (cons (make-tok 'PUNCT sym start-loc) m)
            (%punct-loop src pos line col file start-loc (cdr al)))))))
 
 (define (%match-bytes src pos line col pat i)
   ;; If the next bytes from (pos line col), in logical-byte stream
   ;; order, equal `pat[i..]`, return (npos nline ncol) after the
   ;; match. Otherwise #f.
   (cond
     ((= i (bytevector-length pat)) (list pos line col))
     (else
      (let ((n (bytevector-length src)))
        (cond
          ((>= pos n) #f)
          (else
           (let ((b  (bytevector-u8-ref src pos))
                 (pb (bytevector-u8-ref pat i)))
             (cond
               ((%fast-byte? b)
                (if (= b pb)
                    (%match-bytes src (+ pos 1) line (+ col 1) pat (+ i 1))
                    #f))
               (else
                (let* ((p (%lex-peek src pos line col))
                       (b2 (%pk-byte p)))
                  (cond
                    ((not b2) #f)
                    ((= b2 pb)
                     (%match-bytes src (%pk-pos p) (%pk-line p) (%pk-col p)
                                   pat (+ i 1)))
                    (else #f))))))))))))
 
 ;; --------------------------------------------------------------------
 ;; tok-iter — streaming token source.
 ;; --------------------------------------------------------------------
 ;; Each pipeline layer (lex, pp, parser) wraps the layer below as a
 ;; tok-iter. iter-next pulls one token at a time. iter-peek/iter-peek2
 ;; cache lookahead in `buf`. iter-unget! pushes back. Live-data bound is
 ;; lookahead (≤2) + per-layer state, not source length.
 ;;
 ;; Pull-fns must keep yielding EOF after the first EOF (idempotent).
 (define-record-type tok-iter
   (%tok-iter pull-fn state buf)
   tok-iter?
   (pull-fn tok-iter-pull-fn)
   (state   tok-iter-state)
   (buf     tok-iter-buf  tok-iter-buf-set!))
 
 (define (iter-next it)
   (let ((b (tok-iter-buf it)))
     (cond
       ((null? b) ((tok-iter-pull-fn it) (tok-iter-state it)))
       (else
        (tok-iter-buf-set! it (cdr b))
        (car b)))))
 
 (define (iter-peek it)
   (let ((b (tok-iter-buf it)))
     (cond
       ((null? b)
        (let ((t ((tok-iter-pull-fn it) (tok-iter-state it))))
          (tok-iter-buf-set! it (list t))
          t))
       (else (car b)))))
 
 (define (iter-peek2 it)
   (let ((b (tok-iter-buf it)))
     (cond
       ((null? b)
        (let* ((t1 ((tok-iter-pull-fn it) (tok-iter-state it)))
               (t2 ((tok-iter-pull-fn it) (tok-iter-state it))))
          (tok-iter-buf-set! it (list t1 t2))
          t2))
       ((null? (cdr b))
        (let ((t2 ((tok-iter-pull-fn it) (tok-iter-state it))))
          (tok-iter-buf-set! it (cons (car b) (list t2)))
          t2))
       (else (car (cdr b))))))
 
 (define (iter-unget! it t)
   (tok-iter-buf-set! it (cons t (tok-iter-buf it))))
 
 ;; Drain an iter to a list ending in EOF. Used by lex-tokenize /
 ;; pp-expand so the cc-lex / cc-pp test runners can inspect the
 ;; materialized stream.
 (define (iter->list it)
   (let loop ((acc '()))
     (let ((t (iter-next it)))
       (cond
         ((eq? (tok-kind t) 'EOF) (reverse (cons t acc)))
         (else (loop (cons t acc)))))))
 
 ;; --------------------------------------------------------------------
 ;; list-iter — wrap an existing token list as a tok-iter. Yields each
 ;; tok in turn; once exhausted, keeps yielding EOF (idempotent). The
 ;; wrapped list typically already ends in EOF.
 ;; --------------------------------------------------------------------
 (define-record-type list-iter-state
   (%list-iter-state toks)
   list-iter-state?
   (toks lis-toks lis-toks-set!))
 
 (define (make-list-iter toks)
   (%tok-iter %list-iter-pull (%list-iter-state toks) '()))
 
 (define (%list-iter-pull st)
   (let ((toks (lis-toks st)))
     (cond
       ((null? toks) (make-tok 'EOF #f #f))
       (else
        (lis-toks-set! st (cdr toks))
        (car toks)))))
 
 ;; --------------------------------------------------------------------
 ;; lex-iter — streaming lexer. Steady state: pos/line/col + bol? in
 ;; lex-state; discarded per-token allocation is reclaimed by the GC.
 ;; --------------------------------------------------------------------
 ;; bol? — `#t` when no token has been emitted on the current physical
 ;; line yet (start of file, or only NL + whitespace seen since the last
 ;; line break). pp recognizes a directive only when its leading `#` is
 ;; at line-start; we forward that decision into the token stream by
 ;; emitting `HASH` instead of `(PUNCT hash …)` for a line-leading `#`.
 (define-record-type lex-state
   (%lex-state src file pos line col bol? done?)
   lex-state?
   (src   lex-state-src)
   (file  lex-state-file)
   (pos   lex-state-pos    lex-state-pos-set!)
   (line  lex-state-line   lex-state-line-set!)
   (col   lex-state-col    lex-state-col-set!)
   (bol?  lex-state-bol?   lex-state-bol?-set!)
   (done? lex-state-done?  lex-state-done?-set!))
 
 (define (make-lex-iter src file)
   (%lex-init!)
   (%tok-iter %lex-iter-pull
              (%lex-state src file 0 1 1 #t #f)
              '()))
 
 (define (%lex-iter-pull st)
   (cond
     ((lex-state-done? st)
      ;; Idempotent EOF: keep yielding EOF after the first one.
      (make-tok 'EOF #f (%loc (lex-state-file st)
                               (lex-state-line st)
                               (lex-state-col st))))
     (else (%lex-iter-step st))))
 
 (define (%lex-iter-step st)
   (let ((src  (lex-state-src st))
         (file (lex-state-file st))
         (pos  (lex-state-pos st))
         (line (lex-state-line st))
         (col  (lex-state-col st))
         (bol? (lex-state-bol? st))
         (kind #f) (val #f)
         (loc-line 1) (loc-col 1)
         (npos 0) (nline 1) (ncol 1) (nbol? #f))
     (let* ((sw (%skip-ws-and-comments src pos line col file))
            (pos1  (car sw))
            (line1 (car (cdr sw)))
            (col1  (car (cdr (cdr sw))))
            (p     (%lex-peek src pos1 line1 col1))
            (b     (%pk-byte p)))
       (set! loc-line line1)
       (set! loc-col col1)
       (set! val #f) (set! nbol? #f)
       (cond
         ;; EOF
         ((not b)
          (set! kind 'EOF)
          (set! npos pos1) (set! nline line1) (set! ncol col1))
         ;; Newline → NL token; next call starts at bol.
         ((%newline? b)
          (set! kind 'NL)
          (set! npos (%pk-pos p))
          (set! nline (%pk-line p))
          (set! ncol  (%pk-col  p))
          (set! nbol? #t))
         ;; Line-leading `#`: bare `#` becomes HASH; `##` falls
         ;; through to punctuator (lexes as `paste`).
         ((and bol? (= b 35))
          (let* ((q  (%lex-peek src (%pk-pos p) (%pk-line p) (%pk-col p)))
                 (b2 (%pk-byte q)))
            (cond
              ((and b2 (= b2 35))
               (let* ((r (%lex-read-punct src pos1 line1 col1 file))
                      (tok (car r)) (rest (cdr r)))
                 (set! kind 'PUNCT) (set! val (tok-value tok))
                 (set! npos  (car rest))
                 (set! nline (car (cdr rest)))
                 (set! ncol  (car (cdr (cdr rest))))))
              (else
               (set! kind 'HASH)
               (set! npos  (%pk-pos p))
               (set! nline (%pk-line p))
               (set! ncol  (%pk-col  p))))))
         ;; Identifier / keyword
         ((%ident-start? b)
          (let* ((r (%lex-read-ident src pos1 line1 col1 file))
                 (tok (car r)) (rest (cdr r)))
            (set! kind (tok-kind tok))
            (cond ((eq? (tok-kind tok) 'KW)
                   (set! val (tok-value tok)))
                  (else (set! val (tok-value tok))))
            (set! npos  (car rest))
            (set! nline (car (cdr rest)))
            (set! ncol  (car (cdr (cdr rest))))))
         ;; Number (digit start)
         ((%digit? b)
          (let* ((r (%lex-read-number src pos1 line1 col1 file))
                 (tok (car r)) (rest (cdr r)))
            (set! kind 'INT) (set! val (tok-value tok))
            (set! npos  (car rest))
            (set! nline (car (cdr rest)))
            (set! ncol  (car (cdr (cdr rest))))))
         ;; '.' is a punctuator unless followed by a digit (float).
         ((= b 46)
          (let* ((q  (%lex-peek src (%pk-pos p) (%pk-line p) (%pk-col p)))
                 (b2 (%pk-byte q)))
            (cond
              ((and b2 (%digit? b2))
               (die (%loc file line1 col1)
                    "floating-point literal not supported"))
              (else
               (let* ((r (%lex-read-punct src pos1 line1 col1 file))
                      (tok (car r)) (rest (cdr r)))
                 (set! kind 'PUNCT) (set! val (tok-value tok))
                 (set! npos  (car rest))
                 (set! nline (car (cdr rest)))
                 (set! ncol  (car (cdr (cdr rest)))))))))
         ;; String
         ((= b 34)
          (let* ((r (%lex-read-string src pos1 line1 col1 file))
                 (tok (car r)) (rest (cdr r))
                 (bv  (tok-value tok)))
            (set! kind 'STR)
            (set! val bv)
            (set! npos  (car rest))
            (set! nline (car (cdr rest)))
            (set! ncol  (car (cdr (cdr rest))))))
         ;; Char
         ((= b 39)
          (let* ((r (%lex-read-char src pos1 line1 col1 file))
                 (tok (car r)) (rest (cdr r)))
            (set! kind 'CHAR) (set! val (tok-value tok))
            (set! npos  (car rest))
            (set! nline (car (cdr rest)))
            (set! ncol  (car (cdr (cdr rest))))))
         ;; Punctuator (default)
         (else
          (let* ((r (%lex-read-punct src pos1 line1 col1 file))
                 (tok (car r)) (rest (cdr r)))
            ;; Line-leading `%:` digraph also acts as HASH for directives.
            (cond
              ((and bol? (eq? (tok-value tok) 'hash))
               (set! kind 'HASH))
              (else
               (set! kind 'PUNCT) (set! val (tok-value tok))))
            (set! npos  (car rest))
            (set! nline (car (cdr rest)))
            (set! ncol  (car (cdr (cdr rest))))))))
     ;; Advance the iterator state and return the token.
     (cond
       ((eq? kind 'EOF)
        (lex-state-done?-set! st #t)
        (make-tok 'EOF #f (%loc file loc-line loc-col)))
       (else
        (lex-state-pos-set! st npos)
        (lex-state-line-set! st nline)
        (lex-state-col-set! st ncol)
        (lex-state-bol?-set! st nbol?)
        (make-tok kind val (%loc file loc-line loc-col))))))
 
 ;; Drain a lex-iter into a list ending in EOF, for the cc-lex test
 ;; runner. Production callers chain make-lex-iter directly.
 (define (lex-tokenize src file)
   (iter->list (make-lex-iter src file)))
 ;; cc/pp.scm — preprocessor. Hide-set per C11 6.10.3.4.
 ;; #include rejected (CC.md §Toolchain envelope).
 
 ;; --- helpers ---
 (define (%pp-bv-mem? x xs)
   (cond ((null? xs) #f)
         ((bv= x (car xs)) #t)
         (else (%pp-bv-mem? x (cdr xs)))))
 
 (define (%pp-bv-union a b)
   (cond ((null? a) b)
         ((%pp-bv-mem? (car a) b) (%pp-bv-union (cdr a) b))
         (else (cons (car a) (%pp-bv-union (cdr a) b)))))
 
 (define (%pp-with-hide t hide)
   (%tok (tok-kind t) (tok-value t) (tok-loc t) hide))
 (define (%pp-with-loc t loc)
   (%tok (tok-kind t) (tok-value t) loc (tok-hide t)))
 
 ;; --- pp-state (private record) ---
 ;; cond-stack: list of (active? . has-taken?). Outer-active gating is
 ;; computed by walking the stack rather than encoding it in frames.
 ;;
 ;; Streaming fields drive make-pp-iter; the bounded-buffer path used
 ;; by pp-eval-cexpr leaves them at #f / '().
 ;;   lex-iter   — upstream tok-iter, or #f
 ;;   up-pending — toks unshifted upstream (macro-expansion bodies that
 ;;                must be re-scanned for further expansion)
 ;;   out-buf    — toks already dispatched but stashed for the next pull
 ;;                (peek-and-fuse for adjacent STRs lookahead overshoots
 ;;                by one tok, which lands here)
 (define-record-type pp-state
   (%pp-state macros cond-stack cur-file line-delta lex-iter up-pending out-buf)
   pp-state?
   (macros     pps-macros     pps-macros-set!)
   (cond-stack pps-cond-stack pps-cond-stack-set!)
   (cur-file   pps-cur-file   pps-cur-file-set!)
   (line-delta pps-line-delta pps-line-delta-set!)
   (lex-iter   pps-lex-iter)
   (up-pending pps-up-pending pps-up-pending-set!)
   (out-buf    pps-out-buf    pps-out-buf-set!))
 
 (define (%pp-make-state defs) (%pp-state defs '() #f 0 #f '() '()))
 
 (define (%pp-active? state)
   (let loop ((xs (pps-cond-stack state)))
     (cond ((null? xs) #t)
           ((not (car (car xs))) #f)
           (else (loop (cdr xs))))))
 
 ;; Active for the *parent* of the top frame (used by elif/else).
 (define (%pp-parent-active? state)
   (let ((cs (pps-cond-stack state)))
     (cond ((null? cs) #t)
           (else
            (let loop ((xs (cdr cs)))
              (cond ((null? xs) #t)
                    ((not (car (car xs))) #f)
                    (else (loop (cdr xs)))))))))
 
 ;; --- token classification ---
 (define (%pp-eof? t)   (eq? (tok-kind t) 'EOF))
 (define (%pp-nl? t)    (eq? (tok-kind t) 'NL))
 (define (%pp-hash? t)  (eq? (tok-kind t) 'HASH))
 (define (%pp-ident? t) (eq? (tok-kind t) 'IDENT))
 (define (%pp-int? t)   (eq? (tok-kind t) 'INT))
 (define (%pp-punct? t pname)
   (and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) pname)))
 (define (%pp-ident-name? t name-bv)
   (and (%pp-ident? t) (bv= (tok-value t) name-bv)))
 (define (%pp-skip-ws toks) toks)
 
 ;; --- built-in macro names ---
 (define %pp-bv-FILE   "__FILE__")
 (define %pp-bv-LINE   "__LINE__")
 (define %pp-bv-STDC   "__STDC__")
 (define %pp-bv-LISPCC "__LISPCC__")
 (define %pp-bv-DATE   "__DATE__")
 (define %pp-bv-TIME   "__TIME__")
 (define %pp-bv-STDC-VERSION "__STDC_VERSION__")
 (define %pp-bv-STDC-HOSTED  "__STDC_HOSTED__")
 (define %pp-bv-VA-ARGS "__VA_ARGS__")
 (define %pp-bv-defined "defined")
 
 ;; Fixed values for reproducibility — we don't read the wall clock.
 (define %pp-bv-DATE-VALUE "Jan  1 1970")
 (define %pp-bv-TIME-VALUE "00:00:00")
 
 (define (%pp-builtin? name)
   (or (bv= name %pp-bv-FILE) (bv= name %pp-bv-LINE)
       (bv= name %pp-bv-STDC) (bv= name %pp-bv-LISPCC)
       (bv= name %pp-bv-DATE) (bv= name %pp-bv-TIME)
       (bv= name %pp-bv-STDC-VERSION) (bv= name %pp-bv-STDC-HOSTED)))
 
 (define (%pp-expand-builtin name loc state)
   ;; Emit the token at the ORIGINAL loc; %pp-relocate downstream will
   ;; apply pps-cur-file / pps-line-delta. Doing the rewrite here too
   ;; (then letting relocate re-apply it) double-shifts __LINE__'s loc.
   ;; The VALUE of __LINE__ / __FILE__ already reflects the post-#line
   ;; mapping because we compute `file`/`line` from cur-file/line-delta.
   (let* ((file (or (pps-cur-file state) (loc-file loc)))
          (line (+ (loc-line loc) (pps-line-delta state))))
     (cond
       ((bv= name %pp-bv-FILE)         (list (%tok 'STR file loc '())))
       ((bv= name %pp-bv-LINE)         (list (%tok 'INT line loc '())))
       ((bv= name %pp-bv-STDC)         (list (%tok 'INT 1 loc '())))
       ((bv= name %pp-bv-LISPCC)       (list (%tok 'INT 1 loc '())))
       ((bv= name %pp-bv-DATE)         (list (%tok 'STR %pp-bv-DATE-VALUE loc '())))
       ((bv= name %pp-bv-TIME)         (list (%tok 'STR %pp-bv-TIME-VALUE loc '())))
       ((bv= name %pp-bv-STDC-VERSION) (list (%tok 'INT 199901 loc '())))
       ((bv= name %pp-bv-STDC-HOSTED)  (list (%tok 'INT 1 loc '())))
       (else (die loc "internal: not a builtin" name)))))
 
 ;; --- buf-list: simple reversed-list buffer of toks ---
 (define-record-type buf-list
   (%buf-list xs)
   buf-list?
   (xs buf-list-xs buf-list-xs-set!))
 (define (make-buf-list) (%buf-list '()))
 (define (buf-list-push! b t) (buf-list-xs-set! b (cons t (buf-list-xs b))))
 (define (buf-list-push-many! b ts)
   (let loop ((ts ts))
     (cond ((null? ts) #t)
           (else (buf-list-push! b (car ts)) (loop (cdr ts))))))
 (define (buf-list-flush b) (reverse (buf-list-xs b)))
 
 ;; --- make-pp-iter: streaming preprocessor ---
 ;; Wraps a lex-iter (or any tok-iter). Returns a tok-iter. Live data
 ;; bounded by parser state + lookahead, not source length. Adjacent-STR
 ;; fusion happens inline via peek-and-stash.
 (define (make-pp-iter src-iter initial-defines)
   (let ((st (%pp-state (alist->hash initial-defines)
                        '() #f 0 src-iter '() '())))
     (%tok-iter %pp-iter-pull st '())))
 
 (define (%pp-iter-pull st)
   (let ((ob (pps-out-buf st)))
     (cond
       ((not (null? ob))
        (pps-out-buf-set! st (cdr ob))
        (car ob))
       (else (%pp-maybe-fuse-str st (%pp-dispatch-step st))))))
 
 ;; --- upstream helpers ---
 ;; Upstream tokens come either from up-pending (macro-expansion bodies
 ;; that need re-scanning) or from the wrapped lex-iter.
 (define (%pp-pull-upstream st)
   (let ((up (pps-up-pending st)))
     (cond
       ((not (null? up))
        (pps-up-pending-set! st (cdr up))
        (car up))
       (else (iter-next (pps-lex-iter st))))))
 
 (define (%pp-peek-upstream st)
   (let ((up (pps-up-pending st)))
     (cond
       ((not (null? up)) (car up))
       (else (iter-peek (pps-lex-iter st))))))
 
 ;; Push toks to the front of upstream so (car toks) is yielded next.
 (define (%pp-unshift-upstream! st toks)
   (pps-up-pending-set! st (append toks (pps-up-pending st))))
 
 ;; Collect tokens up to (not including) NL or EOF. NL is consumed; EOF
 ;; is unshifted back so the main loop sees it.
 (define (%pp-collect-line-stream st)
   (let loop ((acc '()))
     (let ((t (%pp-pull-upstream st)))
       (cond
         ((%pp-eof? t)
          (%pp-unshift-upstream! st (list t))
          (reverse acc))
         ((%pp-nl? t) (reverse acc))
         (else (loop (cons t acc)))))))
 
 ;; Streaming arg collection for fn-like macro calls. Position is just
 ;; AFTER the opening `(`. Returns the list of arg-tokenlists.
 (define (%pp-collect-args-stream st call-loc)
   (let loop ((depth 0) (cur '()) (args '()))
     (let ((t (%pp-pull-upstream st)))
       (cond
         ((%pp-eof? t)
          (die call-loc "macro call: unterminated argument list"))
         ((and (= depth 0) (%pp-punct? t 'rparen))
          (cond
            ;; Empty parens count as one empty argument; bind-args
            ;; degenerates this back to "no args" for 0-param macros.
            ((and (null? args) (null? cur)) (list '()))
            (else (reverse (cons (reverse cur) args)))))
         ((and (= depth 0) (%pp-punct? t 'comma))
          (loop 0 '() (cons (reverse cur) args)))
         ((%pp-punct? t 'lparen)
          (loop (+ depth 1) (cons t cur) args))
         ((%pp-punct? t 'rparen)
          (loop (- depth 1) (cons t cur) args))
         (else (loop depth (cons t cur) args))))))
 
 ;; Single dispatch step. Returns one post-pp tok (skipping NLs,
 ;; processing directives, expanding macros). Does NOT apply STR-fusion
 ;; — that happens one layer up in %pp-iter-pull, otherwise the
 ;; recursive lookahead during fusion would itself fuse further STRs
 ;; and drag tokens past the run into out-buf.
 (define (%pp-dispatch-step st)
   (let ((t (%pp-pull-upstream st)))
     (cond
       ((%pp-eof? t)
        (cond ((not (null? (pps-cond-stack st)))
               (die (tok-loc t) "unterminated #if/#ifdef/#ifndef"))
              (else t)))
       ((%pp-nl? t) (%pp-dispatch-step st))
       ((%pp-hash? t)
        (let ((line (%pp-collect-line-stream st)))
          (%pp-dispatch-directive t line st #f)
          (%pp-dispatch-step st)))
       ((not (%pp-active? st))
        (%pp-dispatch-step st))
       ((%pp-ident? t)
        (let ((name (tok-value t)))
          (cond
            ((%pp-bv-mem? name (tok-hide t))
             (%pp-relocate t st))
            ((%pp-builtin? name)
             (let ((toks (%pp-expand-builtin name (tok-loc t) st)))
               (%pp-unshift-upstream! st toks)
               (%pp-dispatch-step st)))
            (else
             (let ((m (%hash-ref (pps-macros st) name)))
               (cond
                 ((not m) (%pp-relocate t st))
                 ((eq? (macro-kind m) 'obj)
                  (let ((body (%pp-prepare-body (macro-body m)
                                (cons name (tok-hide t))
                                (tok-loc t))))
                    (%pp-unshift-upstream! st body)
                    (%pp-dispatch-step st)))
                 (else
                  ;; fn-like or fn-vararg: peek upstream for `(`. If
                  ;; not present, pass IDENT through unchanged (no
                  ;; consumption); the next iter call will process the
                  ;; following tok normally.
                  (let ((next (%pp-peek-upstream st)))
                    (cond
                      ((not (%pp-punct? next 'lparen))
                       (%pp-relocate t st))
                      (else
                       (%pp-pull-upstream st)        ; consume `(`
                       (let* ((args (%pp-collect-args-stream st (tok-loc t)))
                              (params (macro-params m))
                              (variadic? (eq? (macro-kind m) 'fn-vararg))
                              (env (%pp-bind-args params args variadic? (tok-loc t)))
                              (sub (%pp-substitute (macro-body m) env (tok-loc t) st))
                              (body (%pp-prepare-body sub
                                      (cons name (tok-hide t))
                                      (tok-loc t))))
                         (%pp-unshift-upstream! st body)
                         (%pp-dispatch-step st))))))))))))
       (else (%pp-relocate t st)))))
 
 ;; Translation phase 6 (peek-and-fuse). If `cur` is STR, look at the
 ;; next post-pp tok; if it's STR, fuse and repeat. Anything else gets
 ;; stashed in out-buf for the next iter-next call. Lookahead goes
 ;; through %pp-dispatch-step (no fusion), so a non-STR neighbor
 ;; correctly terminates the run.
 (define (%pp-maybe-fuse-str st cur)
   (cond
     ((not (eq? (tok-kind cur) 'STR)) cur)
     (else
      (let loop ((cur cur))
        (let ((next (%pp-dispatch-step st)))
          (cond
            ((eq? (tok-kind next) 'STR)
             (loop (%tok 'STR
                         (bytevector-append (tok-value cur) (tok-value next))
                         (tok-loc cur)
                         (tok-hide cur))))
            (else
             (pps-out-buf-set! st (cons next (pps-out-buf st)))
             cur)))))))
 
 ;; Drain a pp-iter into a list ending in EOF, for the cc-pp test
 ;; runner. The input token list becomes the upstream via make-list-iter.
 ;; Production callers chain make-pp-iter directly over a make-lex-iter.
 (define (pp-expand toks initial-defines)
   (iter->list (make-pp-iter (make-list-iter toks) initial-defines)))
 
 ;; --- directive dispatch ---
 ;; pmatch-based on the directive name bytes. Byte literals use the explicit
 ;; mixed string/bytevector rule from micro+boot2.
 ;; Directive name can arrive as IDENT (most cases) or KW (`if` and `else`
 ;; are C keywords promoted by lex; their KW symbol values map back to bv
 ;; via symbol->string).
 (define (%pp-directive-name t)
   (cond ((eq? (tok-kind t) 'IDENT) (tok-value t))
         ((eq? (tok-kind t) 'KW)    (symbol->string (tok-value t)))
         (else #f)))
 
 (define (%pp-dispatch-directive hash-tok line state out)
   (let ((line (%pp-skip-ws line)))
     (cond
       ((null? line) #t)            ; bare `#` line — null directive
       ((%pp-directive-name (car line))
        (let ((name (%pp-directive-name (car line)))
              (rest (cdr line))
              (loc  (tok-loc (car line))))
          (pmatch name
            ("define"  (cond ((%pp-active? state) (%pp-do-define rest state)) (else #t)))
            ("undef"   (cond ((%pp-active? state) (%pp-do-undef rest state))  (else #t)))
            ("if"      (%pp-do-if rest state))
            ("ifdef"   (%pp-do-ifdef rest state))
            ("ifndef"  (%pp-do-ifndef rest state))
            ("elif"    (%pp-do-elif rest state))
            ("else"    (%pp-do-else rest state))
            ("endif"   (%pp-do-endif rest state))
            ("error"   (cond ((%pp-active? state)
                              (%pp-do-error (cons (car line) rest) state))
                             (else #t)))
            ("line"    (cond ((%pp-active? state)
                              ;; Macro-expand the operands BEFORE
                              ;; processing (`#line MACRO`). Pre-expansion
                              ;; we capture the directive's source line so
                              ;; the line-delta math doesn't anchor on a
                              ;; macro definition site.
                              (let ((here (cond
                                            ((null? rest)
                                             (loc-line (tok-loc hash-tok)))
                                            (else
                                             (loc-line (tok-loc (car rest)))))))
                                (%pp-do-line (%pp-expand-line rest state)
                                             state here)))
                             (else #t)))
            ("pragma"  (cond ((%pp-active? state) (%pp-do-pragma rest state)) (else #t)))
            ("include" (cond ((%pp-active? state) (%pp-do-include rest state)) (else #t)))
            (else (die loc "unknown preprocessor directive" name)))))
       (else
        (die (tok-loc (car line)) "expected directive name after '#'"
             (tok-kind (car line)))))))
 
 ;; --- #define ---
 ;; function-like vs object-like is decided by an immediately-adjacent `(`.
 ;; "Adjacent" = column of `(` equals column of name + length of name.
 (define (%pp-do-define line state)
   (cond
     ((null? line) (die #f "#define requires a macro name"))
     ((not (%pp-ident? (car line)))
      (die (tok-loc (car line)) "#define: expected identifier"))
     (else
      (let* ((nt (car line)) (name (tok-value nt)) (rest (cdr line)))
        (cond
          ((and (not (null? rest))
                (%pp-punct? (car rest) 'lparen)
                (= (loc-col (tok-loc (car rest)))
                   (+ (loc-col (tok-loc nt))
                      (bytevector-length name))))
           (%pp-define-fn name (cdr rest) (tok-loc nt) state))
          (else
           (let ((m (%macro 'obj '() rest)))
             (%hash-set! (pps-macros state) name m))))))))
 
 (define (%pp-define-fn name post-lparen nloc state)
   (let loop ((toks post-lparen) (params '()) (variadic? #f))
     (cond
       ((null? toks) (die nloc "#define: unterminated parameter list"))
       ((%pp-punct? (car toks) 'rparen)
        (let* ((body (cdr toks))
               (kind (if variadic? 'fn-vararg 'fn))
               (m    (%macro kind (reverse params) body)))
          (%hash-set! (pps-macros state) name m)))
       ((%pp-punct? (car toks) 'ellipsis)
        (let ((rest (cdr toks)))
          (cond
            ((null? rest) (die (tok-loc (car toks)) "#define: '...' must precede ')'"))
            ((%pp-punct? (car rest) 'rparen) (loop rest params #t))
            (else (die (tok-loc (car rest)) "#define: garbage after '...'")))))
       ((null? params)
        (cond
          ((%pp-ident? (car toks))
           (loop (cdr toks) (cons (tok-value (car toks)) params) #f))
          (else (die (tok-loc (car toks)) "#define: expected parameter name"))))
       (else
        (cond
          ((%pp-punct? (car toks) 'comma)
           (let ((after (cdr toks)))
             (cond
               ((null? after) (die (tok-loc (car toks)) "#define: trailing ','"))
               ((%pp-punct? (car after) 'ellipsis)
                (let ((aa (cdr after)))
                  (cond
                    ((and (not (null? aa)) (%pp-punct? (car aa) 'rparen))
                     (loop aa params #t))
                    (else (die (tok-loc (car after))
                               "#define: '...' must precede ')'")))))
               ((%pp-ident? (car after))
                (loop (cdr after) (cons (tok-value (car after)) params) #f))
               (else
                (die (tok-loc (car after))
                     "#define: expected parameter name after ','")))))
          (else (die (tok-loc (car toks))
                     "#define: expected ',' or ')' in parameter list")))))))
 
 ;; --- #undef ---
 (define (%pp-do-undef line state)
   (cond
     ((null? line) (die #f "#undef requires a macro name"))
     ((not (%pp-ident? (car line)))
      (die (tok-loc (car line)) "#undef: expected identifier"))
     (else
      (%hash-delete! (pps-macros state) (tok-value (car line))))))
 
 ;; --- #if / #ifdef / #ifndef / #elif / #else / #endif ---
 ;; cond-stack frame: (active? taken? else?). active? gates the body
 ;; until the next #elif/#else/#endif; taken? records whether ANY arm
 ;; (the original #if branch or any #elif) has matched, so later arms
 ;; stay inactive; else? records that we have already passed an #else
 ;; in this frame, so a subsequent #elif/#else is rejected.
 (define (%pp-frame a? t? e?) (list a? t? e?))
 (define (%pp-frame-active? f) (car f))
 (define (%pp-frame-taken?  f) (car (cdr f)))
 (define (%pp-frame-else?   f) (car (cdr (cdr f))))
 
 (define (%pp-do-if line state)
   (cond
     ((not (%pp-active? state))
      (pps-cond-stack-set! state (cons (%pp-frame #f #f #f) (pps-cond-stack state))))
     (else
      (let* ((v (pp-eval-cexpr line state))
             (a? (not (%c-value-zero? v))))
        (pps-cond-stack-set! state (cons (%pp-frame a? a? #f) (pps-cond-stack state)))))))
 
 (define (%pp-do-ifdef line state)
   (cond
     ((not (%pp-active? state))
      (pps-cond-stack-set! state (cons (%pp-frame #f #f #f) (pps-cond-stack state))))
     (else
      (let ((d? (%pp-defined? (%pp-name-of-single line) state)))
        (pps-cond-stack-set! state
          (cons (%pp-frame d? d? #f) (pps-cond-stack state)))))))
 
 (define (%pp-do-ifndef line state)
   (cond
     ((not (%pp-active? state))
      (pps-cond-stack-set! state (cons (%pp-frame #f #f #f) (pps-cond-stack state))))
     (else
      (let ((a? (not (%pp-defined? (%pp-name-of-single line) state))))
        (pps-cond-stack-set! state
          (cons (%pp-frame a? a? #f) (pps-cond-stack state)))))))
 
 (define (%pp-name-of-single line)
   (cond
     ((null? line) (die #f "#ifdef/#ifndef: missing identifier"))
     ((not (%pp-ident? (car line)))
      (die (tok-loc (car line)) "#ifdef/#ifndef: expected identifier"))
     (else (tok-value (car line)))))
 
 (define (%pp-defined? name state)
   (or (%hash-ref (pps-macros state) name)
       (%pp-builtin? name)
       #f))
 
 (define (%pp-do-elif line state)
   (let ((cs (pps-cond-stack state)))
     (cond
       ((null? cs) (die #f "#elif outside #if"))
       (else
        (let* ((top (car cs)) (rest (cdr cs))
               (taken? (%pp-frame-taken? top))
               (else?  (%pp-frame-else? top))
               (par? (%pp-parent-active? state)))
          (cond
            (else? (die #f "#elif after #else"))
            ((or (not par?) taken?)
             (pps-cond-stack-set! state (cons (%pp-frame #f taken? #f) rest)))
            (else
             (let* ((v (pp-eval-cexpr line state))
                    (a? (not (%c-value-zero? v))))
               (pps-cond-stack-set! state
                 (cons (%pp-frame a? (or a? taken?) #f) rest))))))))))
 
 (define (%pp-do-else line state)
   (let ((cs (pps-cond-stack state)))
     (cond
       ((null? cs) (die #f "#else outside #if"))
       (else
        (let* ((top (car cs)) (rest (cdr cs))
               (taken? (%pp-frame-taken? top))
               (else?  (%pp-frame-else? top))
               (par? (%pp-parent-active? state)))
          (cond
            (else? (die #f "#else after #else"))
            ((not par?)
             (pps-cond-stack-set! state (cons (%pp-frame #f taken? #t) rest)))
            (taken?
             (pps-cond-stack-set! state (cons (%pp-frame #f #t #t) rest)))
            (else
             (pps-cond-stack-set! state (cons (%pp-frame #t #t #t) rest)))))))))
 
 (define (%pp-do-endif line state)
   (let ((cs (pps-cond-stack state)))
     (cond ((null? cs) (die #f "#endif outside #if"))
           (else (pps-cond-stack-set! state (cdr cs))))))
 
 ;; --- #error ---
 ;; line[0] is the directive name "error"; the rest is the user message.
 (define (%pp-do-error line state)
   (let* ((msg-toks (if (null? line) '() (cdr line)))
          (loc (if (null? line) #f (tok-loc (car line))))
          (msg (%pp-toks->display msg-toks)))
     (die loc "#error" msg)))
 
 ;; Per C11 §6.10.3.2 ¶2: whitespace between argument tokens becomes a
 ;; single space; absence of whitespace must NOT introduce one. We
 ;; approximate "had whitespace" by comparing locations: a space goes
 ;; in iff the next token does not abut the previous one (different
 ;; line, or column gap larger than the prev spelling length).
 (define (%pp-toks->display toks)
   (let loop ((toks toks) (prev #f) (prev-bv #f) (acc '()))
     (cond
       ((null? toks) (bv-cat (reverse acc)))
       (else
        (let* ((t (car toks)) (p (%pp-tok->bv t))
               (sep? (cond
                       ((not prev) #f)
                       ((or (not (tok-loc prev)) (not (tok-loc t))) #t)
                       ((not (= (loc-line (tok-loc prev))
                                (loc-line (tok-loc t)))) #t)
                       (else
                        (not (= (loc-col (tok-loc t))
                                (+ (loc-col (tok-loc prev))
                                   (bytevector-length prev-bv))))))))
          (loop (cdr toks) t p
                (if sep? (cons p (cons " " acc)) (cons p acc))))))))
 
 ;; Reverse-map punctuator symbol -> source spelling. %punct-alist may
 ;; map several spellings to the same symbol (e.g. both "[" and "<:"
 ;; resolve to 'lbrack); the 1-byte canonical forms appear last in the
 ;; source list, so a last-wins fold yields "[" rather than the digraph.
 (define %pp-punct-spell
   (let loop ((al %punct-alist) (acc '()))
     (cond ((null? al) acc)
           (else (loop (cdr al)
                       (alist-set (cdr (car al)) (car (car al)) acc))))))
 
 (define (%pp-punct-spelling sym)
   (or (alist-ref/eq sym %pp-punct-spell) (symbol->string sym)))
 
 (define (%pp-tok->bv t)
   (let ((k (tok-kind t)) (v (tok-value t)))
     (cond
       ((eq? k 'IDENT) v)
       ((eq? k 'INT)   (%c-value-source-bv v))
       ((eq? k 'STR)   (%pp-quote-bytes v 34))
       ((eq? k 'CHAR)  (%pp-quote-bytes (bv-of-byte v) 39))
       ((eq? k 'KW)    (symbol->string v))
       ((eq? k 'PUNCT) (%pp-punct-spelling v))
       (else "?"))))
 
 ;; Reconstruct a string/char literal source spelling from cooked content.
 ;; Per C11 6.10.3.2: stringize must reproduce the source spelling of
 ;; STR/CHAR constants — every `"` and `\` is prefixed with `\`, and
 ;; the common control-character escapes are restored from their cooked
 ;; bytes. `delim` is 34 for STR, 39 for CHAR.
 (define (%pp-quote-bytes bv delim)
   (let* ((n (bytevector-length bv))
          (delim-bv (bv-of-byte delim)))
     (let loop ((i 0) (acc (list delim-bv)))
       (cond
         ((= i n) (bv-cat (reverse (cons delim-bv acc))))
         (else
          (let ((b (bytevector-u8-ref bv i)))
            (cond
              ((or (= b delim) (= b 92))
               (loop (+ i 1) (cons (bv-of-byte b) (cons "\\" acc))))
              ((= b 10) (loop (+ i 1) (cons "\\n" acc)))
              ((= b 9)  (loop (+ i 1) (cons "\\t" acc)))
              ((= b 13) (loop (+ i 1) (cons "\\r" acc)))
              (else
               (loop (+ i 1) (cons (bv-of-byte b) acc))))))))))
 
 ;; --- #line / #pragma / #include ---
 ;; Approximate #line: subsequent toks have line = (orig-line + delta),
 ;; where delta = (N - here-line - 1). Good enough for most cases.
 (define (%pp-do-line line state here)
   (cond
     ((null? line) (die #f "#line requires a line number"))
     ((not (%pp-int? (car line)))
      (die (tok-loc (car line)) "#line: expected integer"))
     (else
      (let* ((nt (car line)) (n (%c-int-raw (tok-value nt)))
             (rest (cdr line)))
        (pps-line-delta-set! state (- n here 1))
        (cond
          ((null? rest) #t)
          ((eq? (tok-kind (car rest)) 'STR)
           (pps-cur-file-set! state (tok-value (car rest))))
          (else (die (tok-loc (car rest))
                     "#line: expected string after number")))))))
 
 (define (%pp-do-pragma line state) #t)
 
 (define (%pp-do-include line state)
   (die (if (null? line) #f (tok-loc (car line)))
        "#include: file inclusion is handled upstream by pre-flatten"))
 
 ;; --- macro expansion engine ---
 ;; Walk toks; for each IDENT, look up in macros / builtins. Hide-set:
 ;; if the name is in t.hide, don't expand. Otherwise expand and rescan
 ;; the produced body, with hide += {name}.
 (define (%pp-emit-expanded toks state out)
   (let loop ((toks toks))
     (cond
       ((null? toks) #t)
       (else
        (let* ((t (car toks)) (rest (cdr toks)))
          (cond
            ((not (%pp-ident? t))
             (buf-list-push! out (%pp-relocate t state))
             (loop rest))
            (else
             (let ((name (tok-value t)))
               (cond
                 ((%pp-bv-mem? name (tok-hide t))
                  (buf-list-push! out (%pp-relocate t state))
                  (loop rest))
                 ((%pp-builtin? name)
                  (buf-list-push-many! out
                    (%pp-expand-builtin name (tok-loc t) state))
                  (loop rest))
                 (else
                  (let ((m (%hash-ref (pps-macros state) name)))
                    (cond
                      ((not m)
                       (buf-list-push! out (%pp-relocate t state))
                       (loop rest))
                      (else
                       (%pp-apply-macro t m rest state out loop))))))))))))))
 
 (define (%pp-apply-macro t m rest state out cont)
   (let ((kind (macro-kind m)) (name (tok-value t)))
     (cond
       ((eq? kind 'obj)
        (let ((bodies (%pp-prepare-body (macro-body m)
                        (cons name (tok-hide t))
                        (tok-loc t))))
          (%pp-emit-expanded bodies state out)
          (cont rest)))
       (else
        (let ((after (%pp-skip-ws rest)))
          (cond
            ((or (null? after) (not (%pp-punct? (car after) 'lparen)))
             (buf-list-push! out (%pp-relocate t state))
             (cont rest))
            (else
             (let* ((ar (%pp-collect-args (cdr after) (tok-loc t)))
                    (args (car ar)) (rest2 (cdr ar))
                    (params (macro-params m))
                    (variadic? (eq? kind 'fn-vararg))
                    (env (%pp-bind-args params args variadic? (tok-loc t)))
                    (sub (%pp-substitute (macro-body m) env (tok-loc t) state))
                    (bodies (%pp-prepare-body sub
                              (cons name (tok-hide t))
                              (tok-loc t))))
               (%pp-emit-expanded bodies state out)
               (cont rest2)))))))))
 
 ;; Stamp built-in marker tokens (__LINE__ / __FILE__) inside the body
 ;; with the macro-invocation location, so they report the call site
 ;; per C11 §6.10.8. Other body tokens keep their #define-time loc so
 ;; diagnostics still point at the macro body. Hide-set is updated
 ;; with the macro name on every token.
 (define (%pp-prepare-body body extra-hide . call-loc-opt)
   (let ((call-loc (cond ((null? call-loc-opt) #f)
                         (else (car call-loc-opt)))))
     (map (lambda (t)
            (let ((hidden (%pp-with-hide t (%pp-bv-union extra-hide
                                                         (tok-hide t)))))
              (cond
                ((and call-loc (%pp-ident? hidden)
                      (or (bv= (tok-value hidden) %pp-bv-LINE)
                          (bv= (tok-value hidden) %pp-bv-FILE)))
                 (%pp-with-loc hidden call-loc))
                (else hidden))))
          body)))
 
 ;; Collect comma-separated args. `toks` starts AFTER `(`. Returns
 ;; (args . rest), where args is a list of token-lists.
 (define (%pp-collect-args toks call-loc)
   (let loop ((toks toks) (depth 0) (cur '()) (args '()))
     (cond
       ((null? toks) (die call-loc "macro call: unterminated argument list"))
       ((%pp-eof? (car toks))
        (die call-loc "macro call: unterminated argument list"))
       ((and (= depth 0) (%pp-punct? (car toks) 'rparen))
        (let ((args*
               (cond
                 ;; Empty parens count as one empty argument; bind-args
                 ;; degenerates this back to "no args" for 0-param macros.
                 ((and (null? args) (null? cur)) (list '()))
                 (else (reverse (cons (reverse cur) args))))))
          (cons args* (cdr toks))))
       ((and (= depth 0) (%pp-punct? (car toks) 'comma))
        (loop (cdr toks) 0 '() (cons (reverse cur) args)))
       ((%pp-punct? (car toks) 'lparen)
        (loop (cdr toks) (+ depth 1) (cons (car toks) cur) args))
       ((%pp-punct? (car toks) 'rparen)
        (loop (cdr toks) (- depth 1) (cons (car toks) cur) args))
       (else
        (loop (cdr toks) depth (cons (car toks) cur) args)))))
 
 ;; Bind formals → token-lists (alist by bv key). Variadic gathers
 ;; trailing actuals into __VA_ARGS__, joined with synthetic commas.
 (define (%pp-bind-args params args variadic? call-loc)
   (let* ((np (length params)) (na (length args)))
     (cond
       (variadic?
        (cond
          ((< na np) (die call-loc "macro call: too few arguments"))
          (else
           (let loop ((ps params) (as args) (acc '()))
             (cond
               ((null? ps)
                (alist-set %pp-bv-VA-ARGS (%pp-join-comma as) acc))
               (else
                (loop (cdr ps) (cdr as)
                      (alist-set (car ps) (car as) acc))))))))
       (else
        (cond
          ((and (= np 0) (= na 1) (null? (car args))) '())
          ((not (= np na)) (die call-loc "macro call: argument count mismatch"))
          (else
           (let loop ((ps params) (as args) (acc '()))
             (cond
               ((null? ps) acc)
               (else (loop (cdr ps) (cdr as)
                           (alist-set (car ps) (car as) acc)))))))))))
 
 (define (%pp-join-comma argss)
   (cond
     ((null? argss) '())
     ((null? (cdr argss)) (car argss))
     (else
      (append (car argss)
              (cons (%pp-synth-comma) (%pp-join-comma (cdr argss)))))))
 
 (define (%pp-synth-comma)
   (%tok 'PUNCT 'comma (%loc "<expand>" 0 0) '()))
 
 ;; Body substitution: walk body; replace param IDENTs with arg toks,
 ;; handle `#param` (stringize) and `a##b` (paste). Per C11 §6.10.3.1,
 ;; arguments are macro-expanded BEFORE substitution into the body
 ;; EXCEPT when the parameter is the operand of `#` or `##` (in which
 ;; case the raw token list is used). Without prescan, recursive uses
 ;; like M(M(1)) for `#define M(x) ...x...` fail to expand the inner
 ;; M during rescan because the outer M is in every substituted
 ;; token's hide-set.
 (define (%pp-substitute body env call-loc state)
   (let loop ((body body) (out '()))
     (cond
       ((null? body) (reverse out))
       (else
        (let ((t (car body)) (rest (cdr body)))
          (cond
            ((%pp-punct? t 'hash)
             (cond
               ((or (null? rest) (not (%pp-ident? (car rest))))
                (die (tok-loc t) "stringize: '#' must precede a parameter name"))
               (else
                (let* ((id (car rest)) (pn (tok-value id))
                       (pt (alist-ref pn env)))
                  (cond
                    ((not pt)
                     (die (tok-loc id) "stringize: '#' operand must be a parameter" pn))
                    (else
                     (let ((s (%tok 'STR (%pp-toks->display pt) (tok-loc t) '())))
                       (loop (cdr rest) (cons s out)))))))))
            ((%pp-punct? t 'paste)
             (cond
               ((null? out) (die (tok-loc t) "paste: '##' cannot start a body"))
               ((null? rest) (die (tok-loc t) "paste: '##' cannot end a body"))
               (else
                (let* ((lhs (car out))
                       (rt (car rest))
                       (rhs-list
                        (cond
                          ((and (%pp-ident? rt) (alist-ref (tok-value rt) env))
                           (alist-ref (tok-value rt) env))
                          (else (list rt)))))
                  (cond
                    ((null? rhs-list) (loop (cdr rest) out))
                    (else
                     (let* ((p (%pp-paste-tokens lhs (car rhs-list)))
                            (after (append (cdr rhs-list) (cdr rest))))
                       (loop after (cons p (cdr out))))))))))
            ((%pp-ident? t)
             (let* ((pn (tok-value t)) (pt (alist-ref pn env)))
               (cond
                 ((not pt) (loop rest (cons t out)))
                 ((and (not (null? rest)) (%pp-punct? (car rest) 'paste))
                  ;; Operand of ##: use raw arg tokens (no prescan).
                  (cond
                    ((null? pt) (loop (cdr rest) out))
                    (else (loop rest (append (reverse pt) out)))))
                 (else
                  ;; Normal use: prescan (fully macro-expand the arg)
                  ;; before substitution, per C11 §6.10.3.1.
                  (let ((exp (%pp-expand-line pt state)))
                    (loop rest (append (reverse exp) out)))))))
            (else (loop rest (cons t out)))))))))
 
 ;; Paste two tokens textually; reparse the result.
 (define (%pp-paste-tokens lhs rhs)
   (let ((lk (tok-kind lhs)) (rk (tok-kind rhs)))
     (cond
       ((and (eq? lk 'IDENT) (eq? rk 'IDENT))
        (%tok 'IDENT (bytevector-append (tok-value lhs) (tok-value rhs))
              (tok-loc lhs) (%pp-bv-union (tok-hide lhs) (tok-hide rhs))))
       ((and (eq? lk 'IDENT) (eq? rk 'INT))
        (%tok 'IDENT (bytevector-append (tok-value lhs)
                                       (%c-value-source-bv (tok-value rhs)))
              (tok-loc lhs) (%pp-bv-union (tok-hide lhs) (tok-hide rhs))))
       ((and (eq? lk 'INT) (eq? rk 'INT))
        (let* ((s (bytevector-append (%c-value-source-bv (tok-value lhs))
                                     (%c-value-source-bv (tok-value rhs))))
               (r (%c-value-parse-decimal-bv s)))
          (cond
            ((not (car r)) (die (tok-loc lhs) "paste: cannot reparse as integer" s))
            (else (%tok 'INT (%c-int-lit (cdr r) #f 0 #t) (tok-loc lhs)
                        (%pp-bv-union (tok-hide lhs) (tok-hide rhs)))))))
       (else (die (tok-loc lhs) "paste: unsupported token kinds" lk rk)))))
 
 (define (%pp-relocate t state)
   (cond
     ((and (= (pps-line-delta state) 0) (not (pps-cur-file state))) t)
     (else
      (let* ((l (tok-loc t))
             (f (or (pps-cur-file state) (loc-file l)))
             (ln (+ (loc-line l) (pps-line-delta state)))
             (c (loc-col l)))
        (%pp-with-loc t (%loc f ln c))))))
 
 ;; --- pp-eval-cexpr: #if expression evaluator ---
 ;; Steps: resolve `defined NAME`, macro-expand the rest, treat any
 ;; remaining IDENT as 0, then delegate to parse-const-int via a minimal
 ;; pstate (empty scope, no cg). sizeof(type) works as an extension;
 ;; sizeof(expr) dies with a clear message.
 ;;
 (define (%pp-make-const-ps toks)
   (%pstate (make-list-iter toks)
            (%world (list (%make-hash-table 8))
                    (list (%make-hash-table 8))
                    (%make-hash-table 8)
                    (cons '() (%make-hash-table 8)))
            '() #f #f))
 
 (define (pp-eval-cexpr toks outer)
   ;; `outer` is the live %pp-state. We mint a fresh state for #if
   ;; evaluation but inherit cur-file and line-delta so __FILE__ /
   ;; __LINE__ inside the expression reflect any preceding #line.
   (let* ((state (%pp-state (pps-macros outer) '()
                            (pps-cur-file outer)
                            (pps-line-delta outer)
                            #f '() '()))
          (s1 (%pp-resolve-defined toks state))
          (s2 (%pp-expand-line s1 state))
          (s3 (%pp-idents-as-zero s2))
          (ps (%pp-make-const-ps s3))
          (val (parse-const-int ps))
          (t   (peek ps)))
     (cond
       ((eq? (tok-kind t) 'EOF) val)
       (else (die (tok-loc t) "#if: garbage at end of expression"
                  (tok-kind t))))))
 
 (define (%pp-expand-line toks state)
   (let ((out (make-buf-list)))
     (%pp-emit-expanded toks state out)
     (buf-list-flush out)))
 
 (define (%pp-resolve-defined toks state)
   (let loop ((toks toks) (acc '()))
     (cond
       ((null? toks) (reverse acc))
       ((%pp-ident-name? (car toks) %pp-bv-defined)
        (let ((rest (cdr toks)))
          (cond
            ((null? rest) (die (tok-loc (car toks)) "defined: missing operand"))
            ((%pp-ident? (car rest))
             (let ((v (if (%pp-defined? (tok-value (car rest)) state) 1 0)))
               (loop (cdr rest)
                     (cons (%tok 'INT v (tok-loc (car toks)) '()) acc))))
            ((%pp-punct? (car rest) 'lparen)
             (let ((after (cdr rest)))
               (cond
                 ((or (null? after) (not (%pp-ident? (car after))))
                  (die (tok-loc (car toks)) "defined: expected identifier"))
                 (else
                  (let ((aa (cdr after)))
                    (cond
                      ((or (null? aa) (not (%pp-punct? (car aa) 'rparen)))
                       (die (tok-loc (car toks)) "defined: expected ')'"))
                      (else
                       (let ((v (if (%pp-defined? (tok-value (car after)) state) 1 0)))
                         (loop (cdr aa)
                               (cons (%tok 'INT v (tok-loc (car toks)) '()) acc)))))))) ))
            (else (die (tok-loc (car rest)) "defined: expected identifier or '('")))))
       (else (loop (cdr toks) (cons (car toks) acc))))))
 
 (define (%pp-idents-as-zero toks)
   (map (lambda (t)
          (cond ((%pp-ident? t) (%tok 'INT 0 (tok-loc t) '()))
                (else t)))
        toks))
 
 ;; cc/cg.scm — codegen state and emission API.
 ;; Conversion split: parse owns promotion etc; cg owns sign extension,
 ;; signed/unsigned dispatch, pointer scaling.
 ;;
 ;; Output uses libp1pp's structured macros (%fn, %ifelse_nez,
 ;; %break, %continue) per docs/LIBP1PP.md. Function-local control-flow
 ;; labels are hex2++ dotted labels inside %fn's .scope.
 ;;
 ;; Frame layout:
 ;;   [sp + 0 .. staging*8)        outgoing-arg staging
 ;;   [sp + staging*8 ..)          locals + spilled vstack values
 ;; Slot offsets are emitted symbolically as `(+ %<fn>__SO N)` so the
 ;; staging size, only known at fn-end, can be filled in via a 0-arg
 ;; M1pp macro `<fn>__SO` defined just before the `%fn(...)` block.
 
 (define (%cg-emit-buf cg)
   (cond ((cg-in-fn? cg) (cg-fn-buf cg)) (else (cg-text cg))))
 
 (define (%cg-emit cg bv)
   (buf-push! (%cg-emit-buf cg) bv))
 
 (define (%cg-emit-many cg bvs)
   (for-each (lambda (b) (%cg-emit cg b)) bvs))
 
 (define (%n n) (%c-value-literal-bv n))
 
 ;; Per-fn metadata (name, ret-slot, ret-type, switch-case lists, ...)
 ;; lives on cg-fn-meta, reset at every cg-fn-begin/v.
 ;;
 ;; Update is destructive: assq for the key, set-cdr! if found, else
 ;; prepend. The functional alist-update path was O(n) per write *with*
 ;; an append+reverse rebuild — and cg-fn-begin/v plus every emit in a
 ;; function body hammers this. Mutation here is safe: the meta alist
 ;; is private to one cg, scratch-only, and discarded at fn-end.
 (define (%cg-fn-set! cg key val)
   (let* ((meta (cg-fn-meta cg))
          (p    (assq key meta)))
     (cond (p (set-cdr! p val))
           (else (cg-fn-meta-set! cg (cons (cons key val) meta))))))
 
 (define (%cg-fn-get cg key) (alist-ref/eq key (cg-fn-meta cg)))
 
 (define (%cg-fresh-label cg prefix)
   (let* ((n (cg-label-ctr cg))
          (bv (bytevector-append prefix (%n n))))
     (cg-label-ctr-set! cg (+ n 1))
     bv))
 
 (define (%cg-fresh-loop-tag cg) (%cg-fresh-label cg "L"))
 (define (%cg-fresh-lbl cg)      (%cg-fresh-label cg "lbl_"))
 
 (define (%cg-bump-outgoing! cg n)
   (if (< (cg-max-outgoing cg) n) (cg-max-outgoing-set! cg n) 0))
 
 (define (%cg-slot-expr cg logical-off)
   (let ((nm (%cg-fn-get cg '%fn-label)))
     (bv-cat (list "(+ %" nm "__SO " (%n logical-off) ")"))))
 
 (define (%cg-mangle-global cg name-bv)
   (bytevector-append (cg-str-prefix cg) "cc__" name-bv))
 
 ;; Label for a sym at the M1 layer.
 ;;
 ;; C linkage rules drive this directly:
 ;;   - external linkage (the default at file scope, plus any `extern`
 ;;     decl): bare ident. Same label name shared between every decl
 ;;     and the eventual definition, in any order. `extern T memcpy()`
 ;;     links to libp1pp's `:memcpy`; `int g_acc;` and refs to it
 ;;     share `:g_acc`.
 ;;   - internal linkage (`static`): cc__-prefixed. Free to mangle
 ;;     since `static` is invisible across TUs, and the prefix keeps
 ;;     it out of the external/runtime namespace.
 ;; Block-scope statics already mangle their sym-name to
 ;; `<fnname>__<n>` at parse time (see line ~5125); the cc__ prefix
 ;; here just nests another layer of namespacing on top of that.
 (define (%cg-sym-label cg sm)
   (cond
     ((eq? (sym-storage sm) 'static) (%cg-mangle-global cg (sym-name sm)))
     (else                            (sym-name sm))))
 
 (define (%cg-reg->bv r) (bytevector-append (symbol->string r)))
 
 (define (%cg-emit-li cg reg n)
   (%cg-emit-many cg (list "%li(" (%cg-reg->bv reg) ", " (%n n) ")\n")))
 
 (define (%cg-emit-la cg reg label-bv)
   (%cg-emit-many cg (list "%la(" (%cg-reg->bv reg) ", &" label-bv ")\n")))
 
 (define (%cg-emit-ld-slot cg reg logical-off)
   (%cg-emit-many cg (list "%ld(" (%cg-reg->bv reg) ", sp, "
                           (%cg-slot-expr cg logical-off) ")\n")))
 
 (define (%cg-emit-st-slot cg reg logical-off)
   (%cg-emit-many cg (list "%st(" (%cg-reg->bv reg) ", sp, "
                           (%cg-slot-expr cg logical-off) ")\n")))
 
 (define (%cg-emit-ld cg reg base off)
   (%cg-emit-many cg (list "%ld(" (%cg-reg->bv reg) ", "
                           (%cg-reg->bv base) ", " (%n off) ")\n")))
 
 (define (%cg-emit-st cg reg base off)
   (%cg-emit-many cg (list "%st(" (%cg-reg->bv reg) ", "
                           (%cg-reg->bv base) ", " (%n off) ")\n")))
 
 ;; Width-aware load/store. Dispatches on ctype-size:
 ;;   1: %lb / %sb (LB zero-extends; for signed i8 we sign-extend by
 ;;      target-word-relative shli/sari to materialize canonical form).
 ;;   2/4: handled by libp1pp helpers (P1 has only 1-byte and target-word ops,
 ;;      and word ops require natural alignment which we can't promise
 ;;      for struct fields or non-word-aligned local slots). Loads
 ;;      gather bytes via %lb + shli/or; stores scatter via shri/%sb.
 ;;      Signed loads (i16/i32) sign-extend via shli/sari to canonical
 ;;      target-word form.
 ;;   target-word-sized fallback: %ld / %st. RV32 i64/u64 accesses use
 ;;      the dedicated adjacent-pair path before reaching these helpers.
 ;; Scratch convention: helpers may clobber t1; callers never pass
 ;; reg=t1.
 
 ;; Sub-word loads/stores defer byte-decomposition to libp1pp's
 ;; %ld_h / %ld_w / %ld_sh / %ld_sw / %st_h / %st_w macros (see
 ;; P1/P1pp.P1pp). cc.scm just emits one macro call per access; the
 ;; macro arranges the byte gather/scatter and (for signed loads) folds
 ;; in the sign-extend. t1 is the conventional scratch.
 (define (%cg-emit-ld-sub cg reg base-bv off-bv signed? n-bytes)
   (let ((mname (cond ((= n-bytes 2) (if signed? "%ld_sh(" "%ld_h("))
                      ((= n-bytes 4) (if signed? "%ld_sw(" "%ld_w("))
                      (else (die #f "cg-emit-ld-sub: bad width" n-bytes)))))
     (%cg-emit-many cg (list mname (%cg-reg->bv reg) ", "
                             base-bv ", " off-bv ", t1)\n"))))
 
 (define (%cg-emit-st-sub cg reg base-bv off-bv n-bytes)
   (let ((mname (cond ((= n-bytes 2) "%st_h(")
                      ((= n-bytes 4) "%st_w(")
                      (else (die #f "cg-emit-st-sub: bad width" n-bytes)))))
     (%cg-emit-many cg (list mname (%cg-reg->bv reg) ", "
                             base-bv ", " off-bv ", t1)\n"))))
 
 ;; "address of frame slot" — defers to libp1pp's %lea_slot, which hides
 ;; the backend frame-header offset that %mov(rd, sp) folds in.
 (define (%cg-emit-lea-slot cg reg-bv slot-bv)
   (%cg-emit-many cg (list "%lea_slot(" reg-bv ", " slot-bv ")\n")))
 
 ;; sext8/16/32 emitted via libp1pp's %sext<N>(rd, ra). shift-amount is
 ;; kept as the parameter for call-site clarity (callers think in bit
 ;; widths via the same 56/48/32 amounts they always have).
 (define (%cg-emit-sext cg reg shift-amount)
   (let ((width (cond ((= shift-amount 56) "8")
                      ((= shift-amount 48) "16")
                      ((= shift-amount 32) "32")
                      (else (die #f "cg-emit-sext: bad shift" shift-amount))))
         (rb (%cg-reg->bv reg)))
     (%cg-emit-many cg (list "%sext" width "(" rb ", " rb ")\n"))))
 
 ;; Canonicalize REG against CTYPE's kind: signed narrow types sign-extend,
 ;; unsigned narrow types zero-extend, anything else is left alone (the
 ;; full target-word value is already canonical). Used after operations that
 ;; may have left a non-canonical bit pattern in reg — frame-rval load,
 ;; narrowing cast, narrow-typed binop result.
 (define (%cg-canonicalize cg reg ctype)
   (let* ((rb (%cg-reg->bv reg))
          (k  (ctype-kind ctype)))
     (cond
       ((eq? k 'i8)  (%cg-emit-sext cg reg 56))
       ((eq? k 'i16) (%cg-emit-sext cg reg 48))
       ((eq? k 'i32) (%cg-emit-sext cg reg 32))
       ((or (eq? k 'u8) (eq? k 'bool))
        (%cg-emit-many cg (list "%zext8(" rb ", " rb ")\n")))
       ((eq? k 'u16)
        (%cg-emit-many cg (list "%zext16(" rb ", " rb ")\n")))
       ((eq? k 'u32)
        (%cg-emit-many cg (list "%zext32(" rb ", " rb ", t1)\n")))
       (else 0))))
 
 ;; Width-aware load/store core. BASE-BV / OFF-BV are pre-built (so the
 ;; same body serves both the slot variants — base = "sp", off rendered
 ;; through %cg-slot-expr — and the typed variants, where base is a
 ;; register and off is a raw integer rendered via %n). 1-byte uses
 ;; %lb/%sb (with i8 sext); 2- and 4-byte use the sub-word helpers; the
 ;; target-word fallback emits a plain %ld/%st against the same base/off.
 (define (%cg-emit-ld-bv cg reg ctype base-bv off-bv)
   (%cg-fp-reject! 'ld ctype)
   (let* ((sz (ctype-size ctype)) (kind (ctype-kind ctype))
          (rb (%cg-reg->bv reg)))
     (cond
       ((= sz 1)
        (%cg-emit-many cg (list "%lb(" rb ", " base-bv ", " off-bv ")\n"))
        (cond ((eq? kind 'i8) (%cg-emit-sext cg reg 56))))
       ((= sz 2) (%cg-emit-ld-sub cg reg base-bv off-bv (eq? kind 'i16) 2))
       ((= sz 4) (%cg-emit-ld-sub cg reg base-bv off-bv (eq? kind 'i32) 4))
       (else
        (%cg-emit-many cg (list "%ld(" rb ", " base-bv ", " off-bv ")\n"))))))
 
 (define (%cg-emit-st-bv cg reg ctype base-bv off-bv)
   (%cg-fp-reject! 'st ctype)
   (let ((sz (ctype-size ctype))
         (rb (%cg-reg->bv reg)))
     (cond
       ((= sz 1)
        (%cg-emit-many cg (list "%sb(" rb ", " base-bv ", " off-bv ")\n")))
       ((= sz 2) (%cg-emit-st-sub cg reg base-bv off-bv 2))
       ((= sz 4) (%cg-emit-st-sub cg reg base-bv off-bv 4))
       (else
        (%cg-emit-many cg (list "%st(" rb ", " base-bv ", " off-bv ")\n"))))))
 
 (define (%cg-emit-ld-slot-typed cg reg ctype logical-off)
   (%cg-emit-ld-bv cg reg ctype "sp" (%cg-slot-expr cg logical-off)))
 (define (%cg-emit-st-slot-typed cg reg ctype logical-off)
   (%cg-emit-st-bv cg reg ctype "sp" (%cg-slot-expr cg logical-off)))
 
 (define (%cg-emit-ld-typed cg reg ctype base off)
   (%cg-emit-ld-bv cg reg ctype (%cg-reg->bv base) (%n off)))
 (define (%cg-emit-st-typed cg reg ctype base off)
   (%cg-emit-st-bv cg reg ctype (%cg-reg->bv base) (%n off)))
 
 (define (%cg-emit-li-wide cg lo hi value)
   (%cg-emit-many cg
                  (list "%li(" (%cg-reg->bv lo) ", "
                        (%c-value-u32-literal-bv value 0) ")\n"
                        "%li(" (%cg-reg->bv hi) ", "
                        (%c-value-u32-literal-bv value 1) ")\n")))
 
 (define (%cg-load-wide-opnd-into cg op lo hi)
   ;; Load an RV32 i64/u64 as (low-word, high-word). Wide frame rvalues own
   ;; two adjacent target-word slots; wide lvalues read two adjacent words
   ;; from their object storage. t2 is the address scratch for indirect and
   ;; global lvalues, so callers must keep it distinct from LO/HI.
   (cond
     ((not (%ctype-wide-int? (opnd-type op)))
      (die #f "cg internal: pair load of non-wide operand" (ctype-kind (opnd-type op))))
     ((or (eq? lo 't2) (eq? hi 't2))
      (die #f "cg internal: t2 cannot hold a wide operand limb"))
     (else
      (pmatch op
        (($ opnd? (kind imm) (ext ,n))
         (%cg-emit-li-wide cg lo hi n))
        (($ opnd? (kind frame) (lval? #t) (ext ,off))
         (guard (%cg-indirect? cg off))
         (%cg-emit-ld-slot cg 't2 off)
         (%cg-emit-ld cg lo 't2 0)
         (%cg-emit-ld cg hi 't2 %CC-WORD-BYTES))
        (($ opnd? (kind frame) (ext ,off))
         (%cg-emit-ld-slot cg lo off)
         (%cg-emit-ld-slot cg hi (+ off %CC-WORD-BYTES)))
        (($ opnd? (kind global) (lval? #t) (ext ,lbl))
         (%cg-emit-la cg 't2 lbl)
         (%cg-emit-ld cg lo 't2 0)
         (%cg-emit-ld cg hi 't2 %CC-WORD-BYTES))
        (else
         (die #f "cg internal: unsupported wide operand" (opnd-kind op)))))))
 
 (define (%cg-spill-pair cg lo hi ty)
   (cond ((not (%ctype-wide-int? ty))
          (die #f "cg internal: pair spill of non-wide type" (ctype-kind ty))))
   (let* ((off (cg-alloc-slot cg (ctype-size ty)
                              (max %CC-WORD-BYTES (ctype-align ty))))
          (op (%opnd 'frame ty off #f)))
     (%cg-emit-st-slot cg lo off)
     (%cg-emit-st-slot cg hi (+ off %CC-WORD-BYTES))
     (cg-vstack-set! cg (cons op (cg-vstack cg)))
     op))
 
 (define (%cg-store-pair-to-lval cg lo hi lhs)
   (cond ((not (%ctype-wide-int? (opnd-type lhs)))
          (die #f "cg internal: pair store to non-wide lvalue"
               (ctype-kind (opnd-type lhs)))))
   (pmatch lhs
     (($ opnd? (kind frame) (ext ,off))
      (guard (%cg-indirect? cg off))
      (%cg-emit-ld-slot cg 't2 off)
      (%cg-emit-st cg lo 't2 0)
      (%cg-emit-st cg hi 't2 %CC-WORD-BYTES))
     (($ opnd? (kind frame) (ext ,off))
      (%cg-emit-st-slot cg lo off)
      (%cg-emit-st-slot cg hi (+ off %CC-WORD-BYTES)))
     (($ opnd? (kind global) (ext ,lbl))
      (%cg-emit-la cg 't2 lbl)
      (%cg-emit-st cg lo 't2 0)
      (%cg-emit-st cg hi 't2 %CC-WORD-BYTES))
     (else (die #f "cg-assign: unsupported wide lhs kind" (opnd-kind lhs)))))
 
 (define (%cg-load-truth-into cg op reg)
   (cond
     ((%ctype-wide-int? (opnd-type op))
      (%cg-load-wide-opnd-into cg op 'a0 'a1)
      (%cg-emit-rrr cg "or" reg 'a0 'a1))
     (else (%cg-load-opnd-into cg op reg))))
 
 (define (%cg-load-opnd-into cg op reg)
   ;; frame lval: load at type width. frame rval is a spilled target word
   ;; (allocated by %cg-spill-reg) — always a target-word 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.
   (%cg-fp-reject! 'load (opnd-type op))
   (cond ((%ctype-wide-int? (opnd-type op))
          (die #f "cg internal: wide operand used as one word"
               (ctype-kind (opnd-type op)))))
   (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)  (lval? #f) (type ,ty) (ext ,off))
      ;; Frame rval: spilled as one target word, but the slot's bit-pattern may
      ;; not be canonical for the opnd's CURRENT type (e.g.
      ;; cg-arith-conv relabeled a signed slot as unsigned). Canonicalize
      ;; on load so downstream 64-bit ALU/compare ops see the C-semantic
      ;; value.
      (%cg-emit-ld-slot cg reg off)
      (%cg-canonicalize cg reg ty))
     (($ 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)
   (cond ((%ctype-wide-int? ty)
          (die #f "cg internal: wide value spilled from one register"
               (ctype-kind ty))))
   (let* ((off (cg-alloc-slot cg %CC-WORD-BYTES %CC-WORD-BYTES))
          (op  (%opnd 'frame ty off #f)))
     (%cg-emit-st-slot cg reg off)
     (cg-vstack-set! cg (cons op (cg-vstack cg)))
     op))
 
 ;; 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,
 ;; and same-size casts round-trip the bytes; widening int→fp casts
 ;; leave the int bit-pattern in the wider slot; binops use integer
 ;; ALU ops. tcc.flat.c contains real fp code paths (parse_number,
 ;; ieee_finite, …) that the bootstrap tcc-boot2 never executes when
 ;; compiling float-free programs, so producing valid-but-semantically-
 ;; wrong P1pp here is sufficient. Kept as a named no-op so the call
 ;; sites stay grep-able if a future bootstrap target needs real FP.
 (define (%cg-fp-reject! op-name ty) #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))))
 
 ;; --------------------------------------------------------------------
 ;; Lifecycle
 ;; --------------------------------------------------------------------
 
 ;; cc-cg fixtures construct a cg directly via (cg-init) — they don't
 ;; emit ELF and don't link against another TU, so library knobs are
 ;; irrelevant. cc-main routes through cg-init/v with the parsed flag.
 (define (cg-init) (cg-init/v #f ""))
 
 (define (cg-init/v lib? str-prefix)
   (%cg (make-buf/cap %BUF-CAP-TEXT)        ; text
        (make-buf/cap %BUF-CAP-DATA)        ; data
        (make-buf/cap %BUF-CAP-BSS)         ; bss
        '()                                  ; vstack
        0                                    ; frame-hi
        0                                    ; label-ctr
        (make-world)                         ; world (shared with pstate)
        '()                                  ; fn-meta
        (make-buf/cap %BUF-CAP-FN)          ; fn-buf (reused per fn)
        (make-buf/cap %BUF-CAP-PROLOGUE)    ; prologue-buf (reused per fn)
        0                                    ; max-outgoing
        #f                                   ; in-fn?
        lib?                                 ; lib? (skip entry stub + :ELF_end)
        str-prefix))                         ; str-prefix (cc__str_N namespacing)
 
 (define (cg-finalize! cg)
   ;; Tentative file-scope defs (`int x;` / `static int x;` with no
   ;; initializer and not later defined with `=`) get their .bss slot
   ;; here at end of TU. C 6.9.2 — see cg-flush-tentatives!.
   (cg-flush-tentatives! cg)
   ;; Entry stub. P1's program-entry contract (docs/P1.md §Program Entry)
   ;; delivers argc in a0 and argv in a1 at p1_main. %call doesn't
   ;; clobber a0/a1, so falling straight through to main forwards
   ;; them unchanged. The 16-byte frame is just enough for %enter's
   ;; saved-fp/lr to fit; main builds its own frame on top.
   ;;
   ;; In lib mode the stub and :ELF_end are suppressed: the catm chain
   ;; supplies them once, from P1/entry-*.P1pp and P1/elf-end.P1pp, so
   ;; library TUs don't fight the executable TU for ownership of
   ;; :p1_main and don't truncate ELF p_filesz at the first inner
   ;; :ELF_end (hex2 sizes off the first one it sees).
   (cond
     ((not (cg-lib? cg))
      (let ((tb (cg-text cg)))
        (buf-push! tb "# entry stub: forwards argc=a0, argv=a1 to main\n")
        (buf-push! tb "%fn(p1_main, 16, {\n")
        (buf-push! tb "%call(&main)\n")
        (buf-push! tb "})\n"))))
   #t)
 
 (define (cg-output-size cg)
   (+ (buf-offset (cg-text cg))
      (buf-offset (cg-data cg))
      (buf-offset (cg-bss cg))
      (cond ((cg-lib? cg) 0)
            (else (bytevector-length ":ELF_end\n")))))
 
 (define (cg-finish cg)
   ;; In-memory form retained for tests and small callers. Production uses
   ;; %cg-write-finalized-fd below so a fragmented non-moving heap need not
   ;; provide several multi-megabyte snapshot allocations at once.
   (cg-finalize! cg)
   (bv-cat (list (buf-flush (cg-text cg))
                 (buf-flush (cg-data cg))
                 (buf-flush (cg-bss  cg))
                 (cond ((cg-lib? cg) "")
                       (else ":ELF_end\n")))))
 
 (define (%cg-write-finalized-fd cg fd)
   (let ((text (cg-text cg))
         (data (cg-data cg))
         (bss  (cg-bss cg)))
     (write-bv-range-fd fd (buf-storage text) 0 (buf-offset text))
     (write-bv-range-fd fd (buf-storage data) 0 (buf-offset data))
     (write-bv-range-fd fd (buf-storage bss)  0 (buf-offset bss))
     (cond ((not (cg-lib? cg)) (write-bv-fd fd ":ELF_end\n")))
     #t))
 
 (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 a fixed contiguous
 ;; target-word window, populating each slot from the
 ;; appropriate source: a-register for idx 0..3, LDARG slot (idx-4) for
 ;; later indices. va_start computes the address of the slot at index =
 ;; named-arg count, so va_arg walks linearly through the rest.
 ;; Indices beyond the actual arguments may be garbage; user
 ;; code stops walking based on a count or sentinel before those slots
 ;; are read. Kit's widest diagnostic calls require 20 total arguments.
 (define %CG-VARARG-WINDOW 32)
 
 (define (cg-fn-begin/v cg name params return-type variadic?)
   (buf-reset!           (cg-fn-buf       cg))
   (buf-reset!           (cg-prologue-buf cg))
   (cg-in-fn?-set!       cg #t)
   (cg-vstack-set!       cg '())
   (cg-frame-hi-set!     cg 0)
   ;; cg-label-ctr is NOT reset per-fn. Compiler-internal labels are
   ;; emitted as dotted hex2++ locals inside %fn's .scope (and sometimes
   ;; nested .scope blocks), so within-TU collisions are already prevented
   ;; by local lookup. Keeping the counter monotonic across functions is
   ;; no longer required for correctness, just for stable, readable label
   ;; names in expanded.M1 traces.
   (cg-max-outgoing-set! cg 0)
   (cg-fn-meta-set!      cg '())
   (%cg-fn-set! cg '%fn-name        name)
   (let ((sm (%hash-ref (car (world-scope (cg-world cg))) name)))
     (%cg-fn-set! cg '%fn-label
                  (cond (sm (%cg-sym-label cg sm)) (else name))))
   (%cg-fn-set! cg '%fn-ret-type    return-type)
   (%cg-fn-set! cg '%indirect-slots '())
   (%cg-fn-set! cg '%fn-variadic?   variadic?)
   ;; Return slot per P1.md §Arguments. One word → a0; two words → a0+a1;
   ;; wider aggregates
   ;; struct/union → indirect-result (A2): caller passes sret ptr in
   ;; a0; cg-return writes through it; sret-slot saves a0 for cg-fn-end.
   (let* ((rsz (cond ((eq? (ctype-kind return-type) 'void) %CC-WORD-BYTES)
                     (else (align-up (max %CC-WORD-BYTES
                                          (ctype-size return-type))
                                     %CC-WORD-BYTES))))
          (ret-slot (cg-alloc-slot cg rsz %CC-WORD-BYTES)))
     (%cg-fn-set! cg '%fn-ret-slot ret-slot)
     (cond
       ((not (eq? (ctype-kind return-type) 'void))
        (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 %CC-WORD-BYTES))))))))
   (let* ((rk    (ctype-kind return-type))
          (sret? (and (or (eq? rk 'struct) (eq? rk 'union))
                      (> (ctype-size return-type) %CC-PAIR-BYTES))))
     (%cg-fn-set! cg '%fn-sret? sret?)
     (cond
       (sret?
        (let ((ss (cg-alloc-slot cg %CC-WORD-BYTES %CC-WORD-BYTES)))
          (%cg-fn-set! cg '%fn-sret-slot ss)
          (buf-push! (cg-prologue-buf cg)
                     (bv-cat (list "%st(a0, sp, "
                                   (%cg-slot-expr cg ss) ")\n")))))
       (else (%cg-fn-set! cg '%fn-sret-slot #f))))
   ;; Reject definitions whose named parameters leave no variadic slot.
   ;; variadic definitions whose named-arg count would already fill or
   ;; exceed it (no room left for variadic reads).
   (let ((named-slots
          (let count ((xs params) (n 0))
            (cond ((null? xs) n)
                  (else (count (cdr xs)
                               (+ n (%cg-param-reg-count (cdar xs)))))))))
     (cond
       ((and variadic? (>= named-slots %CG-VARARG-WINDOW))
        (die #f "cg-fn-begin: variadic function fills save-area"
             name named-slots %CG-VARARG-WINDOW))))
   ;; With sret, explicit arg i lives at ABI position (i+1): args 0..2
   ;; in a1..a3, args 3+ in slot (i-3).
   (let* ((sret-shift (if (%cg-fn-get cg '%fn-sret?) 1 0))
          (spill (lambda (abi off)
                   (cond
                     ((< abi 4)
                      (buf-push! (cg-prologue-buf cg)
                                 (bv-cat (list "%st(" (%cg-reg->bv (%reg-by-idx abi))
                                               ", sp, "
                                               (%cg-slot-expr cg off) ")\n"))))
                     (else
                      (buf-push! (cg-prologue-buf cg)
                                 (bv-cat (list "%ldarg(t0, " (%n (- abi 4)) ")\n"
                                               "%st(t0, sp, "
                                               (%cg-slot-expr cg off) ")\n"))))))))
     (let walk ((ps params) (idx 0) (out '()) (first-slot #f))
       (cond
         ((null? ps)
          (cond
            (variadic?
             (let pad ((i idx) (vfirst #f) (fs first-slot))
               (cond
                 ((>= i %CG-VARARG-WINDOW)
                  (%cg-fn-set! cg '%fn-vararg-first-slot (or vfirst fs))
                  (reverse out))
                 (else
                  (let ((off (cg-alloc-slot cg %CC-WORD-BYTES %CC-WORD-BYTES)))
                    (spill (+ i sret-shift) off)
                    (pad (+ i 1) (or vfirst off) (or fs off)))))))
            (else (reverse out))))
         (else
          (let* ((p    (car ps))
                 (nm   (car p))
                 (ty   (cdr p))
                 ;; Aggregates wider than two words ride one ABI slot containing
                 ;; a pointer to a caller-owned copy (AAPCS64 / SysV class
                 ;; MEMORY). Smaller aggregates ride one or two words inline.
                 (n    (%cg-param-reg-count ty))
                 (sz   (cond ((%cg-param-indirect? ty) %CC-WORD-BYTES)
                             ((or (%cg-param-aggregate? ty)
                                   (%ctype-wide-int? ty))
                              (align-up (ctype-size ty) %CC-WORD-BYTES))
                             (else %CC-WORD-BYTES)))
                 (al   (cond ((%cg-param-indirect? ty) %CC-WORD-BYTES)
                             ((or (%cg-param-aggregate? ty)
                                   (%ctype-wide-int? ty))
                              (max %CC-WORD-BYTES (ctype-align ty)))
                             (else %CC-WORD-BYTES)))
                 (off  (cg-alloc-slot cg sz al))
                 (psym (%sym nm 'param #f ty off #t)))
            (let chunk ((i 0))
              (cond ((>= i n) 0)
                    (else
                     (spill (+ idx sret-shift i)
                            (+ off (* i %CC-WORD-BYTES)))
                     (chunk (+ i 1)))))
            (cond ((%cg-param-indirect? ty) (%cg-mark-indirect! cg off)))
            (walk (cdr ps) (+ idx n) (cons (cons nm psym) out)
                  (or first-slot off))))))))
 
 ;; Number of consecutive ABI slots (regs or stack words) consumed by a
 ;; parameter of TY. Aggregates up to two words take ceil(size/word).
 (define (%cg-param-reg-count ty)
   (cond
     ((%ctype-wide-int? ty) 2)
     ((%cg-param-aggregate? ty)
      (let ((sz (ctype-size ty)))
        (cond
          ((> sz %CC-PAIR-BYTES) 1)
          ((> sz %CC-WORD-BYTES) 2)
          (else 1))))
     (else 1)))
 
 (define (%cg-param-aggregate? ty)
   (let ((k (ctype-kind ty)))
     (or (eq? k 'struct) (eq? k 'union))))
 
 (define (%cg-param-indirect? ty)
   (and (%cg-param-aggregate? ty)
        (> (ctype-size ty) %CC-PAIR-BYTES)))
 
 (define (cg-fn-end cg)
   ;; Drain prologue-buf and fn-buf directly into cg-text via buf-drain!
   ;; (memcpy, no allocation). Header/footer pieces go through buf-push!
   ;; on cg-text — also memcpy. The only fresh objects here are the small
   ;; (%n N) bytevectors for staging-bytes / frame-size.
   (let* ((name          (%cg-fn-get cg '%fn-name))
          (ret-slot      (%cg-fn-get cg '%fn-ret-slot))
          (ret-type      (%cg-fn-get cg '%fn-ret-type))
          (locals-hi     (cg-frame-hi cg))
          (staging-bytes (* %CC-WORD-BYTES (cg-max-outgoing cg)))
          (raw-size      (+ staging-bytes locals-hi))
          (frame-size    (align-up raw-size 16))
          ;; Look up the bound sym for this fn so `static void foo(){...}`
          ;; emits the same cc__-mangled label that callers reference.
          ;; The sym was bound by parse-fn-body before the body parse,
          ;; so it's in the top scope frame at this point.
          (mangled       (%cg-fn-get cg '%fn-label))
          (tb            (cg-text cg)))
     ;; Now that the body is fully emitted, leave fn dispatch so any
     ;; trailing emits in this function (including the ret-block below)
     ;; route to cg-text directly.
     (cg-in-fn?-set! cg #f)
     ;; staging-size macro
     (buf-push! tb "%macro ")
     (buf-push! tb mangled)
     (buf-push! tb "__SO()\n")
     (buf-push! tb (%n staging-bytes))
     (buf-push! tb "\n%endm\n")
     ;; %fn header
     (buf-push! tb "%fn(")
     (buf-push! tb mangled)
     (buf-push! tb ", ")
     (buf-push! tb (%n frame-size))
     (buf-push! tb ", {\n")
     ;; prologue + body, drained byte-for-byte
     (buf-drain! tb (cg-prologue-buf cg))
     ;; --cc-trace-emit: emit `%trace(&LBL, LEN)` between prologue (which
     ;; spilled live argument regs to slots) and body, so the macro can
     ;; freely clobber a0..a2. The mangled name rides through the
     ;; regular string pool — cg-intern-string emits it with a trailing
     ;; NUL and pads to 8-byte alignment, so the next data label stays
     ;; aligned. We pass the *logical* byte length (no NUL) so the
     ;; runtime print stops at the actual end of the name.
     (cond
       ((trace-emit?)
        (let ((tag-lbl (cg-intern-string cg mangled)))
          (buf-push! tb "%trace(&")
          (buf-push! tb tag-lbl)
          (buf-push! tb ", ")
          (buf-push! tb (%n (bytevector-length mangled)))
          (buf-push! tb ")\n"))))
     (buf-drain! tb (cg-fn-buf cg))
     ;; ret block: one word → a0; two words → a0+a1; wider sret → a0.
     (buf-push! tb ":.ret\n")
     (let ((rk (ctype-kind ret-type))
           (sret? (%cg-fn-get cg '%fn-sret?)))
       (cond
         ((eq? rk 'void)
          (buf-push! tb "%li(a0, 0)\n"))
         (sret?
          (buf-push! tb "%ld(a0, sp, ")
          (buf-push! tb (%cg-slot-expr cg (%cg-fn-get cg '%fn-sret-slot)))
          (buf-push! tb ")\n"))
         (else
          (buf-push! tb "%ld(a0, sp, ")
          (buf-push! tb (%cg-slot-expr cg ret-slot))
          (buf-push! tb ")\n")
          (cond
            ((> (ctype-size ret-type) %CC-WORD-BYTES)
             (buf-push! tb "%ld(a1, sp, ")
             (buf-push! tb (%cg-slot-expr cg
                                          (+ ret-slot %CC-WORD-BYTES)))
             (buf-push! tb ")\n"))))))
     (buf-push! tb "})\n")
     (cg-vstack-set!       cg '())
     (cg-frame-hi-set!     cg 0)
     (cg-max-outgoing-set! cg 0)
     0))
 
 ;; --------------------------------------------------------------------
 ;; Vstack
 ;; --------------------------------------------------------------------
 (define (cg-push cg op)
   (cg-vstack-set! cg (cons op (cg-vstack cg)))
   op)
 
 (define (cg-pop cg)
   (let ((s (cg-vstack cg)))
     (cond ((null? s) (die #f "cg-pop: empty vstack"))
           (else (cg-vstack-set! cg (cdr s)) (car s)))))
 
 (define (cg-top cg)
   (let ((s (cg-vstack cg)))
     (cond ((null? s) (die #f "cg-top: empty vstack")) (else (car s)))))
 
 (define (cg-depth cg) (length (cg-vstack cg)))
 
 ;; --------------------------------------------------------------------
 ;; Snapshot / rewind — discard any vstack pushes and fn-buf bytes
 ;; emitted between snapshot and rewind. Used by sizeof to parse its
 ;; operand for type information without retaining its side effects
 ;; (CC.md §Expressions: sizeof's operand is not evaluated). Internal-
 ;; only; the parser is the sole expected caller.
 ;;
 ;; vstack captures the head of the cons-list (immutable structurally).
 ;; fn-buf is restored by resetting buf-offset; the underlying storage
 ;; bytes past the new offset become garbage that the next buf-push!
 ;; will overwrite (buf-push! always copies into [offset, offset+len)).
 ;; frame-hi and max-outgoing are also restored so cg-alloc-slot calls
 ;; inside the rewound region don't leak frame bytes.  The label counter and
 ;; indirect-slot set are part of the same transaction: parsing `sizeof *p`
 ;; mints an indirect temporary, and leaving that tag behind after frame-hi is
 ;; rewound would make the next ordinary local at the reused offset behave as a
 ;; pointer-to-storage slot.
 ;; --------------------------------------------------------------------
 (define (cg-snapshot cg)
   (cond
     ((not (cg-in-fn? cg))
      (die #f "cg-snapshot: not in fn")))
   (list (cg-vstack cg)
         (buf-offset (cg-fn-buf cg))
         (cg-frame-hi cg)
         (cg-max-outgoing cg)
         (cg-label-ctr cg)
         (or (%cg-fn-get cg '%indirect-slots) '())))
 
 (define (cg-rewind cg tag)
   (cg-vstack-set!       cg (car tag))
   (buf-offset-set!      (cg-fn-buf cg) (cadr tag))
   (cg-frame-hi-set!     cg (caddr tag))
   (cg-max-outgoing-set! cg (cadddr tag))
   (cg-label-ctr-set!    cg (car (cddddr tag)))
   (%cg-fn-set! cg '%indirect-slots (cadr (cddddr tag))))
 
 ;; Duplicate the top vstack entry. For lvals this is safe — the slot
 ;; (or label, or indirect-marked frame) backing the lval keeps existing
 ;; until the function ends. For rvals it duplicates the descriptor of
 ;; the spilled value; both copies refer to the same already-emitted
 ;; storage. Used for `lhs += rhs` and `++lhs` to preserve the lhs
 ;; across a `cg-load` so the subsequent `cg-assign` still has its
 ;; address.
 (define (cg-dup cg)
   (let ((p (cg-top cg))) (cg-push cg p) p))
 
 ;; --------------------------------------------------------------------
 ;; Materialize
 ;; --------------------------------------------------------------------
 (define (cg-push-imm cg ctype value)
   (cg-push cg (%opnd 'imm ctype value #f)))
 
 (define (cg-push-string cg bv-content)
   (let* ((label (cg-intern-string cg bv-content))
          (cp-ty (%mk-ptr %t-i8)))
     (cg-push cg (%opnd 'global cp-ty label #f))))
 
 (define (cg-push-sym cg sm)
   (pmatch sm
     (($ sym? (kind fn) (type ,ty))
      (cg-push cg (%opnd 'global ty (%cg-sym-label cg sm) #f)))
     (($ sym? (kind enum-const) (type ,ty) (slot ,v))
      (cg-push cg (%opnd 'imm ty v #f)))
     (($ sym? (kind var) (storage extern) (type ,ty))
      (cg-push cg (%opnd 'global ty (%cg-sym-label cg sm) #t)))
     (($ sym? (kind var) (storage static) (type ,ty))
      (cg-push cg (%opnd 'global ty (%cg-sym-label cg sm) #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 sm)))))
 
 ;; A cg-push-deref result is a frame-lval whose slot HOLDS THE ADDRESS
 ;; (not the value). To distinguish from ordinary frame-lvals (whose
 ;; slot holds the value directly), we tag indirect slots in
 ;; %indirect-slots so cg-load and cg-assign can do the extra
 ;; indirection.
 (define (%cg-mark-indirect! cg off)
   (let ((cur (or (%cg-fn-get cg '%indirect-slots) '())))
     (%cg-fn-set! cg '%indirect-slots (cons off cur))))
 
 (define (%cg-indirect? cg off)
   (let ((cur (or (%cg-fn-get cg '%indirect-slots) '())))
     (let loop ((xs cur))
       (cond ((null? xs) #f) ((= (car xs) off) #t) (else (loop (cdr xs)))))))
 
 (define (cg-push-deref cg)
   (let* ((p  (cg-pop cg))
          (pt (opnd-type p))
          (pe (cond ((eq? (ctype-kind pt) 'ptr) (ctype-ext pt))
                    ((eq? (ctype-kind pt) 'arr) (car (ctype-ext pt)))
                    (else #f))))
     (cond
       ((not pe) (die #f "cg-push-deref: not a pointer" pt))
       (else
        (%cg-load-opnd-into cg p 't0)
        (let ((off (cg-alloc-slot cg %CC-WORD-BYTES %CC-WORD-BYTES)))
          (%cg-emit-st-slot cg 't0 off)
          (%cg-mark-indirect! cg off)
          (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.
 
 ;; Look up FNAME in FIELDS. C11 §6.7.2.1: a struct/union member with no
 ;; declarator (e.g. `union { int a; int b; };` inside another struct) is
 ;; an "anonymous member" — its members are addressed as if they belonged
 ;; directly to the enclosing aggregate. We recurse into any name=#f
 ;; member of struct/union kind, composing the outer member's offset with
 ;; the inner field's offset, and return a synthetic (name ctype off)
 ;; triple so callers can stay agnostic about anonymity.
 (define (%cg-find-field fields fname)
   (let loop ((xs fields))
     (cond
       ((null? xs) #f)
       (else
        (let* ((f (car xs))
               (fn (car f)))
          (cond
            ((and fn (bv= fn fname)) 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 (%cg-find-field sub-fields fname)))
               (cond
                 (hit (list (car hit)
                            (cadr hit)
                            (+ (car (cddr f)) (car (cddr hit)))))
                 (else (loop (cdr 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))))
               (pmatch s
                 ;; direct frame lval: just shift the slot offset.
                 (($ 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.
                 (($ 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"))))
                  (let ((no (cg-alloc-slot cg %CC-WORD-BYTES %CC-WORD-BYTES)))
                    (%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.
                 (($ 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"))))
                  (let ((no (cg-alloc-slot cg %CC-WORD-BYTES %CC-WORD-BYTES)))
                    (%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 (%mk-ptr et)))
          (pmatch p
            ;; direct frame lval: address is sp+off.
            (($ opnd? (kind frame) (ext ,off))
             (guard (not (%cg-indirect? cg off)))
             (%cg-emit-lea-slot cg "t0" (%cg-slot-expr cg off))
             (%cg-spill-reg cg 't0 pty))
            ;; indirect frame lval (rare for arrays, but support it):
            ;; the slot holds the address already.
            (($ 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.
            (($ 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))))))
       (else tp))))
 
 ;; --------------------------------------------------------------------
 ;; 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-copy-struct, cg-assign-struct,
 ;; cg-call's struct receive). Caller owns the opnd (already popped).
 ;;
 ;; A frame opnd is treated as a slot whose address we want: if it's a
 ;; flagged-indirect lval (slot holds a pointer to the real storage),
 ;; load the pointer; otherwise the slot itself IS the storage and we
 ;; lea its address. Frame rvals are temp spills — address = &slot. A
 ;; global opnd's label is the address. Callers that require an lval
 ;; check it before calling.
 (define (%cg-emit-addr-of cg op reg)
   (let ((reg-bv (%cg-reg->bv reg)))
     (pmatch op
       (($ opnd? (kind frame) (lval? #t) (ext ,off))
        (guard (%cg-indirect? cg off))
        (%cg-emit-ld-slot cg reg off))
       (($ opnd? (kind frame) (ext ,off))
        (%cg-emit-lea-slot cg reg-bv (%cg-slot-expr cg off)))
       (($ opnd? (kind global) (ext ,lbl))
        (%cg-emit-la cg reg lbl))
       (else (die #f "cg-emit-addr-of: unsupported opnd"
                  (opnd-kind op) (opnd-lval? 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)))
 
 ;; Struct/union `=` assignment: pop src lval, pop dst lval, memcpy,
 ;; then push dst back so the assignment expression has a result for
 ;; the surrounding parser to consume (parse-expr-stmt's trailing
 ;; cg-pop, etc.). Distinct from cg-copy-struct because the
 ;; initializer caller needs no result on the vstack.
 ;;
 ;; The src may be either a frame lvalue (named local slot, *p deref,
 ;; callee return-slot) or a frame rvalue (anonymous slot from a temp
 ;; spill); %cg-emit-addr-of handles both shapes by treating the slot
 ;; itself as the address whenever the lval indirection flag isn't set.
 (define (cg-assign-struct cg)
   (let* ((src (cg-pop cg))
          (dst (cg-pop cg))
          (sty (opnd-type dst))
          (sz  (ctype-size sty)))
     (cond ((not (opnd-lval? dst)) (die #f "cg-assign-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)
     (cg-push cg dst)))
 
 ;; Struct copy: defer to libp1pp memcpy via %memcpy_call. dst-reg and
 ;; src-reg hold the addresses; size is the byte count. tmp-reg is no
 ;; longer needed by this helper (kept in the signature so existing
 ;; callers don't have to thread their scratch allocation differently),
 ;; but the macro itself uses a0/a1/a2 around the call. dst-reg and
 ;; src-reg must not be a0 (the dst move would clobber a different live
 ;; input register); both current callers use t-regs.
 (define (%cg-emit-byte-copy cg dst-reg src-reg tmp-reg size)
   (%cg-emit-many cg (list "%memcpy_call("
                           (%cg-reg->bv dst-reg) ", "
                           (%cg-reg->bv src-reg) ", "
                           (%n size) ")\n")))
 
 (define (cg-take-addr cg)
   (let* ((p   (cg-pop cg))
          (ty  (opnd-type p))
          ;; &arr yields T(*)[N] per strict C. Pointer arithmetic on
          ;; the result scales by sizeof(T[N]) (the whole array), so
          ;; &arr + 1 is one-past-end. Array-to-pointer decay happens
          ;; on use via cg-decay-array, not at the & operator.
          (pty (%mk-ptr ty)))
     (pmatch p
       ;; &function: a function designator (rval of fn type pushed by
       ;; cg-push-sym) already evaluates to its entry-point address. The
       ;; `&` is a no-op semantically — re-tag the operand as ptr-to-fn.
       (($ opnd? (kind global) (type ,t) (ext ,lbl) (lval? #f))
        (guard (eq? (ctype-kind t) 'fn))
        (cg-push cg (%opnd 'global pty lbl #f)))
       (($ 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))
       ;; %lea_slot wraps the "%mov(rd, sp); %addi(rd, rd, slot)" idiom;
       ;; the backend hides any frame-header offset inside %mov(rd, sp).
       (($ opnd? (kind frame) (ext ,off))
        (%cg-emit-lea-slot cg "t0" (%cg-slot-expr cg off))
        (%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))))))
 
 (define (cg-load cg)
   (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))
       ;; Struct/union lvalues stay as lvalues — there is no
       ;; register-sized rvalue form for an aggregate, and the
       ;; historical one-word spill path silently truncated wider aggregates
       ;; (the bug that broke `c = cond ? a : b`). Surrounding machinery
       ;; (cg-ifelse-merge / cg-assign-struct / cg-call) consumes
       ;; aggregate operands as lvalues already.
       ((or (eq? (ctype-kind ty) 'struct) (eq? (ctype-kind ty) 'union))
        (cg-push cg p))
       ((%ctype-wide-int? ty)
        (%cg-load-wide-opnd-into cg p 't0 't1)
        (%cg-spill-pair cg 't0 't1 ty))
       ((and (eq? (opnd-kind p) 'frame)
             (%cg-indirect? cg (opnd-ext p)))
        ;; Indirect frame-lval: slot holds the address. Stage the
        ;; address in t2 so multi-byte gathers don't alias dest with
        ;; base.
        (%cg-emit-ld-slot cg 't2 (opnd-ext p))
        (%cg-emit-ld-typed cg 't0 ty 't2 0)
        (%cg-spill-reg cg 't0 ty))
       (else (%cg-load-opnd-into cg p 't0) (%cg-spill-reg cg 't0 ty)))))
 
 ;; --------------------------------------------------------------------
 ;; Type conversions
 ;; --------------------------------------------------------------------
 (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))
          (to-kind (ctype-kind to-type)))
     (%cg-fp-reject! 'cast-to to-type)
     (%cg-fp-reject! 'cast-from from-ty)
     (cond
       ((eq? to-kind 'bool)
        (cond
          ((%ctype-wide-int? from-ty)
           (%cg-load-wide-opnd-into cg p 't0 't1)
           (%cg-emit-rrr cg "or" 't0 't0 't1))
          (else (%cg-load-opnd-into cg p 't0)))
        (%cg-emit-many cg (list "%bool(t0, t0)\n"))
        (%cg-spill-reg cg 't0 to-type))
       ;; Pointer-to-pointer casts preserve the one-word representation.
       ((and (eq? to-kind 'ptr)
             (or (eq? (ctype-kind from-ty) 'ptr)
                 (eq? (ctype-kind from-ty) 'arr)
                 (eq? (ctype-kind from-ty) 'fn)))
        (cg-push cg (%opnd (opnd-kind p) to-type (opnd-ext p) (opnd-lval? p))))
       ;; Any RV32 narrowing conversion consumes only the low limb, then
       ;; canonicalizes it for the destination type.
       ((and (%ctype-wide-int? from-ty) (not (%ctype-wide-int? to-type)))
        (%cg-load-wide-opnd-into cg p 't0 't1)
        (%cg-canonicalize cg 't0 to-type)
        (%cg-spill-reg cg 't0 to-type))
       ;; Same-width signedness changes do not alter an i64 bit pattern.
       ((and (%ctype-wide-int? from-ty) (%ctype-wide-int? to-type))
        (cg-push cg (%opnd (opnd-kind p) to-type (opnd-ext p) (opnd-lval? p))))
       ;; Widen a one-word RV32 value into a real two-word integer. The low
       ;; limb is already canonical; signed sources replicate their sign bit.
       ((%ctype-wide-int? to-type)
        (%cg-load-opnd-into cg p 't0)
        (cond
          ((%ctype-unsigned? from-ty)
           (%cg-emit-many cg (list "%li(t1, 0)\n")))
          (else
           (%cg-emit-many cg
                          (list "%sari(t1, t0, "
                                (%n (- %CC-WORD-BITS 1)) ")\n"))))
        (%cg-spill-pair cg 't0 't1 to-type))
       ;; Same-size or widening cast — retag only when the canonical
       ;; 64-bit slot form for FROM-TY is also canonical for TO-TYPE.
       ;; That holds unless we're crossing from a signed type into an
       ;; unsigned one of the same or wider width: the source's
       ;; sign-extended high bits would leak past the unsigned width
       ;; and corrupt later 64-bit operands (compares, wider casts).
       ;; Same applies to same-size unsigned→signed at narrow widths
       ;; (the narrow branch's sign-extend turns 0xCA back into the
       ;; canonical i8 slot 0xFF…FFCA).
       ((and (>= to-sz from-sz)
             (not (and (not (%ctype-unsigned? from-ty))
                       (%ctype-unsigned? to-type)))
             (not (and (= to-sz from-sz)
                       (%ctype-unsigned? from-ty)
                       (not (%ctype-unsigned? to-type)))))
        (cg-push cg (%opnd (opnd-kind p) to-type (opnd-ext p) (opnd-lval? p))))
       (else
        ;; Narrowing cast OR same/widening with signedness flip.
        ;; Signed targets (i8/i16/i32) shli/sari to truncate-and-
        ;; sign-extend in one step, so the slot holds the canonical
        ;; 64-bit form and a subsequent widening cast (which is
        ;; relabel-only) restores the value. Unsigned targets mask
        ;; off high bits to zero-extend.
        (%cg-load-opnd-into cg p 't0)
        (%cg-canonicalize cg 't0 to-type)
        (%cg-spill-reg cg 't0 to-type)))))
 
 (define (cg-promote cg)
   (let* ((p  (cg-pop cg))
          (ty (opnd-type p))
          (sz (ctype-size ty)))
     (cond
       ;; C 6.3.1.1: _Bool, char, short, and any narrower int type
       ;; promote to (signed) int — every representable value fits
       ;; in i32. Treating narrow unsigned types as u32 here would
       ;; drag the subsequent arith-conv into picking the unsigned
       ;; common type, flipping signedness of `>>`, comparisons,
       ;; division, etc. against the C rule. Canonical form for any
       ;; in-range narrow value already matches i32, so the cast is
       ;; relabel-only.
       ((< sz 4)
        (cg-push cg (%opnd (opnd-kind p) %t-i32 (opnd-ext p) (opnd-lval? p))))
       (else (cg-push cg p)))))
 
 (define (cg-arith-conv cg)
   ;; Usual arithmetic conversions on arithmetic operands. When either
   ;; operand is a pointer (or array,
   ;; which behaves as a pointer in arithmetic), the pair is a
   ;; pointer-arith case — leave the types alone so cg-binop can detect
   ;; the ptr operand and apply the right scaling.
   (let* ((b  (cg-pop cg))
          (a  (cg-pop cg))
          (ta (opnd-type a))
          (tb (opnd-type b))
          (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
       ;; (and doesn't see two pointers, which would skip scaling).
       ((or (%ctype-ptr? ta) (%ctype-ptr? tb))
        (cg-push cg a)
        (cg-push cg b))
       (else
        (let ((common (cond
                        ((> sa sb) ta)
                        ((> sb sa) tb)
                        ((%ctype-unsigned? ta) ta)
                        ((%ctype-unsigned? tb) tb)
                        (else ta))))
          ;; Route through cg-cast (rather than relabel only) so the
          ;; canonical target-word slot form lines up with COMMON. Same-size
          ;; cross-signedness conversions (i32→u32, u32→i32, …) need an
          ;; actual zext/sext to canonicalize; otherwise an i32 -3
          ;; relabeled to u32 keeps its sign-extended slot bits and
          ;; compares unequal to a u32 imm with the same C value.
          (cg-push cg a) (cg-cast cg common)
          (let ((a* (cg-pop cg)))
            (cg-push cg b) (cg-cast cg common)
            (let ((b* (cg-pop cg)))
              (cg-push cg a*)
              (cg-push cg b*))))))))
 
 ;; --------------------------------------------------------------------
 ;; Operators
 ;; --------------------------------------------------------------------
 (define (%cg-emit-rrr cg op rd ra rb)
   (%cg-emit-many cg (list "%" op "(" (%cg-reg->bv rd) ", "
                           (%cg-reg->bv ra) ", " (%cg-reg->bv rb) ")\n")))
 
 (define (%cg-emit-cmp cg cc ra rb rd)
   (%cg-emit-many cg (list "%cmpset_" cc "("
                           (%cg-reg->bv rd) ", "
                           (%cg-reg->bv ra) ", " (%cg-reg->bv rb)
                           ")\n")))
 
 (define (cg-binop cg op)
   (let* ((b  (cg-pop cg))
          (a  (cg-pop cg))
          (ta (opnd-type a))
          (tb (opnd-type b))
          (unsigned? (or (%ctype-unsigned? ta) (%ctype-unsigned? tb)))
          (a-ptr? (%ctype-ptr? ta))
          (b-ptr? (%ctype-ptr? tb))
          (result-ty
           (cond
             ((or (eq? op 'eq) (eq? op 'ne)
                  (eq? op 'lt) (eq? op 'le) (eq? op 'gt) (eq? op 'ge))
              %t-i32)
             ((and a-ptr? b-ptr? (eq? op 'sub)) %t-word-i)
             (a-ptr? ta)
             (b-ptr? tb)
             (else ta))))
     (cond
       ((%ctype-wide-int? ta)
        (%cg-load-wide-opnd-into cg a 'a0 'a1)
        (cond
          ((or (eq? op 'shl) (eq? op 'shr))
           (cond
             ((%ctype-wide-int? tb)
              (%cg-load-wide-opnd-into cg b 'a2 'a3))
             (else (%cg-load-opnd-into cg b 'a2)))
           (%cg-emit-many
            cg
            (list (cond ((eq? op 'shl) "%i64_shl(")
                        ((%ctype-unsigned? ta) "%i64_shr(")
                        (else "%i64_sar("))
                  "t0, t1, a0, a1, a2, t2)\n"))
           (%cg-spill-pair cg 't0 't1 result-ty))
          (else
           (%cg-load-wide-opnd-into cg b 'a2 'a3)
           (cond
             ((eq? op 'add)
              (%cg-emit-many cg
                             (list "%i64_add(t0, t1, a0, a1, a2, a3, t2)\n")))
             ((eq? op 'sub)
              (%cg-emit-many cg
                             (list "%i64_sub(t0, t1, a0, a1, a2, a3, t2)\n")))
             ((eq? op 'mul)
              (%cg-emit-many cg
                             (list "%i64_mul(t0, t1, a0, a1, a2, a3, t2)\n")))
             ((eq? op 'and)
              (%cg-emit-rrr cg "and" 't0 'a0 'a2)
              (%cg-emit-rrr cg "and" 't1 'a1 'a3))
             ((eq? op 'or)
              (%cg-emit-rrr cg "or" 't0 'a0 'a2)
              (%cg-emit-rrr cg "or" 't1 'a1 'a3))
             ((eq? op 'xor)
              (%cg-emit-rrr cg "xor" 't0 'a0 'a2)
              (%cg-emit-rrr cg "xor" 't1 'a1 'a3))
             ((or (eq? op 'div) (eq? op 'rem))
              (%cg-emit-many
               cg
               (list "%call(&"
                     (if (%ctype-unsigned? ta)
                         "p1_i64_udivmod" "p1_i64_divmod")
                     ")\n")))
             ((or (eq? op 'eq) (eq? op 'ne)
                  (eq? op 'lt) (eq? op 'le) (eq? op 'gt) (eq? op 'ge))
              (%cg-emit-many
               cg
               (list "%i64_cmpset_"
                     (cond ((eq? op 'eq) "eq")
                           ((eq? op 'ne) "ne")
                           ((eq? op 'lt) (if unsigned? "ltu" "lt"))
                           ((eq? op 'le) (if unsigned? "leu" "le"))
                           ((eq? op 'gt) (if unsigned? "gtu" "gt"))
                           (else          (if unsigned? "geu" "ge")))
                     "(t0, a0, a1, a2, a3, t1)\n")))
             (else (die #f "cg-binop: unknown wide op" op)))
           (cond
             ((or (eq? op 'eq) (eq? op 'ne)
                  (eq? op 'lt) (eq? op 'le) (eq? op 'gt) (eq? op 'ge))
              (%cg-spill-reg cg 't0 %t-i32))
             ((eq? op 'div)
              (%cg-spill-pair cg 'a0 'a1 result-ty))
             ((eq? op 'rem)
              (%cg-spill-pair cg 'a2 'a3 result-ty))
             (else (%cg-spill-pair cg 't0 't1 result-ty))))))
       ((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)))
              (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))))
          (%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))))
          (%cg-emit-many cg (list "%ptr_diff(t0, a0, a1, " (%n sz) ", t1)\n")))
        (%cg-spill-reg cg 't0 result-ty))
       (else
        (%cg-load-opnd-into cg a 'a0)
        (%cg-load-opnd-into cg b 'a1)
        (cond
          ((eq? op 'add) (%cg-emit-rrr cg "add" 't0 'a0 'a1))
          ((eq? op 'sub) (%cg-emit-rrr cg "sub" 't0 'a0 'a1))
          ((eq? op 'mul) (%cg-emit-rrr cg "mul" 't0 'a0 'a1))
          ((eq? op 'and) (%cg-emit-rrr cg "and" 't0 'a0 'a1))
          ((eq? op 'or)  (%cg-emit-rrr cg "or"  't0 'a0 'a1))
          ((eq? op 'xor) (%cg-emit-rrr cg "xor" 't0 'a0 'a1))
          ((eq? op 'shl) (%cg-emit-rrr cg "shl" 't0 'a0 'a1))
          ((eq? op 'shr)
           ;; Shift result type is the promoted LEFT operand's type
           ;; (C 6.5.7); arithmetic vs logical shift must follow that
           ;; signedness alone, not the rhs's. cg-arith-conv may have
           ;; relabeled ta to match an unsigned rhs — guard against
           ;; that by checking the original `a` opnd's signedness.
           (if (%ctype-unsigned? ta)
               (%cg-emit-rrr cg "shr" 't0 'a0 'a1)
               (%cg-emit-rrr cg "sar" 't0 'a0 'a1)))
          ((eq? op 'div)
           (%cg-emit-rrr cg (if unsigned? "udiv" "div") 't0 'a0 'a1))
          ((eq? op 'rem)
           (%cg-emit-rrr cg (if unsigned? "urem" "rem") 't0 'a0 'a1))
          ((eq? op 'eq) (%cg-emit-cmp cg "eq"  'a0 'a1 't0))
          ((eq? op 'ne) (%cg-emit-cmp cg "ne"  'a0 'a1 't0))
          ((eq? op 'lt) (%cg-emit-cmp cg (if unsigned? "ltu" "lt") 'a0 'a1 't0))
          ((eq? op 'gt) (%cg-emit-cmp cg (if unsigned? "ltu" "lt") 'a1 'a0 't0))
          ((eq? op 'le) (%cg-emit-cmp cg (if unsigned? "leu" "le") 'a0 'a1 't0))
          ((eq? op 'ge) (%cg-emit-cmp cg (if unsigned? "geu" "ge") 'a0 'a1 't0))
          (else (die #f "cg-binop: unknown op" op)))
        ;; Canonicalize narrow integer results to their type's bit width
        ;; before spilling, so the slot's bit-pattern matches result-ty.
        ;; Compare ops already yield 0/1; skip them. Pointer-arith branches
        ;; above don't reach here.
        (cond
          ((or (eq? op 'eq) (eq? op 'ne)
               (eq? op 'lt) (eq? op 'le) (eq? op 'gt) (eq? op 'ge)) 0)
          (else (%cg-canonicalize cg 't0 result-ty)))
        (%cg-spill-reg cg 't0 result-ty)))))
 
 ;; Post-increment / post-decrement on the top-of-vstack lval.
 ;; Pushes the OLD value (per C semantics) and emits the +1 / -1 store.
 ;; Uses cg-dup + cg-load to capture the old rval (which is then in a
 ;; never-reused spill slot), then runs the regular dup+load+add+assign
 ;; pattern for the store. Pointer scaling falls out of cg-binop add.
 (define (%cg-post-inc-dec cg op)
   (cg-dup cg)
   (cg-load cg)
   (let ((old (cg-pop cg)))
     (cg-dup cg)
     (cg-load cg)
     (cg-push-imm cg %t-i32 1)
     (cg-binop cg op)
     (cg-assign cg)
     (cg-pop cg)
     (cg-push cg old)))
 
 (define (cg-postinc cg) (%cg-post-inc-dec cg 'add))
 (define (cg-postdec cg) (%cg-post-inc-dec cg 'sub))
 
 (define (cg-unop cg op)
   (let* ((p  (cg-pop cg)) (ty (opnd-type p)))
     (cond
       ((%ctype-wide-int? ty)
        (%cg-load-wide-opnd-into cg p 'a0 'a1)
        (cond
          ((eq? op 'neg)
           (%cg-emit-many cg (list "%i64_neg(t0, t1, a0, a1, t2)\n"))
           (%cg-spill-pair cg 't0 't1 ty))
          ((eq? op 'bnot)
           (%cg-emit-many cg (list "%bnot(t0, a0, t2)\n"
                                   "%bnot(t1, a1, t2)\n"))
           (%cg-spill-pair cg 't0 't1 ty))
          ((eq? op 'lnot)
           (%cg-emit-rrr cg "or" 't0 'a0 'a1)
           (%cg-emit-many cg (list "%cmpset_eqz(t0, t0)\n"))
           (%cg-spill-reg cg 't0 %t-i32))
          (else (die #f "cg-unop: unknown wide op" op))))
       (else
        (%cg-load-opnd-into cg p 't0)
        (cond
       ((eq? op 'neg)
        (%cg-emit-many cg (list "%neg(t0, t0, t1)\n"))
        (%cg-spill-reg cg 't0 ty))
       ((eq? op 'bnot)
        (%cg-emit-many cg (list "%bnot(t0, t0, t1)\n"))
        (%cg-spill-reg cg 't0 ty))
       ((eq? op 'lnot)
        (%cg-emit-many cg (list "%cmpset_eqz(t0, t0)\n"))
        (%cg-spill-reg cg 't0 %t-i32))
       (else (die #f "cg-unop: unknown op" op)))))))
 
 (define (cg-assign cg)
   ;; Pops rhs, pops lhs, casts rhs to lhs's type (parser cannot peek
   ;; deeper than vstack top to do this itself), emits the store, pushes
   ;; the assigned value as the result rval.
   (let* ((rhs0 (cg-pop cg))
          (lhs  (cg-pop cg))
          (ty   (opnd-type lhs)))
     (cond ((not (opnd-lval? lhs)) (die #f "cg-assign: lhs not lvalue")))
     ;; Cast rhs to lhs's type (no-op when the types already match).
     (cg-push cg rhs0)
     (cg-cast cg ty)
     (let ((rhs (cg-pop cg)))
       (cond
         ((%ctype-wide-int? ty)
          (%cg-load-wide-opnd-into cg rhs 'a0 'a1)
          (%cg-store-pair-to-lval cg 'a0 'a1 lhs)
          (%cg-spill-pair cg 'a0 'a1 ty))
         (else
          (%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
 ;; --------------------------------------------------------------------
 (define (cg-call cg arity has-result?)
   (let* ((args (let loop ((i 0) (acc '()))
                  (cond ((= i arity) acc)
                        (else (loop (+ i 1) (cons (cg-pop cg) acc))))))
          (fn-op (cg-pop cg))
          ;; sret = struct/union wider than two target words; shift args by one reg
          ;; and place a0 last so it's not clobbered by arg loads.
          (fty (opnd-type fn-op))
          (rty (cond
                 ((eq? (ctype-kind fty) 'fn) (car (ctype-ext fty)))
                 ((eq? (ctype-kind fty) 'ptr)
                  (let ((p (ctype-ext fty)))
                    (if (eq? (ctype-kind p) 'fn) (car (ctype-ext p)) %t-word-i)))
                 (else %t-word-i)))
          (rk  (ctype-kind rty))
          (sret? (and has-result?
                      (or (eq? rk 'struct) (eq? rk 'union))
                      (> (ctype-size rty) %CC-PAIR-BYTES)))
          ;; If the callee is variadic, the callee's save area caps total
          ;; incoming ABI words. Reject silent miscompiles up front.
          (callee-fty (cond
                        ((eq? (ctype-kind fty) 'fn) fty)
                        ((and (eq? (ctype-kind fty) 'ptr)
                              (eq? (ctype-kind (ctype-ext fty)) 'fn))
                         (ctype-ext fty))
                        (else #f)))
          (callee-variadic? (and callee-fty
                                 (let ((ext (ctype-ext callee-fty)))
                                   (and (pair? ext) (pair? (cdr ext))
                                        (pair? (cddr ext))
                                        (car (cddr ext))))))
          (arg-slots
           (let count ((xs args) (n 0))
             (cond ((null? xs) n)
                   (else (count (cdr xs)
                                (+ n (%cg-param-reg-count
                                        (opnd-type (car xs)))))))))
          (_cap-check (cond
                        ((and callee-variadic?
                              (> arg-slots %CG-VARARG-WINDOW))
                         (die #f "cg-call: variadic call exceeds save-area"
                              arg-slots %CG-VARARG-WINDOW))
                        (else 0)))
          (sret-shift (if sret? 1 0))
          (recv-slot (cond
                       (sret?
                        (cg-alloc-slot cg
                                       (align-up (ctype-size rty) %CC-WORD-BYTES)
                                       (max %CC-WORD-BYTES (ctype-align rty))))
                       (else #f))))
     ;; Copy every indirect aggregate before loading any ABI argument register:
     ;; %memcpy_call uses a0-a2, so interleaving a later copy with register
     ;; staging would clobber earlier arguments.  The parallel list records the
     ;; private frame slot for each large aggregate and #f for direct args.
     (let ((indirect-copies
            (let materialize ((xs args) (out '()))
              (cond
                ((null? xs) (reverse out))
                (else
                 (let* ((arg (car xs))
                        (aty (opnd-type arg)))
                   (cond
                     ((%cg-param-indirect? aty)
                      (let* ((sz (ctype-size aty))
                             (al (max %CC-WORD-BYTES (ctype-align aty)))
                             (slot (cg-alloc-slot
                                    cg (align-up sz %CC-WORD-BYTES) al)))
                        (%cg-emit-addr-of cg arg 't0)
                        (%cg-emit-lea-slot cg "t2" (%cg-slot-expr cg slot))
                        (%cg-emit-byte-copy cg 't2 't0 't1 sz)
                        (materialize (cdr xs) (cons slot out))))
                     (else
                      (materialize (cdr xs) (cons #f out))))))))))
       (let stage ((xs args) (copies indirect-copies) (idx 0))
         (cond
           ((null? xs) 0)
           (else
            (let* ((arg (car xs))
                   (aty (opnd-type arg))
                   (n   (%cg-param-reg-count aty)))
              (cond
              ;; Large aggregate: pass the address of the private copy through
              ;; one pointer ABI slot. The callee marks its pointer slot
              ;; indirect, so ordinary struct lvalue operations address it.
              ((%cg-param-indirect? aty)
               (let ((slot (car copies))
                     (abi (+ idx sret-shift)))
                 (cond
                   ((< abi 4)
                    (%cg-emit-lea-slot cg
                                       (%cg-reg->bv (%reg-by-idx abi))
                                       (%cg-slot-expr cg slot)))
                   (else
                    (%cg-emit-lea-slot cg "t0" (%cg-slot-expr cg slot))
                    (%cg-emit-st cg 't0 'sp
                                 (* %CC-WORD-BYTES (- abi 4)))))
                 (stage (cdr xs) (cdr copies) (+ idx 1))))
              ;; RV32 i64/u64 values consume two consecutive ABI words.
              ((%ctype-wide-int? aty)
               (%cg-load-wide-opnd-into cg arg 't0 't1)
               (let chunk ((i 0))
                 (cond
                   ((= i 2) 0)
                   (else
                    (let ((tabi (+ idx sret-shift i))
                          (src (if (= i 0) 't0 't1)))
                      (cond
                        ((< tabi 4)
                         (%cg-emit-many
                          cg
                          (list "%mov("
                                (%cg-reg->bv (%reg-by-idx tabi)) ", "
                                (%cg-reg->bv src) ")\n")))
                        (else
                         (%cg-emit-st cg src 'sp
                                      (* %CC-WORD-BYTES (- tabi 4)))))
                      (chunk (+ i 1))))))
               (stage (cdr xs) (cdr copies) (+ idx 2)))
              ;; Direct aggregate: load its target-word chunks into successive
              ;; arg regs / stack slots.  This path also handles a one-word
              ;; aggregate: unlike the generic scalar load below, addr-of knows
              ;; when an aggregate lvalue is represented by an indirect frame
              ;; slot (for example `p->loc`) and follows that slot before the
              ;; chunk load.
              ((%cg-param-aggregate? aty)
               (%cg-emit-addr-of cg arg 't0)
               (let chunk ((i 0))
                 (cond
                   ((>= i n) 0)
                   (else
                    (let ((tabi (+ idx sret-shift i)))
                      (cond
                        ((< tabi 4)
                         (%cg-emit-many cg
                                        (list "%ld("
                                              (%cg-reg->bv (%reg-by-idx tabi))
                                              ", t0, "
                                              (%n (* i %CC-WORD-BYTES)) ")\n")))
                        (else
                         (%cg-emit-many cg
                                        (list "%ld(t1, t0, "
                                              (%n (* i %CC-WORD-BYTES)) ")\n"))
                         (%cg-emit-st cg 't1 'sp
                                      (* %CC-WORD-BYTES (- tabi 4))))))
                    (chunk (+ i 1)))))
               (stage (cdr xs) (cdr copies) (+ idx n)))
              (else
               (let ((abi (+ idx sret-shift)))
                 (cond
                   ((< abi 4)
                    (%cg-load-opnd-into cg arg (%reg-by-idx abi))
                    (stage (cdr xs) (cdr copies) (+ idx 1)))
                   (else
                    (%cg-load-opnd-into cg arg 't0)
                    (%cg-emit-st cg 't0 'sp
                                 (* %CC-WORD-BYTES (- abi 4)))
                    (stage (cdr xs) (cdr copies) (+ idx 1))))))))))))
     ;; Stack-arg footprint accounts for the extra ABI slot any
     ;; >8B-aggregate arg consumed beyond its single-position cousin.
     (let* ((nabi (let count ((xs args) (n sret-shift))
                    (cond ((null? xs) n)
                          (else (count (cdr xs)
                                       (+ n (%cg-param-reg-count
                                               (opnd-type (car xs)))))))))
            (sa  (max 0 (- nabi 4))))
       (cond ((> sa 0) (%cg-bump-outgoing! cg sa)) (else 0)))
     (cond
       (sret?
        (%cg-emit-lea-slot cg "a0" (%cg-slot-expr cg recv-slot))))
     (cond
       ((and (eq? (opnd-kind fn-op) 'global) (not (opnd-lval? fn-op)))
        (%cg-emit-many cg (list "%call(&" (opnd-ext fn-op) ")\n")))
       (else
        (%cg-load-opnd-into cg fn-op 't0)
        (%cg-emit-many cg (list "%callr(t0)\n"))))
     (cond
       (has-result?
        (cond
          ((%ctype-wide-int? rty)
           (%cg-spill-pair cg 'a0 'a1 rty))
          ;; Wider-than-two-word sret (A2): a0 holds recv-slot; push as struct lval.
          (sret? (cg-push cg (%opnd 'frame rty recv-slot #t)))
          ;; At-most-two-word struct/union (A1): fresh slot, spill from a0/a1.
          ((and (or (eq? rk 'struct) (eq? rk 'union))
                (<= (ctype-size rty) %CC-PAIR-BYTES))
           (let* ((sz   (ctype-size rty))
                  (al   (max %CC-WORD-BYTES (ctype-align rty)))
                  (slot (cg-alloc-slot cg
                                       (align-up sz %CC-WORD-BYTES) al)))
             (%cg-emit-st-slot cg 'a0 slot)
             (cond ((> sz %CC-WORD-BYTES)
                    (%cg-emit-st-slot cg 'a1 (+ slot %CC-WORD-BYTES))))
             (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))
          (rk       (ctype-kind ret-type))
          (sret?    (%cg-fn-get cg '%fn-sret?)))
     (cond
       ((eq? rk 'void)
        (%cg-emit-many cg (list "%b(&.ret)\n")))
       ((or (eq? rk 'struct) (eq? rk 'union))
        ;; struct-by-value: at most two words (A1) → ret-slot; wider
        ;; (A2 sret) → *sret-slot.
        (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")))
          (%cg-emit-addr-of cg p 't0)
          (cond
            (sret?
             (%cg-emit-ld-slot cg 't2 (%cg-fn-get cg '%fn-sret-slot)))
          (else
             (%cg-emit-lea-slot cg "t2" (%cg-slot-expr cg ret-slot))))
          (%cg-emit-byte-copy cg 't2 't0 't1 sz)
          (%cg-emit-many cg (list "%b(&.ret)\n"))))
       ((%ctype-wide-int? ret-type)
        (let ((p (cg-pop cg)))
          (%cg-load-wide-opnd-into cg p 'a0 'a1)
          (%cg-emit-st-slot cg 'a0 ret-slot)
          (%cg-emit-st-slot cg 'a1 (+ ret-slot %CC-WORD-BYTES))
          (%cg-emit-many cg (list "%b(&.ret)\n"))))
       (else
        (let ((p (cg-pop cg)))
          (%cg-load-opnd-into cg p 'a0)
          (%cg-emit-st-slot cg 'a0 ret-slot)
          (%cg-emit-many cg (list "%b(&.ret)\n")))))))
 
 ;; --------------------------------------------------------------------
 ;; Structured control flow
 ;; --------------------------------------------------------------------
 (define (cg-if cg then-thunk)
   (let ((p (cg-pop cg)))
     (%cg-load-truth-into cg p 't0)
     (%cg-emit-many cg (list "%if_nez(t0, {\n"))
     (then-thunk)
     (%cg-emit-many cg (list "})\n"))))
 
 (define (cg-ifelse cg then-thunk else-thunk)
   (let ((p (cg-pop cg)))
     (%cg-load-truth-into cg p 't0)
     (%cg-emit-many cg (list "%ifelse_nez(t0, {\n"))
     (then-thunk)
     (%cg-emit-many cg (list "}, {\n"))
     (else-thunk)
     (%cg-emit-many cg (list "})\n"))))
 
 ;; Conditionals-as-values: `cg-ifelse` is correct for if-statements
 ;; (thunks push nothing) but each thunk for ternary / `&&` / `||` ends
 ;; with one rval on top of the vstack — and after both branches run,
 ;; we'd be left with TWO opnds, which breaks the type contract for
 ;; the surrounding expression. `cg-ifelse-merge` solves that: pop the
 ;; cond, allocate one result slot, and after each thunk runs, pop its
 ;; rval and store into the slot. Push the slot as one frame rval.
 ;;
 ;; Result type follows C11 §6.5.15 ¶5 for ternary: the usual arithmetic
 ;; conversions over the two arms' types. The slot stores the raw target-word
 ;; payload (per cc.scm's canonical-form discipline); %cg-load-opnd-into
 ;; then re-canonicalizes on read against whatever common type we picked.
 ;; For `&&` / `||` callers both arms are pre-cast to %t-i32 by the
 ;; parser, so the merge is a no-op on type.
 (define (cg-ifelse-merge cg then-thunk else-thunk)
   (let* ((cond-op (cg-pop cg)))
     (%cg-load-truth-into cg cond-op 't0)
     (%cg-emit-many cg (list "%ifelse_nez(t0, {\n"))
     (then-thunk)
     (let* ((p     (cg-pop cg))
            (rty1  (opnd-type p))
            (rk1   (ctype-kind rty1))
            ;; Struct/union arms can't ride the canonical target-word
            ;; slot — the arm's bytes have to land in a slot sized to
            ;; the struct, and each arm memcpys its lvalue in. tcc's
            ;; expr_cond does this exact `type = bt1 == 6 ? type1 : type2`
            ;; pattern across CType structs, so without this case
            ;; cc.scm-compiled tcc-boot2 self-corrupts.
            (aggr? (or (eq? rk1 'struct) (eq? rk1 'union)))
            ;; On RV32 reserve both words for scalar merges. The second arm
            ;; can widen the common type to i64/u64 after the first arm has
            ;; already been emitted.
            (pair-slot? (and (not aggr?) (= %CC-WORD-BYTES 4)))
            (slot  (cond (aggr?
                          (cg-alloc-slot cg
                                         (align-up (ctype-size rty1)
                                                   %CC-WORD-BYTES)
                                         (max %CC-WORD-BYTES
                                              (ctype-align rty1))))
                         (pair-slot?
                          (cg-alloc-slot cg
                                         %CC-PAIR-BYTES %CC-WORD-BYTES))
                         (else
                          (cg-alloc-slot cg
                                         %CC-WORD-BYTES %CC-WORD-BYTES)))))
       (%cg-merge-write-arm cg p slot aggr? pair-slot?)
       (%cg-emit-many cg (list "}, {\n"))
       (else-thunk)
       (let* ((q    (cg-pop cg))
              (rty2 (opnd-type q)))
         (%cg-merge-write-arm cg q slot aggr? pair-slot?)
         (%cg-emit-many cg (list "})\n"))
         ;; Aggregate result is pushed as a frame lval so cg-copy-struct
         ;; (which asserts src must be lval) accepts it; %cg-emit-addr-of
         ;; falls through the `lval? #t` guard (slot is direct, not
         ;; indirect) and returns the slot's address either way.
         (cg-push cg (%opnd 'frame
                            (%cg-merge-arith-type rty1 rty2)
                            slot
                            aggr?))))))
 
 (define (%cg-merge-write-arm cg op slot aggr? pair-slot?)
   (cond
     (aggr?
      (%cg-emit-addr-of cg op 't0)
      (%cg-emit-lea-slot cg "t2" (%cg-slot-expr cg slot))
      (%cg-emit-byte-copy cg 't2 't0 't1 (ctype-size (opnd-type op))))
     ((and pair-slot? (%ctype-wide-int? (opnd-type op)))
      (%cg-load-wide-opnd-into cg op 'a0 'a1)
      (%cg-emit-st-slot cg 'a0 slot)
      (%cg-emit-st-slot cg 'a1 (+ slot %CC-WORD-BYTES)))
     (pair-slot?
      (%cg-load-opnd-into cg op 'a0)
      (cond
        ((%ctype-unsigned? (opnd-type op))
         (%cg-emit-many cg (list "%li(a1, 0)\n")))
        (else
         (%cg-emit-many cg
                        (list "%sari(a1, a0, "
                              (%n (- %CC-WORD-BITS 1)) ")\n"))))
      (%cg-emit-st-slot cg 'a0 slot)
      (%cg-emit-st-slot cg 'a1 (+ slot %CC-WORD-BYTES)))
     (else
      (%cg-load-opnd-into cg op 'a0)
      (%cg-emit-st-slot cg 'a0 slot))))
 
 ;; Conditional-expression common type (C11 §6.5.15): preserve a pointer
 ;; operand regardless of arm order (the other valid mixed operand is a null
 ;; pointer constant), otherwise apply the usual arithmetic conversions.
 ;; Aggregate conditionals retain the first arm's type as before.
 (define (%cg-merge-arith-type t1 t2)
   (cond
     ((%ctype-ptr? t1) t1)
     ((%ctype-ptr? t2) t2)
     ((and (%ctype-arith? t1) (%ctype-arith? t2))
      (let ((p1 (cond ((< (ctype-size t1) 4) %t-i32) (else t1)))
            (p2 (cond ((< (ctype-size t2) 4) %t-i32) (else t2))))
        (cond
          ((> (ctype-size p1) (ctype-size p2)) p1)
          ((> (ctype-size p2) (ctype-size p1)) p2)
          ((%ctype-unsigned? p1) p1)
          ((%ctype-unsigned? p2) p2)
          (else p1))))
     (else t1)))
 
 (define (cg-loop cg head-thunk body-thunk)
   ;; body-thunk receives the loop tag as its argument; parser uses
   ;; that tag for cg-break / cg-continue inside the body.
   (let ((tag (%cg-fresh-loop-tag cg)))
     (%cg-emit-many cg (list ".scope\n"
                             ":.top\n"))
     (head-thunk)
     (cond
       ((zero? (cg-depth cg)) 0)
       (else
        (let ((c (cg-pop cg)))
          (%cg-load-truth-into cg c 't0)
          (%cg-emit-many cg (list "%if_eqz(t0, { %break })\n")))))
     (body-thunk tag)
     (%cg-emit-many cg (list "%b(&.top)\n"
                             ":.end\n"
                             ".endscope\n"))
     tag))
 
 (define (cg-break cg tag)
   (%cg-emit-many cg (list "%break\n")))
 
 (define (cg-continue cg tag)
   (%cg-emit-many cg (list "%continue\n")))
 
 ;; --------------------------------------------------------------------
 ;; Variadic receive (§G.2). Layout: cg-fn-begin/v reserves a fixed
 ;; target-word save area at known frame offsets, populating each
 ;; slot from the appropriate ABI source — a-register for indices 0..3,
 ;; LDARG for later indices. va_start sets ap to the address of the
 ;; first slot past the named-arg count; va_arg reads *ap, advances ap
 ;; by one target word, 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.
 ;;
 ;; Cap: total incoming ABI words (named + variadic) must fit in the
 ;; %CG-VARARG-WINDOW-slot save area. Variadic call sites exceeding this die in cg-call;
 ;; variadic definitions whose named-arg count exceeds it die in
 ;; cg-fn-begin/v.
 ;; --------------------------------------------------------------------
 (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")))
     (%cg-emit-lea-slot cg "a0" (%cg-slot-expr cg vsl))
     (%cg-emit-addr-of cg ap-lv 't0)
     (%cg-emit-st cg 'a0 't0 0)))
 
 (define (cg-va-arg cg ctype)
   ;; Pop ap-lval. Load ap into a0. Read one word at [a0] into a1.
   ;; Advance a0 by one word 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")))
     ;; Address of the storage that holds ap → t0; ap value → a0.
     (%cg-emit-addr-of cg ap-lv 't0)
     (%cg-emit-ld cg 'a0 't0 0)
     ;; Read one or two ABI words, advance ap by the consumed width, and
     ;; store the updated cursor back through the va_list lvalue.
     (%cg-emit-ld cg 'a1 'a0 0)
     (cond
       ((%ctype-wide-int? ctype)
        (%cg-emit-ld cg 'a2 'a0 %CC-WORD-BYTES)
        (%cg-emit-many cg
                       (list "%addi(a0, a0, "
                             (%n %CC-PAIR-BYTES) ")\n"))
        (%cg-emit-st cg 'a0 't0 0)
        (%cg-spill-pair cg 'a1 'a2 ctype))
       (else
        (%cg-emit-many cg
                       (list "%addi(a0, a0, "
                             (%n %CC-WORD-BYTES) ")\n"))
        (%cg-emit-st cg 'a0 't0 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.
 ;; C labels have function scope, even when the labelled statement appears
 ;; inside a nested block/loop. Emit them as function-qualified global
 ;; labels rather than dotted hex2++ locals, because dotted definitions
 ;; inside a nested `.scope` would be invisible to gotos outside it.
 ;; --------------------------------------------------------------------
 (define (%cg-user-label cg name-bv)
   (let ((fn (%cg-fn-get cg '%fn-label)))
     (bv-cat (list fn "__user_" name-bv))))
 
 (define (cg-emit-label cg name-bv)
   (%cg-emit-many cg (list ":" (%cg-user-label cg name-bv) "\n")))
 
 (define (cg-goto cg name-bv)
   (%cg-emit-many cg (list "%b(&" (%cg-user-label cg name-bv) ")\n")))
 
 ;; --------------------------------------------------------------------
 ;; switch
 ;; --------------------------------------------------------------------
 (define-record-type swctx
   (%swctx ctrl-slot ctrl-type end-tag default-lbl)
   swctx?
   (ctrl-slot   swctx-ctrl-slot)
   (ctrl-type   swctx-ctrl-type)
   (end-tag     swctx-end-tag)
   (default-lbl swctx-default-lbl swctx-default-lbl-set!))
 
 (define (cg-switch-begin cg)
   (let* ((p   (cg-pop cg))
          (ty  (opnd-type p))
          (wide? (%ctype-wide-int? ty))
          (off (cg-alloc-slot cg
                              (if wide? %CC-PAIR-BYTES %CC-WORD-BYTES)
                              %CC-WORD-BYTES))
          (tag (%cg-fresh-loop-tag cg))
          (disp-lbl (bytevector-append "sw_disp_" tag)))
     (cond
       (wide?
        (%cg-load-wide-opnd-into cg p 't0 't1)
        (%cg-emit-st-slot cg 't0 off)
        (%cg-emit-st-slot cg 't1 (+ off %CC-WORD-BYTES)))
       (else
        (%cg-load-opnd-into cg p 't0)
        (%cg-emit-st-slot cg 't0 off)))
     (%cg-emit-many cg (list ".scope\n"
                             "%b(&." disp-lbl ")\n"))
     (%swctx off ty tag #f)))
 
 (define (cg-switch-case cg sw const-int)
   (let* ((lbl (%cg-fresh-lbl cg))
          (key (string->symbol
                (bytevector-append "%sw_cases__" (swctx-end-tag sw))))
          (cur (or (%cg-fn-get cg key) '()))
          (entry (cons const-int lbl)))
     (%cg-fn-set! cg key (cons entry cur))
     (%cg-emit-many cg (list ":." lbl "\n"))))
 
 (define (cg-switch-default cg sw)
   (let ((lbl (%cg-fresh-lbl cg)))
     (swctx-default-lbl-set! sw lbl)
     (%cg-emit-many cg (list ":." lbl "\n"))))
 
 (define (cg-switch-end cg sw)
   (let* ((tag (swctx-end-tag sw))
          (key (string->symbol (bytevector-append "%sw_cases__" tag)))
          (cases (reverse (or (%cg-fn-get cg key) '())))
          (default-lbl (swctx-default-lbl sw))
          (disp-lbl (bytevector-append "sw_disp_" tag)))
     (%cg-emit-many cg (list "%break\n"
                             ":." disp-lbl "\n"))
     (cond
       ((%ctype-wide-int? (swctx-ctrl-type sw))
        (%cg-emit-ld-slot cg 't0 (swctx-ctrl-slot sw))
        (%cg-emit-ld-slot cg 't1
                          (+ (swctx-ctrl-slot sw) %CC-WORD-BYTES))
        (for-each
         (lambda (c)
           (%cg-emit-li-wide cg 'a0 'a1 (car c))
           (%cg-emit-many
            cg
            (list "%i64_cmpset_eq(t2, t0, t1, a0, a1, a2)\n"
                  "%bnez(t2, &." (cdr c) ")\n")))
         cases))
       (else
        (%cg-emit-many cg (list "%ld(t0, sp, "
                                (%cg-slot-expr cg (swctx-ctrl-slot sw)) ")\n"))
        (for-each
         (lambda (c)
           (%cg-emit-many cg (list "%switch_case(t0, t1, "
                                   (%n (car c)) ", &." (cdr c) ")\n")))
         cases)))
     (cond
       (default-lbl (%cg-emit-many cg (list "%b(&." default-lbl ")\n")))
       (else 0))
     (%cg-emit-many cg (list "%break\n"
                             ":.end\n"
                             ".endscope\n"))))
 
 ;; --------------------------------------------------------------------
 ;; Globals and data
 ;; --------------------------------------------------------------------
 ;; cg-emit-global: emit a global symbol into either .data (initialized)
 ;; or .bss (zero-init).
 ;;
 ;; init can be:
 ;;   #f                       — zero-init in .bss (size from sym's ctype).
 ;;   (piece ...)              — initialized in .data; pieces concatenated.
 ;;
 ;; Each piece is either:
 ;;   <bytevector>             — raw bytes; emitted as bare hex chunks
 ;;                              (64 bytes / 128 hex chars per line).
 ;;   (label-ref . <label-bv>) — target-word pointer slot containing &label;
 ;;                              (`&label` on RV32; `&label %(0)` on LP64).
 (define (%cg-init-piece->bv piece)
   (cond
     ((bytes? piece)
      (bv-cat (%cg-bv->hex-lines piece #f)))
     ((and (pair? piece) (eq? (car piece) 'label-ref))
      (bv-cat (list "&" (cdr piece)
                    (if (= %CC-WORD-BYTES 4) "\n" " %(0)\n"))))
     (else (die #f "cg-emit-global: bad init piece" piece))))
 
 (define (cg-emit-global cg sym init)
   (let* ((lbl (%cg-sym-label cg sym))
          (sz  (ctype-size (sym-type sym)))
          (size (if (< sz 0) %CC-WORD-BYTES sz))
          (al  (max 1 (ctype-align (sym-type sym)))))
     (cond
       (init
        (buf-push! (cg-data cg) (bv-cat (list "\n.align " (%n al) "\n:"
                                              lbl "\n")))
        (let walk ((ps init))
          (cond
            ((null? ps) 0)
            (else
             (buf-push! (cg-data cg) (%cg-init-piece->bv (car ps)))
             (walk (cdr ps))))))
       (else
        (buf-push! (cg-bss cg)
                   (bv-cat (list "\n.align " (%n al) "\n:" lbl "\n"
                                 (let zero-loop ((rem size) (acc '()))
                                   (cond
                                     ((<= rem 0) (bv-cat (reverse acc)))
                                     ((>= rem 8)
                                      (zero-loop (- rem 8) (cons "$(0)\n" acc)))
                                     (else
                                      (zero-loop (- rem 1) (cons "!(0)\n" acc))))))))))
   0))
 
 (define (cg-emit-extern cg sym) 0)
 
 ;; Record `n` as a tentative file-scope definition: don't emit BSS yet,
 ;; but if no full definition appears by end of TU, cg-finish will emit
 ;; zero-init storage for it. The pair in world-tentatives holds the names in
 ;; its car and a membership hash in its cdr, avoiding a quadratic `member`
 ;; scan across translation units with many tentative declarations.
 (define (cg-add-tentative! cg n)
   (let* ((w (cg-world cg))
          (pending (world-tentatives w))
          (seen (cdr pending)))
     (cond
       ((%hash-ref seen n) #t)
       (else
        (%hash-set! seen n #t)
        (set-car! pending (cons n (car pending)))))))
 
 ;; End-of-TU pass: for each pending tentative, look up the latest sym
 ;; binding. If it's still `defined?=#f`, no real definition replaced it,
 ;; so emit zero-init storage now. Otherwise the .data emission already
 ;; covered it.
 (define (cg-flush-tentatives! cg)
   (let* ((w (cg-world cg))
          (top (car (world-scope w))))
     (for-each
       (lambda (n)
         (let ((sm (%hash-ref top n)))
           (cond
             ((and sm
                   (eq? (sym-kind sm) 'var)
                   (not (sym-defined? sm)))
              (cg-emit-global cg sm #f)))))
       (car (world-tentatives w)))))
 
 (define (cg-intern-string cg bv-content)
   (let ((p (%hash-ref (cg-str-pool cg) bv-content)))
     (cond
       (p p)
       (else
        (let* ((n   (%hash-size (cg-str-pool cg)))
               (lbl (bytevector-append
                     (cg-str-prefix cg) "cc__str_" (%n n))))
          (%hash-set! (cg-str-pool cg) bv-content lbl)
          (buf-push! (cg-data cg)
                     (bv-cat (append (list "\n.align " (%n %CG-STR-ALIGN)
                                           "\n:" lbl "\n")
                                     (%cg-bv->hex-lines bv-content #t)
                                     (list ".align " (%n %CG-STR-ALIGN) "\n"))))
          lbl)))))
 
 ;; Mint a fresh, never-recurring label for an unnamed file-scope
 ;; compound literal. Mirrors cg-intern-string's namer pattern (prefix +
 ;; "cc__cl_" + N), with N drawn from cg-label-ctr — the same monotonic
 ;; counter the per-fn label minters use. Different prefix → no collision
 ;; with `Lcc__N` / `lbl_N`.
 (define (%cg-fresh-cl-label cg)
   (let* ((n   (cg-label-ctr cg))
          (lbl (bytevector-append (cg-str-prefix cg) "cc__cl_" (%n n))))
     (cg-label-ctr-set! cg (+ n 1))
     lbl))
 
 ;; Render BV's bytes as bare hex accepted directly by hex2++. Lines are
 ;; chunked to ≤128 hex chars (= 64 bytes) to keep generated P1pp readable.
 ;;
 ;; If TRAILING-NUL? is #t, an extra 0x00 byte is appended to terminate
 ;; a C string. Alignment is emitted explicitly by callers with .align
 ;; so hex2++ owns padding instead of cc.scm manufacturing zero bytes.
 ;; The other caller (%cg-init-piece->bv) emits arbitrary initializer
 ;; bytes whose length is sized exactly to the C-visible field; padding a
 ;; 4-byte int slot to 8 would shift every following struct field.
 ;; Returns a list of bytevectors ready for bv-cat.
 (define %CG-HEX-CHUNK-BYTES 64)
 (define %CG-STR-ALIGN       8)
 
 (define (%cg-bv->hex-lines bv trailing-nul?)
   (let* ((len     (bytevector-length bv))
          (logical (cond (trailing-nul? (+ len 1)) (else len)))
          (total   logical))
     (cond
       ((= total 0) '())
       (else
        (let loop ((i 0) (acc '()))
          (cond
            ((>= i total) (reverse acc))
            (else
             (let ((end (cond ((< (+ i %CG-HEX-CHUNK-BYTES) total)
                               (+ i %CG-HEX-CHUNK-BYTES))
                              (else total))))
               (loop end (cons (%cg-hex-line bv i end len) acc))))))))))
 
 ;; One `XXXX...XX\n` line covering BV bytes [START, END). Indices
 ;; >= LEN render as 0x00 (used for the trailing NUL terminator).
 (define (%cg-hex-line bv start end len)
   (let* ((nbytes (- end start))
          (out    (make-bytevector (+ (* 2 nbytes) 1))))
     (let loop ((j start) (k 0))
       (cond
         ((= j end)
          (bytevector-u8-set! out k (char->integer #\newline))
          out)
         (else
          (let ((b (cond ((< j len) (bytevector-u8-ref bv j))
                         (else 0))))
            (bytevector-u8-set! out k       (%cg-hex-digit
                                             (arithmetic-shift b -4)))
            (bytevector-u8-set! out (+ k 1) (%cg-hex-digit (bit-and b 15)))
            (loop (+ j 1) (+ k 2))))))))
 
 (define (%cg-hex-digit n)
   (cond ((< n 10) (+ n (char->integer #\0)))
         (else    (+ (- n 10) (char->integer #\A)))))
 
 ;; --------------------------------------------------------------------
 ;; Frame
 ;; --------------------------------------------------------------------
 (define (cg-alloc-slot cg bytes align)
   (let* ((aligned (align-up (cg-frame-hi cg) align))
          (new-hi  (+ aligned bytes)))
     (cg-frame-hi-set! cg new-hi)
     aligned))
 ;; cc/parse.scm — recursive-descent + Pratt parser. Minimal scheme1.
 
 (define (make-pstate iter cg)
   (%pstate iter (cg-world cg) '() #f cg))
 
 (define (peek ps)    (iter-peek  (ps-iter ps)))
 (define (peek2 ps)   (iter-peek2 (ps-iter ps)))
 (define (advance ps) (iter-next  (ps-iter ps)))
 (define (at-kw? ps s)
   (pmatch (peek ps)
     (($ tok? (kind KW) (value ,v)) (eq? v s))
     (else #f)))
 (define (at-punct? ps s)
   (pmatch (peek ps)
     (($ tok? (kind PUNCT) (value ,v)) (eq? v s))
     (else #f)))
 (define (expect-kw ps s)
   (let ((t (peek ps)))
     (pmatch t
       (($ tok? (kind KW) (value ,v)) (guard (eq? v s)) (advance ps))
       (else (die (tok-loc t) "expected kw" s)))))
 (define (expect-punct ps s)
   (let ((t (peek ps)))
     (pmatch t
       (($ tok? (kind PUNCT) (value ,v)) (guard (eq? v s)) (advance ps))
       (else (die (tok-loc t) "expected punct" s)))))
 
 (define (scope-enter! ps)
   (ps-scope-set! ps (cons (%make-hash-table 16) (ps-scope ps)))
   (ps-tags-set!  ps (cons (%make-hash-table 8) (ps-tags ps))))
 (define (scope-leave! ps)
   (ps-scope-set! ps (cdr (ps-scope ps)))
   (ps-tags-set!  ps (cdr (ps-tags ps))))
 (define (ctype-compat? a b)
   (cond
     ((eq? a b) #t)
     ((not (eq? (ctype-kind a) (ctype-kind b))) #f)
     (else
      (let ((k (ctype-kind a)))
        (cond
          ((eq? k 'ptr) (ctype-compat? (ctype-ext a) (ctype-ext b)))
          ((eq? k 'arr)
           (let ((ea (ctype-ext a)) (eb (ctype-ext b)))
             (and (ctype-compat? (car ea) (car eb))
                  (or (= (cdr ea) (cdr eb))
                      (< (cdr ea) 0) (< (cdr eb) 0)))))
          ((eq? k 'fn) (%fn-ctype-compat? (ctype-ext a) (ctype-ext b)))
          ((or (eq? k 'struct) (eq? k 'union) (eq? k 'enum)) #f)
          (else #t))))))
 
 (define (%fn-ctype-compat? a b)
   (and (ctype-compat? (car a) (car b))
        (eq? (car (cddr a)) (car (cddr b)))
        (%fn-params-compat? (cadr a) (cadr b))))
 
 (define (%fn-params-compat? pa pb)
   (cond
     ((and (null? pa) (null? pb)) #t)
     ((or (null? pa) (null? pb)) #f)
     ((ctype-compat? (cdar pa) (cdar pb))
      (%fn-params-compat? (cdr pa) (cdr pb)))
     (else #f)))
 
 (define (sym-merge old new)
   (cond
     ((not (eq? (sym-kind old) (sym-kind new)))
      (die #f "redecl: kind mismatch" (sym-name old)))
     ((not (ctype-compat? (sym-type old) (sym-type new)))
      (die #f "redecl: type mismatch" (sym-name old)))
     ((eq? (sym-kind old) 'typedef) old)
     ((eq? (sym-kind old) 'enum-const)
      (cond ((equal? (sym-slot old) (sym-slot new)) old)
            (else (die #f "enum-const redecl" (sym-name old)))))
     ((and (sym-defined? old) (sym-defined? new))
      (die #f "redefinition" (sym-name old)))
     ;; Linkage inherits from the first declaration (C 6.2.2 ¶4): if a
     ;; later decl/def of the same identifier doesn't carry a storage
     ;; class, it picks up the prior one. tcc.c relies on this with
     ;; `static T f(); ... T f() {…}` — the prior `static` makes both
     ;; the decl and the def internal-linkage. Without this carry-
     ;; through cc.scm split them across two label namespaces.
     ((sym-defined? new)
      (cond
        ((eq? (sym-storage old) 'static)
         (%sym (sym-name new) (sym-kind new) 'static
               (sym-type new) (sym-slot new) #t))
        (else new)))
     (else old)))
 
 (define (scope-bind! ps n s)
   (let* ((top (car (ps-scope ps)))
          (old (%hash-ref top n)))
     (cond
       ((not old)
        (%hash-set! top n s))
       (else
        (let ((merged (sym-merge old s)))
          (cond
            ((eq? merged old) #t)
            (else (%hash-set! top n merged))))))))
 (define (scope-lookup ps n)
   (let loop ((f (ps-scope ps)))
     (cond ((null? f) #f)
           (else
            (let ((v (%hash-ref (car f) n)))
              (if v v (loop (cdr f))))))))
 (define (scope-lookup-current ps n)
   (%hash-ref (car (ps-scope ps)) n))
 (define (tag-bind! ps n c)
   (%hash-set! (car (ps-tags ps)) n c))
 (define (tag-lookup ps n)
   (let loop ((f (ps-tags ps)))
     (cond ((null? f) #f)
           (else (let ((v (%hash-ref (car f) n)))
                   (if v v (loop (cdr f))))))))
 (define (typedef? ps n)
   (let ((sm (scope-lookup ps n)))
     (and sm (eq? (sym-kind sm) 'typedef))))
 
 (define (%mk-ptr p) (%ctype 'ptr %CC-WORD-BYTES %CC-WORD-BYTES p))
 (define (%mk-arr e n)
   (%ctype 'arr (if (< n 0) -1 (* n (ctype-size e)))
           (ctype-align e) (cons e n)))
 (define (%mk-fn r p v) (%ctype 'fn -1 -1 (list r p v)))
 (define (ctype-is-ptr? t) (eq? (ctype-kind t) 'ptr))
 (define (ctype-is-fn?  t) (eq? (ctype-kind t) 'fn))
 (define (ctype-is-arr? t) (eq? (ctype-kind t) 'arr))
 
 (define (eat-cv-quals! ps)
   (cond ((at-kw? ps '__attribute__)
          (skip-gnu-attribute! ps) (eat-cv-quals! ps))
         ((or (at-kw? ps 'const) (at-kw? ps 'volatile)
              (at-kw? ps 'restrict))
          (advance ps) (eat-cv-quals! ps))
         (else #t)))
 
 ;; Consume a GNU `__attribute__ (( ... ))` spec and discard. The keyword
 ;; has been peeked but not yet consumed. tcc.c's prototypes use these
 ;; for noreturn / format / aligned annotations that the bootstrap doesn't
 ;; need to honour semantically — same softening pattern as floats and
 ;; rejected-but-accepted type specifiers.
 (define (skip-gnu-attribute! ps)
   (advance ps)
   (expect-punct ps 'lparen)
   (let loop ((depth 1))
     (let ((t (peek ps)))
       (cond
         ((eq? (tok-kind t) 'EOF)
          (die (tok-loc t) "EOF in __attribute__"))
         ((and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) 'lparen))
          (advance ps) (loop (+ depth 1)))
         ((and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) 'rparen))
          (advance ps)
          (cond ((= depth 1) #t)
                (else (loop (- depth 1)))))
         (else (advance ps) (loop depth))))))
 
 (define (eat-gnu-attributes! ps)
   (cond ((at-kw? ps '__attribute__)
          (skip-gnu-attribute! ps) (eat-gnu-attributes! ps))
         (else #t)))
 
 ;; Parse the universally layout-neutral C11 alignment requests: zero (the
 ;; standard's no-effect spelling) and one/char alignment (which cannot weaken
 ;; any object's natural alignment).  cc.scm does not carry a pending alignment
 ;; specifier into its declarator layout, so accepting larger values could
 ;; silently under-align an object; reject them instead.
 (define (skip-c11-alignas! ps)
   (expect-kw ps '_Alignas)
   (expect-punct ps 'lparen)
   (cond
     ((%const-tok-is-decl? ps)
      (let*-values (((_sto bty) (parse-decl-spec ps))
                    ((_n ty) (parse-declarator ps bty)))
        (let ((al (ctype-align ty)))
          (cond ((<= al 0)
                 (die (tok-loc (peek ps)) "_Alignas of incomplete type"))
                ((> al 1)
                 (die (tok-loc (peek ps))
                      "_Alignas over-alignment unsupported" al))))))
     (else
      (let ((n (parse-const-int ps)))
        (cond ((or (< n 0) (> n 1))
               (die (tok-loc (peek ps))
                    "_Alignas over-alignment unsupported" n))))))
   (expect-punct ps 'rparen))
 
 (define (parse-decl-spec ps)
   (let loop ((sto #f) (sn #f) (lg 0) (b #f) (saw #f))
     (let ((t (peek ps)))
       (cond
         ((at-kw? ps '__attribute__)
          (skip-gnu-attribute! ps) (loop sto sn lg b saw))
         ((or (at-kw? ps 'auto) (at-kw? ps 'register))
          (advance ps) (loop sto sn lg b #t))
         ((at-kw? ps 'static)  (advance ps) (loop 'static sn lg b #t))
         ((at-kw? ps 'extern)  (advance ps) (loop 'extern sn lg b #t))
         ((at-kw? ps 'typedef) (advance ps) (loop 'typedef sn lg b #t))
         ((or (at-kw? ps 'const) (at-kw? ps 'volatile)
              (at-kw? ps 'restrict) (at-kw? ps 'inline)
              (at-kw? ps '_Noreturn))
          (advance ps) (loop sto sn lg b #t))
         ((at-kw? ps '_Alignas)
          (skip-c11-alignas! ps) (loop sto sn lg b #t))
         ((at-kw? ps 'signed)   (advance ps) (loop sto 'signed lg b #t))
         ((at-kw? ps 'unsigned) (advance ps) (loop sto 'unsigned lg b #t))
         ((at-kw? ps 'short) (advance ps) (loop sto sn -1 b #t))
         ((at-kw? ps 'long)  (advance ps) (loop sto sn (+ lg 1) b #t))
         ((at-kw? ps 'void) (advance ps) (loop sto sn lg 'void #t))
         ((at-kw? ps 'char) (advance ps) (loop sto sn lg 'char #t))
         ((at-kw? ps 'int)  (advance ps) (loop sto sn lg 'int #t))
         ((at-kw? ps '_Bool) (advance ps) (loop sto sn lg 'bool #t))
         ;; Floats: parsed as type specifiers so prototypes and struct
         ;; layouts in the flattened TU don't trip the parser. The cg
         ;; rejects fp loads/arith/casts at use, see %cg-fp-reject!.
         ;; _Complex / _Imaginary are eaten silently — tcc.c only mentions
         ;; them inside HAVE_FLOAT-gated paths.
         ((at-kw? ps 'float)  (advance ps) (loop sto sn lg 'float #t))
         ((at-kw? ps 'double) (advance ps) (loop sto sn lg 'double #t))
         ((or (at-kw? ps '_Complex) (at-kw? ps '_Imaginary))
          (advance ps) (loop sto sn lg b #t))
         ((or (at-kw? ps '_Atomic) (at-kw? ps '_Thread_local)
              (at-kw? ps '_Generic))
          (die (tok-loc t) "rejected" (tok-value t)))
         ((at-kw? ps 'struct)
          (loop sto sn lg (parse-aggregate-spec ps 'struct) #t))
         ((at-kw? ps 'union)
          (loop sto sn lg (parse-aggregate-spec ps 'union) #t))
         ((at-kw? ps 'enum)
          (loop sto sn lg (parse-enum-spec ps) #t))
         ;; __builtin_va_list — gcc/clang builtin type. We don't model
         ;; it as a struct; for our P1 ABI a va_list is just a char*
         ;; into the stack save area (cg-va-start/arg/end work over an
         ;; target-word slot). Letting __builtin_va_list mean `char *` here
         ;; lets a single header source — `typedef __builtin_va_list
         ;; va_list;` — compile cleanly under both cc.scm and stock
         ;; gcc/clang (where it's their native struct).
         ((and (not b) (eq? (tok-kind t) 'IDENT)
               (bv= (tok-value t) "__builtin_va_list"))
          (advance ps)
          (loop sto sn lg (%mk-ptr %t-i8) #t))
         ((and (not b) (eq? (tok-kind t) 'IDENT)
               (let ((sm (scope-lookup ps (tok-value t))))
                 (and sm (eq? (sym-kind sm) 'typedef))))
          (let* ((tk (advance ps)) (sm (scope-lookup ps (tok-value tk))))
            (loop sto sn lg (sym-type sm) #t)))
         (else
          (cond ((not saw) (die (tok-loc t) "expected decl-spec"
                                (tok-value t)))
                (else (values sto (resolve-base t sn lg b)))))))))
 
 (define (resolve-base loc sn lg b)
   (cond
     ((eq? b 'void)
      (if (or sn (not (zero? lg))) (die loc "void+qual") %t-void))
     ((eq? b 'bool)
      (if (or sn (not (zero? lg))) (die loc "bool+qual") %t-bool))
     ((eq? b 'char)
      (cond ((eq? sn 'unsigned) %t-u8) (else %t-i8)))
     ((or (eq? b 'int) (and (not b) (or sn (not (zero? lg)))))
      (cond ((= lg -1) (if (eq? sn 'unsigned) %t-u16 %t-i16))
            ((= lg 0)  (if (eq? sn 'unsigned) %t-u32 %t-i32))
            ((= lg 1)  (if (eq? sn 'unsigned) %t-word-u %t-word-i))
            (else      (if (eq? sn 'unsigned) %t-u64 %t-i64))))
     ((eq? b 'float)
      (if (or sn (not (zero? lg))) (die loc "float+qual") %t-flt))
     ((eq? b 'double)
      (cond (sn        (die loc "double+sign"))
            ((= lg 0)  %t-dbl)
            ((= lg 1)  %t-ldbl)
            (else      (die loc "double+long*" lg))))
     ((ctype? b)
      (if (or sn (not (zero? lg))) (die loc "type+qual") b))
     (else (die loc "unknown decl-spec"))))
 
 (define (parse-aggregate-spec ps kind)
   (advance ps)
   ;; GCC `__attribute__((...))` may sit between `struct/union` and
   ;; the tag/`{`. Eat and discard.
   (eat-gnu-attributes! ps)
   (let ((tag (pmatch (peek ps)
                (($ tok? (kind IDENT)) (tok-value (advance ps)))
                (else #f))))
     (eat-gnu-attributes! ps)
     (cond
       ((at-punct? ps 'lbrace)
        (advance ps)
        ;; A `struct/union TAG { ... }` declaration introduces (or
        ;; completes) the tag in the *current* scope. Looking up in
        ;; outer scopes via tag-lookup would let an inner-scope
        ;; definition mutate an outer-scope same-tag ctype via
        ;; complete-agg!. Restrict the reuse to the top frame, and
        ;; only when the existing tag is still incomplete (size < 0);
        ;; otherwise this is an attempted redefinition.
        (let* ((ex (and tag (%hash-ref (car (ps-tags ps)) tag)))
               (ct (cond ((and ex (eq? (ctype-kind ex) kind)
                                (< (ctype-size ex) 0)) ex)
                         ((and ex (eq? (ctype-kind ex) kind))
                          (die (tok-loc (peek ps)) "agg redefinition" tag))
                         (else (let ((c (%ctype kind -1 -1
                                               (list (or tag #f) #f '()))))
                                 (if tag (tag-bind! ps tag c)) c))))
               (fields (parse-struct-fields ps kind)))
          (expect-punct ps 'rbrace)
          (complete-agg! ct kind tag fields) ct))
       (tag (let ((ex (tag-lookup ps tag)))
              (cond (ex ex)
                    (else (let ((c (%ctype kind -1 -1
                                          (list tag #f '()))))
                            (tag-bind! ps tag c) c)))))
       (else (die (tok-loc (peek ps)) "anon agg")))))
 
 (define (parse-struct-fields ps kind)
   ;; For unions, every field stays at offset 0; complete-agg! takes the
   ;; max of field sizes for the union's overall size.
   (let ((struct? (eq? kind 'struct)))
     (let loop ((acc '()) (off 0))
       (cond
         ((at-punct? ps 'rbrace) (reverse acc))
         ((at-kw? ps '_Static_assert)
          (parse-static-assert! ps) (loop acc off))
         (else
          (let-values (((_sto bty) (parse-decl-spec ps)))
            (let dl ((acc2 acc) (o2 off))
              (let*-values (((nm ty) (parse-declarator ps bty)))
                (let* ((al (max (ctype-align ty) 1))
                       (sz (ctype-size ty))
                       (oa (if struct? (align-up o2 al) 0))
                       (next (if struct? (+ oa (max sz 0)) 0)))
                  (cond
                    ((at-punct? ps 'comma)
                     (advance ps)
                     (dl (cons (list nm ty oa) acc2) next))
                    ((at-punct? ps 'semi)
                     (advance ps)
                     (loop (cons (list nm ty oa) acc2) next))
                    (else (die (tok-loc (peek ps)) "field"))))))))))))
 
 (define (complete-agg! ct k tag fs)
   (let* ((ma (let m ((xs fs) (a 1))
                (if (null? xs) a
                    (m (cdr xs) (max a (ctype-align (cadr (car xs))))))))
          (last (let l ((xs fs) (e 0))
                  (if (null? xs) e
                      (let* ((f (car xs)) (off (car (cddr f)))
                             (sz (ctype-size (cadr f))))
                        (l (cdr xs) (max e (+ off (max sz 0))))))))
          (sz (cond ((eq? k 'union)
                     (let u ((xs fs) (s 0))
                       (if (null? xs) s
                           (u (cdr xs)
                              (max s (ctype-size (cadr (car xs))))))))
                    (else (align-up last ma)))))
     (ctype-size-set! ct sz)
     (ctype-align-set! ct ma)
     (ctype-ext-set! ct (list tag #t fs))))
 
 (define (parse-enum-spec ps)
   (advance ps)
   (let ((tag (pmatch (peek ps)
                (($ tok? (kind IDENT)) (tok-value (advance ps)))
                (else #f))))
     (cond
       ((at-punct? ps 'lbrace)
        (advance ps)
        ;; Parse all members first, then construct the enum ctype with
        ;; the final members list and tag-bind it. Members reference
        ;; earlier enum-consts via scope-lookup (not via the enum tag),
        ;; so deferring tag-bind! is safe.
        (let loop ((vs '()) (nv 0))
          (cond
            ((at-punct? ps 'rbrace)
             (advance ps)
             (let ((ct (%ctype 'enum 4 4 (list tag (reverse vs)))))
               (if tag (tag-bind! ps tag ct))
               ct))
            (else
             (let* ((nt (advance ps)) (nm (tok-value nt))
                    (val (cond ((at-punct? ps 'assign)
                                (advance ps) (parse-const-int ps))
                               (else nv))))
               (scope-bind! ps nm
                            (%sym nm 'enum-const #f %t-i32 val #t))
               (cond ((at-punct? ps 'comma) (advance ps))
                     ((at-punct? ps 'rbrace) #t)
                     (else (die (tok-loc (peek ps)) "enum")))
               (loop (cons (cons nm val) vs) (%c-value-add val 1)))))))
       (tag (let ((e (tag-lookup ps tag)))
              (cond (e e)
                    (else (let ((c (%ctype 'enum 4 4 (list tag '()))))
                            (tag-bind! ps tag c) c)))))
       (else (die (tok-loc (peek ps)) "enum")))))
 
 ;; ====================================================================
 ;; Integer constant expressions (C99 §6.6).
 ;;
 ;; parse-const-expr ps -> (value . ctype)
 ;;   A self-contained walker that never touches cg. The four call sites
 ;;   that demand an integer constant expression — array bounds, enum
 ;;   initializers, case labels, file-scope/static initializers — all go
 ;;   through here. Returns a (value . ctype) pair so a final cast can
 ;;   truncate at the target type's width (e.g. `(int)(unsigned char)257`
 ;;   needs the inner cast to mask off to u8 before the outer relabel).
 ;;
 ;; Operand surface: integer / character literals, enum constants,
 ;; sizeof(TYPENAME), unary + - ~ !, binary + - * / % << >> & | ^,
 ;; compare < <= > >= == !=, logical && || (short-circuit at the value
 ;; layer; both sides are still parsed so the token stream advances),
 ;; ternary ?:, cast to integer type, parenthesization. Anything else
 ;; dies. Floats / function calls / address-of / non-const idents / VLAs
 ;; are out of scope.
 ;; ====================================================================
 
 ;; Truncate VALUE to the width and signedness of CT. Integer types only
 ;; — pointer/array/etc. operands abort upstream.
 (define (%const-trunc value ct)
   (let* ((sz (ctype-size ct))
          (k  (ctype-kind ct)))
     (cond
       ;; bool: 0 or 1.
       ((eq? k 'bool) (if (%c-value-zero? value) 0 1))
       ((<= sz 0) 0)
       (else (%c-value-trunc value sz (not (%ctype-unsigned? ct)))))))
 
 ;; Usual arithmetic conversions on (value . ctype) pairs. Both operands
 ;; have already been integer-promoted (≤ int → int) by the caller.
 ;; Returns three values: truncated a, truncated b, and the shared result
 ;; ctype.
 (define (%const-arith-conv ap bp)
   (let* ((av (car ap)) (at (cdr ap))
          (bv (car bp)) (bt (cdr bp))
          (rt (%const-arith-conv-type at bt)))
     (values (%const-trunc av rt) (%const-trunc bv rt) rt)))
 
 (define (%const-arith-conv-type at bt)
   ;; Pick the wider type; tie-break on unsigned. Caller has already
   ;; promoted both to >= int width.
   (let ((sa (ctype-size at)) (sb (ctype-size bt)))
     (cond
       ((> sa sb) at)
       ((> sb sa) bt)
       ((%ctype-unsigned? at) at)
       ((%ctype-unsigned? bt) bt)
       (else at))))
 
 (define (%const-promote vp)
   ;; Integer promotion (C11 §6.3.1.1): types narrower than int
   ;; (i8/u8/i16/u16/bool) widen to (signed) int — every value of an
   ;; unsigned sub-int type fits in int on this target, so the promotion
   ;; rank picks signed int, not unsigned int. This matters for the
   ;; usual arithmetic conversions in cross-signedness comparisons,
   ;; e.g. ((unsigned char)-1 < (int)-1) must promote LHS to int 255
   ;; (not u32 0xff) so the result is 0, not 1.
   (let* ((v (car vp)) (ct (cdr vp))
          (sz (ctype-size ct)))
     (cond
       ((< sz 4) (cons (%const-trunc v %t-i32) %t-i32))
       (else vp))))
 
 (define (%const-bool? vp) (not (%c-value-zero? (car vp))))
 
 (define (parse-const-expr ps) (parse-const-cond ps))
 
 ;; Ternary (right-associative). Per C11 §6.6 ¶3 + §6.5.15/4 only the
 ;; chosen branch is evaluated; the other need not be a valid constant
 ;; expression (e.g. `1 ? 2 : 1/0` must yield 2, not abort). The dead
 ;; arm is skipped via %const-skip-cond-{mid,rhs}, like the &&/||
 ;; short-circuit paths above.
 (define (parse-const-cond ps)
   (let ((c (parse-const-lor ps)))
     (cond
       ((at-punct? ps 'qmark)
        (advance ps)
        (cond
          ((%const-bool? c)
           (let* ((t (parse-const-expr ps))
                  (_ (expect-punct ps 'colon)))
             (%const-skip-dead-arm ps)
             t))
          (else
           (%const-skip-dead-arm ps)
           (expect-punct ps 'colon)
           (parse-const-cond ps))))
       (else c))))
 
 ;; Generic top-level punct scanner used by skip-rhs / skip-cond helpers.
 ;; Walks paren/bracket depth (a closing bracket at d=0 always stops) and
 ;; optionally tracks ternary `?` depth. STOP? receives the punct value
 ;; v at top-level (d=0, q=0 when q-aware?) and returns #t to stop. With
 ;; Q-AWARE? = #t, a `?` at top-level opens a nested ternary and a
 ;; matching `:` (q>0) closes it; the scanner stops on `:` only when q=0.
 (define (%punct-scan ps stop? q-aware?)
   (let lp ((d 0) (q 0))
     (let ((t (peek ps)))
       (cond
         ((eq? (tok-kind t) 'EOF) #t)
         ((not (eq? (tok-kind t) 'PUNCT))
          (advance ps) (lp d q))
         (else
          (let ((v (tok-value t)))
            (cond
              ((or (eq? v 'lparen) (eq? v 'lbrack))
               (advance ps) (lp (+ d 1) q))
              ((or (eq? v 'rparen) (eq? v 'rbrack))
               (cond ((zero? d) #t)
                     (else (advance ps) (lp (- d 1) q))))
              ((and q-aware? (zero? d) (eq? v 'qmark))
               (advance ps) (lp d (+ q 1)))
              ((and q-aware? (zero? d) (> q 0) (eq? v 'colon))
               (advance ps) (lp d (- q 1)))
              ((and (zero? d) (or (not q-aware?) (zero? q)) (stop? v))
               #t)
              (else (advance ps) (lp d q)))))))))
 
 ;; Skip the dead arm of a ternary. Same scanner whether we're skipping
 ;; the middle (cond was false; will then expect-punct `:` and parse arm
 ;; 3) or the third (cond was true; arm 2 already parsed and `:` already
 ;; consumed). Both stop at top-level `:` / `,` / `;` / `}` with no
 ;; open inner `?`; nested `?:` pairs are absorbed.
 (define (%const-skip-dead-arm ps)
   (%punct-scan ps
     (lambda (v)
       (or (eq? v 'colon) (eq? v 'comma) (eq? v 'semi) (eq? v 'rbrace)))
     #t))
 
 ;; Generic left-associative binary level.
 ;; ops: alist of punct-sym → (vp vp → vp).
 (define (%const-binl ps next ops)
   (let lp ((a (next ps)))
     (let* ((t (peek ps))
            (hit (and (eq? (tok-kind t) 'PUNCT)
                      (alist-ref/eq (tok-value t) ops))))
       (cond ((not hit) a)
             (else (advance ps) (lp (hit a (next ps))))))))
 
 ;; Arithmetic combiner: promote both, arith-conv, apply op, truncate.
 (define (%const-arith-op op a b)
   (let-values (((av bv rt) (%const-arith-conv (%const-promote a) (%const-promote b))))
     (cons (%const-trunc
             (cond ((eq? op 'add) (%c-value-add av bv))
                   ((eq? op 'sub) (%c-value-sub av bv))
                   ((eq? op 'mul) (%c-value-mul av bv))
                   ((eq? op 'and) (%c-value-and av bv))
                   ((eq? op 'or)  (%c-value-or av bv))
                   ((eq? op 'xor) (%c-value-xor av bv))
                   (else (die #f "const-expr: bad arithmetic op" op)))
             rt)
           rt)))
 
 ;; Like %const-arith-op but rejects a zero divisor.
 (define (%const-div-op want-rem? a b)
   (let-values (((av bv rt) (%const-arith-conv (%const-promote a) (%const-promote b))))
     (cond ((%c-value-zero? bv) (die #f "const-expr: divide by zero")))
     (let ((qr (%c-value-divmod av bv (ctype-size rt) (%ctype-unsigned? rt))))
       (cons (%const-trunc (if want-rem? (cdr qr) (car qr)) rt) rt))))
 
 ;; Comparison combiner: result is always (0-or-1 . %t-i32).
 (define (%const-cmp-op op a b)
   (let-values (((av bv rt) (%const-arith-conv (%const-promote a) (%const-promote b))))
     (let ((c (%c-value-cmp av bv (ctype-size rt) (%ctype-unsigned? rt))))
       (cons
         (if (cond ((eq? op 'eq) (= c 0))
                   ((eq? op 'ne) (not (= c 0)))
                   ((eq? op 'lt) (< c 0))
                   ((eq? op 'le) (<= c 0))
                   ((eq? op 'gt) (> c 0))
                   ((eq? op 'ge) (>= c 0))
                   (else (die #f "const-expr: bad comparison op" op)))
             1 0)
         %t-i32))))
 
 ;; Short-circuit per C11 §6.5.13/14 ¶4: rhs is not evaluated when the
 ;; lhs determines the result. Required so `1 || (1/0)` and
 ;; `0 && (1/0)` yield 1/0 rather than aborting on divide-by-zero.
 (define (parse-const-lor ps)
   (let lp ((a (parse-const-land ps)))
     (cond
       ((at-punct? ps 'lor)
        (advance ps)
        (cond
          ((%const-bool? a)
           (%const-skip-lor-rhs ps)
           (lp (cons 1 %t-i32)))
          (else
           (let ((b (parse-const-land ps)))
             (lp (cons (if (%const-bool? b) 1 0) %t-i32))))))
       (else a))))
 
 (define (parse-const-land ps)
   (let lp ((a (parse-const-bor ps)))
     (cond
       ((at-punct? ps 'land)
        (advance ps)
        (cond
          ((not (%const-bool? a))
           (%const-skip-land-rhs ps)
           (lp (cons 0 %t-i32)))
          (else
           (let ((b (parse-const-bor ps)))
             (lp (cons (if (%const-bool? b) 1 0) %t-i32))))))
       (else a))))
 
 ;; Skip the rhs of a short-circuited && / ||. The rhs grammar is
 ;; the operand level of the operator: parse-const-bor for &&,
 ;; parse-const-land for ||. We can't just call those parsers because
 ;; the rhs may itself be invalid as a constant expression (e.g.
 ;; `1/0`); instead, scan tokens at paren/brack depth 0 until we hit
 ;; another operator at the same-or-lower binding level, comma,
 ;; semicolon, colon, qmark, rbrace, rbrack, rparen, or EOF.
 (define (%const-skip-land-rhs ps)
   ;; rhs of && is a parse-const-bor — stop on `&&`, `||`, `?`, `:`,
   ;; `,`, `;`, `}`, and any closing/separator at depth 0.
   (%punct-scan ps
     (lambda (v)
       (or (eq? v 'land) (eq? v 'lor) (eq? v 'qmark) (eq? v 'colon)
           (eq? v 'comma) (eq? v 'semi) (eq? v 'rbrace)))
     #f))
 (define (%const-skip-lor-rhs ps)
   ;; rhs of || is a parse-const-land — stop on `||` (left-assoc),
   ;; `?`, `:`, `,`, `;`, `}`. `&&` binds TIGHTER than `||`, so it is
   ;; absorbed into the rhs and we do NOT stop on it.
   (%punct-scan ps
     (lambda (v)
       (or (eq? v 'lor) (eq? v 'qmark) (eq? v 'colon)
           (eq? v 'comma) (eq? v 'semi) (eq? v 'rbrace)))
     #f))
 
 (define (parse-const-bor ps)
   (%const-binl ps parse-const-bxor (list (cons 'bar   (lambda (a b) (%const-arith-op 'or  a b))))))
 (define (parse-const-bxor ps)
   (%const-binl ps parse-const-band (list (cons 'caret (lambda (a b) (%const-arith-op 'xor a b))))))
 (define (parse-const-band ps)
   (%const-binl ps parse-const-eq   (list (cons 'amp   (lambda (a b) (%const-arith-op 'and a b))))))
 
 (define (parse-const-eq ps)
   (%const-binl ps parse-const-rel
     (list (cons 'eq2 (lambda (a b) (%const-cmp-op 'eq a b)))
           (cons 'ne  (lambda (a b) (%const-cmp-op 'ne a b))))))
 
 (define (parse-const-rel ps)
   (%const-binl ps parse-const-shift
     (list (cons 'lt (lambda (a b) (%const-cmp-op 'lt a b)))
           (cons 'le (lambda (a b) (%const-cmp-op 'le a b)))
           (cons 'gt (lambda (a b) (%const-cmp-op 'gt a b)))
           (cons 'ge (lambda (a b) (%const-cmp-op 'ge a b))))))
 
 ;; Shift combiner: result type is the (promoted) lhs type — rhs is
 ;; just a count, promoted independently. SIGN selects shl (+1) or shr (-1).
 (define (%const-shift-op sign a b)
   (let* ((ap (%const-promote a))
          (bp (%const-promote b))
          (rt (cdr ap))
          (count (%c-value->fixnum (car bp) "const-expr shift")))
     (cons (%const-trunc
             (%c-value-shift (car ap) (* (- 0 sign) count)
                             (and (= sign -1) (not (%ctype-unsigned? rt))))
             rt)
           rt)))
 
 (define (parse-const-shift ps)
   (%const-binl ps parse-const-add
     (list (cons 'shl (lambda (a b) (%const-shift-op  1 a b)))
           (cons 'shr (lambda (a b) (%const-shift-op -1 a b))))))
 
 (define (parse-const-add ps)
   (%const-binl ps parse-const-mul
     (list (cons 'plus  (lambda (a b) (%const-arith-op 'add a b)))
           (cons 'minus (lambda (a b) (%const-arith-op 'sub a b))))))
 
 (define (parse-const-mul ps)
   (%const-binl ps parse-const-cast
     (list (cons 'star  (lambda (a b) (%const-arith-op 'mul a b)))
           (cons 'slash (lambda (a b) (%const-div-op #f a b)))
           (cons 'pct   (lambda (a b) (%const-div-op #t a b))))))
 
 (define (parse-const-cast ps)
   ;; (typename) operand — distinguished from ( expr ) by paren-is-group?.
   ;; Pointer casts are accepted only as a type re-tag — the integer
   ;; offset rides through unchanged. This is what the offsetof idiom
   ;; `(T *)0` and the outer `(size_t) <ptr-const>` need; we do not
   ;; admit general pointer arithmetic in const-expr.
   (cond
     ((at-punct? ps 'lparen)
      (cond
        ((%const-paren-is-cast? ps)
         (advance ps)
         (let*-values (((_sto bty) (parse-decl-spec ps))
                       ((_n   ty)  (parse-declarator ps bty)))
           (expect-punct ps 'rparen)
           (cond
             ((%ctype-int? ty)
              (let ((v (parse-const-cast ps)))
                (cons (%const-trunc (car v) ty) ty)))
             ((eq? (ctype-kind ty) 'ptr)
              (let ((v (parse-const-cast ps)))
                (cons (car v) ty)))
             (else
              (die (tok-loc (peek ps))
                   "const-expr: cast must be integer or pointer"
                   (ctype-kind ty))))))
        (else (parse-const-unary ps))))
     (else (parse-const-unary ps))))
 
 (define (%const-paren-is-cast? ps)
   ;; A '(' starts a cast iff the following token kicks off a type-name.
   (%tok-decl-start? ps (peek2 ps)))
 
 (define (%ctype-int? ty)
   (let ((k (ctype-kind ty)))
     (or (eq? k 'i8) (eq? k 'u8) (eq? k 'i16) (eq? k 'u16)
         (eq? k 'i32) (eq? k 'u32) (eq? k 'i64) (eq? k 'u64)
         (eq? k 'bool) (eq? k 'enum))))
 
 (define (parse-const-unary ps)
   (let ((t (peek ps)))
     (pmatch t
       (($ tok? (kind PUNCT) (value plus))
        (advance ps) (%const-promote (parse-const-cast ps)))
       (($ tok? (kind PUNCT) (value minus))
        (advance ps)
        (let* ((vp (%const-promote (parse-const-cast ps)))
               (rt (cdr vp)))
          (cons (%const-trunc (%c-value-negate (car vp)) rt) rt)))
       (($ tok? (kind PUNCT) (value tilde))
        (advance ps)
        (let* ((vp (%const-promote (parse-const-cast ps)))
               (rt (cdr vp)))
          (cons (%const-trunc (%c-value-not (car vp)) rt) rt)))
       (($ tok? (kind PUNCT) (value bang))
        (advance ps)
        (let ((vp (parse-const-cast ps)))
          (cons (if (%const-bool? vp) 0 1) %t-i32)))
       (($ tok? (kind PUNCT) (value amp))
        ;; Address-of in const-expr context. Restricted to the offsetof
        ;; idiom: a null-pointer-typed base reached via (T *)0 (with
        ;; optional grouping/deref) followed by ->/. field selectors.
        ;; The integer value is the running byte offset; '&' wraps the
        ;; designator's type in a pointer for any outer integer cast to
        ;; consume.
        (advance ps)
        (let* ((dp (%const-parse-addrof-postfix ps)))
          (cons (car dp) (%mk-ptr (cdr dp)))))
       (($ tok? (kind KW) (value sizeof))
        (advance ps)
        (cond
          ((at-punct? ps 'lparen)
           (advance ps)
           (cond
             ((%const-tok-is-decl? ps)
              (let*-values (((_sto bty) (parse-decl-spec ps))
                            ((_n   ty)  (parse-declarator ps bty)))
                (expect-punct ps 'rparen)
                (cons (max (ctype-size ty) 0) %t-word-u)))
             (else
              ;; sizeof(EXPR) in const-expr context. Operand is not
              ;; evaluated (C11 §6.5.3.4) — snapshot the cg, parse the
              ;; expr through the regular parser to recover its ctype,
              ;; then rewind to discard any emission/vstack pushes.
              (cons (%const-sizeof-expr ps #t) %t-word-u))))
          (else
           ;; `sizeof EXPR` (no parens). Same no-eval rule.
           (cons (%const-sizeof-expr ps #f) %t-word-u))))
       (($ tok? (kind KW) (value _Alignof))
        (advance ps)
        (expect-punct ps 'lparen)
        (cond
          ((%const-tok-is-decl? ps)
           (let*-values (((_sto bty) (parse-decl-spec ps))
                         ((_n ty) (parse-declarator ps bty)))
             (expect-punct ps 'rparen)
             (cons (max (ctype-align ty) 1) %t-word-u)))
          (else
           (cons (%const-alignof-expr ps) %t-word-u))))
       (else (parse-const-primary ps)))))
 
 ;; Does TOK begin a type-name? Type specifiers, qualifiers,
 ;; struct/union/enum tags, and typedef-name idents. Storage classes
 ;; (auto/register/static/extern/typedef) are NOT included — those
 ;; appear only at declaration position; callers that need them
 ;; (e.g. stmt-starts-decl?) check separately.
 (define (%tok-decl-start? ps t)
   (pmatch t
     (($ tok? (kind KW) (value ,v))
      (or (eq? v 'void) (eq? v 'char) (eq? v 'short) (eq? v 'int)
          (eq? v 'long) (eq? v 'signed) (eq? v 'unsigned)
          (eq? v '_Bool) (eq? v 'float) (eq? v 'double)
          (eq? v '_Complex) (eq? v '_Imaginary)
          (eq? v 'struct) (eq? v 'union) (eq? v 'enum)
          (eq? v 'const) (eq? v 'volatile) (eq? v 'restrict)
          (eq? v 'inline) (eq? v '_Noreturn)))
     (($ tok? (kind IDENT) (value ,n)) (typedef? ps n))
     (else #f)))
 
 (define (%const-tok-is-decl? ps) (%tok-decl-start? ps (peek ps)))
 
 (define (%const-offsetof-field ps ty offset)
   (let ((nt (advance ps)))
     (cond ((not (eq? (tok-kind nt) 'IDENT))
            (die (tok-loc nt) "__builtin_offsetof expects a member")))
     (let ((f (%cg-find-field (%init-struct-fields ty) (tok-value nt))))
       (cond ((not f)
              (die (tok-loc nt) "__builtin_offsetof: no such member"
                   (tok-value nt))))
       (cons (+ offset (car (cddr f))) (car (cdr f))))))
 
 (define (%const-builtin-offsetof ps)
   ;; `__builtin_offsetof(T, member[const].nested)` is an integer constant.
   ;; Reuse the aggregate field metadata and array element sizes already used by
   ;; normal designators; no pointer expression or code generation is needed.
   (expect-punct ps 'lparen)
   (let*-values (((_sto bty) (parse-decl-spec ps))
                 ((_n ty) (parse-declarator ps bty)))
     (expect-punct ps 'comma)
     (let lp ((p (%const-offsetof-field ps ty 0)))
       (pmatch (peek ps)
         (($ tok? (kind PUNCT) (value dot))
          (advance ps) (lp (%const-offsetof-field ps (cdr p) (car p))))
         (($ tok? (kind PUNCT) (value lbrack))
          (advance ps)
          (let* ((index (parse-const-int ps))
                 (_ (expect-punct ps 'rbrack))
                 (aty (cdr p)))
            (cond ((not (eq? (ctype-kind aty) 'arr))
                   (die (tok-loc (peek ps))
                        "__builtin_offsetof: subscript on non-array")))
            (let ((elem (car (ctype-ext aty))))
              (lp (cons (+ (car p) (* index (ctype-size elem))) elem)))))
         (else
          (expect-punct ps 'rparen)
          (cons (car p) %t-word-u))))))
 
 (define (parse-const-primary ps)
   (let ((t (peek ps)))
     (pmatch t
       (($ tok? (kind INT) (value ,v))
        (advance ps)
        (cons (%c-int-raw v) (%c-int-type v)))
       (($ tok? (kind CHAR) (value ,v))
        (advance ps)
        ;; Character constants have type int in C.
        (cons v %t-i32))
       (($ tok? (kind PUNCT) (value lparen))
        (advance ps)
        (let ((v (parse-const-expr ps)))
          (expect-punct ps 'rparen) v))
       (($ tok? (kind IDENT) (value ,n))
        (cond
          ((bv= n "__builtin_offsetof")
           (advance ps) (%const-builtin-offsetof ps))
          (else
           (let ((sm (scope-lookup ps n)))
             (cond ((and sm (eq? (sym-kind sm) 'enum-const))
                    (advance ps) (cons (sym-slot sm) %t-i32))
                   (else
                    (die (tok-loc t) "const-expr: not a constant" n)))))))
       (else (die (tok-loc t) "const-expr: bad operand"
                  (tok-value t))))))
 
 ;; ====================================================================
 ;; offsetof support inside const-expr.
 ;;
 ;; Recognises `&((T *)0)->FIELD`, `&(*(T *)0).FIELD`, and chains thereof
 ;; — the only address-of idioms that show up in static initializers
 ;; (tcc.c options_W[] / options_f[] / options_m[] tables, and any
 ;; offsetof macro expansion of the same shape). Each helper threads a
 ;; (offset . ctype) pair: integer byte offset of the running designator
 ;; from the null base, plus the lvalue's ctype. Field lookup reuses
 ;; %cg-find-field, so anonymous union/struct members work the same way
 ;; as in regular field access.
 ;; ====================================================================
 
 (define (%const-parse-addrof-postfix ps)
   ;; postfix: primary ( -> FIELD | . FIELD )*
   (let lp ((p (%const-parse-addrof-primary ps)))
     (pmatch (peek ps)
       (($ tok? (kind PUNCT) (value arrow))
        (advance ps) (lp (%const-addrof-arrow ps p)))
       (($ tok? (kind PUNCT) (value dot))
        (advance ps) (lp (%const-addrof-dot ps p)))
       (else p))))
 
 (define (%const-parse-addrof-primary ps)
   ;; primary: ( T )expr   ; pointer cast — the offsetof base
   ;;        | ( postfix ) ; grouping
   ;;        | * primary   ; deref
   (cond
     ((at-punct? ps 'lparen)
      (cond
        ((%const-paren-is-cast? ps)
         (let ((cv (parse-const-cast ps)))
           (cond
             ((not (eq? (ctype-kind (cdr cv)) 'ptr))
              (die #f "const-expr: addr-of: head must be a pointer cast"
                   (ctype-kind (cdr cv)))))
           cv))
        (else
         (advance ps)
         (let ((r (%const-parse-addrof-postfix ps)))
           (expect-punct ps 'rparen) r))))
     ((at-punct? ps 'star)
      (advance ps)
      (let ((h (%const-parse-addrof-primary ps)))
        (cond
          ((not (eq? (ctype-kind (cdr h)) 'ptr))
           (die #f "const-expr: addr-of: '*' on non-pointer"
                (ctype-kind (cdr h)))))
        (cons (car h) (ctype-ext (cdr h)))))
     (else
      (die (tok-loc (peek ps)) "const-expr: addr-of: unexpected token"
           (tok-value (peek ps))))))
 
 (define (%const-addrof-arrow ps p)
   (let* ((off (car p)) (ty (cdr p)))
     (cond ((not (eq? (ctype-kind ty) 'ptr))
            (die (tok-loc (peek ps)) "const-expr: -> on non-pointer"
                 (ctype-kind ty))))
     (let* ((sty (ctype-ext ty)) (sk (ctype-kind sty)))
       (cond ((not (or (eq? sk 'struct) (eq? sk 'union)))
              (die (tok-loc (peek ps))
                   "const-expr: -> target not aggregate" sk)))
       (%const-addrof-field ps sty off))))
 
 (define (%const-addrof-dot ps p)
   (let* ((off (car p)) (ty (cdr p)) (k (ctype-kind ty)))
     (cond ((not (or (eq? k 'struct) (eq? k 'union)))
            (die (tok-loc (peek ps))
                 "const-expr: . on non-aggregate" k)))
     (%const-addrof-field ps ty off)))
 
 (define (%const-addrof-field ps sty base-off)
   (let ((nt (peek ps)))
     (cond ((not (eq? (tok-kind nt) 'IDENT))
            (die (tok-loc nt)
                 "const-expr: field selector needs an identifier"
                 (tok-value nt))))
     (advance ps)
     (let* ((fields (car (cddr (ctype-ext sty))))
            (f (%cg-find-field fields (tok-value nt))))
       (cond ((not f) (die (tok-loc nt)
                           "const-expr: no such field"
                           (tok-value nt))))
       (cons (+ base-off (car (cddr f))) (cadr f)))))
 
 ;; sizeof EXPR / sizeof(EXPR) in const-expr context. Delegates to the
 ;; regular expression parser under a cg snapshot/rewind — same contract
 ;; as parse-unary's sizeof: the operand is parsed to learn its type but
 ;; not evaluated, so any emission or vstack push from the parse is
 ;; discarded. Returns the operand's byte size as a non-negative int.
 ;; If `paren?`, consumes the closing `)` after parsing.
 (define (%const-unevaluated-primary-type ps)
   ;; File-scope sizeof/_Alignof has no active function buffer to snapshot.
   ;; Cover the ordinary unevaluated-designator grammar directly so static
   ;; initializers such as `sizeof table / sizeof table[0]` remain constant
   ;; expressions without inventing a synthetic function.
   (let ((t (peek ps)))
     (pmatch t
       (($ tok? (kind IDENT) (value ,n))
        (let ((sm (scope-lookup ps n)))
          (cond ((not sm) (die (tok-loc t) "unevaluated: undecl" n)))
          (advance ps)
          (sym-type sm)))
       (($ tok? (kind INT) (value ,v))
        (advance ps) (%c-int-type v))
       (($ tok? (kind CHAR)) (advance ps) %t-i32)
       (($ tok? (kind STR) (value ,v))
        (advance ps) (%mk-arr %t-i8 (+ (bytevector-length v) 1)))
       (($ tok? (kind PUNCT) (value lparen))
        (cond
          ((%const-paren-is-cast? ps)
           ;; In an unevaluated operand the cast expression still has to be
           ;; consumed, but only its result type matters.  This covers the
           ;; standard `sizeof(((T *)0)->field)` spelling without asking for an
           ;; active function/codegen buffer at file scope.
           (advance ps)
           (let*-values (((_sto bty) (parse-decl-spec ps))
                         ((_n ty) (parse-declarator ps bty)))
             (expect-punct ps 'rparen)
             (%const-unevaluated-unary-type ps)
             ty))
          (else
           (advance ps)
           (let ((ty (%const-unevaluated-unary-type ps)))
             (expect-punct ps 'rparen)
             ty))))
       (else (die (tok-loc t) "unevaluated: unsupported operand"
                  (tok-value t))))))
 
 (define (%const-unevaluated-postfix-type ps)
   (let lp ((ty (%const-unevaluated-primary-type ps)))
     (pmatch (peek ps)
       (($ tok? (kind PUNCT) (value lbrack))
        (advance ps)
        ;; The index is itself unevaluated by sizeof, but parsing it as a
        ;; constant keeps token consumption deterministic for the bootstrap
        ;; subset (array tables conventionally use [0]).
        (parse-const-int ps)
        (expect-punct ps 'rbrack)
        (let ((k (ctype-kind ty)))
          (cond ((eq? k 'arr) (lp (car (ctype-ext ty))))
                ((eq? k 'ptr) (lp (ctype-ext ty)))
                (else (die #f "unevaluated: subscript on non-array" k)))))
       (($ tok? (kind PUNCT) (value dot))
        (advance ps)
        (let ((nt (peek ps)))
          (cond ((not (eq? (tok-kind nt) 'IDENT))
                 (die (tok-loc nt) "unevaluated: field")))
          (advance ps)
          (let ((f (%cg-find-field (car (cddr (ctype-ext ty)))
                                   (tok-value nt))))
            (cond ((not f) (die (tok-loc nt) "unevaluated: no field"
                                (tok-value nt))))
            (lp (cadr f)))))
       (($ tok? (kind PUNCT) (value arrow))
        (advance ps)
        (cond ((not (eq? (ctype-kind ty) 'ptr))
               (die #f "unevaluated: arrow on non-pointer")))
        (let* ((sty (ctype-ext ty)) (nt (peek ps)))
          (cond ((not (eq? (tok-kind nt) 'IDENT))
                 (die (tok-loc nt) "unevaluated: field")))
          (advance ps)
          (let ((f (%cg-find-field (car (cddr (ctype-ext sty)))
                                   (tok-value nt))))
            (cond ((not f) (die (tok-loc nt) "unevaluated: no field"
                                (tok-value nt))))
            (lp (cadr f)))))
       (else ty))))
 
 (define (%const-unevaluated-unary-type ps)
   (pmatch (peek ps)
     (($ tok? (kind PUNCT) (value amp))
      (advance ps) (%mk-ptr (%const-unevaluated-unary-type ps)))
     (($ tok? (kind PUNCT) (value star))
      (advance ps)
      (let ((ty (%const-unevaluated-unary-type ps)))
        (cond ((not (eq? (ctype-kind ty) 'ptr))
               (die #f "unevaluated: dereference of non-pointer")))
        (ctype-ext ty)))
     (($ tok? (kind PUNCT) (value plus))
      (advance ps)
      (cdr (%const-promote (cons 0 (%const-unevaluated-unary-type ps)))))
     (($ tok? (kind PUNCT) (value minus))
      (advance ps)
      (cdr (%const-promote (cons 0 (%const-unevaluated-unary-type ps)))))
     (($ tok? (kind PUNCT) (value tilde))
      (advance ps)
      (cdr (%const-promote (cons 0 (%const-unevaluated-unary-type ps)))))
     (($ tok? (kind PUNCT) (value bang))
      (advance ps) (%const-unevaluated-unary-type ps) %t-i32)
     (else (%const-unevaluated-postfix-type ps))))
 
 (define (%const-sizeof-expr ps paren?)
   (cond
     ((not (ps-cg ps))
      (die #f "#if: sizeof of expression not valid in preprocessor context"))
     ((cg-in-fn? (ps-cg ps))
      (let ((tag (cg-snapshot (ps-cg ps))))
        (cond (paren? (parse-expr ps) (expect-punct ps 'rparen))
              (else  (parse-unary ps)))
        (let* ((tp (cg-top (ps-cg ps)))
               (sz (max (ctype-size (opnd-type tp)) 0)))
          (cg-rewind (ps-cg ps) tag)
          sz)))
     (else
      (let ((ty (%const-unevaluated-unary-type ps)))
        (cond (paren? (expect-punct ps 'rparen)))
        (max (ctype-size ty) 0)))))
 
 (define (%const-alignof-expr ps)
   (cond
     ((not (ps-cg ps))
      (die #f "#if: _Alignof of expression not valid in preprocessor context"))
     ((not (cg-in-fn? (ps-cg ps)))
      (let ((ty (%const-unevaluated-unary-type ps)))
        (expect-punct ps 'rparen)
        (max (ctype-align ty) 1)))
     (else
      (let ((tag (cg-snapshot (ps-cg ps))))
        (parse-expr ps)
        (expect-punct ps 'rparen)
        (let* ((tp (cg-top (ps-cg ps)))
               (al (max (ctype-align (opnd-type tp)) 1)))
          (cg-rewind (ps-cg ps) tag)
          al)))))
 
 ;; Convenience: returns the integer value alone (callers that don't
 ;; need the type half of parse-const-expr's (value . ctype) result).
 (define (parse-const-int ps) (car (parse-const-expr ps)))
 
 (define (parse-declarator ps base)
   ;; Returns (values name type).
   ((cdr (parse-decl-cont ps)) base
    (lambda (n t) (values n t))))
 
 (define (parse-decl-cont ps)
   (pmatch (peek ps)
     (($ tok? (kind KW) (value __attribute__))
      (skip-gnu-attribute! ps) (parse-decl-cont ps))
     (($ tok? (kind PUNCT) (value star))
      (advance ps) (eat-cv-quals! ps)
      (let* ((r (parse-decl-cont ps)) (rf (cdr r)))
        (cons (car r) (lambda (b k) (rf (%mk-ptr b) k)))))
     (($ tok? (kind PUNCT) (value lparen))
      (guard (paren-is-group? ps))
      (advance ps)
      (let* ((i (parse-decl-cont ps)) (if- (cdr i)))
        (expect-punct ps 'rparen)
        (let ((s (parse-decl-suf-cont ps)))
          (cons (car i) (lambda (b k) (if- (s b) k))))))
     (($ tok? (kind IDENT) (value ,n))
      (advance ps)
      (let ((s (parse-decl-suf-cont ps)))
        (cons n (lambda (b k) (k n (s b))))))
     (else
      (let ((s (parse-decl-suf-cont ps)))
        (cons #f (lambda (b k) (k #f (s b))))))))
 
 (define (parse-decl-suf-cont ps)
   ;; C declarator suffixes apply RIGHT-TO-LEFT (innermost first):
   ;;   int a[2][3]  ⇒  arr (arr int 3) 2     (outer dim 2)
   ;; not arr (arr int 2) 3 (which would treat the leftmost suffix as
   ;; outermost). The recursive structure builds the inner suffix's
   ;; result first, then this level wraps.
   (pmatch (peek ps)
     (($ tok? (kind PUNCT) (value lbrack))
      (advance ps)
      ;; C99 §6.7.5.2 allows `static`, type qualifiers (const /
      ;; volatile / restrict), and `*` (variable length array
      ;; placeholder) inside array-of-T brackets in function
      ;; parameter declarators. We don't honour the qualifier
      ;; semantics — just consume them so the dimension expression
      ;; that follows parses.
      (let lp ()
        (cond
          ((or (at-kw? ps 'const) (at-kw? ps 'volatile)
               (at-kw? ps 'restrict) (at-kw? ps 'static))
           (advance ps) (lp))
          (else #t)))
      (let* ((ln (cond ((at-punct? ps 'rbrack) -1)
                       ((at-punct? ps 'star) (advance ps) -1)
                       (else (parse-const-int ps))))
             (_ (expect-punct ps 'rbrack))
             (r (parse-decl-suf-cont ps)))
        (lambda (b) (%mk-arr (r b) ln))))
     (($ tok? (kind PUNCT) (value lparen))
      (advance ps)
      (let-values (((p v) (parse-fn-params ps)))
        (expect-punct ps 'rparen)
        (let ((r (parse-decl-suf-cont ps)))
          (lambda (b) (%mk-fn (r b) p v)))))
     (($ tok? (kind KW) (value __attribute__))
      (skip-gnu-attribute! ps) (parse-decl-suf-cont ps))
     (else (lambda (b) b))))
 
 (define (paren-is-group? ps)
   (pmatch (peek2 ps)
     (($ tok? (kind KW) (value ,v))
      (cond ((or (eq? v 'void) (eq? v 'char) (eq? v 'short)
                 (eq? v 'int) (eq? v 'long) (eq? v 'signed)
                 (eq? v 'unsigned) (eq? v '_Bool)
                 (eq? v 'float) (eq? v 'double)
                 (eq? v '_Complex) (eq? v '_Imaginary)
                 (eq? v 'struct) (eq? v 'union) (eq? v 'enum)
                 (eq? v 'const) (eq? v 'volatile)
                 (eq? v 'restrict) (eq? v 'static)
                 (eq? v 'extern) (eq? v 'register)) #f)
            (else #t)))
     (($ tok? (kind IDENT) (value ,n))
      (cond ((typedef? ps n) #f) (else #t)))
     (($ tok? (kind PUNCT) (value rparen)) #f)
     (($ tok? (kind PUNCT) (value star))   #t)
     (($ tok? (kind PUNCT) (value lparen)) #t)
     (($ tok? (kind PUNCT) (value lbrack)) #t)
     (else #f)))
 
 (define (parse-fn-params ps)
   ;; Returns (values params variadic?).
   (cond
     ((at-punct? ps 'rparen) (values '() #f))
     ((and (at-kw? ps 'void)
           (eq? (tok-kind (peek2 ps)) 'PUNCT)
           (eq? (tok-value (peek2 ps)) 'rparen))
      (advance ps) (values '() #f))
     (else
      (let loop ((acc '()))
        (cond
          ((at-punct? ps 'ellipsis)
           (advance ps) (values (reverse acc) #t))
          (else
           (let*-values (((_sto bty) (parse-decl-spec ps))
                         ((nm   ty)  (parse-declarator ps bty)))
             (let ((ty2 (cond ((ctype-is-arr? ty)
                               (%mk-ptr (car (ctype-ext ty))))
                              ((ctype-is-fn? ty) (%mk-ptr ty))
                              (else ty))))
               (cond
                 ((at-punct? ps 'comma)
                  (advance ps) (loop (cons (cons nm ty2) acc)))
                 ((at-punct? ps 'rparen)
                  (values (reverse (cons (cons nm ty2) acc)) #f))
                 (else (die (tok-loc (peek ps)) "param")))))))))))
 
 (define (parse-translation-unit ps)
   (let loop ()
     (cond
       ((eq? (tok-kind (peek ps)) 'EOF) #t)
       (else
        (cond
          ((debug-log?)
           (let ((loc (tok-loc (peek ps))))
             (debug-log "decl" "line" (loc-line loc)
                        "heap" (heap-usage)))))
        (cond ((at-kw? ps '_Static_assert) (parse-static-assert! ps))
              (else (parse-decl-or-fn ps)))
        ;; Function-local metadata is not part of the persistent world.
        (cg-fn-meta-set! (ps-cg ps) '())
        (loop)))))
 
 (define (parse-static-assert! ps)
   (let ((loc (tok-loc (peek ps))))
     (expect-kw ps '_Static_assert)
     (expect-punct ps 'lparen)
     (let ((v (parse-const-int ps)))
       (expect-punct ps 'comma)
       (cond ((not (eq? (tok-kind (peek ps)) 'STR))
              (die (tok-loc (peek ps)) "_Static_assert needs a string")))
       (let strings ()
         (cond ((eq? (tok-kind (peek ps)) 'STR)
                (advance ps) (strings))))
       (expect-punct ps 'rparen)
       (expect-punct ps 'semi)
       (cond ((%c-value-zero? v) (die loc "static assertion failed"))
             (else #t)))))
 
 (define (parse-decl-or-fn ps)
   (let-values (((sto b) (parse-decl-spec ps)))
     (cond
       ((at-punct? ps 'semi) (advance ps) 'decl)
       (else
        (let-values (((n t) (parse-declarator ps b)))
          (cond
            ((and (ctype-is-fn? t) (at-punct? ps 'lbrace))
             (parse-fn-body ps sto n t) 'fn)
            (else
             (handle-decl ps sto n t)
             (let lp ()
               (cond
                 ((at-punct? ps 'comma)
                  (advance ps)
                  (let-values (((n2 t2) (parse-declarator ps b)))
                    (handle-decl ps sto n2 t2) (lp)))
                 (else (expect-punct ps 'semi) 'decl))))))))))
 
 ;; ---- Block-scope inferred-length array length resolution -------------
 ;; The token iterator buffers lookahead in a list (see tok-iter); we
 ;; can pull arbitrarily many tokens, then push them all back via
 ;; iter-unget!. We use that to peek the initializer that follows `=`
 ;; (without consuming it) and count its elements so cg-alloc-slot can
 ;; reserve the right number of bytes BEFORE the initializer-emission
 ;; loop runs (and starts spilling intermediate values into newly-
 ;; allocated frame slots).
 ;;
 ;; Only the OUTERMOST length is inferred per C99 6.7.8/22, so for
 ;; `int x[][3] = {{1,2,3},{4,5,6}};` we just count top-level
 ;; brace-or-comma groups; the inner brace groups don't matter.
 
 (define (%peek-inferred-arr-init? ps)
   ;; Check whether the next-after-`=` token starts a brace-init or a
   ;; string-literal — the only initializer shapes that can resolve a
   ;; block-scope inferred-length array. We do NOT consume `=`; we
   ;; peek2 instead.
   (let ((t2 (peek2 ps)))
     (or (and (eq? (tok-kind t2) 'PUNCT) (eq? (tok-value t2) 'lbrace))
         (eq? (tok-kind t2) 'STR))))
 
 (define (%resolve-inferred-arr-len ps ty)
   ;; Returns a fresh array ctype with the resolved length. Does NOT
   ;; consume the `=` or any of the initializer tokens — every token
   ;; pulled is unget back in original order.
   (let* ((eq-tok (iter-next (ps-iter ps)))    ; consume `=` (will unget)
          (first  (iter-next (ps-iter ps)))     ; consume `{` or STR
          (collected (list first eq-tok))       ; head order: revs at end
          (count
           (cond
             ((eq? (tok-kind first) 'STR)
              ;; String length + NUL.
              (+ (bytevector-length (tok-value first)) 1))
             (else
              ;; first is `{`. Count top-level commas + 1, ignoring a
              ;; trailing comma before `}`. Track brace depth so nested
              ;; `{` for sub-aggregates are skipped.
              (let lp ((depth 1) (n 0) (saw-elem? #f) (last-was-comma? #f)
                       (acc collected))
                (let ((t (iter-next (ps-iter ps))))
                  (let ((acc2 (cons t acc)))
                    (cond
                      ((eq? (tok-kind t) 'EOF)
                       ;; Bail; let the real parser report the error
                       ;; after we restore tokens.
                       (%inferred-arr-restore! ps acc2)
                       (die #f "init: unterminated brace"))
                      ((and (eq? (tok-kind t) 'PUNCT)
                            (eq? (tok-value t) 'lbrace))
                       (lp (+ depth 1) n #t #f acc2))
                      ((and (eq? (tok-kind t) 'PUNCT)
                            (eq? (tok-value t) 'rbrace))
                       (cond
                         ((= depth 1)
                          ;; Done. Restore tokens (acc2 includes the
                          ;; closing `}`).
                          (%inferred-arr-restore! ps acc2)
                          (cond ((not saw-elem?) 0)
                                (last-was-comma? n)
                                (else (+ n 1))))
                         (else (lp (- depth 1) n saw-elem? #f acc2))))
                      ((and (eq? (tok-kind t) 'PUNCT)
                            (eq? (tok-value t) 'comma)
                            (= depth 1))
                       (lp depth (+ n 1) saw-elem? #t acc2))
                      (else
                       (lp depth n #t #f acc2)))))))))
          )
     (cond
       ((eq? (tok-kind first) 'STR)
        (%inferred-arr-restore! ps collected)))
     (%init-fixed-arr-type ty count)))
 
 (define (%inferred-arr-restore! ps acc)
   ;; acc is a stack of tokens in REVERSE consume order (most-recent
   ;; first). iter-unget! prepends one at a time, so iterating acc in
   ;; its current order pushes them back in the right sequence —
   ;; i.e. the oldest-consumed token ends up at the front of the
   ;; lookahead buffer.
   (let lp ((xs acc))
     (cond
       ((null? xs) #t)
       (else (iter-unget! (ps-iter ps) (car xs)) (lp (cdr xs))))))
 
 (define (handle-decl ps sto n ty)
   (cond
     ((not n) (die #f "no name"))
     ((eq? sto 'typedef)
      (scope-bind! ps n (%sym n 'typedef #f ty #f #t)))
     ((ctype-is-fn? ty)
      (scope-bind! ps n
                   (%sym n 'fn (or sto 'extern) ty #f #f)))
     ;; §I: block-scope `static` routes to a global with a declaration-id
     ;; name under the enclosing function.  Function + identifier is not
     ;; enough: separate nested scopes may legally reuse the same identifier.
     ;; A same-scope redeclaration reuses its existing mangled name; a new
     ;; declaration consumes the function's monotonic static counter.  The
     ;; scope-bind! key remains the original identifier for source lookup.
     ((and (eq? sto 'static) (ps-fn-ctx ps))
      (let* ((fc (ps-fn-ctx ps))
             (old (scope-lookup-current ps n))
             (mangled
              (cond
                ((and old (eq? (sym-kind old) 'var)
                      (eq? (sym-storage old) 'static))
                 (sym-name old))
                (else
                 (let ((id (fn-ctx-static-counter fc)))
                   (fn-ctx-static-counter-set! fc (+ id 1))
                   (bytevector-append (fn-ctx-name fc) "__static_"
                                      (number->string id 10) "__" n))))))
        (cond
          ((at-punct? ps 'assign)
           (advance ps)
           ;; Parse init first so an inferred-length array picks up its
           ;; resolved type before sm is constructed (sym is immutable).
           (let-values (((pieces ty2) (parse-init-global ps ty)))
             (let ((sm (%sym mangled 'var 'static ty2 #f #t)))
               (scope-bind! ps n sm)
               (cg-emit-global (ps-cg ps) sm pieces))))
          (else
           (let ((sm (%sym mangled 'var 'static ty #f #t)))
             (scope-bind! ps n sm)
             (cg-emit-global (ps-cg ps) sm #f))))))
     (else
      (cond
        ((not (ps-fn-ctx ps))
         ;; File-scope decls. Three cases:
         ;;   (a) initializer present  -> full external definition.
         ;;   (b) `extern` no init     -> declaration only.
         ;;   (c) no init, no `extern` -> tentative definition.
         ;; (a) emits to .data immediately. (b) is recorded but emits
         ;; nothing. (c) is recorded as `defined?=#f` and added to
         ;; world-tentatives; cg-finish emits .bss at end of TU only if
         ;; no full definition appeared. This lets two `static int x;`
         ;; or a `static int x;` followed by `static int x = 1;`
         ;; coexist (C 6.9.2 tentative-def merge).
         (cond
           ((at-punct? ps 'assign)
            (advance ps)
            (let-values (((pieces ty2) (parse-init-global ps ty)))
              (let ((sm (%sym n 'var (or sto 'extern) ty2 #f #t)))
                (scope-bind! ps n sm)
                (cg-emit-global (ps-cg ps) sm pieces))))
           ((eq? sto 'extern)
            (let ((sm (%sym n 'var 'extern ty #f #f)))
              (scope-bind! ps n sm)
              (cg-emit-extern (ps-cg ps) sm)))
           (else
            (let ((sm (%sym n 'var (or sto 'extern) ty #f #f)))
              (scope-bind! ps n sm)
              (cg-add-tentative! (ps-cg ps) n)))))
        (else
         ;; Block-scope inferred-length array (`int a[] = {…};` or
         ;; `char s[] = "…";`): peek the initializer past `=` to count
         ;; elements / measure the string and rebuild `ty` with the
         ;; resolved length BEFORE cg-alloc-slot. Otherwise the slot
         ;; is sized off a -1 / 0 ctype-size (capped to 1 byte) and
         ;; the per-element stores in parse-init-local-aggregate write
         ;; past frame-hi — the next %cg-spill-reg then allocates
         ;; right inside the array, clobbering elements.
         (let* ((ty (cond
                      ((and (eq? (ctype-kind ty) 'arr)
                            (< (cdr (ctype-ext ty)) 0)
                            (at-punct? ps 'assign)
                            (%peek-inferred-arr-init? ps))
                       (%resolve-inferred-arr-len ps ty))
                      (else ty)))
                (sz (max (ctype-size ty) 1))
                (al (max (ctype-align ty) 1))
                (sl (cg-alloc-slot (ps-cg ps) sz al))
                (sm (%sym n 'var (or sto 'auto) ty sl #t)))
           (scope-bind! ps n sm)
           (cond
             ((at-punct? ps 'assign)
              (advance ps)
              (cond
                ;; Aggregate locals get the per-element store treatment.
                ((or (at-punct? ps 'lbrace)
                     (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). 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)
                 (cg-cast (ps-cg ps) ty)
                 (cg-assign (ps-cg ps))
                 (cg-pop (ps-cg ps)))))
             (else #t))))))))
 
 ;; ====================================================================
 ;; Initializers (see CC.md §Variable initializers).
 ;;
 ;; parse-init-global ps ty
 ;;   Reads the initializer following `=` for a file-scope or block-scope
 ;;   static var of static-storage type `ty` and returns a list of
 ;;   pieces suitable for cg-emit-global. See cg.scm §cg-emit-global for
 ;;   the piece grammar.
 ;;
 ;; parse-init-local ps sm ty
 ;;   Reads the initializer for an auto-storage variable bound to slot
 ;;   sym `sm` and emits per-element store cg ops. Returns unspecified.
 ;; ====================================================================
 
 (define (%int->le-bv n nbytes)
   ;; N-byte little-endian encoding of integer n into a fresh bv. Bytes
   ;; >= sign-bit are filled by repeated >>8 (works for both signed and
   ;; unsigned because we only keep the low N bytes).
   (let* ((out (make-bytevector nbytes 0))
          (src (c-value-bytes (%c-value-coerce n))))
     (let loop ((i 0))
       (cond
         ((= i nbytes) out)
         (else
          (bytevector-u8-set! out i
            (if (< i %C-VALUE-BYTES) (bytevector-u8-ref src i) 0))
          (loop (+ i 1)))))))
 
 ;; File-scope compound literal (C99 §6.5.2.5). The bracketed initializer
 ;; following a typename in a static-storage initializer (or behind `&`
 ;; in same) is an unnamed object with static storage duration. Drive
 ;; the existing parse-init-global → cg-emit-global pipeline against a
 ;; synthetic sym whose label is freshly minted via %cg-fresh-cl-label.
 ;; Returns the emitted label; the caller wraps it in a (label-ref . LBL)
 ;; piece. The leading `(T)` and the storage-class disambiguation belong
 ;; to the caller — this entry point assumes peek = `{`.
 (define (%emit-fs-compound-literal ps ty)
   (let-values (((pieces ty2) (parse-init-global ps ty)))
     (let* ((lbl (%cg-fresh-cl-label (ps-cg ps)))
            ;; storage 'extern → %cg-sym-label returns the bare name
            ;; unchanged (no extra "cc__" prefix), so the emitted label
            ;; matches what we hand back to the caller.
            (sm  (%sym lbl 'var 'extern ty2 #f #t)))
       (cg-emit-global (ps-cg ps) sm pieces)
       lbl)))
 
 (define (%const-init-piece ps ty)
   ;; Parse a non-brace initializer expression for scalar type `ty` and
   ;; return a single piece. Recognised forms:
   ;;   - INT (with optional unary +/-)               -> N-byte LE bv
   ;;   - enum-const IDENT                            -> N-byte LE bv
   ;;   - &IDENT (address of a global var/fn)         -> (label-ref . cc__name)
   ;;   - &(T){...} (address of file-scope literal)   -> (label-ref . cc__cl_N)
   ;;   - IDENT  (function name; decays to fn ptr)    -> (label-ref . cc__name)
   ;;   - STR    (only for char* targets)             -> (label-ref . string-pool-label)
   ;;   - (T){...} (file-scope compound literal)      -> (label-ref . cc__cl_N)
   (let ((t (peek ps)))
     (cond
       ;; Redundant expression grouping around a static initializer. Macro
       ;; APIs commonly spell literals as `((T){...})` and strings as
       ;; `("...")`; peel one non-cast pair and let the regular initializer
       ;; paths consume the enclosed value.
       ((and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) 'lparen)
             (eq? (tok-kind (peek2 ps)) 'STR))
        (advance ps)
        (let ((p (%const-init-piece ps ty)))
          (expect-punct ps 'rparen)
          p))
       ;; Address initializer: &ident -> label-ref
       ((and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) 'amp))
        (advance ps)
        (let ((it (peek ps)))
          (cond
            ((eq? (tok-kind it) 'IDENT)
             (advance ps)
             (let ((sm (scope-lookup ps (tok-value it))))
               (cond
                 ((not sm) (die (tok-loc it) "init: undecl" (tok-value it)))
                 ((or (eq? (sym-kind sm) 'fn)
                      (and (eq? (sym-kind sm) 'var)
                           (or (eq? (sym-storage sm) 'static)
                               (eq? (sym-storage sm) 'extern))))
                  (cons 'label-ref (%cg-sym-label (ps-cg ps) sm)))
                 (else
                  (die (tok-loc it) "init: &x must reference a global"
                       (tok-value it))))))
            ;; &(T){...} — address of an unnamed file-scope compound
            ;; literal. Parse the typename, expect `{`, drive the
            ;; literal into .data, and yield its label.
            ((and (eq? (tok-kind it) 'PUNCT) (eq? (tok-value it) 'lparen)
                  (%const-paren-is-cast? ps))
             (advance ps)
             (let*-values (((_sto bty) (parse-decl-spec ps))
                           ((_n   ty2) (parse-declarator ps bty)))
               (expect-punct ps 'rparen)
               (cond
                 ((not (at-punct? ps 'lbrace))
                  (die (tok-loc (peek ps))
                       "init: &(T) must be followed by { ... }"
                       (tok-value (peek ps)))))
               (cons 'label-ref (%emit-fs-compound-literal ps ty2))))
            (else (die (tok-loc it) "init: &?" (tok-value it))))))
       ;; (T){...} — file-scope compound literal. The literal is an
       ;; lvalue of array/struct/union type; assignment to a pointer
       ;; target decays it via its label address (label = first byte).
       ((and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) 'lparen)
             (%const-paren-is-cast? ps)
             ;; Speculatively look past `(T)` for `{`. Since we have no
             ;; 3-token peek, we have to commit to the (T) parse; if the
             ;; following token isn't `{` it's a plain cast, so we fall
             ;; back to the const-int path with the type already consumed.
             #t)
        ;; Take the (T) ourselves so we can dispatch on the next token.
        (advance ps)
        (let*-values (((_sto bty) (parse-decl-spec ps))
                      ((_n   ty2) (parse-declarator ps bty)))
          (expect-punct ps 'rparen)
          (cond
            ((at-punct? ps 'lbrace)
             (cons 'label-ref (%emit-fs-compound-literal ps ty2)))
            (else
             ;; Not a compound literal — it's a constant cast, e.g.
             ;; `(int)(unsigned char)257`. Mirror parse-const-cast's
             ;; cast arm with the already-parsed type.
             (cond
               ((%ctype-int? ty2)
                (let ((v (parse-const-cast ps)))
                  (%int->le-bv (%const-trunc (car v) ty2)
                               (max (ctype-size ty) 1))))
               ((eq? (ctype-kind ty2) 'ptr)
                ;; Pointer cast in const-expr: type-retag only. We expect
                ;; the operand to be an integer-shaped const (e.g. 0) and
                ;; emit it as the target's byte width.
                (let ((v (parse-const-cast ps)))
                  (%int->le-bv (car v) (max (ctype-size ty) 1))))
               (else
                (die (tok-loc (peek ps))
                     "init: cast to non-scalar non-compound-literal"
                     (ctype-kind ty2))))))))
       ;; Function name or array name as a label-ref initializer.
       ;; (Both decay to a pointer when used as a value.)
       ((and (eq? (tok-kind t) 'IDENT)
             (let ((sm (scope-lookup ps (tok-value t))))
               (and sm
                    (or (eq? (sym-kind sm) 'fn)
                        (and (eq? (sym-kind sm) 'var)
                             (eq? (ctype-kind (sym-type sm)) 'arr)
                             (or (eq? (sym-storage sm) 'static)
                                 (eq? (sym-storage sm) 'extern)))))))
        (advance ps)
        (let ((sm (scope-lookup ps (tok-value t))))
          (cons 'label-ref (%cg-sym-label (ps-cg ps) sm))))
       ;; Plain string literal as char* initializer.
       ((eq? (tok-kind t) 'STR)
        (advance ps)
        (let ((lbl (cg-intern-string (ps-cg ps) (tok-value t))))
          (cons 'label-ref lbl)))
       ;; Otherwise it's a const integer.
       (else
        (let ((v (parse-const-int ps)))
          (%int->le-bv v (max (ctype-size ty) 1)))))))
 
 ;; Parse a file-scope aggregate compound literal, accepting redundant outer
 ;; grouping: `(T){...}` and `((T){...})`. The caller already knows an
 ;; aggregate is required, so a leading parenthesis is unambiguous here.
 (define (%global-init-compound ps expected-ty)
   (expect-punct ps 'lparen)
   (cond
     ((at-punct? ps 'lparen)
      (let ((pieces (%global-init-compound ps expected-ty)))
        (expect-punct ps 'rparen)
        pieces))
     (else
      (let*-values (((_sto bty) (parse-decl-spec ps))
                    ((_n literal-ty) (parse-declarator ps bty)))
        (expect-punct ps 'rparen)
        (cond ((not (or (ctype-compat? literal-ty expected-ty)
                        (%ctype-same-aggregate-tag? literal-ty expected-ty)))
               (die (tok-loc (peek ps))
                    "init: incompatible aggregate compound literal")))
        (expect-punct ps 'lbrace)
        (let ((k (ctype-kind literal-ty)))
          (cond
            ((eq? k 'arr)
             (let-values (((pieces _count)
                           (%parse-init-array-list ps literal-ty)))
               pieces))
            ((or (eq? k 'struct) (eq? k 'union))
             (%parse-init-struct-list ps literal-ty))
             (else (die #f "init: compound literal is not aggregate" k))))))))
 
 (define (%ctype-same-aggregate-tag? a b)
   ;; Qualifier propagation can clone a tagged aggregate ctype, so pointer
   ;; identity alone is too strict for `(T){...}` assigned to a const-qualified
   ;; T field.  A matching non-anonymous tag is the seed compiler's nominal
   ;; identity for structs/unions.
   (let ((ka (ctype-kind a)) (kb (ctype-kind b)))
     (and (eq? ka kb)
          (or (eq? ka 'struct) (eq? ka 'union))
          (let ((ta (car (ctype-ext a))) (tb (car (ctype-ext b))))
            (and ta tb (bytes=? ta tb))))))
 
 (define (%init-grouped-compound-start? ps)
   (or (%const-paren-is-cast? ps)
       (pmatch (peek2 ps)
         (($ tok? (kind PUNCT) (value lparen)) #t)
         (else #f))))
 
 (define (%init-array-elem-type ty)
   (cond ((eq? (ctype-kind ty) 'arr) (car (ctype-ext ty)))
         (else (die #f "init: not an array" ty))))
 
 (define (%init-array-decl-len ty)
   ;; Declared array length (-1 = inferred).
   (cond ((eq? (ctype-kind ty) 'arr) (cdr (ctype-ext ty))) (else -1)))
 
 (define (%init-fixed-arr-type ty count)
   ;; Construct a fresh array ctype with the inferred length resolved
   ;; to `count`. Pure — does not mutate `ty`. For non-inferred or
   ;; non-array `ty`, callers should detect this themselves and just
   ;; pass `ty` through.
   (%mk-arr (car (ctype-ext ty)) count))
 
 (define (%init-struct-fields ty)
   ;; Return ((name-bv ctype offset) ...) for a struct/union ctype.
   (let ((ext (ctype-ext ty)))
     (cond ((and (pair? ext) (pair? (cdr ext))) (car (cddr ext)))
           (else (die #f "init: not a struct" ty)))))
 
 ;; After processing a designated initializer for FNAME, return the
 ;; field list with FNAME and all preceding (already-overwritten or
 ;; skipped) fields removed. Empty list if FNAME isn't found (caller
 ;; should already have validated the field exists).
 (define (%init-drop-thru-field fields fname)
   (cond ((null? fields) '())
         ((bytes=? (car (car fields)) fname) (cdr fields))
         (else (%init-drop-thru-field (cdr fields) fname))))
 
 ;; Consume a C99 field designator, including a chain such as `.v.stack`.
 ;; Return the top-level field name (for positional-cursor advancement), the
 ;; final selected type, and its aggregate-relative byte offset.
 (define (%init-field-designator ps fields)
   (expect-punct ps 'dot)
   (let walk ((cur-fields fields) (top-name #f) (offset 0))
     (let ((nt (advance ps)))
       (cond ((not (eq? (tok-kind nt) 'IDENT))
              (die (tok-loc nt) "init: .field expects ident")))
       (let ((f (%cg-find-field cur-fields (tok-value nt))))
         (cond ((not f) (die (tok-loc nt) "init: no such field"
                             (tok-value nt))))
         (let ((name (car f))
               (fty (car (cdr f)))
               (foff (car (cddr f))))
           (cond
             ((at-punct? ps 'dot)
              (advance ps)
              (walk (%init-struct-fields fty)
                    (or top-name name) (+ offset foff)))
             (else
              (expect-punct ps 'assign)
              (list (or top-name name) fty (+ offset foff)))))))))
 
 ;; #t when TY is an array of i8/u8 — a char[] a string literal may
 ;; initialize directly (C11 §6.7.9 ¶14).
 (define (%char-arr-type? t)
   (and (eq? (ctype-kind t) 'arr)
        (let ((et (car (ctype-ext t))))
          (or (eq? et %t-i8) (eq? et %t-u8)))))
 
 ;; A char[] field/element written as `= "..."`: consume the STR token
 ;; and return a byte-vector piece of the array's declared size, copying
 ;; the string bytes (truncating an over-long string, zero-padding a
 ;; short one). The nested-aggregate analogue of parse-init-global's
 ;; top-level STR arm; `t` always has a declared length here (only a
 ;; top-level array may infer its length from the string).
 (define (%str-arr-piece ps t)
   (let* ((s     (tok-value (peek ps)))
          (slen  (bytevector-length s))
          (final (ctype-size t))
          (bv    (make-bytevector final 0)))
     (advance ps)
     (let loop ((i 0))
       (cond
         ((or (= i slen) (>= i final)) bv)
         (else
          (bytevector-u8-set! bv i (bytevector-u8-ref s i))
          (loop (+ i 1)))))))
 
 ;; Element/field dispatch for global aggregate initializers. ELIDE? = #f
 ;; means caller has just consumed `{` for this element and we own the
 ;; matching `}`; ELIDE? = #t is C99 §6.7.8 ¶22 brace elision (the
 ;; sub-aggregate draws items from the parent stream, no inner braces).
 ;; Returns the piece-list contributing this element to the encoding.
 (define (%global-init-elem ps t elide?)
   (let ((k (ctype-kind t)))
     (cond
       ((and elide?
             (or (eq? k 'arr) (eq? k 'struct) (eq? k 'union))
             (at-punct? ps 'lparen)
             (%init-grouped-compound-start? ps))
        (let ((pieces (%global-init-compound ps t)))
          (cond
            (elide? pieces)
            (else
             (cond ((at-punct? ps 'comma) (advance ps)))
             (expect-punct ps 'rbrace)
             pieces))))
       ;; char[] initialized by a string literal (`{"..."}` or, under
       ;; brace elision, a bare `"..."`). Without this, the `arr` arm
       ;; below would treat the string as an element-list and encode it
       ;; as a pointer to the string pool instead of the bytes.
       ((and (eq? k 'arr)
             (eq? (tok-kind (peek ps)) 'STR)
             (%char-arr-type? t))
        (let ((p (%str-arr-piece ps t)))
          (cond
            (elide? (list p))
            (else
             (cond ((at-punct? ps 'comma) (advance ps)))
             (expect-punct ps 'rbrace)
             (list p)))))
       ((eq? k 'arr)
        (let-values (((p _c) (cond
                               (elide? (%parse-init-array-list/mode ps t #f))
                               (else   (%parse-init-array-list ps t)))))
          p))
       ((or (eq? k 'struct) (eq? k 'union))
        (cond
          (elide? (%parse-init-struct-list/mode ps t #f))
          (else   (%parse-init-struct-list ps t))))
       (else
        (let ((p (%const-init-piece ps t)))
          (cond
            (elide? (list p))
            (else
             (cond ((at-punct? ps 'comma) (advance ps)))
             (expect-punct ps 'rbrace)
             (list p))))))))
 
 ;; Element/field dispatch for local aggregate initializers. Mirrors
 ;; %global-init-elem but emits per-element store ops via cg-assign for
 ;; scalar leaves, and recurses into the local-list walkers for
 ;; aggregates. Returns 0; the side effect is the emitted code.
 (define (%local-init-expr-tokens ps)
   ;; Capture one assignment-expression without consuming the comma or `}`
   ;; which terminates it in the surrounding initializer list.  Braces must
   ;; be tracked separately from parentheses: a compound literal such as
   ;; `(struct S){ .x = 1, .y = 2 }` is one expression even though it contains
   ;; both commas and a closing brace.
   (let loop ((acc '()) (paren 0) (brack 0) (brace 0))
     (let ((t (peek ps)))
       (cond
         ((eq? (tok-kind t) 'EOF)
          (die (tok-loc t) "EOF in local initializer expression"))
         ((and (= paren 0) (= brack 0) (= brace 0)
               (eq? (tok-kind t) 'PUNCT)
               (or (eq? (tok-value t) 'comma)
                   (eq? (tok-value t) 'rbrace)))
          (reverse acc))
         (else
          (let ((nt (advance ps)))
            (cond
              ((not (eq? (tok-kind nt) 'PUNCT))
               (loop (cons nt acc) paren brack brace))
              ((eq? (tok-value nt) 'lparen)
               (loop (cons nt acc) (+ paren 1) brack brace))
              ((eq? (tok-value nt) 'rparen)
               (loop (cons nt acc) (- paren 1) brack brace))
              ((eq? (tok-value nt) 'lbrack)
               (loop (cons nt acc) paren (+ brack 1) brace))
              ((eq? (tok-value nt) 'rbrack)
               (loop (cons nt acc) paren (- brack 1) brace))
              ((eq? (tok-value nt) 'lbrace)
               (loop (cons nt acc) paren brack (+ brace 1)))
              ((eq? (tok-value nt) 'rbrace)
               (loop (cons nt acc) paren brack (- brace 1)))
              (else
               (loop (cons nt acc) paren brack brace)))))))))
 
 (define (%local-init-aggregate-expr? ps expected)
   ;; A brace-less aggregate initializer is ambiguous until its first
   ;; assignment-expression has been typed: it can be a whole-aggregate copy
   ;; (`.member = value`) or brace elision (`.member = 1, 2`).  Parse that
   ;; expression once under a codegen snapshot, then put its tokens back.  The
   ;; real parse below either copies the aggregate or descends into its first
   ;; scalar member.  This is the same no-side-effect mechanism used by sizeof.
   (let* ((it (ps-iter ps))
          (toks (%local-init-expr-tokens ps)))
     (for-each (lambda (t) (iter-unget! it t)) (reverse toks))
     (cond
       ((null? toks) #f)
       (else
        (let ((tag (cg-snapshot (ps-cg ps))))
          (parse-saved-expr ps toks)
          (let* ((top (cg-top (ps-cg ps)))
                 (actual (opnd-type top))
                 (aggregate?
                  (and (or (eq? (ctype-kind actual) 'struct)
                           (eq? (ctype-kind actual) 'union))
                       (or (ctype-compat? actual expected)
                           (%ctype-same-aggregate-tag? actual expected)))))
            (cg-rewind (ps-cg ps) tag)
            aggregate?))))))
 
 (define (%local-init-elem ps sm eoff t elide?)
   (let ((k (ctype-kind t)))
     (cond
       ;; char[] field/element initialized by a string literal — emit the
       ;; bytes into the frame slot. Mirrors %global-init-elem's STR arm;
       ;; without it the `arr` arm would parse the string as a scalar
       ;; expression and store one byte of its decayed pointer.
       ((and (eq? k 'arr)
             (eq? (tok-kind (peek ps)) 'STR)
             (%char-arr-type? t))
        (let* ((s     (tok-value (peek ps)))
               (slen  (bytevector-length s))
               (final (ctype-size t)))
          (advance ps)
          (let loop ((i 0))
            (cond
              ((>= i final) 0)
              (else
               (let ((b (cond ((< i slen) (bytevector-u8-ref s i)) (else 0))))
                 (%push-frame-elem-lval ps (+ eoff i) %t-u8)
                 (cg-push-imm (ps-cg ps) %t-u8 b)
                 (cg-assign (ps-cg ps)) (cg-pop (ps-cg ps))
                 (loop (+ i 1))))))
          (cond
            (elide? 0)
            (else
             (cond ((at-punct? ps 'comma) (advance ps)))
             (expect-punct ps 'rbrace)))))
       ((eq? k 'arr)
        (cond
          (elide? (%parse-init-local-array-list/mode ps sm eoff t #f))
          (else   (%parse-init-local-array-list ps sm eoff t))))
       ((or (eq? k 'struct) (eq? k 'union))
        (cond
          ((and elide? (%local-init-aggregate-expr? ps t))
           (%push-frame-elem-lval ps eoff t)
           (parse-expr-bp ps 4)
           (cg-copy-struct (ps-cg ps)))
          (elide? (%parse-init-local-struct-list/mode ps sm eoff t #f))
          (else   (%parse-init-local-struct-list ps sm eoff t))))
       (else
        (%push-frame-elem-lval ps eoff t)
        (parse-expr-bp ps 4) (rval! ps)
        (cg-cast (ps-cg ps) t)
        (cg-assign (ps-cg ps)) (cg-pop (ps-cg ps))
        (cond
          (elide? 0)
          (else
           (cond ((at-punct? ps 'comma) (advance ps)))
           (expect-punct ps 'rbrace)))))))
 
 (define (%pad-piece nbytes)
   (make-bytevector nbytes 0))
 
 ;; Prepend XS in reverse order without allocating an intermediate list.
 (define (%init-prepend-reversed xs acc)
   (let loop ((ys xs) (out acc))
     (cond
       ((null? ys) out)
       (else
        (loop (cdr ys) (cons (car ys) out))))))
 
 ;; ----- Global initializers ---------------------------------------------
 ;; Returns (values pieces final-ty). For inferred-length array `ty`,
 ;; final-ty is a freshly-built array ctype with the resolved length;
 ;; otherwise final-ty is `ty` unchanged.
 (define (parse-init-global ps ty)
   (pmatch (peek ps)
     ;; String literal initializer for char[]
     (($ tok? (kind STR) (value ,s))
      (guard (and (eq? (ctype-kind ty) 'arr)
                  (let ((et (car (ctype-ext ty))))
                    (or (eq? et %t-i8) (eq? et %t-u8)))))
      (advance ps)
      (let* ((slen (bytevector-length s))
             (decl (cdr (ctype-ext ty)))
             (final (cond ((< decl 0) (+ slen 1)) (else decl)))
             (final-ty (cond ((< decl 0) (%init-fixed-arr-type ty final))
                             (else ty))))
        (let ((bv (make-bytevector final 0)))
          (let loop ((i 0))
            (cond
              ((or (= i slen) (>= i final))
               (values (list bv) final-ty))
              (else
               (bytevector-u8-set! bv i (bytevector-u8-ref s i))
               (loop (+ i 1))))))))
     ;; Brace-form
     (($ tok? (kind PUNCT) (value lbrace))
      (advance ps)
      (cond
        ((eq? (ctype-kind ty) 'arr)
         (let-values (((pieces count) (%parse-init-array-list ps ty)))
           (let* ((decl (%init-array-decl-len ty))
                  (final-ty (cond ((< decl 0)
                                   (%init-fixed-arr-type ty count))
                                  (else ty))))
             (values pieces final-ty))))
        ((or (eq? (ctype-kind ty) 'struct) (eq? (ctype-kind ty) 'union))
         (values (%parse-init-struct-list ps ty) ty))
        (else
         ;; Brace-wrapped scalar: { expr }
         (let ((piece (%const-init-piece ps ty)))
           (cond ((at-punct? ps 'comma) (advance ps)))
           (expect-punct ps 'rbrace)
           (values (list piece) ty)))))
     ;; Bare scalar initializer
     (else (values (list (%const-init-piece ps ty)) ty))))
 
 ;; Returns (values pieces count). `count` is the number of element
 ;; initializers actually consumed (used by parse-init-global to resolve
 ;; an inferred top-level length). C99 forbids inferred length in
 ;; nested array elements, so recursive callers ignore `count`.
 ;;
 ;; `brace?` controls termination: when #t (the normal case), the loop
 ;; consumes elements until `}` is seen. When #f (brace-elision recursion
 ;; from C99 §6.7.8 ¶22), the loop consumes exactly `decl` elements from
 ;; the parent stream and returns without expecting `}`. In no-brace
 ;; mode, a leading `.` or `[` designator targets the enclosing aggregate
 ;; — the recursion terminates immediately, padding the unfilled tail.
 (define (%parse-init-array-list ps ty)
   (%parse-init-array-list/mode ps ty #t))
 
 (define (%parse-init-array-list/mode ps ty brace?)
   ;; Element-list array initializer; assumes `{` already consumed when
   ;; brace? is #t.
   (let* ((elem  (%init-array-elem-type ty))
          (esize (ctype-size elem))
          (decl  (%init-array-decl-len ty)))
     (let lp ((entries '()) (cursor 0) (count 0))
       (cond
         ((cond (brace? (at-punct? ps 'rbrace))
                (else (or (>= cursor (cond ((< decl 0) 0) (else decl)))
                          (at-punct? ps 'rbrace)
                          (at-punct? ps 'dot)
                          (at-punct? ps 'lbrack))))
          (cond (brace? (advance ps)))
          (let ((final (cond ((< decl 0) count) (else decl))))
            (values (%merge-init-entries (reverse entries) (* final esize))
                    count)))
         (else
          (let* ((designated? (and brace? (at-punct? ps 'lbrack)))
                 (index
                  (cond
                    (designated?
                     (advance ps)
                     (let ((n (parse-const-int ps)))
                       (expect-punct ps 'rbrack)
                       (expect-punct ps 'assign)
                       n))
                    (else cursor)))
                 (_range
                  (cond
                    ((or (< index 0) (and (>= decl 0) (>= index decl)))
                     (die (tok-loc (peek ps))
                          "init: array designator out of range" index))
                    (else 0)))
                 (piece
                 (let ((p
                        (cond
                          ((at-punct? ps 'lbrace)
                           (advance ps)
                           (%global-init-elem ps elem #f))
                          (else
                           (%global-init-elem ps elem #t)))))
                   ;; Inter-item comma: consume except for the comma
                   ;; following our LAST item in no-brace mode — that
                   ;; one belongs to the enclosing parent.
                   (cond
                     (brace?
                      (cond ((at-punct? ps 'comma) (advance ps))))
                     (else
                      ;; no-brace: consume comma only if more items
                      ;; remain in our quota.
                      (cond
                        ((and (< (+ index 1)
                                 (cond ((< decl 0) 0) (else decl)))
                              (at-punct? ps 'comma))
                         (advance ps)))))
                   p))
                 (next (+ index 1)))
            (lp (cons (cons (* index esize) piece) entries)
                next (max count next))))))))
 
 (define (%piece-bytesize p)
   ;; Output width of one piece (cf. %cg-init-piece->bv): a bv emits
   ;; one byte per element; a (label-ref . _) emits a target-word slot.
   (cond
     ((bytes? p) (bytevector-length p))
     ((and (pair? p) (eq? (car p) 'label-ref)) %CC-WORD-BYTES)
     (else (die #f "init: unknown piece" p))))
 
 (define (%pieces-bytesize ps-list)
   (let loop ((xs ps-list) (n 0))
     (cond ((null? xs) n)
           (else (loop (cdr xs) (+ n (%piece-bytesize (car xs))))))))
 
 (define (%merge-init-entries entries total-size)
   ;; entries: list of (abs-offset . piece-list), in source order.
   ;; Sort stably by offset (later writes to the same offset win, per C
   ;; designated-init semantics) and emit pad pieces in any gaps and at
   ;; the tail. Preserves label-ref pieces — we never merge them into a
   ;; flat bv.
   (let* ((sorted (%init-stable-sort-by-offset entries))
          (out
           (let walk ((xs sorted) (cursor 0) (acc '()))
             (cond
               ((null? xs)
                (cond
                  ((< cursor total-size)
                   (reverse (cons (%pad-piece (- total-size cursor)) acc)))
                  (else (reverse acc))))
               (else
                (let* ((e        (car xs))
                       (eoff     (car e))
                       (epieces  (cdr e))
                       (esize    (%pieces-bytesize epieces))
                       (acc1     (cond
                                   ((> eoff cursor)
                                    (cons (%pad-piece (- eoff cursor)) acc))
                                   (else acc)))
                       (acc2     (append (reverse epieces) acc1)))
                  (walk (cdr xs) (+ eoff esize) acc2)))))))
     out))
 
 (define (%init-stable-sort-by-offset entries)
   ;; Insertion sort, stable by source order for ties. n is small (one
   ;; entry per initialized field) so O(n^2) is fine.
   (let lp ((xs entries) (acc '()))
     (cond
       ((null? xs) acc)
       (else
        (let ((e (car xs)))
          (lp (cdr xs)
              (let ins ((ys acc) (head '()))
                (cond
                  ((null? ys)
                   (append (reverse head) (list e)))
                  ((<= (car e) (car (car ys)))
                   (append (reverse head) (cons e ys)))
                  (else
                   (ins (cdr ys) (cons (car ys) head)))))))))))
 
 (define (%parse-init-struct-list ps ty)
   (%parse-init-struct-list/mode ps ty #t))
 
 (define (%parse-init-struct-list/mode ps ty brace?)
   ;; Struct/union initializer; assumes `{` already consumed when brace?.
   ;; In no-brace mode (brace elision, C99 §6.7.8 ¶22), terminate when
   ;; positional fields are exhausted, when a `}` is seen (belongs to
   ;; the enclosing aggregate), or when a designator (`.`) appears (it
   ;; targets the enclosing aggregate). Doesn't consume the trailing
   ;; comma after the last field — that belongs to the parent list.
   (let* ((fields (%init-struct-fields ty))
          (size   (ctype-size ty))
          (union? (eq? (ctype-kind ty) 'union)))
     (let lp ((entries '()) (rest fields))
       (cond
         ((cond (brace? (at-punct? ps 'rbrace))
                (else (or (null? rest)
                          (at-punct? ps 'rbrace)
                          (at-punct? ps 'dot)
                          ;; Union in brace-elision mode: take one
                          ;; member then return — the next sibling
                          ;; initializer belongs to the parent
                          ;; (C99 §6.7.8 ¶22 + union has one active
                          ;; member at a time).
                          (and union? (pair? entries)))))
          (cond (brace? (advance ps)))
          (%merge-init-entries (reverse entries) size))
         (else
          (let* ((designated? (at-punct? ps 'dot))
                 (target
                 (cond
                   (designated?
                    (%init-field-designator ps fields))
                    ((null? rest)
                     (die (tok-loc (peek ps)) "init: too many fields"))
                    (else (car rest))))
                 (fname  (car target))
                 (fty    (car (cdr target)))
                 (foff   (car (cddr target)))
                 (piece-list
                  (cond
                    ((at-punct? ps 'lbrace)
                     (advance ps)
                     (%global-init-elem ps fty #f))
                    (else
                     (%global-init-elem ps fty #t))))
                 (rest1
                  (cond
                    ;; designated init: drop fields up to and including target
                    (designated? (%init-drop-thru-field fields fname))
                    (else (cdr rest)))))
            ;; Inter-item comma: consume except for the comma after our
            ;; LAST field in no-brace mode (belongs to enclosing list).
            (cond
              (brace?
               (cond ((at-punct? ps 'comma) (advance ps))))
              (else
               (cond ((and (not (null? rest1))
                           ;; Union in brace-elision mode terminates
                           ;; after one element regardless of rest1;
                           ;; that means the comma belongs to the parent.
                           (not union?)
                           (at-punct? ps 'comma))
                      (advance ps)))))
            (lp (cons (cons foff piece-list) entries) rest1)))))))
 
 ;; ----- Local aggregate initializers ------------------------------------
 ;; Emits per-element store sequences via cg ops into the slot of `sm`
 ;; (a 'var sym whose slot is the frame offset). Assumes the assignment
 ;; `=` has already been consumed.
 (define (parse-init-local-aggregate ps sm ty)
   (pmatch (peek ps)
     ;; Local char[] = "string" — fill from string bytes.
     (($ tok? (kind STR) (value ,s))
      (guard (and (eq? (ctype-kind ty) 'arr)
                  (let ((et (car (ctype-ext ty))))
                    (or (eq? et %t-i8) (eq? et %t-u8)))))
      (advance ps)
      ;; Note: for inferred-length (`int x[] = "..."`) auto arrays the
      ;; sm-type still records the original (size=-1) ctype — `sizeof(x)`
      ;; in the body would not see the resolved length. The slot is also
      ;; sized off the original (= 1 byte), so the path is pre-existing
      ;; broken; we don't paper over it here. Real C bootstrap code uses
      ;; statics/globals for inferred-length arrays.
      (let* ((slen (bytevector-length s))
             (decl (cdr (ctype-ext ty)))
             (final (cond ((< decl 0) (+ slen 1)) (else decl))))
        ;; Emit byte stores for each char in s, plus NUL for the
        ;; trailing slot if final > slen.
        (let loop ((i 0))
          (cond
            ((>= i final) #t)
            (else
             (let ((b (cond ((< i slen) (bytevector-u8-ref s i))
                            (else 0)))
                   (off (+ (sym-slot sm) i)))
               (%push-frame-elem-lval ps off %t-u8)
               (cg-push-imm (ps-cg ps) %t-u8 b)
               (cg-assign (ps-cg ps))
               (cg-pop (ps-cg ps))
               (loop (+ i 1))))))))
     (($ tok? (kind PUNCT) (value lbrace))
      (advance ps)
      (cond
        ((eq? (ctype-kind ty) 'arr)
         (%parse-init-local-array-list ps sm (sym-slot sm) ty))
        ((or (eq? (ctype-kind ty) 'struct) (eq? (ctype-kind ty) 'union))
         (%parse-init-local-struct-list ps sm (sym-slot sm) ty))
        (else (die #f "init local: brace on scalar?"))))
     (else (die (tok-loc (peek ps)) "init local aggregate?"))))
 
 (define (%push-frame-elem-lval ps base-off ty)
   (cg-push (ps-cg ps) (%opnd 'frame ty base-off #t)))
 
 (define (%parse-init-local-array-list ps sm base-off ty)
   (%parse-init-local-array-list/mode ps sm base-off ty #t))
 
 (define (%parse-init-local-array-list/mode ps sm base-off ty brace?)
   (let* ((elem (%init-array-elem-type ty))
          (esize (ctype-size elem))
          (decl  (%init-array-decl-len ty)))
     (let lp ((i 0))
       (cond
         ((cond (brace? (at-punct? ps 'rbrace))
                (else (or (>= i (cond ((< decl 0) 0) (else decl)))
                          (at-punct? ps 'rbrace)
                          (at-punct? ps 'dot)
                          (at-punct? ps 'lbrack))))
          (cond (brace? (advance ps)))
          ;; Inferred-length auto path is pre-existing broken (slot
          ;; allocated off size=-1, sm-type unfixed). See note in
          ;; parse-init-local-aggregate STR branch.
          ;; Zero out remaining slots if any (declared length > i).
          (let ((final (cond ((< decl 0) i) (else decl))))
            (let zlp ((k i))
              (cond
                ((>= k final) #t)
                (else
                 (let ((off (+ base-off (* k esize))))
                   (cond
                     ((or (eq? (ctype-kind elem) 'arr)
                          (eq? (ctype-kind elem) 'struct)
                          (eq? (ctype-kind elem) 'union))
                      ;; Zero each byte in this aggregate slot.
                      (let zb ((j 0))
                        (cond
                          ((>= j esize) #t)
                          (else
                           (%push-frame-elem-lval ps (+ off j) %t-u8)
                           (cg-push-imm (ps-cg ps) %t-u8 0)
                           (cg-assign (ps-cg ps))
                           (cg-pop (ps-cg ps))
                           (zb (+ j 1))))))
                     (else
                      (%push-frame-elem-lval ps off elem)
                      (cg-push-imm (ps-cg ps) elem 0)
                      (cg-assign (ps-cg ps))
                      (cg-pop (ps-cg ps)))))
                 (zlp (+ k 1)))))))
         (else
          (let ((eoff (+ base-off (* i esize))))
            (cond
              ((at-punct? ps 'lbrace)
               (advance ps)
               (%local-init-elem ps sm eoff elem #f))
              (else
               (%local-init-elem ps sm eoff elem #t)))
            ;; Inter-item comma: in no-brace mode, don't eat the comma
            ;; that follows our LAST item (it belongs to the parent).
            (cond
              (brace?
               (cond ((at-punct? ps 'comma) (advance ps))))
              (else
               (cond ((and (< (+ i 1)
                              (cond ((< decl 0) 0) (else decl)))
                           (at-punct? ps 'comma))
                      (advance ps)))))
            (lp (+ i 1))))))))
 
 (define (%bv-in-list? bv xs)
   (cond ((null? xs) #f)
         ((bytes=? bv (car xs)) #t)
         (else (%bv-in-list? bv (cdr xs)))))
 
 ;; Does any leaf-name of `f` (a struct/union field tuple, possibly with
 ;; a nameless anon-aggregate type) appear in `seen`? Used by the
 ;; local-struct zero-pass to skip an anonymous member whose sub-field
 ;; was already written through a designator like `.a` (C11 §6.7.2.1).
 (define (%anon-touched? f seen)
   (let ((fn (car f)))
     (cond
       (fn (%bv-in-list? fn seen))
       (else
        (let ((k (ctype-kind (cadr f))))
          (cond
            ((or (eq? k 'struct) (eq? k 'union))
             (let lp ((xs (car (cddr (ctype-ext (cadr f))))))
               (cond
                 ((null? xs) #f)
                 ((%anon-touched? (car xs) seen) #t)
                 (else (lp (cdr xs))))))
            (else #f)))))))
 
 (define (%emit-zero-field ps base-off f)
   ;; Keep the absolute byte-offset expression explicit: base + field offset,
   ;; then add the byte index used by the zero-fill loop.
   (let* ((fty       (car (cdr f)))
          (foff      (car (cddr f)))
          (fsize     (ctype-size fty))
          (start-off (+ base-off foff)))
     (let zb ((j 0))
       (cond
         ((>= j fsize) #t)
         (else
          (%push-frame-elem-lval ps (+ start-off j) %t-u8)
          (cg-push-imm (ps-cg ps) %t-u8 0)
          (cg-assign (ps-cg ps))
          (cg-pop (ps-cg ps))
          (zb (+ j 1)))))))
 
 (define (%parse-init-local-struct-list ps sm base-off ty)
   (%parse-init-local-struct-list/mode ps sm base-off ty #t))
 
 (define (%parse-init-local-struct-list/mode ps sm base-off ty brace?)
   ;; Track each initialized field by name in `seen`; at the closing brace
   ;; zero every field NOT in `seen`. Tracking by name (rather than
   ;; positional "remaining" fields) handles a designator jumping
   ;; backwards correctly — e.g. `{.y = 5}` must still zero `x`.
   ;; C requires every unmentioned member of an aggregate with at least
   ;; one designator/initializer to be zeroed (C11 §6.7.9 ¶21).
   ;;
   ;; In no-brace mode (brace elision, C99 §6.7.8 ¶22): terminate when
   ;; positional fields exhausted, on `}` (parent's), or on `.` designator
   ;; (targets parent). Don't consume trailing comma after our last field.
   (let ((fields (%init-struct-fields ty)))
     (let lp ((rest fields) (seen '()))
       (cond
         ((cond (brace? (at-punct? ps 'rbrace))
                (else (or (null? rest)
                          (at-punct? ps 'rbrace)
                          (at-punct? ps 'dot))))
          (cond (brace? (advance ps)))
          (for-each
            (lambda (f)
              (cond ((not (%anon-touched? f seen))
                     (%emit-zero-field ps base-off f))))
            fields))
         (else
          (let* ((designated? (at-punct? ps 'dot))
                 (target
                 (cond
                   (designated?
                    (%init-field-designator ps fields))
                    ((null? rest)
                     (die (tok-loc (peek ps)) "init: too many fields"))
                    (else (car rest))))
                 (fname (car target))
                 (fty   (car (cdr target)))
                 (foff  (car (cddr target)))
                 (eoff  (+ base-off foff)))
            (cond
              ((at-punct? ps 'lbrace)
               (advance ps)
               (%local-init-elem ps sm eoff fty #f))
              (else
               (%local-init-elem ps sm eoff fty #t)))
            (let ((rest1
                   (cond
                     (designated? (%init-drop-thru-field fields fname))
                     (else (cdr rest)))))
              ;; Inter-item comma: in no-brace mode, don't eat the comma
              ;; that follows our LAST field (belongs to enclosing list).
              (cond
                (brace?
                 (cond ((at-punct? ps 'comma) (advance ps))))
                (else
                 (cond ((and (not (null? rest1))
                             (at-punct? ps 'comma))
                        (advance ps)))))
              (lp rest1 (cons fname seen)))))))))
 
 
 ;; parse-fn-body: bind the fn-sym for recursive lookup, then parse the
 ;; body. Persistent entries remain reachable through the world graph;
 ;; function-local parser state becomes collectible after the body.
 (define (parse-fn-body ps sto name dt)
   (scope-bind! ps name (%sym name 'fn (or sto 'extern) dt #f #t))
   (%parse-fn-body-inner ps name dt))
 
 (define (%parse-fn-body-inner ps name dt)
   (let* ((e (ctype-ext dt)) (ret (car e))
          (par (cadr e)) (var (car (cddr e))))
     (let ((psyms (cg-fn-begin/v (ps-cg ps) name par ret var)))
       (ps-fn-ctx-set! ps
         (%fn-ctx name ret (map cdr psyms) var '() 0))
       (scope-enter! ps)
       (for-each (lambda (p) (scope-bind! ps (car p) (cdr p)))
                 psyms)
       (expect-punct ps 'lbrace)
       (parse-cstmt-body ps)
       (expect-punct ps 'rbrace)
       (scope-leave! ps)
       (ps-fn-ctx-set! ps #f)
       (cg-fn-end (ps-cg ps)))))
 
 (define (parse-stmt ps)
   (pmatch (peek ps)
     (($ tok? (kind PUNCT) (value lbrace)) (parse-cstmt ps))
     (($ tok? (kind KW) (value if))        (parse-if-stmt ps))
     (($ tok? (kind KW) (value while))     (parse-while-stmt ps))
     (($ tok? (kind KW) (value do))        (parse-do-stmt ps))
     (($ tok? (kind KW) (value for))       (parse-for-stmt ps))
     (($ tok? (kind KW) (value switch))    (parse-switch-stmt ps))
     (($ tok? (kind KW) (value return))    (parse-return-stmt ps))
     (($ tok? (kind KW) (value goto))      (parse-goto-stmt ps))
     (($ tok? (kind KW) (value break))
      (advance ps) (expect-punct ps 'semi) (do-break ps))
     (($ tok? (kind KW) (value continue))
      (advance ps) (expect-punct ps 'semi) (do-continue ps))
     (($ tok? (kind KW) (value case))      (parse-case-stmt ps))
     (($ tok? (kind KW) (value default))   (parse-default-stmt ps))
     (($ tok? (kind KW) (value _Static_assert)) (parse-static-assert! ps))
     (($ tok? (kind IDENT))
      (guard (and (eq? (tok-kind (peek2 ps)) 'PUNCT)
                  (eq? (tok-value (peek2 ps)) 'colon)))
      (parse-labelled-stmt ps))
     (else
      (cond ((stmt-starts-decl? ps) (parse-local-decl ps))
            (else (parse-expr-stmt ps))))))
 
 (define (stmt-starts-decl? ps)
   (let ((t (peek ps)))
     (or (%tok-decl-start? ps t)
         ;; Storage classes only appear at declaration position; check here
         ;; rather than fold them into %tok-decl-start? (which is also
         ;; used for cast typenames where storage classes are illegal).
         (pmatch t
           (($ tok? (kind KW) (value ,v))
            (or (eq? v 'auto) (eq? v 'register) (eq? v 'static)
                (eq? v 'extern) (eq? v 'typedef)))
           (else #f)))))
 
 (define (parse-local-decl ps)
   (let-values (((sto b) (parse-decl-spec ps)))
     (cond
       ((at-punct? ps 'semi) (advance ps) #t)
       (else
        (let lp ()
          (let-values (((n t) (parse-declarator ps b)))
            (handle-decl ps sto n t)
            (cond ((at-punct? ps 'comma) (advance ps) (lp))
                  (else (expect-punct ps 'semi) #t))))))))
 
 (define (parse-cstmt ps)
   (expect-punct ps 'lbrace)
   (scope-enter! ps)
   (parse-cstmt-body ps)
   (scope-leave! ps)
   (expect-punct ps 'rbrace) #t)
 
 (define (parse-cstmt-body ps)
   (cond
     ((at-punct? ps 'rbrace) #t)
     ((eq? (tok-kind (peek ps)) 'EOF)
      (die (tok-loc (peek ps)) "EOF in cstmt"))
     (else (parse-stmt ps) (parse-cstmt-body ps))))
 
 (define (parse-compound-stmt ps) (parse-cstmt ps))
 
 (define (parse-if-stmt ps)
   (expect-kw ps 'if)
   (expect-punct ps 'lparen)
   (parse-expr ps) (rval! ps)
   (expect-punct ps 'rparen)
   (cg-ifelse (ps-cg ps)
              (lambda () (parse-stmt ps))
              (lambda ()
                (cond ((at-kw? ps 'else)
                       (advance ps) (parse-stmt ps))
                      (else #t)))))
 
 ;; cg-loop's body-thunk receives the tag from cg; the parser threads
 ;; it into break/continue via loop-ctx.
 
 (define (parse-while-stmt ps)
   (expect-kw ps 'while)
   (expect-punct ps 'lparen)
   (cg-loop (ps-cg ps)
            (lambda () (parse-expr ps) (rval! ps))
            (lambda (tag)
              (expect-punct ps 'rparen)
              (push-loop-ctx! ps 'while tag #t)
              (parse-stmt ps)
              (pop-loop-ctx! ps))) #t)
 
 (define (parse-do-stmt ps)
   (expect-kw ps 'do)
   ;; `continue` in a do-while must jump to the *cond test* (C11
   ;; §6.8.6.2 ¶2), not to the top of the body. The scoped loop labels
   ;; `.top` at the condition test and `.end` after the loop, so bare
   ;; %continue / %break bind through hex2++ local lookup.
   ;;
   ;; Layout:
   ;;   .scope
   ;;   :.body
   ;;     <body>
   ;;   :.top                 ; %continue jumps here
   ;;     <cond>
   ;;     %if_eqz(c, %break)
   ;;   %b(&.body)
   ;;   :.end
   ;;   .endscope
   (let* ((cg (ps-cg ps))
          (tag (%cg-fresh-loop-tag cg)))
     (%cg-emit-many cg (list ".scope\n"
                             ":.body\n"))
     (push-loop-ctx! ps 'do tag #t)
     (parse-stmt ps)
     (pop-loop-ctx! ps)
     (expect-kw ps 'while) (expect-punct ps 'lparen)
     (%cg-emit-many cg (list ":.top\n"))
     (parse-expr ps) (rval! ps)
     (expect-punct ps 'rparen) (expect-punct ps 'semi)
     (let ((c (cg-pop cg)))
       (%cg-load-truth-into cg c 't0)
       (%cg-emit-many cg (list "%if_eqz(t0, { %break })\n")))
     (%cg-emit-many cg (list "%b(&.body)\n"
                             ":.end\n"
                             ".endscope\n")))
   #t)
 
 (define (parse-for-stmt ps)
   (expect-kw ps 'for) (expect-punct ps 'lparen)
   (scope-enter! ps)
   (cond
     ((at-punct? ps 'semi) (advance ps))
     ((stmt-starts-decl? ps) (parse-local-decl ps))
     (else (parse-expr ps) (cg-pop (ps-cg ps))
           (expect-punct ps 'semi)))
   (let* ((cg (ps-cg ps))
          (cond-toks (cond
                       ((at-punct? ps 'semi) '())
                       (else (collect-til-top-punct ps 'semi "EOF in for-cond"))))
          (_ (expect-punct ps 'semi))
          (step-toks (collect-til-rparen ps))
          (_ (expect-punct ps 'rparen))
          (tag (%cg-fresh-loop-tag cg)))
     ;; A C `continue` in a for-loop must run the step expression before
     ;; retesting the condition. Arrange the loop as:
     ;;   jump test; top: step; test: condition; body; jump top
     (%cg-emit-many cg (list ".scope\n"
                             "%b(&.test)\n"
                             ":.top\n"))
     (parse-saved-expr-stmt ps step-toks)
     (%cg-emit-many cg (list ":.test\n"))
     (cond
       ((null? cond-toks) (cg-push-imm cg %t-i32 1))
       (else (parse-saved-expr ps cond-toks) (rval! ps)))
     (let ((c (cg-pop cg)))
       (%cg-load-truth-into cg c 't0)
       (%cg-emit-many cg (list "%if_eqz(t0, { %break })\n")))
     (push-loop-ctx! ps 'for tag #t)
     (parse-stmt ps)
     (pop-loop-ctx! ps)
     (%cg-emit-many cg (list "%b(&.top)\n"
                             ":.end\n"
                             ".endscope\n")))
   (scope-leave! ps) #t)
 
 (define (parse-saved-expr ps toks)
   (let ((sv (ps-iter ps)))
     (ps-iter-set! ps (make-list-iter (append toks (list (make-tok 'EOF #f #f)))))
     (parse-expr ps)
     (ps-iter-set! ps sv)))
 
 (define (parse-saved-expr-stmt ps toks)
   (cond
     ((null? toks) #t)
     (else (parse-saved-expr ps toks) (cg-pop (ps-cg ps)))))
 
 (define (collect-til-top-punct ps punct err)
   (let loop ((acc '()) (d 0))
     (let ((t (peek ps)))
       (cond
         ((eq? (tok-kind t) 'EOF)
          (die (tok-loc t) err))
         ((and (zero? d) (eq? (tok-kind t) 'PUNCT)
               (eq? (tok-value t) punct)) (reverse acc))
         (else
          (let ((nt (advance ps)))
            (loop (cons nt acc)
                  (cond ((not (eq? (tok-kind nt) 'PUNCT)) d)
                        ((or (eq? (tok-value nt) 'lparen)
                             (eq? (tok-value nt) 'lbrack)) (+ d 1))
                        ((or (eq? (tok-value nt) 'rparen)
                             (eq? (tok-value nt) 'rbrack)) (- d 1))
                        (else d)))))))))
 
 (define (collect-til-rparen ps)
   (collect-til-top-punct ps 'rparen "EOF in for-step"))
 
 (define (parse-switch-stmt ps)
   (expect-kw ps 'switch) (expect-punct ps 'lparen)
   (parse-expr ps) (rval! ps)
   (expect-punct ps 'rparen)
   ;; Switch's break-target tag is the swctx's end-tag — cg owns it,
   ;; and we read it back so cg-break inside the switch body emits a
   ;; tag cg actually labels.
   (let* ((sw (cg-switch-begin (ps-cg ps)))
          (tg (swctx-end-tag sw)))
     (push-loop-ctx-sw! ps 'switch tg sw)
     (parse-stmt ps)
     (pop-loop-ctx! ps)
     (cg-switch-end (ps-cg ps) sw)))
 
 (define (parse-case-stmt ps)
   (expect-kw ps 'case)
   (let ((v (parse-const-int ps)))
     (expect-punct ps 'colon)
     (cg-switch-case (ps-cg ps) (innermost-sw ps) v)
     (parse-stmt ps)))
 
 (define (parse-default-stmt ps)
   (expect-kw ps 'default) (expect-punct ps 'colon)
   (cg-switch-default (ps-cg ps) (innermost-sw ps))
   (parse-stmt ps))
 
 (define (parse-return-stmt ps)
   (expect-kw ps 'return)
   (cond
     ((at-punct? ps 'semi) (advance ps) (cg-return (ps-cg ps)))
     (else
      (let* ((fc  (ps-fn-ctx ps))
             (rty (and fc (fn-ctx-return-type fc)))
             (rk  (and rty (ctype-kind rty))))
        (cond
          ;; Struct/union return — leave the source as a struct lval;
          ;; cg-return copies bytes into the function's return slot.
          ;; (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)
   (expect-kw ps 'goto)
   (let ((t (advance ps)))
     (cond ((eq? (tok-kind t) 'IDENT)
            (cg-goto (ps-cg ps) (tok-value t)))
           (else (die (tok-loc t) "label?"))))
   (expect-punct ps 'semi))
 
 (define (parse-labelled-stmt ps)
   (let ((t (advance ps)))
     (expect-punct ps 'colon)
     (cg-emit-label (ps-cg ps) (tok-value t))
     (parse-stmt ps)))
 
 (define (parse-expr-stmt ps)
   (cond
     ((at-punct? ps 'semi) (advance ps) #t)
     (else (parse-expr ps) (cg-pop (ps-cg ps))
           (expect-punct ps 'semi))))
 
 (define (push-loop-ctx! ps k tg hc)
   (ps-loops-set! ps (cons (%loop-ctx k tg hc) (ps-loops ps))))
 (define (push-loop-ctx-sw! ps k tg sw)
   (ps-loops-set! ps
     (cons (%loop-ctx k (cons tg sw) #f) (ps-loops ps))))
 (define (pop-loop-ctx! ps)
   (ps-loops-set! ps (cdr (ps-loops ps))))
 (define (do-break ps)
   (let ((c (innermost-loop ps)))
     (cond
       ((not c) (die #f "break outside"))
       ((eq? (loop-ctx-kind c) 'switch)
        (cg-break (ps-cg ps) (car (loop-ctx-tag c))))
       (else (cg-break (ps-cg ps) (loop-ctx-tag c))))))
 (define (do-continue ps)
   (let ((c (innermost-cont ps)))
     (cond ((not c) (die #f "cont outside"))
           (else (cg-continue (ps-cg ps) (loop-ctx-tag c))))))
 (define (innermost-loop ps)
   (cond ((null? (ps-loops ps)) #f) (else (car (ps-loops ps)))))
 (define (innermost-cont ps)
   (let lp ((xs (ps-loops ps)))
     (cond ((null? xs) #f)
           ((eq? (loop-ctx-kind (car xs)) 'switch) (lp (cdr xs)))
           (else (car xs)))))
 (define (innermost-sw ps)
   (let lp ((xs (ps-loops ps)))
     (cond ((null? xs) (die #f "case outside switch"))
           ((eq? (loop-ctx-kind (car xs)) 'switch)
            (cdr (loop-ctx-tag (car xs))))
           (else (lp (cdr xs))))))
 
 (define %binop-bp
   (list
     (cons 'comma      (cons 1 2))
     (cons 'assign     (cons 4 3)) (cons 'plus-eq (cons 4 3))
     (cons 'minus-eq   (cons 4 3)) (cons 'star-eq (cons 4 3))
     (cons 'slash-eq   (cons 4 3)) (cons 'pct-eq  (cons 4 3))
     (cons 'shl-eq     (cons 4 3)) (cons 'shr-eq  (cons 4 3))
     (cons 'amp-eq     (cons 4 3)) (cons 'caret-eq (cons 4 3))
     (cons 'bar-eq     (cons 4 3)) (cons 'qmark   (cons 6 5))
     (cons 'lor (cons 10 11)) (cons 'land (cons 20 21))
     (cons 'bar (cons 30 31)) (cons 'caret (cons 40 41))
     (cons 'amp (cons 50 51))
     (cons 'eq2 (cons 60 61)) (cons 'ne (cons 60 61))
     (cons 'lt (cons 70 71)) (cons 'le (cons 70 71))
     (cons 'gt (cons 70 71)) (cons 'ge (cons 70 71))
     (cons 'shl (cons 80 81)) (cons 'shr (cons 80 81))
     (cons 'plus (cons 90 91)) (cons 'minus (cons 90 91))
     (cons 'star (cons 100 101)) (cons 'slash (cons 100 101))
     (cons 'pct (cons 100 101))))
 
 (define (binop-bp-of s) (alist-ref/eq s %binop-bp))
 
 (define (punct-to-cgop s)
   (cond ((eq? s 'plus)  'add) ((eq? s 'minus) 'sub)
         ((eq? s 'star)  'mul) ((eq? s 'slash) 'div)
         ((eq? s 'pct)   'rem) ((eq? s 'amp)   'and)
         ((eq? s 'bar)   'or)  ((eq? s 'caret) 'xor)
         ((eq? s 'shl)   'shl) ((eq? s 'shr)   'shr)
         ((eq? s 'eq2)   'eq)  ((eq? s 'ne)    'ne)
         ((eq? s 'lt)    'lt)  ((eq? s 'le)    'le)
         ((eq? s 'gt)    'gt)  ((eq? s 'ge)    'ge)
         (else (die #f "binop" s))))
 
 (define (compound-op s)
   (cond ((eq? s 'plus-eq)  'add) ((eq? s 'minus-eq) 'sub)
         ((eq? s 'star-eq)  'mul) ((eq? s 'slash-eq) 'div)
         ((eq? s 'pct-eq)   'rem) ((eq? s 'shl-eq)   'shl)
         ((eq? s 'shr-eq)   'shr) ((eq? s 'amp-eq)   'and)
         ((eq? s 'caret-eq) 'xor) ((eq? s 'bar-eq)   'or)
         (else #f)))
 
 (define (parse-expr ps) (parse-expr-bp ps 0))
 
 (define (parse-expr-bp ps mn)
   (parse-unary ps) (parse-binary-rhs ps mn))
 
 (define (parse-binary-rhs ps mn)
   (let ((t (peek ps)))
     (cond
       ((not (eq? (tok-kind t) 'PUNCT)) #t)
       (else
        (let ((bp (binop-bp-of (tok-value t))))
          (cond
            ((not bp) #t)
            ((< (car bp) mn) #t)
            (else
             (let ((op (tok-value t)) (rb (cdr bp)))
               (advance ps)
               (cond
                 ((eq? op 'comma)
                  ;; lhs has been parsed; discard it and evaluate rhs.
                  ;; Result of the comma expr is the rhs's rval.
                  (cg-pop (ps-cg ps))
                  (parse-expr-bp ps rb) (rval! ps))
                 ((eq? op 'assign)
                  ;; Struct/union assignment must memcpy the whole
                  ;; aggregate. The scalar cg-assign path loads/stores
                  ;; via a single 8-byte register, dropping any field at
                  ;; offset >= 8. Detect via the lhs (already on the
                  ;; vstack) and route to cg-assign-struct, which keeps
                  ;; rhs as an lvalue and emits a memcpy.
                  (let* ((lhs-top (cg-top (ps-cg ps)))
                         (lk (cond ((and (opnd? lhs-top) (opnd-lval? lhs-top))
                                    (ctype-kind (opnd-type lhs-top)))
                                   (else #f))))
                    (cond
                      ((or (eq? lk 'struct) (eq? lk 'union))
                       (parse-expr-bp ps rb)
                       (cg-assign-struct (ps-cg ps)))
                      (else
                       (parse-expr-bp ps rb) (rval! ps)
                       (cg-assign (ps-cg ps))))))
                 ((compound-op op)
                  (let ((b (compound-op op)))
                    (cg-dup (ps-cg ps))
                    (cg-load (ps-cg ps))
                    (parse-expr-bp ps rb) (rval! ps)
                    ;; Skip the usual arithmetic conversion for shift
                    ;; compounds (`<<=` / `>>=`) so the lhs's signedness
                    ;; survives; cg-binop's shr branch then picks the
                    ;; right arithmetic-vs-logical opcode.
                    (cond ((or (eq? b 'shl) (eq? b 'shr)) #t)
                          (else (cg-arith-conv (ps-cg ps))))
                    (cg-binop (ps-cg ps) b)
                    (cg-assign (ps-cg ps))))
                 ((eq? op 'qmark)
                  (rval! ps)
                  (cg-ifelse-merge (ps-cg ps)
                             (lambda ()
                               (parse-expr-bp ps 0) (rval! ps))
                             (lambda ()
                               (expect-punct ps 'colon)
                               (parse-expr-bp ps rb) (rval! ps))))
                 ((eq? op 'land)
                  (rval! ps)
                  ;; Both branches must push i32 0/1. Right side is
                  ;; coerced via `cg-cast bool` so the merge slot
                  ;; carries i32 (per §H.2).
                  (cg-ifelse-merge (ps-cg ps)
                             (lambda ()
                               (parse-expr-bp ps rb) (rval! ps)
                               (cg-cast (ps-cg ps) %t-bool)
                               (cg-cast (ps-cg ps) %t-i32))
                             (lambda ()
                               (cg-push-imm (ps-cg ps) %t-i32 0))))
                 ((eq? op 'lor)
                  (rval! ps)
                  (cg-ifelse-merge (ps-cg ps)
                             (lambda ()
                               (cg-push-imm (ps-cg ps) %t-i32 1))
                             (lambda ()
                               (parse-expr-bp ps rb) (rval! ps)
                               (cg-cast (ps-cg ps) %t-bool)
                               (cg-cast (ps-cg ps) %t-i32))))
                 (else
                  (rval! ps) (cg-promote (ps-cg ps))
                  (parse-expr-bp ps rb) (rval! ps)
                  (cg-promote (ps-cg ps))
                  ;; Shifts (C 6.5.7) only require integer promotion of
                  ;; each operand individually; the usual arithmetic
                  ;; conversion would force the lhs into an unsigned
                  ;; common type when the rhs is unsigned, breaking
                  ;; arithmetic-shift semantics for `signed >> unsigned`.
                  (cond ((or (eq? op 'shl) (eq? op 'shr)) #t)
                        (else (cg-arith-conv (ps-cg ps))))
                  (cg-binop (ps-cg ps) (punct-to-cgop op))))
               (parse-binary-rhs ps mn)))))))))
 
 (define (parse-unary ps)
   (pmatch (peek ps)
     (($ tok? (kind PUNCT) (value amp))
      (advance ps) (parse-unary ps)
      (cg-take-addr (ps-cg ps)))
     (($ tok? (kind PUNCT) (value star))
      (advance ps) (parse-unary ps) (rval! ps)
      (cg-push-deref (ps-cg ps)))
     (($ tok? (kind PUNCT) (value plus))
      (advance ps) (parse-unary ps)
      (rval! ps) (cg-promote (ps-cg ps)))
     (($ tok? (kind PUNCT) (value minus))
      (advance ps) (parse-unary ps)
      (rval! ps) (cg-promote (ps-cg ps))
      (cg-unop (ps-cg ps) 'neg))
     (($ tok? (kind PUNCT) (value tilde))
      (advance ps) (parse-unary ps)
      (rval! ps) (cg-promote (ps-cg ps))
      (cg-unop (ps-cg ps) 'bnot))
     (($ tok? (kind PUNCT) (value bang))
      (advance ps) (parse-unary ps) (rval! ps)
      (cg-unop (ps-cg ps) 'lnot))
     (($ tok? (kind PUNCT) (value inc))
      (advance ps) (parse-unary ps)
      (cg-dup (ps-cg ps))
      (cg-load (ps-cg ps))
      (cg-push-imm (ps-cg ps) %t-i32 1)
      (cg-binop (ps-cg ps) 'add) (cg-assign (ps-cg ps)))
     (($ tok? (kind PUNCT) (value dec))
      (advance ps) (parse-unary ps)
      (cg-dup (ps-cg ps))
      (cg-load (ps-cg ps))
      (cg-push-imm (ps-cg ps) %t-i32 1)
      (cg-binop (ps-cg ps) 'sub) (cg-assign (ps-cg ps)))
     (($ tok? (kind PUNCT) (value lparen)) (parse-cast-or-unary ps))
     (($ tok? (kind KW) (value sizeof))
      (advance ps)
      (cond
        ((at-punct? ps 'lparen)
         (advance ps)
         (cond
           ((token-is-decl? ps)
            (let*-values (((_sto bty) (parse-decl-spec ps))
                          ((_n   ty)  (parse-declarator ps bty)))
              (expect-punct ps 'rparen)
              (cg-push-imm (ps-cg ps) %t-word-u
                           (max (ctype-size ty) 0))))
           ;; A string literal has type char[N] until ordinary expression
           ;; conversion.  parse-primary deliberately lowers strings as
           ;; pointers for runtime expressions, so preserve the array bound
           ;; here before entering that path.  Kit's KIT_SLICE_LIT relies on
           ;; exactly this `sizeof("...") - 1` shape during parser setup.
           ((and (eq? (tok-kind (peek ps)) 'STR)
                 (eq? (tok-kind (peek2 ps)) 'PUNCT)
                 (eq? (tok-value (peek2 ps)) 'rparen))
            (let ((n (+ (bytevector-length (tok-value (peek ps))) 1)))
              (advance ps)
              (expect-punct ps 'rparen)
              (cg-push-imm (ps-cg ps) %t-word-u n)))
           (else
            ;; sizeof(EXPR): C semantics — operand is NOT evaluated.
            ;; Snapshot cg state, parse the expr to learn its type,
            ;; then rewind to discard any code emission and vstack
            ;; pushes the parse incurred (e.g. `sizeof(x++)` must not
            ;; increment x). cf. CC.md §Expressions.
            (let ((tag (cg-snapshot (ps-cg ps))))
              (parse-expr ps) (expect-punct ps 'rparen)
              (let* ((tp (cg-top (ps-cg ps)))
                     (sz (max (ctype-size (opnd-type tp)) 0)))
                (cg-rewind (ps-cg ps) tag)
                (cg-push-imm (ps-cg ps) %t-word-u sz))))))
        (else
         ;; sizeof EXPR (no parens) — same no-eval rule.
         (cond
           ((eq? (tok-kind (peek ps)) 'STR)
            (let ((n (+ (bytevector-length (tok-value (peek ps))) 1)))
              (advance ps)
              (cg-push-imm (ps-cg ps) %t-word-u n)))
           (else
            (let ((tag (cg-snapshot (ps-cg ps))))
              (parse-unary ps)
              (let* ((tp (cg-top (ps-cg ps)))
                     (sz (max (ctype-size (opnd-type tp)) 0)))
                (cg-rewind (ps-cg ps) tag)
                (cg-push-imm (ps-cg ps) %t-word-u sz))))))))
     (($ tok? (kind KW) (value _Alignof))
      (advance ps)
      (expect-punct ps 'lparen)
      (cond
        ((token-is-decl? ps)
         (let*-values (((_sto bty) (parse-decl-spec ps))
                       ((_n ty) (parse-declarator ps bty)))
           (expect-punct ps 'rparen)
           (cg-push-imm (ps-cg ps) %t-word-u
                        (max (ctype-align ty) 1))))
        (else
         (let ((tag (cg-snapshot (ps-cg ps))))
           (parse-expr ps)
           (expect-punct ps 'rparen)
           (let* ((tp (cg-top (ps-cg ps)))
                  (al (max (ctype-align (opnd-type tp)) 1)))
             (cg-rewind (ps-cg ps) tag)
             (cg-push-imm (ps-cg ps) %t-word-u al))))))
     (else (parse-postfix ps))))
 
 (define (token-is-decl? ps) (%tok-decl-start? ps (peek ps)))
 
 (define (parse-cast-or-unary ps)
   (cond
     ((or (%tok-decl-start? ps (peek2 ps))
          ;; A leading GNU attribute on the cast typename
          ;; (e.g. `((__attribute__((...)) int(*)(void))ptr)()`) — eaten
          ;; by parse-decl-spec along with the rest of the decl-spec.
          (let ((t (peek2 ps)))
            (and (eq? (tok-kind t) 'KW) (eq? (tok-value t) '__attribute__))))
      (advance ps)
      (let*-values (((_sto bty) (parse-decl-spec ps))
                    ((_n   ty)  (parse-declarator ps bty)))
        (expect-punct ps 'rparen)
        (cond
          ;; (T){ ... } — compound literal (C99 §6.5.2.5). Looks like a
          ;; cast at the typename level but disambiguates on the
          ;; following `{` and is a postfix lvalue, not a cast operator.
          ((at-punct? ps 'lbrace) (parse-compound-literal ps ty))
          (else
           (parse-unary ps)
           ;; Cast operand undergoes lvalue conversion first (C semantics):
           ;; arrays decay to pointers, lvals become rvals. cg-cast then
           ;; bit-casts the resulting rval to the target type.
           (rval! ps)
           (cg-cast (ps-cg ps) ty)))))
     (else (advance ps) (parse-expr ps)
           (expect-punct ps 'rparen)
           (parse-postfix-rest ps))))
 
 ;; --------------------------------------------------------------------
 ;; Compound literals (C99 §6.5.2.5):  (T){ init-list }
 ;;
 ;; Block scope — allocate a fresh frame slot sized for T, drive the
 ;; existing local-aggregate initializer path against it, then push a
 ;; frame lval typed as T. The literal is an lvalue with automatic
 ;; storage tied to the enclosing block, so &literal, literal.field,
 ;; literal[i], byval pass, and array decay all chain through the
 ;; existing primitives (cg-take-addr / cg-push-field / cg-decay-array
 ;; via rval!).
 ;;
 ;; File scope — handled out-of-band in %const-init-piece (incl. its `&`
 ;; arm) via %emit-fs-compound-literal: pieces go to .data under a fresh
 ;; cc__cl_N label and the enclosing initializer takes a (label-ref . LBL)
 ;; piece. Reaching parse-compound-literal at file scope would mean an
 ;; expression context outside an initializer (which file scope doesn't
 ;; have), so this entry point still rejects it.
 ;; --------------------------------------------------------------------
 (define (parse-compound-literal ps ty)
   (cond
     ((not (ps-fn-ctx ps))
      (die (tok-loc (peek ps)) "compound literal at file scope: unsupported")))
   (let* ((sz (max (ctype-size ty) 1))
          (al (max (ctype-align ty) 1))
          (sl (cg-alloc-slot (ps-cg ps) sz al))
          ;; Synthetic sym: parse-init-local-aggregate only reads
          ;; sym-slot at its top-level entry to seed base-off; the
          ;; recursive helpers thread `sm` along but never read other
          ;; fields. The name is unbound and never enters scope.
          (sm (%sym "__cl" 'var 'auto ty sl #t)))
     (cond
       ((or (eq? (ctype-kind ty) 'arr)
            (eq? (ctype-kind ty) 'struct)
            (eq? (ctype-kind ty) 'union))
        (parse-init-local-aggregate ps sm ty))
       (else
        ;; Scalar (T){expr [,]} — parse-init-local-aggregate's brace arm
        ;; only handles aggregates, so emit the single-element store
        ;; here directly.
        (expect-punct ps 'lbrace)
        (cg-push (ps-cg ps) (%opnd 'frame ty sl #t))
        (parse-expr-bp ps 4) (rval! ps)
        (cg-cast (ps-cg ps) ty)
        (cg-assign (ps-cg ps)) (cg-pop (ps-cg ps))
        (cond ((at-punct? ps 'comma) (advance ps)))
        (expect-punct ps 'rbrace)))
     ;; The literal is an lvalue with automatic storage. ctype-size may
     ;; have been resolved by parse-init-local-aggregate (e.g. (int[])
     ;; gets its bound fixed in-place); we re-fetch via the slot's type
     ;; pointer (ty) which the init code mutated.
     (cg-push (ps-cg ps) (%opnd 'frame ty sl #t))
     (parse-postfix-rest ps)))
 
 (define (parse-postfix ps)
   (parse-primary ps) (parse-postfix-rest ps))
 
 (define (parse-postfix-rest ps)
   (let lp ()
     (pmatch (peek ps)
       (($ tok? (kind PUNCT) (value lbrack))
        (advance ps) (rval! ps)
        (parse-expr ps) (rval! ps)
        (expect-punct ps 'rbrack)
        (cg-binop (ps-cg ps) 'add)
        (cg-push-deref (ps-cg ps)) (lp))
       (($ tok? (kind PUNCT) (value lparen))
        (advance ps) (rval-not-fn! ps)
        (let* ((fn-ty   (call-fn-type (ps-cg ps)))
               (n (parse-call-args ps fn-ty))
               ;; has-result? = #f for known void returns. Skips the
               ;; wasted ST a0 → frame-slot spill that cg-call would
               ;; otherwise emit for void calls.
               (has-result?
                (cond
                  ((not fn-ty) #t)
                  ((eq? (ctype-kind (car (ctype-ext fn-ty))) 'void) #f)
                  (else #t))))
          (expect-punct ps 'rparen)
          (cg-call (ps-cg ps) n has-result?)
          ;; Maintain parse's "one rval per expression" invariant so
          ;; comma / parse-expr-stmt / for-init/step pop sites stay
          ;; simple. The placeholder is vstack-only and never
          ;; materialized (cg-pop is a vstack op, no emit).
          (cond ((not has-result?)
                 (cg-push-imm (ps-cg ps) %t-i32 0)))
          (lp)))
       (($ tok? (kind PUNCT) (value dot))
        (advance ps)
        (pmatch (advance ps)
          (($ tok? (kind IDENT) (value ,n))
           (cg-push-field (ps-cg ps) n) (lp))
          (($ tok? (loc ,l)) (die l "expected field name"))))
       (($ tok? (kind PUNCT) (value arrow))
        (advance ps)
        (pmatch (advance ps)
          (($ tok? (kind IDENT) (value ,n))
           ;; ptr -> field: load the pointer to rval, deref to reach
           ;; the struct lval, then push the field.
           (rval! ps)
           (cg-push-deref (ps-cg ps))
           (cg-push-field (ps-cg ps) n) (lp))
          (($ tok? (loc ,l)) (die l "expected field name"))))
       (($ tok? (kind PUNCT) (value inc))
        (advance ps)
        (cg-postinc (ps-cg ps)) (lp))
       (($ tok? (kind PUNCT) (value dec))
        (advance ps)
        (cg-postdec (ps-cg ps)) (lp))
       (else #t))))
 
 ;; call-fn-type cg -> ctype-or-#f
 ;;   The function operand sits at the top of the vstack when
 ;;   parse-call-args runs (just after rval-not-fn!). Its type may be
 ;;   `fn` directly (named callee) or `ptr -> fn` (function pointer).
 ;;   Returns the underlying `fn` ctype, or #f if the operand isn't
 ;;   recognizably callable (callsite still works — no per-arg cast).
 (define (call-fn-type cg)
   (let* ((tp (cg-top cg)))
     (cond
       ((not tp) #f)
       (else
        (let* ((ty (opnd-type tp))
               (k  (ctype-kind ty)))
          (cond
            ((eq? k 'fn) ty)
            ((eq? k 'ptr)
             (let ((pe (ctype-ext ty)))
               (cond ((and pe (eq? (ctype-kind pe) 'fn)) pe)
                     (else #f))))
            (else #f)))))))
 
 ;; param-types-of fn-ty -> (params variadic?)  with a #f fallback.
 (define (call-fn-param-info fn-ty)
   (cond
     ((not fn-ty) (cons '() #f))
     (else
      (let ((ext (ctype-ext fn-ty)))
        (cons (cadr ext) (car (cddr ext)))))))
 
 ;; parse-call-args ps fn-ty -> arg-count
 ;;   Casts each fixed arg to the declared param type (CC.md §K.5).
 ;;   For variadic args (index >= named-arg count, when variadic? = #t)
 ;;   applies cg-promote (CC.md §G.1).
 (define (parse-call-args ps fn-ty)
   (cond
     ((at-punct? ps 'rparen) 0)
     (else
      (let* ((info  (call-fn-param-info fn-ty))
             (params (car info))
             (var?  (cdr info))
             (nfix  (length params)))
        (let lp ((n 0) (rem params))
          (parse-expr-bp ps 4) (rval! ps)
          (cond
            ;; Fixed-arg: cast to declared param type. param entry shape
            ;; is (name . ctype) per cg-fn-begin's contract.
            ((not (null? rem))
             (cg-cast (ps-cg ps) (cdr (car rem))))
            ;; Variadic position (n >= nfix and var? is true): promote.
            (var?
             (cg-promote (ps-cg ps))))
          (let ((m (+ n 1))
                (rest (if (null? rem) '() (cdr rem))))
            (cond ((at-punct? ps 'comma) (advance ps) (lp m rest))
                  (else m))))))))
 
 ;; --------------------------------------------------------------------
 ;; __builtin_va_* (§G.2). va_list / va_start / va_arg / va_end in
 ;; <stdarg.h> alias these. Each is parsed as: name '(' args ')'.
 ;; va_start(ap, last)  — last is parsed and discarded; cg only needs
 ;;   the variadic-first-slot offset, which it already tracks.
 ;; va_arg(ap, T)       — T is a type-name; result rval has that type.
 ;; va_end(ap)          — no-op codegen; just consumes ap.
 ;;
 ;; Pushes a single imm 0 for va_start / va_end so they fit as
 ;; expression statements; va_arg pushes the rval.
 ;; --------------------------------------------------------------------
 (define (parse-builtin-va-start ps)
   (advance ps)                                 ; IDENT
   (expect-punct ps 'lparen)
   (parse-expr-bp ps 4)                         ; ap (must be lval)
   (expect-punct ps 'comma)
   ;; "last" is parsed for syntactic completeness then dropped — cg
   ;; doesn't need it; the variadic-first-slot was determined at
   ;; cg-fn-begin/v time.
   (parse-expr-bp ps 4) (cg-pop (ps-cg ps))
   (expect-punct ps 'rparen)
   (cg-va-start (ps-cg ps))
   ;; Push a placeholder rval so the call expression has a value
   ;; (matches va_start's "void" but our parser expects all
   ;; expressions to leave one rval).
   (cg-push-imm (ps-cg ps) %t-i32 0))
 
 (define (parse-builtin-va-arg ps)
   (advance ps)                                 ; IDENT
   (expect-punct ps 'lparen)
   (parse-expr-bp ps 4)                         ; ap (lval)
   (expect-punct ps 'comma)
   (let*-values (((_sto bty) (parse-decl-spec ps))
                 ((_n   ty)  (parse-declarator ps bty)))
     (expect-punct ps 'rparen)
     (cg-va-arg (ps-cg ps) ty)))
 
 (define (parse-builtin-expect ps)
   ;; GCC `__builtin_expect(EXPR, EXPECTED)` — branch-prediction hint.
   ;; We ignore the hint and emit just the value of EXPR.
   (advance ps)                                  ; IDENT
   (expect-punct ps 'lparen)
   (parse-expr-bp ps 4) (rval! ps)               ; result
   (expect-punct ps 'comma)
   (parse-expr-bp ps 4) (cg-pop (ps-cg ps))      ; expected (drop)
   (expect-punct ps 'rparen))
 
 (define (parse-builtin-va-end ps)
   (advance ps)                                 ; IDENT
   (expect-punct ps 'lparen)
   (parse-expr-bp ps 4)                         ; ap
   (expect-punct ps 'rparen)
   (cg-va-end (ps-cg ps))
   (cg-push-imm (ps-cg ps) %t-i32 0))
 
 (define (parse-builtin-offsetof ps)
   ;; Reuse the constant aggregate-designator parser in ordinary expression
   ;; context; offsetof emits no code beyond materializing its integer value.
   (advance ps)                                 ; IDENT
   (let ((v (%const-builtin-offsetof ps)))
     (cg-push-imm (ps-cg ps) (cdr v) (car v))))
 
 (define (parse-primary ps)
   (let ((t (peek ps)))
     (pmatch t
       (($ tok? (kind INT) (value ,n))
        (advance ps)
        (cg-push-imm (ps-cg ps) (%c-int-type n) (%c-int-raw n)))
       (($ tok? (kind CHAR) (value ,c))
        (advance ps)
        ;; C99 §6.4.4.4: an integer character constant has type int.
        (cg-push-imm (ps-cg ps) %t-i32 c))
       (($ tok? (kind STR) (value ,s))
        (advance ps)
        (cg-push-string (ps-cg ps) s))
       (($ tok? (kind IDENT) (value ,n))
        (cond
          ((bv= n "__builtin_va_start") (parse-builtin-va-start ps))
          ((bv= n "__builtin_va_arg")   (parse-builtin-va-arg ps))
          ((bv= n "__builtin_va_end")   (parse-builtin-va-end ps))
          ((bv= n "__builtin_expect")   (parse-builtin-expect ps))
          ((bv= n "__builtin_offsetof") (parse-builtin-offsetof ps))
          (else
           (let ((sm (scope-lookup ps n)))
             (advance ps)
             (cond
               ((not sm) (die (tok-loc t) "undecl" n))
               ((eq? (sym-kind sm) 'enum-const)
                (cg-push-imm (ps-cg ps) %t-i32 (sym-slot sm)))
               (else (cg-push-sym (ps-cg ps) sm)))))))
       (($ tok? (kind PUNCT) (value lparen))
        (advance ps) (parse-expr ps) (expect-punct ps 'rparen))
       (else (die (tok-loc t) "unexp" (tok-value t))))))
 
 (define (rval! ps)
   (let ((tp (cg-top (ps-cg ps))))
     (cond ((and tp (opnd? tp) (opnd-lval? tp))
            (cg-load (ps-cg ps)))
           (else #t))))
 
 (define (rval-not-fn! ps)
   (let ((tp (cg-top (ps-cg ps))))
     (cond ((and tp (opnd? tp) (opnd-lval? tp)
                 (not (ctype-is-fn? (opnd-type tp))))
            (cg-load (ps-cg ps)))
           (else #t))))
 ;; cc/main.scm — driver. Argv, file I/O, ties phases together.
 
 ;; --------------------------------------------------------------------
 ;; CLI:   cc [--cc-debug] [--cc-trace-emit] [--lib=PFX]
 ;;           <input.c> <output.P1pp>
 ;;
 ;; scheme1 passes (argv) as a list of bvs; argv[0] is "scheme1", argv[1]
 ;; is the catm'd compiler source path, argv[2..] are the user-facing
 ;; positional args. cc-main strips the first two.
 ;; --------------------------------------------------------------------
 
 (define (%cc-slurp path)
   (let ((r (open-input path)))
     (cond ((not (car r))
            (die #f "cannot open input" path)))
     (let* ((p (cdr r))
            (rd (read-all p)))
       (close p)
       (cond ((not (car rd)) (die #f "read failed" path)))
       (cdr rd))))
 
 (define (%cc-write path bv)
   (let ((r (open-output path)))
     (cond ((not (car r))
            (die #f "cannot open output" path)))
     (let ((p (cdr r)))
       (write-bv-fd (port-fd p) bv)
       (close p)
       0)))
 
 (define (%cc-write-cg path cg)
   (let ((r (open-output path)))
     (cond ((not (car r))
            (die #f "cannot open output" path)))
     (let ((p (cdr r)))
       (%cg-write-finalized-fd cg (port-fd p))
       (close p)
       0)))
 
 ;; CC_DEBUG=1 in the env doesn't fly here (no getenv); instead, scan
 ;; argv for a sentinel "--cc-debug" flag. When present, debug-log
 ;; prints heap usage between phases to fd 2.
 (define (%cc-flag? args flag)
   (cond ((null? args) #f)
         ((bv= (car args) flag) #t)
         (else (%cc-flag? (cdr args) flag))))
 
 (define (%cc-strip-flag args flag)
   (cond ((null? args) '())
         ((bv= (car args) flag) (cdr args))
         (else (cons (car args) (%cc-strip-flag (cdr args) flag)))))
 
 ;; --lib=PFX selects library-mode codegen: cc.scm skips the p1_main
 ;; entry stub and trailing :ELF_end (the catm chain supplies them
 ;; from P1/entry-*.P1pp + P1/elf-end.P1pp once), and uses PFX as the
 ;; translation-unit namespace for internal-linkage symbols, strings,
 ;; compound literals, frame macros, and generated labels. Returns
 ;; (values prefix-bv rest-args). PREFIX = "" means exec mode (flag
 ;; absent). PREFIX = "" with the flag present is rejected — silently
 ;; falling back to exec mode would mask a typo'd Makefile rule.
 (define (%cc-take-lib args)
   (let loop ((acc '()) (rest args) (pfx #f))
     (cond
       ((null? rest)
        (values (cond (pfx pfx) (else "")) (reverse acc)))
       ((bv-prefix? "--lib=" (car rest))
        (cond (pfx (die #f "cc: --lib= specified twice")))
        (let* ((arg (car rest))
               (p   (bv-slice arg 6 (bytevector-length arg))))
          (cond ((= 0 (bytevector-length p))
                 (die #f "cc: --lib= requires a non-empty PREFIX")))
          (loop acc (cdr rest) p)))
       (else
        (loop (cons (car rest) acc) (cdr rest) pfx)))))
 
 ;; Predefined macros visible to every translation unit. CCSCM lets
 ;; tests/headers branch on "compiled by cc.scm" — e.g. skip <stdarg.h>
 ;; and use the __builtin_va_* primitives directly.
 (define %cc-initial-defines
   (list (cons "CCSCM" (%macro 'obj '() '()))))
 
 (define (cc-main av)
   (let* ((raw  (cdr (cdr av)))
          (dbg  (%cc-flag? raw "--cc-debug"))
          (a1   (%cc-strip-flag raw "--cc-debug"))
          (tr   (%cc-flag? a1 "--cc-trace-emit"))
          (a2   (%cc-strip-flag a1 "--cc-trace-emit")))
     (cond (dbg (debug-log-on!)))
     (cond (tr  (trace-emit-on!)))
     (let-values (((lib-prefix args) (%cc-take-lib a2)))
       (cond
         ((or (null? args) (null? (cdr args)))
          (die #f "usage: cc [--cc-debug] [--cc-trace-emit] [--lib=PFX] <input.c> <output.P1pp>")))
       (let* ((in-path  (car args))
              (out-path (car (cdr args)))
              (lib?     (cond ((= 0 (bytevector-length lib-prefix)) #f)
                              (else #t))))
         (debug-log "phase=start" "heap" (heap-usage))
         ;; Streaming pipeline: lex → pp → parser → cg, all concurrent.
         ;; Each stage pulls one tok at a time from upstream. Steady-state
         ;; live data is bounded by parser/pp state, not source length.
         (let* ((src      (%cc-slurp in-path))
                (_1       (debug-log "phase=slurp" "heap" (heap-usage)
                                     "src-bytes" (bytevector-length src)))
                (lex-iter (make-lex-iter src in-path))
                (pp-iter  (make-pp-iter lex-iter %cc-initial-defines))
                (cg       (cg-init/v lib? lib-prefix))
                (ps       (make-pstate pp-iter cg)))
           (parse-translation-unit ps)
           (debug-log "phase=parse" "heap" (heap-usage))
           (cg-finalize! cg)
           (debug-log "phase=cg-finish" "heap" (heap-usage)
                      "out-bytes" (cg-output-size cg))
           (%cc-write-cg out-path cg)
           0)))))