boot2

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

scheme1.P1pp (179350B)


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