From 5eadd14f57c1ae61b23b17a3d0db01e5a06e23b4 Mon Sep 17 00:00:00 2001 From: Daniel Covington Date: Tue, 10 Nov 2026 10:10:52 -0500 Subject: [PATCH] Add the Nova128 interface dispatch trampoline (E06-S02). Give interface calls one audited entry point that resolves the slot, refuses null/table/entry/stack faults before executing anything, and returns through a single synthetic address so nested and recursive calls unwind. Generated with Codebuff Co-Authored-By: Codebuff --- newLang/docs/architecture.md | 41 +- newLang/docs/decisions.md | 1 + newLang/docs/memory-map.md | 15 +- newLang/planning/claims/E06-S02.md | 101 ++++ newLang/scripts/build-dispatch-test.ps1 | 25 + newLang/scripts/verify-dispatch-test.ps1 | 46 ++ newLang/src/common/interfaces.inc | 2 + newLang/src/runtime/interfaces.s | 52 +- newLang/tests/runtime/dispatch-test.s | 653 +++++++++++++++++++++++ 9 files changed, 916 insertions(+), 20 deletions(-) create mode 100644 newLang/planning/claims/E06-S02.md create mode 100644 newLang/scripts/build-dispatch-test.ps1 create mode 100644 newLang/scripts/verify-dispatch-test.ps1 create mode 100644 newLang/tests/runtime/dispatch-test.s diff --git a/newLang/docs/architecture.md b/newLang/docs/architecture.md index 276426f..ce6eaa9 100644 --- a/newLang/docs/architecture.md +++ b/newLang/docs/architecture.md @@ -11,8 +11,8 @@ Status: approved version 1 baseline. The compiler memory map is frozen by E01-S05 (section 4.4, `docs/memory-map.md`). E04-S01 defines the generated PRG/MAP container and low-memory startup; E04-S02 adds the frame runtime; E05-S01 supplies an explicit-region heap; E05-S02 freezes class descriptors and MAP -class records; E06-S01 freezes the interface value ABI. Generated-program heap -placement and banking remain open. +class records; E06-S01 freezes the interface value ABI; E06-S02 adds the +dispatch trampoline. Generated-program heap placement and banking remain open. ## 1. System Boundary @@ -436,17 +436,28 @@ immediately; another interface-returning call overwrites the area. The runtime module asserts at link time that `IF_RESULT` sits between the print vectors (`$C0-$C5`) and the for-end values (`$D0`). -An interface call then: - -1. checks the object pointer for null; -2. installs the object pointer as `self`; -3. loads the two-byte target from the compile-time interface slot; -4. invokes the runtime's indirect-call trampoline. - -The 8502 has no `JSR (address)` instruction, so the trampoline must establish a -synthetic return path safely. `construct.s` already proves one synthetic-return -form for constructors; E06-S02 tests the dispatch form independently before -interface code generation relies on it. +An interface call (`if_call`, E06-S02) takes A/X = the value pointer and Y = +the compile-time slot: + +1. `if_slot` reads the two-byte target from the value's method table; +2. a null value, zero table, zero entry, or full hardware stack faults with + `IF_ERR_NULL`, `IF_ERR_TABLE`, `IF_ERR_ENTRY`, or `IF_ERR_STACK` before + anything is executed; +3. the object pointer becomes `self` in A/X, and the trampoline pushes one + synthetic return address and `JMP (if_vec)`s to the target. + +The 8502 has no `JSR (address)` instruction, so the trampoline builds its +return path from a pushed address pair, the same form `construct.s` uses for +constructors. Each nested or recursive call pushes its own pair, so returns +unwind without a dispatch stack; `if_vec` must not straddle a page because of +the `JMP` indirect bug. The hardware-stack check compares TSX with +`FRAME_HW_MIN` so a refused call cannot wrap the 6502 stack silently. + +`if_call` passes the callee's A/X and flags back unchanged, so a callee that +sets its own C=1 status is not confused with a refusal: `if_error` is `IF_OK` +exactly when the call happened. The trampoline leaves `FRAME_SP`/`FRAME_FP`, +`self` is the object rather than the fat reference, and the I/D flags and IRQ +vectors are untouched. `delete` through an interface uses the object pointer and its class descriptor, not the interface table, to find the optional destructor and object size. @@ -454,6 +465,10 @@ not the interface table, to find the optional destructor and object size. The E06-S01 fixture (`tests/runtime/interface-test.s`) verifies the little-endian layout, canonical null, the invalid-table refusal, four-byte copy, slot order, the result area, and the pushed argument order in x128. +The E06-S02 fixture (`tests/runtime/dispatch-test.s`) adds runtime-selected +targets, three-level nesting, 8- and 12-level recursion, SP/frame/argument/IRQ +and I/D preservation, the three target faults, and recovery after a full-stack +refusal. ### 7.6 Scalar code generation (E04-S03) diff --git a/newLang/docs/decisions.md b/newLang/docs/decisions.md index 8011aef..93fe835 100644 --- a/newLang/docs/decisions.md +++ b/newLang/docs/decisions.md @@ -71,6 +71,7 @@ documented default. `Proposed` means a later change still needs approval. | D141 | The MAP CLASS record carries the class descriptor's final address between the name and size: `CLASS name address size destroy interface-count interface-directory`. `out_class_addr` supplies it, `OUT_CLASS_RECORD_SIZE` grows from 10 to 12 bytes, and METHOD records remain `METHOD name address`. The class fixture exports `desc_empty`/`desc_box` and compares both descriptor addresses plus the two method addresses against the linker labels. | Makes class and method map records symmetric and directly verifiable, instead of requiring the caller to infer a descriptor address from the size/destructor fields. This is a visible MAP format change; existing SECTION, ENTRY, and method records keep their order. | | D142 | E06-S01 freezes the interface value ABI in `src/common/interfaces.inc`. A value is a four-byte fat reference, little-endian: object pointer at +0 and interface method-table pointer at +2. All four bytes zero is canonical null; a non-null object with a zero table is `IF_ERR_TABLE`. A per-class table holds two-byte method entries in the interface's declaration slot order with no header, so slot *n* sits at table+2*n. Interface parameters, locals, fields, and array elements occupy four bytes with no padding, and callers push all four bytes right-to-left so the object low byte is at `FP+2`. A four-byte result cannot use A/X: the callee writes it to fixed zero-page `IF_RESULT` (`$C6-$C9`) and the caller copies it out before another interface-returning call. `src/runtime/interfaces.s` supplies `if_conv`, `if_copy`, `if_is_null`, `if_slot`, `if_ret_store`, and `if_ret_load`, with `if_error` reporting `IF_OK`, `IF_ERR_NULL`, or `IF_ERR_TABLE`. | Implements the E06-S01 freeze above the object/descriptor ABI and settles the open interface-result convention. Dispatch, table emission, and interface lifetime remain E06-S02/E06-S03/E06-S06. The x128 fixture checks layout, null, copy, slot order, the result area, and argument order; the assertion keeps `IF_RESULT` clear of the print vectors and for-end values. | +| D143 | E06-S02 adds `if_call` to `src/runtime/interfaces.s` as the one interface dispatch path: A/X = interface value pointer, Y = slot. It resolves the slot through `if_slot`, stores the entry in page-safe `if_vec`, and jumps there with A/X = the object pointer as `self` after pushing one synthetic return address. Faults happen before any target executes: `IF_ERR_ENTRY` for a zero entry, `IF_ERR_NULL`, `IF_ERR_TABLE`, and `IF_ERR_STACK` when TSX is at or below `FRAME_HW_MIN`. The callee's A/X and flags come back unchanged, so a refusal is reported by `if_error` (`IF_OK` exactly when the call happened), not by C. | Gives every interface call one audited trampoline instead of duplicating synthetic-return code, and refuses invalid targets rather than jumping to address zero. The x128 fixture covers three runtime-selected targets, three-level nesting, 8- and 12-level recursion, SP/frame/argument/IRQ and I/D preservation, the three target faults, a full-stack refusal with recovery, and the page-safety assertion. | ## Deferred diff --git a/newLang/docs/memory-map.md b/newLang/docs/memory-map.md index faa6162..bf51f8e 100644 --- a/newLang/docs/memory-map.md +++ b/newLang/docs/memory-map.md @@ -153,15 +153,18 @@ its normal frame and reads them where the caller pushed them. | Interface params/locals/fields/array elements | 4 bytes, no alignment padding | | Argument order | caller pushes four bytes right-to-left, object low at `FP+2` | | Four-byte result | `IF_RESULT` = `$C6-$C9`; the caller copies it before the next call | -| Module zero page | `if_obj`, `if_tab`, `if_dst`, `if_src` (link-allocated) | -| Module status | `if_error`: `IF_OK`, `IF_ERR_NULL`, `IF_ERR_TABLE` | +| Module zero page | `if_obj`, `if_tab`, `if_dst`, `if_src`, `if_vec`, `if_self` (link-allocated) | +| Module status | `if_error`: `IF_OK`, `IF_ERR_NULL`, `IF_ERR_TABLE`, `IF_ERR_ENTRY`, `IF_ERR_STACK` | +| Dispatch | `if_call` takes A/X = value, Y = slot; a refusal leaves A/X=0, C=1 and sets `if_error` | +| Dispatch floor | TSX at or below `FRAME_HW_MIN` (`$40`) is refused with `IF_ERR_STACK` | | Fixture | code below `$4000`, producer `$03`, six phase flags | `src/common/interfaces.inc` fixes the layout; `src/runtime/interfaces.s` -implements `if_conv`, `if_copy`, `if_is_null`, `if_slot`, `if_ret_store`, and -`if_ret_load`. The module asserts at link time that `IF_RESULT` follows the -print vectors (`$C0-$C5`) and ends below the for-end values (`$D0`). Interface -table emission, dispatch, and interface lifetime remain E06-S02/E06-S03/E06-S06. +implements `if_conv`, `if_copy`, `if_is_null`, `if_slot`, `if_call`, +`if_ret_store`, and `if_ret_load`. The module asserts at link time that +`IF_RESULT` follows the print vectors (`$C0-$C5`) and ends below the for-end +values (`$D0`), and that `if_vec` does not cross a page. Interface table +emission and interface lifetime remain E06-S03/E06-S06. ## Mappings diff --git a/newLang/planning/claims/E06-S02.md b/newLang/planning/claims/E06-S02.md new file mode 100644 index 0000000..eb04120 --- /dev/null +++ b/newLang/planning/claims/E06-S02.md @@ -0,0 +1,101 @@ +--- +story: E06-S02 +owner: codebuff +status: done +started: 2026-11-10 +completed: 2026-11-10 +depends-on: [E06-S01, E04-S02] +--- + +# E06-S02 Claim + +## Intended change + +Add `if_call` to `src/runtime/interfaces.s` as the single interface dispatch +trampoline: resolve the compile-time slot, refuse invalid targets, pass the +object pointer as `self`, and return through one synthetic address so nested +and recursive calls unwind. Prove it with a new x128 fixture covering +runtime-selected targets, nesting, recursion, preservation, fault paths, and +the hardware-stack floor. + +## File area + +- `src/common/interfaces.inc` (new error codes), `src/runtime/interfaces.s` + (`if_call`, `if_vec`, `if_self`) +- `tests/runtime/dispatch-test.s` (new) +- `scripts/build-dispatch-test.ps1`, `scripts/verify-dispatch-test.ps1` (new) +- `docs/decisions.md` (D143), `docs/architecture.md` (status, 7.5), + `docs/memory-map.md` (dispatch rows) +- `planning/claims/E06-S02.md` +- generated files under `build/` + +## Acceptance evidence + +- [x] Calls at least three target methods selected at runtime: phase 1 of the + fixture builds each value pointer as `vals + 4*index` at run time and + dispatches slot 0 for three different values. Each target checks that A/X + is its own object pointer (`impl_self_bad` stays 0), and the fixture checks + A/X ids `$A0/$B0/$C0`, `if_error`, and SP for every iteration. +- [x] Returns correctly through nested and recursive calls: phase 2 dispatches + `impl_one` -> `impl_two` -> `impl_three` and checks the accumulated result + `$33/$31`; phase 3 recurses 8 levels through `if_call` with the depth passed + as a frame argument and checks the count, 9 entries, and restored `FRAME_SP`; + phase 7 recurses 12 levels, checks 13 entries, and confirms `rec_min_sp` + stayed at or above `FRAME_HW_MIN`. +- [x] Preserves documented registers, software frame, and interrupt state: + phase 4 dispatches with two argument bytes on the software frame and checks + A/X results, `if_error`, unchanged TSX, unchanged `FRAME_SP`, both argument + bytes intact, unchanged `$0314`/`$0315`, and an unchanged I/D mask; the + fixture documents A/X/Y as scratch and `if_error` as the refusal signal. +- [x] Null/invalid targets use a fault path rather than executing address zero: + phase 5 covers a null value (`IF_ERR_NULL`), a non-null object with no table + (`IF_ERR_TABLE`), and a zero slot entry (`IF_ERR_ENTRY`). Each refusal + leaves A/X=0 and C=1, changes no call counter (`impl_calls`), and leaves TSX + unchanged; a later dispatch still succeeds. +- [x] Hardware-stack boundary tests pass: phase 6 fills the 6502 stack to + `FRAME_HW_MIN - 1`, gets `IF_ERR_STACK` with A/X=0, restores SP with TXS, + verifies TSX equals the saved value, and dispatches successfully again. +- [x] `if_vec` cannot straddle a page: `src/runtime/interfaces.s` asserts + ` $FF`. + +## Coordination notes + +- Depends on E06-S01 (frozen value/table layout and `if_slot`) and E04-S02 + (software frames); both are complete. No other claim was active. +- `if_call` reuses `construct.s`'s proven one-level synthetic return form + rather than adding a dispatch stack; each nesting level owns its own pair on + the 6502 stack. +- E06-S03/E06-S04/E06-S05 consume `if_call`; table emission and + concrete-to-interface conversion were not added here. +- ca65 2.19 lives in `C:\Program Files\cc65-snapshot-win32\bin` and the + session prefixed PATH; VICE tools resolve through the test module. + +## Work log + +- Added `IF_ERR_ENTRY` and `IF_ERR_STACK`, then `if_call`, `if_vec`, and + `if_self`. +- The fixture's first build failed its own slot-table size assertion because + the assertion was placed after the next record; moved it next to the table. +- Phase 1 failed because the SP check used `tsx` (which sets X) followed by + `cmp` (which compares A); changed the comparisons to `tsx`/`txa`/`cmp`. +- Phase 4 then compared the hardware SP and `FRAME_SP` captured before the two + frame arguments were pushed; both captures moved to just before the + dispatch. Diagnostic `MB_ADDR` traps located both issues and were removed + before the final run. +- Final verification on the cleaned fixture: 7/7 phase flags, PASS, screen + shows `DISPATCH OK`. + +## Completion + +- Tests run: `scripts/verify-dispatch-test.ps1` (x128, fresh D81); + `scripts/verify-interface-test.ps1` (regression after the `interfaces.s` + change); `git diff --check`. +- Results: dispatch PRG ends `$2542`; mailbox `4E 38 03 A5 00 00` with flags + `01` at MB_DATA+0..+6; screen shows `NOVA128 DISPATCH TEST` and + `DISPATCH OK`. The interface ABI fixture still reports `INTERFACE OK`. +- Remaining risks: the trampoline trusts the value's object pointer (no class + or interface identity check); table contents are trusted apart from the + zero-entry check. `if_call` uses one shared `if_vec`, safe only because the + jump happens before a nested call can reuse it. Interface-typed arguments + and results are not yet emitted by the compiler (E06-S04/E06-S05), and + physical C128 testing remains P2 validation. diff --git a/newLang/scripts/build-dispatch-test.ps1 b/newLang/scripts/build-dispatch-test.ps1 new file mode 100644 index 0000000..45bd014 --- /dev/null +++ b/newLang/scripts/build-dispatch-test.ps1 @@ -0,0 +1,25 @@ +# E06-S02: build the dispatch trampoline fixture and its D81. +[CmdletBinding()] +param() + +$ErrorActionPreference = "Stop" +$project = Split-Path $PSScriptRoot -Parent +Import-Module (Join-Path $PSScriptRoot "lib\Nova128Test.psm1") -Force +$out = Join-Path $project "build\dispatch-test" +New-Item -ItemType Directory -Force -Path $out | Out-Null + +$link = Invoke-Nova128Link -Name "dispatch-test" -BuildDir $out ` + -Config (Join-Path $project "cfg\compiler.cfg") -Sources @( + (Join-Path $project "src\runtime\print.s"), + (Join-Path $project "src\runtime\frames.s"), + (Join-Path $project "src\runtime\interfaces.s"), + (Join-Path $project "tests\runtime\dispatch-test.s")) +if ((Get-Nova128Label $link.Labels "test_entry") -ne 0x1C0D) { throw "test_entry is not at `$1C0D" } +$end = Get-Nova128Label $link.Labels "test_end" +if ($end -ge 0x4000) { + throw ("dispatch-test ends at `$" + $end.ToString("X4") + "; it must stay below `$4000") +} + +New-Nova128Disk -Path (Join-Path $out "dispatch-test.d81") -Files @( + @{ Name = "dispatch-test"; Path = $link.Program; Type = "prg" }) +Write-Host ("built {0} (end {1:X4})" -f $link.Program, $end) diff --git a/newLang/scripts/verify-dispatch-test.ps1 b/newLang/scripts/verify-dispatch-test.ps1 new file mode 100644 index 0000000..6d8a614 --- /dev/null +++ b/newLang/scripts/verify-dispatch-test.ps1 @@ -0,0 +1,46 @@ +# E06-S02: run the dispatch trampoline fixture and check its mailbox. +[CmdletBinding()] +param([int]$Port = 6558, [int]$TimeoutSeconds = 180) + +$ErrorActionPreference = "Stop" +$project = Split-Path $PSScriptRoot -Parent +Import-Module (Join-Path $PSScriptRoot "lib\Nova128Test.psm1") -Force +& (Join-Path $PSScriptRoot "build-dispatch-test.ps1") + +$out = Join-Path $project "build\dispatch-test" +$disk = Join-Path $out "dispatch-test.d81" +$failures = @() + +$session = Start-Nova128X128 -Autostart $disk -Drive8Image $disk -Port $Port ` + -Screenshot (Join-Path $out "dispatch-test-vicii.png") +try { + $mb = Wait-Nova128Mailbox $session -TimeoutSeconds $TimeoutSeconds + Start-Sleep -Milliseconds 500 + $screenRam = Read-Nova128Memory $session 0x0400 1000 +} finally { + Stop-Nova128X128 $session -SettleSeconds 0 +} + +if ($mb[2] -ne 0x03) { $failures += "producer $($mb[2]) expected 3" } +if ($mb[3] -ne 0xA5) { $failures += ("status {0:X2} expected A5" -f $mb[3]) } +if ($mb[4] -ne 0 -or $mb[5] -ne 0) { $failures += "code $($mb[4] + 256 * $mb[5]) expected 0" } +for ($i = 0; $i -lt 7; $i++) { + if ($mb[8 + $i] -ne 1) { $failures += "phase $i flag is $($mb[8 + $i]), expected 1" } +} + +$rows = for ($r = 0; $r -lt 25; $r++) { + $chars = for ($c = 0; $c -lt 40; $c++) { + $code = $screenRam[$r * 40 + $c] + if ($code -le 0x1F) { [char]($code + 0x40) } elseif ($code -le 0x3F) { [char]$code } else { '?' } + } + (-join $chars).TrimEnd() +} +if (-not ($rows -contains "DISPATCH OK")) { + $failures += "screen does not contain 'DISPATCH OK'" +} + +if ($failures) { throw ("dispatch verification failed:`n " + ($failures -join "`n ")) } +Write-Host "screen:" +$rows | Where-Object { $_ } | ForEach-Object { Write-Host " |$_" } +Write-Host "mailbox: producer 3, PASS, code 0, all 7 dispatch flags set" +Write-Host "verified runtime-selected targets, nesting, recursion, register/frame/interrupt preservation, fault paths, and the hardware-stack guard" diff --git a/newLang/src/common/interfaces.inc b/newLang/src/common/interfaces.inc index 883232d..92a6765 100644 --- a/newLang/src/common/interfaces.inc +++ b/newLang/src/common/interfaces.inc @@ -33,5 +33,7 @@ IF_RESULT = $C6 ; four-byte interface result area IF_OK = 0 IF_ERR_NULL = 1 ; null value pointer or null object IF_ERR_TABLE = 2 ; non-null object with no method table +IF_ERR_ENTRY = 3 ; method table slot holds address zero +IF_ERR_STACK = 4 ; 6502 stack too low for a dispatch frame .endif diff --git a/newLang/src/runtime/interfaces.s b/newLang/src/runtime/interfaces.s index ebfbdcd..193a800 100644 --- a/newLang/src/runtime/interfaces.s +++ b/newLang/src/runtime/interfaces.s @@ -21,6 +21,13 @@ ; if_ret_store A/X = value pointer -> copies the value to IF_RESULT for a ; four-byte return. A zero pointer is IF_ERR_NULL and leaves ; the previous result intact. +; if_call A/X = value pointer, Y = slot -> dispatches through that +; slot with A/X = the object pointer as self. Faults before +; executing anything: IF_ERR_NULL, IF_ERR_TABLE, +; IF_ERR_ENTRY (zero entry), or IF_ERR_STACK (TSX at or below +; FRAME_HW_MIN). On success the callee's A/X and flags come +; back unchanged and if_error is IF_OK, so if_error -- not C -- +; tells the caller whether the call happened. ; if_ret_load A/X = destination -> copies IF_RESULT there. ; ; All destinations are caller-provided; nothing here allocates or validates a @@ -31,8 +38,9 @@ .setcpu "6502" .include "../common/interfaces.inc" .include "../common/emit.inc" +.include "../common/frames.inc" -.export if_conv, if_copy, if_is_null, if_slot, if_ret_store, if_ret_load +.export if_conv, if_copy, if_is_null, if_slot, if_call, if_ret_store, if_ret_load .export if_error, if_obj, if_tab, if_dst, if_src .segment "ZEROPAGE" @@ -40,6 +48,8 @@ if_obj: .res 2 ; concrete object pointer for if_conv if_tab: .res 2 ; method table selected at compile time if_dst: .res 2 ; destination value pointer if_src: .res 2 ; source value pointer +if_vec: .res 2 ; dispatch target for if_call +if_self: .res 2 ; object pointer passed through if_call .segment "CODE" @@ -174,6 +184,46 @@ if_slot: sec rts +; A/X = value pointer, Y = slot. Dispatch through that slot; see the API. +if_call: + sta if_src ; if_slot re-sets if_src to the same value + stx if_src+1 + jsr if_slot + bcs @fault ; if_slot already set if_error and A/X=0 + sta if_vec + stx if_vec+1 + ora if_vec+1 + bne @have + lda #IF_ERR_ENTRY + sta if_error + jmp @fail +@have: tsx + cpx #FRAME_HW_MIN + bcs @room + lda #IF_ERR_STACK + sta if_error + jmp @fail +@room: ldy #IF_OBJECT + lda (if_src),y + sta if_self + iny + lda (if_src),y + sta if_self+1 + lda #>(@ret - 1) ; one synthetic return level + pha + lda #<(@ret - 1) + pha + lda if_self + ldx if_self+1 + jmp (if_vec) +@ret: rts ; callee's A/X and flags pass through +@fault: rts +@fail: lda #$00 + tax + sec + rts +.assert $FF, error, "if_vec must not straddle a page" + ; A/X = value pointer -> IF_RESULT. if_ret_store: sta if_src diff --git a/newLang/tests/runtime/dispatch-test.s b/newLang/tests/runtime/dispatch-test.s new file mode 100644 index 0000000..ecfd518 --- /dev/null +++ b/newLang/tests/runtime/dispatch-test.s @@ -0,0 +1,653 @@ +; E06-S02: indirect-call trampoline fixture in x128. +; +; Runs under CR=$0E. It checks: +; - three targets chosen at runtime from value records dispatch correctly, +; with A/X results and self = the object pointer; +; - nested dispatch returns through three levels; +; - recursive dispatch through 8 levels returns the right count; +; - SP, software frame, frame arguments, IRQ vectors, and the I/D flags are +; unchanged across a dispatch; +; - null, table-less, and zero-entry targets fault without executing +; anything, and a later dispatch still works; +; - a full hardware stack is refused with IF_ERR_STACK and recovers after SP +; is restored; +; - 12-level recursion stays above FRAME_HW_MIN and restores the frame. +; +; MB_DATA flags 0..6 report the seven phases. + +.setcpu "6502" +.include "../../src/common/c128.inc" +.include "../../src/common/mailbox.inc" +.include "../../src/common/print.inc" +.include "../../src/common/frames.inc" +.include "../../src/common/interfaces.inc" + +.import pr_char, pr_cr, pr_text +.import frame_init, frame_enter, frame_leave, frame_push_byte, frame_discard +.import if_call +.import if_error + +.macro TEXT src, len + lda #src + ldy #len + jsr pr_text +.endmacro + +.macro PHASE n + lda #n + sta MB_CODE + lda #$00 + sta MB_CODE+1 +.endmacro + +.macro FAIL_CS + bcc :+ + jmp @fail +: +.endmacro + +.macro FAIL_CC + bcs :+ + jmp @fail +: +.endmacro + +.macro FAIL_NE + beq :+ + jmp @fail +: +.endmacro + +.segment "LOADADDR" + .word $1C01 + +.segment "EXEHDR" + .word basic_end + .word 10 + .byte $9E + .byte "7181" + .byte $00 +basic_end: + .word $0000 + +.segment "MAILBOX" + .res MB_SIZE + +.segment "ZEROPAGE" +vp: .res 2 +pv: .res 2 + +.segment "STARTUP" +.export test_entry, test_end +test_entry: + php + sei + ldx #MB_SIZE - 1 + lda #$00 +@clr: sta MB_BASE,x + dex + bpl @clr + lda #MB_MAGIC0_VALUE + sta MB_MAGIC0 + lda #MB_MAGIC1_VALUE + sta MB_MAGIC1 + lda #MB_PROD_PROGRAM + sta MB_PRODUCER + lda #MB_ST_RUNNING + sta MB_STATUS + lda #$00 + sta MB_CODE + sta MB_CODE+1 + + lda MMU_CR + sta saved_cr + lda #CR_RAM0_KERNAL + sta MMU_CR + lda #PR_CLEAR + jsr pr_char + TEXT title, 21 + jsr pr_cr + + ; 1: three targets selected at runtime, self and A/X checked. + PHASE 1 + lda #$00 + sta idx + sta impl_calls + sta impl_self_bad + tsx + stx sp_before +@pick: lda idx + asl a + asl a + clc + adc #vals + adc #$00 + sta vp+1 + lda vp + ldx vp+1 + ldy #$00 + jsr if_call + sta result_a + stx result_x + lda if_error + FAIL_NE + tsx + txa + cmp sp_before + FAIL_NE + lda idx + tay + lda result_a + cmp exp_ids,y + FAIL_NE + lda exp_ids,y + clc + adc #$01 + cmp result_x + FAIL_NE + inc idx + lda idx + cmp #$03 + bne @pick + lda impl_calls + cmp #$03 + FAIL_NE + lda impl_self_bad + FAIL_NE + lda #$01 + sta MB_DATA+0 + + ; 2: three-level nested dispatch. + PHASE 2 + lda #val_one + ldy #$00 + jsr if_call + sta result_a + stx result_x + lda if_error + FAIL_NE + lda result_a + cmp #$33 + FAIL_NE + lda result_x + cmp #$31 + FAIL_NE + lda #$01 + sta MB_DATA+1 + + ; 3: recursive dispatch through 8 levels. + PHASE 3 + jsr frame_init + lda #$FF + sta rec_min_sp + lda #$00 + sta rec_entries + lda #$08 + jsr frame_push_byte + FAIL_CS + lda #val_rec + ldy #$00 + jsr if_call + sta result_a + lda if_error + FAIL_NE + lda #$01 + ldx #$00 + jsr frame_discard + lda result_a + cmp #$08 + FAIL_NE + lda rec_entries + cmp #$09 + FAIL_NE + lda FRAME_SP + cmp #FRAME_STACK_TOP + FAIL_NE + lda #$01 + sta MB_DATA+2 + + ; 4: SP, frame, arguments, vectors, and I/D survive a dispatch. + PHASE 4 + php + pla + sta p_before + lda $0314 + sta v_before + lda $0315 + sta v_before+1 + lda #$AB + jsr frame_push_byte + FAIL_CS + lda #$CD + jsr frame_push_byte + FAIL_CS + tsx + stx sp_before + lda FRAME_SP + sta fsp_before + lda FRAME_SP+1 + sta fsp_before+1 + lda #val_a + ldy #$00 + jsr if_call + sta result_a + stx result_x + lda if_error + FAIL_NE + lda result_a + cmp #$A0 + FAIL_NE + lda result_x + cmp #$A1 + FAIL_NE + tsx + txa + cmp sp_before + FAIL_NE + lda FRAME_SP + cmp fsp_before + FAIL_NE + lda FRAME_SP+1 + cmp fsp_before+1 + FAIL_NE + lda FRAME_SP + sta pv + lda FRAME_SP+1 + sta pv+1 + ldy #$00 + lda (pv),y + cmp #$CD + FAIL_NE + iny + lda (pv),y + cmp #$AB + FAIL_NE + lda $0314 + cmp v_before + FAIL_NE + lda $0315 + cmp v_before+1 + FAIL_NE + php + pla + and #$0C + sta p_after + lda p_before + and #$0C + cmp p_after + FAIL_NE + lda #$02 + ldx #$00 + jsr frame_discard + lda FRAME_SP + cmp #FRAME_STACK_TOP + FAIL_NE + lda #$01 + sta MB_DATA+3 + + ; 5: faults never execute a target, and dispatch recovers. + PHASE 5 + lda impl_calls + sta calls_before + tsx + stx sp_before + lda #val_null + ldy #$00 + jsr if_call + FAIL_CC + sta result_a + stx result_x + lda if_error + cmp #IF_ERR_NULL + FAIL_NE + lda result_a + FAIL_NE + lda result_x + FAIL_NE + tsx + txa + cmp sp_before + FAIL_NE + + lda #val_notable + ldy #$00 + jsr if_call + FAIL_CC + sta result_a + stx result_x + lda if_error + cmp #IF_ERR_TABLE + FAIL_NE + lda result_a + FAIL_NE + lda result_x + FAIL_NE + tsx + txa + cmp sp_before + FAIL_NE + + lda #val_zero + ldy #$00 + jsr if_call + FAIL_CC + sta result_a + stx result_x + lda if_error + cmp #IF_ERR_ENTRY + FAIL_NE + lda result_a + FAIL_NE + lda result_x + FAIL_NE + lda impl_calls + cmp calls_before + FAIL_NE + + lda #val_a + ldy #$00 + jsr if_call + sta result_a + lda if_error + FAIL_NE + lda result_a + cmp #$A0 + FAIL_NE + lda #$01 + sta MB_DATA+4 + + ; 6: a full hardware stack is refused, then SP is restored. + PHASE 6 + tsx + stx sp_saved +@fill: lda #$00 + pha + tsx + cpx #(FRAME_HW_MIN - 1) + bne @fill + lda #val_a + ldy #$00 + jsr if_call + FAIL_CC + sta result_a + stx result_x + lda if_error + cmp #IF_ERR_STACK + FAIL_NE + lda result_a + FAIL_NE + lda result_x + FAIL_NE + ldx sp_saved + txs + tsx + cpx sp_saved + FAIL_NE + lda #val_a + ldy #$00 + jsr if_call + sta result_a + lda if_error + FAIL_NE + lda result_a + cmp #$A0 + FAIL_NE + lda #$01 + sta MB_DATA+5 + + ; 7: 12-level recursion stays above the stack floor. + PHASE 7 + lda #$FF + sta rec_min_sp + lda #$00 + sta rec_entries + lda #$0C + jsr frame_push_byte + FAIL_CS + lda #val_rec + ldy #$00 + jsr if_call + sta result_a + lda if_error + FAIL_NE + lda #$01 + ldx #$00 + jsr frame_discard + lda result_a + cmp #$0C + FAIL_NE + lda rec_entries + cmp #$0D + FAIL_NE + lda rec_min_sp + cmp #FRAME_HW_MIN + FAIL_CC + lda FRAME_SP + cmp #FRAME_STACK_TOP + FAIL_NE + lda #$01 + sta MB_DATA+6 + + TEXT dispatch_ok, 11 + jsr pr_cr + lda #MB_ST_PASS + sta MB_STATUS + lda #$00 + sta MB_CODE + sta MB_CODE+1 + jmp @restore + +@fail: + lda #MB_ST_FAIL + sta MB_STATUS + TEXT dispatch_fail, 13 + jsr pr_cr +@restore: + lda saved_cr + sta MMU_CR + plp + rts + +; Three runtime-selected targets. Each checks that A/X is its object pointer, +; then returns an id pair ($?0/$?1). +impl_a: + cmp #$11 + bne @bad + cpx #$11 + beq @ok +@bad: inc impl_self_bad +@ok: inc impl_calls + lda #$A0 + ldx #$A1 + rts + +impl_b: + cmp #$22 + bne @bad + cpx #$22 + beq @ok +@bad: inc impl_self_bad +@ok: inc impl_calls + lda #$B0 + ldx #$B1 + rts + +impl_c: + cmp #$33 + bne @bad + cpx #$33 + beq @ok +@bad: inc impl_self_bad +@ok: inc impl_calls + lda #$C0 + ldx #$C1 + rts + +; Nested chain: one -> two -> three, each level adding its own offset. +impl_three: + inc impl_calls + lda #$30 + ldx #$31 + rts + +impl_two: + inc impl_calls + lda #val_three + ldy #$00 + jsr if_call + sta child + lda if_error + bne @err + lda child + clc + adc #$02 + rts +@err: lda #$00 + ldx #$00 + sec + rts + +impl_one: + inc impl_calls + lda #val_two + ldy #$00 + jsr if_call + sta child + lda if_error + bne @err + lda child + clc + adc #$01 + rts +@err: lda #$00 + ldx #$00 + sec + rts + +; Recursive target: A/X = self, depth arrives at FP+2. Returns depth in A, X=0. +impl_rec: + lda #$00 + ldx #$00 + jsr frame_enter + bcc @in + sec + rts +@in: inc rec_entries + tsx + cpx rec_min_sp + bcs :+ + stx rec_min_sp +: ldy #$02 + lda (FRAME_FP),y + beq @zero + sec + sbc #$01 + jsr frame_push_byte + bcs @bad_stack + lda #val_rec + ldy #$00 + jsr if_call + sta child + lda if_error + bne @bad_nested + lda #$01 + ldx #$00 + jsr frame_discard + lda child + clc + adc #$01 + sta child + jsr frame_leave + lda child + ldx #$00 + clc + rts +@zero: jsr frame_leave + lda #$00 + ldx #$00 + clc + rts +@bad_stack: + jsr frame_leave + sec + rts +@bad_nested: + lda #$01 + ldx #$00 + jsr frame_discard + jsr frame_leave + sec + rts + +.segment "DATA" +vals: .word $1111, tab_a + .word $2222, tab_b + .word $3333, tab_c +.assert * - vals = 12, error, "three value records" +exp_ids: .byte $A0, $B0, $C0 +tab_a: .word impl_a +tab_b: .word impl_b +tab_c: .word impl_c +val_a: .word $1111, tab_a +val_one: .word $4444, tab_one +tab_one: .word impl_one +val_two: .word $5555, tab_two +tab_two: .word impl_two +val_three: .word $6666, tab_three +tab_three: .word impl_three +val_rec: .word $7777, tab_rec +tab_rec: .word impl_rec +val_null: .word $0000, $0000 +val_notable: .word $1111, $0000 +tab_zero: .word $0000 +.assert * - tab_zero = IF_SLOT_SIZE, error, "one slot per table" +val_zero: .word $2222, tab_zero + +.segment "RODATA" +title: .byte "NOVA128 DISPATCH TEST" +dispatch_ok: .byte "DISPATCH OK" +dispatch_fail: .byte "DISPATCH FAIL" + +.segment "BSS" +saved_cr: .res 1 +idx: .res 1 +impl_calls: .res 1 +impl_self_bad: .res 1 +result_a: .res 1 +result_x: .res 1 +sp_before: .res 1 +sp_saved: .res 1 +p_before: .res 1 +p_after: .res 1 +fsp_before: .res 2 +v_before: .res 2 +calls_before: .res 1 +child: .res 1 +rec_min_sp: .res 1 +rec_entries: .res 1 +test_end: