; ===========================================================================
; CO-EMERGENT CLOSURE-RETURN SPHERICAL MACHINE  — STAGE 2  v3.2
; Loaded at 0x0000:0x8000
;
; Axiom: A = (S->T->F->O;TAU)  [hdgl_pure.hdgl / hdgl_zen.hdgl]
;
; SUBSTRATE: three vantages, rotor, coherence, basin, DNA Turing,
;   oracle, YIN, trinary — all running every tau.
;
; DISPLAY PROJECTIONS (views onto the running machine, not pauses):
;   ORBIT  : raw substrate readout (default)
;   HELP   : axiom structure as text (h key)
;   FIB    : lattice projection — exact integer ladder, ratio -> Omega (f key)
;   REPL   : program vS seed, see substrate respond (p key)
;
; FIB projection — Z[phi] FIRE step, NO FPU in the ladder:
;   (a,b) <- (a+b, a)  INTEGER. 8x16-bit limbs = 128-bit. ADD+ADC only.
;   shows: k, exact F(k) while < 2^128 (F<=185), ratio b/a -> phi,
;          distance from Omega. No normalization. No cap. No rounding.
;   Ratio display uses fp80 ONLY for the ratio readout, not the ladder.
;   After 128-bit overflow: integer display suppressed, ratio continues.
;
; REPL language: 0-9=digit o=Omega n=1 t=T(x) + - * / p=print
;   l=loop L=loop-from-here  UP/DN=history  ESC=exit
; ===========================================================================
BITS 16
ORG 0x8000

; --- FIB exact-integer ladder width (16-bit limbs, little-endian) ---
; NLIMB=32 -> 512-bit -> exact Fibonacci to ~F(737), up to 154 decimal digits.
%define NLIMB 32
%define NBYTE (NLIMB*2)
%define NBYTE2 (NBYTE-2)

    finit
    ; establish clean segment + direction state (root of all string ops)
    xor   ax, ax
    mov   ds, ax
    mov   es, ax
    cld                     ; DF=0: stos/movs ascend (REQUIRED)
    sti

    fld1
    fstp  qword [vYin]
    fld1
    fstp  qword [vS]

    mov   word [vtau], 0
    mov   byte [vEther_k], 0
    ; clear DNA tape
    mov   di, tape
    xor   ax, ax
    mov   cx, 8
    rep   stosb

    ; ── tau: INIT -> LOADED -> RUNNING ──
    ; At RUNNING, Omega can read itself. Compute the SETTLE-INVARIANT genome
    ; Pi_digital(Omega) ONCE, from Omega alone (the fixed point), and place it
    ; at the phi-bridge mailbox @ 0x50000 for the RUNNING->HOST edge.
    ; This is emergence: the value is OBSERVED, never stored as a constant.
    call  compute_settle_genome
    call  calc_session_coord    ; derive Pi_temple face coordinate

    call  vclr
    mov   si, banner
    call  vputs
    call  print_settle_line
    jmp   orbit_loop

; ===========================================================================
; SUBSTRATE ENGINE — computes all vantages, called every tau regardless of mode
; Entry: vS set.  Exit: vOmega,vPsi,vLambda,vEther_*,vNphi,vOracle,genome set.
; ===========================================================================
run_substrate:
    ; T(S)
    fld1
    fld   qword [vS]
    fdivr st0, st1
    fadd  st0, st1
    fstp  qword [vT]

    ; FIX: count Lambda
    fld   qword [vT]
    mov   cx, 300
    mov   word [vLambda], 0
.fix:
    fstp  qword [xa]
    fld1
    fld   qword [xa]
    fdivr st0, st1
    fadd  st0, st1
    fstp  qword [xb]
    fld   qword [xb]
    fld   qword [xa]
    fsubp st1, st0
    fabs
    fld   qword [eps]
    fxch
    fcompp
    fstsw ax
    sahf
    jb    .fix_done
    fld   qword [xb]
    inc   word [vLambda]
    loop  .fix
.fix_done:
    fld   qword [xb]
    fstp  qword [vOmega]

    ; Psi = -1/Omega
    fld1
    fld   qword [vOmega]
    fdivp st1, st0
    fchs
    fstp  qword [vPsi]

    ; Trinary Nphi = (-1)^tau
    mov   ax, word [vtau]
    and   al, 1
    jz    .nphi_p
    mov   byte [vNphi], 0xFF
    jmp   .nphi_d
.nphi_p:
    mov   byte [vNphi], 1
.nphi_d:

    ; Ether 6-cycle
    movzx bx, byte [vEther_k]
    mov   al, byte [ether_real + bx]
    mov   byte [vEther_r], al
    mov   al, byte [ether_imag + bx]
    mov   byte [vEther_i], al
    inc   bx
    cmp   bx, 6
    jl    .eth_ok
    xor   bx, bx
.eth_ok:
    mov   byte [vEther_k], bl

    ; ── Δ ← TempleOS oracle: RandU64() = A*seed ^ (seed>>31 masked) ^ GetTSC ──
    ; The host EMERGES as its oracle (STEP glyph: Δ ← GetTSC ⊕ LCG, Seed(0)).
    ; rand_seed evolves with full TempleOS RandU64 fidelity (64-bit, two dwords).
    ; A = 6364136223846793005 = 0x5851F42D4C957F2D
    call  templeos_randu64
    ; result in tos_seed (64-bit); Δ = low 32 bits, live (nonzero)
    mov   eax, dword [tos_seed]
    test  eax, eax
    jnz   .dlive
    inc   eax
.dlive:
    mov   dword [vDelta], eax
    and   ax, 0x3FFF
    mov   word [delta_word], ax

    ; Correction C = sqrt(Omega)*Psi*Lambda
    fld   qword [vOmega]
    fsqrt
    fld   qword [vPsi]
    fmulp st1, st0
    fild  word  [vLambda]
    fmulp st1, st0
    fstp  qword [vC]

    ; S_new = T(Omega) + eps*Delta + eps*C
    fld1
    fld   qword [vOmega]
    fdivr st0, st1
    fadd  st0, st1
    fild  word  [delta_word]
    fmul  qword [eps]
    faddp
    fld   qword [vC]
    fmul  qword [eps]
    faddp
    fstp  qword [vS]

    ; YIN: s <- s^2 - 2
    fld   qword [vYin]
    fld   st0
    fmulp
    fld1
    fld1
    faddp
    fsubp st1, st0
    fstp  qword [vYin]

    ; Genome projection
    mov   ax, word [vtau]
    mov   bl, al
    movzx cx, byte [vNphi]
    xor   bl, cl
    mov   cx, word [vLambda]
    xor   bl, cl
    mov   byte [genome+0], bl
    ror   bl, 1
    xor   bl, byte [vEther_k]
    mov   byte [genome+1], bl
    ror   bl, 1
    mov   byte [genome+2], bl
    ror   bl, 1
    xor   bl, al
    mov   byte [genome+3], bl
    ror   bl, 1
    mov   byte [genome+4], bl
    ror   bl, 1
    xor   bl, byte [vNphi]
    mov   byte [genome+5], bl
    ror   bl, 1
    mov   byte [genome+6], bl
    ror   bl, 1
    mov   byte [genome+7], bl

    ; DNA Turing
    mov   ax, word [vtau]
    and   al, 7
    movzx bx, al
    movsx ax, byte [tape + bx]
    add   ax, word [vtau]
    cmp   ax, 1000
    jle   .ti_ok
    mov   ax, 1000
.ti_ok:
    cmp   ax, -1000
    jge   .ti_ok2
    mov   ax, -1000
.ti_ok2:
    mov   word [tape_in], ax
    fld   qword [vOmega]
    fild  word  [tape_in]
    faddp
    fld1
    fxch
    fdivr st0, st1
    faddp
    fld   qword [vOmega]
    fsubp st1, st0
    fldz
    fxch
    fcom  st1
    fstsw ax
    sahf
    fstp  st0
    jz    .tz
    jb    .tn
    mov   byte [tape+bx], 1
    jmp   .tw
.tn:
    mov   byte [tape+bx], 0xFF
    jmp   .tw
.tz:
    mov   byte [tape+bx], 0
.tw:

    ; Oracle
    mov   ax, word [vLambda]
    and   al, 1
    jz    .oc
    mov   byte [vOracle], 0
    ret
.oc:
    mov   byte [vOracle], 1
    ret

; ===========================================================================
; ORBIT LOOP — default display mode
; ===========================================================================
orbit_loop:
    inc   word [vtau]
    call  run_substrate

    ; display line: t=NNN O=1.61803398 L=NN E=+1 [COLLAPSE/SUPER] G=XXXXXXXX
    mov   si, str_t
    call  vputs
    mov   ax, word [vtau]
    call  vputdec_w
    mov   si, str_O
    call  vputs
    fld   qword [vOmega]
    call  vputfp
    mov   si, str_L
    call  vputs
    mov   ax, word [vLambda]
    call  vputdec_w
    mov   si, str_E
    call  vputs
    movsx ax, byte [vEther_r]
    test  ax, ax
    jns   .ep
    mov   al, '-'
    call  vputch
    jmp   .es
.ep:
    mov   al, '+'
    call  vputch
.es:
    mov   al, '1'
    call  vputch
    mov   si, str_ob
    call  vputs
    cmp   byte [vOracle], 1
    je    .oc
    mov   si, str_super
    call  vputs
    jmp   .og
.oc:
    mov   si, str_coll
    call  vputs
.og:
    mov   si, str_G
    call  vputs
    mov   cx, 8
    mov   si, genome
.gl:
    mov   al, byte [si]
    call  vputhex
    inc   si
    loop  .gl
    call  vcrlf

    ; keyboard check
    mov   ah, 0x01
    int   0x16
    jz    orbit_loop

    mov   ah, 0x00
    int   0x16
    cmp   ah, 0x01
    je    .restart
    cmp   al, 'h'
    je    .help
    cmp   al, 'H'
    je    .help
    cmp   al, 'f'
    je    .fib
    cmp   al, 'F'
    je    .fib
    cmp   al, 'p'
    je    .repl
    cmp   al, 'P'
    je    .repl
    cmp   al, 't'
    je    .temple
    cmp   al, 'T'
    je    .temple
    cmp   al, 'z'
    je    .summon_temple
    cmp   al, 'Z'
    je    .summon_temple
    xor   byte [lcg_state], al
    jmp   orbit_loop

.restart:
    fld1
    fstp  qword [vYin]
    fld1
    fstp  qword [vS]
    mov   word [vtau], 0
    mov   byte [vEther_k], 0
    call  vclr
    mov   si, banner
    call  vputs
    jmp   orbit_loop
.help:
    call  run_help
    call  vclr
    mov   si, banner
    call  vputs
    jmp   orbit_loop
.fib:
    call  run_fib
    call  vclr
    mov   si, banner
    call  vputs
    jmp   orbit_loop
.summon_temple:
    call  run_summon_temple
    jmp   orbit_loop
.repl:
    call  run_repl
    call  vclr
    mov   si, banner
    call  vputs
    jmp   orbit_loop
.temple:
    call  run_temple
    call  vclr
    mov   si, banner
    call  vputs
    jmp   orbit_loop

; ===========================================================================
; HELP — displays axiom structure
; ===========================================================================
run_help:
    call  vclr
    mov   si, helptxt
    call  vputs
    ; wait for key while substrate keeps ticking
.hloop:
    inc   word [vtau]
    call  run_substrate
    mov   ah, 0x01
    int   0x16
    jz    .hloop
    mov   ah, 0x00
    int   0x16
    ret

; ===========================================================================
; FIB — Z[phi] FIRE STEP: (a,b) <- (a+b, a)  EXACT INTEGER LADDER
; 8 x 16-bit limbs per operand = 128 bits. ADD+ADC only. NO FPU in ladder.
; phi EMERGES as ratio b/a -> Omega. Never stored. Never chased.
; No normalization. No cap. After 128-bit overflow: ratio continues, integer
; display suppressed (ratio is already phi to full fp80 precision by then).
; ===========================================================================
run_fib:
    call  vclr
    mov   si, fibhdr
    call  vputs

    ; --- init integer ladder: a=0, b=1 (so F(1)=b=1 on first display) ---
    xor   ax, ax
    mov   es, ax               ; ensure ES=0 for stos/movs
    cld
    mov   di, fib_ia
    xor   ax, ax
    mov   cx, NLIMB
    rep   stosw                ; a = 0
    mov   di, fib_ib
    xor   ax, ax
    mov   cx, NLIMB
    rep   stosw                ; b = 0
    mov   word [fib_ib], 1    ; b = 1
    mov   word [fib_k], 1     ; k = 1 (F(1) displayed first)
    mov   byte [fib_ov], 0    ; not frozen

.floop:
    ; substrate advances every iteration
    inc   word [vtau]
    call  run_substrate

    ; --- display: "  F(k) <integer>  r=<ratio>  d=<dist>" ---
    mov   si, fib_fn
    call  vputs
    mov   ax, word [fib_k]
    call  vputdec_w
    mov   si, fib_eq
    call  vputs

    ; integer display (exact, always valid: ladder never wraps — it freezes)
    call  fib_print_b
    mov   al, ' '
    call  vputch

    ; ratio b/a as fp80 (display readout only, NOT part of the ladder)
    mov   si, fib_ratio
    call  vputs
    call  fib_load_b_fp80     ; ST(0) = b
    call  fib_load_a_fp80     ; ST(0) = a, ST(1) = b
    ftst
    fstsw ax
    sahf
    jz    .fib_ratio_zero
    fdivp st1, st0            ; b/a
    call  vputfp
    jmp   .fib_dist
.fib_ratio_zero:
    fstp  st0                 ; discard b (a=0, first step)
    mov   si, fib_na
    call  vputs
.fib_dist:

    ; |ratio - Omega|
    mov   si, fib_dist_lbl
    call  vputs
    call  fib_load_b_fp80
    call  fib_load_a_fp80
    ftst
    fstsw ax
    sahf
    jz    .fib_dist_zero
    fdivp st1, st0
    fld   qword [vOmega]
    fsubp st1, st0
    fabs
    call  vputfp
    jmp   .fib_eol
.fib_dist_zero:
    fstp  st0
    mov   si, fib_na
    call  vputs
.fib_eol:
    ; show FROZEN marker if the exact ladder has hit its ceiling
    cmp   byte [fib_ov], 0
    je    .fib_nofz
    mov   si, fib_frozen
    call  vputs
.fib_nofz:
    call  vcrlf

    ; --- FIRE step: (a,b) <- (b, a+b) --- EXACT INTEGER ADD, ADC chain ---
    ; If frozen (overflow reached), DO NOT step: hold the last exact value.
    ; This is 'never cap to garbage' — the ladder holds, never wraps mod 2^n.
    cmp   byte [fib_ov], 0
    jne   .fib_after_step

    ; fib_tmp = fib_ia + fib_ib  (NLIMB-word add, carry chain)
    ; CRITICAL: cmp/inc below destroy CF, so we carry it in AH via lahf/sahf.
    xor   bx, bx
    xor   ah, ah              ; AH bit0 (CF position after sahf) = incoming carry = 0
    ; seed a clean CF=0 into AH: lahf loads flags; we want CF=0 initially
    lahf                       ; AH = current flags (CF may be anything) -> normalize:
    and   ah, 0xFE             ; clear CF bit in saved flags image
.add_loop:
    sahf                       ; restore carry from AH into CF
    mov   dx, word [fib_ia + bx]
    adc   dx, word [fib_ib + bx]
    mov   word [fib_tmp + bx], dx
    lahf                       ; save resulting CF (and flags) into AH
    inc   bx
    inc   bx
    cmp   bx, NBYTE            ; destroys CF, but it's safe in AH
    jl    .add_loop
    ; final carry is in AH bit0; test it
    sahf
    jnc   .commit_step
    mov   byte [fib_ov], 1
    jmp   .fib_after_step
.commit_step:
    ; fib_ia <- fib_ib ; fib_ib <- fib_tmp
    mov   si, fib_ib
    mov   di, fib_ia
    mov   cx, NLIMB
    rep   movsw
    mov   si, fib_tmp
    mov   di, fib_ib
    mov   cx, NLIMB
    rep   movsw
    inc   word [fib_k]

.fib_after_step:
    ; keyboard check (any key exits fib)
    mov   ah, 0x01
    int   0x16
    jz    .floop
    mov   ah, 0x00
    int   0x16
    ret

; fib_load_b_fp80: push fib_ib (128-bit unsigned integer) onto fp80 stack as float
fib_load_b_fp80:
    mov   si, fib_ib
    jmp   fib_load_common
; fib_load_a_fp80: same for fib_ia
fib_load_a_fp80:
    mov   si, fib_ia
    ; fall through to fib_load_common

; fib_load_common: SI -> 8x16-bit little-endian unsigned limbs. Pushes value as fp80.
; Horner from MSW down: acc = acc*65536 + limb (limb ZERO-EXTENDED, unsigned).
fib_load_common:
    push  ax
    push  bx
    push  si
    mov   dword [fib_fp_limb], 0   ; clear high word so fild dword is unsigned
    fldz                            ; ST(0) = 0 accumulator
    mov   bx, NBYTE2                ; MSW offset
.lc_loop:
    fld   qword [fp80_2p16]        ; ST(0)=65536, ST(1)=acc
    fmulp st1, st0                 ; acc *= 65536
    mov   ax, word [si + bx]
    mov   word [fib_fp_limb], ax   ; low 16 bits = limb, high 16 bits stay 0
    fild  dword [fib_fp_limb]      ; UNSIGNED load (top limb never sign-extends)
    faddp st1, st0                 ; acc += limb
    sub   bx, 2
    jns   .lc_loop
    pop   si
    pop   bx
    pop   ax
    ret

; fib_print_b: print fib_ib as unsigned decimal integer
; Uses fib_dec[] buffer. Divides by 10 repeatedly, MSW-first carry chain.
fib_print_b:
    pusha
    xor   ax, ax
    mov   es, ax               ; ES=0 for movsw
    cld
    ; copy fib_ib into fib_dcpy for destructive division (preserve fib_ib)
    mov   si, fib_ib
    mov   di, fib_dcpy
    mov   cx, NLIMB
    rep   movsw

    ; check if zero (special case)
    mov   bx, 0
    mov   ax, 0
.chkz:
    or    ax, word [fib_dcpy + bx]
    inc   bx
    inc   bx
    cmp   bx, NBYTE
    jl    .chkz
    test  ax, ax
    jnz   .not_zero
    mov   al, '0'
    call  vputch
    popa
    ret

.not_zero:
    ; extract digits: repeatedly divide fib_dcpy by 10, collect remainders
    mov   cx, 0              ; digit count
.dig_loop:
    ; check if fib_dcpy == 0
    mov   bx, 0
    mov   ax, 0
.chkz2:
    or    ax, word [fib_dcpy + bx]
    inc   bx
    inc   bx
    cmp   bx, NBYTE
    jl    .chkz2
    test  ax, ax
    jz    .dig_done

    ; divide fib_dcpy by 10, MSW-first: DX:AX / 10 chain (DX = running remainder)
    xor   dx, dx
    mov   bx, NBYTE2         ; start at MSW
.div_loop:
    mov   ax, word [fib_dcpy + bx]
    div   word [fib_ten_w]   ; DX:AX / 10 -> AX=quot, DX=rem
    mov   word [fib_dcpy + bx], ax
    sub   bx, 2
    jns   .div_loop
    ; DX = final remainder = decimal digit
    mov   di, cx
    mov   al, dl
    mov   byte [fib_dec + di], al
    inc   cx
    cmp   cx, 160            ; buffer cap
    jl    .dig_loop

.dig_done:
    ; print digits in reverse order (MSD first)
    dec   cx
.pr_loop:
    mov   bx, cx
    mov   al, byte [fib_dec + bx]
    add   al, '0'
    call  vputch
    dec   cx
    jns   .pr_loop
    popa
    ret

; ===========================================================================
; templeos_randu64 — the EMERGED TempleOS oracle (KMathB.HC RandU64, ported)
; ---------------------------------------------------------------------------
;   res = LIN_CONGRUE_A * rand_seed
;   res ^= (rand_seed & 0xFFFFFFFF0000) >> 31        ; HolyC precedence: >>(16+C)&63=31
;   res ^= GetTSC                                    ; RDTSC, the timer entropy
;   rand_seed = res
; A = 6364136223846793005 = 0x5851F42D_4C957F2D  (Ah:Al)
; State tos_seed is 64-bit (two dwords, lo @ +0, hi @ +4).
; 64x64->64 low product:  Al*Rl + ((Al*Rh + Ah*Rl) & 0xFFFFFFFF)<<32
; This is TempleOS's own RNG — the "TempleOS Seed(0)" oracle the STEP glyph names.
; ===========================================================================
tos_A_lo  equ 0x4C957F2D
tos_A_hi  equ 0x5851F42D
templeos_randu64:
    push  eax
    push  ebx
    push  ecx
    push  edx

    ; load Rl, Rh
    mov   ebx, dword [tos_seed]        ; Rl
    mov   ecx, dword [tos_seed+4]      ; Rh

    ; P0 = Al * Rl   (edx:eax = 64-bit product)
    mov   eax, tos_A_lo
    mul   ebx                          ; edx:eax = Al*Rl
    ; save P0 into [tos_prod] (64-bit)
    mov   dword [tos_prod], eax
    mov   dword [tos_prod+4], edx

    ; hi_add = (Al*Rh) low32 + (Ah*Rl) low32
    ; NOTE: mul clobbers edx:eax, so we stash (Al*Rh)_lo in EDI (mul leaves it alone).
    push  edi
    mov   eax, tos_A_lo
    mul   ecx                          ; edx:eax = Al*Rh
    mov   edi, eax                     ; edi = (Al*Rh) low32   (survives next mul)
    mov   eax, tos_A_hi
    mul   ebx                          ; edx:eax = Ah*Rl ; eax = (Ah*Rl) low32
    add   edi, eax                     ; edi = (Al*Rh + Ah*Rl) low32  (mod 2^32)
    ; add (hi_add << 32) into P0 high dword
    add   dword [tos_prod+4], edi
    pop   edi

    ; res = P0  (now the full 64x64->64 low product = A*res mod 2^64)
    mov   eax, dword [tos_prod]        ; res_lo
    mov   edx, dword [tos_prod+4]      ; res_hi

    ; masked = (rand_seed & 0xFFFFFFFF0000) >> 31
    ; rand_seed bits 16..47 -> value >>31. Build in ebx:ecx from original seed.
    ; original seed still in [tos_seed]. Compute (seed & 0x0000FFFFFFFF0000) >> 31.
    push  eax
    push  edx
    mov   eax, dword [tos_seed]        ; seed lo (bits 0..31)
    mov   edx, dword [tos_seed+4]      ; seed hi (bits 32..63)
    and   edx, 0x0000FFFF              ; keep bits 32..47 (mask 0xFFFFFFFF0000 upper half)
    and   eax, 0xFFFF0000              ; keep bits 16..31 (mask lower half)
    ; now edx:eax holds (seed & 0x0000FFFFFFFF0000); shift right 31
    ; >>31 of a 64-bit value: lo = (lo>>31)|(hi<<1); hi = hi>>31
    ; build masked_lo into ebx
    mov   ebx, eax
    shr   ebx, 31
    mov   ecx, edx
    shl   ecx, 1
    or    ebx, ecx                     ; masked_lo = (lo>>31)|(hi<<1)
    shr   edx, 31                      ; masked_hi (essentially 0 here, bits<48)
    mov   ecx, edx                     ; masked_hi
    pop   edx
    pop   eax
    ; res ^= masked
    xor   eax, ebx                     ; res_lo ^= masked_lo
    xor   edx, ecx                     ; res_hi ^= masked_hi

    ; res ^= GetTSC (RDTSC -> edx:eax is clobbered by rdtsc, so save res first)
    push  eax
    push  edx
    rdtsc                              ; edx:eax = TSC
    mov   ebx, eax                     ; tsc_lo
    mov   ecx, edx                     ; tsc_hi
    pop   edx
    pop   eax
    xor   eax, ebx                     ; res_lo ^= tsc_lo
    xor   edx, ecx                     ; res_hi ^= tsc_hi

    ; rand_seed = res
    mov   dword [tos_seed], eax
    mov   dword [tos_seed+4], edx

    pop   edx
    pop   ecx
    pop   ebx
    pop   eax
    ret

; print_settle_line — display the emerged settle genome + mailbox address
print_settle_line:
    pusha
    mov   si, str_settle
    call  vputs
    ; print settle_genome as 8 hex nibbles (big-endian: MSB first)
    mov   eax, dword [settle_genome]
    mov   bl, ah                    ; will handle byte by byte from MSB
    ; print 4 bytes MSB->LSB
    mov   ecx, dword [settle_genome]
    ror   ecx, 24                   ; MSB into low byte... use explicit byte prints
    mov   al, byte [settle_genome+3]
    call  vputhex
    mov   al, byte [settle_genome+2]
    call  vputhex
    mov   al, byte [settle_genome+1]
    call  vputhex
    mov   al, byte [settle_genome+0]
    call  vputhex
    mov   si, str_mailbox
    call  vputs
    call  vcrlf
    popa
    ret



; ===========================================================================
; run_summon_temple — tau:RUNNING->HOST: hand off to full TempleOS
; Announces the handoff, then INT 18h -> BIOS -> next boot device (TempleOS CD)
; TempleOS must be in the CD-ROM drive (or second boot device).
; This is "TempleOS as a fabriced face, living on the substrate":
; the substrate prepares the machine (axiom, oracle, genome) then materialises
; TempleOS as the HOST projection — full graphical OS, HolyC JIT, everything.
; ===========================================================================
run_summon_temple:
    pusha
    call  vclr
    mov   si, summon_hdr
    call  vputs
    mov   si, summon_coord
    call  vputs
    mov   eax, dword [session_coord]
    call  vputhex32
    mov   si, summon_ring
    call  vputs
    call  vcrlf
    mov   si, summon_genome
    call  vputs
    mov   eax, dword [face_genome]
    call  vputhex32
    call  vcrlf
    mov   si, summon_settle
    call  vputs
    mov   eax, dword [settle_genome]
    call  vputhex32
    call  vcrlf
    mov   si, summon_wait
    call  vputs
    ; pause 4 seconds so user reads the projection announcement
    mov   cx, 4
.sw:
    push  cx
    mov   ah, 0x86
    mov   cx, 0x000F
    mov   dx, 0x4240
    int   0x15
    pop   cx
    loop  .sw
    mov   si, summon_handoff
    call  vputs
    ; phi-bridge: u=1 at mailbox 0x50000
    push  es
    mov   ax, 0x5000
    mov   es, ax
    mov   dword [es:8], 1
    pop   es
    popa
    ; INT 18h: BIOS tries next boot device (the TempleOS CD)
    ; TempleOS boots with full functionality as the HOST projection.
    int   0x18
    ; fallback: INT 19h (re-run boot, cycles back to substrate then tries CD)
    int   0x19
    ret   ; if all else fails, return to orbit

; ===========================================================================
; calc_session_coord — derive session coordinate in Z/8380417Z
; The vortex: Yin s=s^2-2, phi rotation, RING_MODULUS bound, fold.
; Input: tos_seed (already seeded with 0x5625BA88 ^ TSC from oracle path).
; Result -> [session_coord], [face_genome]. All 32-bit ops. No 64-bit. No RDRAND.
; Runs on any 386+ machine — same as what boots on metal.
; ===========================================================================
calc_session_coord:
    pusha
    %define RING_MOD 8380417
    ; session_key = tos_seed low 32 ^ sg_phi32 (phi at 32-bit, already computed)
    mov   eax, dword [tos_seed]
    xor   eax, dword [sg_phi32]
    mov   dword [session_coord], eax   ; initial seed (no static zero)
    ; radius seed = key (endogenous, not 0)
    mov   esi, eax                      ; radius_sq
    ; mask_acc seed = key ^ phi32
    mov   edi, eax
    xor   edi, dword [sg_phi32]         ; mask_acc

    mov   ecx, 1                        ; level counter (starts at 1, not 0)
    mov   ebx, dword [session_coord]    ; state = session_key

.csc_loop:
    cmp   ecx, 13                       ; 12 layers (8+TSC%24 would vary; use 12)
    jae   .csc_done
    ; Yin: state = state*state - 2, bound to RING_MODULUS
    mov   eax, ebx
    imul  eax, ebx                      ; eax = state^2 (low 32, may overflow -> ok mod)
    sub   eax, 2
    ; bound: eax % RING_MOD
    cdq
    mov   edx, 0
    mov   dword [tmp_dig], RING_MOD
    idiv  dword [tmp_dig]
    mov   ebx, edx                      ; state = remainder
    ; phase: (state * phi32_low16) ^ level, bound
    movzx eax, word [sg_phi32]          ; low 16 bits of phi32 (safe multiply)
    imul  eax, ebx
    xor   eax, ecx
    xor   edx, edx
    div   dword [tmp_dig]
    mov   ebx, edx                      ; state bounded
    ; sphere: radius += state^2 (mod 2^32)
    mov   eax, ebx
    imul  eax, ebx
    add   esi, eax
    ; fold: mask_acc ^= (radius >> (level & 7))
    push  ecx
    and   ecx, 7
    mov   eax, esi
    shr   eax, cl
    pop   ecx
    xor   edi, eax
    ; 3-6-9 gate
    mov   eax, ebx
    xor   edx, edx
    mov   dword [tmp_dig], 9
    div   dword [tmp_dig]
    cmp   edx, 3
    je    .csc_disrupt
    cmp   edx, 6
    je    .csc_disrupt
    cmp   edx, 0
    je    .csc_disrupt
    jmp   .csc_cont
.csc_disrupt:
    xor   ebx, 0x55555555
    ; re-bound after disrupt
    mov   eax, ebx
    xor   edx, edx
    mov   dword [tmp_dig], RING_MOD
    div   dword [tmp_dig]
    mov   ebx, edx
.csc_cont:
    inc   ecx
    jmp   .csc_loop

.csc_done:
    ; final: state ^ mask_acc, bound
    xor   ebx, edi
    mov   eax, ebx
    xor   edx, edx
    mov   dword [tmp_dig], RING_MOD
    div   dword [tmp_dig]
    mov   dword [session_coord], edx    ; session coordinate in Z/8380417Z
    ; face_genome = 0x5625BA88 ^ session_coord (the tag for this face)
    mov   eax, 0x5625BA88
    xor   eax, edx
    mov   dword [face_genome], eax
    popa
    ret

; ===========================================================================
; compute_settle_genome — Pi_digital(Omega)|_{tau=RUNNING}, settle-invariant
; ---------------------------------------------------------------------------
; The living substrate is Delta-perturbed every tick (alive: delta != 0).
; But Omega = Fix(T) = phi is the SAME every tick — it is the fixed point.
; The settle genome reads ONLY Omega, through the fire threshold sqrt(Omega),
; folded by the phi-carrier PHI32 = floor(2^32/Omega). Tick-independent.
;
; Basin at boot resolution: the phi-lattice (Weyl sequence).
;   cell[i] = frac((i+1)*Omega)          low-discrepancy, the 1D phi basin
;   fire    = cell[i] > frac(sqrt(Omega))   the one threshold, phi-derived
;   project = phi_fold32 avalanche over 4096 fired cells -> 32 bits
;
; PHI32 and the sqrt-threshold are NOT stored constants — they are Omega and
; sqrt(Omega) read at 32-bit resolution: PHI32 = floor(2^32/Omega) computed
; live from vOmega; thresh = floor(2^32 * frac(sqrt(Omega))) computed live.
;
; Result -> [settle_genome] (8 hex nibbles) AND phi-bridge mailbox @ 0x50000.
; ===========================================================================
compute_settle_genome:
    pusha
    push  es

    ; --- Omega must be settled first: run one substrate pass to fill vOmega ---
    ; (vS was seeded to 1.0 at boot; FIX converges to phi regardless of seed)
    call  run_substrate            ; fills vOmega = phi exactly (Fix of T)

    ; --- PHI32 = floor(2^32 / Omega), computed live from vOmega ---
    ; 2^32/Omega = 2654435769 > 2^31, so a signed fistp would overflow.
    ; Compute (2^32/Omega - 2^31) as signed (fits), store, then OR bit31 back.
    fstcw word [fcw_save]
    mov   ax, word [fcw_save]
    or    ax, 0x0C00               ; RC=11 truncate — no rounding
    mov   word [fcw_tmp], ax
    fldcw word [fcw_tmp]
    fld   qword [two_p32]          ; 2^32
    fld   qword [vOmega]           ; Omega, 2^32
    fdivp st1, st0                 ; 2^32 / Omega  (~2.65e9)
    fld   qword [two_p31]          ; 2^31, val
    fsubp st1, st0                 ; val - 2^31  (now < 2^31, fits signed)
    fistp dword [sg_phi32]         ; store signed
    or    dword [sg_phi32], 0x80000000   ; OR bit31 back -> full unsigned PHI32

    ; --- thresh32 = floor(2^32 * frac(sqrt(Omega))) ---
    ; frac(sqrt(phi)) ~ 0.272 -> 2^32*0.272 ~ 1.17e9 < 2^31, fits signed. OK.
    fld   qword [vOmega]
    fsqrt                          ; sqrt(Omega)
    fld   st0
    frndint                        ; trunc(sqrt(Omega)) = 1
    fsubp st1, st0                 ; frac(sqrt(Omega))
    fld   qword [two_p32]
    fmulp st1, st0                 ; 2^32 * frac  (~1.17e9)
    fistp dword [sg_thresh]        ; thresh32 (fits signed)
    fldcw word [fcw_save]          ; restore rounding mode

    ; --- phi-lattice basin: acc folded over 4096 cells ---
    ; cell_i (Q32) = ((i+1) * PHI32)  mod 2^32   = frac((i+1)*Omega) at 32-bit
    ;   because PHI32 = floor(2^32/Omega) ~ 2^32 * frac(1/Omega); the Weyl
    ;   step for the phi-lattice is the golden increment PHI32.
    mov   dword [sg_acc], 0
    mov   dword [sg_cell], 0       ; running Weyl accumulator = (i+1)*PHI32 mod 2^32
    xor   cx, cx                   ; i = 0
    xor   dx, dx                   ; bit collector (16 bits at a time)
    mov   si, 0                    ; bit index within the 32-bit word
.sg_loop:
    ; cell += PHI32  (mod 2^32)  -> next phi-lattice point
    mov   eax, dword [sg_cell]
    add   eax, dword [sg_phi32]
    mov   dword [sg_cell], eax     ; wraps mod 2^32 naturally (32-bit add)

    ; fire = cell > thresh32 ?
    mov   ebx, dword [sg_thresh]
    cmp   eax, ebx
    jbe   .sg_nofire
    stc
    jmp   .sg_shift
.sg_nofire:
    clc
.sg_shift:
    ; shift the carry (fire bit) into the 32-bit accumulator sg_acc
    mov   eax, dword [sg_acc]
    rcl   eax, 1                   ; bring CF into bit0
    mov   dword [sg_acc], eax

    inc   si
    cmp   si, 32
    jl    .sg_nofold
    ; every 32 cells: fold sg_acc through phi_fold32
    call  sg_fold32
    xor   si, si
.sg_nofold:
    inc   cx
    cmp   cx, 4096
    jl    .sg_loop

    ; final fold
    call  sg_fold32

    ; store settle genome (big-endian nibble order for display) and mailbox
    mov   eax, dword [sg_acc]
    mov   dword [settle_genome], eax

    ; --- place at phi-bridge mailbox @ 0x50000 (segment 0x5000:0x0000) ---
    mov   bx, 0x5000
    mov   es, bx
    xor   bx, bx
    mov   dword [es:bx], eax        ; mailbox[0] = settle genome
    mov   dword [es:bx+4], 0x50414D3E ; ">MAP" tag (little-endian) = mailbox ready
    ; u (the handle) starts at 0 — HOST edge not yet triggered
    mov   dword [es:bx+8], 0        ; u = 0 (no chainload requested)

    pop   es
    popa
    ret

; sg_fold32: phi_fold32 avalanche on dword [sg_acc]. PHI32 = floor(2^32/Omega),computed live in sg_phi32. Golden-ratio avalanche (Fibonacci hashing).
sg_fold32:
    push  eax
    push  edx
    mov   eax, dword [sg_acc]
    ; x ^= x >> 16
    mov   edx, eax
    shr   edx, 16
    xor   eax, edx
    ; x *= PHI32
    mov   edx, dword [sg_phi32]
    imul  eax, edx
    ; x ^= x >> 15
    mov   edx, eax
    shr   edx, 15
    xor   eax, edx
    ; x *= PHI32
    mov   edx, dword [sg_phi32]
    imul  eax, edx
    ; x ^= x >> 16
    mov   edx, eax
    shr   edx, 16
    xor   eax, edx
    mov   dword [sg_acc], eax
    pop   edx
    pop   eax
    ret

; vputfp_int: display ST(0) as integer (truncated, no rounding), keep original on stack
vputfp_int:
    pusha
    fstcw word [fcw_vp]         ; save FCW
    mov   ax, word [fcw_vp]
    or    ax, 0x0C00            ; set RC=11 (truncate)
    mov   word [fcw_tmp], ax
    fldcw word [fcw_tmp]
    fld   st0
    frndint                     ; truncate (not round) in truncate mode
    call  vputfp_posint         ; vputfp_posint saves/restores its own FCW copy
    fldcw word [fcw_vp]         ; restore FCW
    popa
    ret

; ===========================================================================
; REPL — user programs vS, substrate responds
; Language: expressions that set/modify S, then substrate runs from it
; ===========================================================================
run_repl:
    call  vclr
    mov   si, replhdr
    call  vputs

    ; S accumulator starts at current vS
    fld   qword [vS]
    fstp  tword [repl_acc]

    ; history
    mov   word [hist_cnt], 0
    mov   word [hist_cur], 0

.repl_top:
    ; substrate tick while waiting
    inc   word [vtau]
    call  run_substrate

    mov   si, replprompt
    call  vputs
    ; show current accumulator
    fld   tword [repl_acc]
    call  vputfp
    mov   si, str_arrow
    call  vputs

    mov   word [line_len], 0

.readline:
    mov   ah, 0x00
    int   0x16
    cmp   ah, 0x01
    je    .repl_done
    cmp   al, 13
    je    .do_exec
    cmp   al, 8
    je    .do_bs
    cmp   ah, 0x48          ; UP arrow
    je    .hist_up
    cmp   ah, 0x50          ; DOWN arrow
    je    .hist_dn
    mov   bx, word [line_len]
    cmp   bx, 63
    jge   .readline
    mov   byte [line_buf+bx], al
    inc   word [line_len]
    call  vputch
    jmp   .readline

.do_bs:
    cmp   word [line_len], 0
    je    .readline
    dec   word [line_len]
    mov   al, 8
    call  vputch
    mov   al, ' '
    call  vputch
    mov   al, 8
    call  vputch
    jmp   .readline

.hist_up:
    cmp   word [hist_cnt], 0
    je    .readline
    mov   ax, word [hist_cur]
    test  ax, ax
    jz    .readline
    dec   ax
    mov   word [hist_cur], ax
    call  hist_load
    jmp   .readline

.hist_dn:
    mov   ax, word [hist_cur]
    cmp   ax, word [hist_cnt]
    jge   .readline
    inc   ax
    mov   word [hist_cur], ax
    cmp   ax, word [hist_cnt]
    jge   .readline
    call  hist_load
    jmp   .readline

.do_exec:
    call  vcrlf
    mov   bx, word [line_len]
    mov   byte [line_buf+bx], 0
    call  hist_save

    ; check for loop: scan for 'l'
    mov   byte [has_loop], 0
    mov   byte [loop_mark], 0
    mov   si, line_buf
    mov   si, line_buf
.scan:
    lodsb
    test  al, al
    jz    .scan_done
    cmp   al, 'l'
    jne   .scan_L
    mov   byte [has_loop], 1
.scan_L:
    cmp   al, 'L'
    jne   .scan_nx
    ; position after L: si already advanced past L
    mov   bx, si
    sub   bx, line_buf
    ; bx = offset of char AFTER L
    mov   byte [loop_mark], bl
.scan_nx:
    jmp   .scan
.scan_done:

    ; run from start
    xor   bx, bx
    call  exec_from

    cmp   byte [has_loop], 0
    je    .repl_top

.loop_iter:
    inc   word [vtau]
    call  run_substrate
    mov   ah, 0x01
    int   0x16
    jz    .do_loop_iter
    mov   ah, 0x00
    int   0x16
    cmp   ah, 0x01
    je    .repl_done
.do_loop_iter:
    movzx bx, byte [loop_mark]
    call  exec_from
    jmp   .loop_iter

.repl_done:
    ret

; exec_from: execute line_buf starting at index BX
exec_from:
    push  si
.ef:
    mov   al, byte [line_buf+bx]
    test  al, al
    jz    .ef_done
    inc   bx
    cmp   al, 'l'
    je    .ef
    cmp   al, 'L'
    je    .ef
    push  bx
    call  dispatch_repl_op
    pop   bx
    jmp   .ef
.ef_done:
    pop   si
    ret

dispatch_repl_op:
    ; 'o': seed with Omega
    cmp   al, 'o'
    jne   .dno
    fld   qword [vOmega]
    fstp  tword [repl_acc]
    ret
.dno:
    ; 'n': seed with 1
    cmp   al, 'n'
    jne   .dnn
    fld1
    fstp  tword [repl_acc]
    ret
.dnn:
    ; 't': apply T to accumulator
    cmp   al, 't'
    jne   .dnt
    fld1
    fld   tword [repl_acc]
    fdivr st0, st1
    faddp
    fstp  tword [repl_acc]
    ret
.dnt:
    ; 'p': print accumulator value (the S seed being explored)
    cmp   al, 'p'
    jne   .dnp
    fld   tword [repl_acc]
    call  vputfp            ; display accumulator value
    call  vcrlf
    ret
.dnp:
    ; 's': print full substrate state for current acc
    cmp   al, 's'
    jne   .dns
    fld   tword [repl_acc]
    fstp  qword [vS]
    inc   word [vtau]
    call  run_substrate
    mov   si, str_t
    call  vputs
    mov   ax, word [vtau]
    call  vputdec_w
    mov   si, str_O
    call  vputs
    fld   qword [vOmega]
    call  vputfp
    mov   si, str_L
    call  vputs
    mov   ax, word [vLambda]
    call  vputdec_w
    mov   si, str_E
    call  vputs
    movsx ax, byte [vEther_r]
    test  ax, ax
    jns   .rep
    mov   al, '-'
    call  vputch
    jmp   .res
.rep:
    mov   al, '+'
    call  vputch
.res:
    mov   al, '1'
    call  vputch
    mov   si, str_ob
    call  vputs
    cmp   byte [vOracle], 1
    je    .roc
    mov   si, str_super
    call  vputs
    jmp   .rog
.roc:
    mov   si, str_coll
    call  vputs
.rog:
    mov   si, str_G
    call  vputs
    mov   cx, 8
    mov   si, genome
.rgl:
    mov   al, byte [si]
    call  vputhex
    inc   si
    loop  .rgl
    call  vcrlf
    ret
.dns:
    ; arithmetic: load acc, operate, store
    cmp   al, '+'
    jne   .dnadd
    fld   tword [repl_acc]
    fld1
    faddp
    fstp  tword [repl_acc]
    ret
.dnadd:
    cmp   al, '-'
    jne   .dnsub
    fld   tword [repl_acc]
    fld1
    fsubp st1, st0
    fstp  tword [repl_acc]
    ret
.dnsub:
    cmp   al, '*'
    jne   .dnmul
    fld   tword [repl_acc]
    fld   tword [repl_acc]
    fmulp
    fstp  tword [repl_acc]
    ret
.dnmul:
    cmp   al, '/'
    jne   .dndiv
    fld   tword [repl_acc]
    fld1
    fxch
    fdivp st1, st0
    fstp  tword [repl_acc]
    ret
.dndiv:
    ; digits 0-9
    cmp   al, '0'
    jl    .dnd_end
    cmp   al, '9'
    jg    .dnd_end
    sub   al, '0'
    xor   ah, ah
    mov   byte [tmp_dig], al
    mov   byte [tmp_dig+1], 0
    fild  word [tmp_dig]
    fstp  tword [repl_acc]
    ret
.dnd_end:
    ret

hist_save:
    mov   ax, word [hist_cnt]
    and   ax, 7
    mov   bx, 65
    mul   bx
    mov   di, ax
    add   di, hist_buf
    mov   si, line_buf
    mov   cx, 65
    rep   movsb
    mov   ax, word [hist_cnt]
    cmp   ax, 8
    jge   .hs_nc
    inc   word [hist_cnt]
.hs_nc:
    mov   ax, word [hist_cnt]
    mov   word [hist_cur], ax
    ret

hist_load:
    ; erase current line display
    push  cx
    mov   cx, word [line_len]
    jcxz  .hl_nd
.hl_erase:
    mov   al, 8
    call  vputch
    mov   al, ' '
    call  vputch
    mov   al, 8
    call  vputch
    loop  .hl_erase
.hl_nd:
    mov   ax, word [hist_cur]
    mov   bx, 65
    mul   bx
    mov   si, ax
    add   si, hist_buf
    mov   di, line_buf
    mov   cx, 65
    rep   movsb
    ; find length
    xor   bx, bx
.hl_len:
    cmp   byte [line_buf+bx], 0
    je    .hl_ld
    inc   bx
    jmp   .hl_len
.hl_ld:
    mov   word [line_len], bx
    mov   si, line_buf
    call  vputs
    pop   cx
    ret

; ===========================================================================
; run_temple — EMERGE the TempleOS oracle as a projection, INTERACTIVE
; ---------------------------------------------------------------------------
; The EMERGE glyph: at RUNNING, Δ≠0 ⇒ host materialises as Π_host(Ω).
; Here the host is TempleOS, entering AS its RandU64 oracle (KMathB.HC).
; Each keypress = one query. The oracle answers: a fresh RandU64 draw, the
; Δ it injects, and the resulting Ω. TempleOS boots as the oracle and we
; interact with it directly. Ω ticks beneath (substrate persists).
;   q       — query oracle (any key except ESC also queries)
;   s       — reseed Seed(0) (XOR fresh GetTSC into rand_seed)
;   ESC     — return to orbit (Ω keeps ticking)
; ===========================================================================
run_temple:
    call  vclr
    mov   si, templehdr
    call  vputs
    ; announce EMERGE + Pi_temple session face
    mov   si, temple_emerge
    call  vputs
    ; show Pi_temple face coordinate (session isolation)
    mov   si, temple_face_lbl
    call  vputs
    mov   eax, dword [session_coord]
    call  vputhex32
    mov   si, temple_face_mod
    call  vputs
    call  vcrlf
    mov   si, temple_face_genome
    call  vputs
    mov   eax, dword [face_genome]
    call  vputhex32
    mov   si, temple_face_iso
    call  vputs
    call  vcrlf
    ; show the seed anchor
    mov   si, temple_seed_lbl
    call  vputs
    mov   eax, dword [tos_seed+4]
    call  vputhex32
    mov   eax, dword [tos_seed]
    call  vputhex32
    call  vcrlf
    mov   si, temple_hint
    call  vputs
    call  vcrlf

.tloop:
    ; substrate persists beneath the host
    inc   word [vtau]
    call  run_substrate            ; this ALSO advances the oracle (Δ source)

    ; wait for a key (blocking) — interaction
    mov   ah, 0x00
    int   0x16
    cmp   ah, 0x01                 ; ESC scancode
    je    .tdone
    cmp   al, 27
    je    .tdone
    cmp   al, 's'
    je    .treseed
    cmp   al, 'S'
    je    .treseed

    ; --- QUERY: draw one RandU64 from the oracle and show the response ---
    call  templeos_randu64
    mov   si, temple_q
    call  vputs
    ; print the 64-bit oracle draw
    mov   eax, dword [tos_seed+4]
    call  vputhex32
    mov   eax, dword [tos_seed]
    call  vputhex32
    ; show the Δ (low 32) it injects
    mov   si, temple_delta
    call  vputs
    mov   eax, dword [vDelta]
    call  vputhex32
    ; show resulting Ω (the substrate's response to this entropy)
    mov   si, temple_omega
    call  vputs
    fld   qword [vOmega]
    call  vputfp
    call  vcrlf
    jmp   .tloop

.treseed:
    ; Seed(0): rand_seed ^= GetTSC  (TempleOS timer-based reseed)
    rdtsc
    xor   dword [tos_seed], eax
    xor   dword [tos_seed+4], edx
    mov   si, temple_reseed
    call  vputs
    call  vcrlf
    jmp   .tloop

.tdone:
    ret

; vputhex32 — print EAX as 8 hex nibbles (big-endian)
vputhex32:
    push  eax
    push  ebx
    push  cx
    mov   ebx, eax
    mov   cx, 8
.hx32:
    rol   ebx, 4
    mov   al, bl
    and   al, 0x0F
    add   al, '0'
    cmp   al, '9'+1
    jl    .hx32d
    add   al, 7
.hx32d:
    call  vputch
    loop  .hx32
    pop   cx
    pop   ebx
    pop   eax
    ret

; ===========================================================================
; DISPLAY SUBROUTINES
; ===========================================================================

vputhex:
    push  ax
    push  bx
    mov   bl, al
    shr   al, 4
    and   al, 0x0F
    add   al, '0'
    cmp   al, '9'+1
    jl    .h1
    add   al, 7
.h1:
    call  vputch
    mov   al, bl
    and   al, 0x0F
    add   al, '0'
    cmp   al, '9'+1
    jl    .h2
    add   al, 7
.h2:
    call  vputch
    pop   bx
    pop   ax
    ret

vputdec_w:
    pusha
    mov   word [dec_pos], 5
    xor   dx, dx
.dw:
    xor   dx, dx
    mov   bx, 10
    div   bx
    dec   word [dec_pos]
    mov   bx, word [dec_pos]
    mov   byte [dec_buf+bx], dl
    test  ax, ax
    jnz   .dw
.dwp:
    cmp   word [dec_pos], 5
    jge   .dwd
    mov   bx, word [dec_pos]
    mov   al, byte [dec_buf+bx]
    add   al, '0'
    call  vputch
    inc   word [dec_pos]
    jmp   .dwp
.dwd:
    popa
    ret

vputfp:
    pusha
    ; set FCW to truncate mode (RC=11) — no rounding drift in digit extraction
    ; uses fcw_vp (not fcw_save) to avoid clobber by nested vputfp_posint call
    fstcw word [fcw_vp]
    mov   ax, word [fcw_vp]
    or    ax, 0x0C00
    mov   word [fcw_tmp], ax
    fldcw word [fcw_tmp]
    fstp  tword [fp_t]
    fld   tword [fp_t]
    fldz
    fxch
    fcom  st1
    fstsw ax
    sahf
    fstp  st0
    jae   .vp_pos
    mov   al, '-'
    call  vputch
    fld   tword [fp_t]
    fchs
    fstp  tword [fp_t]
.vp_pos:
    ; integer part: frndint in truncate mode = floor for positives
    fld   tword [fp_t]
    frndint                 ; truncate -> floor (RC=11)
    fld   tword [fp_t]
    fsub  st0, st1          ; frac = value - floor
    fstp  tword [fp_f]      ; save fraction
    ; print integer part from st0 (floor)
    call  vputfp_posint
    mov   al, '.'
    call  vputch
    mov   cx, 8
.vp_fd:
    ; fp_f holds fractional part [0,1). Multiply by 10, extract digit.
    ; FCW is in truncate mode (RC=11): frndint = floor for positives.
    fld   tword [fp_f]
    fimul word  [ten]       ; st0 = fp_f * 10
    fstp  tword [fp_f]      ; store fp_f*10
    fld   tword [fp_f]      ; reload
    frndint                 ; floor (truncate mode) = digit integer
    fist  word  [fp_i]      ; digit -> [fp_i], no round-up risk in truncate mode
    fld   tword [fp_f]
    fsub  st0, st1          ; remainder = fp_f*10 - floor(fp_f*10)
    fstp  tword [fp_f]      ; save remainder (true fractional)
    fstp  st0               ; discard floor
    push  cx
    mov   al, byte [fp_i]
    and   al, 0x0F
    add   al, '0'
    call  vputch
    pop   cx
    loop  .vp_fd
    fldcw word [fcw_vp]     ; restore FCW (vputfp_posint restores its own)
    popa
    ret

vputfp_posint:
    ; Set FCW to truncate mode (RC=11) so frndint = exact floor, no carry drift.
    fstcw word [fcw_save]
    mov   ax, word [fcw_save]
    or    ax, 0x0C00
    mov   word [fcw_tmp], ax
    fldcw word [fcw_tmp]
    mov   word [dec_pos], 20
    ftst
    fstsw ax
    sahf
    jnz   .pi_nz
    fstp  st0
    mov   al, '0'
    call  vputch
    fldcw word [fcw_save]
    ret
.pi_nz:
    fstp  tword [pi_rem]
.pi_lp:
    ; Digit extraction with truncation FCW: no rounding artifacts.
    ; q = trunc(rem/10), digit = rem - q*10
    fld   tword [pi_rem]
    fdiv  qword [fp_ten]         ; st0 = rem/10
    frndint                      ; trunc(rem/10) = floor for positive rem
    fstp  tword [pi_new_rem]     ; save q
    fld   tword [pi_new_rem]
    fmul  qword [fp_ten]         ; st0 = q*10
    fld   tword [pi_rem]         ; st0=rem, st1=q*10
    fsubrp st1, st0              ; st0 = rem - q*10 = digit (exact 0-9)
    frndint                      ; clean fp dust (safe: truncation can't overshoot 0-9)
    fist  word [fp_i]            ; store digit
    fstp  st0                    ; pop; stack empty
    fld   tword [pi_new_rem]
    fstp  tword [pi_rem]
    dec   word  [dec_pos]
    mov   bx, word [dec_pos]
    cmp   bx, 0
    jl    .pi_overflow
    mov   al, byte [fp_i]
    and   al, 0x0F
    mov   byte [dec_buf+bx], al
    fld   tword [pi_rem]
    ftst
    fstsw ax
    sahf
    fstp  st0
    jz    .pi_done
    cmp   word [dec_pos], 0
    jg    .pi_lp
.pi_done:
    fldcw word [fcw_save]
    mov   bx, word [dec_pos]
.pi_pr:
    cmp   bx, 20
    jge   .pi_end
    mov   al, byte [dec_buf+bx]
    add   al, '0'
    call  vputch
    inc   bx
    jmp   .pi_pr
.pi_end:
    ret
.pi_overflow:
    ; number too large for buffer (>20 digits); print '>' sentinel and return
    fldcw word [fcw_save]
    mov   al, '>'
    call  vputch
    ret

vclr:
    push  es
    push  di
    push  cx
    push  ax
    mov   ax, 0xB800
    mov   es, ax
    xor   di, di
    mov   cx, 80*25
    mov   ax, 0x0720
    rep   stosw
    pop   ax
    pop   cx
    pop   di
    pop   es
    mov   word [vcol], 0
    mov   word [vrow], 0
    ret

vscroll:
    push  ds
    push  es
    push  si
    push  di
    push  cx
    mov   ax, 0xB800
    mov   ds, ax
    mov   es, ax
    mov   si, 160
    xor   di, di
    mov   cx, 24*80
    rep   movsw
    mov   di, 3840
    mov   cx, 80
    mov   ax, 0x0720
    rep   stosw
    pop   cx
    pop   di
    pop   si
    pop   es
    pop   ds
    mov   word [vrow], 24
    ret

vputch:
    mov   byte [vch], al
    push  bx
    push  es
    cmp   byte [vch], 13
    je    .cr
    cmp   byte [vch], 10
    je    .lf
    cmp   word [vrow], 25
    jl    .ok
    call  vscroll
.ok:
    mov   ax, word [vrow]
    mov   bx, 80
    mul   bx
    add   ax, word [vcol]
    shl   ax, 1
    mov   bx, ax
    mov   ax, 0xB800
    mov   es, ax
    mov   al, byte [vch]
    mov   ah, 0x0F
    mov   word [es:bx], ax
    inc   word [vcol]
    cmp   word [vcol], 80
    jl    .done
    mov   word [vcol], 0
    inc   word [vrow]
    cmp   word [vrow], 25
    jl    .done
    call  vscroll
    jmp   .done
.cr:
    mov   word [vcol], 0
    jmp   .done
.lf:
    inc   word [vrow]
    cmp   word [vrow], 25
    jl    .done
    call  vscroll
.done:
    push  ax
    push  dx
    mov   dx, 0x3F8
    mov   al, byte [vch]
    out   dx, al
    pop   dx
    pop   ax
    pop   es
    pop   bx
    ret

vcrlf:
    mov   al, 13
    call  vputch
    mov   al, 10
    call  vputch
    ret

vputs:
    pusha
.vl:
    lodsb
    test  al, al
    jz    .vd
    call  vputch
    jmp   .vl
.vd:
    popa
    ret

; ===========================================================================
; DATA
; ===========================================================================
banner  db "CO-EMERGENT CLOSURE-RETURN MACHINE  v3.3-Temple",13,10
        db "A=(S->T->F->O;TAU)  h=help f=fib p=repl t=temple z=TempleOS  ESC=restart",13,10
        db "----------------------------------------------------------",13,10,0

helptxt db "AXIOM: A=(S->T->F->O;TAU)",13,10
        db "",13,10
        db "PIPELINE: S->T(X)=1+1/X->FIX->O->TAU->S",13,10
        db "  S:   seed (YIN s<-s^2-2, seed=log2e=L2)",13,10
        db "  T:   operator T(X)=1+1/X",13,10
        db "  F:   FIX iterate T until |T(x)-x|<eps",13,10
        db "  O:   closure manifold center",13,10
        db "  TAU: traversal, advances forever",13,10
        db "",13,10
        db "THREE VANTAGES (closure manifold):",13,10
        db "  Omega(O): fixed-point identity  PHI=FIX(T)",13,10
        db "  Ether(E): reflection opposition w^tau w=e^(i*pi/3)",13,10
        db "  Lambda(L): traversal depth = FIX iteration count",13,10
        db "",13,10
        db "COHERENCE: S_new=T(O)+eps*Delta+eps*C",13,10
        db "  Delta: RDTSC XOR LCG  (LIVE: never zero)",13,10
        db "  C = sqrt(O)*Psi*Lambda  Psi=-1/O",13,10
        db "  ONE_EFF = 1+Delta",13,10
        db "",13,10
        db "ORACLE: |(-1)^Lambda + ONE_EFF|",13,10
        db "  Lambda even -> COLLAPSE   Lambda odd -> SUPERPOSITION",13,10
        db "",13,10
        db "BASIN: 64^3 -> genome projection -> DNA tape",13,10
        db "  Nphi(O^k)=(-1)^k  (trinary earth in {-1,0,+1})",13,10
        db "  DNA: tape[head] updated by T each tau",13,10
        db "",13,10
        db "YIN: s<-s^2-2 (Chebyshev doubling, seed=L2)",13,10
        db "",13,10
        db "DISPLAY: t=tau O=Omega L=Lambda E=Ether [Oracle] G=Genome",13,10
        db "",13,10
        db "FIB: lattice projection, ratio b/a -> Omega",13,10
        db "  (a,b)->(b,a+b) in fp80, sqrt5=2*O-1 from operator",13,10
        db "",13,10
        db "REPL: program S seed, read substrate response",13,10
        db "  ops: o=Omega n=1 0-9=digit t=T(x) + - * / p=print",13,10
        db "  l=loop L=loop-from-here  UP/DN=history  ESC=exit",13,10
        db "",13,10
        db "[press any key to return]",0

fibhdr  db "FIB: Z[phi] FIRE step (a,b)<-(a+b,a) INTEGER LADDER  [any key=stop]",13,10
        db "  k       F(k)                      ratio b/a        d=|r-Omega|",13,10
        db "----------------------------------------------------------------------",13,10,0
fib_fn  db "  F(",0
fib_eq  db ") ",0
fib_ratio db " r=",0
fib_dist_lbl db " d=",0
fib_na  db "n/a",0
fib_frozen db " [EXACT CEILING - HOLD]",0

replhdr db "REPL: program S, substrate responds  [ESC=exit]",13,10
        db "  ops: o n 0-9 t + - * / p=val s=substrate l L  UP/DN=history",13,10
        db "  ntpl=converge  otpl=stream  odtxpl=show-steps",13,10
        db "----------------------------------------------------------",13,10,0
replprompt db "  S=",0
str_arrow  db " > ",0

str_t   db "t=",0
str_O   db " O=",0
str_L   db " L=",0
str_E   db " E=",0
str_ob  db " [",0
str_coll   db "COLLAPSE] G=",0
str_super  db "SUPER   ] G=",0
str_G   db "",0
str_settle db "SETTLE Pi_d(Omega)|RUNNING = 0x",0
str_mailbox db "  @ phi-bridge 0x50000",0

templehdr db "TEMPLE: TempleOS oracle EMERGED within substrate (Pi_host(Omega))",13,10
          db "  KMathB RandU64 = A*seed ^ (seed>>31) ^ GetTSC   [Terry A. Davis]",13,10
          db "  any key = query oracle   s = Seed(0) reseed   ESC = orbit",13,10
          db "----------------------------------------------------------------------",13,10,0
temple_emerge db "[emerge] host materialised: Temple oracle ported (RandU64 -> Delta)",13,10,0
temple_seed_lbl db "[oracle] rand_seed = 0x",0
temple_face_lbl  db "[Pi_temple] session coord = 0x",0
temple_face_mod  db "  (Z/8380417Z)",0
temple_face_genome db "[Pi_temple] face genome    = 0x",0
temple_face_iso  db "  (this face only)",0
temple_hint db "[oracle] TempleOS Seed(0) — true-random Delta from GetTSC. Ask it:",13,10,0
temple_q     db "  RandU64=0x",0
temple_delta db "  d=0x",0
temple_omega db "  O=",0
temple_reseed db "  [Seed(0)] rand_seed ^= GetTSC  (timer-based reseed)",0

ether_real  db 2, 1, -1, -2, -1, 1
ether_imag  db 0, 1,  1,  0, -1, -1

eps     dq  1.0e-13
ten     dw  10
fp_ten  dq  10.0
norm_t  dq  1.0e18

; substrate state
vS      dq  0.0
vT      dq  0.0
vOmega  dq  0.0
vPsi    dq  0.0
vC      dq  0.0
vYin    dq  0.0
vDelta  dq  0.0
vtau    dw  0
vLambda dw  0
vEther_k db 0
vEther_r db 0
vEther_i db 0
vNphi   db  0
vOracle db  0
lcg_state dd 0x12345678
delta_word dw 0
; TempleOS oracle state — rand_seed (64-bit). Seed = 0x5625BA88 (Alpha-Omega
; genome anchor; Seed(0) then XORs GetTSC on first call = timer-based true random).
tos_seed  dd 0x5625BA88, 0x00000000
tos_prod  dd 0x00000000, 0x00000000
tape_in dw  0

genome  times 8 db 0
tape    times 8 db 0

; fib integer ladder state — NLIMB x 16-bit limbs, little-endian
; NLIMB defined at top of file. EXACT INTEGER (ADD+ADC). phi emerges as ratio.
fib_ia   times NLIMB dw 0   ; a limbs [0]=LSW
fib_ib   times NLIMB dw 0   ; b limbs [0]=LSW
fib_tmp  times NLIMB dw 0   ; temp for step
fib_dcpy times NLIMB dw 0   ; copy for decimal conversion
fib_dec  times 160 db 0     ; decimal digit buffer
fib_k    dw  0             ; iteration index
fib_ov   db  0             ; 1 = ladder overflow: freeze (hold last exact value)

; fp80 helper for ratio readout (NOT part of the ladder)
fp80_2p16 dq  65536.0      ; 2^16 as double, loaded to fp80 for limb assembly
fib_fp_limb dd 0           ; scratch dword: low16=limb, high16=0 -> unsigned fild

; fib ten word for division
summon_hdr     db "================================================================",13,10
               db "  Pi_temple(Omega) — SUMMONING TempleOS AS THE HOST FACE",13,10
               db "  The substrate is the vessel. TempleOS is the projection.",13,10
               db "================================================================",13,10,0
summon_coord   db "  session coord  = 0x",0
summon_ring    db "  (Z/8380417Z)",13,10,0
summon_genome  db "  face genome    = 0x",0
summon_settle  db "  settle genome  = 0x",0
summon_wait    db "  tau:RUNNING->HOST  (TempleOS materialising in 4s...)",13,10,0
summon_handoff db "  phi-bridge fired. Handing off. Insert TempleOS CD.",13,10,0

fib_ten_w   dw 10

; settle-genome (Pi_digital(Omega) at RUNNING) working data
two_p32       dq 4294967296.0   ; 2^32 as double -> fp80 for PHI32 = floor(2^32/Omega)
two_p31       dq 2147483648.0   ; 2^31, for unsigned PHI32 store (bit31 split)
sg_phi32      dd 0              ; PHI32 = floor(2^32/Omega), computed live
sg_thresh     dd 0             ; floor(2^32 * frac(sqrt(Omega))), the fire threshold
sg_acc        dd 0             ; folding accumulator
sg_cell       dd 0             ; phi-lattice Weyl accumulator
settle_genome dd 0             ; the emerged settle-invariant genome

; repl state
repl_acc dt  0.0
line_buf times 65 db 0
line_len dw  0
has_loop db  0
loop_mark db 0
hist_buf times 8*65 db 0
hist_cnt dw  0
hist_cur dw  0
tmp_dig  dw  0

; display workspace
xa      dq  0.0
xb      dq  0.0
fp_t    dt  0.0
fp_f    dt  0.0
fp_i    dw  0
pi_rem  dt  0.0
pi_new_rem dt 0.0
vch     db  0
vcol    dw  0
vrow    dw  0
dec_buf times 20 db 0
dec_pos dw  0
fcw_save dw 0       ; used by vputfp_posint
fcw_tmp  dw 0
fcw_vp   dw 0       ; used by vputfp (separate, avoids clobber via nested call)

; ── closure field session data ──
session_coord dd 0          ; calc_session_coord(tos_seed_lo) % RING_MODULUS
face_genome   dd 0          ; 0x5625BA88 ^ session_coord
