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 <noreply@codebuff.com>main
| @@ -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) | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| `<if_vec <> $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. | |||
| @@ -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) | |||
| @@ -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" | |||
| @@ -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 | |||
| @@ -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 <if_vec <> $FF, error, "if_vec must not straddle a page" | |||
| ; A/X = value pointer -> IF_RESULT. | |||
| if_ret_store: | |||
| sta if_src | |||
| @@ -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 | |||
| ldx #>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 | |||
| sta vp | |||
| lda #>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 | |||
| ldx #>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 | |||
| ldx #>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 FRAME_SP+1 | |||
| 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 | |||
| ldx #>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 FRAME_SP+1 | |||
| 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 | |||
| ldx #>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 | |||
| ldx #>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 | |||
| ldx #>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 | |||
| ldx #>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 | |||
| ldx #>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 | |||
| ldx #>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 | |||
| ldx #>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 FRAME_SP+1 | |||
| 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 | |||
| ldx #>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 | |||
| ldx #>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 | |||
| ldx #>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: | |||
Powered by TurnKey Linux.