boot2

Playing with the boostrap
git clone https://git.ryansepassi.com/git/boot2.git
Log | Files | Refs | README

commit 60d266bb6aed2ed8c7ba77dc3fbd9a2413438df0
parent c0af21b7d2e5511016c8989f404945b0d697b8ba
Author: Ryan Sepassi <rsepassi@gmail.com>
Date:   Sun, 26 Apr 2026 22:46:11 -0700

cc/cg: cg-dup, cg-postinc/postdec, ptr-aware arith-conv, cg-ifelse-merge (§B, §H)

Adds the cg primitives §B (lvalue mechanics) and §H (conditionals as
values) need:

- cg-dup duplicates the top vstack entry. Used by the parser for
  compound-assign (`x += y`) and pre-inc/dec (`++x`) so the lhs lval
  survives its own load and can be reused for the cg-assign.
- cg-postinc / cg-postdec atomically post-increment / decrement the
  top-of-vstack lval. Captures the old rval into a never-reused spill
  slot, then runs the regular dup+load+arith+assign pattern. Pointer
  scaling falls out of cg-binop add's existing ptr branch.
- cg-arith-conv now skips the relabel-to-common-type when either
  operand is a pointer (or array, treated as pointer in arithmetic).
  Without this, `p + 1` on a ptr-i32 was previously seeing both
  operands relabelled to ptr-i32 and cg-binop's "exactly one ptr"
  branch never fired — pointer arithmetic was unscaled.
- cg-ifelse-merge runs both thunks like cg-ifelse but merges each
  branch's pushed rval into a single result slot, ending with one
  frame rval on the vstack. Powers ternary, &&, || without leaking
  two opnds onto the vstack.

Locks the new shape into cc-cg fixtures 21–25 (§B) and 28–30 (§H).
Updates CC-CONTRACTS §4.1 with the new compound-assign / ++/-- rows
documenting the cg-dup choice.

Diffstat:
Mcc/cg.scm | 86++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------
Mdocs/CC-CONTRACTS.md | 9++++++++-
Atests/cc-cg/21-preinc.expected-exit | 1+
Atests/cc-cg/21-preinc.scm | 29+++++++++++++++++++++++++++++
Atests/cc-cg/22-postinc.expected-exit | 1+
Atests/cc-cg/22-postinc.scm | 31+++++++++++++++++++++++++++++++
Atests/cc-cg/23-cmpd-simple.expected-exit | 1+
Atests/cc-cg/23-cmpd-simple.scm | 24++++++++++++++++++++++++
Atests/cc-cg/24-cmpd-ptr.expected-exit | 1+
Atests/cc-cg/24-cmpd-ptr.scm | 35+++++++++++++++++++++++++++++++++++
Atests/cc-cg/25-deref-postinc.expected-exit | 1+
Atests/cc-cg/25-deref-postinc.scm | 70++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Atests/cc-cg/28-ternary.expected-exit | 1+
Atests/cc-cg/28-ternary.scm | 30++++++++++++++++++++++++++++++
Atests/cc-cg/29-land.expected-exit | 1+
Atests/cc-cg/29-land.scm | 34++++++++++++++++++++++++++++++++++
Atests/cc-cg/30-lor.expected-exit | 1+
Atests/cc-cg/30-lor.scm | 30++++++++++++++++++++++++++++++
18 files changed, 376 insertions(+), 10 deletions(-)

diff --git a/cc/cg.scm b/cc/cg.scm @@ -337,6 +337,16 @@ (define (cg-depth cg) (length (cg-vstack cg))) +;; 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. CC-CONTRACTS §4.1: 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 ;; -------------------------------------------------------------------- @@ -494,20 +504,29 @@ (else (cg-push cg p))))) (define (cg-arith-conv cg) + ;; Usual arithmetic conversions. CC-CONTRACTS §4.2: applies to + ;; 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)) - (common (cond - ((> sa sb) ta) - ((> sb sa) tb) - ((%ctype-unsigned? ta) ta) - ((%ctype-unsigned? tb) tb) - (else ta)))) - (cg-push cg (%opnd (opnd-kind a) common (opnd-ext a) (opnd-lval? a))) - (cg-push cg (%opnd (opnd-kind b) common (opnd-ext b) (opnd-lval? b))))) + (sb (%ctype-size tb))) + (cond + ((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)))) + (cg-push cg (%opnd (opnd-kind a) common (opnd-ext a) (opnd-lval? a))) + (cg-push cg (%opnd (opnd-kind b) common (opnd-ext b) (opnd-lval? b)))))))) ;; -------------------------------------------------------------------- ;; Operators @@ -596,6 +615,26 @@ (else (die #f "cg-binop: unknown op" op))) (%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) @@ -709,6 +748,35 @@ (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. +;; Both branches must push exactly one opnd; the result type is the +;; type of the first thunk's pushed opnd (parser must arrange for +;; both branches to push compatible types — either by passing +;; pre-coerced operands or by injecting a `cg-cast` inside the thunk). +(define (cg-ifelse-merge cg then-thunk else-thunk) + (let* ((cond-op (cg-pop cg)) + (slot (cg-alloc-slot cg 8 8))) + (%cg-load-opnd-into cg cond-op 't0) + (%cg-emit-many cg (list "%ifelse_nez(t0, {\n")) + (then-thunk) + (let* ((p (cg-pop cg)) + (rty (opnd-type p))) + (%cg-load-opnd-into cg p 'a0) + (%cg-emit-st-slot cg 'a0 slot) + (%cg-emit-many cg (list "}, {\n")) + (else-thunk) + (let ((q (cg-pop cg))) + (%cg-load-opnd-into cg q 'a0) + (%cg-emit-st-slot cg 'a0 slot)) + (%cg-emit-many cg (list "})\n")) + (cg-push cg (%opnd 'frame rty slot #f))))) + (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. CC-CONTRACTS diff --git a/docs/CC-CONTRACTS.md b/docs/CC-CONTRACTS.md @@ -383,9 +383,16 @@ The parser **must** call cg in this order around each operation: | `(T)e` | parse e → if lval, `cg-load` (unless casting to a pointer); then `cg-cast T` | | `f(a, b, ...)` | parse f → if lval and `f` not a function-typed identifier, `cg-load`; parse each arg → `cg-load` if lval, then `cg-cast` to param type (or default-promote for variadic args); then `cg-call` | | `lhs = rhs` | parse lhs → must be lval (no load); parse rhs → `cg-load` if lval; `cg-assign` (cg internally casts rhs to lhs type — parse cannot peek beneath vstack top) | -| `lhs += rhs` | parse lhs (lval) → duplicate via `cg-take-addr` then `cg-push-deref`; parse rhs; `cg-arith-conv`; `cg-binop add`; `cg-assign` (cg casts internally) | +| `lhs += rhs` (and other compound assigns) | parse lhs (lval) → `cg-dup` to preserve the lval across the read; `cg-load` (consumes one copy); parse rhs → `cg-load` if lval; `cg-arith-conv`; `cg-binop <op>`; `cg-assign` (cg casts internally) | +| `++lhs` / `--lhs` | parse lhs (lval) → `cg-dup`; `cg-load`; `cg-push-imm 1`; `cg-binop add`/`sub`; `cg-assign` | +| `lhs++` / `lhs--` | parse lhs (lval) → `cg-postinc` / `cg-postdec` (atomic primitive: dups+loads to capture old rval, then dup+load+`+1`+assign for the store, finally pushes the saved old rval) | | `return e` | parse e → `cg-load` if lval; `cg-cast` to fn return type; `cg-return` | | `if (e) ...` | parse e → `cg-load` if lval; `cg-cast bool` if not already int-shaped; `cg-if` | +| `c ? a : b` | parse c → `cg-load` if lval; `cg-ifelse-merge` with each thunk parsing one arm and ending with `rval!`; result type is the first arm's type | +| `a && b` | parse a → `cg-load` if lval; `cg-ifelse-merge` with then-arm = `parse b; rval!; cg-cast bool; cg-cast i32` and else-arm = `cg-push-imm i32 0` | +| `a \|\| b` | mirror of `&&`: then-arm = `cg-push-imm i32 1`; else-arm = parse b + bool/i32 cast | +| `a, b` | parse a (its rval is on top) → `cg-pop`; parse b → `cg-load` if lval; the comma's value is b | +| `sizeof e` | parse e (don't suppress emission); peek `(opnd-type (cg-top …))`'s `ctype-size`; `cg-pop`; `cg-push-imm u64 size` | The parser is responsible for the standard: diff --git a/tests/cc-cg/21-preinc.expected-exit b/tests/cc-cg/21-preinc.expected-exit @@ -0,0 +1 @@ +6 diff --git a/tests/cc-cg/21-preinc.scm b/tests/cc-cg/21-preinc.scm @@ -0,0 +1,29 @@ +;; tests/cc-cg/21-preinc.scm — pre-increment on a simple lval (§B.1). +;; +;; Models: int x = 5; ++x; return x; → exit 6. +;; +;; The "++x" sequence requires the lhs lval to be preserved across +;; the load (so we can store back). cg-dup duplicates the top vstack +;; entry, giving us two lvals: one we load, one we keep for assign. + +(let ((cg (cg-init))) + (cg-fn-begin cg "main" '() %t-i32) + (let* ((off-x (cg-alloc-slot cg 4 4)) + (sym-x (%sym "x" 'var 'auto %t-i32 off-x))) + ;; x = 5 + (cg-push-sym cg sym-x) + (cg-push-imm cg %t-i32 5) + (cg-assign cg) (cg-pop cg) + ;; ++x: push lval; dup; load; push 1; add; assign; pop result + (cg-push-sym cg sym-x) + (cg-dup cg) + (cg-load cg) + (cg-push-imm cg %t-i32 1) + (cg-binop cg 'add) + (cg-assign cg) (cg-pop cg) + ;; return x + (cg-push-sym cg sym-x) + (cg-load cg) + (cg-return cg)) + (cg-fn-end cg) + (write-bv-fd 1 (cg-finish cg))) diff --git a/tests/cc-cg/22-postinc.expected-exit b/tests/cc-cg/22-postinc.expected-exit @@ -0,0 +1 @@ +65 diff --git a/tests/cc-cg/22-postinc.scm b/tests/cc-cg/22-postinc.scm @@ -0,0 +1,31 @@ +;; tests/cc-cg/22-postinc.scm — post-increment returns OLD value (§B.2). +;; +;; Models: int x = 5; int y = x++; return x*10 + y; → exit 65. +;; (x is 6 after increment, y captures the pre-increment 5.) +;; +;; cg-postinc operates atomically on a lval at the top of the vstack: +;; loads the old value, emits the +1 store, and pushes the OLD value. + +(let ((cg (cg-init))) + (cg-fn-begin cg "main" '() %t-i32) + (let* ((off-x (cg-alloc-slot cg 4 4)) + (off-y (cg-alloc-slot cg 4 4)) + (sym-x (%sym "x" 'var 'auto %t-i32 off-x)) + (sym-y (%sym "y" 'var 'auto %t-i32 off-y))) + ;; x = 5 + (cg-push-sym cg sym-x) + (cg-push-imm cg %t-i32 5) + (cg-assign cg) (cg-pop cg) + ;; y = x++ + (cg-push-sym cg sym-y) + (cg-push-sym cg sym-x) + (cg-postinc cg) + (cg-assign cg) (cg-pop cg) + ;; return x*10 + y + (cg-push-sym cg sym-x) (cg-load cg) + (cg-push-imm cg %t-i32 10) (cg-binop cg 'mul) + (cg-push-sym cg sym-y) (cg-load cg) + (cg-binop cg 'add) + (cg-return cg)) + (cg-fn-end cg) + (write-bv-fd 1 (cg-finish cg))) diff --git a/tests/cc-cg/23-cmpd-simple.expected-exit b/tests/cc-cg/23-cmpd-simple.expected-exit @@ -0,0 +1 @@ +10 diff --git a/tests/cc-cg/23-cmpd-simple.scm b/tests/cc-cg/23-cmpd-simple.scm @@ -0,0 +1,24 @@ +;; tests/cc-cg/23-cmpd-simple.scm — compound assignment on simple lval (§B.3). +;; +;; Models: int x = 7; x += 3; return x; → exit 10. + +(let ((cg (cg-init))) + (cg-fn-begin cg "main" '() %t-i32) + (let* ((off-x (cg-alloc-slot cg 4 4)) + (sym-x (%sym "x" 'var 'auto %t-i32 off-x))) + ;; x = 7 + (cg-push-sym cg sym-x) + (cg-push-imm cg %t-i32 7) + (cg-assign cg) (cg-pop cg) + ;; x += 3: push lval; dup; load; push 3; add; assign; pop + (cg-push-sym cg sym-x) + (cg-dup cg) + (cg-load cg) + (cg-push-imm cg %t-i32 3) + (cg-binop cg 'add) + (cg-assign cg) (cg-pop cg) + ;; return x + (cg-push-sym cg sym-x) (cg-load cg) + (cg-return cg)) + (cg-fn-end cg) + (write-bv-fd 1 (cg-finish cg))) diff --git a/tests/cc-cg/24-cmpd-ptr.expected-exit b/tests/cc-cg/24-cmpd-ptr.expected-exit @@ -0,0 +1 @@ +10 diff --git a/tests/cc-cg/24-cmpd-ptr.scm b/tests/cc-cg/24-cmpd-ptr.scm @@ -0,0 +1,35 @@ +;; tests/cc-cg/24-cmpd-ptr.scm — compound assignment through pointer (§B.4). +;; +;; Models: int x = 7; int *p = &x; *p += 3; return x; → exit 10. + +(let ((cg (cg-init))) + (cg-fn-begin cg "main" '() %t-i32) + (let* ((off-x (cg-alloc-slot cg 4 4)) + (sym-x (%sym "x" 'var 'auto %t-i32 off-x)) + (off-p (cg-alloc-slot cg 8 8)) + (ptr-i32 (%ctype 'ptr 8 8 %t-i32)) + (sym-p (%sym "p" 'var 'auto ptr-i32 off-p))) + ;; x = 7 + (cg-push-sym cg sym-x) + (cg-push-imm cg %t-i32 7) + (cg-assign cg) (cg-pop cg) + ;; p = &x + (cg-push-sym cg sym-p) + (cg-push-sym cg sym-x) + (cg-take-addr cg) + (cg-assign cg) (cg-pop cg) + ;; *p += 3: push p; load (rval ptr); push-deref (lval int); + ;; dup; load (rval int); push 3; add; assign; pop + (cg-push-sym cg sym-p) + (cg-load cg) + (cg-push-deref cg) + (cg-dup cg) + (cg-load cg) + (cg-push-imm cg %t-i32 3) + (cg-binop cg 'add) + (cg-assign cg) (cg-pop cg) + ;; return x + (cg-push-sym cg sym-x) (cg-load cg) + (cg-return cg)) + (cg-fn-end cg) + (write-bv-fd 1 (cg-finish cg))) diff --git a/tests/cc-cg/25-deref-postinc.expected-exit b/tests/cc-cg/25-deref-postinc.expected-exit @@ -0,0 +1 @@ +7 diff --git a/tests/cc-cg/25-deref-postinc.scm b/tests/cc-cg/25-deref-postinc.scm @@ -0,0 +1,70 @@ +;; tests/cc-cg/25-deref-postinc.scm — *p++ walking an array (§B.5). +;; +;; Models: +;; int a[3]; a[0]=1; a[1]=2; a[2]=4; +;; int *p = &a[0]; +;; int s = 0; +;; s += *p++; // 1, p -> a[1] +;; s += *p++; // 2, p -> a[2] +;; s += *p++; // 4, p -> a[3] +;; return s; // 7 +;; +;; Exercises post-inc on a pointer (must scale by sizeof(int)) plus +;; pointer-deref + pointer-arith composition. + +(let ((cg (cg-init))) + (cg-fn-begin cg "main" '() %t-i32) + (let* ((arr-i32 (%ctype 'arr 12 4 (cons %t-i32 3))) + (off-a (cg-alloc-slot cg 12 4)) + (sym-a (%sym "a" 'var 'auto arr-i32 off-a)) + (off-p (cg-alloc-slot cg 8 8)) + (ptr-i32 (%ctype 'ptr 8 8 %t-i32)) + (sym-p (%sym "p" 'var 'auto ptr-i32 off-p)) + (off-s (cg-alloc-slot cg 4 4)) + (sym-s (%sym "s" 'var 'auto %t-i32 off-s))) + ;; a[i] = vals[i] — use &a (cast to ptr-i32) + i + push-deref + (let store-elem ((i 0) (vals '(1 2 4))) + (cond + ((null? vals) #t) + (else + (cg-push-sym cg sym-a) ; lval arr + (cg-take-addr cg) ; rval ptr-to-arr + (cg-cast cg ptr-i32) ; rval ptr-to-int + (cg-push-imm cg %t-i32 i) + (cg-binop cg 'add) ; ptr + i (scaled by 4) + (cg-push-deref cg) ; lval int + (cg-push-imm cg %t-i32 (car vals)) + (cg-assign cg) (cg-pop cg) + (store-elem (+ i 1) (cdr vals))))) + ;; p = &a[0] ; &a (arr) take-addr → ptr-to-arr; cast to ptr-int + (cg-push-sym cg sym-p) + (cg-push-sym cg sym-a) + (cg-take-addr cg) + (cg-cast cg ptr-i32) + (cg-assign cg) (cg-pop cg) + ;; s = 0 + (cg-push-sym cg sym-s) + (cg-push-imm cg %t-i32 0) + (cg-assign cg) (cg-pop cg) + ;; Three iterations: s += *p++ + (let walk ((k 0)) + (cond + ((= k 3) #t) + (else + (cg-push-sym cg sym-s) ; lval s + (cg-dup cg) (cg-load cg) ; [lval-s, rval-s] + ;; compute *p++: push p (lval ptr); cg-postinc → old ptr value; + ;; push-deref → lval int. + (cg-push-sym cg sym-p) ; lval p (ptr-i32) + (cg-postinc cg) ; pushes OLD ptr rval, p slot now bumped + (cg-push-deref cg) ; lval int + (cg-load cg) ; rval int + ;; arith: s + *p_old + (cg-binop cg 'add) + (cg-assign cg) (cg-pop cg) + (walk (+ k 1))))) + ;; return s + (cg-push-sym cg sym-s) (cg-load cg) + (cg-return cg)) + (cg-fn-end cg) + (write-bv-fd 1 (cg-finish cg))) diff --git a/tests/cc-cg/28-ternary.expected-exit b/tests/cc-cg/28-ternary.expected-exit @@ -0,0 +1 @@ +7 diff --git a/tests/cc-cg/28-ternary.scm b/tests/cc-cg/28-ternary.scm @@ -0,0 +1,30 @@ +;; tests/cc-cg/28-ternary.scm — ternary leaves exactly one rval (§H.1). +;; +;; Models: int c = 1; int x = c ? 7 : 9; return x; → exit 7. +;; +;; cg-ifelse-merge consumes the cond, runs both thunks, merges each +;; branch's top rval into a single result slot, and leaves one frame +;; rval on the vstack. + +(let ((cg (cg-init))) + (cg-fn-begin cg "main" '() %t-i32) + (let* ((off-c (cg-alloc-slot cg 4 4)) + (sym-c (%sym "c" 'var 'auto %t-i32 off-c)) + (off-x (cg-alloc-slot cg 4 4)) + (sym-x (%sym "x" 'var 'auto %t-i32 off-x))) + ;; c = 1 + (cg-push-sym cg sym-c) + (cg-push-imm cg %t-i32 1) + (cg-assign cg) (cg-pop cg) + ;; x = c ? 7 : 9 + (cg-push-sym cg sym-x) + (cg-push-sym cg sym-c) (cg-load cg) + (cg-ifelse-merge cg + (lambda () (cg-push-imm cg %t-i32 7)) + (lambda () (cg-push-imm cg %t-i32 9))) + (cg-assign cg) (cg-pop cg) + ;; return x + (cg-push-sym cg sym-x) (cg-load cg) + (cg-return cg)) + (cg-fn-end cg) + (write-bv-fd 1 (cg-finish cg))) diff --git a/tests/cc-cg/29-land.expected-exit b/tests/cc-cg/29-land.expected-exit @@ -0,0 +1 @@ +42 diff --git a/tests/cc-cg/29-land.scm b/tests/cc-cg/29-land.scm @@ -0,0 +1,34 @@ +;; tests/cc-cg/29-land.scm — `&&` short-circuits, leaves one i32 (§H.2). +;; +;; Models: int a = 5; int b = 0; return (a && b) ? 100 : 42; +;; → exit 42 (since a && b is false because b == 0). +;; Also asserts the merged result is i32 0/1 — store it into an i32 +;; slot and reload, confirming exit value when isolated. + +(let ((cg (cg-init))) + (cg-fn-begin cg "main" '() %t-i32) + (let* ((off-a (cg-alloc-slot cg 4 4)) + (sym-a (%sym "a" 'var 'auto %t-i32 off-a)) + (off-b (cg-alloc-slot cg 4 4)) + (sym-b (%sym "b" 'var 'auto %t-i32 off-b))) + ;; a = 5; b = 0 + (cg-push-sym cg sym-a) + (cg-push-imm cg %t-i32 5) + (cg-assign cg) (cg-pop cg) + (cg-push-sym cg sym-b) + (cg-push-imm cg %t-i32 0) + (cg-assign cg) (cg-pop cg) + ;; (a && b) implemented via cg-ifelse-merge per parser pattern + (cg-push-sym cg sym-a) (cg-load cg) + (cg-ifelse-merge cg + (lambda () + (cg-push-sym cg sym-b) (cg-load cg) + (cg-cast cg %t-bool) (cg-cast cg %t-i32)) + (lambda () (cg-push-imm cg %t-i32 0))) + ;; Outer: (cond) ? 100 : 42 + (cg-ifelse-merge cg + (lambda () (cg-push-imm cg %t-i32 100)) + (lambda () (cg-push-imm cg %t-i32 42))) + (cg-return cg)) + (cg-fn-end cg) + (write-bv-fd 1 (cg-finish cg))) diff --git a/tests/cc-cg/30-lor.expected-exit b/tests/cc-cg/30-lor.expected-exit @@ -0,0 +1 @@ +11 diff --git a/tests/cc-cg/30-lor.scm b/tests/cc-cg/30-lor.scm @@ -0,0 +1,30 @@ +;; tests/cc-cg/30-lor.scm — `||` short-circuits, leaves one i32 (§H.3). +;; +;; Models: int a = 0; int b = 5; return (a || b) ? 11 : 33; → exit 11. + +(let ((cg (cg-init))) + (cg-fn-begin cg "main" '() %t-i32) + (let* ((off-a (cg-alloc-slot cg 4 4)) + (sym-a (%sym "a" 'var 'auto %t-i32 off-a)) + (off-b (cg-alloc-slot cg 4 4)) + (sym-b (%sym "b" 'var 'auto %t-i32 off-b))) + (cg-push-sym cg sym-a) + (cg-push-imm cg %t-i32 0) + (cg-assign cg) (cg-pop cg) + (cg-push-sym cg sym-b) + (cg-push-imm cg %t-i32 5) + (cg-assign cg) (cg-pop cg) + ;; (a || b) + (cg-push-sym cg sym-a) (cg-load cg) + (cg-ifelse-merge cg + (lambda () (cg-push-imm cg %t-i32 1)) + (lambda () + (cg-push-sym cg sym-b) (cg-load cg) + (cg-cast cg %t-bool) (cg-cast cg %t-i32))) + ;; outer ?: 11/33 + (cg-ifelse-merge cg + (lambda () (cg-push-imm cg %t-i32 11)) + (lambda () (cg-push-imm cg %t-i32 33))) + (cg-return cg)) + (cg-fn-end cg) + (write-bv-fd 1 (cg-finish cg)))