From 63b73f2f13fef3a1d7907c70185afc88e4109049 Mon Sep 17 00:00:00 2001 From: Daniel Covington Date: Tue, 10 Nov 2026 12:48:58 -0500 Subject: [PATCH] Resolve Nova128 interface call slots and prove the call path (E06-S05). iface_slot reads the declaration slot assign_slots recorded, so a call site emits an offset the class table actually has and refuses a method the interface does not declare. The x128 fixture proves one call site reaching two classes, one object reaching two interface tables, a nested call with a one-byte result, and byte/word arguments returning a word with the frame stack restored, while self stays the underlying object. Generated with Codebuff Co-Authored-By: Codebuff --- newLang/docs/architecture.md | 17 +- newLang/docs/decisions.md | 2 + newLang/docs/memory-map.md | 2 + newLang/planning/claims/E06-S05.md | 102 +++++++ newLang/scripts/build-ifcall-test.ps1 | 25 ++ newLang/scripts/verify-ifcall-test.ps1 | 46 +++ newLang/src/common/ifcalls.inc | 19 ++ newLang/src/compiler/interfaces.s | 56 +++- newLang/tests/compiler/iftable-test.s | 54 ++++ newLang/tests/runtime/ifcall-test.s | 381 +++++++++++++++++++++++++ 10 files changed, 701 insertions(+), 3 deletions(-) create mode 100644 newLang/planning/claims/E06-S05.md create mode 100644 newLang/scripts/build-ifcall-test.ps1 create mode 100644 newLang/scripts/verify-ifcall-test.ps1 create mode 100644 newLang/src/common/ifcalls.inc create mode 100644 newLang/tests/runtime/ifcall-test.s diff --git a/newLang/docs/architecture.md b/newLang/docs/architecture.md index 545d930..fd89ac7 100644 --- a/newLang/docs/architecture.md +++ b/newLang/docs/architecture.md @@ -14,7 +14,9 @@ supplies an explicit-region heap; E05-S02 freezes class descriptors and MAP class records; E06-S01 freezes the interface value ABI; E06-S02 adds the dispatch trampoline; E06-S03 emits one table per implemented interface; E06-S04 converts a class reference or null into an interface value and stores -it. Generated-program heap placement and banking remain open. +it; E06-S05 resolves the compile-time slot at a call site and dispatches +through the runtime table. Generated-program heap placement and banking remain +open. ## 1. System Boundary @@ -490,6 +492,15 @@ that wraps past `$FFFF` with `IF_ERR_RANGE`. Assignment rules stay in `types.s`: a class converts only to an interface it implements and everything else is `E080`, so an invalid conversion never reaches emission. +An interface call site fixes its slot at compile time: `iface_slot` reads the +slot `assign_slots` recorded for the interface's method row and refuses a name +the interface does not declare (`IS_ERR_METHOD`), so emission cannot invent an +offset. At run time `if_call` takes the table half of the value and dispatches +slot *n* from it, which is why one call site reaches different classes and one +object reaches different interfaces. The caller pushes arguments right-to-left +and discards them after the return; a one-byte result comes back in A and a +two-byte result in A/X. + 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. @@ -499,7 +510,9 @@ and I/D preservation, the three target faults, and recovery after a full-stack refusal. The E06-S04 fixture (`tests/runtime/convert-test.s`) adds the class and null conversions, verbatim interface assignment, a four-byte field, three array elements, the wrapped-address refusal, the argument layout, and the result -area. +area. The E06-S05 fixture (`tests/runtime/ifcall-test.s`) adds one call site +reaching two classes, one object reaching two interface tables, a nested call +with a one-byte result, and a byte/word argument pair returning a word. ### 7.6 Scalar code generation (E04-S03) diff --git a/newLang/docs/decisions.md b/newLang/docs/decisions.md index 4b2f608..7681755 100644 --- a/newLang/docs/decisions.md +++ b/newLang/docs/decisions.md @@ -77,6 +77,8 @@ documented default. `Proposed` means a later change still needs approval. | D145 | E06-S04 closes the gap between the E06-S03 tables and an interface value. `it_find` (A = class ID, X = interface ID) returns the table address the class emitted for that interface, or C=1 with `IT_ERR_IFACE`, so a conversion never guesses a table and cannot emit one the class does not implement. `src/runtime/interfaces.s` gains `if_assign` (A/X = destination, Y = 0 copies `if_src`, any other value converts `if_obj` with the compile-time `if_tab`; a zero object writes the canonical null), `if_arg_push` (pushes four bytes right-to-left so the object low byte lands at FP+2), and `if_elem_store`/`if_elem_load` (4-byte elements at `base + IF_VALUE_SIZE*index`, refusing a wrapped address with `IF_ERR_RANGE`). | Makes the story's four acceptance paths executable before codegen grows four-byte values: assignment, parameter passing, field and element storage, and returns all go through one API, while the compile-time rejection stays in `types.s` (E080). The x128 conversion fixture checks the class pair, canonical null, verbatim copy, a field, three array elements, the wrapped-address refusal, the argument layout, and the result area; the table fixture now proves `it_find` for three implemented pairs and one refusal. | +| D146 | E06-S05 makes an interface call resolvable at its call site. `src/common/ifcalls.inc` fixes the call-site result codes (`IS_OK`, `IS_ERR_METHOD`), and `src/compiler/interfaces.s` gains `iface_slot` (A = interface name ID, X = method name ID -> A = the declaration slot from `C_MEM_SLOT`, or C=1 with `IS_ERR_METHOD` when the interface declares no such method, which covers a class or program ID too). At run time the slot indexes the table half of the fat reference, so the compile-time slot and the runtime table pointer together select the method; nothing at run time re-derives interface order. | The call sequence itself was already `if_call` (E06-S02) plus the frame ABI, so what was missing was a way for emission to learn the slot without re-deriving declaration order, and an end-to-end proof of the story's four behaviours. The x128 call fixture reaches two classes from one call site, two interfaces from one object by swapping only the table pointer, a nested call with a one-byte result, and a byte/word argument pair returning a word in A/X with the frame stack restored; it also checks `self` is the object, not the value record. | + ## Deferred - Native C128/80-column Vim port diff --git a/newLang/docs/memory-map.md b/newLang/docs/memory-map.md index 64ff84d..6c4aad0 100644 --- a/newLang/docs/memory-map.md +++ b/newLang/docs/memory-map.md @@ -166,6 +166,8 @@ its normal frame and reads them where the caller pushed them. | Conversion | `if_assign` A/X = destination, Y = 0 copies `if_src`, else converts `if_obj` + `if_tab` | | Argument push | `if_arg_push` A/X = value; object low byte at `FP+2`; `IF_ERR_NULL` / `IF_ERR_STACK` | | Array elements | `if_elem_store`/`if_elem_load` A/X = base, Y = index; stride `IF_VALUE_SIZE`; `IF_ERR_RANGE` on wrap | +| Interface call | `iface_slot` A = interface ID, X = method ID -> A = compile-time slot; `IS_ERR_METHOD` when absent | +| Call sequence | caller pushes arguments, `if_call` A/X = value and Y = slot, then `frame_discard` the argument bytes | | Fixture | code below `$4000`, producer `$03`, six phase flags | `src/common/interfaces.inc` fixes the layout; `src/runtime/interfaces.s` diff --git a/newLang/planning/claims/E06-S05.md b/newLang/planning/claims/E06-S05.md new file mode 100644 index 0000000..02a0bf5 --- /dev/null +++ b/newLang/planning/claims/E06-S05.md @@ -0,0 +1,102 @@ +--- +story: E06-S05 +owner: codebuff +status: done +started: 2026-11-10 +completed: 2026-11-10 +depends-on: [E06-S02, E06-S04] +--- + +# E06-S05 Claim + +## Intended change + +Make an interface method call resolvable from both halves it needs: the slot +that the interface declaration fixes at compile time, and the table pointer the +value carries at run time. `iface_slot` resolves the slot from the parser tables +and refuses a name the interface does not declare, so emission never invents an +offset. The call itself stays `if_call` (E06-S02); this story proves it against +the story's four behaviours, including `self` identity, two classes per call +site, two interfaces per object, arguments, and one-/two-byte returns. + +## File area + +- `src/common/ifcalls.inc` (new): `IS_OK`, `IS_ERR_METHOD` +- `src/compiler/interfaces.s`: `iface_slot`, `is_error` +- `tests/compiler/iftable-test.s`: slot-resolution checks in phase 7 +- `tests/runtime/ifcall-test.s` (new) +- `scripts/build-ifcall-test.ps1`, `scripts/verify-ifcall-test.ps1` (new) +- `docs/decisions.md` (D146), `docs/architecture.md` (status, 7.5), + `docs/memory-map.md` (call rows) +- `planning/claims/E06-S05.md` +- generated files under `build/` + +## Acceptance evidence + +- [x] Call uses the compile-time interface slot and runtime table pointer: + `iface_slot` returns 0 for IFOO/ALPHA, 1 for IFOO/BETA, and 0 for IBAR/ALPHA + in the table fixture, so the slot is the declaration order `assign_slots` + recorded; the call fixture then passes those slots as constants to `if_call`, + which reads the table pointer from the value at run time. Phase 2 swaps only + the table pointer under one slot and reaches a different method for the same + object. +- [x] `self` is the underlying object, not the fat-reference address: every + fixture method compares the incoming A/X against its class object + (`$1111`/`$2222`) while the value records live elsewhere, and any miss counts + `self_bad`; all phases require `self_bad = 0`. +- [x] Two classes dispatch the same interface call to different methods: phase + 1 calls slot 0 of IFOO on object `$1111` (returns `$A0`) and on `$2222` + (returns `$B0`), with each class's call counter at 1. +- [x] One class implements and dispatches at least two interfaces: phase 2 calls + slot 0 on object `$1111` through the IFOO table (`m_a0`, `$A0`) and through + the IBAR table (`m_abar`, `$C0`). +- [x] Arguments and one-/two-byte returns work through interface calls: phase 3 + calls slot 1, whose method makes its own interface call and returns `$5A+1` + in A; phase 4 pushes a byte and a word, the method reads them at `FP+2..FP+4` + and returns `$1234+7` in A/X (`$3B`/`$12`), and the caller's frame stack + returns to `$C000` after discarding three argument bytes. +- [x] A call site that names a method the interface does not declare is refused + at compile time: `iface_slot` reports `IS_ERR_METHOD` for IBAR/GAMMA and for a + class ID, verified in the table fixture. + +## Coordination notes + +- Depends on E06-S02 (`if_call`) and E06-S04 (values); both are complete. The + trampoline and frame ABI were reused unchanged, so this story adds no runtime + entry point and cannot regress dispatch behaviour. +- `iface_slot` is the lookup emission will call; codegen still handles only + byte scalars and zero-argument self calls, so wiring interface expressions + into `emit.s` remains open compiler work rather than part of this story. +- Interface lifetime, deletion through an interface, and null-call policy are + E06-S06. + +## Work log + +- Added `iface_slot` beside `assign_slots` so the slot's writer and reader live + in one module; it walks the interface's signature rows and returns + `C_MEM_SLOT` rather than recomputing the index, which keeps a call site + correct if slot assignment ever changes. +- The call fixture reuses the E06-S02 dispatch conventions (A/X = value + pointer, Y = slot, results in A/X, status in `if_error`) so it tests the call + path rather than a private copy of it. +- First build failed the `.assert` on the IFOO table: `* - tab_a_foo` spanned + all four tables. The assertion now subtracts the next label, and a second one + covers the one-slot IBAR table. + +## Completion + +- Tests run: `scripts/verify-iftable-test.ps1` (x128, fresh D81, now including + the slot-resolution checks); `scripts/verify-ifcall-test.ps1` (x128, fresh + D81); `scripts/verify-parser-test.ps1` (42 semantic/parser fixtures); + `git diff --check`. +- Results: the table fixture still reports PASS with all eight flags, + `NOVA128 IFTABLE TEST OK`, and its four MAP records (stub addresses moved to + `7573`/`7574`/`7576`/`7577` because `interfaces.s` grew). The call fixture + reports PASS with all four flags and prints `IFCALL OK`; its PRG ends `$2354`. +- Remaining risks: the trampoline still trusts the value's object and table + pointers, so a forged value can reach any address; `if_call` uses one shared + `if_vec`, safe only because the jump happens before a nested call can reuse + it; and argument pushes are byte-wise, so a stack refusal mid-push leaves the + caller's arguments to be discarded by the caller. Generated-code emission of + interface calls and lifetime remain E06-S06 and later compiler work, and + physical C128 testing remains P2 validation. diff --git a/newLang/scripts/build-ifcall-test.ps1 b/newLang/scripts/build-ifcall-test.ps1 new file mode 100644 index 0000000..baf1bc7 --- /dev/null +++ b/newLang/scripts/build-ifcall-test.ps1 @@ -0,0 +1,25 @@ +# E06-S05: build the interface call 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\ifcall-test" +New-Item -ItemType Directory -Force -Path $out | Out-Null + +$link = Invoke-Nova128Link -Name "ifcall-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\ifcall-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 ("ifcall-test ends at `$" + $end.ToString("X4") + "; it must stay below `$4000") +} + +New-Nova128Disk -Path (Join-Path $out "ifcall-test.d81") -Files @( + @{ Name = "ifcall-test"; Path = $link.Program; Type = "prg" }) +Write-Host ("built {0} (end {1:X4})" -f $link.Program, $end) diff --git a/newLang/scripts/verify-ifcall-test.ps1 b/newLang/scripts/verify-ifcall-test.ps1 new file mode 100644 index 0000000..4d6324f --- /dev/null +++ b/newLang/scripts/verify-ifcall-test.ps1 @@ -0,0 +1,46 @@ +# E06-S05: run the interface call fixture in x128 and check its mailbox. +[CmdletBinding()] +param([int]$Port = 6561, [int]$TimeoutSeconds = 180) + +$ErrorActionPreference = "Stop" +$project = Split-Path $PSScriptRoot -Parent +Import-Module (Join-Path $PSScriptRoot "lib\Nova128Test.psm1") -Force +& (Join-Path $PSScriptRoot "build-ifcall-test.ps1") + +$out = Join-Path $project "build\ifcall-test" +$disk = Join-Path $out "ifcall-test.d81" +$failures = @() + +$session = Start-Nova128X128 -Autostart $disk -Drive8Image $disk -Port $Port ` + -Screenshot (Join-Path $out "ifcall-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 4; $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 "IFCALL OK")) { + $failures += "screen does not contain 'IFCALL OK'" +} + +if ($failures) { throw ("interface call 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 4 call flags set" +Write-Host "verified two classes per call site, two interfaces per object, a nested call, and byte/word arguments with a word result" diff --git a/newLang/src/common/ifcalls.inc b/newLang/src/common/ifcalls.inc new file mode 100644 index 0000000..e662e8b --- /dev/null +++ b/newLang/src/common/ifcalls.inc @@ -0,0 +1,19 @@ +; ifcalls.inc - interface call site constants (E06-S05). +; +; A call through an interface type knows the interface and the method at +; compile time, so it also knows the declaration slot: slot n is at +; table + IF_SLOT_SIZE*n (interfaces.inc). src/compiler/interfaces.s resolves +; that slot from the parser tables with iface_slot; the table pointer half of +; the fat reference is read at run time, so two classes answering the same +; slot reach different methods. +; +; A call site that cannot resolve a slot reports an error rather than emitting +; a call that would dispatch through whatever bytes sit at that offset. + +.ifndef IFCALLS_INC +IFCALLS_INC = 1 + +IS_OK = 0 +IS_ERR_METHOD = 1 ; the interface declares no such method + +.endif diff --git a/newLang/src/compiler/interfaces.s b/newLang/src/compiler/interfaces.s index dfac0f4..6817e5e 100644 --- a/newLang/src/compiler/interfaces.s +++ b/newLang/src/compiler/interfaces.s @@ -5,6 +5,11 @@ ; assign_slots numbers each interface method in declaration order and ; stores it in C_MEM_SLOT, so later method tables and the MAP ; writer can use a stable slot without re-reading the source; +; iface_slot A = interface name ID, X = method name ID. A = that +; method's declaration slot, C=0; C=1 with +; is_error = IS_ERR_METHOD when the interface declares no +; such method (or the ID is not an interface). A call site +; uses this so the slot it emits is the one E06-S03 wrote; ; check_interfaces ; verifies each class against every interface it implements. ; A satisfying method is public and has the same parameter @@ -25,13 +30,15 @@ .setcpu "6502" .include "../common/errors.inc" +.include "../common/ifcalls.inc" .include "../common/parser.inc" .import tb_get, tb_set, names_count .import diag_report, diag_line, diag_col, diag_arg1, diag_arg1_len .import name_get, name_out, name_out_len -.export assign_slots, check_interfaces, find_method +.export assign_slots, iface_slot, check_interfaces, find_method +.export is_error .segment "CODE" @@ -75,6 +82,47 @@ assign_slots: bne @next rts +; --------------------------------------------------------- call sites +; A = interface name ID, X = method name ID. A = declaration slot, C=0. +iface_slot: + sta is_iface + stx is_name + ldy is_iface + lda #C_TYPE_KIND + jsr tb_get + cmp #TYPE_INTERFACE + bne @no + ldy is_iface + lda #C_TYPE_MFIRST + jsr tb_get + sta is_row + ldy is_iface + lda #C_TYPE_MCOUNT + jsr tb_get + sta is_n +@row: lda is_n + beq @no + ldy is_row + lda #C_MEM_NAME + jsr tb_get + cmp is_name + beq @yes + inc is_row + dec is_n + bne @row +@no: lda #IS_ERR_METHOD + sta is_error + lda #$00 + sec + rts +@yes: lda #IS_OK + sta is_error + ldy is_row + lda #C_MEM_SLOT + jsr tb_get + clc + rts + ; ----------------------------------------------------------- conformance ; For each class in declaration order, walk its implements list in source ; order and each interface's signatures in slot order. @@ -411,6 +459,12 @@ iface_err: rts .segment "BSS" +; call sites +is_iface: .res 1 +is_name: .res 1 +is_row: .res 1 +is_n: .res 1 +is_error: .res 1 ; slot assignment as_id: .res 1 as_row: .res 1 diff --git a/newLang/tests/compiler/iftable-test.s b/newLang/tests/compiler/iftable-test.s index 24ad0b9..82a7206 100644 --- a/newLang/tests/compiler/iftable-test.s +++ b/newLang/tests/compiler/iftable-test.s @@ -23,6 +23,7 @@ .include "../../src/common/formats.inc" .include "../../src/common/parser.inc" .include "../../src/common/iftables.inc" +.include "../../src/common/ifcalls.inc" .import mmu_init, mmu_bank0, mmu_shutdown .import out_begin, out_startup, out_finish, out_abort @@ -33,6 +34,7 @@ .import it_begin, it_set_addr, it_class, it_find .import it_error, it_count, it_used, it_data .import it_class_ids, it_iface_ids, it_table_addrs, it_slots, it_offsets +.import iface_slot, is_error TABLE_BASE = $B000 @@ -393,6 +395,58 @@ test_entry: jmp @fail : CHK it_error, IT_ERR_IFACE CHK it_count, 3 + + ; A call site resolves its slot from the interface declaration: + ; IFOO ALPHA=0, BETA=1; IBAR ALPHA=0; IBAR GAMMA does not exist, and a + ; class name is not an interface. + STEP $34 + lda #1 + ldx #1 + jsr iface_slot + bcc :+ + jmp @fail +: cmp #0 + beq :+ + jmp @fail +: CHK is_error, IS_OK + + STEP $35 + lda #1 + ldx #2 + jsr iface_slot + bcc :+ + jmp @fail +: cmp #1 + beq :+ + jmp @fail +: CHK is_error, IS_OK + + STEP $36 + lda #2 + ldx #1 + jsr iface_slot + bcc :+ + jmp @fail +: cmp #0 + beq :+ + jmp @fail +: CHK is_error, IS_OK + + STEP $37 + lda #2 + ldx #3 + jsr iface_slot + bcs :+ ; no such method: a refusal is expected + jmp @fail +: CHK is_error, IS_ERR_METHOD + + STEP $38 + lda #3 + ldx #1 + jsr iface_slot + bcs :+ ; a class is not an interface + jmp @fail +: CHK is_error, IS_ERR_METHOD lda #$01 sta MB_DATA+7 diff --git a/newLang/tests/runtime/ifcall-test.s b/newLang/tests/runtime/ifcall-test.s new file mode 100644 index 0000000..904f144 --- /dev/null +++ b/newLang/tests/runtime/ifcall-test.s @@ -0,0 +1,381 @@ +; E06-S05: interface method call fixture in x128. +; +; Runs under CR=$0E on the E06-S01 value ABI, the E06-S02 trampoline, the +; E06-S03 table shape, and the E06-S04 conversion API. It checks: +; - two classes dispatch the same interface slot to different methods, and +; self is the underlying object ($1111 / $2222), not the value record; +; - one class dispatches through two of its interface tables, so the same +; object reaches different methods by table pointer alone; +; - a callee can itself make an interface call and pass on a one-byte result; +; - a byte argument and a two-byte argument arrive at FP+2..FP+4, a two-byte +; result comes back in A/X, and the caller's frame stack is restored. +; +; The slots are the compile-time interface slots (resolved by the compiler's +; iface_slot in the table fixture); the table pointer is read at run time from +; the value, which is what lets one call site reach two classes. +; +; MB_DATA flags 0..3 report the four 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_push_word, frame_discard +.import if_call, 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_NE + beq :+ + jmp @fail +: +.endmacro + +; A/X = self. A method whose self is not its class's object counts the miss +; and returns failure instead of reporting a result. +.macro SELF_IS lo, hi + cmp #lo + bne @selfbad + cpx #hi + beq @selfok +@selfbad: + inc self_bad + lda #$00 + ldx #$00 + rts +@selfok: +.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 "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 + sta self_bad + sta a_calls + sta b_calls + sta leaf_calls + ldx #$03 +@flags: sta MB_DATA,x + dex + bpl @flags + + lda MMU_CR + sta saved_cr + lda #CR_RAM0_KERNAL + sta MMU_CR + lda #PR_CLEAR + jsr pr_char + TEXT title, title_len + jsr pr_cr + + ; 1: one call site, two classes, two methods. + PHASE 1 + lda #val_a_foo + ldy #0 + jsr if_call + sta result_a + lda if_error + FAIL_NE + lda result_a + cmp #$A0 + FAIL_NE + lda a_calls + cmp #1 + FAIL_NE + + lda #val_b_foo + ldy #0 + jsr if_call + sta result_a + lda if_error + FAIL_NE + lda result_a + cmp #$B0 + FAIL_NE + lda b_calls + cmp #1 + FAIL_NE + lda self_bad + FAIL_NE + lda #$01 + sta MB_DATA+0 + + ; 2: one class, two interface tables, different methods. + PHASE 2 + lda #val_a_bar + ldy #0 + jsr if_call + sta result_a + lda if_error + FAIL_NE + lda result_a + cmp #$C0 + FAIL_NE + lda a_calls + cmp #2 + FAIL_NE + lda self_bad + FAIL_NE + lda #$01 + sta MB_DATA+1 + + ; 3: an interface call inside a method, one-byte result passed on. + PHASE 3 + lda #val_a_foo + ldy #1 + jsr if_call + sta result_a + lda if_error + FAIL_NE + lda result_a + cmp #$5B + FAIL_NE + lda a_calls + cmp #3 + FAIL_NE + lda leaf_calls + cmp #1 + FAIL_NE + lda self_bad + FAIL_NE + lda #$01 + sta MB_DATA+2 + + ; 4: arguments and a two-byte result through an interface call. + PHASE 4 + jsr frame_init + lda #$34 + ldx #$12 + jsr frame_push_word ; arg1 = $1234 + FAIL_CS + lda #$07 + jsr frame_push_byte ; arg0 = 7 + FAIL_CS + lda #val_a_foo + ldy #2 + jsr if_call + sta result_a + stx result_x + lda if_error + FAIL_NE + lda #$03 + ldx #$00 + jsr frame_discard + lda result_a + cmp #$3B ; $1234 + 7 + FAIL_NE + lda result_x + cmp #$12 + FAIL_NE + lda FRAME_SP + cmp #FRAME_STACK_TOP + FAIL_NE + lda a_calls + cmp #4 + FAIL_NE + lda self_bad + FAIL_NE + lda #$01 + sta MB_DATA+3 + + TEXT ok_msg, ok_len + 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 fail_msg, fail_len + jsr pr_cr +@restore: + lda saved_cr + sta MMU_CR + plp + rts + +.segment "CODE" +; IFOO slot 0 of class A: byte result, self checked. +m_a0: + SELF_IS $11, $11 + inc a_calls + lda #$A0 + ldx #$00 + rts + +; IFOO slot 1 of class A: calls leaf through val_leaf and adds one. +m_a1: + SELF_IS $11, $11 + inc a_calls + lda #val_leaf + ldy #$00 + jsr if_call + sta child + stx child_x + lda if_error + bne @bad + lda child + clc + adc #$01 + ldx #$00 + rts +@bad: inc self_bad + lda #$00 + ldx #$00 + rts + +; IFOO slot 2 of class A: (byte, word) -> word sum. +m_addw: + SELF_IS $11, $11 + inc a_calls + lda #$00 + ldx #$00 + jsr frame_enter + bcs @bad + ldy #$02 + lda (FRAME_FP),y + sta tmp + iny + lda (FRAME_FP),y + clc + adc tmp + sta res_lo + iny + lda (FRAME_FP),y + adc #$00 + sta res_hi + jsr frame_leave + lda res_lo + ldx res_hi + clc + rts +@bad: lda #$00 + ldx #$00 + sec + rts + +; IBAR slot 0 of class A: a different method for the same object. +m_abar: + SELF_IS $11, $11 + inc a_calls + lda #$C0 + ldx #$00 + rts + +; IFOO slot 0 of class B. +m_b0: + SELF_IS $22, $22 + inc b_calls + lda #$B0 + ldx #$00 + rts + +; Target of the nested call. +m_leaf: + inc leaf_calls + lda #$5A + ldx #$00 + rts + +.segment "DATA" +; Object pointers are only identities here; the methods compare them. +val_a_foo: .word $1111, tab_a_foo +val_a_bar: .word $1111, tab_a_bar +val_b_foo: .word $2222, tab_b_foo +val_leaf: .word $9999, tab_leaf +tab_a_foo: .word m_a0, m_a1, m_addw +tab_a_bar: .word m_abar +tab_b_foo: .word m_b0 +tab_leaf: .word m_leaf +.assert tab_a_bar - tab_a_foo = 3 * IF_SLOT_SIZE, error, "IFOO table size" +.assert tab_b_foo - tab_a_bar = 1 * IF_SLOT_SIZE, error, "IBAR table size" + +.segment "RODATA" +title: .byte "NOVA128 IFCALL TEST" +title_len = * - title +ok_msg: .byte "IFCALL OK" +ok_len = * - ok_msg +fail_msg: .byte "IFCALL FAIL" +fail_len = * - fail_msg + +.segment "BSS" +saved_cr: .res 1 +a_calls: .res 1 +b_calls: .res 1 +leaf_calls: .res 1 +self_bad: .res 1 +result_a: .res 1 +result_x: .res 1 +child: .res 1 +child_x: .res 1 +tmp: .res 1 +res_lo: .res 1 +res_hi: .res 1 +test_end: