boot2

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

scheme1.P1pp (185996B)


      1 # scheme1.P1pp -- Phase 1 minimal Scheme interpreter on P1.
      2 #
      3 # Build chain:
      4 #   catm P1-<arch>.M1pp P1.M1pp P1pp.P1pp scheme1/scheme1.P1pp \
      5 #     | m1pp -> hex2pp -> ELF
      6 #
      7 # Run chain:
      8 #   catm scheme1/prelude.scm prog.scm | scheme1
      9 
     10 # =========================================================================
     11 # Constants
     12 # =========================================================================
     13 
     14 %enum TAG { FIXNUM PAIR SYM HEAP IMM }
     15 %enum IMM { FALSE TRUE NIL UNSPEC UNBOUND EOF }
     16 %enum HDR { BV CLOSURE PRIM TD REC MV }
     17 %enum GCKIND { FREE PAIR HEAP RAW }
     18 
     19 # Each managed block begins with two machine words.  The first word is
     20 #   (total_block_bytes << 8) | kind | mark
     21 # and the second is an intrusive link, reused by the free list and mark
     22 # worklist.  Payloads retain their historical layouts and tags.
     23 %macro GC_HEADER_BYTES() 16 %endm
     24 %macro GC_MARK_BIT() 128 %endm
     25 %macro GC_KIND_MASK() 7 %endm
     26 
     27 # imm_val(idx) -> integer-expression for the tagged immediate at IMM index
     28 # `idx`. Used both at %li sites (loaded into a register) and at $() emission
     29 # sites (baked into a static word).
     30 %macro imm_val(idx) (| (<< idx 3) %TAG.IMM) %endm
     31 
     32 # Layout helpers. %struct stride is 8 bytes per field.
     33 %struct PAIR    { car cdr }                          # .SIZE = 16
     34 %struct SYMENT  { name_ptr name_len global_val pad } # .SIZE = 32
     35 %struct PRIM    { hdr entry_w data }                  # .SIZE = 24
     36 %struct CLOSURE { hdr params body env }              # .SIZE = 32
     37 %struct TD      { hdr name nfields fields }           # .SIZE = 32
     38 %struct BV      { hdr data }                          # .SIZE = 16
     39 %struct REC     { hdr td }                            # .SIZE = 16 (header)
     40 # Records are variable width: header + td slot + N field slots.
     41 
     42 # BSS arenas anchored past :ELF_end. readbuf is 1 MiB (sized to fit
     43 # the catm'd cc compiler source incl. prelude), followed by the symbol
     44 # table, the exact-root frame stack, and one 256 MiB managed heap.
     45 
     46 %macro SYMTAB_CAP_SLOTS() 8192 %endm
     47 %macro READBUF_CAP_BYTES() 1048576 %endm
     48 %macro HEAP_CAP_BYTES() 0x10000000 %endm
     49 %macro GC_ROOT_CAP_FRAMES() 8192 %endm
     50 %macro GC_ROOT_FRAME_BYTES() 24 %endm
     51 
     52 # =========================================================================
     53 # Tag idioms
     54 # =========================================================================
     55 
     56 %macro tagof(rd, rs) %andi(rd, rs, 7) %endm
     57 %macro mkfix(rd, rs) %shli(rd, rs, 3) %endm
     58 %macro untag_fix(rd, rs) %sari(rd, rs, 3) %endm
     59 %macro untag_sym(rd, rs) %sari(rd, rs, 3) %endm
     60 %macro car(rd, rs) %ld(rd, rs, -1) %endm
     61 %macro cdr(rd, rs) %ld(rd, rs, 7) %endm
     62 %macro set_car(rs, pair_tagged) %st(rs, pair_tagged, -1) %endm
     63 %macro set_cdr(rs, pair_tagged) %st(rs, pair_tagged, 7) %endm
     64 %macro hdr_type(rd, rs) %lb(rd, rs, -3) %endm
     65 
     66 # Field access through a tagged HEAP pointer (tag = 3). `field` is a
     67 # constant byte offset from the underlying raw object (e.g. %PRIM.data,
     68 # %CLOSURE.env). Reader is %ld; writer is %heap_st.
     69 %macro heap_ld(rd, rs, field) %ld(rd, rs, (- field 3)) %endm
     70 %macro heap_st(rs, rt, field) %st(rs, rt, (- field 3)) %endm
     71 
     72 # =========================================================================
     73 # Scheme1-local helpers
     74 # =========================================================================
     75 
     76 # Load the byte at readbuf_buf[off_reg] into rd. Clobbers rd. `rd` must
     77 # be the destination register; the macro reuses it as a scratch pointer
     78 # during the la / ld / add chain before the final lb writes the byte.
     79 %macro readbuf_byte(rd, off_reg)
     80     %ld_global(rd, &readbuf_buf_ptr)
     81     %add(rd, rd, off_reg)
     82     %lb(rd, rd, 0)
     83 %endm
     84 
     85 # Increment cursor and store it back. `addr_reg` is the address of
     86 # readbuf_pos as returned by %lda_global (the second output register).
     87 %macro readbuf_advance(pos_reg, addr_reg)
     88     %addi(pos_reg, pos_reg, 1)
     89     %st(pos_reg, addr_reg, 0)
     90 %endm
     91 
     92 # Load readbuf_len into len_reg and branch to target if cursor is at EOF.
     93 %macro readbuf_at_eof(pos_reg, len_reg, target)
     94     %ld_global(len_reg, &readbuf_len)
     95     %beq(pos_reg, len_reg, target)
     96 %endm
     97 
     98 # Branch character equal/not-equal: if (c == expect) / (c != expect) goto target.
     99 # expect passed as -(char_code). scratch is clobbered.
    100 %macro bceq(c, neg_cv, target, scratch)
    101     %addi(scratch, c, neg_cv)
    102     %beqz(scratch, target)
    103 %endm
    104 
    105 %macro bcne(c, neg_cv, target, scratch)
    106     %addi(scratch, c, neg_cv)
    107     %bnez(scratch, target)
    108 %endm
    109 
    110 # Branch immediate equal/not-equal: if (reg == value) / (reg != value) goto target.
    111 # scratch is clobbered.
    112 %macro bieq(reg, value, target, scratch)
    113     %li(scratch, value)
    114     %beq(reg, scratch, target)
    115 %endm
    116 
    117 %macro bine(reg, value, target, scratch)
    118     %li(scratch, value)
    119     %bne(reg, scratch, target)
    120 %endm
    121 
    122 # Branch to `target` if `ch_reg` holds an ASCII whitespace byte (space,
    123 # tab, LF, CR). `scratch` is clobbered.
    124 %macro is_ws_branch(scratch, ch_reg, target)
    125     %bceq(ch_reg, -32, target, scratch)    ; SP
    126     %bceq(ch_reg,  -9, target, scratch)    ; HT
    127     %bceq(ch_reg, -10, target, scratch)    ; LF
    128     %bceq(ch_reg, -13, target, scratch)    ; CR
    129 %endm
    130 
    131 # Branch to `target` if lo_neg <= c < lo_neg+count (unsigned). Both
    132 # scratch and count_scratch are clobbered.
    133 %macro brange(c, lo_neg, count, scratch, count_scratch, target)
    134     %addi(scratch, c, lo_neg)
    135     %li(count_scratch, count)
    136     %bltu(scratch, count_scratch, target)
    137 %endm
    138 
    139 # Compute &symtab_buf + idx_reg * SYMENT.SIZE into rd. `scratch` is
    140 # clobbered.
    141 %macro symtab_entry(rd, idx_reg, scratch)
    142     %ld_global(rd, &symtab_buf_ptr)
    143     %shli(scratch, idx_reg, 5)
    144     %add(rd, rd, scratch)
    145 %endm
    146 
    147 # Print msg_label and abort. Never returns. Routes through runtime_error
    148 # so every error path lands in one place (stderr + exit 1).
    149 %macro die(msg)
    150     %la(a0, & ## msg)
    151     %call(&runtime_error)
    152 %endm
    153 
    154 # Emit an 8-aligned NUL-terminated string.
    155 %macro cstr8(str)
    156     str
    157     00
    158     .align 8
    159 %endm
    160 
    161 # Intern `str` into `slot` and declare its padded string data inline.
    162 # `key` is the label suffix; the data label :name_##key is emitted here.
    163 %macro intern_form(key, str, slot)
    164     %la(a0, &name_ ## key)
    165     %li(a1, (strlen str))
    166     %call(&intern)
    167     %st_global(a0, slot, t0)
    168     %b(&@end)
    169     :name_ ## key
    170     %cstr8(str)
    171     :@end
    172 %endm
    173 
    174 # Special-form dispatch: pointer-compare the head symbol against `slot`'s
    175 # cached value (in t0) and branch to `target` on hit. Caller has already
    176 # loaded head into t0.
    177 %macro dispatch_form(slot, target)
    178     %ld_global(t1, slot)
    179     %beq(t0, t1, target)
    180 %endm
    181 
    182 # Tail-jump from a special-form dispatch label to its handler. Handlers
    183 # uniformly take (rest=cdr(expr), env) -> value; expr lives at sp[0],
    184 # env at sp[8] in eval's frame.
    185 %macro tail_to_handler(handler)
    186     %ld(a0, sp, 0)
    187     %cdr(a0, a0)
    188     %ld(a1, sp, 8)
    189     %gctail(handler)
    190 %endm
    191 
    192 # Branch to `target` if `val` holds the NIL immediate. `scratch` is
    193 # clobbered.
    194 %macro if_nil(scratch, val, target)
    195     %li(scratch, %imm_val(%IMM.NIL))
    196     %beq(val, scratch, target)
    197 %endm
    198 
    199 # Advance a named list-cursor local to its cdr. t0 is the implicit scratch
    200 # register; callers must ensure it's free.
    201 %macro advance_walk(name)
    202     %ldl(t0, name)
    203     %cdr(t0, t0)
    204     %stl(t0, name)
    205 %endm
    206 
    207 # Set a global binding. sym is a tagged symbol, val is the new value.
    208 # Untags sym into the idx ABI position and calls sym_set_global.
    209 %macro set_global(sym, val)
    210     %mov(a1, val)
    211     %untag_sym(a0, sym)
    212     %call(&sym_set_global)
    213 %endm
    214 
    215 # Exact shadow-root frames.  Every frame records the native frame pointer
    216 # plus two bitmaps: tagged Scheme-reference slots and temporarily live raw
    217 # managed-allocation pointers.  Bit N describes native local slot N.  The
    218 # collector dereferences only those described slots; ordinary machine
    219 # locals and the native P1 stack are never scanned.
    220 %macro gc_frame_push(scheme_mask, raw_mask)
    221     %ld_global(t0, &gc_root_next)
    222     %addi(t1, t0, %GC_ROOT_FRAME_BYTES)
    223     %ld_global(t2, &gc_root_end)
    224     %bltu(t2, t1, &@overflow)
    225     %addi(t2, sp, 16)
    226     %st(t2, t0, 0)
    227     %li(t2, scheme_mask)
    228     %st(t2, t0, 8)
    229     %li(t2, raw_mask)
    230     %st(t2, t0, 16)
    231     %st_global(t1, &gc_root_next, t2)
    232     %b(&@done)
    233     :@overflow
    234     %die(msg_gc_roots_full)
    235     :@done
    236 %endm
    237 
    238 %macro gc_frame_pop()
    239     %ld_global(t0, &gc_root_next)
    240     %addi(t0, t0, (- %GC_ROOT_FRAME_BYTES))
    241     # Clear popped descriptors so debugging an overflow never exposes
    242     # stale native-stack addresses as apparently active slots.
    243     %li(t1, 0)
    244     %st(t1, t0, 0)
    245     %st(t1, t0, 8)
    246     %st(t1, t0, 16)
    247     %st_global(t0, &gc_root_next, t1)
    248 %endm
    249 
    250 %macro gc_frame_clear(frame_size)
    251     %addi(t0, sp, 16)
    252     %li(t1, frame_size)
    253     %li(t2, 0)
    254     :@loop
    255     %beqz(t1, &@done)
    256     %st(t2, t0, 0)
    257     %addi(t0, t0, 8)
    258     %addi(t1, t1, -8)
    259     %b(&@loop)
    260     :@done
    261 %endm
    262 
    263 %macro gceret()
    264     %gc_frame_pop
    265     %eret
    266 %endm
    267 
    268 %macro gctail(target)
    269     %gc_frame_pop
    270     %tail(target)
    271 %endm
    272 
    273 %macro gctailr(target_reg)
    274     %mov(a3, target_reg)
    275     %gc_frame_pop
    276     %tailr(a3)
    277 %endm
    278 
    279 # GC-aware counterpart of P1pp's %fn2.  Functions using this form must
    280 # use %gceret / %gctail / %gctailr for explicit exits; fallthrough runs
    281 # the epilogue emitted here.
    282 %macro gcfn2(name, locals, scheme_mask, raw_mask, body)
    283     %struct name ## _FRAME { locals }
    284     : ## name
    285     .scope
    286     %frame name
    287     %enter(% ## name ## _FRAME.SIZE)
    288     %gc_frame_clear(% ## name ## _FRAME.SIZE)
    289     %gc_frame_push(scheme_mask, raw_mask)
    290     body
    291     %gc_frame_pop
    292     %eret
    293     %endframe
    294     .endscope
    295 %endm
    296 
    297 # car-and-untag-fixnum: rd = car(list) >> 3.
    298 %macro car_fix(rd, list)
    299     %car(rd, list)
    300     %sari(rd, rd, 3)
    301 %endm
    302 
    303 # car-then-load-bytevector-data-pointer: rd = (car(list)).data_ptr.
    304 %macro car_bvdata(rd, list)
    305     %car(rd, list)
    306     %ld(rd, rd, 5)
    307 %endm
    308 
    309 # Positional list-arg extraction. r_n receives the nth element of `list`;
    310 # the last destination register doubles as the in-flight rest cursor
    311 # during extraction (its final value is the last argument).
    312 %macro args2(r0, r1, list)
    313     %car(r0, list)
    314     %cdr(r1, list)
    315     %car(r1, r1)
    316 %endm
    317 
    318 %macro args3(r0, r1, r2, list)
    319     %car(r0, list)
    320     %cdr(r2, list)
    321     %car(r1, r2)
    322     %cdr(r2, r2)
    323     %car(r2, r2)
    324 %endm
    325 
    326 %macro args4(r0, r1, r2, r3, list)
    327     %car(r0, list)
    328     %cdr(r3, list)
    329     %car(r1, r3)
    330     %cdr(r3, r3)
    331     %car(r2, r3)
    332     %cdr(r3, r3)
    333     %car(r3, r3)
    334 %endm
    335 
    336 # =========================================================================
    337 # p1_main -- runtime spine
    338 # =========================================================================
    339 
    340 %fn(p1_main, 0, {
    341     # Stash argc/argv
    342     %st_global(a0, &saved_argc, t0)
    343     %st_global(a1, &saved_argv, t0)
    344 
    345     # if argc < 2 goto usage
    346     %li(t0, 2)
    347     %bltu(a0, t0, &.usage)
    348 
    349     # Initialize
    350     %la(a0, &ELF_end)
    351     %la(a1, &arena_table)
    352     %la(a2, &arena_table_end)
    353     %call(&init_arenas)
    354     %call(&heap_init)
    355     %call(&intern_special_forms)
    356     %call(&register_primitives)
    357     %call(&register_globals)
    358 
    359     # load_source(argv[1])
    360     %ld_global(a0, &saved_argv)
    361     %ld(a0, a0, 8)
    362     %call(&load_source)
    363 
    364     # read-eval loop
    365     %loop_scoped({
    366         # eof = skip_ws()
    367         %call(&skip_ws)
    368         # if eof break
    369         %if_nez(a0, { %break })
    370         # expr = parse_one()
    371         %call(&parse_one)
    372         # eval(expr, env=nil)
    373         %li(a1, %imm_val(%IMM.NIL))
    374         %call(&eval)
    375     })
    376 
    377     # return 0
    378     %li(a0, 0)
    379     %eret
    380 
    381     :.usage
    382     %la(a0, &msg_usage)
    383     %call(&print_cstr)
    384     %li(a0, 2)
    385 })
    386 
    387 # =========================================================================
    388 # Reader -- parse_one over readbuf with a single byte cursor
    389 # =========================================================================
    390 #
    391 # Cursor lives in &readbuf_pos; readbuf_len holds the slurped byte count.
    392 # The reader is called recursively from parse_list, so every state goes
    393 # through frame slots, not s-registers.
    394 
    395 # Skip whitespace (ASCII 32, 9, 10, 13) and `;`-to-LF comments. Returns
    396 # a0 = 1 if readbuf_pos >= readbuf_len after skipping (caller hit EOF),
    397 # else 0. Leaf.
    398 :skip_ws
    399 .scope
    400     %lda_global(t0, t2, &readbuf_pos)
    401     %ld_global(t1, &readbuf_len)
    402     :.loop
    403         %beq(t0, t1, &.done)
    404         %readbuf_byte(a0, t0)
    405         %is_ws_branch(a1, a0, &.step)
    406         %bceq(a0, -59, &.comment, a1)    ; ';'
    407         %b(&.done)
    408         :.comment
    409         # Consume up to and including the next LF, or to EOF.
    410         %addi(t0, t0, 1)
    411         %beq(t0, t1, &.done)
    412         %readbuf_byte(a0, t0)
    413         %bcne(a0, -10, &.comment, a1)    ; LF
    414         :.step
    415         %addi(t0, t0, 1)
    416         %b(&.loop)
    417     :.done
    418 
    419     %st(t0, t2, 0)
    420     %li(a0, 1)
    421     %beq(t0, t1, &.ret)
    422     %li(a0, 0)
    423     :.ret
    424     %ret
    425 .endscope
    426 
    427 # parse_one() -> tagged value in a0
    428 %fn(parse_one, 0, {
    429     %call(&skip_ws)
    430     %bnez(a0, &.eof)
    431 
    432     %ld_global(t0, &readbuf_pos)
    433     %readbuf_byte(a0, t0)
    434 
    435     %bceq(a0, -40, &.lparen, a1)
    436     %bceq(a0, -41, &.rparen, a1)
    437     %bceq(a0, -35, &.hash, a1)
    438     %bceq(a0, -39, &.quote, a1)
    439     %bceq(a0, -44, &.comma, a1)
    440     %bceq(a0, -34, &.string, a1)
    441 
    442     %tail(&parse_atom)
    443 
    444     :.lparen
    445     # Consume '(' and read items until ')'.
    446     %lda_global(t1, t0, &readbuf_pos)
    447     %readbuf_advance(t1, t0)
    448     %tail(&parse_list)
    449 
    450     :.rparen
    451     %die(msg_unexp_rparen)
    452 
    453     :.string
    454     # Consume opening '"' and tail to parse_string. parse_string scans
    455     # through the matching '"' (consuming it) and returns a tagged bv.
    456     %lda_global(t1, t0, &readbuf_pos)
    457     %readbuf_advance(t1, t0)
    458     %tail(&parse_string)
    459 
    460     :.hash
    461     # Consume '#' plus its type byte; dispatch on the type byte.
    462     %lda_global(t0, t2, &readbuf_pos)
    463     %addi(t0, t0, 1)
    464     %readbuf_at_eof(t0, t1, &.eof)
    465     %readbuf_byte(a0, t0)
    466     %readbuf_advance(t0, t2)
    467     %bceq(a0, -116, &.true_lit,  a1)    ; 't'
    468     %bceq(a0, -102, &.false_lit, a1)    ; 'f'
    469     %bceq(a0, -120, &.hex_lit,   a1)    ; 'x'
    470     %bceq(a0,  -88, &.hex_lit,   a1)    ; 'X'
    471     %bceq(a0,  -92, &.char_lit,  a1)    ; '\\'
    472     %bceq(a0, -117, &.u8_lit,    a1)    ; 'u'
    473     %die(msg_bad_hash)
    474 
    475     :.true_lit
    476     %li(a0, %imm_val(%IMM.TRUE))
    477     %eret
    478 
    479     :.false_lit
    480     %li(a0, %imm_val(%IMM.FALSE))
    481     %eret
    482 
    483     :.hex_lit
    484     # t0 sits at the first hex digit; t1 = readbuf_len. Scan to ws/paren/EOF,
    485     # then parse_hex over the slice (with optional leading '-').
    486     %mov(a3, t0)
    487     :.hex_scan
    488         %beq(t0, t1, &.hex_end)
    489         %readbuf_byte(a0, t0)
    490         %is_ws_branch(a1, a0, &.hex_end)
    491         %bceq(a0, -40, &.hex_end, a1)
    492         %bceq(a0, -41, &.hex_end, a1)
    493         %addi(t0, t0, 1)
    494         %b(&.hex_scan)
    495     :.hex_end
    496 
    497     %st_global(t0, &readbuf_pos, t2)
    498     %ld_global(a0, &readbuf_buf_ptr)
    499     %add(a0, a0, a3)
    500     %sub(a1, t0, a3)
    501     %lb(t2, a0, 0)
    502     %addi(t2, t2, -45)              ; '-'
    503     %beqz(t2, &.hex_neg)
    504     %call(&parse_hex)
    505     %mkfix(a0, a0)
    506     %eret
    507     :.hex_neg
    508     %addi(a0, a0, 1)
    509     %addi(a1, a1, -1)
    510     %call(&parse_hex)
    511     %li(t0, 0)
    512     %sub(a0, t0, a0)
    513     %mkfix(a0, a0)
    514     %eret
    515 
    516     :.quote
    517     # Consume the leading '\''; recurse into parse_one for the datum;
    518     # then build (quote <datum>).
    519     %lda_global(t0, t2, &readbuf_pos)
    520     %readbuf_advance(t0, t2)
    521     %call(&parse_one)
    522     %li(a1, %imm_val(%IMM.NIL))
    523     %call(&cons)
    524     %ld_global(t0, &sym_quote)
    525     %mov(a1, a0)
    526     %mov(a0, t0)
    527     %tail(&cons)
    528 
    529     :.comma
    530     # Consume the leading ','; recurse into parse_one for the datum;
    531     # build (unquote <datum>). The comma sugar exists so pmatch
    532     # patterns can be written as `,ident`. Outside pmatch
    533     # `(unquote x)` reaches eval as an application of the unbound
    534     # `unquote` and dies through the standard unbound-variable path.
    535     %lda_global(t0, t2, &readbuf_pos)
    536     %readbuf_advance(t0, t2)
    537     %call(&parse_one)
    538     %li(a1, %imm_val(%IMM.NIL))
    539     %call(&cons)
    540     %ld_global(t0, &sym_unquote)
    541     %mov(a1, a0)
    542     %mov(a0, t0)
    543     %tail(&cons)
    544 
    545     :.char_lit
    546     # Cursor is already past '#\\'; parse_char scans the body and returns
    547     # a tagged fixnum (the u8 char value).
    548     %tail(&parse_char)
    549 
    550     :.u8_lit
    551     # Cursor is past '#u'. Demand '8' then '('; consume both and tail to
    552     # parse_u8_body, which reads the element list and packs it into a bv.
    553     %lda_global(t0, t2, &readbuf_pos)
    554     %readbuf_at_eof(t0, t1, &.u8_bad)
    555     %readbuf_byte(a0, t0)
    556     %bcne(a0, -56, &.u8_bad, a1)    ; '8'
    557     %addi(t0, t0, 1)
    558     %beq(t0, t1, &.u8_bad)
    559     %readbuf_byte(a0, t0)
    560     %bcne(a0, -40, &.u8_bad, a1)    ; '('
    561     %readbuf_advance(t0, t2)
    562     %tail(&parse_u8_body)
    563 
    564     :.u8_bad
    565     %die(msg_bad_hash)
    566 
    567     :.eof
    568     %die(msg_unexp_eof)
    569 })
    570 
    571 # parse_list() -> tagged list value in a0. Cursor sits past '(' on entry;
    572 # returns once ')' is consumed.
    573 #
    574 # Locals:
    575 #   head  NIL until first item
    576 #   tail  most recent cons (set-cdr! target)
    577 %gcfn2(parse_list, {head tail}, 3, 0, {
    578     %li(t0, %imm_val(%IMM.NIL))
    579     %stl(t0, head)
    580     %stl(t0, tail)
    581 
    582     :.loop
    583     %call(&skip_ws)
    584     %bnez(a0, &.eof)
    585     %ld_global(t0, &readbuf_pos)
    586     %ld_global(t1, &readbuf_len)
    587 
    588     %readbuf_byte(a0, t0)
    589     %bceq(a0, -41, &.close, a1)
    590 
    591     # Dotted-pair separator: '.' followed by ws/paren/EOF (otherwise the
    592     # '.' is part of an identifier and parse_atom handles it).
    593     %bcne(a0, -46, &.not_dot, a1)    ; '.'
    594     %addi(a2, t0, 1)
    595     %beq(a2, t1, &.do_dot)
    596     %readbuf_byte(a3, a2)
    597     %is_ws_branch(a1, a3, &.do_dot)
    598     %bceq(a3, -40, &.do_dot, a1)
    599     %bceq(a3, -41, &.do_dot, a1)
    600     :.not_dot
    601 
    602     # Not ')': parse one item, append.
    603     %call(&parse_one)
    604     %li(a1, %imm_val(%IMM.NIL))
    605     %call(&cons)
    606 
    607     # If head is NIL, both head and tail = new cons; else set-cdr! tail = new.
    608     %ldl(t0, head)
    609     %bine(t0, %imm_val(%IMM.NIL), &.link, t1)
    610     %stl(a0, head)
    611     %stl(a0, tail)
    612     %b(&.loop)
    613 
    614     :.link
    615     %ldl(t0, tail)
    616     # set-cdr! tail = a0  -> store a0 at [tail + 7] (raw + 8)
    617     %set_cdr(a0, t0)
    618     %stl(a0, tail)
    619     %b(&.loop)
    620 
    621     :.do_dot
    622     # Consume the '.', read one datum, splice it in as the cdr of the
    623     # tail cons. Then expect a closing ')' (with optional ws).
    624     %lda_global(t0, t1, &readbuf_pos)
    625     %readbuf_advance(t0, t1)
    626     %call(&parse_one)
    627     %ldl(t0, tail)
    628     %set_cdr(a0, t0)
    629     %call(&skip_ws)
    630     %bnez(a0, &.eof)
    631     %lda_global(t0, t1, &readbuf_pos)
    632     %readbuf_byte(a0, t0)
    633     %bcne(a0, -41, &.eof, a1)    ; ')'
    634     %readbuf_advance(t0, t1)
    635     %ldl(a0, head)
    636     %gceret
    637 
    638     :.close
    639     # Consume ')' and return head.
    640     %lda_global(t1, t0, &readbuf_pos)
    641     %readbuf_advance(t1, t0)
    642     %ldl(a0, head)
    643     %gceret
    644 
    645     :.eof
    646     %die(msg_unterm_list)
    647 })
    648 
    649 # parse_u8_body() -> tagged HDR.BV in a0. Cursor sits past '#u8(' on
    650 # entry. Reads elements via parse_list (each must be a fixnum byte 0..255;
    651 # range is unchecked, matching make-bytevector's lax stance) and packs
    652 # them into a fresh bytevector.
    653 #
    654 # Locals:
    655 #   list    parsed element list (cursor during fill pass)
    656 #   result  freshly allocated bv
    657 %gcfn2(parse_u8_body, {list result}, 3, 0, {
    658     %call(&parse_list)
    659     %stl(a0, list)
    660 
    661     %call(&list_length)             ; clobbers a0 -> count
    662     %call(&bv_alloc)                ; a0 = bv
    663     %stl(a0, result)
    664 
    665     %heap_ld(t0, a0, %BV.data)
    666     %ldl(a0, list)                  ; list cursor
    667 
    668     :.loop
    669         %if_nil(t1, a0, &.done)
    670         %car(t1, a0)
    671         %untag_fix(t1, t1)
    672         %sb(t1, t0, 0)
    673         %addi(t0, t0, 1)
    674         %cdr(a0, a0)
    675         %b(&.loop)
    676     :.done
    677     %ldl(a0, result)
    678 })
    679 
    680 # is_ident_byte(c=a0) -> a1 (1 if c is a valid identifier byte, else 0).
    681 # Leaf. Allowed bytes are R7RS-Small's identifier set: ASCII letters,
    682 # digits, and the extended chars  ! $ % & * + - . / : < = > ? @ ^ _ ~ .
    683 # Clobbers t0, t1, a1.
    684 :is_ident_byte
    685 .scope
    686     %brange(a0, -48, 10, t0, t1, &.ok)    ; '0'..'9'
    687     %brange(a0, -65, 26, t0, t1, &.ok)    ; 'A'..'Z'
    688     %brange(a0, -97, 26, t0, t1, &.ok)    ; 'a'..'z'
    689 
    690     %bceq(a0,  -33, &.ok, t0)    ; '!'
    691     %bceq(a0,  -36, &.ok, t0)    ; '$'
    692     %bceq(a0,  -37, &.ok, t0)    ; '%'
    693     %bceq(a0,  -38, &.ok, t0)    ; '&'
    694     %bceq(a0,  -42, &.ok, t0)    ; '*'
    695     %bceq(a0,  -43, &.ok, t0)    ; '+'
    696     %bceq(a0,  -45, &.ok, t0)    ; '-'
    697     %bceq(a0,  -46, &.ok, t0)    ; '.'
    698     %bceq(a0,  -47, &.ok, t0)    ; '/'
    699     %bceq(a0,  -58, &.ok, t0)    ; ':'
    700     %bceq(a0,  -60, &.ok, t0)    ; '<'
    701     %bceq(a0,  -61, &.ok, t0)    ; '='
    702     %bceq(a0,  -62, &.ok, t0)    ; '>'
    703     %bceq(a0,  -63, &.ok, t0)    ; '?'
    704     %bceq(a0,  -64, &.ok, t0)    ; '@'
    705     %bceq(a0,  -94, &.ok, t0)    ; '^'
    706     %bceq(a0,  -95, &.ok, t0)    ; '_'
    707     %bceq(a0, -126, &.ok, t0)    ; '~'
    708 
    709     %li(a1, 0)
    710     %ret
    711 
    712     :.ok
    713     %li(a1, 1)
    714     %ret
    715 .endscope
    716 
    717 # parse_atom() -> tagged value (fixnum or symbol) in a0.
    718 # Reads until whitespace or paren or EOF, then dispatches by first byte.
    719 # A token whose first byte is a digit (or sign-then-digit) commits to
    720 # parse_dec and any non-numeric byte aborts; otherwise the token is a
    721 # symbol and every byte is checked against is_ident_byte before intern.
    722 #
    723 # Locals:
    724 #   start  cursor (byte offset)
    725 #   end  cursor   (byte offset)
    726 #   cursor  (scratch slot for the symbol-validation loop)
    727 %fn2(parse_atom, {start end cursor}, {
    728     %lda_global(t1, t0, &readbuf_pos)
    729     %stl(t1, start)
    730 
    731     %ld_global(t2, &readbuf_len)
    732 
    733     :.scan
    734     %beq(t1, t2, &.end)
    735     %readbuf_byte(a0, t1)
    736 
    737     %is_ws_branch(a1, a0, &.end)
    738     %bceq(a0, -40, &.end, a1)    ; '('
    739     %bceq(a0, -41, &.end, a1)    ; ')'
    740 
    741     %addi(t1, t1, 1)
    742     %b(&.scan)
    743 
    744     :.end
    745     %stl(t1, end)
    746     %st(t1, t0, 0)
    747 
    748     # Dispatch on the first byte.
    749     %ldl(t0, start)
    750     %ld_global(a0, &readbuf_buf_ptr)
    751     %add(a0, a0, t0)
    752     %lb(t1, a0, 0)
    753 
    754     # '0'..'9' -> int
    755     %addi(a1, t1, -48)
    756     %li(a2, 10)
    757     %bltu(a1, a2, &.is_int)
    758     # '-' or '+' followed by digit -> int. A lone '+' or '-' falls
    759     # through to is_sym (those tokens stay valid identifiers).
    760     %bceq(t1, -45, &.sign, a1)    ; '-'
    761     %bceq(t1, -43, &.sign, a1)    ; '+'
    762     %b(&.is_sym)
    763     :.sign
    764     %ldl(t2, end)
    765     %addi(t0, t0, 1)
    766     %beq(t0, t2, &.is_sym)
    767     %readbuf_byte(a0, t0)
    768     %addi(a1, a0, -48)
    769     %bltu(a1, a2, &.is_int)
    770     # fall through to is_sym
    771 
    772     :.is_sym
    773     # Validate every byte; abort on the first non-ident byte.
    774     %ldl(t0, start)
    775     %stl(t0, cursor)
    776     :.sym_loop
    777     %ldl(t0, cursor)
    778     %ldl(t1, end)
    779     %beq(t0, t1, &.sym_intern)
    780     %readbuf_byte(a0, t0)
    781     %call(&is_ident_byte)
    782     %beqz(a1, &.sym_bad)
    783     %ldl(t0, cursor)
    784     %addi(t0, t0, 1)
    785     %stl(t0, cursor)
    786     %b(&.sym_loop)
    787 
    788     :.sym_bad
    789     %die(msg_bad_ident)
    790 
    791     :.sym_intern
    792     %ldl(a0, start)
    793     %ld_global(t0, &readbuf_buf_ptr)
    794     %add(a0, t0, a0)
    795     %ldl(t1, end)
    796     %ldl(t2, start)
    797     %sub(a1, t1, t2)
    798     %tail(&intern)
    799 
    800     :.is_int
    801     %ldl(t0, start)
    802     %ldl(t1, end)
    803     %ld_global(a0, &readbuf_buf_ptr)
    804     %add(a0, a0, t0)
    805     %sub(a1, t1, t0)            ; len = end - start
    806     # P1pp's parse_dec handles '-' but not '+'; strip '+' here.
    807     %lb(t2, a0, 0)
    808     %bcne(t2, -43, &.no_plus, t2)    ; '+'
    809     %addi(a0, a0, 1)
    810     %addi(a1, a1, -1)
    811     :.no_plus
    812     %stl(a1, cursor)            ; save adjusted len (cursor slot is free on int path)
    813     %call(&parse_dec)           ; P1pp: -> (raw_val=a0, consumed=a1)
    814     %ldl(t0, cursor)
    815     %bne(a1, t0, &.int_bad)    ; partial parse -> bad
    816     %mkfix(a0, a0)
    817     %eret
    818     :.int_bad
    819     %die(msg_bad_number)
    820 })
    821 
    822 # parse_string() -> tagged bytevector in a0. Cursor sits past the
    823 # opening '"' (consumed by parse_one). Two-pass: pass 1 walks the body,
    824 # counting decoded bytes in a0 and locating the closing '"'; pass 2
    825 # allocates the bv and decodes into its data buffer. Each named escape
    826 # (\n \t \r \\ \") yields one byte; an inline-hex escape \xHEX; (1+
    827 # hex digits, value 0..255, terminated by ';') also yields one byte.
    828 #
    829 # Locals:
    830 #   start  cursor (first content byte)
    831 #   end  cursor   (closing '"' position)
    832 #   bv  wrapper   (saved across the data fill loop)
    833 #   spill  slot   (write ptr saved across parse_hex in \x escape)
    834 %fn2(parse_string, {start end bv spill}, {
    835     %ld_global(t1, &readbuf_pos)
    836     %stl(t1, start)
    837 
    838     %ld_global(t2, &readbuf_len)
    839 
    840     %li(a0, 0)
    841     :.scan
    842         %beq(t1, t2, &.eof)
    843         %readbuf_byte(a3, t1)
    844         %bceq(a3, -34, &.scan_done, a1)    ; '"'
    845         %bceq(a3, -92, &.scan_esc,  a1)    ; '\\'
    846         %addi(t1, t1, 1)
    847         %addi(a0, a0, 1)
    848         %b(&.scan)
    849 
    850         :.scan_esc
    851         # Backslash plus the next byte yield one decoded byte. \xHEX; runs
    852         # until the terminating ';' (validated in pass 2); every other escape
    853         # is exactly two source bytes.
    854         %addi(t1, t1, 1)
    855         %beq(t1, t2, &.eof)
    856         %readbuf_byte(a3, t1)
    857         %bceq(a3, -120, &.scan_hex, a1)    ; 'x'
    858         %addi(t1, t1, 1)
    859         %addi(a0, a0, 1)
    860         %b(&.scan)
    861 
    862         :.scan_hex
    863         # Skip past 'x' and scan to the terminating ';'. EOF before ';'
    864         # falls into the unterminated-string path below, matching how an
    865         # unterminated body is reported.
    866         %addi(t1, t1, 1)
    867         :.scan_hex_loop
    868         %beq(t1, t2, &.eof)
    869         %readbuf_byte(a3, t1)
    870         %bceq(a3, -59, &.scan_hex_done, a1)    ; ';'
    871         %addi(t1, t1, 1)
    872         %b(&.scan_hex_loop)
    873         :.scan_hex_done
    874         %addi(t1, t1, 1)                ; consume ';'
    875         %addi(a0, a0, 1)                ; +1 output byte
    876         %b(&.scan)
    877     :.scan_done
    878 
    879     %stl(t1, end)
    880     %call(&str_alloc)
    881     %stl(a0, bv)
    882 
    883     # Pass 2: decode into the freshly allocated data buffer.
    884     %ldl(t1, start)
    885     %ldl(t2, end)
    886     %heap_ld(a3, a0, %BV.data)
    887 
    888     :.fill
    889     %beq(t1, t2, &.fill_done)
    890     %readbuf_byte(a1, t1)
    891     %bceq(a1, -92, &.fill_esc, a2)    ; '\\'
    892     %sb(a1, a3, 0)
    893     %addi(a3, a3, 1)
    894     %addi(t1, t1, 1)
    895     %b(&.fill)
    896 
    897     :.fill_esc
    898     %addi(t1, t1, 1)                ; consume backslash
    899     %readbuf_byte(a1, t1)
    900     %bceq(a1, -110, &.esc_n,      a2)    ; 'n'
    901     %bceq(a1, -116, &.esc_t,      a2)    ; 't'
    902     %bceq(a1, -114, &.esc_r,      a2)    ; 'r'
    903     %bceq(a1,  -92, &.write_byte, a2)    ; '\\'
    904     %bceq(a1,  -34, &.write_byte, a2)    ; '"'
    905     %bceq(a1, -120, &.esc_hex,    a2)    ; 'x'
    906     %die(msg_bad_escape)
    907 
    908     :.esc_n
    909     %li(a1, 10)
    910     %b(&.write_byte)
    911     :.esc_t
    912     %li(a1, 9)
    913     %b(&.write_byte)
    914     :.esc_r
    915     %li(a1, 13)
    916     :.write_byte
    917     %sb(a1, a3, 0)
    918     %addi(a3, a3, 1)
    919     %addi(t1, t1, 1)
    920     %b(&.fill)
    921 
    922     :.esc_hex
    923     # Skip past 'x'. parse_hex consumes hex digits; demand at least one,
    924     # value <= 255, and an immediate ';' terminator. parse_hex clobbers
    925     # t0/t1/t2 and a2/a3, so spill the cursor (t1) and write ptr (a3)
    926     # across the call. sp+0 is free once pass 1 finishes.
    927     %addi(t1, t1, 1)                ; t1 -> first hex digit
    928     %stl(t1, start)
    929     %stl(a3, spill)
    930     %ld_global(t0, &readbuf_buf_ptr)
    931     %add(a0, t0, t1)                ; ptr to first hex digit
    932     %sub(a1, t2, t1)                ; max len (bytes left in body)
    933     %call(&parse_hex)               ; -> (a0=value, a1=consumed)
    934     %beqz(a1, &.hex_bad)
    935     %li(t0, 255)
    936     %bltu(t0, a0, &.hex_bad)
    937     %ldl(t1, start)
    938     %add(t1, t1, a1)                ; t1 = position of expected ';'
    939     %ldl(t2, end)
    940     %beq(t1, t2, &.hex_bad)
    941     %readbuf_byte(t0, t1)
    942     %bcne(t0, -59, &.hex_bad, t0)    ; ';'
    943     %addi(t1, t1, 1)                ; consume ';'
    944     %ldl(a3, spill)
    945     %sb(a0, a3, 0)
    946     %addi(a3, a3, 1)
    947     %b(&.fill)
    948 
    949     :.hex_bad
    950     %die(msg_bad_escape)
    951 
    952     :.fill_done
    953     %addi(t1, t1, 1)                ; consume closing '"'
    954     %st_global(t1, &readbuf_pos, t0)
    955     %ldl(a0, bv)
    956     %eret
    957 
    958     :.eof
    959     %die(msg_unterm_string)
    960 })
    961 
    962 # Emit one named-char arm inside parse_char's multi-byte dispatch. t2
    963 # must hold the slice pointer; ::bad must be in scope. name_label is a
    964 # full label reference (e.g. &name_ch_tab).
    965 %macro match_named_char(name_label, len, value)
    966     %mov(a0, t2)
    967     %la(a1, name_label)
    968     %li(a2, len)
    969     %call(&memcmp)
    970     %bnez(a0, &.bad)
    971     %li(a0, value)
    972     %mkfix(a0, a0)
    973     %eret
    974 %endm
    975 
    976 # parse_char() -> tagged fixnum (the u8 char value) in a0. Cursor sits
    977 # past '#\\' (consumed by parse_one's hash dispatch). Always consumes
    978 # at least one byte; then continues until ws/paren/EOF. Single-byte
    979 # bodies yield that byte; multi-byte bodies dispatch to hex (#\xNN) or
    980 # named (#\space, #\newline, #\tab, #\return, #\null) forms.
    981 #
    982 # Locals:
    983 #   start  cursor
    984 #   end  cursor
    985 %fn2(parse_char, {start end}, {
    986     %lda_global(t1, t0, &readbuf_pos)
    987     %stl(t1, start)
    988 
    989     %ld_global(t2, &readbuf_len)
    990 
    991     %beq(t1, t2, &.short)
    992 
    993     # Always consume the first byte unconditionally — it might itself be
    994     # a delimiter (e.g., '(' in `#\(`) and is still the character value.
    995     %addi(t1, t1, 1)
    996 
    997     :.scan
    998     %beq(t1, t2, &.scan_done)
    999     %readbuf_byte(a0, t1)
   1000     %is_ws_branch(a1, a0, &.scan_done)
   1001     %bceq(a0, -40, &.scan_done, a1)    ; '('
   1002     %bceq(a0, -41, &.scan_done, a1)    ; ')'
   1003     %addi(t1, t1, 1)
   1004     %b(&.scan)
   1005 
   1006     :.scan_done
   1007     %stl(t1, end)
   1008     %st(t1, t0, 0)
   1009 
   1010     %ldl(t0, start)
   1011     %ldl(t1, end)
   1012     %sub(a2, t1, t0)                ; length
   1013 
   1014     %bieq(a2, 1, &.single, a3)
   1015 
   1016     %ld_global(t2, &readbuf_buf_ptr)
   1017     %add(t2, t2, t0)                ; t2 = slice ptr
   1018 
   1019     # Hex form: first byte is 'x'.
   1020     %lb(a0, t2, 0)
   1021     %addi(a1, a0, -120)             ; 'x'
   1022     %beqz(a1, &.hex_form)
   1023 
   1024     # Named form: dispatch on length.
   1025     %bieq(a2, 3, &.try_tab,     a3)
   1026     %bieq(a2, 4, &.try_null,    a3)
   1027     %bieq(a2, 5, &.try_space,   a3)
   1028     %bieq(a2, 6, &.try_return,  a3)
   1029     %bieq(a2, 7, &.try_newline, a3)
   1030     %b(&.bad)
   1031 
   1032     :.single
   1033     %ld_global(t2, &readbuf_buf_ptr)
   1034     %add(t2, t2, t0)
   1035     %lb(a0, t2, 0)
   1036     %mkfix(a0, a0)
   1037     %eret
   1038 
   1039     :.hex_form
   1040     %addi(a0, t2, 1)
   1041     %addi(a1, a2, -1)
   1042     %call(&parse_hex)
   1043     %mkfix(a0, a0)
   1044     %eret
   1045 
   1046     :.try_tab
   1047     %match_named_char(&name_ch_tab, 3, 9)
   1048 
   1049     :.try_null
   1050     %match_named_char(&name_ch_null, 4, 0)
   1051 
   1052     :.try_space
   1053     %match_named_char(&name_ch_space, 5, 32)
   1054 
   1055     :.try_return
   1056     %match_named_char(&name_ch_return, 6, 13)
   1057 
   1058     :.try_newline
   1059     %match_named_char(&name_ch_newline, 7, 10)
   1060 
   1061     :.bad
   1062     %die(msg_bad_char)
   1063 
   1064     :.short
   1065     %die(msg_bad_char)
   1066 })
   1067 
   1068 
   1069 # =========================================================================
   1070 # eval / apply
   1071 # =========================================================================
   1072 
   1073 # eval(expr=a0, env=a1) -> value (a0)
   1074 #
   1075 # Locals:
   1076 #   expr
   1077 #   env
   1078 #   fn  (head value, while args are being evaluated)
   1079 #   pad
   1080 %gcfn2(eval, {expr env fn pad}, 7, 0, {
   1081     %stl(a0, expr)
   1082     %stl(a1, env)
   1083 
   1084     %tagof(t0, a0)
   1085     %bieq(t0, %TAG.SYM,  &.sym,  t1)
   1086     %bieq(t0, %TAG.PAIR, &.pair, t1)
   1087     # FIXNUM, HEAP, IMM all self-evaluate.
   1088     %gceret
   1089 
   1090     :.sym
   1091     # Walk the env alist. Each cell is ((sym . val) . rest). On hit,
   1092     # return cdr(binding); on NIL, fall back to the symbol's global slot.
   1093     # a0 still holds the tagged sym; a1 still holds env.
   1094     :.env_walk
   1095     %if_nil(t0, a1, &.env_miss)
   1096     %car(t1, a1)            ; t1 = (sym . val)
   1097     %car(t2, t1)            ; t2 = sym in binding
   1098     %beq(t2, a0, &.env_hit)
   1099     %cdr(a1, a1)
   1100     %b(&.env_walk)
   1101 
   1102     :.env_hit
   1103     %cdr(a0, t1)
   1104     %gceret
   1105 
   1106     :.env_miss
   1107     %untag_sym(a0, a0)
   1108     %call(&sym_global)
   1109     %bieq(a0, %imm_val(%IMM.UNBOUND), &.unbound, t0)
   1110     %gceret
   1111 
   1112     :.unbound
   1113     %die(msg_unbound)
   1114 
   1115 
   1116     :.pair
   1117 
   1118     # Special-form dispatch: pointer-compare head against the cached
   1119     # special-form symbol values. SYM is a distinct tag, so a head that
   1120     # isn't a symbol cannot collide with any sym_* slot.
   1121     %ldl(t0, expr)
   1122     %car(t0, t0)            ; t0 = head
   1123     %dispatch_form(&sym_quote,   &.do_quote)
   1124     %dispatch_form(&sym_if,      &.do_if)
   1125     %dispatch_form(&sym_lambda,  &.do_lambda)
   1126     %dispatch_form(&sym_define,  &.do_define)
   1127     %dispatch_form(&sym_begin,   &.do_begin)
   1128     %dispatch_form(&sym_cond,    &.do_cond)
   1129     %dispatch_form(&sym_let,     &.do_let)
   1130     %dispatch_form(&sym_letstar, &.do_letstar)
   1131     %dispatch_form(&sym_let_values, &.do_let_values)
   1132     %dispatch_form(&sym_letstar_values, &.do_letstar_values)
   1133     %dispatch_form(&sym_and,     &.do_and)
   1134     %dispatch_form(&sym_or,      &.do_or)
   1135     %dispatch_form(&sym_when,    &.do_when)
   1136     %dispatch_form(&sym_case,    &.do_case)
   1137     %dispatch_form(&sym_setbang, &.do_setbang)
   1138     %dispatch_form(&sym_define_record_type, &.do_define_record_type)
   1139     %dispatch_form(&sym_pmatch,  &.do_pmatch)
   1140     %dispatch_form(&sym_do,      &.do_do)
   1141 
   1142     # Apply car to cdr
   1143     # fn = eval(car(expr), env)
   1144     %ldl(a0, expr)
   1145     %car(a0, a0)
   1146     %ldl(a1, env)
   1147     %call(&eval)
   1148     %stl(a0, fn)
   1149     # args = eval_args(cdr(expr), env)
   1150     %ldl(a0, expr)
   1151     %cdr(a0, a0)
   1152     %ldl(a1, env)
   1153     %call(&eval_args)
   1154     # apply(fn, args) -- tail call
   1155     %mov(a1, a0)
   1156     %ldl(a0, fn)
   1157     %gctail(&apply)
   1158 
   1159     :.do_quote
   1160     %tail_to_handler(&eval_quote)
   1161     :.do_if
   1162     %tail_to_handler(&eval_if)
   1163     :.do_lambda
   1164     %tail_to_handler(&eval_lambda)
   1165     :.do_define
   1166     %tail_to_handler(&eval_define)
   1167     :.do_begin
   1168     %tail_to_handler(&eval_body)
   1169     :.do_cond
   1170     %tail_to_handler(&eval_cond)
   1171     :.do_let
   1172     %tail_to_handler(&eval_let)
   1173     :.do_letstar
   1174     %tail_to_handler(&eval_letstar)
   1175     :.do_let_values
   1176     %tail_to_handler(&eval_let_values)
   1177     :.do_letstar_values
   1178     %tail_to_handler(&eval_letstar_values)
   1179     :.do_and
   1180     %tail_to_handler(&eval_and)
   1181     :.do_or
   1182     %tail_to_handler(&eval_or)
   1183     :.do_when
   1184     %tail_to_handler(&eval_when)
   1185     :.do_case
   1186     %tail_to_handler(&eval_case)
   1187     :.do_setbang
   1188     %tail_to_handler(&eval_setbang)
   1189     :.do_define_record_type
   1190     %tail_to_handler(&eval_define_record_type)
   1191     :.do_pmatch
   1192     %tail_to_handler(&eval_pmatch)
   1193     :.do_do
   1194     %tail_to_handler(&eval_do)
   1195 })
   1196 
   1197 # eval_args(args=a0, env=a1) -> evaluated args list (cons-built).
   1198 # Iterative head/tail-cdr build: each iteration evals one arg, allocates
   1199 # a (val . NIL) cell, and either seeds head/tail or set-cdr!s onto the
   1200 # previous tail. Host stack stays O(1) regardless of arg-list length;
   1201 # eval order is left-to-right.
   1202 #
   1203 # Locals:
   1204 #   args  (advances)
   1205 #   env
   1206 #   head  (NIL until first val is appended)
   1207 #   tail  (most recent cell; set-cdr! target)
   1208 %gcfn2(eval_args, {args env head tail}, 15, 0, {
   1209     %stl(a0, args)
   1210     %stl(a1, env)
   1211     %li(t0, %imm_val(%IMM.NIL))
   1212     %stl(t0, head)
   1213     %stl(t0, tail)
   1214 
   1215     :.loop
   1216         %ldl(t0, args)
   1217         %if_nil(t1, t0, &.done)
   1218 
   1219         # val = eval(car(args), env)
   1220         %car(a0, t0)
   1221         %ldl(a1, env)
   1222         %call(&eval)
   1223 
   1224         # cell = cons(val, NIL); append to head/tail.
   1225         %li(a1, %imm_val(%IMM.NIL))
   1226         %call(&cons)
   1227 
   1228         %ldl(t0, head)
   1229         %if_nil(t1, t0, &.first)
   1230         %ldl(t0, tail)
   1231         %set_cdr(a0, t0)
   1232         %stl(a0, tail)
   1233         %b(&.advance)
   1234 
   1235         :.first
   1236         %stl(a0, head)
   1237         %stl(a0, tail)
   1238 
   1239         :.advance
   1240         %advance_walk(args)
   1241         %b(&.loop)
   1242     :.done
   1243 
   1244     %ldl(a0, head)
   1245 })
   1246 
   1247 
   1248 # apply(fn=a0, args=a1) -> result (a0)
   1249 #
   1250 # Locals:
   1251 #   args
   1252 #   body  (saved across bind_params for the closure path)
   1253 %gcfn2(apply, {args body}, 3, 0, {
   1254     %stl(a1, args)
   1255 
   1256     %hdr_type(t0, a0)
   1257     %bieq(t0, %HDR.PRIM,    &.prim,    t1)
   1258     %bieq(t0, %HDR.CLOSURE, &.closure, t1)
   1259 
   1260     :.prim
   1261     # Primitive calling convention:
   1262     #   a0 = args list (proper list of evaluated args)
   1263     #   a1 = the PRIM object itself (HEAP-tagged)
   1264     # Parameterized PRIMs (e.g. the per-field record accessors built
   1265     # by define-record-type) read their closed-over datum from
   1266     # a1+13. Plain PRIMs ignore a1. A primitive that needs a1 as a
   1267     # working register must save it first; this convention is shared
   1268     # across every entry in prim_table and is not negotiable per
   1269     # primitive. prim_apply_entry maintains the same contract when it
   1270     # tail-calls back into apply.
   1271     %mov(a1, a0)
   1272     %heap_ld(t0, a0, %PRIM.entry_w)
   1273     %ldl(a0, args)
   1274     %gctailr(t0)
   1275 
   1276     :.closure
   1277     # Closure layout (HEAP-tagged): [hdr][params][body][env]
   1278     %heap_ld(t0, a0, %CLOSURE.params)
   1279     %heap_ld(t1, a0, %CLOSURE.body)
   1280     %heap_ld(t2, a0, %CLOSURE.env)
   1281     %stl(t1, body)  ; persist body past bind_params
   1282 
   1283     # bind_params(params, args, env)
   1284     %mov(a0, t0)
   1285     %ldl(a1, args)
   1286     %mov(a2, t2)
   1287     %call(&bind_params)
   1288 
   1289     # eval_body(body, new_env) -- tail call
   1290     %mov(a1, a0)
   1291     %ldl(a0, body)
   1292     %gctail(&eval_body)
   1293 })
   1294 
   1295 # =========================================================================
   1296 # Special forms
   1297 # =========================================================================
   1298 #
   1299 # intern_special_forms runs at startup, before register_primitives, so
   1300 # the symbols `if`, ... occupy the first sym_idx slots (per LISP-C.md
   1301 # §Reservation convention). For now we just cache each one's tagged
   1302 # value in a labeled slot; eval's pair branch compares head against
   1303 # these slots before falling through to ordinary application.
   1304 
   1305 %fn(intern_special_forms, 0, {
   1306     %intern_form(quote,              "quote",              &sym_quote)
   1307     %intern_form(if,                 "if",                 &sym_if)
   1308     %intern_form(lambda,             "lambda",             &sym_lambda)
   1309     %intern_form(define,             "define",             &sym_define)
   1310     %intern_form(begin,              "begin",              &sym_begin)
   1311     %intern_form(cond,               "cond",               &sym_cond)
   1312     %intern_form(else,               "else",               &sym_else)
   1313     %intern_form(arrow,              "=>",                 &sym_arrow)
   1314     %intern_form(let,                "let",                &sym_let)
   1315     %intern_form(letstar,            "let*",               &sym_letstar)
   1316     %intern_form(let_values,         "let-values",         &sym_let_values)
   1317     %intern_form(letstar_values,     "let*-values",        &sym_letstar_values)
   1318     %intern_form(and,                "and",                &sym_and)
   1319     %intern_form(or,                 "or",                 &sym_or)
   1320     %intern_form(when,               "when",               &sym_when)
   1321     %intern_form(case,               "case",               &sym_case)
   1322     %intern_form(setbang,            "set!",               &sym_setbang)
   1323     %intern_form(define_record_type, "define-record-type", &sym_define_record_type)
   1324     %intern_form(pmatch,             "pmatch",             &sym_pmatch)
   1325     %intern_form(do,                 "do",                 &sym_do)
   1326     %intern_form(unquote,            "unquote",            &sym_unquote)
   1327     %intern_form(guard,              "guard",              &sym_guard)
   1328     %intern_form(underscore,         "_",                  &sym_underscore)
   1329     %intern_form(dollar,             "$",                  &sym_dollar)
   1330 })
   1331 
   1332 # eval_quote(rest=a0, env=a1) -> value (a0). rest is (datum); return datum.
   1333 %fn(eval_quote, 0, {
   1334     %car(a0, a0)
   1335 })
   1336 
   1337 # eval_if(rest=a0, env=a1) -> value (a0). `rest` is (test then) or
   1338 # (test then else). Single-arm form returns UNSPEC when test is #f.
   1339 # No arity check beyond that -- spec policy: malformed special forms
   1340 # are UB.
   1341 #
   1342 # Locals:
   1343 #   rest
   1344 #   env
   1345 %gcfn2(eval_if, {rest env}, 3, 0, {
   1346     %stl(a0, rest)
   1347     %stl(a1, env)
   1348 
   1349     # val = eval(car(rest), env)
   1350     %car(a0, a0)
   1351     %call(&eval)
   1352 
   1353     %bieq(a0, %imm_val(%IMM.FALSE), &.else_branch, t0)
   1354 
   1355     # then-branch: tail-eval(cadr(rest), env)
   1356     %ldl(a0, rest)
   1357     %cdr(a0, a0)
   1358     %car(a0, a0)
   1359     %ldl(a1, env)
   1360     %gctail(&eval)
   1361 
   1362     :.else_branch
   1363     # If cddr(rest) is NIL, this is single-arm `if` -> UNSPEC.
   1364     %ldl(t0, rest)
   1365     %cdr(t0, t0)
   1366     %cdr(t0, t0)
   1367     %if_nil(t1, t0, &.no_else)
   1368 
   1369     # else-branch: tail-eval(car(cddr(rest)), env)
   1370     %car(a0, t0)
   1371     %ldl(a1, env)
   1372     %gctail(&eval)
   1373 
   1374     :.no_else
   1375     %li(a0, %imm_val(%IMM.UNSPEC))
   1376 })
   1377 
   1378 # eval_lambda(rest=a0, env=a1) -> closure (a0).
   1379 # rest is (params . body). Allocates a 32-byte CLOSURE on the heap
   1380 # and stores params, body, and the captured env directly.
   1381 #
   1382 # Locals:
   1383 #   rest
   1384 #   env
   1385 #   closure  ptr (HEAP-tagged)
   1386 %gcfn2(eval_lambda, {rest env closure}, 7, 0, {
   1387     %stl(a0, rest)
   1388     %stl(a1, env)
   1389 
   1390     %li(a0, %CLOSURE.SIZE)
   1391     %li(a1, %HDR.CLOSURE)
   1392     %call(&alloc_hdr)
   1393     %stl(a0, closure)
   1394 
   1395     # closure[params] = car(rest)
   1396     %ldl(t0, rest)
   1397     %car(t1, t0)
   1398     %ldl(t0, closure)
   1399     %heap_st(t1, t0, %CLOSURE.params)
   1400 
   1401     # closure[body] = cdr(rest)
   1402     %ldl(t1, rest)
   1403     %cdr(t1, t1)
   1404     %heap_st(t1, t0, %CLOSURE.body)
   1405 
   1406     # closure[env] = captured env
   1407     %ldl(t1, env)
   1408     %heap_st(t1, t0, %CLOSURE.env)
   1409 
   1410     %ldl(a0, closure)
   1411 })
   1412 
   1413 # eval_define(rest=a0, env=a1) -> UNSPEC (a0).
   1414 # Top-level only. Two surface forms:
   1415 #   (define <sym> <expr>)              ; head of rest is a SYM
   1416 #   (define (<sym> . <params>) . body) ; head of rest is a PAIR; sugar for
   1417 #                                         (define <sym> (lambda <params> . body))
   1418 # Internal `define` is rejected by eval_body before this entry is reached
   1419 # (every internal body context routes through eval_body); see the check
   1420 # at the head of eval_body's loop.
   1421 #
   1422 # Locals:
   1423 #   rest
   1424 #   env
   1425 %gcfn2(eval_define, {rest env}, 3, 0, {
   1426     %stl(a0, rest)
   1427     %stl(a1, env)
   1428 
   1429     # If car(rest) is a pair, this is the lambda-sugar form.
   1430     %car(t0, a0)
   1431     %tagof(t1, t0)
   1432     %bieq(t1, %TAG.PAIR, &.sugar, t2)
   1433 
   1434     # Plain define: value = eval(car(cdr(rest)), env)
   1435     %ldl(t0, rest)
   1436     %cdr(a0, t0)
   1437     %car(a0, a0)
   1438     %ldl(a1, env)
   1439     %call(&eval)
   1440 
   1441     %ldl(t0, rest)
   1442     %car(t0, t0)
   1443     %set_global(t0, a0)
   1444     %li(a0, %imm_val(%IMM.UNSPEC))
   1445     %gceret
   1446 
   1447     :.sugar
   1448     # rest = ((name . params) . body); build (params . body) for eval_lambda.
   1449     %ldl(t0, rest)
   1450     %car(t0, t0)
   1451     %cdr(a0, t0)            ; params
   1452     %ldl(t0, rest)
   1453     %cdr(a1, t0)            ; body
   1454     %call(&cons)
   1455     %ldl(a1, env)
   1456     %call(&eval_lambda)
   1457 
   1458     %ldl(t0, rest)
   1459     %car(t0, t0)
   1460     %car(t0, t0)            ; name
   1461     %set_global(t0, a0)
   1462     %li(a0, %imm_val(%IMM.UNSPEC))
   1463 })
   1464 
   1465 # eval_setbang(rest=a0, env=a1) -> UNSPEC (a0).
   1466 # rest = (sym value-expr). Evaluates value-expr in env, then walks the
   1467 # env alist looking for a binding cell whose car is the target sym;
   1468 # on hit, mutates the cell's cdr (offset 7, same as set-cdr!). On miss,
   1469 # falls back to the global slot via sym_set_global -- the shape used
   1470 # by define for top-level rebind. Spec: behavior on a truly unbound
   1471 # name follows the primitive-failure policy.
   1472 #
   1473 # Locals:
   1474 #   rest  (sym . (value-expr . ()))
   1475 #   env
   1476 #   saved  value   (eval'd value-expr)
   1477 %gcfn2(eval_setbang, {rest env saved}, 7, 0, {
   1478     %stl(a0, rest)
   1479     %stl(a1, env)
   1480 
   1481     # value = eval(cadr(rest), env)
   1482     %cdr(a0, a0)
   1483     %car(a0, a0)
   1484     %ldl(a1, env)
   1485     %call(&eval)
   1486     %stl(a0, saved)
   1487 
   1488     # Walk env looking for a binding cell whose car == target sym.
   1489     # Only t0..t2 are available: t0 scratch, t1 target sym, t2 env cursor.
   1490     %ldl(t1, rest)
   1491     %car(t1, t1)            ; target sym
   1492 
   1493     :.loop
   1494         %ldl(t2, env)
   1495         %if_nil(t0, t2, &.miss)
   1496         %car(t0, t2)
   1497         %car(t0, t0)            ; cell sym
   1498         %beq(t0, t1, &.hit)
   1499         %cdr(t2, t2)
   1500         %stl(t2, env)
   1501         %b(&.loop)
   1502 
   1503     :.hit
   1504     %car(t0, t2)            ; re-fetch binding cell
   1505     %ldl(a0, saved)
   1506     %set_cdr(a0, t0)          ; mutate cell's cdr
   1507     %li(a0, %imm_val(%IMM.UNSPEC))
   1508     %gceret
   1509 
   1510     :.miss
   1511     # Miss: rebind global.
   1512     %ldl(a0, saved)
   1513     %ldl(t0, rest)
   1514     %car(t0, t0)
   1515     %set_global(t0, a0)
   1516     %li(a0, %imm_val(%IMM.UNSPEC))
   1517 })
   1518 
   1519 # eval_cond(clauses=a0, env=a1) -> value (a0).
   1520 # Clause shapes: (else body...), (test body...), (test => proc-expr).
   1521 # else / => are literal symbols matched by pointer equality. The =>
   1522 # arrow is only recognized in non-else clauses; an empty body after a
   1523 # truthy test returns UNSPEC (spec policy: malformed-form UB).
   1524 #
   1525 # Locals:
   1526 #   clauses  (advances)
   1527 #   env
   1528 #   test  value (live across the => eval/cons calls)
   1529 #   proc  (live across the => cons call)
   1530 %gcfn2(eval_cond, {clauses env test proc}, 15, 0, {
   1531     %stl(a0, clauses)
   1532     %stl(a1, env)
   1533 
   1534     :.loop
   1535     %ldl(t0, clauses)
   1536     %if_nil(t1, t0, &.no_match)
   1537 
   1538     %car(t1, t0)            ; clause
   1539     %car(t2, t1)            ; test_expr
   1540 
   1541     %ld_global(a0, &sym_else)
   1542     %beq(t2, a0, &.else_clause)
   1543 
   1544     %mov(a0, t2)
   1545     %ldl(a1, env)
   1546     %call(&eval)
   1547     %li(t0, %imm_val(%IMM.FALSE))
   1548     %beq(a0, t0, &.next)
   1549 
   1550     # Truthy. Spill test value and inspect cdr(clause): empty -> UNSPEC,
   1551     # car == => -> arrow path, else regular body.
   1552     %stl(a0, test)
   1553     %ldl(t0, clauses)
   1554     %car(t0, t0)
   1555     %cdr(t0, t0)
   1556     %if_nil(t1, t0, &.no_match)
   1557     %car(t1, t0)
   1558     %ld_global(t2, &sym_arrow)
   1559     %beq(t1, t2, &.arrow)
   1560 
   1561     %mov(a0, t0)            ; regular body
   1562     %ldl(a1, env)
   1563     %gctail(&eval_body)
   1564 
   1565     :.arrow
   1566     %cdr(t0, t0)
   1567     %car(a0, t0)            ; proc-expr
   1568     %ldl(a1, env)
   1569     %call(&eval)
   1570     %stl(a0, proc)
   1571     %ldl(a0, test)
   1572     %li(a1, %imm_val(%IMM.NIL))
   1573     %call(&cons)
   1574     %mov(a1, a0)
   1575     %ldl(a0, proc)
   1576     %gctail(&apply)
   1577 
   1578     :.else_clause
   1579     %ldl(t0, clauses)
   1580     %car(t0, t0)
   1581     %cdr(a0, t0)
   1582     %ldl(a1, env)
   1583     %gctail(&eval_body)
   1584 
   1585     :.next
   1586     %advance_walk(clauses)
   1587     %b(&.loop)
   1588 
   1589     :.no_match
   1590     %li(a0, %imm_val(%IMM.UNSPEC))
   1591 })
   1592 
   1593 # eval_let(rest=a0, env=a1) -> value (a0).
   1594 # Two surface forms:
   1595 #   (let ((p v) ...) body...)
   1596 #   (let name ((p v) ...) body...)   ; named let, dispatches to eval_let_named
   1597 # Standard `let` evaluates every init in `env`, then extends env with all
   1598 # bindings simultaneously and tail-evaluates the body.
   1599 #
   1600 # Locals:
   1601 #   rest
   1602 #   env  (original)
   1603 #   walk  (bindings, advances)
   1604 #   new_env  (built up)
   1605 %gcfn2(eval_let, {rest env walk new_env}, 15, 0, {
   1606     %stl(a0, rest)
   1607     %stl(a1, env)
   1608 
   1609     # Named let?
   1610     %car(t0, a0)
   1611     %tagof(t1, t0)
   1612     %bieq(t1, %TAG.SYM, &.named, t2)
   1613 
   1614     %ldl(t0, rest)
   1615     %car(t0, t0)            ; bindings
   1616     %stl(t0, walk)
   1617     %ldl(t0, env)
   1618     %stl(t0, new_env)         ; new_env = env
   1619 
   1620     :.loop
   1621     %ldl(t0, walk)
   1622     %if_nil(t1, t0, &.done)
   1623 
   1624     %car(t1, t0)            ; pair = (name init)
   1625     %cdr(t2, t1)
   1626     %car(t2, t2)            ; init
   1627 
   1628     # val = eval(init, env_orig)
   1629     %mov(a0, t2)
   1630     %ldl(a1, env)
   1631     %call(&eval)
   1632 
   1633     # binding = cons(name, val)
   1634     %ldl(t0, walk)
   1635     %car(t1, t0)
   1636     %car(t2, t1)
   1637     %mov(a1, a0)
   1638     %mov(a0, t2)
   1639     %call(&cons)
   1640 
   1641     # new_env = cons(binding, new_env)
   1642     %ldl(a1, new_env)
   1643     %call(&cons)
   1644     %stl(a0, new_env)
   1645 
   1646     %advance_walk(walk)
   1647     %b(&.loop)
   1648 
   1649     :.done
   1650     %ldl(a0, rest)
   1651     %cdr(a0, a0)            ; body
   1652     %ldl(a1, new_env)
   1653     %gctail(&eval_body)
   1654 
   1655     :.named
   1656     %ldl(a0, rest)
   1657     %ldl(a1, env)
   1658     %gctail(&eval_let_named)
   1659 })
   1660 
   1661 # eval_letstar(rest=a0, env=a1) -> value (a0).
   1662 # Like let, but each init is evaluated in the env extended by all prior
   1663 # bindings of the same let* form (left-to-right shadowing).
   1664 #
   1665 # Locals:
   1666 #   rest
   1667 #   env
   1668 #   walk
   1669 #   new_env
   1670 %gcfn2(eval_letstar, {rest env walk new_env}, 15, 0, {
   1671     %stl(a0, rest)
   1672     %stl(a1, env)
   1673 
   1674     %ldl(t0, rest)
   1675     %car(t0, t0)
   1676     %stl(t0, walk)
   1677     %ldl(t0, env)
   1678     %stl(t0, new_env)
   1679 
   1680     :.loop
   1681         %ldl(t0, walk)
   1682         %if_nil(t1, t0, &.done)
   1683 
   1684         %car(t1, t0)
   1685         %cdr(t2, t1)
   1686         %car(t2, t2)
   1687 
   1688         # val = eval(init, new_env)
   1689         %mov(a0, t2)
   1690         %ldl(a1, new_env)
   1691         %call(&eval)
   1692 
   1693         %ldl(t0, walk)
   1694         %car(t1, t0)
   1695         %car(t2, t1)
   1696         %mov(a1, a0)
   1697         %mov(a0, t2)
   1698         %call(&cons)
   1699 
   1700         %ldl(a1, new_env)
   1701         %call(&cons)
   1702         %stl(a0, new_env)
   1703 
   1704         %advance_walk(walk)
   1705         %b(&.loop)
   1706     :.done
   1707 
   1708     %ldl(a0, rest)
   1709     %cdr(a0, a0)
   1710     %ldl(a1, new_env)
   1711     %gctail(&eval_body)
   1712 })
   1713 
   1714 # eval_let_values(rest=a0, env=a1) -> value (a0).
   1715 # rest = (((formals init) ...) body...). Each init is evaluated in the
   1716 # OUTER env; mv_to_list normalizes its result so bind_params can drive
   1717 # both list-style and dotted/rest formals identically. Then bodies run
   1718 # in the env extended by all clauses.
   1719 #
   1720 # Locals:
   1721 #   rest
   1722 #   env  (original)
   1723 #   walk  (clauses, advances)
   1724 #   new_env  (built up)
   1725 %gcfn2(eval_let_values, {rest env walk new_env}, 15, 0, {
   1726     %stl(a0, rest)
   1727     %stl(a1, env)
   1728 
   1729     %ldl(t0, rest)
   1730     %car(t0, t0)            ; clauses
   1731     %stl(t0, walk)
   1732     %ldl(t0, env)
   1733     %stl(t0, new_env)         ; new_env = env
   1734 
   1735     :.loop
   1736         %ldl(t0, walk)
   1737         %if_nil(t1, t0, &.done)
   1738 
   1739         %car(t1, t0)            ; clause = (formals init)
   1740         %cdr(t2, t1)
   1741         %car(t2, t2)            ; init
   1742 
   1743         # val = eval(init, env_orig)
   1744         %mov(a0, t2)
   1745         %ldl(a1, env)
   1746         %call(&eval)
   1747 
   1748         # vals = mv_to_list(val)
   1749         %call(&mv_to_list)
   1750 
   1751         # new_env = bind_params(formals, vals, new_env)
   1752         %ldl(t0, walk)
   1753         %car(t1, t0)
   1754         %car(t1, t1)            ; formals
   1755         %mov(a1, a0)
   1756         %mov(a0, t1)
   1757         %ldl(a2, new_env)
   1758         %call(&bind_params)
   1759         %stl(a0, new_env)
   1760 
   1761         %advance_walk(walk)
   1762         %b(&.loop)
   1763     :.done
   1764 
   1765     %ldl(a0, rest)
   1766     %cdr(a0, a0)            ; body
   1767     %ldl(a1, new_env)
   1768     %gctail(&eval_body)
   1769 })
   1770 
   1771 # eval_letstar_values(rest=a0, env=a1) -> value (a0).
   1772 # Like let-values but each init is evaluated in new_env (the env extended
   1773 # by all prior clauses' bindings), giving sequential / shadowing semantics.
   1774 #
   1775 # Locals:
   1776 #   rest
   1777 #   env
   1778 #   walk
   1779 #   new_env
   1780 %gcfn2(eval_letstar_values, {rest env walk new_env}, 15, 0, {
   1781     %stl(a0, rest)
   1782     %stl(a1, env)
   1783 
   1784     %ldl(t0, rest)
   1785     %car(t0, t0)
   1786     %stl(t0, walk)
   1787     %ldl(t0, env)
   1788     %stl(t0, new_env)
   1789 
   1790     :.loop
   1791         %ldl(t0, walk)
   1792         %if_nil(t1, t0, &.done)
   1793 
   1794         %car(t1, t0)
   1795         %cdr(t2, t1)
   1796         %car(t2, t2)            ; init
   1797 
   1798         # val = eval(init, new_env)
   1799         %mov(a0, t2)
   1800         %ldl(a1, new_env)
   1801         %call(&eval)
   1802 
   1803         %call(&mv_to_list)
   1804 
   1805         %ldl(t0, walk)
   1806         %car(t1, t0)
   1807         %car(t1, t1)            ; formals
   1808         %mov(a1, a0)
   1809         %mov(a0, t1)
   1810         %ldl(a2, new_env)
   1811         %call(&bind_params)
   1812         %stl(a0, new_env)
   1813 
   1814         %advance_walk(walk)
   1815         %b(&.loop)
   1816     :.done
   1817 
   1818     %ldl(a0, rest)
   1819     %cdr(a0, a0)
   1820     %ldl(a1, new_env)
   1821     %gctail(&eval_body)
   1822 })
   1823 
   1824 # eval_and(rest=a0, env=a1) -> value (a0).
   1825 # (and) is #t. Otherwise eval forms left-to-right, short-circuiting to #f
   1826 # the moment one yields #f. The last form is tail-evaluated so a tail call
   1827 # inside `and` doesn't grow the host stack.
   1828 #
   1829 # Locals:
   1830 #   rest
   1831 #   env
   1832 %gcfn2(eval_and, {rest env}, 3, 0, {
   1833     %li(t0, %imm_val(%IMM.TRUE))
   1834     %if_nil(t1, a0, &.done_imm)
   1835 
   1836     :.loop
   1837         %stl(a0, rest)
   1838         %stl(a1, env)
   1839 
   1840         # If cdr(rest) is NIL, the head is the last form -> tail-eval.
   1841         %cdr(t0, a0)
   1842         %if_nil(t1, t0, &.last)
   1843 
   1844         # Non-last: eval, short-circuit on #f, otherwise advance.
   1845         %car(a0, a0)
   1846         %call(&eval)
   1847         %li(t0, %imm_val(%IMM.FALSE))
   1848         %beq(a0, t0, &.done)
   1849         %ldl(a0, rest)
   1850         %cdr(a0, a0)
   1851         %ldl(a1, env)
   1852         %b(&.loop)
   1853 
   1854         :.last
   1855         %ldl(a0, rest)
   1856         %car(a0, a0)
   1857         %ldl(a1, env)
   1858         %gctail(&eval)
   1859     :.done
   1860 
   1861     %gceret
   1862 
   1863     :.done_imm
   1864     %mov(a0, t0)
   1865 })
   1866 
   1867 # eval_or(rest=a0, env=a1) -> value (a0).
   1868 # (or) is #f. Otherwise eval forms left-to-right and return the first
   1869 # non-#f value; if every form was #f, return #f. The last form is
   1870 # tail-evaluated.
   1871 #
   1872 # Locals:
   1873 #   rest
   1874 #   env
   1875 %gcfn2(eval_or, {rest env}, 3, 0, {
   1876     %li(t0, %imm_val(%IMM.FALSE))
   1877     %if_nil(t1, a0, &.done_imm)
   1878 
   1879     :.loop
   1880         %stl(a0, rest)
   1881         %stl(a1, env)
   1882 
   1883         %cdr(t0, a0)
   1884         %if_nil(t1, t0, &.last)
   1885 
   1886         %car(a0, a0)
   1887         %call(&eval)
   1888         %bine(a0, %imm_val(%IMM.FALSE), &.done, t0)
   1889         %ldl(a0, rest)
   1890         %cdr(a0, a0)
   1891         %ldl(a1, env)
   1892         %b(&.loop)
   1893 
   1894         :.last
   1895         %ldl(a0, rest)
   1896         %car(a0, a0)
   1897         %ldl(a1, env)
   1898         %gctail(&eval)
   1899     :.done
   1900 
   1901     %gceret
   1902 
   1903     :.done_imm
   1904     %mov(a0, t0)
   1905 })
   1906 
   1907 # eval_when(rest=a0, env=a1) -> value (a0).
   1908 # (when test body...) -- if test evaluates non-#f, tail-eval body and
   1909 # return its last value; otherwise return UNSPEC. Body never enters a
   1910 # new scope.
   1911 #
   1912 # Locals:
   1913 #   rest
   1914 #   env
   1915 %gcfn2(eval_when, {rest env}, 3, 0, {
   1916     %stl(a0, rest)
   1917     %stl(a1, env)
   1918 
   1919     %car(a0, a0)            ; test
   1920     %call(&eval)
   1921 
   1922     %bieq(a0, %imm_val(%IMM.FALSE), &.skip, t0)
   1923 
   1924     %ldl(a0, rest)
   1925     %cdr(a0, a0)            ; body
   1926     %ldl(a1, env)
   1927     %gctail(&eval_body)
   1928 
   1929     :.skip
   1930     %li(a0, %imm_val(%IMM.UNSPEC))
   1931 })
   1932 
   1933 # eval_case(rest=a0, env=a1) -> value (a0).
   1934 # rest is (key-expr clause...). The key is evaluated once; clauses are
   1935 # tried in order. Clause shape:
   1936 #   ((datum...) body...)   ; datums are literal, eq?-compared to key
   1937 #   (else body...)         ; matches unconditionally
   1938 # Matching uses pointer equality (eq?), which is correct for fixnums,
   1939 # symbols, chars, and booleans -- the values case is meant for. The
   1940 # matched clause's body is tail-evaluated via eval_body. No-match (and
   1941 # no else) returns UNSPEC, mirroring eval_cond's no-match policy.
   1942 #
   1943 # Locals:
   1944 #   subject  (evaluated key)
   1945 #   env
   1946 #   clauses  (advances)
   1947 #   datums   (advances within a clause)
   1948 %gcfn2(eval_case, {subject env clauses datums}, 15, 0, {
   1949     %stl(a1, env)
   1950 
   1951     # subject = eval(car(rest), env); clauses = cdr(rest).
   1952     %mov(t0, a0)
   1953     %cdr(t1, t0)
   1954     %stl(t1, clauses)
   1955     %car(a0, t0)
   1956     %ldl(a1, env)
   1957     %call(&eval)
   1958     %stl(a0, subject)
   1959 
   1960     :.loop
   1961         %ldl(t0, clauses)
   1962         %if_nil(t1, t0, &.no_match)
   1963 
   1964         %car(t1, t0)                  ; clause
   1965         %car(t2, t1)                  ; head: datum-list or `else`
   1966 
   1967         %ld_global(a3, &sym_else)
   1968         %beq(t2, a3, &.do_else)
   1969 
   1970         # Walk the datum list, eq?-compare each against subject.
   1971         %stl(t2, datums)
   1972         %ldl(a0, subject)
   1973         :.scan
   1974         %ldl(t0, datums)
   1975         %if_nil(t1, t0, &.next_clause)
   1976         %car(t1, t0)                  ; datum
   1977         %beq(t1, a0, &.do_body)
   1978         %cdr(t0, t0)
   1979         %stl(t0, datums)
   1980         %b(&.scan)
   1981 
   1982         :.do_body
   1983         %ldl(t0, clauses)
   1984         %car(t0, t0)
   1985         %cdr(a0, t0)                  ; body
   1986         %ldl(a1, env)
   1987         %gctail(&eval_body)
   1988 
   1989         :.do_else
   1990         %ldl(t0, clauses)
   1991         %car(t0, t0)
   1992         %cdr(a0, t0)                  ; body
   1993         %ldl(a1, env)
   1994         %gctail(&eval_body)
   1995 
   1996         :.next_clause
   1997         %ldl(t0, clauses)
   1998         %cdr(t0, t0)
   1999         %stl(t0, clauses)
   2000         %b(&.loop)
   2001 
   2002     :.no_match
   2003     %li(a0, %imm_val(%IMM.UNSPEC))
   2004 })
   2005 
   2006 # eval_pmatch(rest=a0, env=a1) -> value (a0).
   2007 # rest is (subject-expr . clauses). The subject is evaluated once; each
   2008 # clause is then tried in order against the same subject value, restarting
   2009 # from the outer env per clause. Clause shape:
   2010 #   (<pat> <body>...)
   2011 #   (<pat> (guard <g>...) <body>...)
   2012 #   (else <body>...)
   2013 # An `else` clause always matches with no bindings; a guarded clause is
   2014 # selected only if every guard expression evaluates non-#f. The matched
   2015 # clause's body is tail-evaluated via eval_body so the last form keeps
   2016 # tail position. No-match (and no else) dies via runtime_error.
   2017 #
   2018 # Locals:
   2019 #   subject
   2020 #   env_outer  (per-clause restart point)
   2021 #   clauses  (current cursor; advances on miss / failed guard)
   2022 #   env_ext  (env extended with the matched clause's bindings)
   2023 #   guard  cursor (advances during the guard AND-fold)
   2024 #   body  (saved across guard evals, tail-evaluated on success)
   2025 %gcfn2(eval_pmatch, {subject env_outer clauses env_ext guard body}, 63, 0, {
   2026     %stl(a1, env_outer)
   2027 
   2028     # subject = eval(car(rest), env_outer); clauses = cdr(rest).
   2029     %mov(t0, a0)
   2030     %cdr(t1, t0)
   2031     %stl(t1, clauses)
   2032     %car(a0, t0)
   2033     %ldl(a1, env_outer)
   2034     %call(&eval)
   2035     %stl(a0, subject)
   2036 
   2037     :.loop
   2038         %ldl(t0, clauses)
   2039         %if_nil(t1, t0, &.no_match)
   2040 
   2041         %car(t1, t0)                  ; clause
   2042         %car(t2, t1)                  ; pat
   2043 
   2044         %ld_global(a3, &sym_else)
   2045         %beq(t2, a3, &.do_else)
   2046 
   2047         # pmatch_match(pat, subject, env_outer) -> (a0=env_ext, a1=ok)
   2048         %mov(a0, t2)
   2049         %ldl(a1, subject)
   2050         %ldl(a2, env_outer)
   2051         %call(&pmatch_match)
   2052         %beqz(a1, &.next)
   2053 
   2054         %stl(a0, env_ext)               ; env_ext
   2055 
   2056         # tail = cdr(clause)
   2057         %ldl(t0, clauses)
   2058         %car(t0, t0)
   2059         %cdr(t0, t0)                  ; tail = (body...) or ((guard ...) body...)
   2060 
   2061         # Guard form? tail is a pair, car(tail) is a pair, head of car(tail)
   2062         # eq? sym_guard.
   2063         %tagof(t1, t0)
   2064         %bine(t1, %TAG.PAIR, &.body_simple, t2)
   2065         %car(t1, t0)                  ; first form of tail
   2066         %tagof(t2, t1)
   2067         %bine(t2, %TAG.PAIR, &.body_simple, a0)
   2068         %car(a0, t1)                  ; head of first form
   2069         %ld_global(a1, &sym_guard)
   2070         %bne(a0, a1, &.body_simple)
   2071 
   2072         # Guard clause. guards = cdr(car(tail)); body = cdr(tail).
   2073         %cdr(a0, t1)
   2074         %stl(a0, guard)
   2075         %cdr(t0, t0)
   2076         %stl(t0, body)
   2077 
   2078         :.g_loop
   2079             %ldl(t0, guard)
   2080             %if_nil(t1, t0, &.body_run)
   2081 
   2082             %car(a0, t0)                  ; guard expr
   2083             %ldl(a1, env_ext)               ; env_ext
   2084             %call(&eval)
   2085             %bieq(a0, %imm_val(%IMM.FALSE), &.next, t0)
   2086 
   2087             %ldl(t0, guard)
   2088             %cdr(t0, t0)
   2089             %stl(t0, guard)
   2090             %b(&.g_loop)
   2091 
   2092         :.body_run
   2093         %ldl(a0, body)
   2094         %ldl(a1, env_ext)
   2095         %gctail(&eval_body)
   2096 
   2097         :.body_simple
   2098         # tail itself is the body (no guard wrapper). Tail-call eval_body
   2099         # with the extended env; tail position of the matched clause's body
   2100         # is preserved.
   2101         %mov(a0, t0)
   2102         %ldl(a1, env_ext)
   2103         %gctail(&eval_body)
   2104 
   2105         :.do_else
   2106         %ldl(t0, clauses)
   2107         %car(t0, t0)
   2108         %cdr(a0, t0)                  ; body
   2109         %ldl(a1, env_outer)                ; env_outer (no bindings introduced)
   2110         %gctail(&eval_body)
   2111 
   2112         :.next
   2113         %ldl(t0, clauses)
   2114         %cdr(t0, t0)
   2115         %stl(t0, clauses)
   2116         %b(&.loop)
   2117 
   2118     :.no_match
   2119     %die(msg_pmatch_no_match)
   2120 })
   2121 
   2122 # eval_do(rest=a0, env=a1) -> value (a0).
   2123 # rest = (((var init step?) ...) (test result?...) body...).
   2124 #
   2125 # Phase 1 (init): walk binding-specs in order, eval each `init` in the
   2126 # outer env, build new_env by consing (var . val) pairs onto it. A
   2127 # parallel list `pairs_head` records the binding pairs in spec order so
   2128 # the iteration can mutate them by set-cdr!. A second parallel list
   2129 # `vals_head` is preallocated (one cell per spec) to hold each iteration's
   2130 # computed step values without per-iteration cell allocation.
   2131 #
   2132 # Phase 2 (loop): eval test in new_env. Truthy -> tail-eval result body
   2133 # (UNSPEC if no result forms). Falsy -> eval each command form in
   2134 # new_env (discard), collect new step values into vals_head (parallel
   2135 # semantics: every step is evaluated against the iteration's pre-update
   2136 # bindings; specs without a step keep their current value), then walk
   2137 # pairs_head/vals_head together and set-cdr! each binding pair to its
   2138 # new value. Loop.
   2139 #
   2140 # Locals:
   2141 #   rest          original rest pointer
   2142 #   env           outer env
   2143 #   new_env       env extended with binding pairs (mutated each iter)
   2144 #   walk          generic cdr-cursor (binding-specs / commands / steps)
   2145 #   pairs_head    list of binding-pair refs in spec order
   2146 #   pairs_tail    append point during init
   2147 #   vals_head     parallel list of cells holding each iteration's step vals
   2148 #   vals_tail     append point during init
   2149 #   body          body command-forms (cddr of rest)
   2150 #   pair_walk     cdr-cursor over pairs_head during step/update
   2151 #   val_walk      cdr-cursor over vals_head during step/update
   2152 %gcfn2(eval_do, {rest env new_env walk pairs_head pairs_tail vals_head vals_tail body pair_walk val_walk}, 2047, 0, {
   2153     %stl(a0, rest)
   2154     %stl(a1, env)
   2155 
   2156     %ldl(t0, rest)
   2157     %car(t0, t0)
   2158     %stl(t0, walk)
   2159     %ldl(t0, env)
   2160     %stl(t0, new_env)
   2161     %li(t0, %imm_val(%IMM.NIL))
   2162     %stl(t0, pairs_head)
   2163     %stl(t0, pairs_tail)
   2164     %stl(t0, vals_head)
   2165     %stl(t0, vals_tail)
   2166 
   2167     :.init_loop
   2168         %ldl(t0, walk)
   2169         %if_nil(t1, t0, &.init_done)
   2170 
   2171         # spec = car(walk); init-expr = car(cdr(spec)).
   2172         %car(t1, t0)
   2173         %cdr(a0, t1)
   2174         %car(a0, a0)            ; init expression
   2175 
   2176         # val = eval(init, env)
   2177         %ldl(a1, env)
   2178         %call(&eval)
   2179 
   2180         # binding pair = cons(var, val); var = car(car(walk)).
   2181         %ldl(t0, walk)
   2182         %car(t1, t0)
   2183         %car(t2, t1)            ; var
   2184         %mov(a1, a0)
   2185         %mov(a0, t2)
   2186         %call(&cons)            ; a0 = binding pair
   2187 
   2188         # new_env = cons(pair, new_env). cons clobbers t0/t1/t2 so we don't
   2189         # spill pair into a t-reg; recover it as car(new_env) afterwards.
   2190         %ldl(a1, new_env)
   2191         %call(&cons)
   2192         %stl(a0, new_env)
   2193 
   2194         # pcell = cons(pair, NIL). pair = car(new_env), and a0 still holds
   2195         # the new_env list pointer from the cons above.
   2196         %car(a0, a0)
   2197         %li(a1, %imm_val(%IMM.NIL))
   2198         %call(&cons)
   2199 
   2200         %ldl(t0, pairs_head)
   2201         %if_nil(t1, t0, &.pairs_first)
   2202         %ldl(t0, pairs_tail)
   2203         %set_cdr(a0, t0)
   2204         %stl(a0, pairs_tail)
   2205         %b(&.vals_alloc)
   2206 
   2207         :.pairs_first
   2208         %stl(a0, pairs_head)
   2209         %stl(a0, pairs_tail)
   2210 
   2211         :.vals_alloc
   2212         # vcell = cons(NIL, NIL). Append onto vals list.
   2213         %li(a0, %imm_val(%IMM.NIL))
   2214         %li(a1, %imm_val(%IMM.NIL))
   2215         %call(&cons)
   2216 
   2217         %ldl(t0, vals_head)
   2218         %if_nil(t1, t0, &.vals_first)
   2219         %ldl(t0, vals_tail)
   2220         %set_cdr(a0, t0)
   2221         %stl(a0, vals_tail)
   2222         %b(&.init_advance)
   2223 
   2224         :.vals_first
   2225         %stl(a0, vals_head)
   2226         %stl(a0, vals_tail)
   2227 
   2228         :.init_advance
   2229         %advance_walk(walk)
   2230         %b(&.init_loop)
   2231     :.init_done
   2232 
   2233     # body = cddr(rest).
   2234     %ldl(t0, rest)
   2235     %cdr(t0, t0)
   2236     %cdr(t0, t0)
   2237     %stl(t0, body)
   2238 
   2239     :.iter_loop
   2240     # test = car(car(cdr(rest))). Eval in new_env.
   2241     %ldl(t0, rest)
   2242     %cdr(t0, t0)
   2243     %car(t0, t0)            ; (test result?...)
   2244     %car(a0, t0)            ; test
   2245     %ldl(a1, new_env)
   2246     %call(&eval)
   2247 
   2248     %bieq(a0, %imm_val(%IMM.FALSE), &.commands, t0)
   2249 
   2250     # Truthy: results = cdr(car(cdr(rest))).
   2251     %ldl(t0, rest)
   2252     %cdr(t0, t0)
   2253     %car(t0, t0)
   2254     %cdr(t0, t0)            ; results
   2255     %if_nil(t1, t0, &.no_results)
   2256     %mov(a0, t0)
   2257     %ldl(a1, new_env)
   2258     %gctail(&eval_body)
   2259 
   2260     :.no_results
   2261     %li(a0, %imm_val(%IMM.UNSPEC))
   2262     %gceret
   2263 
   2264     :.commands
   2265     %ldl(t0, body)
   2266     %stl(t0, walk)
   2267 
   2268     :.cmd_loop
   2269     %ldl(t0, walk)
   2270     %if_nil(t1, t0, &.step_phase)
   2271     %car(a0, t0)
   2272     %ldl(a1, new_env)
   2273     %call(&eval)
   2274     %advance_walk(walk)
   2275     %b(&.cmd_loop)
   2276 
   2277     :.step_phase
   2278     # Compute new step values. walk = specs, pair_walk = pairs_head,
   2279     # val_walk = vals_head. For each spec: if spec has step (cddr non-NIL),
   2280     # val = eval(step, new_env); else val = cdr(binding_pair) (current).
   2281     # Store val into car(val_walk).
   2282     %ldl(t0, rest)
   2283     %car(t0, t0)
   2284     %stl(t0, walk)
   2285     %ldl(t0, pairs_head)
   2286     %stl(t0, pair_walk)
   2287     %ldl(t0, vals_head)
   2288     %stl(t0, val_walk)
   2289 
   2290     :.step_loop
   2291     %ldl(t0, walk)
   2292     %if_nil(t1, t0, &.update_phase)
   2293 
   2294     %car(t1, t0)            ; spec
   2295     %cdr(t2, t1)
   2296     %cdr(t2, t2)            ; (step?) or NIL
   2297     %if_nil(t1, t2, &.no_step)
   2298 
   2299     %car(a0, t2)            ; step
   2300     %ldl(a1, new_env)
   2301     %call(&eval)
   2302     %b(&.store_val)
   2303 
   2304     :.no_step
   2305     %ldl(t0, pair_walk)
   2306     %car(t0, t0)            ; binding pair
   2307     %cdr(a0, t0)            ; current val
   2308 
   2309     :.store_val
   2310     %ldl(t0, val_walk)
   2311     %set_car(a0, t0)
   2312 
   2313     %advance_walk(walk)
   2314     %advance_walk(pair_walk)
   2315     %advance_walk(val_walk)
   2316     %b(&.step_loop)
   2317 
   2318     :.update_phase
   2319     # Walk pairs_head and vals_head; set-cdr!(pair, val) for each.
   2320     %ldl(t0, pairs_head)
   2321     %stl(t0, pair_walk)
   2322     %ldl(t0, vals_head)
   2323     %stl(t0, val_walk)
   2324 
   2325     :.update_loop
   2326     %ldl(t0, pair_walk)
   2327     %if_nil(t1, t0, &.iter_loop)
   2328     %car(t1, t0)            ; binding pair
   2329     %ldl(t0, val_walk)
   2330     %car(t2, t0)            ; new val
   2331     %set_cdr(t2, t1)
   2332     %advance_walk(pair_walk)
   2333     %advance_walk(val_walk)
   2334     %b(&.update_loop)
   2335 })
   2336 
   2337 # pmatch_match(pat=a0, subj=a1, env=a2) -> (env=a0, ok=a1)
   2338 #
   2339 # Walks pat and subj structurally. On success returns the (possibly
   2340 # extended) env in a0 and 1 in a1; on failure returns 0 in a1 (a0 is
   2341 # undefined and callers must not use it). Pattern shapes:
   2342 #
   2343 #   - pair (car eq? sym_unquote): binder `,ident` or wildcard `,_`. The
   2344 #     pattern must be exactly (unquote <sym>) — any other shape dies
   2345 #     with msg_bad_unquote_pattern (the only carve-out from the spec's
   2346 #     primitive-failure UB policy, since pattern shape is a syntax
   2347 #     error in the user's source).
   2348 #   - pair (car eq? sym_dollar): record pattern `($ pred (f1 p1) ...)`.
   2349 #     Looks up `pred` in the current env; expects a record predicate
   2350 #     PRIM (the one bound by define-record-type). The TD pulled from
   2351 #     PRIM.data drives the type check on subj and the field-name -> idx
   2352 #     lookup. Each clause matches recursively. Listed fields only;
   2353 #     missing fields are unconstrained. Malformed pattern shape, an
   2354 #     unknown field name, a non-record subject, or a TD mismatch fall
   2355 #     through as ::no.
   2356 #   - pair (otherwise): subj must be a pair; recurse on car, then cdr.
   2357 #   - atomic (fixnum, sym, immediate, identical heap pointer): raw
   2358 #     word equality.
   2359 #   - HEAP-tagged HDR.BV: structural byte-for-byte equality via
   2360 #     bv_equal_check; only when both pat and subj are HDR.BV.
   2361 #
   2362 # Locals:
   2363 #   pat
   2364 #   subj
   2365 #   env
   2366 #   td   (record-pattern: TD pulled from the predicate PRIM)
   2367 #   flw  (record-pattern: cursor over remaining (fname pat) clauses)
   2368 %gcfn2(pmatch_match, {pat subj env td flw}, 31, 0, {
   2369     %stl(a0, pat)
   2370     %stl(a1, subj)
   2371     %stl(a2, env)
   2372 
   2373     %tagof(t0, a0)
   2374     %li(t1, %TAG.PAIR)
   2375     %beq(t0, t1, &.pair_pat)
   2376 
   2377     # Atomic pattern. Identity covers fixnum / symbol / immediate / same
   2378     # heap pointer.
   2379     %beq(a0, a1, &.ok)
   2380 
   2381     # HDR.BV equality.
   2382     %bine(t0, %TAG.HEAP, &.no, t1)
   2383     %hdr_type(t1, a0)
   2384     %bine(t1, %HDR.BV,   &.no, t2)
   2385     %tagof(t1, a1)
   2386     %bine(t1, %TAG.HEAP, &.no, t2)
   2387     %hdr_type(t1, a1)
   2388     %bine(t1, %HDR.BV,   &.no, t2)
   2389     %call(&bv_equal_check)
   2390     %bieq(a0, %imm_val(%IMM.TRUE), &.ok, t0)
   2391     %b(&.no)
   2392 
   2393     :.pair_pat
   2394     %car(t0, a0)                   ; phead
   2395     %ld_global(t1, &sym_unquote)
   2396     %beq(t0, t1, &.binder)
   2397     %ld_global(t1, &sym_dollar)
   2398     %beq(t0, t1, &.record_pat)
   2399 
   2400     # Structural pair. subj must be a pair too.
   2401     %tagof(t0, a1)
   2402     %bine(t0, %TAG.PAIR, &.no, t1)
   2403 
   2404     # Recurse on the cars; on success, recurse on the cdrs as a tail call.
   2405     %ldl(t0, pat)
   2406     %car(a0, t0)
   2407     %ldl(t0, subj)
   2408     %car(a1, t0)
   2409     %ldl(a2, env)
   2410     %call(&pmatch_match)
   2411     %beqz(a1, &.no)
   2412 
   2413     %mov(a2, a0)                  ; env_after_car
   2414     %ldl(t0, pat)
   2415     %cdr(a0, t0)
   2416     %ldl(t0, subj)
   2417     %cdr(a1, t0)
   2418     %gctail(&pmatch_match)
   2419 
   2420     :.binder
   2421     # Validate (unquote <sym>): cdr(pat) is a pair, cdr(cdr(pat)) is NIL,
   2422     # car(cdr(pat)) is a symbol.
   2423     %ldl(t0, pat)
   2424     %cdr(t1, t0)                  ; cdr(pat)
   2425     %tagof(t0, t1)
   2426     %bine(t0, %TAG.PAIR,           &.bad, t2)
   2427     %cdr(t0, t1)                  ; cdr(cdr(pat))
   2428     %bine(t0, %imm_val(%IMM.NIL), &.bad, t2)
   2429     %car(t0, t1)                  ; pident (kept in t0)
   2430     %tagof(t2, t0)
   2431     %bine(t2, %TAG.SYM,           &.bad, a3)
   2432 
   2433     # Wildcard? Compare against sym_underscore; if so, no binding.
   2434     %ld_global(t1, &sym_underscore)
   2435     %beq(t0, t1, &.ok)
   2436 
   2437     # Bind: env' = cons(cons(pident, subj), env). pident lives in t0;
   2438     # cons clobbers t0..t2, so move it into a0 right away.
   2439     %mov(a0, t0)
   2440     %ldl(a1, subj)
   2441     %call(&cons)
   2442     %ldl(a1, env)
   2443     %call(&cons)
   2444     %li(a1, 1)
   2445     %gceret
   2446 
   2447     :.record_pat
   2448     # pat = ($ pred-sym (f1 p1) (f2 p2) ...). Resolve pred-sym -> PRIM via
   2449     # eval, pull TD from PRIM.data, type-check subj, then iterate the
   2450     # (fname pat_i) clauses. Clobbers `pat` local once we begin the loop:
   2451     # we stash each pat_i there before recursing so the recursion has the
   2452     # right argument and the local stays usable as scratch.
   2453     %ldl(t0, pat)
   2454     %cdr(t1, t0)                  ; (pred-sym . clauses)
   2455     %tagof(t0, t1)
   2456     %bine(t0, %TAG.PAIR, &.no, t2)
   2457     %car(t0, t1)                  ; t0 = pred-sym
   2458     %tagof(t2, t0)
   2459     %bine(t2, %TAG.SYM,  &.no, a3)
   2460     %cdr(t2, t1)                  ; t2 = clauses
   2461     %stl(t2, flw)
   2462 
   2463     # eval(pred-sym, env) -> a0 = pred PRIM (or dies "unbound").
   2464     %mov(a0, t0)
   2465     %ldl(a1, env)
   2466     %call(&eval)
   2467 
   2468     # Verify HEAP / HDR.PRIM, entry == &prim_predicate_entry; extract TD
   2469     # from PRIM.data; sanity-check TD is HEAP / HDR.TD.
   2470     %tagof(t0, a0)
   2471     %bine(t0, %TAG.HEAP, &.no, t1)
   2472     %hdr_type(t0, a0)
   2473     %bine(t0, %HDR.PRIM, &.no, t1)
   2474     %heap_ld(t1, a0, %PRIM.entry_w)
   2475     %la(t2, &prim_predicate_entry)
   2476     %bne(t1, t2, &.no)
   2477     %heap_ld(t1, a0, %PRIM.data)  ; t1 = TD
   2478     %tagof(t0, t1)
   2479     %li(t2, %TAG.HEAP)
   2480     %bne(t0, t2, &.no)
   2481     %hdr_type(t0, t1)
   2482     %li(t2, %HDR.TD)
   2483     %bne(t0, t2, &.no)
   2484     %stl(t1, td)
   2485 
   2486     # Verify subj is HDR.REC with REC.td == TD.
   2487     %ldl(a0, subj)
   2488     %tagof(t0, a0)
   2489     %li(t1, %TAG.HEAP)
   2490     %bne(t0, t1, &.no)
   2491     %hdr_type(t0, a0)
   2492     %li(t1, %HDR.REC)
   2493     %bne(t0, t1, &.no)
   2494     %heap_ld(t0, a0, %REC.td)
   2495     %ldl(t1, td)
   2496     %bne(t0, t1, &.no)
   2497 
   2498     :.record_field_loop
   2499     # flw points at remaining (fname pat_i) clauses; NIL ends the loop.
   2500     %ldl(t0, flw)
   2501     %if_nil(t1, t0, &.ok)
   2502     %car(t1, t0)                  ; t1 = clause
   2503     %tagof(t0, t1)
   2504     %bine(t0, %TAG.PAIR, &.no, t2)
   2505     %car(t2, t1)                  ; t2 = fname
   2506     %cdr(t1, t1)                  ; t1 = (pat_i)
   2507     %tagof(t0, t1)
   2508     %bine(t0, %TAG.PAIR, &.no, a3)
   2509     %car(a3, t1)                  ; a3 = pat_i
   2510     %stl(a3, pat)                 ; reuse `pat` local for pat_i across recursion
   2511 
   2512     # Linear scan of TD.fields for fname; idx accumulated in t1. t2 holds
   2513     # fname (still live); a3 is scratch (since we no longer need pat_i in
   2514     # a register — it's in the local).
   2515     %ldl(t0, td)
   2516     %heap_ld(t0, t0, %TD.fields)
   2517     %li(t1, 0)
   2518     :.record_field_idx_loop
   2519     %if_nil(a3, t0, &.no)
   2520     %car(a3, t0)
   2521     %beq(a3, t2, &.record_field_found)
   2522     %cdr(t0, t0)
   2523     %addi(t1, t1, 1)
   2524     %b(&.record_field_idx_loop)
   2525 
   2526     :.record_field_found
   2527     # val = ld(subj_tagged + (idx<<3) + 13). Same offset arithmetic as
   2528     # prim_accessor_entry. Compute the address into a1 directly so the
   2529     # recursive call's val arg is in place.
   2530     %ldl(a1, subj)
   2531     %shli(t1, t1, 3)
   2532     %add(a1, a1, t1)
   2533     %ld(a1, a1, 13)
   2534 
   2535     # Recurse: pmatch_match(pat_i, val, env). pat_i is in `pat` local.
   2536     %ldl(a0, pat)
   2537     %ldl(a2, env)
   2538     %call(&pmatch_match)
   2539     %beqz(a1, &.no)
   2540     %stl(a0, env)
   2541 
   2542     %ldl(t0, flw)
   2543     %cdr(t0, t0)
   2544     %stl(t0, flw)
   2545     %b(&.record_field_loop)
   2546 
   2547     :.ok
   2548     %ldl(a0, env)
   2549     %li(a1, 1)
   2550     %gceret
   2551 
   2552     :.no
   2553     %li(a1, 0)
   2554     %gceret
   2555 
   2556     :.bad
   2557     %die(msg_bad_unquote_pattern)
   2558 })
   2559 
   2560 # eval_let_named(rest=a0, env=a1) -> value (a0).
   2561 # rest = (name bindings . body). Builds a closure whose captured env
   2562 # contains a self-binding that resolves `name` to the closure itself
   2563 # (set after the closure is allocated, via set-cdr! on the placeholder
   2564 # pair). Inits are evaluated in the *original* env (matches let
   2565 # semantics), then we apply the closure.
   2566 #
   2567 # Locals:
   2568 #   rest
   2569 #   env_orig
   2570 #   self_binding  (the (name . UNSPEC) placeholder, patched at the end)
   2571 #   self_env  (cons(self_binding, env_orig))
   2572 #   walk  (advances; reset between passes)
   2573 #   head  (current pass's list head — params, then args)
   2574 #   tail  (current pass's list tail)
   2575 #   params  (saved between passes)
   2576 %gcfn2(eval_let_named, {rest env_orig self_binding self_env walk head tail params}, 255, 0, {
   2577     %stl(a0, rest)
   2578     %stl(a1, env_orig)
   2579 
   2580     # 1. self_binding = (name . UNSPEC); self_env = cons(self_binding, env)
   2581     %car(t0, a0)
   2582     %mov(a0, t0)
   2583     %li(a1, %imm_val(%IMM.UNSPEC))
   2584     %call(&cons)
   2585     %stl(a0, self_binding)
   2586     %ldl(a1, env_orig)
   2587     %call(&cons)
   2588     %stl(a0, self_env)
   2589 
   2590     # 2. Pass 1: build params list (cdr-tail trick) by walking bindings.
   2591     %li(t0, %imm_val(%IMM.NIL))
   2592     %stl(t0, head)
   2593     %stl(t0, tail)
   2594     %ldl(t0, rest)
   2595     %cdr(t0, t0)
   2596     %car(t0, t0)            ; bindings
   2597     %stl(t0, walk)
   2598 
   2599     :.p1_loop
   2600     %ldl(t0, walk)
   2601     %if_nil(t1, t0, &.p1_done)
   2602 
   2603     %car(t1, t0)
   2604     %car(t2, t1)            ; name
   2605     %mov(a0, t2)
   2606     %li(a1, %imm_val(%IMM.NIL))
   2607     %call(&cons)            ; cell = (name . NIL)
   2608 
   2609     %ldl(t0, head)
   2610     %if_nil(t1, t0, &.p1_first)
   2611     %ldl(t0, tail)
   2612     %set_cdr(a0, t0)
   2613     %stl(a0, tail)
   2614     %b(&.p1_advance)
   2615 
   2616     :.p1_first
   2617     %stl(a0, head)
   2618     %stl(a0, tail)
   2619 
   2620     :.p1_advance
   2621     %advance_walk(walk)
   2622     %b(&.p1_loop)
   2623 
   2624     :.p1_done
   2625     %ldl(t0, head)
   2626     %stl(t0, params)         ; save params
   2627 
   2628     # 3. Pass 2: build args list (eval inits in env_orig).
   2629     %li(t0, %imm_val(%IMM.NIL))
   2630     %stl(t0, head)
   2631     %stl(t0, tail)
   2632     %ldl(t0, rest)
   2633     %cdr(t0, t0)
   2634     %car(t0, t0)
   2635     %stl(t0, walk)
   2636 
   2637     :.p2_loop
   2638     %ldl(t0, walk)
   2639     %if_nil(t1, t0, &.p2_done)
   2640 
   2641     %car(t1, t0)
   2642     %cdr(t2, t1)
   2643     %car(t2, t2)            ; init
   2644     %mov(a0, t2)
   2645     %ldl(a1, env_orig)
   2646     %call(&eval)            ; val
   2647 
   2648     %li(a1, %imm_val(%IMM.NIL))
   2649     %call(&cons)            ; cell = (val . NIL)
   2650 
   2651     %ldl(t0, head)
   2652     %if_nil(t1, t0, &.p2_first)
   2653     %ldl(t0, tail)
   2654     %set_cdr(a0, t0)
   2655     %stl(a0, tail)
   2656     %b(&.p2_advance)
   2657 
   2658     :.p2_first
   2659     %stl(a0, head)
   2660     %stl(a0, tail)
   2661 
   2662     :.p2_advance
   2663     %advance_walk(walk)
   2664     %b(&.p2_loop)
   2665 
   2666     :.p2_done
   2667     # 4. Closure: eval_lambda((params . body), self_env).
   2668     %ldl(a0, params)         ; params
   2669     %ldl(t0, rest)
   2670     %cdr(t0, t0)
   2671     %cdr(a1, t0)            ; body
   2672     %call(&cons)
   2673     %ldl(a1, self_env)
   2674     %call(&eval_lambda)
   2675 
   2676     # 5. Patch self_binding cdr to closure.
   2677     %ldl(t0, self_binding)
   2678     %set_cdr(a0, t0)
   2679 
   2680     # 6. apply(closure, args).
   2681     %ldl(a1, head)
   2682     %gctail(&apply)
   2683 })
   2684 
   2685 # bind_params(params=a0, args=a1, env=a2) -> extended env (a0).
   2686 # Walks params and args in lockstep, prepending (param . arg) to env.
   2687 # Variadic `.`-tail: when params terminates with a SYM (rather than NIL),
   2688 # bind it to the remaining args list and stop.
   2689 #
   2690 # Locals:
   2691 #   params  (advanced each iteration)
   2692 #   args  (advanced each iteration)
   2693 #   env  (extended each iteration)
   2694 %gcfn2(bind_params, {params args env}, 7, 0, {
   2695     %stl(a0, params)
   2696     %stl(a1, args)
   2697     %stl(a2, env)
   2698 
   2699     :.loop
   2700         %ldl(t0, params)
   2701         %tagof(t1, t0)
   2702         %li(t2, %TAG.PAIR)
   2703         %beq(t1, t2, &.pair)
   2704         %li(t2, %TAG.SYM)
   2705         %beq(t1, t2, &.rest_bind)
   2706         %b(&.done)
   2707 
   2708         :.pair
   2709         # binding = cons(car(params), car(args))
   2710         %ldl(t0, params)
   2711         %car(a0, t0)
   2712         %ldl(t0, args)
   2713         %car(a1, t0)
   2714         %call(&cons)
   2715 
   2716         # env = cons(binding, env)
   2717         %ldl(a1, env)
   2718         %call(&cons)
   2719         %stl(a0, env)
   2720 
   2721         # advance params and args
   2722         %advance_walk(params)
   2723         %advance_walk(args)
   2724         %b(&.loop)
   2725 
   2726     :.rest_bind
   2727     # binding = cons(params_sym, args_list); env = cons(binding, env)
   2728     %ldl(a0, params)
   2729     %ldl(a1, args)
   2730     %call(&cons)
   2731     %ldl(a1, env)
   2732     %call(&cons)
   2733     %stl(a0, env)
   2734 
   2735     :.done
   2736     %ldl(a0, env)
   2737 })
   2738 
   2739 # eval_body(body=a0, env=a1) -> value of last form (a0).
   2740 # Evaluates each non-last form for effect; tail-evaluates the last so
   2741 # that closures used in tail position do not grow the host stack.
   2742 #
   2743 # Internal `define` is rejected here (this is the single chokepoint for
   2744 # every body context: closure body via apply, let / letrec / named-let
   2745 # bodies, cond clause bodies, begin's body). Per-form check is one
   2746 # tagof + one symbol compare, regardless of body length.
   2747 #
   2748 # Locals:
   2749 #   body
   2750 #   env
   2751 %gcfn2(eval_body, {body env}, 3, 0, {
   2752     :.loop
   2753     %stl(a0, body)
   2754     %stl(a1, env)
   2755 
   2756     # Reject internal `define`. Detect (define ...) at the head of any
   2757     # form before dispatching to eval; top-level-only.
   2758     %car(t0, a0)              ; form
   2759     %tagof(t1, t0)
   2760     %li(t2, %TAG.PAIR)
   2761     %bne(t1, t2, &.not_define)
   2762     %car(t1, t0)              ; head sym
   2763     %ld_global(t2, &sym_define)
   2764     %beq(t1, t2, &.internal_define)
   2765 
   2766     :.not_define
   2767     # If cdr(body) is NIL, body's car is the last form.
   2768     %ldl(a0, body)
   2769     %cdr(t0, a0)
   2770     %if_nil(t1, t0, &.last)
   2771 
   2772     # Non-last form: eval and discard, advance.
   2773     %car(a0, a0)
   2774     %ldl(a1, env)
   2775     %call(&eval)
   2776     %ldl(a0, body)
   2777     %cdr(a0, a0)
   2778     %ldl(a1, env)
   2779     %b(&.loop)
   2780 
   2781     :.last
   2782     %ldl(a0, body)
   2783     %car(a0, a0)
   2784     %ldl(a1, env)
   2785     %gctail(&eval)
   2786 
   2787     :.internal_define
   2788     %die(msg_internal_define)
   2789 })
   2790 
   2791 # =========================================================================
   2792 # Runtime error -- single abort entry point
   2793 # =========================================================================
   2794 #
   2795 # runtime_error(msg_cstr=a0) -> never returns. Every overflow / bounds /
   2796 # unbound / type-failure path lands here so error reporting (and the
   2797 # eventual user-facing `error` primitive) only have to be implemented
   2798 # once. Today we tail into libp1pp's `panic`, which writes msg + LF to
   2799 # stderr and sys_exits 1.
   2800 :runtime_error
   2801     %tail(&panic)
   2802 
   2803 # =========================================================================
   2804 # Source loading -- argv[1] -> readbuf, length stored in readbuf_len
   2805 # =========================================================================
   2806 
   2807 %fn(load_source, 0, {
   2808     %ld_global(a1, &readbuf_buf_ptr)
   2809     %li(a2, %READBUF_CAP_BYTES)
   2810     %call(&read_file)
   2811     %bltz(a0, &.fail)
   2812 
   2813     # If the read filled (or would have filled) the buffer, the source
   2814     # is at least cap bytes; refuse rather than silently truncate.
   2815     # read_file does a single sys_read so n == cap is the only saturation
   2816     # signal we have. We treat n >= cap as overflow defensively.
   2817     %li(t0, %READBUF_CAP_BYTES)
   2818     %bltu(a0, t0, &.ok)
   2819     %die(msg_readbuf_full)
   2820 
   2821     :.ok
   2822     %st_global(a0, &readbuf_len, t0)
   2823     %li(a0, 0)
   2824     %st_global(a0, &readbuf_pos, t0)
   2825     %eret
   2826 
   2827     :.fail
   2828     %die(msg_load_fail)
   2829 })
   2830 
   2831 # =========================================================================
   2832 # Mark-and-sweep collector
   2833 # =========================================================================
   2834 #
   2835 # Marking never allocates.  A marked allocation header is linked through
   2836 # word 1 onto gc_mark_worklist.  Only exact shadow-frame slots and explicit
   2837 # symbol-table roots seed the traversal.
   2838 
   2839 # gc_mark_payload(raw_payload=a0, expected_kind=a1).  Invalid, interior,
   2840 # free, or already-marked addresses are ignored.
   2841 :gc_mark_payload
   2842 .scope
   2843     %beqz(a0, &.done)
   2844     %andi(t2, a0, 7)
   2845     %bnez(t2, &.done)
   2846     %ld_global(t0, &heap_base)
   2847     %addi(t0, t0, %GC_HEADER_BYTES)
   2848     %bltu(a0, t0, &.done)
   2849     %ld_global(t1, &heap_tail)
   2850     %bltu(a0, t1, &.in_heap)
   2851     # A zero-length RAW allocation has its payload exactly at heap_tail;
   2852     # its 16-byte header is still a real managed block.
   2853     %beq(a0, t1, &.in_heap)
   2854     %b(&.done)
   2855     :.in_heap
   2856     %addi(t0, a0, (- %GC_HEADER_BYTES))
   2857     %ld(t1, t0, 0)
   2858     %andi(t2, t1, %GC_KIND_MASK)
   2859     %bne(t2, a1, &.done)
   2860     # Validate the candidate header before putting it on the worklist.
   2861     # Exact roots should always name object starts; these checks reject
   2862     # malformed, truncated, and implausible interior candidates safely.
   2863     %shri(a2, t1, 8)
   2864     %li(a3, %GC_HEADER_BYTES)
   2865     %bltu(a2, a3, &.done)
   2866     %andi(a3, a2, 7)
   2867     %bnez(a3, &.done)
   2868     %add(a3, t0, a2)
   2869     %ld_global(t2, &heap_tail)
   2870     %bltu(t2, a3, &.done)
   2871     %andi(t2, t1, %GC_MARK_BIT)
   2872     %bnez(t2, &.done)
   2873     # An unmarked allocated block keeps its own header address in the
   2874     # intrusive word. This canary distinguishes a real object start from
   2875     # an aligned interior word without a quadratic physical-chain walk.
   2876     %ld(t2, t0, 8)
   2877     %bne(t2, t0, &.done)
   2878     %ori(t1, t1, %GC_MARK_BIT)
   2879     %st(t1, t0, 0)
   2880     %ld_global(t1, &gc_mark_worklist)
   2881     %st(t1, t0, 8)
   2882     %st_global(t0, &gc_mark_worklist, t1)
   2883     :.done
   2884     %ret
   2885 .endscope
   2886 
   2887 # gc_mark_scheme(value=a0).  Tags select the exact managed allocation
   2888 # kind; fixnums, symbols, and immediates are not heap roots.
   2889 :gc_mark_scheme
   2890 .scope
   2891     %tagof(t0, a0)
   2892     %li(t1, %TAG.PAIR)
   2893     %beq(t0, t1, &.pair)
   2894     %li(t1, %TAG.HEAP)
   2895     %beq(t0, t1, &.heap)
   2896     %ret
   2897     :.pair
   2898     %addi(a0, a0, (- %TAG.PAIR))
   2899     %li(a1, %GCKIND.PAIR)
   2900     %b(&gc_mark_payload)
   2901     :.heap
   2902     %addi(a0, a0, (- %TAG.HEAP))
   2903     %li(a1, %GCKIND.HEAP)
   2904     %b(&gc_mark_payload)
   2905 .endscope
   2906 
   2907 :gc_mark_raw
   2908     %li(a1, %GCKIND.RAW)
   2909     %b(&gc_mark_payload)
   2910 
   2911 # Mark all described native-frame slots.
   2912 %fn2(gc_mark_shadow_roots, {frame end native scheme_mask raw_mask slot}, {
   2913     %ld_global(t0, &gc_root_buf_ptr)
   2914     %stl(t0, frame)
   2915     %ld_global(t0, &gc_root_next)
   2916     %stl(t0, end)
   2917     :.frame_loop
   2918     %ldl(t0, frame)
   2919     %ldl(t1, end)
   2920     %beq(t0, t1, &.done)
   2921     %ld(t1, t0, 0)
   2922     %stl(t1, native)
   2923     %stl(t1, slot)
   2924     %ld(t1, t0, 8)
   2925     %stl(t1, scheme_mask)
   2926     %ld(t1, t0, 16)
   2927     %stl(t1, raw_mask)
   2928     :.slot_loop
   2929     %ldl(t0, scheme_mask)
   2930     %ldl(t1, raw_mask)
   2931     %or(t2, t0, t1)
   2932     %beqz(t2, &.next_frame)
   2933     %andi(t2, t0, 1)
   2934     %beqz(t2, &.maybe_raw)
   2935     %ldl(t2, slot)
   2936     %ld(a0, t2, 0)
   2937     %call(&gc_mark_scheme)
   2938     :.maybe_raw
   2939     %ldl(t0, raw_mask)
   2940     %andi(t1, t0, 1)
   2941     %beqz(t1, &.advance_slot)
   2942     %ldl(t1, slot)
   2943     %ld(a0, t1, 0)
   2944     %call(&gc_mark_raw)
   2945     :.advance_slot
   2946     %ldl(t0, scheme_mask)
   2947     %shri(t0, t0, 1)
   2948     %stl(t0, scheme_mask)
   2949     %ldl(t0, raw_mask)
   2950     %shri(t0, t0, 1)
   2951     %stl(t0, raw_mask)
   2952     %ldl(t0, slot)
   2953     %addi(t0, t0, 8)
   2954     %stl(t0, slot)
   2955     %b(&.slot_loop)
   2956     :.next_frame
   2957     %ldl(t0, frame)
   2958     %addi(t0, t0, %GC_ROOT_FRAME_BYTES)
   2959     %stl(t0, frame)
   2960     %b(&.frame_loop)
   2961     :.done
   2962 })
   2963 
   2964 # Symbol entries are permanent roots: the stable RAW name buffers and
   2965 # every Scheme value installed in a global binding.
   2966 %fn2(gc_mark_symbol_roots, {idx count entry}, {
   2967     %li(t0, 0)
   2968     %stl(t0, idx)
   2969     %ld_global(t0, &symtab_count)
   2970     %stl(t0, count)
   2971     :.loop
   2972     %ldl(t0, idx)
   2973     %ldl(t1, count)
   2974     %beq(t0, t1, &.done)
   2975     %symtab_entry(t1, t0, t2)
   2976     %stl(t1, entry)
   2977     %ld(a0, t1, %SYMENT.name_ptr)
   2978     %call(&gc_mark_raw)
   2979     %ldl(t1, entry)
   2980     %ld(a0, t1, %SYMENT.global_val)
   2981     %call(&gc_mark_scheme)
   2982     %ldl(t0, idx)
   2983     %addi(t0, t0, 1)
   2984     %stl(t0, idx)
   2985     %b(&.loop)
   2986     :.done
   2987 })
   2988 
   2989 # Trace one marked allocation header.  The header remains marked while it
   2990 # is off the worklist, so cycles terminate naturally.
   2991 %fn2(gc_trace_header, {header payload object_hdr count cursor td}, {
   2992     %stl(a0, header)
   2993     %addi(t0, a0, %GC_HEADER_BYTES)
   2994     %stl(t0, payload)
   2995     %ld(t1, a0, 0)
   2996     %andi(t1, t1, %GC_KIND_MASK)
   2997     %li(t2, %GCKIND.PAIR)
   2998     %beq(t1, t2, &.pair)
   2999     %li(t2, %GCKIND.HEAP)
   3000     %beq(t1, t2, &.heap)
   3001     %eret                         ; RAW has no outgoing references
   3002 
   3003     :.pair
   3004     %ld(a0, t0, %PAIR.car)
   3005     %call(&gc_mark_scheme)
   3006     %ldl(t0, payload)
   3007     %ld(a0, t0, %PAIR.cdr)
   3008     %tail(&gc_mark_scheme)
   3009 
   3010     :.heap
   3011     %ld(t1, t0, 0)
   3012     %stl(t1, object_hdr)
   3013     %andi(t1, t1, 255)
   3014     %li(t2, %HDR.BV)
   3015     %beq(t1, t2, &.bv)
   3016     %li(t2, %HDR.CLOSURE)
   3017     %beq(t1, t2, &.closure)
   3018     %li(t2, %HDR.PRIM)
   3019     %beq(t1, t2, &.prim)
   3020     %li(t2, %HDR.TD)
   3021     %beq(t1, t2, &.td)
   3022     %li(t2, %HDR.REC)
   3023     %beq(t1, t2, &.record)
   3024     %li(t2, %HDR.MV)
   3025     %beq(t1, t2, &.mv)
   3026     %eret
   3027 
   3028     :.bv
   3029     %ld(a0, t0, %BV.data)
   3030     %tail(&gc_mark_raw)
   3031 
   3032     :.closure
   3033     %ld(a0, t0, %CLOSURE.params)
   3034     %call(&gc_mark_scheme)
   3035     %ldl(t0, payload)
   3036     %ld(a0, t0, %CLOSURE.body)
   3037     %call(&gc_mark_scheme)
   3038     %ldl(t0, payload)
   3039     %ld(a0, t0, %CLOSURE.env)
   3040     %tail(&gc_mark_scheme)
   3041 
   3042     :.prim
   3043     # Plain primitives contain zero in data; parameterized primitives
   3044     # contain their TD or tagged field index.
   3045     %ld(a0, t0, %PRIM.data)
   3046     %tail(&gc_mark_scheme)
   3047 
   3048     :.td
   3049     %ld(a0, t0, %TD.fields)
   3050     %tail(&gc_mark_scheme)
   3051 
   3052     :.record
   3053     %ld(t1, t0, %REC.td)
   3054     %stl(t1, td)
   3055     %mov(a0, t1)
   3056     %call(&gc_mark_scheme)
   3057     # A freshly published record may still have its cleared TD slot while
   3058     # its constructor is filling fields. In that state it has no outgoing
   3059     # references yet and is safe to revisit after construction.
   3060     %ldl(t0, td)
   3061     %tagof(t1, t0)
   3062     %li(t2, %TAG.HEAP)
   3063     %bne(t1, t2, &.done)
   3064     %hdr_type(t1, t0)
   3065     %li(t2, %HDR.TD)
   3066     %bne(t1, t2, &.done)
   3067     %heap_ld(t1, t0, %TD.nfields)
   3068     %stl(t1, count)
   3069     %ldl(t0, payload)
   3070     %addi(t0, t0, 16)
   3071     %stl(t0, cursor)
   3072     %b(&.slots)
   3073 
   3074     :.mv
   3075     %ldl(t0, object_hdr)
   3076     %shri(t0, t0, 8)
   3077     %stl(t0, count)
   3078     %ldl(t0, payload)
   3079     %addi(t0, t0, 8)
   3080     %stl(t0, cursor)
   3081 
   3082     :.slots
   3083     %ldl(t0, count)
   3084     %beqz(t0, &.done)
   3085     %ldl(t1, cursor)
   3086     %ld(a0, t1, 0)
   3087     %call(&gc_mark_scheme)
   3088     %ldl(t0, cursor)
   3089     %addi(t0, t0, 8)
   3090     %stl(t0, cursor)
   3091     %ldl(t0, count)
   3092     %addi(t0, t0, -1)
   3093     %stl(t0, count)
   3094     %b(&.slots)
   3095     :.done
   3096 })
   3097 
   3098 # Sweep the physical block chain, rebuild an address-ordered free list,
   3099 # coalesce adjacent garbage, clear survivor marks, and return a trailing
   3100 # free run to the unused tail.
   3101 %fn2(gc_sweep, {cursor end free_head list_last list_prev run_free allocated size}, {
   3102     %ld_global(t0, &heap_base)
   3103     %stl(t0, cursor)
   3104     %ld_global(t0, &heap_tail)
   3105     %stl(t0, end)
   3106     %li(t0, 0)
   3107     %stl(t0, free_head)
   3108     %stl(t0, list_last)
   3109     %stl(t0, list_prev)
   3110     %stl(t0, run_free)
   3111     %stl(t0, allocated)
   3112     :.loop
   3113     %ldl(t0, cursor)
   3114     %ldl(t1, end)
   3115     %beq(t0, t1, &.finish)
   3116     %ld(t1, t0, 0)
   3117     %shri(t2, t1, 8)
   3118     %li(a0, %GC_HEADER_BYTES)
   3119     %bltu(t2, a0, &.corrupt)
   3120     %andi(a0, t2, 7)
   3121     %bnez(a0, &.corrupt)
   3122     %add(a0, t0, t2)
   3123     %ldl(a1, end)
   3124     %bltu(a1, a0, &.corrupt)
   3125     %stl(t2, size)
   3126     %andi(a0, t1, %GC_KIND_MASK)
   3127     %beqz(a0, &.garbage)
   3128     %andi(a0, t1, %GC_MARK_BIT)
   3129     %beqz(a0, &.garbage)
   3130 
   3131     # Survivor: clear mark and break any adjacent-free run.
   3132     %li(a0, -129)
   3133     %and(t1, t1, a0)
   3134     %st(t1, t0, 0)
   3135     %st(t0, t0, 8)             ; restore allocated-block start canary
   3136     %ldl(a0, allocated)
   3137     %add(a0, a0, t2)
   3138     %stl(a0, allocated)
   3139     %li(a0, 0)
   3140     %stl(a0, run_free)
   3141     %b(&.advance)
   3142 
   3143     :.garbage
   3144     %ldl(a0, run_free)
   3145     %beqz(a0, &.new_run)
   3146     # Extend the preceding physical free run.
   3147     # Invalidate the absorbed block's old header so a stale exact slot
   3148     # cannot mistake this interior address for an allocated object start.
   3149     %li(a1, 0)
   3150     %st(a1, t0, 0)
   3151     %st(a1, t0, 8)
   3152     %ld(a1, a0, 0)
   3153     %shri(a1, a1, 8)
   3154     %add(a1, a1, t2)
   3155     %shli(a1, a1, 8)
   3156     %st(a1, a0, 0)
   3157     %b(&.advance)
   3158 
   3159     :.new_run
   3160     %shli(t1, t2, 8)          ; FREE kind, mark clear
   3161     %st(t1, t0, 0)
   3162     %li(t1, 0)
   3163     %st(t1, t0, 8)
   3164     %ldl(t1, list_last)
   3165     %stl(t1, list_prev)
   3166     %beqz(t1, &.first_free)
   3167     %st(t0, t1, 8)
   3168     %b(&.linked)
   3169     :.first_free
   3170     %stl(t0, free_head)
   3171     :.linked
   3172     %stl(t0, list_last)
   3173     %stl(t0, run_free)
   3174 
   3175     :.advance
   3176     %ldl(t0, cursor)
   3177     %ldl(t1, size)
   3178     %add(t0, t0, t1)
   3179     %stl(t0, cursor)
   3180     %b(&.loop)
   3181 
   3182     :.finish
   3183     # A final free run is outside the physical chain after trimming.
   3184     %ldl(t0, run_free)
   3185     %beqz(t0, &.publish)
   3186     %st_global(t0, &heap_tail, t1)
   3187     %ldl(t1, list_prev)
   3188     %beqz(t1, &.trim_only)
   3189     %li(t2, 0)
   3190     %st(t2, t1, 8)
   3191     %b(&.publish)
   3192     :.trim_only
   3193     %li(t1, 0)
   3194     %stl(t1, free_head)
   3195 
   3196     :.publish
   3197     %ldl(t0, free_head)
   3198     %st_global(t0, &gc_free_list, t1)
   3199     %ldl(t0, allocated)
   3200     %st_global(t0, &heap_allocated, t1)
   3201     %eret
   3202     :.corrupt
   3203     %die(msg_heap_corrupt)
   3204 })
   3205 
   3206 %fn(gc_collect, 0, {
   3207     %li(t0, 0)
   3208     %st_global(t0, &gc_mark_worklist, t1)
   3209     %call(&gc_mark_shadow_roots)
   3210     %call(&gc_mark_symbol_roots)
   3211     :.drain
   3212     %ld_global(t0, &gc_mark_worklist)
   3213     %beqz(t0, &.sweep)
   3214     %ld(t1, t0, 8)
   3215     %st_global(t1, &gc_mark_worklist, t2)
   3216     %mov(a0, t0)
   3217     %call(&gc_trace_header)
   3218     %b(&.drain)
   3219     :.sweep
   3220     %tail(&gc_sweep)
   3221 })
   3222 
   3223 # =========================================================================
   3224 # Managed heap allocation
   3225 # =========================================================================
   3226 #
   3227 # gc_alloc_try performs coalesced-free-list first fit, then uses the
   3228 # untouched heap tail.  It never collects and returns raw payload 0 on
   3229 # failure.  gc_alloc collects once and retries.  All managed payloads are
   3230 # 8-byte aligned; the two-word allocation header is not visible through
   3231 # existing Scheme object pointers.
   3232 
   3233 %fn2(gc_alloc_try, {total kind prev cur block_size next}, {
   3234     %alignup(a0, a0, 8, t0)
   3235     %addi(a0, a0, %GC_HEADER_BYTES)
   3236     %stl(a0, total)
   3237     %stl(a1, kind)
   3238     %li(t0, 0)
   3239     %stl(t0, prev)
   3240     %ld_global(t0, &gc_free_list)
   3241     %stl(t0, cur)
   3242 
   3243     :.free_loop
   3244     %ldl(t0, cur)
   3245     %beqz(t0, &.tail)
   3246     %ld(t1, t0, 0)
   3247     %shri(t1, t1, 8)
   3248     %stl(t1, block_size)
   3249     %ldl(t2, total)
   3250     %bltu(t1, t2, &.free_next)
   3251 
   3252     # Found first fit.  Split only when the remainder can hold a header
   3253     # plus at least one aligned payload word.
   3254     %ld(t1, t0, 8)
   3255     %stl(t1, next)
   3256     %ldl(t1, block_size)
   3257     %ldl(t2, total)
   3258     %sub(t1, t1, t2)            ; remainder bytes
   3259     %li(t2, (+ %GC_HEADER_BYTES 8))
   3260     %bltu(t1, t2, &.consume)
   3261 
   3262     # remainder_header = current + requested_total
   3263     %ldl(t0, cur)
   3264     %ldl(t2, total)
   3265     %add(t2, t0, t2)
   3266     %shli(t1, t1, 8)            ; FREE kind is zero
   3267     %st(t1, t2, 0)
   3268     %ldl(t1, next)
   3269     %st(t1, t2, 8)
   3270     %ldl(t1, prev)
   3271     %beqz(t1, &.split_head)
   3272     %st(t2, t1, 8)
   3273     %b(&.split_done)
   3274     :.split_head
   3275     %st_global(t2, &gc_free_list, t1)
   3276     :.split_done
   3277     %ldl(t1, total)
   3278     %stl(t1, block_size)
   3279     %b(&.prepare)
   3280 
   3281     :.consume
   3282     %ldl(t1, prev)
   3283     %ldl(t2, next)
   3284     %beqz(t1, &.consume_head)
   3285     %st(t2, t1, 8)
   3286     %b(&.prepare)
   3287     :.consume_head
   3288     %st_global(t2, &gc_free_list, t1)
   3289     %b(&.prepare)
   3290 
   3291     :.free_next
   3292     %ldl(t0, cur)
   3293     %stl(t0, prev)
   3294     %ld(t0, t0, 8)
   3295     %stl(t0, cur)
   3296     %b(&.free_loop)
   3297 
   3298     :.tail
   3299     %ld_global(t0, &heap_tail)
   3300     %ldl(t1, total)
   3301     %add(t2, t0, t1)
   3302     %ld_global(a3, &heap_end)
   3303     %bltu(a3, t2, &.fail)
   3304     %st_global(t2, &heap_tail, a3)
   3305     %stl(t0, cur)
   3306     %stl(t1, block_size)
   3307 
   3308     :.prepare
   3309     # Install the allocated header and account for the entire physical
   3310     # block (including header and any unsplittable tail fragment).
   3311     %ldl(t0, cur)
   3312     %ldl(t1, block_size)
   3313     %shli(t2, t1, 8)
   3314     %ldl(a1, kind)
   3315     %or(t2, t2, a1)
   3316     %st(t2, t0, 0)
   3317     %st(t0, t0, 8)             ; allocated-block start canary
   3318     %ld_global(a3, &heap_allocated)
   3319     %add(a3, a3, t1)
   3320     %st_global(a3, &heap_allocated, t2)
   3321 
   3322     # Clear traced payloads before publishing them.  This makes a
   3323     # partially constructed HEAP object safe if a later field-setting
   3324     # step allocates and triggers collection.
   3325     %ldl(a1, kind)
   3326     %li(t1, %GCKIND.RAW)
   3327     %beq(a1, t1, &.return)
   3328     %addi(t1, t0, %GC_HEADER_BYTES)
   3329     %ldl(t2, block_size)
   3330     %addi(t2, t2, (- %GC_HEADER_BYTES))
   3331     :.clear_loop
   3332     %beqz(t2, &.return)
   3333     %li(a0, 0)
   3334     %st(a0, t1, 0)
   3335     %addi(t1, t1, 8)
   3336     %addi(t2, t2, -8)
   3337     %b(&.clear_loop)
   3338 
   3339     :.return
   3340     %addi(a0, t0, %GC_HEADER_BYTES)
   3341     %eret
   3342 
   3343     :.fail
   3344     %li(a0, 0)
   3345 })
   3346 
   3347 %fn2(gc_alloc, {bytes kind}, {
   3348     %stl(a0, bytes)
   3349     %stl(a1, kind)
   3350     %call(&gc_alloc_try)
   3351     %bnez(a0, &.done)
   3352     %call(&gc_collect)
   3353     %ldl(a0, bytes)
   3354     %ldl(a1, kind)
   3355     %call(&gc_alloc_try)
   3356     %beqz(a0, &.oom)
   3357     :.done
   3358     %eret
   3359     :.oom
   3360     %die(msg_heap_full)
   3361 })
   3362 
   3363 # cons roots both arguments inside the allocator frame because gc_alloc
   3364 # may synchronously collect before returning a payload.
   3365 %gcfn2(cons, {car_value cdr_value}, 3, 0, {
   3366     %stl(a0, car_value)
   3367     %stl(a1, cdr_value)
   3368     %li(a0, %PAIR.SIZE)
   3369     %li(a1, %GCKIND.PAIR)
   3370     %call(&gc_alloc)
   3371     %ldl(t0, car_value)
   3372     %st(t0, a0, %PAIR.car)
   3373     %ldl(t0, cdr_value)
   3374     %st(t0, a0, %PAIR.cdr)
   3375     %addi(a0, a0, %TAG.PAIR)
   3376 })
   3377 
   3378 # alloc_hdr(bytes=a0, hdr_word=a1) -> tagged HEAP object.
   3379 %fn2(alloc_hdr, {bytes hdr_word}, {
   3380     %stl(a0, bytes)
   3381     %stl(a1, hdr_word)
   3382     %li(a1, %GCKIND.HEAP)
   3383     %call(&gc_alloc)
   3384     %ldl(t0, hdr_word)
   3385     %st(t0, a0, 0)
   3386     %addi(a0, a0, %TAG.HEAP)
   3387 })
   3388 
   3389 # list_length(list=a0) -> count (a0). Linear walk; clobbers a0 (used as
   3390 # the cursor). Callers that need the list afterward must save it first.
   3391 :list_length
   3392 .scope
   3393     %li(t0, 0)
   3394     :.loop
   3395         %if_nil(t1, a0, &.done)
   3396         %addi(t0, t0, 1)
   3397         %cdr(a0, a0)
   3398         %b(&.loop)
   3399     :.done
   3400     %mov(a0, t0)
   3401     %ret
   3402 .endscope
   3403 
   3404 # =========================================================================
   3405 # Multiple-values protocol
   3406 # =========================================================================
   3407 #
   3408 # An MV-pack is a HEAP-tagged object with header (count << 8) | HDR.MV
   3409 # followed by `count` slot words (raw +8, +16, ...). The R7RS protocol
   3410 # below treats single values and MV-packs uniformly: a 1-value yield is
   3411 # returned as the bare value, while 0 or 2+ values are materialized as
   3412 # an MV-pack. mv_to_list normalizes either form to a list so let-values /
   3413 # call-with-values can reuse the existing destructuring machinery.
   3414 
   3415 # list_to_mv(list=a0) -> tagged MV-pack (a0).
   3416 # Walks `list` to count it, allocates (count+1)*8 bytes with header
   3417 # (count<<8)|HDR.MV, then copies elements into consecutive slots in
   3418 # order. An empty list yields a 0-pack.
   3419 #
   3420 # Locals:
   3421 #   list   (preserved across list_length + alloc_hdr)
   3422 #   count
   3423 #   mv     (tagged MV-pack)
   3424 %gcfn2(list_to_mv, {list count mv pad}, 5, 0, {
   3425     %stl(a0, list)
   3426     %call(&list_length)         ; clobbers a0; returns count
   3427     %stl(a0, count)
   3428 
   3429     # alloc_hdr((count+1)*8, (count<<8)|HDR.MV)
   3430     %addi(a0, a0, 1)
   3431     %shli(a0, a0, 3)
   3432     %ldl(t0, count)
   3433     %shli(t0, t0, 8)
   3434     %ori(a1, t0, %HDR.MV)
   3435     %call(&alloc_hdr)
   3436     %stl(a0, mv)
   3437 
   3438     # Walk list, store at consecutive slots. The first slot's raw byte
   3439     # offset from a tagged HEAP pointer is +5 (= raw+8 - 3).
   3440     %ldl(t0, list)
   3441     %addi(t1, a0, 5)
   3442 
   3443     :.loop
   3444     %if_nil(t2, t0, &.done)
   3445     %car(t2, t0)
   3446     %st(t2, t1, 0)
   3447     %addi(t1, t1, 8)
   3448     %cdr(t0, t0)
   3449     %b(&.loop)
   3450 
   3451     :.done
   3452     %ldl(a0, mv)
   3453 })
   3454 
   3455 # mv_to_list(val=a0) -> list (a0).
   3456 # If val is HEAP-tagged with HDR.MV, build a fresh list of its slots in
   3457 # order. Any other value is wrapped as a single-element list, so callers
   3458 # can uniformly reuse list-shaped destructuring.
   3459 #
   3460 # Locals:
   3461 #   mv     original MV-pack, rooted while fresh list cells are allocated
   3462 #   ptr    (raw cursor into MV slots, walked backward)
   3463 #   count  (remaining slot count)
   3464 %gcfn2(mv_to_list, {mv ptr count}, 1, 0, {
   3465     %stl(a0, mv)
   3466     %tagof(t0, a0)
   3467     %bine(t0, %TAG.HEAP, &.single, t1)
   3468     %hdr_type(t0, a0)
   3469     %bine(t0, %HDR.MV,   &.single, t1)
   3470 
   3471     # MV-pack: count = (hdr >> 8); header sits at raw+0 = tagged-3.
   3472     %ld(t0, a0, -3)
   3473     %shri(t0, t0, 8)
   3474     %stl(t0, count)
   3475 
   3476     # Walk slots back-to-front so each cons prepends, yielding original
   3477     # left-to-right order. Cursor = (tagged+5) + (count-1)*8.
   3478     %addi(t1, a0, 5)
   3479     %shli(t2, t0, 3)
   3480     %add(t1, t1, t2)
   3481     %addi(t1, t1, -8)
   3482     %stl(t1, ptr)
   3483 
   3484     %li(a0, %imm_val(%IMM.NIL))
   3485 
   3486     :.loop
   3487     %ldl(t0, count)
   3488     %beqz(t0, &.done)
   3489 
   3490     %ldl(t1, ptr)
   3491     %ld(t2, t1, 0)
   3492     %mov(a1, a0)
   3493     %mov(a0, t2)
   3494     %call(&cons)
   3495 
   3496     %ldl(t1, ptr)
   3497     %addi(t1, t1, -8)
   3498     %stl(t1, ptr)
   3499     %ldl(t0, count)
   3500     %addi(t0, t0, -1)
   3501     %stl(t0, count)
   3502     %b(&.loop)
   3503 
   3504     :.done
   3505     %gceret
   3506 
   3507     :.single
   3508     # Non-MV: return (val . NIL).
   3509     %li(a1, %imm_val(%IMM.NIL))
   3510     %gctail(&cons)
   3511 })
   3512 
   3513 # =========================================================================
   3514 # Symbol intern -- linear scan, append on miss
   3515 # =========================================================================
   3516 #
   3517 # Locals:
   3518 #   name_ptr  (input)
   3519 #   name_len  (input)
   3520 #   idx  (loop counter / found index)
   3521 #   entry_ptr  (spilled across memcmp)
   3522 %gcfn2(intern, {name_ptr name_len idx entry_ptr}, 0, 1, {
   3523     %stl(a0, name_ptr)
   3524     %stl(a1, name_len)
   3525 
   3526     %li(t0, 0)
   3527     %stl(t0, idx)
   3528 
   3529     :.scan
   3530     # idx >= count? -> append
   3531     %ldl(t0, idx)
   3532     %ld_global(t1, &symtab_count)
   3533     %bltu(t0, t1, &.probe)
   3534     %b(&.append)
   3535 
   3536     :.probe
   3537     %symtab_entry(t1, t0, t2)
   3538     %stl(t1, entry_ptr)
   3539 
   3540     # entry.name_len == name_len ?
   3541     %ld(t2, t1, %SYMENT.name_len)
   3542     %ldl(a2, name_len)
   3543     %bne(t2, a2, &.next)
   3544 
   3545     # memcmp(entry.name_ptr, name_ptr, len)
   3546     %ld(a0, t1, %SYMENT.name_ptr)
   3547     %ldl(a1, name_ptr)
   3548     %ldl(a2, name_len)
   3549     %call(&memcmp)
   3550     %beqz(a0, &.found)
   3551 
   3552     :.next
   3553     %ldl(t0, idx)
   3554     %addi(t0, t0, 1)
   3555     %stl(t0, idx)
   3556     %b(&.scan)
   3557 
   3558     :.append
   3559     # Bounds check; on overflow exit 5 with a message.
   3560     %ldl(t0, idx)
   3561     %li(t1, %SYMTAB_CAP_SLOTS)
   3562     %bltu(t0, t1, &.append_ok)
   3563     %die(msg_symtab_full)
   3564 
   3565     :.append_ok
   3566     # Copy the name into a stable managed RAW buffer. The caller-provided
   3567     # ptr may live in readbuf_buf (parse_atom), so symtab names must
   3568     # outlive source-buffer reuse. The collector roots each name explicitly.
   3569     %ldl(a0, name_len)
   3570     %call(&alloc_bytes)
   3571     %ldl(a1, name_ptr)
   3572     %ldl(a2, name_len)
   3573     %call(&memcpy)              ; returns dst in a0 = stable copy
   3574 
   3575     %ldl(t0, idx)
   3576     %symtab_entry(t1, t0, t2)
   3577     %st(a0, t1, %SYMENT.name_ptr)   ; stable copy
   3578     %ldl(a0, name_len)
   3579     %st(a0, t1, %SYMENT.name_len)
   3580     %li(a0, %imm_val(%IMM.UNBOUND))
   3581     %st(a0, t1, %SYMENT.global_val)
   3582     %li(a0, 0)
   3583     %st(a0, t1, %SYMENT.pad)
   3584 
   3585     # symtab_count = idx + 1
   3586     %addi(a0, t0, 1)
   3587     %st_global(a0, &symtab_count, t2)
   3588 
   3589     # fall through with idx in t0 = sp[16]
   3590 
   3591     :.found
   3592     %ldl(t0, idx)
   3593     %shli(a0, t0, 3)
   3594     %ori(a0, a0, %TAG.SYM)
   3595 })
   3596 
   3597 # Lookup by sym_idx (untagged, in a0). Returns symtab[idx].global_val in a0.
   3598 # Leaf.
   3599 :sym_global
   3600     %ld_global(t0, &symtab_buf_ptr)
   3601     %ld_array(a0, t0, %SYMENT.SIZE, a0, %SYMENT.global_val, t1)
   3602     %ret
   3603 
   3604 # sym_set_global(idx=a0, val=a1). Leaf.
   3605 :sym_set_global
   3606     %ld_global(t0, &symtab_buf_ptr)
   3607     %st_array(a1, t0, %SYMENT.SIZE, a0, %SYMENT.global_val, t1)
   3608     %ret
   3609 
   3610 # =========================================================================
   3611 # Primitives
   3612 # =========================================================================
   3613 #
   3614 # PRIM objects live on the heap so the bump allocator's 8-byte alignment
   3615 # is what makes (heap_ptr & 7 == 0) hold; that's what lets `+3` encode
   3616 # the HEAP tag cleanly. (A static :prim_sys_exit emitted in the data
   3617 # section was at the mercy of preceding code length and could land at
   3618 # any 4-byte alignment, producing tag bits 5 or 7 instead of 3.)
   3619 #
   3620 # register_primitives walks prim_table at startup. Each table entry is
   3621 # 24 bytes: 8-byte name_ptr (4-byte label ref + 4 pad), 8-byte name_len,
   3622 # 8-byte entry_label (4 ref + 4 pad). For each entry we alloc a 16-byte
   3623 # PRIM, write the entry-label into the prim header's entry slot, intern
   3624 # the surface name, and bind the symbol's global slot to the HEAP-tagged
   3625 # prim pointer.
   3626 #
   3627 # Locals:
   3628 #   prim  ptr (HEAP-tagged; spilled across intern + sym_set_global)
   3629 #   walk  (current table cursor)
   3630 #   end  (table_end)
   3631 %gcfn2(register_primitives, {prim walk end}, 1, 0, {
   3632     %la(t0, &prim_table)
   3633     %stl(t0, walk)
   3634     %la(t0, &prim_table_end)
   3635     %stl(t0, end)
   3636 
   3637     :.loop
   3638     %ldl(t0, walk)
   3639     %ldl(t1, end)
   3640     %beq(t0, t1, &.done)
   3641 
   3642     # alloc_hdr(24, HDR.PRIM) -> HEAP-tagged a0. The third slot (offset 13
   3643     # from tagged) holds per-instance data and stays zero for the
   3644     # primitives registered here -- only parameterized prims (record
   3645     # ctor/predicate/accessor/mutator) read it.
   3646     %li(a0, 24)
   3647     %li(a1, %HDR.PRIM)
   3648     %call(&alloc_hdr)
   3649     %stl(a0, prim)
   3650 
   3651     # Write entry-label into prim's entry slot.
   3652     %ldl(t0, walk)
   3653     %ld(t1, t0, 16)
   3654     %ldl(t2, prim)
   3655     %heap_st(t1, t2, %PRIM.entry_w)
   3656 
   3657     # Intern surface name; bind global to prim ptr.
   3658     %ldl(t0, walk)
   3659     %ld(a0, t0, 0)
   3660     %ld(a1, t0, 8)
   3661     %call(&intern)
   3662     %untag_sym(a0, a0)
   3663     %ldl(a1, prim)
   3664     %call(&sym_set_global)
   3665 
   3666     %ldl(t0, walk)
   3667     %addi(t0, t0, 24)
   3668     %stl(t0, walk)
   3669     %b(&.loop)
   3670 
   3671     :.done
   3672 })
   3673 
   3674 %fn(register_globals, 0, {
   3675     # Bind `eof` as a direct global -> IMM.EOF value. (Predicate is `eof?`,
   3676     # registered via prim_table.) Cheaper and shorter than a 0-arg thunk.
   3677     %la(a0, &name_eof)
   3678     %li(a1, 3)
   3679     %call(&intern)
   3680     %untag_sym(a0, a0)
   3681     %li(a1, %imm_val(%IMM.EOF))
   3682     %call(&sym_set_global)
   3683 })
   3684 
   3685 # Each primitive is a leaf reached via apply's %tailr: args list is in a0,
   3686 # and the result goes back in a0. Most use no frame at all; the few that
   3687 # need recursion (apply) carry a small one via %fn.
   3688 #
   3689 # Arithmetic / compare / bitwise primitives on tagged fixnums take
   3690 # advantage of the (n << 3) representation: + / - / signed compare /
   3691 # bit-and / bit-or / bit-xor all work directly on the tagged words, so
   3692 # the variadic fold loop preserves the tag at every step. Only * has to
   3693 # untag each incoming operand to avoid a stray <<6.
   3694 
   3695 # (sys-exit code) -- libp1pp's sys_exit doesn't return; %b, not %call.
   3696 :prim_sys_exit_entry
   3697     %car(a0, a0)
   3698     %untag_fix(a0, a0)
   3699     %b(&sys_exit)
   3700 
   3701 # (cons a b) -> tagged pair.
   3702 :prim_cons_entry
   3703     %car(t0, a0)
   3704     %cdr(t1, a0)
   3705     %car(t1, t1)
   3706     %mov(a0, t0)
   3707     %mov(a1, t1)
   3708     %b(&cons)
   3709 
   3710 # (car p), (cdr p)
   3711 :prim_car_entry
   3712     %car(a0, a0)
   3713     %car(a0, a0)
   3714     %ret
   3715 
   3716 :prim_cdr_entry
   3717     %car(a0, a0)
   3718     %cdr(a0, a0)
   3719     %ret
   3720 
   3721 # Predicate primitives. Same shape: extract the arg, compare, return one
   3722 # of the two boolean immediates.
   3723 
   3724 :prim_nullq_entry
   3725 .scope
   3726     %car(t0, a0)
   3727     %li(a0, %imm_val(%IMM.TRUE))
   3728     %if_nil(t1, t0, &.end)
   3729     %li(a0, %imm_val(%IMM.FALSE))
   3730     :.end
   3731     %ret
   3732 .endscope
   3733 
   3734 :prim_pairq_entry
   3735 .scope
   3736     %car(t0, a0)
   3737     %tagof(t1, t0)
   3738     %li(t2, %TAG.PAIR)
   3739     %li(a0, %imm_val(%IMM.FALSE))
   3740     %bne(t1, t2, &.end)
   3741     %li(a0, %imm_val(%IMM.TRUE))
   3742     :.end
   3743     %ret
   3744 .endscope
   3745 
   3746 # (string? x) -- #t iff x is a HEAP-tagged HDR.BV. Bytevectors back the
   3747 # string type until characters get a distinct repr; this prim is also
   3748 # the bytevector? predicate.
   3749 :prim_stringq_entry
   3750 .scope
   3751     %car(t0, a0)
   3752     %li(a0, %imm_val(%IMM.FALSE))
   3753     %tagof(t1, t0)
   3754     %li(t2, %TAG.HEAP)
   3755     %bne(t1, t2, &.end)
   3756     %hdr_type(t1, t0)
   3757     %li(t2, %HDR.BV)
   3758     %bne(t1, t2, &.end)
   3759     %li(a0, %imm_val(%IMM.TRUE))
   3760     :.end
   3761     %ret
   3762 .endscope
   3763 
   3764 # (set-car! pair val) / (set-cdr! pair val) -- in-place pair mutation.
   3765 # No type check (matches car/cdr's lax stance); both return UNSPEC.
   3766 :prim_set_car_entry
   3767     %args2(t0, t1, a0)
   3768     %set_car(t1, t0)
   3769     %li(a0, %imm_val(%IMM.UNSPEC))
   3770     %ret
   3771 
   3772 :prim_set_cdr_entry
   3773     %args2(t0, t1, a0)
   3774     %set_cdr(t1, t0)
   3775     %li(a0, %imm_val(%IMM.UNSPEC))
   3776     %ret
   3777 
   3778 # (length xs) -- count of pairs in a proper list. Forwards to the
   3779 # list_length helper (which clobbers a0 as the cursor) and tags the
   3780 # resulting count as a fixnum. Needs a frame because %call(&list_length)
   3781 # would otherwise clobber lr and the trailing %ret would loop.
   3782 %fn(prim_length_entry, 0, {
   3783     %car(a0, a0)
   3784     %call(&list_length)
   3785     %mkfix(a0, a0)
   3786     %eret
   3787 })
   3788 
   3789 # (list-ref xs n) -- 0-indexed nth element. n is a fixnum; we untag,
   3790 # advance via cdr, then car. Out-of-range is undefined behavior, same
   3791 # as car/cdr on '().
   3792 :prim_list_ref_entry
   3793 .scope
   3794     %args2(t0, t1, a0)
   3795     %sari(t1, t1, 3)
   3796     :.loop
   3797     %beqz(t1, &.done)
   3798     %cdr(t0, t0)
   3799     %addi(t1, t1, -1)
   3800     %b(&.loop)
   3801     :.done
   3802     %car(a0, t0)
   3803     %ret
   3804 .endscope
   3805 
   3806 # (assq key alist) -> matching pair or #f. Walks alist, comparing
   3807 # car of each pair to key by identity (eq?); first match wins. Pure
   3808 # leaf -- no allocation, no calls. Replaces the interpreted prelude
   3809 # define so file-scope alist lookups (e.g. cc.scm scope-bind!'s
   3810 # redecl check) don't pay bind_params env-cons cost per step.
   3811 :prim_assq_entry
   3812 .scope
   3813     %args2(t0, t1, a0)         ; t0=key, t1=alist
   3814     :.loop
   3815     %if_nil(t2, t1, &.miss)
   3816     %car(t2, t1)               ; pair = (car alist)
   3817     %car(a0, t2)               ; (car pair)
   3818     %beq(a0, t0, &.hit)
   3819     %cdr(t1, t1)
   3820     %b(&.loop)
   3821     :.hit
   3822     %mov(a0, t2)
   3823     %ret
   3824     :.miss
   3825     %li(a0, %imm_val(%IMM.FALSE))
   3826     %ret
   3827 .endscope
   3828 
   3829 # (assoc key alist) -> matching pair or #f. Same shape as assq but
   3830 # the key compare goes through equal_recurse, which means we need a
   3831 # frame to preserve the key/cursor/current-pair across the call.
   3832 #
   3833 # Locals:
   3834 #   key
   3835 #   cursor
   3836 #   pair  (saved across equal_recurse so we can return it on hit)
   3837 %fn2(prim_assoc_entry, {key cursor pair}, {
   3838     %args2(t0, t1, a0)
   3839     %stl(t0, key)
   3840     %stl(t1, cursor)
   3841 
   3842     :.loop
   3843     %ldl(t1, cursor)
   3844     %if_nil(t2, t1, &.miss)
   3845     %car(t2, t1)               ; pair = (car cursor)
   3846     %stl(t2, pair)
   3847     %car(a0, t2)               ; (car pair)
   3848     %ldl(a1, key)
   3849     %call(&equal_recurse)
   3850     %bieq(a0, %imm_val(%IMM.FALSE), &.next, t0)
   3851     %ldl(a0, pair)
   3852     %eret
   3853 
   3854     :.next
   3855     %ldl(t1, cursor)
   3856     %cdr(t1, t1)
   3857     %stl(t1, cursor)
   3858     %b(&.loop)
   3859 
   3860     :.miss
   3861     %li(a0, %imm_val(%IMM.FALSE))
   3862 })
   3863 
   3864 # (reverse list) -> fresh reversed list. Walks the input forward,
   3865 # consing each element onto an accumulator; result is the accumulator.
   3866 # One fresh PAIR per input element, no intermediates. Frame needed
   3867 # because cons is a leaf and %call clobbers lr.
   3868 #
   3869 # Locals:
   3870 #   xs   (cursor; advanced each iteration)
   3871 #   acc
   3872 %gcfn2(prim_reverse_entry, {xs acc}, 3, 0, {
   3873     %car(t0, a0)               ; t0 = list arg
   3874     %stl(t0, xs)
   3875     %li(t0, %imm_val(%IMM.NIL))
   3876     %stl(t0, acc)
   3877 
   3878     :.loop
   3879     %ldl(t0, xs)
   3880     %if_nil(t1, t0, &.done)
   3881     %car(a0, t0)
   3882     %ldl(a1, acc)
   3883     %call(&cons)
   3884     %stl(a0, acc)
   3885     %ldl(t0, xs)
   3886     %cdr(t0, t0)
   3887     %stl(t0, xs)
   3888     %b(&.loop)
   3889 
   3890     :.done
   3891     %ldl(a0, acc)
   3892 })
   3893 
   3894 # (bytevector-append bv ...) -- variadic concatenation. Two passes:
   3895 # the first sums the bv lengths so we can size the result up front; the
   3896 # second walks the args again and memcpy's each src into the result.
   3897 # The args list head is saved at +0 because pass 1 walks a separate
   3898 # cursor (t1) and pass 2 needs to re-read the head. memcpy clobbers
   3899 # t-regs, so the running write offset and remaining-args cursor live
   3900 # in the frame across each call.
   3901 #
   3902 # Locals:
   3903 #   args  list head (re-read for pass 2; cursor during pass 2)
   3904 #   total  length (raw)
   3905 #   result  bv
   3906 #   write  offset (raw, into result.data)
   3907 %gcfn2(prim_bv_append_entry, {args total result write}, 5, 0, {
   3908     %stl(a0, args)
   3909 
   3910     %li(t0, 0)
   3911     %mov(t1, a0)
   3912     :.sum_loop
   3913         %if_nil(t2, t1, &.sum_done)
   3914         %car(t2, t1)
   3915         %heap_ld(a0, t2, %BV.hdr)
   3916         %shri(a0, a0, 8)
   3917         %add(t0, t0, a0)
   3918         %cdr(t1, t1)
   3919         %b(&.sum_loop)
   3920     :.sum_done
   3921     %stl(t0, total)
   3922 
   3923     %mov(a0, t0)
   3924     %call(&bv_alloc)
   3925     %stl(a0, result)
   3926 
   3927     %li(t0, 0)
   3928     %stl(t0, write)
   3929 
   3930     :.copy_loop
   3931         %ldl(t0, args)
   3932         %if_nil(t1, t0, &.copy_done)
   3933         %car(t1, t0)                ; src bv
   3934         %heap_ld(t2, t1, %BV.hdr)
   3935         %shri(t2, t2, 8)            ; src length
   3936 
   3937         %ldl(a0, result)
   3938         %heap_ld(a0, a0, %BV.data)  ; result.data
   3939         %ldl(a3, write)
   3940         %add(a0, a0, a3)            ; dst = result.data + offset
   3941         %heap_ld(a1, t1, %BV.data)  ; src.data
   3942         %mov(a2, t2)                ; count
   3943 
   3944         %add(a3, a3, t2)
   3945         %stl(a3, write)
   3946         %cdr(t0, t0)
   3947         %stl(t0, args)
   3948 
   3949         %call(&memcpy)
   3950         %b(&.copy_loop)
   3951     :.copy_done
   3952 
   3953     %ldl(a0, result)
   3954 })
   3955 
   3956 # (string->symbol bv) -- intern the bytes and return the SYM-tagged
   3957 # value. intern copies the name into stable heap storage if it has to
   3958 # append, so the bv's data buffer is safe to relocate afterwards.
   3959 :prim_string_to_symbol_entry
   3960     %car(t0, a0)
   3961     %heap_ld(a0, t0, %BV.data)
   3962     %heap_ld(a1, t0, %BV.hdr)
   3963     %shri(a1, a1, 8)            ; length
   3964     %b(&intern)
   3965 
   3966 # (symbol->string sym) -- fresh bv copy of the symtab name. sym_name
   3967 # returns (ptr, len); str_alloc gives us a NUL-terminated wrapper;
   3968 # memcpy fills the data. Frame holds the (ptr, len) pair across
   3969 # str_alloc and the resulting bv across memcpy.
   3970 
   3971 %gcfn2(prim_symbol_to_string_entry, {ptr len bv}, 4, 0, {
   3972     %car(a0, a0)
   3973     %sari(a0, a0, 3)            ; raw sym idx
   3974     %call(&sym_name)            ; -> ptr (a0), len (a1)
   3975     %stl(a0, ptr)
   3976     %stl(a1, len)
   3977     %mov(a0, a1)
   3978     %call(&str_alloc)           ; tagged bv in a0
   3979     %stl(a0, bv)
   3980     %ldl(a1, ptr)              ; src ptr
   3981     %ldl(a2, len)              ; len
   3982     %heap_ld(t0, a0, %BV.data)  ; dst = bv.data
   3983     %mov(a0, t0)
   3984     %call(&memcpy)
   3985     %ldl(a0, bv)
   3986 })
   3987 
   3988 # (number->string n [radix]) -- fresh bv with the integer's text form.
   3989 # Radix 16 selects str_puthex (lowercase, leading '-' for negatives);
   3990 # any other radix (or omitted) selects decimal. str_alloc(0) gives an
   3991 # empty NUL-terminated wrapper that the str_put* helper grows in place.
   3992 
   3993 %fn2(prim_number_to_string_entry, {value radix}, {
   3994     %car(t0, a0)
   3995     %sari(t0, t0, 3)            ; raw value
   3996     %stl(t0, value)
   3997 
   3998     # Default radix = 10. If a second arg is present, untag it.
   3999     %li(t0, 10)
   4000     %stl(t0, radix)
   4001     %cdr(t1, a0)
   4002     %if_nil(t0, t1, &.have_radix)
   4003     %car(t0, t1)
   4004     %sari(t0, t0, 3)
   4005     %stl(t0, radix)
   4006     :.have_radix
   4007 
   4008     %li(a0, 0)
   4009     %call(&str_alloc)
   4010     %ldl(a1, value)
   4011     %ldl(t0, radix)
   4012     %bieq(t0, 16, &.hex, t1)
   4013     %tail(&str_putint)
   4014     :.hex
   4015     %tail(&str_puthex)
   4016 })
   4017 
   4018 # (string->number bv [radix]) -- decimal goes through parse_dec; radix
   4019 # 16 strips an optional leading '-' and calls parse_hex over the
   4020 # remainder, demanding it consume every byte. Returns #f on
   4021 # non-bytevector input, empty string, lone "-", or any non-recognized
   4022 # byte. Other radices are not pinned by LISP.md and currently fall
   4023 # through to the decimal path.
   4024 %fn2(prim_string_to_number_entry, {args ptr len sign}, {
   4025     %stl(a0, args)
   4026 
   4027     %car(t2, a0)
   4028     %tagof(t0, t2)
   4029     %bine(t0, %TAG.HEAP, &.fail, t1)
   4030     %hdr_type(t0, t2)
   4031     %bine(t0, %HDR.BV,   &.fail, t1)
   4032 
   4033     %heap_ld(t0, t2, %BV.data)
   4034     %heap_ld(t1, t2, %BV.hdr)
   4035     %shri(t1, t1, 8)            ; length
   4036     %stl(t0, ptr)
   4037     %stl(t1, len)
   4038 
   4039     # Inspect the optional radix arg.
   4040     %ldl(t0, args)
   4041     %cdr(t0, t0)
   4042     %if_nil(t1, t0, &.dec)
   4043     %car(t1, t0)
   4044     %sari(t1, t1, 3)
   4045     %bieq(t1, 16, &.hex, t2)
   4046 
   4047     :.dec
   4048     %ldl(a0, ptr)
   4049     %ldl(a1, len)
   4050     %beqz(a1, &.fail)
   4051     %lb(t0, a0, 0)
   4052     %bcne(t0, -43, &.dec_no_plus, t0)    ; '+'
   4053     %addi(a0, a0, 1)
   4054     %addi(a1, a1, -1)
   4055     %beqz(a1, &.fail)
   4056     :.dec_no_plus
   4057     %stl(a1, len)               ; save adjusted len
   4058     %call(&parse_dec)           ; P1pp: -> (raw_val=a0, consumed=a1)
   4059     %ldl(t0, len)
   4060     %bne(a1, t0, &.fail)       ; partial parse -> fail
   4061     %mkfix(a0, a0)
   4062     %b(&.end)
   4063 
   4064     :.hex
   4065     # Strip optional leading '+' / '-'.
   4066     %li(t0, 0)
   4067     %stl(t0, sign)
   4068     %ldl(t0, len)
   4069     %beqz(t0, &.fail)
   4070     %ldl(t1, ptr)
   4071     %lb(t2, t1, 0)
   4072     %addi(t0, t2, -45)          ; '-'
   4073     %beqz(t0, &.hex_neg)
   4074     %addi(t0, t2, -43)          ; '+'
   4075     %beqz(t0, &.hex_skip_sign)
   4076     %b(&.hex_parse)
   4077     :.hex_neg
   4078     %li(t0, 1)
   4079     %stl(t0, sign)
   4080     :.hex_skip_sign
   4081     %ldl(t0, ptr)
   4082     %addi(t0, t0, 1)
   4083     %stl(t0, ptr)
   4084     %ldl(t0, len)
   4085     %addi(t0, t0, -1)
   4086     %stl(t0, len)
   4087     %beqz(t0, &.fail)
   4088 
   4089     :.hex_parse
   4090     %ldl(a0, ptr)
   4091     %ldl(a1, len)
   4092     %call(&parse_hex)            ; -> (a0=value, a1=consumed)
   4093     %ldl(t0, len)
   4094     %bne(a1, t0, &.fail)        ; demand full consumption
   4095     %ldl(t0, sign)
   4096     %beqz(t0, &.hex_pos)
   4097     %li(t1, 0)
   4098     %sub(a0, t1, a0)
   4099     :.hex_pos
   4100     %mkfix(a0, a0)
   4101     %b(&.end)
   4102 
   4103     :.fail
   4104     %li(a0, %imm_val(%IMM.FALSE))
   4105     :.end
   4106 })
   4107 
   4108 # (boolean? x) -- #t iff x is the IMM.FALSE or IMM.TRUE singleton.
   4109 :prim_booleanq_entry
   4110 .scope
   4111     %car(t0, a0)
   4112     %li(a0, %imm_val(%IMM.TRUE))
   4113     %li(t1, %imm_val(%IMM.FALSE))
   4114     %beq(t0, t1, &.end)
   4115     %li(t1, %imm_val(%IMM.TRUE))
   4116     %beq(t0, t1, &.end)
   4117     %li(a0, %imm_val(%IMM.FALSE))
   4118     :.end
   4119     %ret
   4120 .endscope
   4121 
   4122 # (integer? x) -- #t iff x is a fixnum (low 3 tag bits == TAG.FIXNUM == 0).
   4123 :prim_integerq_entry
   4124 .scope
   4125     %car(t0, a0)
   4126     %tagof(t1, t0)
   4127     %li(a0, %imm_val(%IMM.FALSE))
   4128     %bnez(t1, &.end)
   4129     %li(a0, %imm_val(%IMM.TRUE))
   4130     :.end
   4131     %ret
   4132 .endscope
   4133 
   4134 # (symbol? x) -- #t iff x is TAG.SYM (interned symbol index, not a heap obj).
   4135 :prim_symbolq_entry
   4136 .scope
   4137     %car(t0, a0)
   4138     %tagof(t1, t0)
   4139     %li(t2, %TAG.SYM)
   4140     %li(a0, %imm_val(%IMM.FALSE))
   4141     %bne(t1, t2, &.end)
   4142     %li(a0, %imm_val(%IMM.TRUE))
   4143     :.end
   4144     %ret
   4145 .endscope
   4146 
   4147 # (procedure? x) -- #t iff x is HEAP-tagged with header HDR.CLOSURE or HDR.PRIM.
   4148 :prim_procedureq_entry
   4149 .scope
   4150     %car(t0, a0)
   4151     %tagof(t1, t0)
   4152     %li(t2, %TAG.HEAP)
   4153     %li(a0, %imm_val(%IMM.FALSE))
   4154     %bne(t1, t2, &.end)
   4155     %hdr_type(t1, t0)
   4156     %li(t2, %HDR.CLOSURE)
   4157     %beq(t1, t2, &.yes)
   4158     %li(t2, %HDR.PRIM)
   4159     %beq(t1, t2, &.yes)
   4160     %b(&.end)
   4161     :.yes
   4162     %li(a0, %imm_val(%IMM.TRUE))
   4163     :.end
   4164     %ret
   4165 .endscope
   4166 
   4167 :prim_zeroq_entry
   4168 .scope
   4169     %car(t0, a0)
   4170     %li(a0, %imm_val(%IMM.FALSE))
   4171     %bnez(t0, &.end)
   4172     %li(a0, %imm_val(%IMM.TRUE))
   4173     :.end
   4174     %ret
   4175 .endscope
   4176 
   4177 :prim_not_entry
   4178 .scope
   4179     %car(t0, a0)
   4180     %li(t1, %imm_val(%IMM.FALSE))
   4181     %li(a0, %imm_val(%IMM.FALSE))
   4182     %bne(t0, t1, &.end)
   4183     %li(a0, %imm_val(%IMM.TRUE))
   4184     :.end
   4185     %ret
   4186 .endscope
   4187 
   4188 :prim_eqq_entry
   4189 .scope
   4190     %car(t0, a0)
   4191     %cdr(t1, a0)
   4192     %car(t1, t1)
   4193     %li(a0, %imm_val(%IMM.FALSE))
   4194     %bne(t0, t1, &.end)
   4195     %li(a0, %imm_val(%IMM.TRUE))
   4196     :.end
   4197     %ret
   4198 .endscope
   4199 
   4200 # Variadic arithmetic. (+ ...) folds with identity 0; (* ...) folds with
   4201 # identity 1; (- x) is unary negate, (- x y z ...) folds left.
   4202 
   4203 :prim_plus_entry
   4204 .scope
   4205     %li(t0, 0)              ; tagged 0; tag bits stay 0 across %add
   4206     :.loop
   4207         %if_nil(t1, a0, &.done)
   4208         %car(t1, a0)
   4209         %add(t0, t0, t1)
   4210         %cdr(a0, a0)
   4211         %b(&.loop)
   4212     :.done
   4213     %mov(a0, t0)
   4214     %ret
   4215 .endscope
   4216 
   4217 # (- x) -> -x; (- x y ...) -> x - y - ... .  (-) is undefined behavior
   4218 # per the primitive-failure policy.
   4219 :prim_minus_entry
   4220 .scope
   4221     %car(t0, a0)            ; seed = first arg (tagged)
   4222     %cdr(a0, a0)
   4223     %if_nil(t1, a0, &.neg)
   4224     :.loop
   4225         %if_nil(t1, a0, &.done)
   4226         %car(t1, a0)
   4227         %sub(t0, t0, t1)
   4228         %cdr(a0, a0)
   4229         %b(&.loop)
   4230     :.neg
   4231     %li(t1, 0)              ; unary: 0 - seed
   4232     %sub(t0, t1, t0)
   4233     :.done
   4234     %mov(a0, t0)
   4235     %ret
   4236 .endscope
   4237 
   4238 # Multiply keeps the accumulator tagged and untags each incoming arg:
   4239 # (a<<3) * b == (a*b)<<3, so the loop preserves the fixnum tag.
   4240 :prim_mult_entry
   4241 .scope
   4242     %li(t0, 8)              ; tagged 1 = mkfix(1)
   4243     :.loop
   4244         %if_nil(t1, a0, &.done)
   4245         %car(t1, a0)
   4246         %untag_fix(t1, t1)
   4247         %mul(t0, t0, t1)
   4248         %cdr(a0, a0)
   4249         %b(&.loop)
   4250     :.done
   4251     %mov(a0, t0)
   4252     %ret
   4253 .endscope
   4254 
   4255 # Variadic chained comparisons: (op a b c ...) ⇔ (a op b) ∧ (b op c) ∧ ...
   4256 # Walks the tail with a single live `prev` register; a0 is reused as the
   4257 # args cursor and finally as the result. <2 args is undefined behavior.
   4258 :prim_eq_entry
   4259 .scope
   4260     %car(t0, a0)            ; prev = first
   4261     %cdr(a0, a0)
   4262     :.loop
   4263         %if_nil(t1, a0, &.true)
   4264         %car(t1, a0)            ; curr
   4265         %bne(t0, t1, &.false)
   4266         %mov(t0, t1)
   4267         %cdr(a0, a0)
   4268         %b(&.loop)
   4269     :.true
   4270     %li(a0, %imm_val(%IMM.TRUE))
   4271     %ret
   4272     :.false
   4273     %li(a0, %imm_val(%IMM.FALSE))
   4274     %ret
   4275 .endscope
   4276 
   4277 :prim_lt_entry
   4278 .scope
   4279     %car(t0, a0)
   4280     %cdr(a0, a0)
   4281     :.loop
   4282         %if_nil(t1, a0, &.true)
   4283         %car(t1, a0)
   4284         %blt(t0, t1, &.ok)     ; prev < curr -> continue
   4285         %li(a0, %imm_val(%IMM.FALSE))
   4286         %ret
   4287         :.ok
   4288         %mov(t0, t1)
   4289         %cdr(a0, a0)
   4290         %b(&.loop)
   4291     :.true
   4292     %li(a0, %imm_val(%IMM.TRUE))
   4293     %ret
   4294 .endscope
   4295 
   4296 :prim_gt_entry
   4297 .scope
   4298     %car(t0, a0)
   4299     %cdr(a0, a0)
   4300     :.loop
   4301         %if_nil(t1, a0, &.true)
   4302         %car(t1, a0)
   4303         %blt(t1, t0, &.ok)     ; curr < prev <=> prev > curr -> continue
   4304         %li(a0, %imm_val(%IMM.FALSE))
   4305         %ret
   4306         :.ok
   4307         %mov(t0, t1)
   4308         %cdr(a0, a0)
   4309         %b(&.loop)
   4310     :.true
   4311     %li(a0, %imm_val(%IMM.TRUE))
   4312     %ret
   4313 .endscope
   4314 
   4315 # (quotient x y) -- truncating integer division. Both fixnums are tagged
   4316 # (real << 3); div(tagged, tagged) yields the raw quotient (the shifts
   4317 # cancel), which mkfix retags. UB on y == 0.
   4318 :prim_quotient_entry
   4319     %args2(t0, t1, a0)
   4320     %div(a0, t0, t1)
   4321     %mkfix(a0, a0)
   4322     %ret
   4323 
   4324 # (remainder x y) -- truncating remainder, sign of dividend. rem(tagged,
   4325 # tagged) = 8 * (real_x rem real_y), already in tagged form.
   4326 :prim_remainder_entry
   4327     %args2(t0, t1, a0)
   4328     %rem(a0, t0, t1)
   4329     %ret
   4330 
   4331 # Variadic bitwise folds. Tagged fixnums have low 3 bits = 0, so AND/OR/
   4332 # XOR with another tagged fixnum preserves the tag in the accumulator.
   4333 # Identities: bit-and -> -1 (tagged -8), bit-or -> 0, bit-xor -> 0.
   4334 :prim_bit_and_entry
   4335 .scope
   4336     %li(t0, -8)             ; tagged -1; AND-identity preserves the tag
   4337     :.loop
   4338         %if_nil(t1, a0, &.done)
   4339         %car(t1, a0)
   4340         %and(t0, t0, t1)
   4341         %cdr(a0, a0)
   4342         %b(&.loop)
   4343     :.done
   4344     %mov(a0, t0)
   4345     %ret
   4346 .endscope
   4347 
   4348 :prim_bit_or_entry
   4349 .scope
   4350     %li(t0, 0)
   4351     :.loop
   4352         %if_nil(t1, a0, &.done)
   4353         %car(t1, a0)
   4354         %or(t0, t0, t1)
   4355         %cdr(a0, a0)
   4356         %b(&.loop)
   4357     :.done
   4358     %mov(a0, t0)
   4359     %ret
   4360 .endscope
   4361 
   4362 :prim_bit_xor_entry
   4363 .scope
   4364     %li(t0, 0)
   4365     :.loop
   4366         %if_nil(t1, a0, &.done)
   4367         %car(t1, a0)
   4368         %xor(t0, t0, t1)
   4369         %cdr(a0, a0)
   4370         %b(&.loop)
   4371     :.done
   4372     %mov(a0, t0)
   4373     %ret
   4374 .endscope
   4375 
   4376 # (bit-not n) -- bitwise complement. Untag, XOR with -1 (= ~n), retag.
   4377 # Can't XOR the tagged value directly: that would flip the low 3 tag bits.
   4378 :prim_bit_not_entry
   4379     %car(t0, a0)
   4380     %untag_fix(t0, t0)
   4381     %li(t1, -1)
   4382     %xor(t0, t0, t1)
   4383     %mkfix(a0, t0)
   4384     %ret
   4385 
   4386 # (arithmetic-shift n k): k > 0 means left shift; k < 0 means arith right.
   4387 # Untag both, branch on sign of k, retag.
   4388 :prim_arith_shift_entry
   4389 .scope
   4390     %car(t0, a0)
   4391     %cdr(t1, a0)
   4392     %car(t1, t1)
   4393     %untag_fix(t0, t0)
   4394     %untag_fix(t1, t1)
   4395     %bltz(t1, &.right)
   4396     %shl(a0, t0, t1)
   4397     %mkfix(a0, a0)
   4398     %ret
   4399     :.right
   4400     %li(t2, 0)
   4401     %sub(t1, t2, t1)
   4402     %sar(a0, t0, t1)
   4403     %mkfix(a0, a0)
   4404     %ret
   4405 .endscope
   4406 
   4407 # Bytevectors are 24-byte HEAP-tagged wrappers pointing at a separately
   4408 # allocated data buffer; this gives them dynamic-array semantics — capacity
   4409 # can grow in place by reallocating just the data buffer (no need to find
   4410 # and patch every reference to the wrapper).
   4411 #
   4412 #   word 0  ::  (length << 8) | HDR.BV       ; length = hdr >> 8
   4413 #   word 1  ::  data_ptr (raw heap address)
   4414 #   word 2  ::  capacity in bytes
   4415 #
   4416 # Tagged-pointer offsets into the wrapper:
   4417 #   hdr      = ld(bv, -3)
   4418 #   data_ptr = ld(bv,  5)
   4419 #   capacity = ld(bv, 13)
   4420 #
   4421 # bv_capacity_for(n) returns the smallest power-of-two ≥ max(n, 16); bv_grow
   4422 # then doubles by repeatedly shifting until cap ≥ requested. Bytevectors
   4423 # are raw u8[] and need no headroom for a NUL terminator -- callers that
   4424 # build "strings" use the str_* writers, which reserve cap > len AND
   4425 # explicitly zero data[len] (reused GC blocks are not assumed zeroed).
   4426 
   4427 # alloc_bytes(size=a0) -> managed RAW payload address (a0).
   4428 :alloc_bytes
   4429     %li(a1, %GCKIND.RAW)
   4430     %b(&gc_alloc)
   4431 
   4432 # bv_capacity_for(n=a0) -> smallest power-of-two ≥ n, minimum 16. Pure
   4433 # bytevector sizing -- no NUL slack. Callers building "strings" call
   4434 # bv_capacity_for(raw_len + 1) to reserve room for the trailing NUL.
   4435 :bv_capacity_for
   4436 .scope
   4437     %li(t0, 16)
   4438     :.loop
   4439     %bltu(t0, a0, &.shift)         ; t0 < a0: keep doubling
   4440     %mov(a0, t0)                    ; t0 >= a0: done
   4441     %ret
   4442     :.shift
   4443     %shli(t0, t0, 1)
   4444     %b(&.loop)
   4445 .endscope
   4446 
   4447 # bv_alloc(raw_len=a0) -> tagged bv (a0). Length = raw_len, capacity from
   4448 # bv_capacity_for, data buffer uninitialized. data_ptr lives in a frame
   4449 # slot because alloc_hdr's alignup clobbers t-regs.
   4450 #
   4451 # Locals:
   4452 #   raw_len
   4453 #   capacity
   4454 #   data_ptr  (raw)
   4455 %gcfn2(bv_alloc, {raw_len capacity data_ptr}, 0, 4, {
   4456     %stl(a0, raw_len)
   4457 
   4458     %call(&bv_capacity_for)
   4459     %stl(a0, capacity)
   4460     %call(&alloc_bytes)
   4461     %stl(a0, data_ptr)
   4462 
   4463     %ldl(a1, raw_len)
   4464     %shli(a1, a1, 8)        ; hdr = (raw_len << 8) | HDR.BV (BV == 0)
   4465     %li(a0, 24)
   4466     %call(&alloc_hdr)
   4467 
   4468     %ldl(t0, data_ptr)
   4469     %heap_st(t0, a0, %BV.data)
   4470     %ldl(t1, capacity)
   4471     %st(t1, a0, 13)         ; bv.cap (raw offset 16; not in BV struct)
   4472 })
   4473 
   4474 # bv_grow(bv=a0, min_cap=a1) -> bv (a0). Doubles capacity until ≥ min_cap;
   4475 # allocates a fresh data buffer, copies the live bytes (length, not
   4476 # capacity), and patches the wrapper's data_ptr/capacity slots in place.
   4477 # A no-op when current capacity already satisfies min_cap.
   4478 #
   4479 # Locals:
   4480 #   bv
   4481 #   min_cap  (input) / new_cap (during loop)
   4482 #   new_data_ptr
   4483 #   raw  length
   4484 %gcfn2(bv_grow, {bv min_cap new_data_ptr raw}, 1, 4, {
   4485     %stl(a0, bv)
   4486     %stl(a1, min_cap)
   4487 
   4488     %ld(t0, a0, 13)         ; bv.cap (raw offset 16; not in BV struct)
   4489     %bltu(t0, a1, &.need)
   4490     %ldl(a0, bv)
   4491     %gceret
   4492 
   4493     :.need
   4494     :.loop
   4495     %shli(t0, t0, 1)
   4496     %ldl(t1, min_cap)
   4497     %bltu(t0, t1, &.loop)
   4498     %stl(t0, min_cap)
   4499 
   4500     %mov(a0, t0)
   4501     %call(&alloc_bytes)
   4502     %stl(a0, new_data_ptr)
   4503 
   4504     %ldl(t0, bv)
   4505     %heap_ld(t1, t0, %BV.hdr)
   4506     %shri(t1, t1, 8)        ; raw length
   4507     %stl(t1, raw)
   4508     %ldl(a0, new_data_ptr)
   4509     %heap_ld(a1, t0, %BV.data)  ; old data ptr
   4510     %ldl(a2, raw)
   4511     %call(&memcpy)
   4512 
   4513     %ldl(t0, bv)
   4514     %ldl(t1, new_data_ptr)
   4515     %heap_st(t1, t0, %BV.data)
   4516     %ldl(t1, min_cap)
   4517     %st(t1, t0, 13)         ; bv.cap (raw offset 16; not in BV struct)
   4518     %ldl(a0, bv)
   4519 })
   4520 
   4521 # (make-bytevector len) or (make-bytevector len fill)
   4522 
   4523 %gcfn2(prim_make_bytevector_entry, {args fill wrapper}, 5, 0, {
   4524     %stl(a0, args)
   4525 
   4526     %li(t2, 0)
   4527     %cdr(t0, a0)
   4528     %if_nil(t1, t0, &.no_fill)
   4529     %car(t0, t0)
   4530     %sari(t2, t0, 3)
   4531     :.no_fill
   4532     %stl(t2, fill)
   4533 
   4534     %ldl(a0, args)
   4535     %car_fix(a0, a0)
   4536     %bltz(a0, &.bad_len)
   4537     %call(&bv_alloc)
   4538     %stl(a0, wrapper)
   4539 
   4540     %ldl(t0, args)
   4541     %car_fix(t0, t0)        ; raw_len
   4542     %ldl(t1, fill)          ; fill
   4543     %ldl(a1, wrapper)
   4544     %heap_ld(t2, a1, %BV.data)
   4545     %li(a1, 0)
   4546 
   4547     :.fill_loop
   4548         %beq(a1, t0, &.fill_done)
   4549         %sb(t1, t2, 0)
   4550         %addi(t2, t2, 1)
   4551         %addi(a1, a1, 1)
   4552         %b(&.fill_loop)
   4553     :.fill_done
   4554 
   4555     %ldl(a0, wrapper)
   4556     %gceret
   4557 
   4558     :.bad_len
   4559     %die(msg_bv_oob)
   4560 })
   4561 
   4562 :prim_bv_length_entry
   4563     %car(t0, a0)
   4564     %heap_ld(t1, t0, %BV.hdr)
   4565     %shri(a0, t1, 5)
   4566     %ret
   4567 
   4568 # (string-length s) -- assumes s is a NUL-terminated bv (a "string");
   4569 # returns strlen(data_ptr). Mirrors bytevector-length but uses the NUL
   4570 # terminator instead of the bv header. For a well-formed string built
   4571 # via str_alloc / str_putn / etc the two agree; for a raw bytevector
   4572 # without a NUL the result is unspecified (strlen may walk past the
   4573 # data buffer).
   4574 %fn(prim_string_length_entry, 0, {
   4575     %car(t0, a0)
   4576     %heap_ld(a0, t0, %BV.data)
   4577     %call(&libp1pp__strlen)
   4578     %mkfix(a0, a0)
   4579     %eret
   4580 })
   4581 
   4582 :prim_bv_u8_ref_entry
   4583 .scope
   4584     %args2(t0, t1, a0)      ; bv, tagged idx
   4585     %sari(t1, t1, 3)        ; raw idx
   4586     %bltz(t1, &.oob)
   4587     %heap_ld(a0, t0, %BV.hdr)
   4588     %shri(a0, a0, 8)        ; length
   4589     %bltu(t1, a0, &.ok)
   4590     :.oob
   4591     %die(msg_bv_oob)
   4592     :.ok
   4593     %heap_ld(t2, t0, %BV.data)
   4594     %add(t2, t2, t1)
   4595     %lb(a0, t2, 0)
   4596     %mkfix(a0, a0)
   4597     %ret
   4598 .endscope
   4599 
   4600 :prim_bv_u8_set_entry
   4601 .scope
   4602     %args3(t0, t2, t1, a0)  ; bv, idx, val
   4603     %sari(t2, t2, 3)        ; raw idx
   4604     %sari(t1, t1, 3)        ; raw val
   4605     %bltz(t2, &.oob)
   4606     %heap_ld(a0, t0, %BV.hdr)
   4607     %shri(a0, a0, 8)        ; length
   4608     %bltu(t2, a0, &.ok)
   4609     :.oob
   4610     %die(msg_bv_oob)
   4611     :.ok
   4612     %heap_ld(a0, t0, %BV.data)
   4613     %add(a0, a0, t2)
   4614     %sb(t1, a0, 0)
   4615     %li(a0, %imm_val(%IMM.UNSPEC))
   4616     %ret
   4617 .endscope
   4618 
   4619 # (bytevector-copy src start end) -> fresh bv of length end-start.
   4620 # Bounds: 0 <= start <= end <= src.length.
   4621 #
   4622 # Locals:
   4623 #   args
   4624 #   src  tagged
   4625 #   wrapper  (saved after bv_alloc)
   4626 %gcfn2(prim_bv_copy_entry, {args src wrapper}, 7, 0, {
   4627     %stl(a0, args)
   4628 
   4629     %args3(t0, t2, t1, a0)  ; src, start, end
   4630     %stl(t0, src)
   4631     %sari(t2, t2, 3)        ; raw start
   4632     %sari(t1, t1, 3)        ; raw end
   4633 
   4634     # Bounds: start >= 0; end >= start (signed catches negative end since
   4635     # start is now non-negative); src.length >= end.
   4636     %bltz(t2, &.oob)
   4637     %blt(t1, t2, &.oob)
   4638     %heap_ld(a0, t0, %BV.hdr)
   4639     %shri(a0, a0, 8)        ; src.length
   4640     %blt(a0, t1, &.oob)
   4641 
   4642     %sub(a0, t1, t2)        ; count
   4643     %call(&bv_alloc)
   4644     %stl(a0, wrapper)
   4645 
   4646     # Recompute src ptr at start; dst ptr at 0; count from new bv's hdr.
   4647     %ldl(t0, args)
   4648     %cdr(t0, t0)
   4649     %car_fix(t0, t0)        ; raw start
   4650     %ldl(t1, src)
   4651     %heap_ld(t2, t1, %BV.data)
   4652     %add(t2, t2, t0)        ; src ptr
   4653     %ldl(a3, wrapper)
   4654     %heap_ld(a2, a3, %BV.data)  ; dst ptr
   4655     %heap_ld(a1, a3, %BV.hdr)
   4656     %shri(a1, a1, 8)        ; count
   4657 
   4658     :.copy_loop
   4659     %beqz(a1, &.copy_done)
   4660     %lb(t0, t2, 0)
   4661     %sb(t0, a2, 0)
   4662     %addi(t2, t2, 1)
   4663     %addi(a2, a2, 1)
   4664     %addi(a1, a1, -1)
   4665     %b(&.copy_loop)
   4666 
   4667     :.copy_done
   4668     %ldl(a0, wrapper)
   4669     %gceret
   4670 
   4671     :.oob
   4672     %die(msg_bv_oob)
   4673 })
   4674 
   4675 # (bytevector-copy! dst dst-start src src-start src-end). Bounds:
   4676 # 0 <= src-start <= src-end <= src.length and
   4677 # 0 <= dst-start && dst-start + (src-end-src-start) <= dst.length.
   4678 #
   4679 # Locals:
   4680 #   dst  -start (raw)
   4681 #   dst_start
   4682 #   src  -end (raw)
   4683 #   src_start
   4684 #   src_end
   4685 %fn2(prim_bv_copy_bang_entry, {dst dst_start src src_start src_end}, {
   4686     %car(t0, a0)
   4687     %stl(t0, dst)              ; dst
   4688     %cdr(a0, a0)
   4689     %car(t0, a0)
   4690     %sari(t0, t0, 3)
   4691     %stl(t0, dst_start)              ; dst-start
   4692     %cdr(a0, a0)
   4693     %car(t0, a0)
   4694     %stl(t0, src)             ; src
   4695     %cdr(a0, a0)
   4696     %car(t0, a0)
   4697     %sari(t0, t0, 3)
   4698     %stl(t0, src_start)             ; src-start
   4699     %cdr(a0, a0)
   4700     %car(t0, a0)
   4701     %sari(t0, t0, 3)
   4702     %stl(t0, src_end)             ; src-end
   4703 
   4704     # src-start >= 0
   4705     %ldl(t0, src_start)
   4706     %bltz(t0, &.oob)
   4707     # src-end >= src-start (signed catches negative src-end)
   4708     %ldl(t1, src_end)
   4709     %blt(t1, t0, &.oob)
   4710     # src-end <= src.length
   4711     %ldl(t2, src)
   4712     %heap_ld(a0, t2, %BV.hdr)
   4713     %shri(a0, a0, 8)
   4714     %blt(a0, t1, &.oob)
   4715     # dst-start >= 0
   4716     %ldl(t2, dst_start)
   4717     %bltz(t2, &.oob)
   4718     # dst-start + count <= dst.length
   4719     %sub(a0, t1, t0)            ; count = src-end - src-start
   4720     %add(a0, a0, t2)            ; dst-start + count
   4721     %ldl(t1, dst)
   4722     %heap_ld(t2, t1, %BV.hdr)
   4723     %shri(t2, t2, 8)
   4724     %blt(t2, a0, &.oob)
   4725 
   4726     # Set up copy. dst ptr = dst.data + dst-start; src ptr = src.data +
   4727     # src-start; count = src-end - src-start.
   4728     %ldl(t0, dst)
   4729     %heap_ld(t0, t0, %BV.data)
   4730     %ldl(a1, dst_start)
   4731     %add(t0, t0, a1)            ; dst ptr
   4732     %ldl(a1, src)
   4733     %heap_ld(a1, a1, %BV.data)
   4734     %ldl(a2, src_start)
   4735     %add(a1, a1, a2)            ; src ptr
   4736     %ldl(a3, src_end)
   4737     %sub(a3, a3, a2)            ; count
   4738 
   4739     :.loop
   4740         %beqz(a3, &.done)
   4741         %lb(t1, a1, 0)
   4742         %sb(t1, t0, 0)
   4743         %addi(t0, t0, 1)
   4744         %addi(a1, a1, 1)
   4745         %addi(a3, a3, -1)
   4746     %b(&.loop)
   4747 
   4748     :.done
   4749     %li(a0, %imm_val(%IMM.UNSPEC))
   4750     %eret
   4751 
   4752     :.oob
   4753     %die(msg_bv_oob)
   4754 })
   4755 
   4756 # bv_equal_check(a=a0, b=a1) -> a0 (IMM.TRUE / IMM.FALSE). Leaf. Both
   4757 # arguments are assumed to be HEAP-tagged HDR.BV values; callers do the
   4758 # type check (either bytevector=?'s prim entry or equal_recurse's BV
   4759 # branch). Compares lengths first, then walks bytes; %lb is zero-extending
   4760 # on every backend, so a single %bne is enough for the byte test.
   4761 :bv_equal_check
   4762 .scope
   4763     %heap_ld(t0, a0, %BV.hdr)
   4764     %shri(t0, t0, 8)            ; len_a
   4765     %heap_ld(t1, a1, %BV.hdr)
   4766     %shri(t1, t1, 8)            ; len_b
   4767     %bne(t0, t1, &.false)
   4768 
   4769     %heap_ld(a2, a0, %BV.data)
   4770     %heap_ld(a3, a1, %BV.data)
   4771 
   4772     :.loop
   4773         %beqz(t0, &.true)
   4774         %lb(t1, a2, 0)
   4775         %lb(t2, a3, 0)
   4776         %bne(t1, t2, &.false)
   4777         %addi(a2, a2, 1)
   4778         %addi(a3, a3, 1)
   4779         %addi(t0, t0, -1)
   4780     %b(&.loop)
   4781 
   4782     :.true
   4783     %li(a0, %imm_val(%IMM.TRUE))
   4784     %ret
   4785 
   4786     :.false
   4787     %li(a0, %imm_val(%IMM.FALSE))
   4788     %ret
   4789 .endscope
   4790 
   4791 # (bytevector=? a b) -- structural equality on bytevectors. Non-bv
   4792 # inputs return #f rather than aborting, matching the lax stance the
   4793 # other predicates take until LISP.md pins a stricter policy.
   4794 :prim_bytevector_eq_entry
   4795 .scope
   4796     %args2(t0, t1, a0)
   4797     %tagof(t2, t0)
   4798     %li(a0, %TAG.HEAP)
   4799     %bne(t2, a0, &.false)
   4800     %tagof(t2, t1)
   4801     %bne(t2, a0, &.false)
   4802     %hdr_type(t2, t0)
   4803     %li(a0, %HDR.BV)
   4804     %bne(t2, a0, &.false)
   4805     %hdr_type(t2, t1)
   4806     %bne(t2, a0, &.false)
   4807     %mov(a0, t0)
   4808     %mov(a1, t1)
   4809     %b(&bv_equal_check)
   4810     :.false
   4811     %li(a0, %imm_val(%IMM.FALSE))
   4812     %ret
   4813 .endscope
   4814 
   4815 # equal_recurse(a=a0, b=a1) -> a0 (IMM.TRUE / IMM.FALSE). Identity covers
   4816 # fixnums, symbols, immediates, and any case where both arguments are the
   4817 # same heap or pair pointer. For non-identical pair pointers we recurse
   4818 # into car then cdr; for non-identical heap pointers we structural-equal
   4819 # only when both are HDR.BV (closures, prims, records, and TDs are
   4820 # identity-only). Tail-calls the cdr-side recursion and the BV check.
   4821 #
   4822 # Locals:
   4823 #   a
   4824 #   b
   4825 %fn2(equal_recurse, {a b}, {
   4826     %stl(a0, a)
   4827     %stl(a1, b)
   4828 
   4829     %beq(a0, a1, &.true)
   4830 
   4831     %tagof(t0, a0)
   4832     %tagof(t1, a1)
   4833     %bne(t0, t1, &.false)
   4834 
   4835     %bieq(t0, %TAG.PAIR, &.pair, t1)
   4836     %bieq(t0, %TAG.HEAP, &.heap, t1)
   4837     %b(&.false)
   4838 
   4839     :.pair
   4840     %ldl(t0, a)
   4841     %ldl(t1, b)
   4842     %car(a0, t0)
   4843     %car(a1, t1)
   4844     %call(&equal_recurse)
   4845     %bieq(a0, %imm_val(%IMM.FALSE), &.done, t0)
   4846     %ldl(t0, a)
   4847     %ldl(t1, b)
   4848     %cdr(a0, t0)
   4849     %cdr(a1, t1)
   4850     %tail(&equal_recurse)
   4851 
   4852     :.heap
   4853     %ldl(t0, a)
   4854     %ldl(t1, b)
   4855     %hdr_type(t2, t0)
   4856     %hdr_type(a0, t1)
   4857     %bne(t2, a0, &.false)      ; differing heap classes -> #f
   4858     %li(a0, %HDR.BV)
   4859     %beq(t2, a0, &.heap_bv)
   4860     %li(a0, %HDR.REC)
   4861     %beq(t2, a0, &.heap_rec)
   4862     %b(&.false)                 ; CLOSURE/PRIM/TD: identity-only
   4863 
   4864     :.heap_bv
   4865     %mov(a0, t0)
   4866     %mov(a1, t1)
   4867     %tail(&bv_equal_check)
   4868 
   4869     :.heap_rec
   4870     %mov(a0, t0)
   4871     %mov(a1, t1)
   4872     %tail(&rec_equal_check)
   4873 
   4874     :.true
   4875     %li(a0, %imm_val(%IMM.TRUE))
   4876     %b(&.done)
   4877 
   4878     :.false
   4879     %li(a0, %imm_val(%IMM.FALSE))
   4880 
   4881     :.done
   4882 })
   4883 
   4884 # rec_equal_check(a=a0, b=a1) -> a0 (IMM.TRUE / IMM.FALSE). Both args
   4885 # are HEAP-tagged HDR.REC. Records are equal iff their TDs are eq? and
   4886 # every field is equal? (recursing through equal_recurse). Field i sits
   4887 # at tagged + 13 + 8*i; nfields lives at the TD's offset 13 (raw).
   4888 #
   4889 # Locals:
   4890 #   a  (rec, tagged)
   4891 #   b  (rec, tagged)
   4892 #   i  (raw counter)
   4893 #   nfields  (raw)
   4894 %fn2(rec_equal_check, {a b i nfields}, {
   4895     %stl(a0, a)
   4896     %stl(a1, b)
   4897 
   4898     %heap_ld(t0, a0, %REC.td)   ; td_a
   4899     %heap_ld(t1, a1, %REC.td)   ; td_b
   4900     %bne(t0, t1, &.false)
   4901 
   4902     %heap_ld(t1, t0, %TD.nfields)
   4903     %stl(t1, nfields)
   4904     %li(t0, 0)
   4905     %stl(t0, i)              ; i = 0
   4906 
   4907     :.loop
   4908     %ldl(t0, i)
   4909     %ldl(t1, nfields)
   4910     %beq(t0, t1, &.true)
   4911 
   4912     %shli(t2, t0, 3)
   4913     %addi(t2, t2, 13)            ; field offset = 13 + 8*i
   4914     %ldl(t1, a)
   4915     %add(t1, t1, t2)
   4916     %ld(a0, t1, 0)               ; a's field i
   4917     %ldl(t1, b)
   4918     %add(t1, t1, t2)
   4919     %ld(a1, t1, 0)               ; b's field i
   4920     %call(&equal_recurse)
   4921     %bieq(a0, %imm_val(%IMM.FALSE), &.done, t0)
   4922 
   4923     %ldl(t0, i)
   4924     %addi(t0, t0, 1)
   4925     %stl(t0, i)
   4926     %b(&.loop)
   4927 
   4928     :.true
   4929     %li(a0, %imm_val(%IMM.TRUE))
   4930     %b(&.done)
   4931 
   4932     :.false
   4933     %li(a0, %imm_val(%IMM.FALSE))
   4934 
   4935     :.done
   4936 })
   4937 
   4938 # (equal? a b) -- thin prim wrapper that unpacks the args list and falls
   4939 # into equal_recurse. equal_recurse owns the frame; this entry stays a
   4940 # leaf so the prim-dispatch tailr lands directly into the frame setup.
   4941 :prim_equal_entry
   4942     %args2(t0, t1, a0)
   4943     %mov(a0, t0)
   4944     %mov(a1, t1)
   4945     %b(&equal_recurse)
   4946 
   4947 # (apply fn rest...)  -- the trailing element of `rest` is a list; any
   4948 # leading elements get prepended to it. apply_build_args walks `rest` and
   4949 # returns the assembled args list; prim_apply_entry then tail-calls apply.
   4950 #
   4951 # `apply` is itself a primitive, so on entry here a0 holds (fn . rest)
   4952 # and a1 holds the apply PRIM ptr (per the convention documented at
   4953 # `apply::prim`). a1 is dead from this primitive's point of view; we
   4954 # clobber it freely while assembling args, then tail-call apply, which
   4955 # re-derives a1 from the callee fn it dispatches on. Outer convention
   4956 # stays intact end-to-end.
   4957 
   4958 %gcfn2(prim_apply_entry, {args pad}, 1, 0, {
   4959     %stl(a0, args)
   4960     %cdr(a0, a0)
   4961     %call(&apply_build_args)
   4962     %mov(t0, a0)
   4963     %ldl(a0, args)
   4964     %car(a0, a0)
   4965     %mov(a1, t0)
   4966     %gctail(&apply)
   4967 })
   4968 
   4969 # apply_build_args(rest=a0) -> assembled args list.
   4970 # `rest` is (a1 a2 ... aN listargs); the trailing element is itself a list
   4971 # whose elements get appended after the leading aâ‚–'s. Iterative
   4972 # head/tail-cdr build: walk every cell whose cdr isn't NIL into a fresh
   4973 # (aâ‚– . NIL) cons; the final element (the trailing list) becomes the
   4974 # tail's cdr (or the result itself if there are no leading elements).
   4975 #
   4976 # Locals:
   4977 #   walk  (advances; current cell of rest)
   4978 #   head  (NIL until first leading arg appended)
   4979 #   tail  (most recent cell; set-cdr! target)
   4980 %gcfn2(apply_build_args, {walk head tail}, 7, 0, {
   4981     %stl(a0, walk)
   4982     %li(t0, %imm_val(%IMM.NIL))
   4983     %stl(t0, head)
   4984     %stl(t0, tail)
   4985 
   4986     :.loop
   4987         %ldl(t0, walk)
   4988         %cdr(t1, t0)
   4989         %if_nil(t2, t1, &.last)
   4990 
   4991         # cell = cons(car(walk), NIL); append to head/tail.
   4992         %car(a0, t0)
   4993         %li(a1, %imm_val(%IMM.NIL))
   4994         %call(&cons)
   4995 
   4996         %ldl(t0, head)
   4997         %if_nil(t1, t0, &.first)
   4998         %ldl(t0, tail)
   4999         %set_cdr(a0, t0)
   5000         %stl(a0, tail)
   5001         %b(&.advance)
   5002 
   5003         :.first
   5004         %stl(a0, head)
   5005         %stl(a0, tail)
   5006 
   5007         :.advance
   5008         %advance_walk(walk)
   5009         %b(&.loop)
   5010 
   5011     :.last
   5012     # car(walk) is the trailing list. If head is NIL there were no leading
   5013     # args -- return the trailing list directly. Otherwise splice it onto
   5014     # the tail and return head.
   5015     %car(a0, t0)
   5016     %ldl(t1, head)
   5017     %if_nil(t2, t1, &.done)
   5018     %ldl(t1, tail)
   5019     %set_cdr(a0, t1)
   5020     %ldl(a0, head)
   5021 
   5022     :.done
   5023 })
   5024 
   5025 # Records: TDs (type descriptors) and instances. A TD is a 24-byte heap
   5026 # object [HDR.TD][name_sym][nfields_raw]. A record is a variable-width
   5027 # heap object [HDR.REC][td][field_0]...[field_{n-1}], so field i lives at
   5028 # tagged + 13 + 8*i. define-record-type allocates one TD plus one
   5029 # parameterized PRIM per ctor/predicate/accessor/mutator, all pointing
   5030 # into the same TD via the prim's data slot.
   5031 
   5032 # make_param_prim(entry=a0, data=a1) -> prim (a0). Allocates a 24-byte
   5033 # PRIM and sets the entry label and data word. Generated primitives stay
   5034 # reachable through their global bindings.
   5035 
   5036 %gcfn2(make_param_prim, {entry data}, 2, 0, {
   5037     %stl(a0, entry)
   5038     %stl(a1, data)
   5039 
   5040     %li(a0, 24)
   5041     %li(a1, %HDR.PRIM)
   5042     %call(&alloc_hdr)
   5043 
   5044     %ldl(t0, entry)
   5045     %heap_st(t0, a0, %PRIM.entry_w)
   5046     %ldl(t1, data)
   5047     %heap_st(t1, a0, %PRIM.data)
   5048 })
   5049 
   5050 # Parameterized PRIM entries used by define-record-type. Each receives
   5051 # args in a0 and the prim itself in a1; the prim's data slot (offset 13
   5052 # from tagged) holds either the TD or a tagged field index. The
   5053 # constructor inlines record allocation; predicate / accessor / mutator
   5054 # inline what would otherwise be %record-is-a? / %record-ref /
   5055 # %record-set! bodies. None of these primitives are exposed at the
   5056 # user level — R7RS define-record-type binds only ctor / pred /
   5057 # accessor / mutator names.
   5058 
   5059 # ctor: prim.data = TD (HEAP); args = (f0 f1 ...). Inlines the
   5060 # %make-record body so we don't have to cons (TD . args) first.
   5061 
   5062 %gcfn2(prim_ctor_entry, {args td record}, 7, 0, {
   5063     %stl(a0, args)
   5064     %heap_ld(t0, a1, %PRIM.data)
   5065     %stl(t0, td)
   5066 
   5067     # Count = length(args).
   5068     %call(&list_length)
   5069     %shli(a0, a0, 3)
   5070     %addi(a0, a0, 16)
   5071     %li(a1, %HDR.REC)
   5072     %call(&alloc_hdr)
   5073     %stl(a0, record)
   5074 
   5075     %ldl(t0, td)
   5076     %heap_st(t0, a0, %REC.td)
   5077 
   5078     %ldl(t0, args)
   5079     %addi(t1, a0, 13)
   5080 
   5081     :.fill_loop
   5082         %if_nil(t2, t0, &.fill_done)
   5083         %car(t2, t0)
   5084         %st(t2, t1, 0)
   5085         %addi(t1, t1, 8)
   5086         %cdr(t0, t0)
   5087         %b(&.fill_loop)
   5088     :.fill_done
   5089 
   5090     %ldl(a0, record)
   5091 })
   5092 
   5093 # predicate: prim.data = TD; args = (rec).
   5094 :prim_predicate_entry
   5095 .scope
   5096     %car(t0, a0)
   5097     %heap_ld(t1, a1, %PRIM.data)
   5098     %tagof(t2, t0)
   5099     %li(a0, %imm_val(%IMM.FALSE))
   5100     %bine(t2, %TAG.HEAP, &.end, a2)
   5101     %hdr_type(t2, t0)
   5102     %bine(t2, %HDR.REC,  &.end, a2)
   5103     %heap_ld(t2, t0, %REC.td)
   5104     %bne(t2, t1, &.end)
   5105     %li(a0, %imm_val(%IMM.TRUE))
   5106     :.end
   5107     %ret
   5108 .endscope
   5109 
   5110 # accessor: prim.data = tagged field index; args = (rec).
   5111 :prim_accessor_entry
   5112     %car(t0, a0)
   5113     %heap_ld(t1, a1, %PRIM.data)
   5114     %addi(t1, t1, 13)
   5115     %add(t1, t1, t0)
   5116     %ld(a0, t1, 0)
   5117     %ret
   5118 
   5119 # mutator: prim.data = tagged field index; args = (rec val).
   5120 :prim_mutator_entry
   5121 .scope
   5122     %car(t0, a0)
   5123     %cdr(t1, a0)
   5124     %car(t1, t1)
   5125     %heap_ld(t2, a1, %PRIM.data)
   5126     %addi(t2, t2, 13)
   5127     %add(t2, t2, t0)
   5128     %st(t1, t2, 0)
   5129     %li(a0, %imm_val(%IMM.UNSPEC))
   5130     %ret
   5131 .endscope
   5132 
   5133 # eval_define_record_type(rest=a0, env=a1) -> UNSPEC.
   5134 # rest = (name (ctor f1 ...) pred clause1 clause2 ...)
   5135 # Each clause is (field-name accessor) or (field-name accessor mutator).
   5136 # Allocates one TD + one parameterized PRIM per name introduced (ctor,
   5137 # predicate, accessor, mutator) and binds each to the symbol's global.
   5138 # The TD also stores a list of field-name symbols in declaration order;
   5139 # pmatch's ($ pred (field pat) ...) record pattern uses this to map
   5140 # field names to indices at match time.
   5141 #
   5142 # Locals:
   5143 #   rest
   5144 #   env  (unused, but the dispatcher passes it)
   5145 #   td
   5146 #   walk  (clauses, advancing)
   5147 #   idx  (raw counter)
   5148 #   nfields
   5149 #   fl_head  (head of field-name list under construction)
   5150 #   fl_tail  (tail cell of field-name list under construction)
   5151 #   fl_cur   (cursor walking clauses for field-name pre-pass)
   5152 %gcfn2(eval_define_record_type, {rest env td walk idx nfields fl_head fl_tail fl_cur}, 463, 0, {
   5153     %stl(a0, rest)
   5154     %stl(a1, env)
   5155 
   5156     # clauses = cdddr(rest); count them via list_length.
   5157     %ldl(a0, rest)
   5158     %cdr(a0, a0)
   5159     %cdr(a0, a0)
   5160     %cdr(a0, a0)
   5161     %stl(a0, walk)
   5162     %call(&list_length)
   5163     %stl(a0, nfields)
   5164 
   5165     # td = alloc_hdr(TD.SIZE, HDR.TD); td.name = type-name;
   5166     # td.nfields = nfields; td.fields = NIL (filled below).
   5167     %li(a0, %TD.SIZE)
   5168     %li(a1, %HDR.TD)
   5169     %call(&alloc_hdr)
   5170     %stl(a0, td)
   5171     %ldl(t0, rest)
   5172     %car(t0, t0)
   5173     %heap_st(t0, a0, %TD.name)
   5174     %ldl(t1, nfields)
   5175     %heap_st(t1, a0, %TD.nfields)
   5176     %li(t1, %imm_val(%IMM.NIL))
   5177     %heap_st(t1, a0, %TD.fields)
   5178 
   5179     # Pre-pass: build (field-name-1 ... field-name-N) in declaration order
   5180     # via head/tail accumulator, then store at td.fields. Each clause's
   5181     # car is the field-name symbol. Uses fl_cur as a separate cursor so
   5182     # walk is left intact for the accessor-binding loop below.
   5183     %li(t0, %imm_val(%IMM.NIL))
   5184     %stl(t0, fl_head)
   5185     %stl(t0, fl_tail)
   5186     %ldl(t0, walk)
   5187     %stl(t0, fl_cur)
   5188 
   5189     :.fl_loop
   5190     %ldl(t0, fl_cur)
   5191     %if_nil(t1, t0, &.fl_done)
   5192     # cell = cons(car(car(fl_cur)), NIL)
   5193     %car(t1, t0)
   5194     %car(a0, t1)
   5195     %li(a1, %imm_val(%IMM.NIL))
   5196     %call(&cons)
   5197     # Splice into list: if head is NIL, head = tail = cell.
   5198     # Else set-cdr!(tail, cell); tail = cell.
   5199     %ldl(t1, fl_head)
   5200     %bine(t1, %imm_val(%IMM.NIL), &.fl_append, t2)
   5201     %stl(a0, fl_head)
   5202     %stl(a0, fl_tail)
   5203     %b(&.fl_next)
   5204     :.fl_append
   5205     %ldl(t1, fl_tail)
   5206     %set_cdr(a0, t1)
   5207     %stl(a0, fl_tail)
   5208     :.fl_next
   5209     %ldl(t0, fl_cur)
   5210     %cdr(t0, t0)
   5211     %stl(t0, fl_cur)
   5212     %b(&.fl_loop)
   5213 
   5214     :.fl_done
   5215     %ldl(t0, td)
   5216     %ldl(t1, fl_head)
   5217     %heap_st(t1, t0, %TD.fields)
   5218 
   5219     # ctor-prim = make_param_prim(prim_ctor_entry, td); bind ctor-name.
   5220     %la(a0, &prim_ctor_entry)
   5221     %ldl(a1, td)
   5222     %call(&make_param_prim)
   5223     %ldl(t0, rest)
   5224     %cdr(t0, t0)
   5225     %car(t0, t0)
   5226     %car(t0, t0)
   5227     %set_global(t0, a0)
   5228 
   5229     # pred-prim = make_param_prim(prim_predicate_entry, td); bind pred.
   5230     %la(a0, &prim_predicate_entry)
   5231     %ldl(a1, td)
   5232     %call(&make_param_prim)
   5233     %ldl(t0, rest)
   5234     %cdr(t0, t0)
   5235     %cdr(t0, t0)
   5236     %car(t0, t0)
   5237     %set_global(t0, a0)
   5238 
   5239     # Iterate clauses: bind accessor + optional mutator per clause.
   5240     %li(t0, 0)
   5241     %stl(t0, idx)
   5242 
   5243     :.clause_loop
   5244     %ldl(t0, walk)
   5245     %if_nil(t1, t0, &.done)
   5246 
   5247     # accessor-prim with data = tagged idx; bind cadr(clause).
   5248     %ldl(a1, idx)
   5249     %mkfix(a1, a1)
   5250     %la(a0, &prim_accessor_entry)
   5251     %call(&make_param_prim)
   5252 
   5253     %ldl(t0, walk)
   5254     %car(t0, t0)
   5255     %cdr(t0, t0)
   5256     %car(t0, t0)
   5257     %set_global(t0, a0)
   5258 
   5259     # Mutator? If cddr(clause) is a pair, bind it.
   5260     %ldl(t0, walk)
   5261     %car(t0, t0)
   5262     %cdr(t0, t0)
   5263     %cdr(t0, t0)
   5264     %if_nil(t1, t0, &.no_mutator)
   5265 
   5266     %ldl(a1, idx)
   5267     %mkfix(a1, a1)
   5268     %la(a0, &prim_mutator_entry)
   5269     %call(&make_param_prim)
   5270 
   5271     %ldl(t0, walk)
   5272     %car(t0, t0)
   5273     %cdr(t0, t0)
   5274     %cdr(t0, t0)
   5275     %car(t0, t0)
   5276     %set_global(t0, a0)
   5277 
   5278     :.no_mutator
   5279     %advance_walk(walk)
   5280     %ldl(t0, idx)
   5281     %addi(t0, t0, 1)
   5282     %stl(t0, idx)
   5283     %b(&.clause_loop)
   5284 
   5285     :.done
   5286     %li(a0, %imm_val(%IMM.UNSPEC))
   5287 })
   5288 
   5289 # =========================================================================
   5290 # Writer -- display, write, format, error
   5291 # =========================================================================
   5292 #
   5293 # All four entry points walk values through a single recursive writer
   5294 # that appends bytes into an output bytevector. display / write call the
   5295 # writer once, then sys_write the resulting bytes to stdout. error
   5296 # prepends `scheme1: error: `, joins irritants with spaces, and tails
   5297 # into runtime_error so the prefix stays consistent with every other
   5298 # abort path. format walks a template bv, emitting raw bytes verbatim
   5299 # and dispatching ~a (display), ~s (write), ~d (decimal), ~% (newline),
   5300 # and ~~ (literal '~') against successive args.
   5301 #
   5302 # Mode flag for write_to_bv: 0 = display (bytevectors emit raw), 1 =
   5303 # write (bytevectors emit "..." with a leading and trailing double quote;
   5304 # escapes are not handled because string literals are not yet supported).
   5305 #
   5306 # bv_putn / bv_putc / bv_putint append raw bytes to a bv and return the
   5307 # (same wrapper, possibly-grown) bv. They do NOT maintain a trailing NUL
   5308 # -- callers building "strings" must use the str_* family below.
   5309 # bv_grow patches data_ptr/capacity in place, so the wrapper pointer
   5310 # never changes -- callers can keep a stable handle in a single frame
   5311 # slot.
   5312 
   5313 # bv_putn(bv=a0, src=a1, n=a2) -> bv (a0). Append n bytes from src to bv,
   5314 # growing the data buffer when capacity falls short. Raw u8[] semantics:
   5315 # the byte at index `length` after append is unspecified.
   5316 
   5317 %gcfn2(bv_putn, {bv src n old_len}, 1, 2, {
   5318     %stl(a0, bv)
   5319     %stl(a1, src)
   5320     %stl(a2, n)
   5321 
   5322     %heap_ld(t0, a0, %BV.hdr)
   5323     %shri(t0, t0, 8)            ; old_len
   5324     %stl(t0, old_len)
   5325 
   5326     # bv_grow ensures cap >= old_len + n.
   5327     %add(a1, t0, a2)
   5328     %call(&bv_grow)
   5329 
   5330     %ldl(t0, bv)
   5331     %heap_ld(a0, t0, %BV.data)
   5332     %ldl(t1, old_len)
   5333     %add(a0, a0, t1)            ; dst = data + old_len
   5334     %ldl(a1, src)
   5335     %ldl(a2, n)
   5336     %call(&memcpy)
   5337 
   5338     # hdr = (old_len + n) << 8 | HDR.BV. HDR.BV is 0.
   5339     %ldl(t0, old_len)
   5340     %ldl(t1, n)
   5341     %add(t0, t0, t1)
   5342     %shli(t0, t0, 8)
   5343     %ldl(t1, bv)
   5344     %heap_st(t0, t1, %BV.hdr)
   5345 
   5346     %ldl(a0, bv)
   5347 })
   5348 
   5349 # bv_putc(bv=a0, byte=a1) -> bv (a0). Append a single byte (low 8 bits
   5350 # of a1). Same growth + length-update protocol as bv_putn; no NUL.
   5351 
   5352 %gcfn2(bv_putc, {bv byte}, 1, 0, {
   5353     %stl(a0, bv)
   5354     %stl(a1, byte)
   5355 
   5356     %heap_ld(t0, a0, %BV.hdr)
   5357     %shri(t0, t0, 8)            ; old_len
   5358     %addi(a1, t0, 1)             ; min_cap = old_len + 1
   5359     %call(&bv_grow)
   5360 
   5361     %ldl(t0, bv)
   5362     %heap_ld(t1, t0, %BV.hdr)
   5363     %shri(t1, t1, 8)            ; old_len (re-read after grow)
   5364     %heap_ld(t2, t0, %BV.data)
   5365     %add(t2, t2, t1)
   5366     %ldl(a0, byte)
   5367     %sb(a0, t2, 0)
   5368 
   5369     %addi(t1, t1, 1)
   5370     %shli(t1, t1, 8)
   5371     %heap_st(t1, t0, %BV.hdr)
   5372 
   5373     %ldl(a0, bv)
   5374 })
   5375 
   5376 # bv_putint(bv=a0, value=a1) -> bv (a0). Append decimal repr of (raw,
   5377 # untagged) value. Uses :writer_num_buf as a 24-byte scratch buffer
   5378 # (fmt_dec writes at most 20 bytes for a 64-bit signed integer).
   5379 
   5380 %gcfn2(bv_putint, {bv pad}, 1, 0, {
   5381     %stl(a0, bv)
   5382 
   5383     %la(a0, &writer_num_buf)
   5384     %call(&fmt_dec)              ; n_bytes (a0)
   5385 
   5386     %mov(a2, a0)
   5387     %la(a1, &writer_num_buf)
   5388     %ldl(a0, bv)
   5389     %gctail(&bv_putn)
   5390 })
   5391 
   5392 # String writers: identical to bv_putn / bv_putc / bv_putint except they
   5393 # guarantee cap > length AND data[length] == 0 on return. Required for
   5394 # any bv whose data_ptr is later read as a C string (syscall paths,
   5395 # runtime_error). The explicit zero is necessary because a fresh data
   5396 # buffer may come from a reused block carrying stale bytes.
   5397 
   5398 # str_alloc(raw_len=a0) -> tagged bv (a0). Like bv_alloc, but cap >
   5399 # raw_len and data[raw_len] = 0.
   5400 %gcfn2(str_alloc, {raw_len bv}, 2, 0, {
   5401     %stl(a0, raw_len)
   5402     %addi(a0, a0, 1)             ; reserve a NUL slot
   5403     %call(&bv_alloc)
   5404     %stl(a0, bv)
   5405 
   5406     # Patch hdr length back down to raw_len.
   5407     %ldl(t0, raw_len)
   5408     %shli(t0, t0, 8)             ; HDR.BV is 0
   5409     %heap_st(t0, a0, %BV.hdr)
   5410 
   5411     # Zero data[raw_len].
   5412     %heap_ld(t1, a0, %BV.data)
   5413     %ldl(t2, raw_len)
   5414     %add(t1, t1, t2)
   5415     %li(t0, 0)
   5416     %sb(t0, t1, 0)
   5417 
   5418     %ldl(a0, bv)
   5419 })
   5420 
   5421 # str_putn(bv=a0, src=a1, n=a2) -> bv (a0). Append n bytes; on return
   5422 # cap > new_len and data[new_len] == 0.
   5423 %gcfn2(str_putn, {bv src n}, 1, 2, {
   5424     %stl(a0, bv)
   5425     %stl(a1, src)
   5426     %stl(a2, n)
   5427 
   5428     # Pre-grow so the post-append buffer has a NUL slot.
   5429     %heap_ld(t0, a0, %BV.hdr)
   5430     %shri(t0, t0, 8)             ; old_len
   5431     %add(a1, t0, a2)
   5432     %addi(a1, a1, 1)             ; min_cap = old_len + n + 1
   5433     %call(&bv_grow)
   5434 
   5435     %ldl(a0, bv)
   5436     %ldl(a1, src)
   5437     %ldl(a2, n)
   5438     %call(&bv_putn)              ; appends + updates length
   5439 
   5440     # Zero data[new_len]. bv_putn left cap and data_ptr alone, so the
   5441     # NUL slot reserved above is still ours.
   5442     %heap_ld(t0, a0, %BV.hdr)
   5443     %shri(t0, t0, 8)             ; new_len
   5444     %heap_ld(t1, a0, %BV.data)
   5445     %add(t1, t1, t0)
   5446     %li(t2, 0)
   5447     %sb(t2, t1, 0)
   5448 })
   5449 
   5450 # str_putc(bv=a0, byte=a1) -> bv (a0). Append one byte; cap > new_len
   5451 # and data[new_len] == 0 on return.
   5452 %gcfn2(str_putc, {bv byte}, 1, 0, {
   5453     %stl(a0, bv)
   5454     %stl(a1, byte)
   5455 
   5456     %heap_ld(t0, a0, %BV.hdr)
   5457     %shri(t0, t0, 8)             ; old_len
   5458     %addi(a1, t0, 2)             ; min_cap = old_len + 1 + 1
   5459     %call(&bv_grow)
   5460 
   5461     %ldl(a0, bv)
   5462     %ldl(a1, byte)
   5463     %call(&bv_putc)
   5464 
   5465     %heap_ld(t0, a0, %BV.hdr)
   5466     %shri(t0, t0, 8)             ; new_len
   5467     %heap_ld(t1, a0, %BV.data)
   5468     %add(t1, t1, t0)
   5469     %li(t2, 0)
   5470     %sb(t2, t1, 0)
   5471 })
   5472 
   5473 # str_putint(bv=a0, value=a1) -> bv (a0). Like bv_putint but tails into
   5474 # str_putn, so the result is NUL-terminated.
   5475 %gcfn2(str_putint, {bv pad}, 1, 0, {
   5476     %stl(a0, bv)
   5477 
   5478     %la(a0, &writer_num_buf)
   5479     %call(&fmt_dec)              ; n_bytes (a0)
   5480 
   5481     %mov(a2, a0)
   5482     %la(a1, &writer_num_buf)
   5483     %ldl(a0, bv)
   5484     %gctail(&str_putn)
   5485 })
   5486 
   5487 # str_puthex(bv=a0, value=a1) -> bv (a0). Signed hex: emits a leading
   5488 # '-' for negatives, then unsigned hex of |value| via fmt_hex. The bv
   5489 # wrapper pointer is stable across str_putc / str_putn (only the
   5490 # internal data buffer can move), so we reload it from the local.
   5491 %gcfn2(str_puthex, {bv value}, 1, 0, {
   5492     %stl(a0, bv)
   5493     %stl(a1, value)
   5494 
   5495     %bltz(a1, &.neg)
   5496     %b(&.pos)
   5497 
   5498     :.neg
   5499     %ldl(a0, bv)
   5500     %li(a1, 45)                  ; '-'
   5501     %call(&str_putc)
   5502     %ldl(t0, value)
   5503     %li(t1, 0)
   5504     %sub(t0, t1, t0)
   5505     %stl(t0, value)
   5506 
   5507     :.pos
   5508     %la(a0, &writer_num_buf)
   5509     %ldl(a1, value)
   5510     %call(&fmt_hex)              ; n_bytes (a0)
   5511 
   5512     %mov(a2, a0)
   5513     %la(a1, &writer_num_buf)
   5514     %ldl(a0, bv)
   5515     %gctail(&str_putn)
   5516 })
   5517 
   5518 # sym_name(idx=a0) -> (ptr=a0, len=a1). Leaf. idx is the untagged sym
   5519 # slot index; both fields come straight out of the symtab entry.
   5520 :sym_name
   5521     %ld_global(t0, &symtab_buf_ptr)
   5522     %lda_array(a1, t1, t0, %SYMENT.SIZE, a0, %SYMENT.name_len)
   5523     %ld(a0, t1, %SYMENT.name_ptr)
   5524     %ret
   5525 
   5526 # write_to_bv(val=a0, bv=a1, mode=a2) -> bv (a0). Recursively appends
   5527 # val's printed representation to bv. mode = 0 emits bytevectors as raw
   5528 # bytes (display); mode = 1 emits them as `"..."` (write). Pairs are
   5529 # delegated to write_pair_to_bv so the recursion through PAIR has its
   5530 # own frame.
   5531 #
   5532 # Output is treated as a string by callers (display / write / error /
   5533 # format), so all internal append calls go through the str_* family --
   5534 # the result has cap > length and a trailing NUL.
   5535 
   5536 %gcfn2(write_to_bv, {val bv mode pad}, 3, 0, {
   5537     %stl(a0, val)
   5538     %stl(a1, bv)
   5539     %stl(a2, mode)
   5540 
   5541     %tagof(t0, a0)
   5542     %bieq(t0, %TAG.PAIR, &.pair, t1)
   5543     %bieq(t0, %TAG.SYM,  &.sym,  t1)
   5544     %bieq(t0, %TAG.HEAP, &.heap, t1)
   5545     %bieq(t0, %TAG.IMM,  &.imm,  t1)
   5546 
   5547     # Fall-through: FIXNUM (the only remaining tag).
   5548     %ldl(a0, bv)
   5549     %ldl(a1, val)
   5550     %sari(a1, a1, 3)
   5551     %gctail(&str_putint)
   5552 
   5553     :.sym
   5554     %ldl(a0, val)
   5555     %sari(a0, a0, 3)
   5556     %call(&sym_name)
   5557     %mov(a2, a1)
   5558     %mov(a1, a0)
   5559     %ldl(a0, bv)
   5560     %gctail(&str_putn)
   5561 
   5562     :.pair
   5563     %ldl(a0, val)
   5564     %ldl(a1, bv)
   5565     %ldl(a2, mode)
   5566     %gctail(&write_pair_to_bv)
   5567 
   5568     :.heap
   5569     %hdr_type(t0, a0)
   5570     %bieq(t0, %HDR.BV,      &.heap_bv,      t1)
   5571     %bieq(t0, %HDR.CLOSURE, &.heap_closure, t1)
   5572     %bieq(t0, %HDR.PRIM,    &.heap_prim,    t1)
   5573     %bieq(t0, %HDR.TD,      &.heap_td,      t1)
   5574     %bieq(t0, %HDR.REC,     &.heap_rec,     t1)
   5575     %b(&.heap_unknown)
   5576 
   5577     :.heap_bv
   5578     %ldl(t0, mode)
   5579     %beqz(t0, &.heap_bv_raw)
   5580     # write mode: emit `"`, then the raw bytes, then `"`.
   5581     %ldl(a0, bv)
   5582     %li(a1, 34)
   5583     %call(&str_putc)
   5584     %ldl(t0, val)
   5585     %heap_ld(a1, t0, %BV.data)
   5586     %heap_ld(a2, t0, %BV.hdr)
   5587     %shri(a2, a2, 8)
   5588     %call(&str_putn)
   5589     %li(a1, 34)
   5590     %gctail(&str_putc)
   5591 
   5592     :.heap_bv_raw
   5593     %ldl(t0, val)
   5594     %heap_ld(a1, t0, %BV.data)
   5595     %heap_ld(a2, t0, %BV.hdr)
   5596     %shri(a2, a2, 8)
   5597     %ldl(a0, bv)
   5598     %gctail(&str_putn)
   5599 
   5600     :.heap_closure
   5601     %la(a1, &str_closure)
   5602     %li(a2, 10)
   5603     %ldl(a0, bv)
   5604     %gctail(&str_putn)
   5605 
   5606     :.heap_prim
   5607     %la(a1, &str_prim)
   5608     %li(a2, 7)
   5609     %ldl(a0, bv)
   5610     %gctail(&str_putn)
   5611 
   5612     :.heap_td
   5613     %la(a1, &str_td)
   5614     %li(a2, 11)
   5615     %ldl(a0, bv)
   5616     %gctail(&str_putn)
   5617 
   5618     :.heap_rec
   5619     %la(a1, &str_rec)
   5620     %li(a2, 9)
   5621     %ldl(a0, bv)
   5622     %gctail(&str_putn)
   5623 
   5624     :.heap_unknown
   5625     %la(a1, &str_unknown)
   5626     %li(a2, 10)
   5627     %ldl(a0, bv)
   5628     %gctail(&str_putn)
   5629 
   5630     :.imm
   5631     %ldl(a0, val)
   5632     %sari(a0, a0, 3)
   5633     %beqz(a0, &.imm_false)
   5634     %addi(t0, a0, -1)
   5635     %beqz(t0, &.imm_true)
   5636     %addi(t0, a0, -2)
   5637     %beqz(t0, &.imm_nil)
   5638     %addi(t0, a0, -3)
   5639     %beqz(t0, &.imm_unspec)
   5640     %addi(t0, a0, -4)
   5641     %beqz(t0, &.imm_unbound)
   5642     # EOF (idx == 5) is the only remaining IMM.
   5643     %la(a1, &str_eof)
   5644     %li(a2, 5)
   5645     %ldl(a0, bv)
   5646     %gctail(&str_putn)
   5647 
   5648     :.imm_false
   5649     %la(a1, &str_false)
   5650     %li(a2, 2)
   5651     %ldl(a0, bv)
   5652     %gctail(&str_putn)
   5653 
   5654     :.imm_true
   5655     %la(a1, &str_true)
   5656     %li(a2, 2)
   5657     %ldl(a0, bv)
   5658     %gctail(&str_putn)
   5659 
   5660     :.imm_nil
   5661     %la(a1, &str_nil)
   5662     %li(a2, 2)
   5663     %ldl(a0, bv)
   5664     %gctail(&str_putn)
   5665 
   5666     :.imm_unspec
   5667     %la(a1, &str_unspec)
   5668     %li(a2, 8)
   5669     %ldl(a0, bv)
   5670     %gctail(&str_putn)
   5671 
   5672     :.imm_unbound
   5673     %la(a1, &str_unbound)
   5674     %li(a2, 9)
   5675     %ldl(a0, bv)
   5676     %gctail(&str_putn)
   5677 })
   5678 
   5679 # write_pair_to_bv(pair=a0, bv=a1, mode=a2) -> bv (a0). Emits `(elt elt
   5680 # ...)` form, with `( . )` for non-list cdrs (dotted pair). The walker
   5681 # advances `pair` along the spine; cdr's tag determines whether we emit
   5682 # a separator and continue, emit ` . val)` for a dotted tail, or just
   5683 # emit `)` for a proper-list NIL.
   5684 #
   5685 # Locals:
   5686 #   pair  walk
   5687 #   bv  (stable wrapper; reused across recursive calls)
   5688 #   mode
   5689 #   pad
   5690 %gcfn2(write_pair_to_bv, {pair bv mode pad}, 3, 0, {
   5691     %stl(a0, pair)
   5692     %stl(a1, bv)
   5693     %stl(a2, mode)
   5694 
   5695     %ldl(a0, bv)
   5696     %li(a1, 40)
   5697     %call(&str_putc)
   5698 
   5699     :.loop
   5700     %ldl(t0, pair)
   5701     %car(a0, t0)
   5702     %ldl(a1, bv)
   5703     %ldl(a2, mode)
   5704     %call(&write_to_bv)
   5705 
   5706     %ldl(t0, pair)
   5707     %cdr(t0, t0)
   5708     %stl(t0, pair)
   5709 
   5710     %if_nil(t1, t0, &.done)
   5711     %tagof(t1, t0)
   5712     %li(t2, %TAG.PAIR)
   5713     %beq(t1, t2, &.cont)
   5714 
   5715     # Dotted tail: emit ` . ` then write_to_bv(cdr).
   5716     %ldl(a0, bv)
   5717     %li(a1, 32)
   5718     %call(&str_putc)
   5719     %ldl(a0, bv)
   5720     %li(a1, 46)
   5721     %call(&str_putc)
   5722     %ldl(a0, bv)
   5723     %li(a1, 32)
   5724     %call(&str_putc)
   5725     %ldl(a0, pair)
   5726     %ldl(a1, bv)
   5727     %ldl(a2, mode)
   5728     %call(&write_to_bv)
   5729     %b(&.done)
   5730 
   5731     :.cont
   5732     %ldl(a0, bv)
   5733     %li(a1, 32)
   5734     %call(&str_putc)
   5735     %b(&.loop)
   5736 
   5737     :.done
   5738     %ldl(a0, bv)
   5739     %li(a1, 41)
   5740     %gctail(&str_putc)
   5741 })
   5742 
   5743 # value_to_bv(val=a0, mode=a1) -> bv (a0). Allocate an empty NUL-
   5744 # terminated bv and delegate to write_to_bv; helper for display / write
   5745 # / error / format. write_to_bv internally uses str_*, so the result
   5746 # has cap > length and a trailing NUL -- safe to hand to syscalls or
   5747 # runtime_error as a C string.
   5748 
   5749 %gcfn2(value_to_bv, {val mode}, 1, 0, {
   5750     %stl(a0, val)
   5751     %stl(a1, mode)
   5752     %li(a0, 0)
   5753     %call(&str_alloc)
   5754     %mov(a1, a0)
   5755     %ldl(a0, val)
   5756     %ldl(a2, mode)
   5757     %gctail(&write_to_bv)
   5758 })
   5759 
   5760 # (display val) and (write val): build the printed representation in a
   5761 # fresh bv, sys_write the raw bytes to fd 1, return UNSPEC. Partial
   5762 # writes are not retried -- libp1pp's wrapper streams its own buffer
   5763 # but the kernel may chunk a giant single write; in practice
   5764 # scheme1 outputs are short and we accept the simple path.
   5765 %fn(prim_display_entry, 0, {
   5766     %car(a0, a0)
   5767     %li(a1, 0)
   5768     %call(&value_to_bv)
   5769     %heap_ld(a1, a0, %BV.data)
   5770     %heap_ld(a2, a0, %BV.hdr)
   5771     %shri(a2, a2, 8)
   5772     %li(a0, 1)
   5773     %call(&sys_write)
   5774     %li(a0, %imm_val(%IMM.UNSPEC))
   5775 })
   5776 
   5777 %fn(prim_write_entry, 0, {
   5778     %car(a0, a0)
   5779     %li(a1, 1)
   5780     %call(&value_to_bv)
   5781     %heap_ld(a1, a0, %BV.data)
   5782     %heap_ld(a2, a0, %BV.hdr)
   5783     %shri(a2, a2, 8)
   5784     %li(a0, 1)
   5785     %call(&sys_write)
   5786     %li(a0, %imm_val(%IMM.UNSPEC))
   5787 })
   5788 
   5789 # (error msg-bv irritant ...). Builds `scheme1: error: <msg> <irr> ...`
   5790 # in a string-bv (irritants joined by single spaces, all rendered with
   5791 # display semantics) and tails into runtime_error. str_alloc + str_*
   5792 # guarantee cap > length and a trailing NUL, making the bv's data_ptr
   5793 # a valid C string for panic's eprint_cstr.
   5794 #
   5795 # Locals:
   5796 #   walk  (initially args; advances over irritants)
   5797 #   bv
   5798 %gcfn2(prim_error_entry, {walk bv}, 3, 0, {
   5799     %stl(a0, walk)
   5800 
   5801     %li(a0, 0)
   5802     %call(&str_alloc)
   5803     %stl(a0, bv)
   5804 
   5805     %la(a1, &str_error_prefix)
   5806     %li(a2, 16)
   5807     %ldl(a0, bv)
   5808     %call(&str_putn)
   5809 
   5810     # First arg (the message) goes through write_to_bv with display mode.
   5811     %ldl(t0, walk)
   5812     %car(a0, t0)
   5813     %ldl(a1, bv)
   5814     %li(a2, 0)
   5815     %call(&write_to_bv)
   5816 
   5817     %ldl(t0, walk)
   5818     %cdr(t0, t0)
   5819     %stl(t0, walk)
   5820 
   5821     :.loop
   5822     %ldl(t0, walk)
   5823     %if_nil(t1, t0, &.done)
   5824 
   5825     %ldl(a0, bv)
   5826     %li(a1, 32)
   5827     %call(&str_putc)
   5828 
   5829     %ldl(t0, walk)
   5830     %car(a0, t0)
   5831     %ldl(a1, bv)
   5832     %li(a2, 0)
   5833     %call(&write_to_bv)
   5834 
   5835     %ldl(t0, walk)
   5836     %cdr(t0, t0)
   5837     %stl(t0, walk)
   5838     %b(&.loop)
   5839 
   5840     :.done
   5841     %ldl(t0, bv)
   5842     %heap_ld(a0, t0, %BV.data)
   5843     %gctail(&runtime_error)
   5844 })
   5845 
   5846 # (format template-bv arg ...). Walks the template bv byte by byte;
   5847 # `~X` consumes the next byte as a directive: a (display), s (write),
   5848 # d (decimal fixnum), x (lowercase hex fixnum, signed), % (newline),
   5849 # ~ (literal tilde). Unknown specs pass through verbatim. Returns the
   5850 # assembled bv; the caller decides how to consume it (e.g.
   5851 # (display (format ...))).
   5852 #
   5853 # Locals:
   5854 #   out  bv
   5855 #   template  bv
   5856 #   args  walk
   5857 #   idx  (current byte offset into template)
   5858 %gcfn2(prim_format_entry, {out template args idx}, 7, 0, {
   5859     %stl(a0, args)             ; spill incoming args while we set up
   5860 
   5861     %li(a0, 0)
   5862     %call(&str_alloc)
   5863     %stl(a0, out)
   5864 
   5865     %ldl(t0, args)
   5866     %car(t1, t0)
   5867     %stl(t1, template)
   5868     %cdr(t0, t0)
   5869     %stl(t0, args)
   5870 
   5871     %li(t0, 0)
   5872     %stl(t0, idx)
   5873 
   5874     :.loop
   5875     %ldl(t1, template)
   5876     %heap_ld(t2, t1, %BV.hdr)
   5877     %shri(t2, t2, 8)            ; template length
   5878     %ldl(t0, idx)
   5879     %beq(t0, t2, &.done)
   5880 
   5881     %heap_ld(a3, t1, %BV.data)
   5882     %add(a3, a3, t0)
   5883     %lb(a3, a3, 0)               ; byte = template.data[idx]
   5884 
   5885     %addi(t1, a3, -126)         ; '~'
   5886     %beqz(t1, &.tilde)
   5887 
   5888     # Plain byte: emit and advance.
   5889     %ldl(a0, out)
   5890     %mov(a1, a3)
   5891     %call(&str_putc)
   5892     %ldl(t0, idx)
   5893     %addi(t0, t0, 1)
   5894     %stl(t0, idx)
   5895     %b(&.loop)
   5896 
   5897     :.tilde
   5898     %ldl(t0, idx)
   5899     %addi(t0, t0, 1)
   5900     %ldl(t1, template)
   5901     %heap_ld(t2, t1, %BV.hdr)
   5902     %shri(t2, t2, 8)
   5903     %beq(t0, t2, &.tilde_lit)
   5904 
   5905     %heap_ld(t1, t1, %BV.data)
   5906     %add(t1, t1, t0)
   5907     %lb(a3, t1, 0)               ; spec
   5908 
   5909     %addi(t0, t0, 1)             ; advance past spec
   5910     %stl(t0, idx)
   5911 
   5912     %addi(t1, a3, -97)          ; 'a'
   5913     %beqz(t1, &.spec_a)
   5914     %addi(t1, a3, -115)         ; 's'
   5915     %beqz(t1, &.spec_s)
   5916     %addi(t1, a3, -100)         ; 'd'
   5917     %beqz(t1, &.spec_d)
   5918     %addi(t1, a3, -120)         ; 'x'
   5919     %beqz(t1, &.spec_x)
   5920     %addi(t1, a3, -37)          ; '%'
   5921     %beqz(t1, &.spec_pct)
   5922     %addi(t1, a3, -126)         ; '~'
   5923     %beqz(t1, &.spec_tilde)
   5924 
   5925     # Unknown directive: emit `~` then the spec byte verbatim. Re-read
   5926     # the spec byte from the template since str_putc may clobber a3.
   5927     %ldl(a0, out)
   5928     %li(a1, 126)
   5929     %call(&str_putc)
   5930     %ldl(t0, template)
   5931     %heap_ld(t1, t0, %BV.data)
   5932     %ldl(t0, idx)
   5933     %addi(t0, t0, -1)
   5934     %add(t1, t1, t0)
   5935     %lb(a1, t1, 0)
   5936     %ldl(a0, out)
   5937     %call(&str_putc)
   5938     %b(&.loop)
   5939 
   5940     :.tilde_lit
   5941     # `~` at end of template: emit literal `~` and finish next iter.
   5942     %ldl(a0, out)
   5943     %li(a1, 126)
   5944     %call(&str_putc)
   5945     %ldl(t0, idx)
   5946     %addi(t0, t0, 1)
   5947     %stl(t0, idx)
   5948     %b(&.loop)
   5949 
   5950     :.spec_a
   5951     %ldl(t0, args)
   5952     %car(a0, t0)
   5953     %cdr(t0, t0)
   5954     %stl(t0, args)
   5955     %ldl(a1, out)
   5956     %li(a2, 0)
   5957     %call(&write_to_bv)
   5958     %b(&.loop)
   5959 
   5960     :.spec_s
   5961     %ldl(t0, args)
   5962     %car(a0, t0)
   5963     %cdr(t0, t0)
   5964     %stl(t0, args)
   5965     %ldl(a1, out)
   5966     %li(a2, 1)
   5967     %call(&write_to_bv)
   5968     %b(&.loop)
   5969 
   5970     :.spec_d
   5971     %ldl(t0, args)
   5972     %car(t1, t0)
   5973     %cdr(t0, t0)
   5974     %stl(t0, args)
   5975     %sari(a1, t1, 3)
   5976     %ldl(a0, out)
   5977     %call(&str_putint)
   5978     %b(&.loop)
   5979 
   5980     :.spec_x
   5981     %ldl(t0, args)
   5982     %car(t1, t0)
   5983     %cdr(t0, t0)
   5984     %stl(t0, args)
   5985     %sari(a1, t1, 3)
   5986     %ldl(a0, out)
   5987     %call(&str_puthex)
   5988     %b(&.loop)
   5989 
   5990     :.spec_pct
   5991     %ldl(a0, out)
   5992     %li(a1, 10)
   5993     %call(&str_putc)
   5994     %b(&.loop)
   5995 
   5996     :.spec_tilde
   5997     %ldl(a0, out)
   5998     %li(a1, 126)
   5999     %call(&str_putc)
   6000     %b(&.loop)
   6001 
   6002     :.done
   6003     %ldl(a0, out)
   6004 })
   6005 
   6006 # =========================================================================
   6007 # Syscall primitives
   6008 # =========================================================================
   6009 #
   6010 # Each syscall primitive untags the args list, calls a thin libp1pp- or
   6011 # scheme1-local syscall wrapper, and routes the raw return through
   6012 # wrap_syscall_result: r >= 0 -> (#t . r), r < 0 -> (#f . -r).
   6013 #
   6014 # Bytevector args (paths, buffers) are passed by their raw data_ptr (slot
   6015 # +5 from the tagged wrapper). For syscalls that read data_ptr as a C
   6016 # string (paths, argv elements), the caller must produce the bv via the
   6017 # str_* family so cap > length and data[length] == 0. Callers that only
   6018 # expose the bv as a (data_ptr, count) pair (sys-read, sys-write buffers)
   6019 # can pass plain bytevectors -- no NUL needed.
   6020 
   6021 # wrap_syscall_result(raw=a0) -> (#t . r) or (#f . errno).
   6022 
   6023 %fn2(wrap_syscall_result, {raw pad}, {
   6024     %stl(a0, raw)
   6025     %bltz(a0, &.err)
   6026     %mkfix(a1, a0)
   6027     %li(a0, %imm_val(%IMM.TRUE))
   6028     %tail(&cons)
   6029 
   6030     :.err
   6031     %ldl(t0, raw)
   6032     %li(t1, 0)
   6033     %sub(t0, t1, t0)
   6034     %mkfix(a1, t0)
   6035     %li(a0, %imm_val(%IMM.FALSE))
   6036     %tail(&cons)
   6037 })
   6038 
   6039 # sys_openat(dirfd=a0, path=a1, flags=a2, mode=a3) -> r (a0). Leaf.
   6040 :sys_openat
   6041     %mov(t0, a3)
   6042     %mov(a3, a2)
   6043     %mov(a2, a1)
   6044     %mov(a1, a0)
   6045     %li(a0, %p1_sys_openat)
   6046     %syscall
   6047     %ret
   6048 
   6049 # sys_clone() -> r (a0). Linux clone(SIGCHLD, 0, 0, 0, 0) -- fork-style.
   6050 # Saves and restores s0 around the syscall because %p1_syscall reads s0
   6051 # as the 5th OS-syscall argument.
   6052 
   6053 %fn2(sys_clone, {saved_s0 pad}, {
   6054     %stl(s0, saved_s0)
   6055     %li(s0, 0)
   6056 
   6057     %li(a1, 17)
   6058     %li(a2, 0)
   6059     %li(a3, 0)
   6060     %li(t0, 0)
   6061     %li(a0, %p1_sys_clone)
   6062     %syscall
   6063 
   6064     %ldl(s0, saved_s0)
   6065 })
   6066 
   6067 # sys_execve(path=a0, argv=a1, envp=a2) -> -errno (a0). Only returns on
   6068 # failure; on success the new image takes over.
   6069 :sys_execve
   6070     %mov(a3, a2)
   6071     %mov(a2, a1)
   6072     %mov(a1, a0)
   6073     %li(a0, %p1_sys_execve)
   6074     %syscall
   6075     %ret
   6076 
   6077 # sys_spawn(path=a0, argv=a1) -> r (a0). Atomic clone+execve, single
   6078 # syscall: kernel saves parent state, swaps user pool with no copy,
   6079 # loads the ELF, builds the user stack, and erets into the child. The
   6080 # parent's spawn() returns child_pid only after the child exit_groups.
   6081 # Provided by the seed kernel (private syscall 1024). On Linux this
   6082 # number is unmapped so the kernel returns -ENOSYS, which the prelude
   6083 # uses to detect environment and fall back to sys_clone+sys_execve.
   6084 :sys_spawn
   6085     %mov(a2, a1)
   6086     %mov(a1, a0)
   6087     %li(a0, %p1_sys_spawn)
   6088     %syscall
   6089     %ret
   6090 
   6091 # sys_waitid(idtype=a0, id=a1, infop=a2, options=a3) -> r (a0). Leaf.
   6092 :sys_waitid
   6093     %mov(t0, a3)
   6094     %mov(a3, a2)
   6095     %mov(a2, a1)
   6096     %mov(a1, a0)
   6097     %li(a0, %p1_sys_waitid)
   6098     %syscall
   6099     %ret
   6100 
   6101 # build_execve_argv(list=a0) -> raw NULL-terminated array (a0).
   6102 # Walks `list` (cons-list of bytevectors), allocates (count+1)*8 bytes,
   6103 # writes each bv's data_ptr, terminates with NULL.
   6104 #
   6105 # Locals:
   6106 #   list
   6107 #   count
   6108 #   array  ptr (raw)
   6109 %gcfn2(build_execve_argv, {list count array}, 1, 0, {
   6110     %stl(a0, list)
   6111     %call(&list_length)     ; clobbers a0 -> count
   6112     %stl(a0, count)
   6113 
   6114     %addi(a0, a0, 1)
   6115     %shli(a0, a0, 3)
   6116     %call(&alloc_bytes)
   6117     %stl(a0, array)
   6118 
   6119     %ldl(t0, list)
   6120     %ldl(t1, array)
   6121 
   6122     :.fill_loop
   6123     %if_nil(t2, t0, &.fill_done)
   6124     %car(a3, t0)
   6125     %heap_ld(a2, a3, %BV.data)
   6126     %st(a2, t1, 0)
   6127     %addi(t1, t1, 8)
   6128     %cdr(t0, t0)
   6129     %b(&.fill_loop)
   6130 
   6131     :.fill_done
   6132     %li(t2, 0)
   6133     %st(t2, t1, 0)
   6134 
   6135     %ldl(a0, array)
   6136 })
   6137 
   6138 # (sys-read fd buf offset count). Passes (buf.data_ptr + offset) to the
   6139 # kernel; offset lets callers read into the middle of a bv without first
   6140 # slicing/copying.
   6141 %fn(prim_sys_read_entry, 0, {
   6142     %args4(t0, t1, t2, a3, a0)
   6143     %sari(t0, t0, 3)        ; fd
   6144     %heap_ld(t1, t1, %BV.data)  ; buf data ptr
   6145     %sari(t2, t2, 3)        ; offset
   6146     %add(t1, t1, t2)        ; data_ptr + offset
   6147     %sari(t2, a3, 3)        ; count
   6148     %mov(a0, t0)
   6149     %mov(a1, t1)
   6150     %mov(a2, t2)
   6151     %call(&sys_read)
   6152     %tail(&wrap_syscall_result)
   6153 })
   6154 
   6155 # (sys-write fd buf offset count). Passes (buf.data_ptr + offset) to the
   6156 # kernel; offset lets callers retry the unwritten tail of a partial
   6157 # write without bytevector-copy.
   6158 %fn(prim_sys_write_entry, 0, {
   6159     %args4(t0, t1, t2, a3, a0)
   6160     %sari(t0, t0, 3)        ; fd
   6161     %heap_ld(t1, t1, %BV.data)  ; buf data ptr
   6162     %sari(t2, t2, 3)        ; offset
   6163     %add(t1, t1, t2)        ; data_ptr + offset
   6164     %sari(t2, a3, 3)        ; count
   6165     %mov(a0, t0)
   6166     %mov(a1, t1)
   6167     %mov(a2, t2)
   6168     %call(&sys_write)
   6169     %tail(&wrap_syscall_result)
   6170 })
   6171 
   6172 # (sys-close fd)
   6173 %fn(prim_sys_close_entry, 0, {
   6174     %car_fix(a0, a0)
   6175     %call(&sys_close)
   6176     %tail(&wrap_syscall_result)
   6177 })
   6178 
   6179 # (sys-openat dirfd path flags mode)
   6180 %fn(prim_sys_openat_entry, 0, {
   6181     %args4(t0, t1, t2, a3, a0)
   6182     %sari(t0, t0, 3)        ; dirfd
   6183     %heap_ld(t1, t1, %BV.data)  ; path data_ptr
   6184     %sari(t2, t2, 3)        ; flags
   6185     %sari(a3, a3, 3)        ; mode
   6186     %mov(a0, t0)
   6187     %mov(a1, t1)
   6188     %mov(a2, t2)
   6189     %call(&sys_openat)
   6190     %tail(&wrap_syscall_result)
   6191 })
   6192 
   6193 # (sys-clone). Linux POSIX-style fork; only used as a fallback path on
   6194 # Linux since the seed kernel doesn't implement clone (it offers
   6195 # sys-spawn instead).
   6196 %fn(prim_sys_clone_entry, 0, {
   6197     %call(&sys_clone)
   6198     %tail(&wrap_syscall_result)
   6199 })
   6200 
   6201 # (sys-execve path argv-list)
   6202 
   6203 %gcfn2(prim_sys_execve_entry, {path pad}, 1, 0, {
   6204     %args2(t0, a0, a0)      ; t0 = path bv, a0 = argv-list
   6205     %stl(t0, path)
   6206     %call(&build_execve_argv)
   6207     %mov(a1, a0)
   6208     %ldl(a0, path)
   6209     %heap_ld(a0, a0, %BV.data)  ; path data ptr
   6210     %li(a2, 0)
   6211     %call(&sys_execve)
   6212     %gctail(&wrap_syscall_result)
   6213 })
   6214 
   6215 # (sys-spawn path argv-list). Same calling convention as sys-execve, but
   6216 # wraps the seed kernel's atomic spawn syscall: returns (#t . child-pid)
   6217 # after the child has exit_grouped (the kernel suspends the parent for
   6218 # the lifetime of the child), or (#f . -errno) on failure (notably
   6219 # -ENOSYS=38 on Linux, which the prelude probes for at init time).
   6220 %gcfn2(prim_sys_spawn_entry, {path pad}, 1, 0, {
   6221     %args2(t0, a0, a0)      ; t0 = path bv, a0 = argv-list
   6222     %stl(t0, path)
   6223     %call(&build_execve_argv)
   6224     %mov(a1, a0)
   6225     %ldl(a0, path)
   6226     %heap_ld(a0, a0, %BV.data)  ; path data ptr
   6227     %call(&sys_spawn)
   6228     %gctail(&wrap_syscall_result)
   6229 })
   6230 
   6231 # (sys-waitid idtype id infop options)
   6232 %fn(prim_sys_waitid_entry, 0, {
   6233     %args4(t0, t1, t2, a3, a0)
   6234     %sari(t0, t0, 3)        ; idtype
   6235     %sari(t1, t1, 3)        ; id
   6236     %heap_ld(t2, t2, %BV.data)  ; infop bv data ptr
   6237     %sari(a3, a3, 3)        ; options
   6238     %mov(a0, t0)
   6239     %mov(a1, t1)
   6240     %mov(a2, t2)
   6241     %call(&sys_waitid)
   6242     %tail(&wrap_syscall_result)
   6243 })
   6244 
   6245 # (sys-argv) -> list of bytevectors. Walks saved_argv, strlen-ing each
   6246 # NUL-terminated entry into a fresh bytevector and consing them in order
   6247 # via the head/tail trick.
   6248 #
   6249 # Locals:
   6250 #   argv  ptr (advancing 8 bytes per iteration)
   6251 #   count  remaining (decrementing from saved_argc)
   6252 #   head
   6253 #   tail
   6254 #   bv
   6255 %gcfn2(prim_sys_argv_entry, {argv count head tail bv}, 28, 0, {
   6256     %ld_global(t0, &saved_argv)
   6257     %stl(t0, argv)
   6258     %ld_global(t0, &saved_argc)
   6259     %stl(t0, count)
   6260     %li(t0, %imm_val(%IMM.NIL))
   6261     %stl(t0, head)
   6262     %stl(t0, tail)
   6263 
   6264     :.loop
   6265     %ldl(t0, count)
   6266     %beqz(t0, &.done)
   6267 
   6268     # len = strlen(*argv)
   6269     %ldl(t0, argv)
   6270     %ld(a0, t0, 0)
   6271     %call(&libp1pp__strlen)
   6272 
   6273     # bv = str_alloc(len). argv entries flow into syscalls (sys-openat,
   6274     # sys-execve) that read data_ptr as a C string, so the trailing NUL
   6275     # is required.
   6276     %call(&str_alloc)
   6277     %stl(a0, bv)
   6278 
   6279     # memcpy(bv.data_ptr, *argv, len-from-bv-hdr).
   6280     %ldl(t0, bv)
   6281     %heap_ld(a0, t0, %BV.data)
   6282     %ldl(t1, argv)
   6283     %ld(a1, t1, 0)
   6284     %heap_ld(t1, t0, %BV.hdr)
   6285     %shri(a2, t1, 8)
   6286     %call(&memcpy)
   6287 
   6288     # cell = cons(bv, NIL); append to list head/tail.
   6289     %ldl(a0, bv)
   6290     %li(a1, %imm_val(%IMM.NIL))
   6291     %call(&cons)
   6292 
   6293     %ldl(t0, head)
   6294     %if_nil(t1, t0, &.first)
   6295     %ldl(t0, tail)
   6296     %set_cdr(a0, t0)
   6297     %stl(a0, tail)
   6298     %b(&.advance)
   6299 
   6300     :.first
   6301     %stl(a0, head)
   6302     %stl(a0, tail)
   6303 
   6304     :.advance
   6305     %ldl(t0, argv)
   6306     %addi(t0, t0, 8)
   6307     %stl(t0, argv)
   6308     %ldl(t0, count)
   6309     %addi(t0, t0, -1)
   6310     %stl(t0, count)
   6311     %b(&.loop)
   6312 
   6313     :.done
   6314     %ldl(a0, head)
   6315 })
   6316 
   6317 # (eof? x). The `eof` value itself is bound at startup in p1_main as a
   6318 # direct global -> IMM.EOF, not via a primitive thunk.
   6319 :prim_eofq_entry
   6320 .scope
   6321     %car(t0, a0)
   6322     %li(t1, %imm_val(%IMM.EOF))
   6323     %li(a0, %imm_val(%IMM.FALSE))
   6324     %bne(t0, t1, &.end)
   6325     %li(a0, %imm_val(%IMM.TRUE))
   6326     :.end
   6327     %ret
   6328 .endscope
   6329 
   6330 # (heap-usage) -> tagged fixnum: currently allocated managed bytes,
   6331 # including the 16-byte header of every live allocation.
   6332 :prim_heap_usage_entry
   6333     %ld_global(a0, &heap_allocated)
   6334     %mkfix(a0, a0)
   6335     %ret
   6336 
   6337 # (collect-garbage) -> unspecified.  The primitive's argument list is
   6338 # intentionally ignored, so it does not retain otherwise unreachable data.
   6339 %fn(prim_collect_garbage_entry, 0, {
   6340     %call(&gc_collect)
   6341     %li(a0, %imm_val(%IMM.UNSPEC))
   6342 })
   6343 
   6344 # Record introspection. Surfaces the unsafe %record-* helpers (heap
   6345 # layout: [HDR.REC][td][f0..fN-1], field i at tagged + 13 + 8*i;
   6346 # nfields lives at TD's offset 13 raw). All primitives below trust
   6347 # their inputs -- no bounds check, no kind check on record-ref /
   6348 # record-set! / record-td.
   6349 
   6350 # (record? obj) -> bool. True iff obj is HEAP-tagged with HDR.REC.
   6351 :prim_recordq_entry
   6352 .scope
   6353     %car(t0, a0)
   6354     %li(a0, %imm_val(%IMM.FALSE))
   6355     %tagof(t1, t0)
   6356     %li(t2, %TAG.HEAP)
   6357     %bne(t1, t2, &.end)
   6358     %hdr_type(t1, t0)
   6359     %li(t2, %HDR.REC)
   6360     %bne(t1, t2, &.end)
   6361     %li(a0, %imm_val(%IMM.TRUE))
   6362     :.end
   6363     %ret
   6364 .endscope
   6365 
   6366 # (record-td rec) -> td. Reads the TD slot from the record header. No
   6367 # kind check; caller is expected to gate with record? if needed.
   6368 :prim_record_td_entry
   6369     %car(t0, a0)
   6370     %heap_ld(a0, t0, %REC.td)
   6371     %ret
   6372 
   6373 # (record-ref rec idx) -> field value. idx is a tagged fixnum; since
   6374 # tagged_fixnum = raw_idx * 8 (fixnum tag bits are 0), the byte offset
   6375 # is exactly idx + 13 from the tagged record pointer. No bounds check.
   6376 :prim_record_ref_entry
   6377     %args2(t0, t1, a0)         ; t0=rec, t1=idx (tagged fixnum = raw*8)
   6378     %addi(t0, t0, 13)
   6379     %add(t0, t0, t1)
   6380     %ld(a0, t0, 0)
   6381     %ret
   6382 
   6383 # (record-set! rec idx val) -> unspec. In-place store at slot idx.
   6384 :prim_record_set_bang_entry
   6385 .scope
   6386     %car(t0, a0)               ; rec
   6387     %cdr(a0, a0)
   6388     %car(t1, a0)               ; idx (tagged fixnum)
   6389     %cdr(a0, a0)
   6390     %car(t2, a0)               ; val
   6391     %addi(t0, t0, 13)
   6392     %add(t0, t0, t1)
   6393     %st(t2, t0, 0)
   6394     %li(a0, %imm_val(%IMM.UNSPEC))
   6395     %ret
   6396 .endscope
   6397 
   6398 # (make-record/td td) -> fresh record allocated in the current heap.
   6399 # Reads td.nfields, allocates 16 + nfields*8 bytes with HDR.REC, sets
   6400 # the td slot, and zero-fills field slots to IMM.UNSPEC. Mirrors
   6401 # eval_define_record_type's ctor allocation but driven by the TD's
   6402 # nfields rather than a runtime args list. Used by deep-copy as a
   6403 # pre-fill stand-in before recursive slot promotion.
   6404 #
   6405 # Locals:
   6406 #   td      (the TD pointer; saved across alloc_hdr)
   6407 #   record  (the new record pointer)
   6408 %gcfn2(prim_make_record_td_entry, {td record}, 3, 0, {
   6409     %car(t0, a0)               ; td
   6410     %stl(t0, td)
   6411 
   6412     %heap_ld(a0, t0, %TD.nfields)  ; raw nfields
   6413     %shli(a0, a0, 3)               ; nfields * 8
   6414     %addi(a0, a0, 16)              ; + REC header (hdr + td slot)
   6415     %li(a1, %HDR.REC)
   6416     %call(&alloc_hdr)
   6417     %stl(a0, record)
   6418 
   6419     %ldl(t0, td)
   6420     %heap_st(t0, a0, %REC.td)
   6421 
   6422     # Zero-fill field slots to IMM.UNSPEC. Cursor starts at first slot
   6423     # (tagged + 13); count = nfields read again from the TD.
   6424     %heap_ld(t0, t0, %TD.nfields)
   6425     %addi(t1, a0, 13)
   6426     %li(t2, %imm_val(%IMM.UNSPEC))
   6427 
   6428     :.fill_loop
   6429     %beqz(t0, &.fill_done)
   6430     %st(t2, t1, 0)
   6431     %addi(t1, t1, 8)
   6432     %addi(t0, t0, -1)
   6433     %b(&.fill_loop)
   6434 
   6435     :.fill_done
   6436     %ldl(a0, record)
   6437 })
   6438 
   6439 # (td-nfields td) -> tagged fixnum count of fields.
   6440 :prim_td_nfields_entry
   6441     %car(t0, a0)
   6442     %heap_ld(a0, t0, %TD.nfields)  ; raw count
   6443     %mkfix(a0, a0)
   6444     %ret
   6445 
   6446 # (td-name td) -> symbol bound at define-record-type time.
   6447 :prim_td_name_entry
   6448     %car(t0, a0)
   6449     %heap_ld(a0, t0, %TD.name)
   6450     %ret
   6451 
   6452 # Debug primitives. UNSAFE: peek-u8 dereferences arbitrary addresses.
   6453 # Intended for diagnosing heap-layout bugs from scheme1 user code; not
   6454 # part of the surface contract.
   6455 
   6456 # (tagged-value obj) -> fixnum. Returns the raw byte address of obj
   6457 # with tag bits masked off, encoded as a tagged fixnum so format /
   6458 # display can print it. Pass the result back into peek-u8 to read raw
   6459 # bytes. For non-pointer values (fixnums, immediates, syms) the masked
   6460 # value is small but still encodable; the result is meaningful only for
   6461 # heap-tagged inputs.
   6462 :prim_tagged_value_entry
   6463     %car(t0, a0)
   6464     %li(t1, -8)
   6465     %and(t0, t0, t1)
   6466     %mkfix(a0, t0)
   6467     %ret
   6468 
   6469 # (peek-u8 addr) -> fixnum. Reads one byte at the given raw byte
   6470 # address (tagged fixnum input, untagged inside). UNSAFE: no bounds
   6471 # check; a wild address segfaults the process.
   6472 :prim_peek_u8_entry
   6473     %car(t0, a0)
   6474     %sari(t0, t0, 3)
   6475     %lb(a0, t0, 0)
   6476     %mkfix(a0, a0)
   6477     %ret
   6478 
   6479 # (values . xs) -- multiple-values producer. Single-arg case returns the
   6480 # arg unchanged so (values x) is interchangeable with x in any 1-value
   6481 # context; 0 or 2+ args materialize an MV-pack.
   6482 :prim_values_entry
   6483 .scope
   6484     %if_nil(t0, a0, &.pack)
   6485     %cdr(t0, a0)
   6486     %if_nil(t1, t0, &.single)
   6487     :.pack
   6488     %b(&list_to_mv)
   6489     :.single
   6490     %car(a0, a0)
   6491     %ret
   6492 .endscope
   6493 
   6494 # (call-with-values producer consumer) -- apply producer to no args, then
   6495 # normalize its result (via mv_to_list) and tail-apply the consumer to the
   6496 # resulting argument list.
   6497 #
   6498 # Locals:
   6499 #   consumer  (saved across apply(producer) and mv_to_list)
   6500 %gcfn2(prim_call_with_values_entry, {consumer pad}, 1, 0, {
   6501     %args2(t0, t1, a0)              ; t0 = producer, t1 = consumer
   6502     %stl(t1, consumer)
   6503 
   6504     %mov(a0, t0)
   6505     %li(a1, %imm_val(%IMM.NIL))
   6506     %call(&apply)
   6507 
   6508     %call(&mv_to_list)
   6509 
   6510     %mov(a1, a0)
   6511     %ldl(a0, consumer)
   6512     %gctail(&apply)
   6513 })
   6514 
   6515 # =========================================================================
   6516 # Startup -- heap_init
   6517 # =========================================================================
   6518 
   6519 # heap_init() -> none. Initializes the physical heap chain, free list,
   6520 # accounting, and bounded exact-root stack. Leaf.
   6521 :heap_init
   6522     %ld_global(t0, &heap_buf_ptr)
   6523     %alignup(t0, t0, 8, t1)
   6524     %st_global(t0, &heap_base, t1)
   6525     %st_global(t0, &heap_tail, t1)
   6526 
   6527     %ld_global(t0, &heap_buf_ptr)
   6528     %li(t1, %HEAP_CAP_BYTES)
   6529     %add(t0, t0, t1)
   6530     %st_global(t0, &heap_end, t1)
   6531 
   6532     %li(t0, 0)
   6533     %st_global(t0, &gc_free_list, t1)
   6534     %st_global(t0, &gc_mark_worklist, t1)
   6535     %st_global(t0, &heap_allocated, t1)
   6536 
   6537     %ld_global(t0, &gc_root_buf_ptr)
   6538     %st_global(t0, &gc_root_next, t1)
   6539     %li(t1, (* %GC_ROOT_CAP_FRAMES %GC_ROOT_FRAME_BYTES))
   6540     %add(t0, t0, t1)
   6541     %st_global(t0, &gc_root_end, t1)
   6542 
   6543     %ret
   6544 
   6545 # Sentinel: marks the boundary between executable text and rodata.
   6546 # Read by scripts/disasm-elf.sh (via scripts/m1-symbols.py) to bound
   6547 # disassembly so trailing strings don't decode as bogus instructions.
   6548 :_text_end
   6549 
   6550 .align 8
   6551 
   6552 # Primitive surface names.
   6553 :name_sys_exit    %cstr8("sys-exit")
   6554 :name_cons        %cstr8("cons")
   6555 :name_car         %cstr8("car")
   6556 :name_cdr         %cstr8("cdr")
   6557 :name_nullq       %cstr8("null?")
   6558 :name_pairq       %cstr8("pair?")
   6559 :name_stringq     %cstr8("string?")
   6560 :name_set_car     %cstr8("set-car!")
   6561 :name_set_cdr     %cstr8("set-cdr!")
   6562 :name_length      %cstr8("length")
   6563 :name_list_ref    %cstr8("list-ref")
   6564 :name_assq        %cstr8("assq")
   6565 :name_assoc       %cstr8("assoc")
   6566 :name_reverse     %cstr8("reverse")
   6567 :name_str_to_sym  %cstr8("string->symbol")
   6568 :name_sym_to_str  %cstr8("symbol->string")
   6569 :name_num_to_str  %cstr8("number->string")
   6570 :name_str_to_num  %cstr8("string->number")
   6571 :name_bv_append   %cstr8("bytevector-append")
   6572 :name_booleanq    %cstr8("boolean?")
   6573 :name_integerq    %cstr8("integer?")
   6574 :name_symbolq     %cstr8("symbol?")
   6575 :name_procedureq  %cstr8("procedure?")
   6576 :name_zeroq       %cstr8("zero?")
   6577 :name_not         %cstr8("not")
   6578 :name_eqq         %cstr8("eq?")
   6579 :name_equal       %cstr8("equal?")
   6580 :name_plus        %cstr8("+")
   6581 :name_minus       %cstr8("-")
   6582 :name_mult        %cstr8("*")
   6583 :name_eq          %cstr8("=")
   6584 :name_lt          %cstr8("<")
   6585 :name_gt          %cstr8(">")
   6586 :name_quotient    %cstr8("quotient")
   6587 :name_remainder   %cstr8("remainder")
   6588 :name_bit_and     %cstr8("bit-and")
   6589 :name_bit_or      %cstr8("bit-or")
   6590 :name_bit_xor     %cstr8("bit-xor")
   6591 :name_bit_not     %cstr8("bit-not")
   6592 :name_arith_shift %cstr8("arithmetic-shift")
   6593 :name_apply       %cstr8("apply")
   6594 :name_make_bv     %cstr8("make-bytevector")
   6595 :name_bv_length   %cstr8("bytevector-length")
   6596 :name_string_length %cstr8("string-length")
   6597 :name_bv_u8_ref   %cstr8("bytevector-u8-ref")
   6598 :name_bv_u8_set   %cstr8("bytevector-u8-set!")
   6599 :name_bv_copy     %cstr8("bytevector-copy")
   6600 :name_bv_copy_b   %cstr8("bytevector-copy!")
   6601 :name_bv_eq       %cstr8("bytevector=?")
   6602 
   6603 :name_sys_read    %cstr8("sys-read")
   6604 :name_sys_write   %cstr8("sys-write")
   6605 :name_sys_close   %cstr8("sys-close")
   6606 :name_sys_openat  %cstr8("sys-openat")
   6607 :name_sys_clone   %cstr8("sys-clone")
   6608 :name_sys_execve  %cstr8("sys-execve")
   6609 :name_sys_spawn   %cstr8("sys-spawn")
   6610 :name_sys_waitid  %cstr8("sys-waitid")
   6611 :name_sys_argv    %cstr8("sys-argv")
   6612 :name_eof         %cstr8("eof")
   6613 :name_eofq        %cstr8("eof?")
   6614 :name_values      %cstr8("values")
   6615 :name_call_with_values %cstr8("call-with-values")
   6616 :name_display     %cstr8("display")
   6617 :name_write       %cstr8("write")
   6618 :name_error       %cstr8("error")
   6619 :name_format      %cstr8("format")
   6620 :name_heap_usage  %cstr8("heap-usage")
   6621 :name_collect_garbage %cstr8("collect-garbage")
   6622 :name_recordq               %cstr8("record?")
   6623 :name_record_td             %cstr8("record-td")
   6624 :name_record_ref            %cstr8("record-ref")
   6625 :name_record_set_bang       %cstr8("record-set!")
   6626 :name_make_record_td        %cstr8("make-record/td")
   6627 :name_td_nfields            %cstr8("td-nfields")
   6628 :name_td_name               %cstr8("td-name")
   6629 :name_tagged_value          %cstr8("tagged-value")
   6630 :name_peek_u8               %cstr8("peek-u8")
   6631 
   6632 # Writer string constants. Lengths are hard-coded at the str_putn call
   6633 # sites (write_to_bv branches). They are emitted through cstr8 so the
   6634 # labels remain aligned and are also safe as C strings if reused later.
   6635 :str_false        %cstr8("#f")
   6636 :str_true         %cstr8("#t")
   6637 :str_nil          %cstr8("()")
   6638 :str_unspec       %cstr8("#!unspec")
   6639 :str_unbound      %cstr8("#!unbound")
   6640 :str_eof          %cstr8("#!eof")
   6641 :str_closure      %cstr8("#<closure>")
   6642 :str_prim         %cstr8("#<prim>")
   6643 :str_td           %cstr8("#<rec-type>")
   6644 :str_rec          %cstr8("#<record>")
   6645 :str_unknown      %cstr8("#<unknown>")
   6646 :str_error_prefix %cstr8("scheme1: error: ")
   6647 
   6648 # Primitive registration table. Each entry: 8-byte name_ptr (4-byte label
   6649 # ref + 4 pad), 8-byte name_len, 8-byte entry_label (4 ref + 4 pad).
   6650 :prim_table
   6651 &name_sys_exit    %(0)  $(8)   &prim_sys_exit_entry     %(0)
   6652 &name_cons        %(0)  $(4)   &prim_cons_entry         %(0)
   6653 &name_car         %(0)  $(3)   &prim_car_entry          %(0)
   6654 &name_cdr         %(0)  $(3)   &prim_cdr_entry          %(0)
   6655 &name_nullq       %(0)  $(5)   &prim_nullq_entry        %(0)
   6656 &name_pairq       %(0)  $(5)   &prim_pairq_entry        %(0)
   6657 &name_stringq     %(0)  $(7)   &prim_stringq_entry      %(0)
   6658 &name_set_car     %(0)  $(8)   &prim_set_car_entry      %(0)
   6659 &name_set_cdr     %(0)  $(8)   &prim_set_cdr_entry      %(0)
   6660 &name_length      %(0)  $(6)   &prim_length_entry       %(0)
   6661 &name_list_ref    %(0)  $(8)   &prim_list_ref_entry     %(0)
   6662 &name_assq        %(0)  $(4)   &prim_assq_entry         %(0)
   6663 &name_assoc       %(0)  $(5)   &prim_assoc_entry        %(0)
   6664 &name_reverse     %(0)  $(7)   &prim_reverse_entry      %(0)
   6665 &name_str_to_sym  %(0)  $(14)  &prim_string_to_symbol_entry %(0)
   6666 &name_sym_to_str  %(0)  $(14)  &prim_symbol_to_string_entry %(0)
   6667 &name_num_to_str  %(0)  $(14)  &prim_number_to_string_entry %(0)
   6668 &name_str_to_num  %(0)  $(14)  &prim_string_to_number_entry %(0)
   6669 &name_bv_append   %(0)  $(17)  &prim_bv_append_entry    %(0)
   6670 &name_booleanq    %(0)  $(8)   &prim_booleanq_entry     %(0)
   6671 &name_integerq    %(0)  $(8)   &prim_integerq_entry     %(0)
   6672 &name_symbolq     %(0)  $(7)   &prim_symbolq_entry      %(0)
   6673 &name_procedureq  %(0)  $(10)  &prim_procedureq_entry   %(0)
   6674 &name_zeroq       %(0)  $(5)   &prim_zeroq_entry        %(0)
   6675 &name_not         %(0)  $(3)   &prim_not_entry          %(0)
   6676 &name_eqq         %(0)  $(3)   &prim_eqq_entry          %(0)
   6677 &name_equal       %(0)  $(6)   &prim_equal_entry        %(0)
   6678 &name_plus        %(0)  $(1)   &prim_plus_entry         %(0)
   6679 &name_minus       %(0)  $(1)   &prim_minus_entry        %(0)
   6680 &name_mult        %(0)  $(1)   &prim_mult_entry         %(0)
   6681 &name_eq          %(0)  $(1)   &prim_eq_entry           %(0)
   6682 &name_lt          %(0)  $(1)   &prim_lt_entry           %(0)
   6683 &name_gt          %(0)  $(1)   &prim_gt_entry           %(0)
   6684 &name_quotient    %(0)  $(8)   &prim_quotient_entry     %(0)
   6685 &name_remainder   %(0)  $(9)   &prim_remainder_entry    %(0)
   6686 &name_bit_and     %(0)  $(7)   &prim_bit_and_entry      %(0)
   6687 &name_bit_or      %(0)  $(6)   &prim_bit_or_entry       %(0)
   6688 &name_bit_xor     %(0)  $(7)   &prim_bit_xor_entry      %(0)
   6689 &name_bit_not     %(0)  $(7)   &prim_bit_not_entry      %(0)
   6690 &name_arith_shift %(0)  $(16)  &prim_arith_shift_entry  %(0)
   6691 &name_apply       %(0)  $(5)   &prim_apply_entry        %(0)
   6692 &name_make_bv     %(0)  $(15)  &prim_make_bytevector_entry %(0)
   6693 &name_bv_length   %(0)  $(17)  &prim_bv_length_entry    %(0)
   6694 &name_string_length %(0) $(13) &prim_string_length_entry %(0)
   6695 &name_bv_u8_ref   %(0)  $(17)  &prim_bv_u8_ref_entry    %(0)
   6696 &name_bv_u8_set   %(0)  $(18)  &prim_bv_u8_set_entry    %(0)
   6697 &name_bv_copy     %(0)  $(15)  &prim_bv_copy_entry      %(0)
   6698 &name_bv_copy_b   %(0)  $(16)  &prim_bv_copy_bang_entry %(0)
   6699 &name_bv_eq       %(0)  $(12)  &prim_bytevector_eq_entry %(0)
   6700 &name_sys_read    %(0)  $(8)   &prim_sys_read_entry     %(0)
   6701 &name_sys_write   %(0)  $(9)   &prim_sys_write_entry    %(0)
   6702 &name_sys_close   %(0)  $(9)   &prim_sys_close_entry    %(0)
   6703 &name_sys_openat  %(0)  $(10)  &prim_sys_openat_entry   %(0)
   6704 &name_sys_clone   %(0)  $(9)   &prim_sys_clone_entry    %(0)
   6705 &name_sys_execve  %(0)  $(10)  &prim_sys_execve_entry   %(0)
   6706 &name_sys_spawn   %(0)  $(9)   &prim_sys_spawn_entry    %(0)
   6707 &name_sys_waitid  %(0)  $(10)  &prim_sys_waitid_entry   %(0)
   6708 &name_sys_argv    %(0)  $(8)   &prim_sys_argv_entry     %(0)
   6709 &name_eofq        %(0)  $(4)   &prim_eofq_entry         %(0)
   6710 &name_display     %(0)  $(7)   &prim_display_entry      %(0)
   6711 &name_write       %(0)  $(5)   &prim_write_entry        %(0)
   6712 &name_error       %(0)  $(5)   &prim_error_entry        %(0)
   6713 &name_format      %(0)  $(6)   &prim_format_entry       %(0)
   6714 &name_heap_usage  %(0)  $(10)  &prim_heap_usage_entry   %(0)
   6715 &name_collect_garbage %(0) $(15) &prim_collect_garbage_entry %(0)
   6716 &name_recordq         %(0) $(7)  &prim_recordq_entry         %(0)
   6717 &name_record_td       %(0) $(9)  &prim_record_td_entry       %(0)
   6718 &name_record_ref      %(0) $(10) &prim_record_ref_entry      %(0)
   6719 &name_record_set_bang %(0) $(11) &prim_record_set_bang_entry %(0)
   6720 &name_make_record_td  %(0) $(14) &prim_make_record_td_entry  %(0)
   6721 &name_td_nfields      %(0) $(10) &prim_td_nfields_entry      %(0)
   6722 &name_td_name         %(0) $(7)  &prim_td_name_entry         %(0)
   6723 &name_tagged_value    %(0) $(12) &prim_tagged_value_entry    %(0)
   6724 &name_peek_u8         %(0) $(7)  &prim_peek_u8_entry         %(0)
   6725 &name_values      %(0)  $(6)   &prim_values_entry       %(0)
   6726 &name_call_with_values %(0) $(16) &prim_call_with_values_entry %(0)
   6727 :prim_table_end
   6728 
   6729 ;; Error messages are NUL-terminated C strings. The embedded newline
   6730 ;; keeps the old stderr formatting; runtime_error's panic path appends
   6731 ;; another newline, which shell command substitution trims in tests.
   6732 :msg_usage          %cstr8("scheme1: usage: scheme1 SOURCE.scm\n")
   6733 :msg_load_fail      %cstr8("scheme1: failed to read source\n")
   6734 :msg_symtab_full    %cstr8("scheme1: symbol table full\n")
   6735 :msg_unexp_rparen   %cstr8("scheme1: unexpected ')'\n")
   6736 :msg_bad_hash       %cstr8("scheme1: bad #-syntax\n")
   6737 :msg_unexp_eof      %cstr8("scheme1: unexpected EOF in form\n")
   6738 :msg_unterm_list    %cstr8("scheme1: unterminated list\n")
   6739 :msg_unbound        %cstr8("scheme1: unbound variable\n")
   6740 :msg_not_proc       %cstr8("scheme1: not a procedure\n")
   6741 :msg_heap_full      %cstr8("scheme1: heap exhausted\n")
   6742 :msg_heap_corrupt   %cstr8("scheme1: corrupt managed heap\n")
   6743 :msg_gc_roots_full  %cstr8("scheme1: shadow root stack overflow\n")
   6744 :msg_readbuf_full   %cstr8("scheme1: source buffer overflow\n")
   6745 :msg_bv_oob         %cstr8("scheme1: bytevector index out of range\n")
   6746 :msg_unterm_string  %cstr8("scheme1: unterminated string literal\n")
   6747 :msg_bad_escape     %cstr8("scheme1: bad string escape\n")
   6748 :msg_bad_char       %cstr8("scheme1: bad #\\ character literal\n")
   6749 :msg_bad_number     %cstr8("scheme1: bad number literal\n")
   6750 :msg_bad_ident      %cstr8("scheme1: bad identifier\n")
   6751 :msg_internal_define %cstr8("scheme1: internal define is not supported\n")
   6752 :msg_pmatch_no_match %cstr8("scheme1: pmatch: no clause matched\n")
   6753 :msg_bad_unquote_pattern %cstr8("scheme1: pmatch: malformed ,-pattern\n")
   6754 
   6755 :name_ch_tab      %cstr8("tab")
   6756 :name_ch_null     %cstr8("null")
   6757 :name_ch_space    %cstr8("space")
   6758 :name_ch_return   %cstr8("return")
   6759 :name_ch_newline  %cstr8("newline")
   6760 
   6761 # =========================================================================
   6762 # BSS arena table
   6763 # =========================================================================
   6764 #
   6765 # (slot, size) rows for libp1pp's init_arenas, walked once at startup.
   6766 # init_arenas threads a running offset, so each arena starts where the
   6767 # previous one ended.
   6768 :arena_table
   6769 %arena_entry(&readbuf_buf_ptr, %READBUF_CAP_BYTES)
   6770 %arena_entry(&symtab_buf_ptr,  (* %SYMTAB_CAP_SLOTS %SYMENT.SIZE))
   6771 %arena_entry(&gc_root_buf_ptr, (* %GC_ROOT_CAP_FRAMES %GC_ROOT_FRAME_BYTES))
   6772 %arena_entry(&heap_buf_ptr,    %HEAP_CAP_BYTES)
   6773 :arena_table_end
   6774 
   6775 # =========================================================================
   6776 # Scalar BSS (file-resident, zero-initialized)
   6777 # =========================================================================
   6778 
   6779 # Managed-heap physical chain and accounting.
   6780 :heap_base        $(0)
   6781 :heap_tail        $(0)
   6782 :heap_end         $(0)
   6783 :heap_allocated   $(0)
   6784 :gc_free_list     $(0)
   6785 :gc_mark_worklist $(0)
   6786 
   6787 # Exact shadow-root frame stack.
   6788 :gc_root_next     $(0)
   6789 :gc_root_end      $(0)
   6790 
   6791 # Source-buffer cursor and slurped length.
   6792 :readbuf_pos      $(0)
   6793 :readbuf_len      $(0)
   6794 
   6795 # Symbol table count (number of entries used).
   6796 :symtab_count     $(0)
   6797 
   6798 # Cached tagged-symbol values for special forms (filled by
   6799 # intern_special_forms at startup).
   6800 :sym_quote        $(0)
   6801 :sym_if           $(0)
   6802 :sym_lambda       $(0)
   6803 :sym_define       $(0)
   6804 :sym_begin        $(0)
   6805 :sym_cond         $(0)
   6806 :sym_else         $(0)
   6807 :sym_arrow        $(0)
   6808 :sym_let          $(0)
   6809 :sym_letstar      $(0)
   6810 :sym_let_values   $(0)
   6811 :sym_letstar_values $(0)
   6812 :sym_and          $(0)
   6813 :sym_or           $(0)
   6814 :sym_when         $(0)
   6815 :sym_case         $(0)
   6816 :sym_setbang     $(0)
   6817 :sym_define_record_type $(0)
   6818 :sym_pmatch       $(0)
   6819 :sym_do           $(0)
   6820 :sym_unquote      $(0)
   6821 :sym_guard        $(0)
   6822 :sym_underscore   $(0)
   6823 :sym_dollar       $(0)
   6824 
   6825 # Process startup state, captured by p1_main and read by sys-argv.
   6826 :saved_argc       $(0)
   6827 :saved_argv       $(0)
   6828 
   6829 # Scratch buffer for bv_putint / str_putint -> fmt_dec. fmt_dec writes
   6830 # at most 20 bytes for a 64-bit signed integer; 24 bytes (three words)
   6831 # is comfortable room and keeps following slots word-aligned.
   6832 :writer_num_buf   $(0) $(0) $(0)
   6833 
   6834 # Pointer slots for the past-:ELF_end arenas.
   6835 :readbuf_buf_ptr  $(0)
   6836 :heap_buf_ptr     $(0)
   6837 :symtab_buf_ptr   $(0)
   6838 :gc_root_buf_ptr  $(0)
   6839 
   6840 :ELF_end