Przeglądaj źródła

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 <noreply@codebuff.com>
main
Daniel Covington 3 dni temu
rodzic
commit
63b73f2f13
10 zmienionych plików z 701 dodań i 3 usunięć
  1. +15
    -2
      newLang/docs/architecture.md
  2. +2
    -0
      newLang/docs/decisions.md
  3. +2
    -0
      newLang/docs/memory-map.md
  4. +102
    -0
      newLang/planning/claims/E06-S05.md
  5. +25
    -0
      newLang/scripts/build-ifcall-test.ps1
  6. +46
    -0
      newLang/scripts/verify-ifcall-test.ps1
  7. +19
    -0
      newLang/src/common/ifcalls.inc
  8. +55
    -1
      newLang/src/compiler/interfaces.s
  9. +54
    -0
      newLang/tests/compiler/iftable-test.s
  10. +381
    -0
      newLang/tests/runtime/ifcall-test.s

+ 15
- 2
newLang/docs/architecture.md Wyświetl plik

@@ -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)



+ 2
- 0
newLang/docs/decisions.md Wyświetl plik

@@ -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


+ 2
- 0
newLang/docs/memory-map.md Wyświetl plik

@@ -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`


+ 102
- 0
newLang/planning/claims/E06-S05.md Wyświetl plik

@@ -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.

+ 25
- 0
newLang/scripts/build-ifcall-test.ps1 Wyświetl plik

@@ -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)

+ 46
- 0
newLang/scripts/verify-ifcall-test.ps1 Wyświetl plik

@@ -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"

+ 19
- 0
newLang/src/common/ifcalls.inc Wyświetl plik

@@ -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

+ 55
- 1
newLang/src/compiler/interfaces.s Wyświetl plik

@@ -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


+ 54
- 0
newLang/tests/compiler/iftable-test.s Wyświetl plik

@@ -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



+ 381
- 0
newLang/tests/runtime/ifcall-test.s Wyświetl plik

@@ -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
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_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
ldx #>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
ldx #>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
ldx #>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
ldx #>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
ldx #>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 FRAME_SP+1
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
ldx #>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:

Ładowanie…
Anuluj
Zapisz

Powered by TurnKey Linux.