boot2

cc.scm (313483B)

---

 ;; cc/util.scm — leaf helpers. Depends only on the scheme1 prelude.
 
 ;; --------------------------------------------------------------------
 ;; bytevector helpers (scheme1 strings ARE bytevectors)
 ;; --------------------------------------------------------------------
 (define (bv= a b) (bytevector=? 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) (number->string n radix))
 
 ;; --------------------------------------------------------------------
 ;; lists / alists
 ;; --------------------------------------------------------------------
 (define (alist-ref    key al) (let ((p (assoc 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))
 
 (define (alist-update key f al)
   ;; Functional update by equal? key. 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)))
           ((equal? (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))))
 
 ;; --------------------------------------------------------------------
 ;; 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. This is what makes per-function
 ;; heap-mark/heap-rewind! safe in cg: the destination buf is fixed-
 ;; storage (allocated once, lives pre-mark), so byte-level mutations
 ;; survive a rewind that discards the parse/cg scratch.
 ;;
 ;; 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 ≈ 12.27 MiB on a
 ;; 64 MiB heap. 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       262144)    ; 256 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))))))))))
 
 ;; --------------------------------------------------------------------
 ;; 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 | 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!))
 
 ;; 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-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))
 
 ;; --------------------------------------------------------------------
 ;; 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.
 ;; Promotion (Phase 3 of CC-SCRATCH) relies on this: a deep-copied
 ;; sym in main heap is guaranteed structurally identical to its
 ;; scratch original.
 ;; --------------------------------------------------------------------
 (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)
   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!))
 
 ;; --------------------------------------------------------------------
 ;; world — cross-decl persistent parser/cg state. The same world record
 ;; is shared by pstate and cg so its slots — scope (var/typedef
 ;; bindings), tags (struct/union/enum tags), str-pool (interned string
 ;; literals), tentatives (file-scope tentative defs awaiting end-of-TU
 ;; BSS emission) — can be reasoned about as one boundary contract.
 ;; Phase 3's promote walkers deep-copy from this single root.
 ;; --------------------------------------------------------------------
 (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 '()) (list '()) '() '()))
 
 ;; --------------------------------------------------------------------
 ;; 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!. No per-fn allocation, which lets
 ;; the parse-decl-or-fn boundary (Phase 3, scratch heap) discard
 ;; everything the body allocated wholesale — fixed-storage byte writes
 ;; survive scratch reset because the buf storage was allocated in main.
 ;;
 ;; 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))))
 
 ;; --------------------------------------------------------------------
 ;; 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)
     ;; 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) ("_Alignas" . _Alignas)
     ("_Static_assert" . _Static_assert)
     ("_Complex" . _Complex) ("_Imaginary" . _Imaginary)))
 
 ;; 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.
 ;;
 ;; Heap discipline (per tests/scheme1/093-heap-mark-rewind.scm):
 ;; token-producing helpers wrap their inner work in call-with-heap-
 ;; rewind. Slots that must survive the rewind (start-loc and the
 ;; integer holders for npos/nline/ncol) are bound by an outer let
 ;; *before* the call-with-heap-rewind invocation, so the let's env
 ;; extensions live below the mark. The byte-run scanners' tail-call
 ;; env frames and any %lex-peek 4-lists are above the mark and get
 ;; reclaimed. For helpers that produce a fresh bytevector (ident,
 ;; string), the bv is allocated between the two calls so it persists
 ;; into the parent arena. Numeric digit runs accumulate inline via
 ;; %accum-int-while.
 ;;
 ;; %lex-iter-pull wraps each token-emitting iteration in an outer
 ;; call-with-heap-rewind. The helper allocates its own tok+loc+bv
 ;; above this outer mark; the driver reads the scalar fields and
 ;; copies any bv contents into %lex-scratch (sticky, pre-mark) before
 ;; the wrapper rewinds. Post-rewind it rebuilds a fresh tok+loc and a
 ;; fresh bv (for IDENT/STR) sized to the actual content.
 
 ;; --------------------------------------------------------------------
 ;; Cross-rewind transport for IDENT / STR bv values.
 ;;
 ;; %lex-scratch is a single sticky bytevector allocated below any
 ;; lex-tokenize heap-mark. The driver copies bv data here *before* the
 ;; rewind, then post-rewind allocates a fresh bv (sized exactly to the
 ;; ident/string content) by copying back out of scratch. The whole
 ;; lex run shares this one buffer.
 ;;
 ;; Why scratch, not a deduplicating intern pool: under scheme1's
 ;; interpreter, walking a cons-list pool per lookup costs ~50–150 B
 ;; per step in bind_params/eval_args/named-let env-extension
 ;; overhead. Even 16-way bucketing has the walk cost outpace the
 ;; bv-allocation savings until scheme1 grows a vector primitive
 ;; (an O(1) bucket lookup without interpreter overhead).
 ;; --------------------------------------------------------------------
 (define %lex-scratch-cap 65536)
 (define %lex-scratch (make-bytevector %lex-scratch-cap 0))
 
 (define (%lex-init!) #t)
 
 (define (%lex-scratch<- bv len)
   (cond ((> len %lex-scratch-cap)
          (die #f "lex: token exceeds scratch cap" len)))
   (let loop ((i 0))
     (cond ((< i len)
            (bytevector-u8-set! %lex-scratch i (bytevector-u8-ref bv i))
            (loop (+ i 1))))))
 
 (define (%lex-scratch->bv len)
   ;; Allocate a fresh bv (exact size) and copy scratch[0..len) into it.
   (let ((bv (make-bytevector len 0)))
     (let copy ((i 0))
       (cond ((< i len)
              (bytevector-u8-set! bv i (bytevector-u8-ref %lex-scratch i))
              (copy (+ i 1)))))
     bv))
 
 ;; --------------------------------------------------------------------
 ;; 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); the per-iteration env frames allocated
 ;; by tail recursion are reclaimed by the caller's heap-rewind!.
 ;;
 ;; - %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)
                         (+ (* 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)
                           (+ (* 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 with call-with-heap-rewind: pass 1 (%scan-while) sizes the
 ;; run, then between the two calls we allocate `name` bv so it survives
 ;; the second rewind, then pass 2 (%fill-while-bv) writes into it. The
 ;; integer slots count/npos/nline/ncol are bound by the outer let so
 ;; they survive both rewinds.
 ;; --------------------------------------------------------------------
 (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))
     (call-with-heap-rewind
       (lambda ()
         (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)))
       (call-with-heap-rewind
         (lambda ()
           (%fill-while-bv %ident-cont? src pos line col name 0)))
       (let ((kw (alist-ref name %keyword-alist)))
         (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-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)))
                (cons (make-tok 'INT val start-loc) 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)))
                  (cons (make-tok 'INT val start-loc) 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)))
            (cons (make-tok 'INT val start-loc) 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).
   (let loop ((pos pos) (line line) (col col))
     (let* ((p (%lex-peek src pos line col))
            (b (%pk-byte p)))
       (cond
         ((not b) (list pos line col))
         ((or (= b 117) (= b 85)    ; u U
              (= b 108) (= b 76))   ; l L
          (loop (%pk-pos p) (%pk-line p) (%pk-col p)))
         (else (list pos line col))))))
 
 ;; --------------------------------------------------------------------
 ;; 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); after rewind we 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
        (call-with-heap-rewind
          (lambda ()
            (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)))
          (call-with-heap-rewind
            (lambda ()
              (%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; per-token allocation reclaimed via heap-mark/rewind.
 ;; --------------------------------------------------------------------
 ;; 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 `#`.
 ;;
 ;; Heap discipline: each call to %lex-iter-pull is wrapped in a
 ;; call-with-heap-rewind. All scratch the helper allocates (the
 ;; helper's own tok/loc, the `(cons tok 4-list)` it returns, every
 ;; bind_params / let* / eval_args env-cons consumed getting in and out)
 ;; lives above the mark and is reclaimed before returning. Per-token
 ;; scratch (kind/val/vlen/loc-line/loc-col/npos/nline/ncol/nbol?) is
 ;; allocated in the outer `let` BEFORE the wrapper call — set! mutates
 ;; those cells in place across the rewind. Bv contents survive via the
 ;; sticky %lex-scratch buffer + %lex-scratch->bv (allocated post-rewind).
 ;; The survivors per token are tok (48 B) + loc (40 B) + bv if any.
 (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))
         ;; Per-iteration scratch — must be allocated BEFORE the call to
         ;; call-with-heap-rewind so that set!s issued from inside the
         ;; thunk still find live cells after the rewind.
         (kind #f) (val #f) (vlen 0)
         (loc-line 1) (loc-col 1)
         (npos 0) (nline 1) (ncol 1) (nbol? #f))
     (call-with-heap-rewind
      (lambda ()
       (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! vlen 0) (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
                   (let ((bv (tok-value tok)))
                     (set! vlen (bytevector-length bv))
                     (%lex-scratch<- bv vlen))))
            (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! vlen (bytevector-length bv))
            (%lex-scratch<- bv vlen)
            (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))))))))))
     ;; Reconstruct the survivor below the mark and advance state.
     (cond
       ((eq? kind 'EOF)
        (lex-state-done?-set! st #t)
        (make-tok 'EOF #f (%loc file loc-line loc-col)))
       (else
        (let ((tok-val (cond ((eq? kind 'IDENT) (%lex-scratch->bv vlen))
                             ((eq? kind 'STR)   (%lex-scratch->bv vlen))
                             (else val))))
          (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 tok-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 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 (alist-ref name (pps-macros st))))
               (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 bv. bv literals match by equal?.
 ;; 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)))
             (pps-macros-set! state (alist-set name m (pps-macros state))))))))))
 
 (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)))
          (pps-macros-set! state (alist-set name m (pps-macros state)))))
       ((%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
      (pps-macros-set! state
        (%pp-alist-drop (tok-value (car line)) (pps-macros state))))))
 
 (define (%pp-alist-drop key al)
   (cond ((null? al) '())
         ((bv= (car (car al)) key) (cdr al))
         (else (cons (car al) (%pp-alist-drop key (cdr al))))))
 
 ;; --- #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 (= v 0))))
        (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 (alist-ref name (pps-macros state))
       (%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 (= v 0))))
               (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)   (fixnum->bv v 10))
       ((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 (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 (alist-ref name (pps-macros state))))
                    (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) (fixnum->bv (tok-value rhs) 10))
              (tok-loc lhs) (%pp-bv-union (tok-hide lhs) (tok-hide rhs))))
       ((and (eq? lk 'INT) (eq? rk 'INT))
        (let ((s (bytevector-append (fixnum->bv (tok-value lhs) 10)
                                     (fixnum->bv (tok-value rhs) 10))))
          (let-values (((ok? n) (bv->fixnum s 10)))
            (cond
              ((not ok?) (die (tok-loc lhs) "paste: cannot reparse as integer" s))
              (else (%tok 'INT n (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.
 ;;
 ;; Arena boundary (test 093 A→B→C pattern). Everything inside the
 ;; call-with-heap-rewind thunk is scratch: `s1`/`s2`/`s3` plus the
 ;; parse-const-* (value . ctype) cells at every level. parse-const-int
 ;; returns the integer via `car`, which is a fixnum immediate and
 ;; survives the rewind. The error path goes through `die` (sys-exits),
 ;; so no rewind there.
 (define (%pp-make-const-ps toks)
   (%pstate (make-list-iter toks)
            (%world (list '()) (list '()) '() '())
            '() #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.
   (call-with-heap-rewind
     (lambda ()
       (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) (number->string n 10))
 
 ;; 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-name)))
     (bv-cat (list "(+ %" nm "__SO " (%n logical-off) ")"))))
 
 (define (%cg-mangle-global name-bv)
   (bytevector-append "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 sm)
   (cond
     ((eq? (sym-storage sm) 'static) (%cg-mangle-global (sym-name sm)))
     (else                            (sym-name sm))))
 
 (define (%cg-reg->bv r) (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
 ;;      shli/sari 56 to materialize the canonical 64-bit form).
 ;;   2/4: byte-decomposed (P1 has only 1-byte and 8-byte memory 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
 ;;      64-bit form.
 ;;   8 (and any other size): %ld / %st.
 ;; 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 64-bit 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
 ;; 8-byte 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-load-opnd-into cg op reg)
   ;; frame lval: load at type width. frame rval is a spilled word
   ;; (alloc-slot 8 8 in %cg-spill-reg) — always 8-byte load.
   ;; global lval width > 1 byte-gathers must not alias dest with base —
   ;; the first %lb would otherwise clobber the address before subsequent
   ;; byte loads. Stage the address in t2.
   (%cg-fp-reject! 'load (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 8 bytes, 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)
   (let* ((off (cg-alloc-slot cg 8 8))
          (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-finish 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"))))
   (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-fn-begin cg name params return-type)
   (cg-fn-begin/v cg name params return-type #f))
 
 ;; Variadic-aware variant. variadic? = #t reserves 16 contiguous 8-byte
 ;; slots covering incoming arg indices 0..15, populating each from the
 ;; appropriate source: a-register for idx 0..3, LDARG slot (idx-4) for
 ;; idx 4..15. va_start computes the address of the slot at index =
 ;; named-arg count, so va_arg walks linearly through the rest.
 ;; Indices 4..15 may be garbage when the caller passed fewer args; user
 ;; code stops walking based on a count or sentinel before those slots
 ;; are read. Limit of 15 variadic args (after named) is enough for
 ;; tcc.c's logging shapes; bump VARARG_WINDOW if you need more.
 (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)
   (%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. ≤8B → a0; 9–16B → a0+a1; >16B
   ;; 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) 8)
                     (else (align-up (max 8 (ctype-size return-type)) 8))))
          (ret-slot (cg-alloc-slot cg rsz 8)))
     (%cg-fn-set! cg '%fn-ret-slot ret-slot)
     (cond
       ((not (eq? (ctype-kind return-type) 'void))
        (let zinit ((k 0))
          (cond
            ((>= k rsz) #t)
            (else
             (buf-push! (cg-prologue-buf cg)
                        (bv-cat (list "%li(t0, 0)\n"
                                      "%st(t0, sp, "
                                      (%cg-slot-expr cg (+ ret-slot k))
                                      ")\n")))
             (zinit (+ k 8))))))))
   (let* ((rk    (ctype-kind return-type))
          (sret? (and (or (eq? rk 'struct) (eq? rk 'union))
                      (> (ctype-size return-type) 16))))
     (%cg-fn-set! cg '%fn-sret? sret?)
     (cond
       (sret?
        (let ((ss (cg-alloc-slot cg 8 8)))
          (%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))))
   ;; Variadic save area is capped at 16 incoming-arg slots; reject
   ;; variadic definitions whose named-arg count would already fill or
   ;; exceed it (no room left for variadic reads).
   (cond
     ((and variadic? (> (length params) 16))
      (die #f "cg-fn-begin: variadic function exceeds 16-arg save-area cap"
           name (length params))))
   ;; 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 16)
                  (%cg-fn-set! cg '%fn-vararg-first-slot (or vfirst fs))
                  (reverse out))
                 (else
                  (let ((off (cg-alloc-slot cg 8 8)))
                    (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))
                 ;; AAPCS: 9..16B aggregates ride two consecutive arg
                 ;; positions (regs or stack slots), wider-than-16B
                 ;; aggregates would normally pass by reference — not
                 ;; supported here yet.
                 (n    (%cg-param-reg-count ty))
                 (sz   (cond ((%cg-param-aggregate? ty)
                              (align-up (ctype-size ty) 8))
                             (else 8)))
                 (al   (cond ((%cg-param-aggregate? ty)
                              (max 8 (ctype-align ty)))
                             (else 8)))
                 (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 8)))
                     (chunk (+ i 1)))))
            (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 ≤16B take ⌈size/8⌉; everything else 1.
 (define (%cg-param-reg-count ty)
   (cond
     ((%cg-param-aggregate? ty)
      (let ((sz (ctype-size ty)))
        (cond
          ((> sz 16)
           (die #f "cg: aggregate arg/param >16B not supported" sz))
          ((> sz 8) 2)
          (else 1))))
     (else 1)))
 
 (define (%cg-param-aggregate? ty)
   (let ((k (ctype-kind ty)))
     (or (eq? k 'struct) (eq? k 'union))))
 
 (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. Net result: zero net heap allocation in
   ;; cg-fn-end other than the small (%n N) bvs for staging-bytes /
   ;; frame-size, which the enclosing parse-decl-or-fn boundary's
   ;; reset-scratch-heap! reclaims.
   (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 (* 8 (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.
          (fn-sym        (alist-ref name (car (world-scope (cg-world cg)))))
          (mangled       (cond (fn-sym (%cg-sym-label fn-sym))
                               (else name)))
          (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 name)
     (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: ≤8B → a0; 9–16B → a0+a1; >16B sret → a0 = saved sret ptr.
     (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) 8)
             (buf-push! tb "%ld(a1, sp, ")
             (buf-push! tb (%cg-slot-expr cg (+ ret-slot 8)))
             (buf-push! tb ")\n"))))))
     (buf-push! tb "})\n")
     (cg-vstack-set!       cg '())
     (cg-frame-hi-set!     cg 0)
     (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.
 ;; --------------------------------------------------------------------
 (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)))
 
 (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)))
 
 ;; 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 (%ctype 'ptr 8 8 %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 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 sm) #t)))
     (($ sym? (kind var) (storage static) (type ,ty))
      (cg-push cg (%opnd 'global ty (%cg-sym-label 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 8 8)))
          (%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 8 8)))
                    (%cg-emit-st-slot cg 't0 no)
                    (%cg-mark-indirect! cg no)
                    (cg-push cg (%opnd 'frame fty no #t))))
                 ;; global lval: load addr, add offset, indirect slot.
                 (($ 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 8 8)))
                    (%cg-emit-st-slot cg 't0 no)
                    (%cg-mark-indirect! cg no)
                    (cg-push cg (%opnd 'frame fty no #t))))
                 (else
                  (die #f "cg-push-field: unsupported lval kind"
                       (opnd-kind s))))))))))))
 
 ;; cg-decay-array:
 ;;   if top of vstack is an arr-typed lval, replace it with a ptr-rval
 ;;   to the first element. C arrays decay to T* in most contexts;
 ;;   parse calls this before rval-style operations. No-op otherwise.
 (define (cg-decay-array cg)
   (let ((tp (cg-top cg)))
     (cond
       ((and (opnd-lval? tp) (eq? (ctype-kind (opnd-type tp)) 'arr))
        (let* ((p   (cg-pop cg))
               (et  (car (ctype-ext (opnd-type p))))
               (pty (%ctype 'ptr 8 8 et)))
          (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 (%ctype 'ptr 8 8 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
       ;; existing 8-byte spill path silently truncated anything
       ;; wider (the bug that broke `c = cond ? a : b` for
       ;; sizeof(struct) > 8). Surrounding expression 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))
       ((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)
        (%cg-load-opnd-into cg p 't0)
        (%cg-emit-many cg (list "%bool(t0, t0)\n"))
        (%cg-spill-reg cg 't0 to-type))
       ((or (eq? to-kind 'ptr)
            (and (or (eq? to-kind 'i64) (eq? to-kind 'u64))
                 (or (eq? (ctype-kind from-ty) 'ptr)
                     (eq? (ctype-kind from-ty) 'arr))))
        (cg-push cg (%opnd (opnd-kind p) to-type (opnd-ext p) (opnd-lval? p))))
       ;; 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 64-bit 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-i64)
             (a-ptr? ta)
             (b-ptr? tb)
             (else ta))))
     (cond
       ((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 "div" 't0 'a0 'a1))
          ((eq? op 'rem) (%cg-emit-rrr cg "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)))
     (%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)))
       (%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 > 16B return; 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-i64)))
                 (else %t-i64)))
          (rk  (ctype-kind rty))
          (sret? (and has-result?
                      (or (eq? rk 'struct) (eq? rk 'union))
                      (> (ctype-size rty) 16)))
          ;; If the callee is variadic, the callee's save area caps total
          ;; incoming args at 16. 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))))))
          (_cap-check (cond
                        ((and callee-variadic? (> arity 16))
                         (die #f "cg-call: variadic call exceeds 16-arg save-area cap"
                              arity))
                        (else 0)))
          (sret-shift (if sret? 1 0))
          (recv-slot (cond
                       (sret?
                        (cg-alloc-slot cg
                                       (align-up (ctype-size rty) 8)
                                       (max 8 (ctype-align rty))))
                       (else #f))))
     (let stage ((xs args) (idx 0))
       (cond
         ((null? xs) 0)
         (else
          (let* ((arg (car xs))
                 (aty (opnd-type arg))
                 (n   (%cg-param-reg-count aty)))
            (cond
              ;; Aggregate >8B: load both halves into successive arg
              ;; regs / stack slots. Stage the struct's address in t0
              ;; once and chunk-load 8 bytes at a time.
              ((and (%cg-param-aggregate? aty) (> n 1))
               (%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 8)) ")\n")))
                        (else
                         (%cg-emit-many cg
                                        (list "%ld(t1, t0, "
                                              (%n (* i 8)) ")\n"))
                         (%cg-emit-st cg 't1 'sp (* 8 (- tabi 4))))))
                    (chunk (+ i 1)))))
               (stage (cdr xs) (+ idx n)))
              (else
               (let ((abi (+ idx sret-shift)))
                 (cond
                   ((< abi 4)
                    (%cg-load-opnd-into cg arg (%reg-by-idx abi))
                    (stage (cdr xs) (+ idx 1)))
                   (else
                    (%cg-load-opnd-into cg arg 't0)
                    (%cg-emit-st cg 't0 'sp (* 8 (- abi 4)))
                    (stage (cdr xs) (+ 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
          ;; >16B sret (A2): a0 holds recv-slot; push as struct lval.
          (sret? (cg-push cg (%opnd 'frame rty recv-slot #t)))
          ;; ≤16B struct/union (A1): fresh slot, spill from a0/a1.
          ((and (or (eq? rk 'struct) (eq? rk 'union))
                (<= (ctype-size rty) 16))
           (let* ((sz   (ctype-size rty))
                  (al   (max 8 (ctype-align rty)))
                  (slot (cg-alloc-slot cg (align-up sz 8) al)))
             (%cg-emit-st-slot cg 'a0 slot)
             (cond ((> sz 8) (%cg-emit-st-slot cg 'a1 (+ slot 8))))
             (cg-push cg (%opnd 'frame rty slot #t))))
          (else
           (%cg-spill-reg cg 'a0 rty))))
       (else #f))))
 
 ;; --------------------------------------------------------------------
 ;; Return
 ;; --------------------------------------------------------------------
 (define (cg-return cg)
   (let* ((ret-slot (%cg-fn-get cg '%fn-ret-slot))
          (ret-type (%cg-fn-get cg '%fn-ret-type))
          (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: ≤16B (A1) → ret-slot; >16B (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"))))
       (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-opnd-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-opnd-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 8-byte
 ;; 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-opnd-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 8-byte 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)))
            (slot  (cond (aggr?
                          (cg-alloc-slot cg
                                         (align-up (ctype-size rty1) 8)
                                         (max 8 (ctype-align rty1))))
                         (else
                          (cg-alloc-slot cg 8 8)))))
       (%cg-merge-write-arm cg p slot aggr?)
       (%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?)
         (%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?)
   (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))))
     (else
      (%cg-load-opnd-into cg op 'a0)
      (%cg-emit-st-slot cg 'a0 slot))))
 
 ;; Usual arithmetic conversion over two ctypes (C11 §6.3.1.8):
 ;; integer-promote each (sub-int → int), then pick the wider with
 ;; unsigned tie-break. Falls back to t1 for non-arithmetic kinds
 ;; (pointer, struct, array — ternary on those preserves the first
 ;; arm's type as before).
 (define (%cg-merge-arith-type t1 t2)
   (cond
     ((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-opnd-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 16-slot
 ;; (8 bytes each) save area at known frame offsets, populating each
 ;; slot from the appropriate ABI source — a-register for indices 0..3,
 ;; LDARG for indices 4..15. va_start sets ap to the address of the
 ;; first slot past the named-arg count; va_arg reads *ap, advances ap
 ;; by 8, 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 args (named + variadic) must fit in the 16-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 8 bytes at [a0] into a1.
   ;; Advance a0 by 8 and store back through ap-lval. Push a1 as rval
   ;; of type ctype (caller cg-cast's if needed).
   (let ((ap-lv (cg-pop cg)))
     (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 *ap into a1 (full 8 bytes; cg-cast on the rval the caller
     ;; pushes will narrow if needed). Advance ap by 8 and store back.
     (%cg-emit-ld cg 'a1 'a0 0)
     (%cg-emit-many cg (list "%addi(a0, a0, 8)\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-name)))
     (bv-cat (list "cc__" 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 end-tag default-lbl)
   swctx?
   (ctrl-slot   swctx-ctrl-slot)
   (end-tag     swctx-end-tag)
   (default-lbl swctx-default-lbl swctx-default-lbl-set!))
 
 (define (cg-switch-begin cg)
   (let* ((p   (cg-pop cg))
          (off (cg-alloc-slot cg 8 8))
          (tag (%cg-fresh-loop-tag cg))
          (disp-lbl (bytevector-append "sw_disp_" tag)))
     (%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 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"))
     (%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>) — 8-byte pointer slot containing &label;
 ;;                              emitted as `&<label> %(0)` (4B label ref +
 ;;                              4B zero pad).
 (define (%cg-init-piece->bv piece)
   (cond
     ((bytevector? piece)
      (bv-cat (%cg-bv->hex-lines piece #f)))
     ((and (pair? piece) (eq? (car piece) 'label-ref))
      (bv-cat (list "&" (cdr piece) " %(0)\n")))
     (else (die #f "cg-emit-global: bad init piece" piece))))
 
 (define (cg-emit-global cg sym init)
   (let* ((lbl (%cg-sym-label sym))
          (sz  (ctype-size (sym-type sym)))
          (size (if (< sz 0) 8 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. Idempotent — extra entries with the same
 ;; name are harmless (cg-finish dedupes via scope-lookup).
 (define (cg-add-tentative! cg n)
   (let* ((w (cg-world cg))
          (cur (world-tentatives w)))
     (cond
       ((member n cur) #t)
       (else (world-tentatives-set! w (cons n cur))))))
 
 ;; 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 (alist-ref n top)))
           (cond
             ((and sm
                   (eq? (sym-kind sm) 'var)
                   (not (sym-defined? sm)))
              (cg-emit-global cg sm #f)))))
       (world-tentatives w))))
 
 (define (cg-intern-string cg bv-content)
   (let ((p (alist-ref bv-content (cg-str-pool cg))))
     (cond
       (p p)
       (else
        (let* ((n   (length (cg-str-pool cg)))
               (lbl (bytevector-append
                     (cg-str-prefix cg) "cc__str_" (%n n))))
          (cg-str-pool-set! cg
            (alist-set bv-content lbl (cg-str-pool cg)))
          (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 '() (ps-scope ps)))
   (ps-tags-set!  ps (cons '() (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* ((f (ps-scope ps)) (top (car f)) (r (cdr f))
          (old (alist-ref n top)))
     (cond
       ((not old)
        (ps-scope-set! ps (cons (alist-set n s top) r)))
       (else
        (let ((merged (sym-merge old s)))
          (cond
            ((eq? merged old) #t)
            (else
             (ps-scope-set! ps (cons (alist-set n merged top) r)))))))))
 (define (scope-lookup ps n)
   (let loop ((f (ps-scope ps)))
     (cond ((null? f) #f)
           (else
            (let ((v (alist-ref n (car f))))
              (if v v (loop (cdr f))))))))
 (define (tag-bind! ps n c)
   (let* ((f (ps-tags ps)) (top (car f)) (r (cdr f)))
     (ps-tags-set! ps (cons (alist-set n c top) r))))
 (define (tag-lookup ps n)
   (let loop ((f (ps-tags ps)))
     (cond ((null? f) #f)
           (else (let ((v (alist-ref n (car f))))
                   (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 8 8 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)))
 
 (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))
          (advance 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 '_Alignas) (at-kw? ps '_Generic)
              (at-kw? ps '_Alignof) (at-kw? ps '_Static_assert))
          (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
         ;; 8-byte 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 (%ctype 'ptr 8 8 %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))
            (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 (alist-ref tag (car (ps-tags ps)))))
               (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))
         (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))
     ;; Phase 3: if `ct` is a forward-declared struct/union that lived in
     ;; main from a prior decl, its newly-set ext lives in scratch and
     ;; would dangle on reset-scratch-heap!. Track it so promote-roots!
     ;; can rewrite ext in main before the boundary fires. Scratch-resident
     ;; ct (defined and completed in this decl) is promoted normally via
     ;; the tag walker.
     (set! %promote-pending-completions
           (cons ct %promote-pending-completions))))
 
 (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) (+ 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))
          (mask (cond ((<= sz 0) 0)
                      ((= sz 1) #xff)
                      ((= sz 2) #xffff)
                      ((= sz 4) #xffffffff)
                      (else -1))))
     (cond
       ;; bool: 0 or 1.
       ((eq? k 'bool) (if (= value 0) 0 1))
       ;; 8-byte integers — value already fits in scheme's bignum.
       ((or (eq? k 'i64) (eq? k 'u64))
        (cond ((eq? k 'u64)
               ;; Mask to 64 bits without losing sign on negative values.
               (bit-and value #xffffffffffffffff))
              (else value)))
       ((%ctype-unsigned? ct) (bit-and value mask))
       (else
        ;; Signed: mask to width, then sign-extend if top bit is set.
        (let* ((m (bit-and value mask))
               (sign-bit (arithmetic-shift 1 (- (* sz 8) 1))))
          (cond ((= 0 (bit-and m sign-bit)) m)
                (else (- m (arithmetic-shift 1 (* sz 8))))))))))
 
 ;; 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 (= 0 (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 fn, truncate.
 (define (%const-arith-op fn a b)
   (let-values (((av bv rt) (%const-arith-conv (%const-promote a) (%const-promote b))))
     (cons (%const-trunc (fn av bv) rt) rt)))
 
 ;; Like %const-arith-op but rejects a zero divisor.
 (define (%const-div-op fn a b)
   (let-values (((av bv rt) (%const-arith-conv (%const-promote a) (%const-promote b))))
     (cond ((= bv 0) (die #f "const-expr: divide by zero")))
     (cons (%const-trunc (fn av bv) rt) rt)))
 
 ;; Comparison combiner: result is always (0-or-1 . %t-i32).
 (define (%const-cmp-op fn a b)
   (let-values (((av bv _rt) (%const-arith-conv (%const-promote a) (%const-promote b))))
     (cons (if (fn av bv) 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 bit-or  a b))))))
 (define (parse-const-bxor ps)
   (%const-binl ps parse-const-band (list (cons 'caret (lambda (a b) (%const-arith-op bit-xor a b))))))
 (define (parse-const-band ps)
   (%const-binl ps parse-const-eq   (list (cons 'amp   (lambda (a b) (%const-arith-op bit-and a b))))))
 
 (define (parse-const-eq ps)
   (%const-binl ps parse-const-rel
     (list (cons 'eq2 (lambda (a b) (%const-cmp-op =                         a b)))
           (cons 'ne  (lambda (a b) (%const-cmp-op (lambda (x y) (not (= x y))) a b))))))
 
 (define (parse-const-rel ps)
   (%const-binl ps parse-const-shift
     (list (cons 'lt (lambda (a b) (%const-cmp-op <  a b)))
           (cons 'le (lambda (a b) (%const-cmp-op <= a b)))
           (cons 'gt (lambda (a b) (%const-cmp-op >  a b)))
           (cons 'ge (lambda (a b) (%const-cmp-op >= 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)))
     (cons (%const-trunc (arithmetic-shift (car ap) (* sign (car bp))) 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 + a b)))
           (cons 'minus (lambda (a b) (%const-arith-op - a b))))))
 
 (define (parse-const-mul ps)
   (%const-binl ps parse-const-cast
     (list (cons 'star  (lambda (a b) (%const-arith-op *         a b)))
           (cons 'slash (lambda (a b) (%const-div-op   quotient  a b)))
           (cons 'pct   (lambda (a b) (%const-div-op   remainder 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 (- 0 (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 (bit-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-u64)))
             (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-u64))))
          (else
           ;; `sizeof EXPR` (no parens). Same no-eval rule.
           (cons (%const-sizeof-expr ps #f) %t-u64))))
       (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)))
     (($ tok? (kind IDENT) (value ,n)) (typedef? ps n))
     (else #f)))
 
 (define (%const-tok-is-decl? ps) (%tok-decl-start? ps (peek ps)))
 
 (define (parse-const-primary ps)
   (let ((t (peek ps)))
     (pmatch t
       (($ tok? (kind INT) (value ,v))
        (advance ps)
        ;; Untyped INT literals ride as i32. Suffixes (L, LL, U) aren't
        ;; preserved through to the parser, but const-expr operands at
        ;; the granularity 118 cares about all fit in i32.
        (cons v %t-i32))
       (($ 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))
        (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-sizeof-expr ps paren?)
   (cond
     ((not (ps-cg ps))
      (die #f "#if: sizeof of expression not valid in preprocessor context"))
     (else
      (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)))))
 
 ;; 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")))))))))))
 
 ;; ====================================================================
 ;; Phase 3: parse-decl-or-fn boundary — scratch by default, promote
 ;; surviving roots into main and reset scratch at each top-level decl.
 ;;
 ;; Promotion uses the prelude's generic deep-copy via
 ;; call-with-scratch-cycle; the per-decl identity-preserving map is
 ;; folded into a single deep-copy context shared across all roots.
 ;;
 ;; Per-decl mutable state retained on the cc side:
 ;;   %promote-pending-completions: list of struct/union ctypes that
 ;;     complete-agg! mutated during the current decl. These are
 ;;     pre-existing main-heap records whose ext now points at scratch;
 ;;     ext is rewritten via deep-copy before the scratch reset.
 ;; ====================================================================
 
 (define %promote-pending-completions '())
 
 (define (rewrite-pending-completions! ctx)
   (for-each
     (lambda (c)
       (cond ((heap-in-main? c)
              (ctype-ext-set! c (deep-copy ctx (ctype-ext c))))))
     %promote-pending-completions)
   (set! %promote-pending-completions '()))
 
 ;; Deep-copy each top-level world alist into main. The world-tags /
 ;; world-scope stacks contain only the file-scope frame at decl
 ;; boundaries (nested frames popped by scope-leave!); rebuild that head
 ;; frame and preserve the (always-empty) tail. world-str-pool is a flat
 ;; alist. deep-copy short-circuits prior-decl entries via heap-in-current?,
 ;; so this is linear in the new entries only.
 (define (promote-roots! w ctx)
   (rewrite-pending-completions! ctx)
   (let ((tn (world-tags w)))
     (world-tags-set! w (cons (deep-copy ctx (car tn)) (cdr tn))))
   (let ((sn (world-scope w)))
     (world-scope-set! w (cons (deep-copy ctx (car sn)) (cdr sn))))
   (world-str-pool-set!   w (deep-copy ctx (world-str-pool   w)))
   (world-tentatives-set! w (deep-copy ctx (world-tentatives w))))
 
 ;; Iter-buffer carryover. The pp-iter / lex-iter records themselves
 ;; live in main from cc-init; only their tok-iter-buf slots and the
 ;; pp-state's pending / out / cur-file / macros slots can hold
 ;; scratch-allocated content. Rewrite each in place via deep-copy.
 (define (promote-iter-buffers! pp-it ctx)
   (let* ((st     (tok-iter-state pp-it))
          (lex-it (pps-lex-iter st)))
     (tok-iter-buf-set! pp-it (deep-copy ctx (tok-iter-buf pp-it)))
     (cond (lex-it
            (tok-iter-buf-set! lex-it
              (deep-copy ctx (tok-iter-buf lex-it)))))
     (pps-up-pending-set! st (deep-copy ctx (pps-up-pending st)))
     (pps-out-buf-set!    st (deep-copy ctx (pps-out-buf    st)))
     (pps-cur-file-set!   st (deep-copy ctx (pps-cur-file   st)))
     (pps-cond-stack-set! st (deep-copy ctx (pps-cond-stack st)))
     (pps-macros-set!     st (deep-copy ctx (pps-macros     st)))))
 
 (define (parse-translation-unit ps)
   (let loop ()
     (let ((at-eof? #f))
       (call-with-scratch-cycle
         (lambda ()
           (cond
             ((eq? (tok-kind (peek ps)) 'EOF) (set! at-eof? #t))
             (else
              (cond
                ((debug-log?)
                 (let ((loc (tok-loc (peek ps))))
                   (debug-log "decl" "line" (loc-line loc)
                              "heap" (heap-usage)))))
              (parse-decl-or-fn ps))))
         (lambda ()
           (cond
             ((not at-eof?)
              (let ((ctx (make-deep-copy-context)))
                (promote-roots! (ps-world ps) ctx)
                (promote-iter-buffers! (ps-iter ps) ctx))
              ;; cg-fn-meta may hold scratch alist conses left over from
              ;; the just-finished function; cg-fn-begin would reset it,
              ;; but a trailing fn means it'd dangle past the reset.
              (cg-fn-meta-set! (ps-cg ps) '())))))
       (cond
         (at-eof? #t)
         (else (loop))))))
 
 (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 name mangled
     ;; on the enclosing function so two functions can each have their
     ;; own `static int n;` without colliding. The sym's NAME holds the
     ;; mangled form (cg-push-sym / cg-emit-global both prefix "cc__"
     ;; onto sym-name to derive the emitted label); scope-bind!s key
     ;; remains the original identifier for source-level lookup.
     ((and (eq? sto 'static) (ps-fn-ctx ps))
      (let* ((fname (fn-ctx-name (ps-fn-ctx ps)))
             (mangled (bytevector-append fname "__" 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)))
     (let loop ((i 0) (v n))
       (cond
         ((= i nbytes) out)
         (else
          (bytevector-u8-set! out i (bit-and v 255))
          (loop (+ i 1) (arithmetic-shift v -8)))))))
 
 ;; 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
       ;; 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 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 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)))))))
 
 (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) '())
         ((equal? (car (car fields)) fname) (cdr fields))
         (else (%init-drop-thru-field (cdr fields) fname))))
 
 ;; 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
       ((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-elem ps sm eoff t elide?)
   (let ((k (ctype-kind t)))
     (cond
       ((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
          (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))
 
 ;; Static aggregate init streaming support. parse-translation-unit runs
 ;; declarations in scratch, but a large file-scope array initializer can
 ;; contain hundreds of independent elements. Parse one array element
 ;; past a heap mark, promote the element pieces and parser lookahead into
 ;; main, rewind that element's transient lexer/pp/const-expr scratch, and
 ;; keep the outer pieces list in main as well.
 (define (%init-promote-unit ps thunk)
   (let ((mark (heap-mark)))
     (let ((scratch-result (thunk)))
       (use-main-heap!)
       (let ((ctx (make-deep-copy-context)))
         (promote-roots! (ps-world ps) ctx)
         (promote-iter-buffers! (ps-iter ps) ctx)
         (let ((main-result (deep-copy ctx scratch-result)))
           (use-scratch-heap!)
           (heap-rewind! mark)
           main-result)))))
 
 (define (%init-main-cons x xs)
   (use-main-heap!)
   (let ((r (cons x xs)))
     (use-scratch-heap!)
     r))
 
 (define (%init-main-reverse xs)
   (use-main-heap!)
   (let ((r (reverse xs)))
     (use-scratch-heap!)
     r))
 
 (define (%init-main-prepend-reversed xs acc)
   (use-main-heap!)
   (let loop ((ys xs) (out acc))
     (cond
       ((null? ys)
        (use-scratch-heap!)
        out)
       (else
        (loop (cdr ys) (cons (car ys) out))))))
 
 (define (%init-main-pad-piece nbytes)
   (use-main-heap!)
   (let ((p (%pad-piece nbytes)))
     (use-scratch-heap!)
     p))
 
 ;; ----- 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 ((acc '()) (count 0))
       (cond
         ((cond (brace? (at-punct? ps 'rbrace))
                (else (or (>= count (cond ((< decl 0) 0) (else decl)))
                          (at-punct? ps 'rbrace)
                          (at-punct? ps 'dot)
                          (at-punct? ps 'lbrack))))
          (cond (brace? (advance ps)))
          ;; Pad to declared length if longer than count.
          (let* ((final (cond ((< decl 0) count) (else decl)))
                 (pad (- final count)))
            (values
              (cond
               ((> pad 0)
                (%init-main-reverse
                 (%init-main-cons (%init-main-pad-piece (* pad esize)) acc)))
               (else (%init-main-reverse acc)))
             count)))
         (else
          (let ((piece
                 (%init-promote-unit
                  ps
                  (lambda ()
                    ;; The trailing inter-element comma must be consumed
                    ;; *inside* the mark/rewind window: advance loads pp/lex
                    ;; lookahead into iter buffers, which promote-iter-buffers!
                    ;; then deep-copies into main. Consuming it after the
                    ;; rewind would leave that lookahead leaking on scratch.
                    (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 (< (+ count 1)
                                    (cond ((< decl 0) 0) (else decl)))
                                 (at-punct? ps 'comma))
                            (advance ps)))))
                      p)))))
            (lp (%init-main-prepend-reversed piece acc) (+ count 1))))))))
 
 (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 an 8-byte slot.
   (cond
     ((bytevector? p) (bytevector-length p))
     ((and (pair? p) (eq? (car p) 'label-ref)) 8)
     (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?
                     (advance ps)
                     (let ((nt (advance ps)))
                       (cond
                         ((not (eq? (tok-kind nt) 'IDENT))
                          (die (tok-loc nt) "init: .field expects ident")))
                       (let ((f (%cg-find-field fields (tok-value nt))))
                         (cond
                           ((not f) (die (tok-loc nt) "init: no such field"
                                         (tok-value nt))))
                         (expect-punct ps 'assign)
                         f)))
                    ((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)
         ((equal? 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)
   ;; Note: scheme1's `+` is binary-only — `(+ a b c)` returns (+ a b)
   ;; and silently drops the rest. Compute absolute byte offsets via
   ;; nested binary +.
   (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?
                     (advance ps)
                     (let ((nt (advance ps)))
                       (let ((f (%cg-find-field fields (tok-value nt))))
                         (cond
                           ((not f) (die (tok-loc nt) "init: no such field"
                                         (tok-value nt))))
                         (expect-punct ps 'assign)
                         f)))
                    ((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. Heap discipline is handled at the parse-decl-or-fn boundary —
 ;; the body runs in scratch like the rest of the decl, and surviving
 ;; roots (block-statics, string literals, block-scope tags that escape
 ;; via the global tables) are promoted en masse there. See the Phase 3
 ;; section above parse-translation-unit.
 (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 '()))
       (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 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-opnd-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-opnd-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-u64
                           (max (ctype-size ty) 0))))
           (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-u64 sz))))))
        (else
         ;; sizeof EXPR (no parens) — same no-eval rule.
         (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-u64 sz))))))
     (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-primary ps)
   (let ((t (peek ps)))
     (pmatch t
       (($ tok? (kind INT) (value ,n))
        (advance ps)
        ;; C99 §6.4.4.1: pick the smallest type that holds the value.
        ;; The lexer drops u/U/l/L suffixes before we get here, so we can't
        ;; tell `0x1L` from `0x1`. But a value that doesn't fit in int has
        ;; to widen anyway — otherwise `4294967296L + 7L` truncates to 7,
        ;; because cg-arith-conv leaves both operands at i32 width.
        (cg-push-imm (ps-cg ps)
                     (cond ((<= n 2147483647) %t-i32)
                           (else              %t-i64))
                     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))
          (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)))
 
 ;; 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 namespaces
 ;; anonymous string labels as PFX+"cc__str_N" so two cc.scm outputs
 ;; in the same link don't collide on cc__str_0..N. 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))
           (let ((out (cg-finish cg)))
             (debug-log "phase=cg-finish" "heap" (heap-usage)
                        "out-bytes" (bytevector-length out))
             (%cc-write out-path out))
           0)))))