Преглед изворни кода

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 <noreply@codebuff.com>
main
Daniel Covington пре 3 дана
родитељ
комит
5eadd14f57
9 измењених фајлова са 916 додато и 20 уклоњено
  1. +28
    -13
      newLang/docs/architecture.md
  2. +1
    -0
      newLang/docs/decisions.md
  3. +9
    -6
      newLang/docs/memory-map.md
  4. +101
    -0
      newLang/planning/claims/E06-S02.md
  5. +25
    -0
      newLang/scripts/build-dispatch-test.ps1
  6. +46
    -0
      newLang/scripts/verify-dispatch-test.ps1
  7. +2
    -0
      newLang/src/common/interfaces.inc
  8. +51
    -1
      newLang/src/runtime/interfaces.s
  9. +653
    -0
      newLang/tests/runtime/dispatch-test.s

+ 28
- 13
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)



+ 1
- 0
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



+ 9
- 6
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



+ 101
- 0
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
`<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.

+ 25
- 0
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)

+ 46
- 0
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"

+ 2
- 0
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

+ 51
- 1
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 <if_vec <> $FF, error, "if_vec must not straddle a page"

; A/X = value pointer -> IF_RESULT.
if_ret_store:
sta if_src


+ 653
- 0
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
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:

Loading…
Откажи
Сачувај

Powered by TurnKey Linux.