it_find selects the table a class emitted for an interface, refusing a pair the class does not implement, and if_assign, if_arg_push, if_elem_store, and if_elem_load give assignment, argument passing, field, and array storage one API that keeps all four value bytes. Two x128 fixtures prove the class and null conversions, verbatim copies, array stride, argument layout, and the result area, while the semantic suite still rejects an invalid conversion. Generated with Codebuff Co-Authored-By: Codebuff <noreply@codebuff.com>main
| @@ -12,8 +12,9 @@ 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 | 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 | 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 | class records; E06-S01 freezes the interface value ABI; E06-S02 adds the | ||||
| dispatch trampoline; E06-S03 emits one table per implemented interface. | |||||
| Generated-program heap placement and banking remain open. | |||||
| 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. | |||||
| ## 1. System Boundary | ## 1. System Boundary | ||||
| @@ -477,13 +478,28 @@ rather than an entry that would dispatch to zero, and a failed class restores | |||||
| the watermark and table count so the caller can retry. The caller supplies | the watermark and table count so the caller can retry. The caller supplies | ||||
| addresses because method placement is pass 3. | addresses because method placement is pass 3. | ||||
| `it_find` (E06-S04) turns a class ID and an interface ID into the table that | |||||
| class emitted, or `IT_ERR_IFACE` when the class does not implement the | |||||
| interface, so a conversion site never guesses a table. `if_assign` is the one | |||||
| store path: with Y = 0 it copies an interface value verbatim, otherwise it | |||||
| converts `if_obj` with the compile-time table in `if_tab`, and a zero object | |||||
| writes the canonical null. `if_arg_push` pushes the four bytes right-to-left so | |||||
| the object low byte lands at `FP+2`; `if_elem_store` and `if_elem_load` address | |||||
| 4-byte array elements at `base + IF_VALUE_SIZE*index` and refuse an address | |||||
| 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. | |||||
| The E06-S01 fixture (`tests/runtime/interface-test.s`) verifies the | The E06-S01 fixture (`tests/runtime/interface-test.s`) verifies the | ||||
| little-endian layout, canonical null, the invalid-table refusal, four-byte | little-endian layout, canonical null, the invalid-table refusal, four-byte | ||||
| copy, slot order, the result area, and the pushed argument order in x128. | 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 | 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 | 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 | and I/D preservation, the three target faults, and recovery after a full-stack | ||||
| refusal. | |||||
| 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. | |||||
| ### 7.6 Scalar code generation (E04-S03) | ### 7.6 Scalar code generation (E04-S03) | ||||
| @@ -75,6 +75,8 @@ documented default. `Proposed` means a later change still needs approval. | |||||
| | D144 | E06-S03 adds `src/common/iftables.inc` and `src/compiler/iftables.s` as the one interface-table emitter. `it_begin` (A/X = first table address) clears the error, table count, and buffer watermark; `it_set_addr` (A/X = address, Y = member row) records a method entry; `it_class` (A = class name ID) emits one table per implemented interface in implements order, one slot per interface method in slot order, resolving each requirement to the class member row through the exported `find_method`. Table data lives in a 512-byte `it_data` buffer with at most 16 tables and 255 address rows; parallel arrays `it_class_ids`, `it_iface_ids`, `it_slots`, `it_table_addrs`, and 2-byte `it_offsets` are indexed by table number. Errors are `IT_OK`, `IT_ERR_SPACE`, `IT_ERR_TABLES`, `IT_ERR_STATE`, `IT_ERR_METHOD`, and `IT_ERR_UNSET`; a failed class restores `it_used` and leaves `it_count` unchanged, so the caller can supply the missing address and retry. `output.s` gains `out_table` and appends `TABLE class interface address slots slot0 .. slotN` records after the METHOD records, bounded by `OUT_MAX_TABLES` (16) with `OUT_ERR_TABLES` (9). | Emits the tables E06-S01 froze and `if_call` consumes, with the destination address supplied by the caller because method placement is pass 3. The x128 fixture fills the real parser tables for two interfaces and two classes and checks table contents, distinct per-class tables, one ALPHA method filling both IFOO and IBAR slot 0, both rollback paths, the three MAP records, and `it_used = 10`. Binding the tables to pass 3, interface conversion, and lifetime remain E06-S04/E06-S05/E06-S06. | | | D144 | E06-S03 adds `src/common/iftables.inc` and `src/compiler/iftables.s` as the one interface-table emitter. `it_begin` (A/X = first table address) clears the error, table count, and buffer watermark; `it_set_addr` (A/X = address, Y = member row) records a method entry; `it_class` (A = class name ID) emits one table per implemented interface in implements order, one slot per interface method in slot order, resolving each requirement to the class member row through the exported `find_method`. Table data lives in a 512-byte `it_data` buffer with at most 16 tables and 255 address rows; parallel arrays `it_class_ids`, `it_iface_ids`, `it_slots`, `it_table_addrs`, and 2-byte `it_offsets` are indexed by table number. Errors are `IT_OK`, `IT_ERR_SPACE`, `IT_ERR_TABLES`, `IT_ERR_STATE`, `IT_ERR_METHOD`, and `IT_ERR_UNSET`; a failed class restores `it_used` and leaves `it_count` unchanged, so the caller can supply the missing address and retry. `output.s` gains `out_table` and appends `TABLE class interface address slots slot0 .. slotN` records after the METHOD records, bounded by `OUT_MAX_TABLES` (16) with `OUT_ERR_TABLES` (9). | Emits the tables E06-S01 froze and `if_call` consumes, with the destination address supplied by the caller because method placement is pass 3. The x128 fixture fills the real parser tables for two interfaces and two classes and checks table contents, distinct per-class tables, one ALPHA method filling both IFOO and IBAR slot 0, both rollback paths, the three MAP records, and `it_used = 10`. Binding the tables to pass 3, interface conversion, and lifetime remain E06-S04/E06-S05/E06-S06. | | ||||
| | 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. | | |||||
| ## Deferred | ## Deferred | ||||
| - Native C128/80-column Vim port | - Native C128/80-column Vim port | ||||
| @@ -162,6 +162,10 @@ its normal frame and reads them where the caller pushed them. | |||||
| | Table records | `it_class_ids`, `it_iface_ids`, `it_slots`, `it_table_addrs`, `it_offsets`, indexed by table number | | | Table records | `it_class_ids`, `it_iface_ids`, `it_slots`, `it_table_addrs`, `it_offsets`, indexed by table number | | ||||
| | Table result | one table per implemented interface in implements order, two bytes per slot; a failed class restores the watermark and count | | | Table result | one table per implemented interface in implements order, two bytes per slot; a failed class restores the watermark and count | | ||||
| | MAP table record | `TABLE class interface address slots slot0 .. slotN` | | | MAP table record | `TABLE class interface address slots slot0 .. slotN` | | ||||
| | Conversion table | `it_find` A = class ID, X = interface ID -> A/X = emitted table; `IT_ERR_IFACE` when absent | | |||||
| | 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 | | |||||
| | Fixture | code below `$4000`, producer `$03`, six phase flags | | | Fixture | code below `$4000`, producer `$03`, six phase flags | | ||||
| `src/common/interfaces.inc` fixes the layout; `src/runtime/interfaces.s` | `src/common/interfaces.inc` fixes the layout; `src/runtime/interfaces.s` | ||||
| @@ -0,0 +1,107 @@ | |||||
| --- | |||||
| story: E06-S04 | |||||
| owner: codebuff | |||||
| status: done | |||||
| started: 2026-11-10 | |||||
| completed: 2026-11-10 | |||||
| depends-on: [E06-S01, E06-S02, E06-S03] | |||||
| --- | |||||
| # E06-S04 Claim | |||||
| ## Intended change | |||||
| Turn a class reference or `null` into an interface value, and carry that value | |||||
| through every place the language allows, on top of the E06-S01 value ABI and the | |||||
| E06-S03 tables. `it_find` selects the table a class emitted for a given | |||||
| interface, so a conversion site never guesses. `if_assign`, `if_arg_push`, | |||||
| `if_elem_store`, and `if_elem_load` add the assignment, argument, and array | |||||
| paths the ABI described but did not yet implement. The compile-time rejection | |||||
| stays in `types.s` (E080) and is re-verified by the semantic suite. | |||||
| ## File area | |||||
| - `src/common/interfaces.inc`: `IF_ERR_RANGE`, element-stride wording | |||||
| - `src/common/iftables.inc`: `IT_ERR_IFACE` | |||||
| - `src/compiler/iftables.s`: `it_find` | |||||
| - `src/runtime/interfaces.s`: `if_assign`, `if_arg_push`, `if_elem_store`, | |||||
| `if_elem_load`, `if_elem_addr` | |||||
| - `tests/compiler/iftable-test.s`: `it_find` checks in phase 7 | |||||
| - `tests/runtime/convert-test.s` (new) | |||||
| - `scripts/build-convert-test.ps1`, `scripts/verify-convert-test.ps1` (new) | |||||
| - `scripts/verify-iftable-test.ps1`: failure detail (check address and value) | |||||
| - `docs/decisions.md` (D145), `docs/architecture.md` (status, 7.5), | |||||
| `docs/memory-map.md` (conversion rows) | |||||
| - `planning/claims/E06-S04.md` | |||||
| - generated files under `build/` | |||||
| ## Acceptance evidence | |||||
| - [x] Assignment creates the correct object/table pair: convert phase 1 assigns | |||||
| a class reference with `if_assign` mode 1 and checks all four bytes of the | |||||
| stored value (`obj_a_stub` then `tab_a`), with `if_error` `IF_OK`. The table | |||||
| fixture proves `it_find` returns exactly the emitted table for A/IFOO | |||||
| (`$B000`), A/IBAR (`$B004`), B/IFOO (`$B006`). | |||||
| - [x] `null` conversion produces a canonical null: convert phase 2 converts a | |||||
| zero object and checks four zero bytes, `if_error` `IF_OK`, and | |||||
| `if_is_null`'s C=1; copying that null value verbatim stays canonical. | |||||
| - [x] Passing, returning, storing, and array-copying preserve all four bytes: | |||||
| phase 3 copies an interface value into another and rejects a zero source | |||||
| pointer with `IF_ERR_NULL` while leaving the destination intact; phase 4 | |||||
| stores the pair in a four-byte field (leaving the two bytes before it at | |||||
| `$5A`) and in three independent array elements, loads elements 0, 1, and 2 | |||||
| back, and refuses a wrapped element address (`$FF00 + 4*200`) with | |||||
| `IF_ERR_RANGE`; phase 5 pushes the value as an argument and the callee reads | |||||
| object and table at `FP+2..FP+5`, with the frame stack restored; phase 6 | |||||
| round-trips a converted value through `IF_RESULT` twice, the second time with | |||||
| a different table. | |||||
| - [x] Invalid class-to-interface conversion is a compile-time error: the rule | |||||
| lives in `types.s` (`converts`), and `tests/semantic/refs.n8` expects | |||||
| `TYP_MISMATCH` for `n = b` (a class that does not implement `Named`) while | |||||
| accepting `s = b` for the interface it does implement. | |||||
| ## Coordination notes | |||||
| - Depends on E06-S01 (value ABI), E06-S02 (`if_call`), and E06-S03 (tables); | |||||
| all are complete. | |||||
| - `it_find` is the compiler-side half of conversion: pass 3 can ask for the | |||||
| table by class and interface instead of indexing `it_table_addrs` itself. | |||||
| - Codegen does not yet produce four-byte values, so assignment, argument, and | |||||
| array paths are proven at the ABI level; wiring them into `emit.s` belongs to | |||||
| E06-S05, which also emits the interface call itself. | |||||
| - ca65 2.19 lives in `C:\Program Files\cc65-snapshot-win32\bin`; VICE tools | |||||
| resolve through the test module and `x128` runs every fixture. | |||||
| ## Work log | |||||
| - Added `it_find` over the existing parallel arrays; a pair with no emitted | |||||
| table returns `IT_ERR_IFACE` with A/X=0, so a caller cannot manufacture a | |||||
| table for an interface the class does not implement. | |||||
| - Added the four runtime entry points and one shared refusal tail; `if_elem_addr` | |||||
| shifts the index into a 16-bit offset with `asl`/`rol` on memory so a byte | |||||
| index cannot lose its high bits (`200*4 = $0320`). | |||||
| - The first table-fixture run failed phase 7 with only `STEP $23` recorded. | |||||
| Step markers narrowed it to the refusal case: its guard used the success | |||||
| branch (`bcc`) where a correct refusal returns C=1, so the refusal jumped to | |||||
| `@fail`. Changed to `bcs`. | |||||
| - Verifier failure messages now report the last check address and value, which | |||||
| is what identified the missing step marker. | |||||
| ## Completion | |||||
| - Tests run: `scripts/verify-iftable-test.ps1` (x128, fresh D81; phase 7 now | |||||
| covers `it_find`); `scripts/verify-convert-test.ps1` (x128, fresh D81); | |||||
| `scripts/verify-parser-test.ps1` (semantic goldens, including `refs.n8`); | |||||
| `git diff --check`. | |||||
| - Results: both fixtures report PASS with every flag set and print | |||||
| `NOVA128 IFTABLE TEST OK` / `CONVERT OK`; `IFTTEST.MAP` still matches its | |||||
| four section records plus `TABLE A IFOO B000 02 7419 741A`, | |||||
| `TABLE A IBAR B004 01 7419`, `TABLE B IFOO B006 02 741C 741D`. The | |||||
| conversion PRG ends `$25E5`. | |||||
| - Remaining risks: `if_arg_push` pushes byte by byte, so a frame-stack refusal | |||||
| can leave the higher bytes already pushed; the caller's frame cleanup owns | |||||
| them. `it_find` returns the first matching table, which is unique because a | |||||
| class emits one table per implements entry and duplicate entries are a | |||||
| separate conformance question. Descriptor-directory lookups at run time, | |||||
| interface calls in generated code, and lifetime remain E06-S05/E06-S06; | |||||
| physical C128 testing remains P2 validation. | |||||
| @@ -0,0 +1,25 @@ | |||||
| # E06-S04: build the conversion 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\convert-test" | |||||
| New-Item -ItemType Directory -Force -Path $out | Out-Null | |||||
| $link = Invoke-Nova128Link -Name "convert-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\convert-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 ("convert-test ends at `$" + $end.ToString("X4") + "; it must stay below `$4000") | |||||
| } | |||||
| New-Nova128Disk -Path (Join-Path $out "convert-test.d81") -Files @( | |||||
| @{ Name = "convert-test"; Path = $link.Program; Type = "prg" }) | |||||
| Write-Host ("built {0} (end {1:X4})" -f $link.Program, $end) | |||||
| @@ -0,0 +1,46 @@ | |||||
| # E06-S04: run the conversion 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-convert-test.ps1") | |||||
| $out = Join-Path $project "build\convert-test" | |||||
| $disk = Join-Path $out "convert-test.d81" | |||||
| $failures = @() | |||||
| $session = Start-Nova128X128 -Autostart $disk -Drive8Image $disk -Port $Port ` | |||||
| -Screenshot (Join-Path $out "convert-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 6; $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 "CONVERT OK")) { | |||||
| $failures += "screen does not contain 'CONVERT OK'" | |||||
| } | |||||
| if ($failures) { throw ("conversion 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 6 conversion flags set" | |||||
| Write-Host "verified class and null conversion, verbatim copy, field, array elements, argument push, and the result area" | |||||
| @@ -76,7 +76,11 @@ if ($mapLines -and ($mapLines -join "`n") -ne ($expectedMap -join "`n")) { | |||||
| "`n want: " + ($expectedMap -join "`n ")) | "`n want: " + ($expectedMap -join "`n ")) | ||||
| } | } | ||||
| if ($failures) { throw ("interface table verification failed:`n " + ($failures -join "`n ")) } | |||||
| $detail = "last check {0:X4} value {1:X2}" -f ($mb[6] + 256 * $mb[7]), $mb[4] | |||||
| if ($failures) { | |||||
| throw ("interface table verification failed ($detail):`n " + ($failures -join "`n ") + | |||||
| "`n screen:`n " + (($rows | Where-Object { $_ }) -join "`n ")) | |||||
| } | |||||
| Write-Host "screen:" | Write-Host "screen:" | ||||
| $rows | Where-Object { $_ } | ForEach-Object { Write-Host " |$_" } | $rows | Where-Object { $_ } | ForEach-Object { Write-Host " |$_" } | ||||
| Write-Host "mailbox: producer 3, PASS, all 8 table flags set" | Write-Host "mailbox: producer 3, PASS, all 8 table flags set" | ||||
| @@ -13,6 +13,9 @@ | |||||
| ; it_table_addrs[t] assigned address (2 bytes) | ; it_table_addrs[t] assigned address (2 bytes) | ||||
| ; it_slots[t] slot count | ; it_slots[t] slot count | ||||
| ; it_offsets[t] byte offset of the table in it_data (2 bytes) | ; it_offsets[t] byte offset of the table in it_data (2 bytes) | ||||
| ; | |||||
| ; it_find turns a (class, interface) pair into the table that conversion | |||||
| ; needs, so a caller never has to search the arrays itself. | |||||
| .ifndef IFTABLES_INC | .ifndef IFTABLES_INC | ||||
| IFTABLES_INC = 1 | IFTABLES_INC = 1 | ||||
| @@ -27,5 +30,6 @@ IT_ERR_TABLES = 2 ; more than IT_MAX_TABLES tables | |||||
| IT_ERR_STATE = 3 ; an implements entry is not an interface | IT_ERR_STATE = 3 ; an implements entry is not an interface | ||||
| IT_ERR_METHOD = 4 ; the class declares no method for a slot | IT_ERR_METHOD = 4 ; the class declares no method for a slot | ||||
| IT_ERR_UNSET = 5 ; that method has no address yet | IT_ERR_UNSET = 5 ; that method has no address yet | ||||
| IT_ERR_IFACE = 6 ; the class emitted no table for that interface | |||||
| .endif | .endif | ||||
| @@ -11,8 +11,9 @@ | |||||
| ; no table header. Slot n therefore lives at table + 2*n. | ; no table header. Slot n therefore lives at table + 2*n. | ||||
| ; | ; | ||||
| ; Parameters, locals, fields, and array elements holding an interface value | ; Parameters, locals, fields, and array elements holding an interface value | ||||
| ; occupy IF_VALUE_SIZE bytes with no alignment padding. A caller pushes all | |||||
| ; four bytes right-to-left, so the object low byte ends at FP+2. | |||||
| ; occupy IF_VALUE_SIZE bytes with no alignment padding; adjacent array | |||||
| ; elements are IF_VALUE_SIZE apart. A caller pushes all four bytes | |||||
| ; right-to-left, so the object low byte ends at FP+2 (if_arg_push). | |||||
| ; | ; | ||||
| ; A four-byte result cannot travel in A/X. The callee writes the value to the | ; A four-byte result cannot travel in A/X. The callee writes the value to the | ||||
| ; fixed zero-page area IF_RESULT and the caller copies it out before making | ; fixed zero-page area IF_RESULT and the caller copies it out before making | ||||
| @@ -35,5 +36,6 @@ IF_ERR_NULL = 1 ; null value pointer or null object | |||||
| IF_ERR_TABLE = 2 ; non-null object with no method table | IF_ERR_TABLE = 2 ; non-null object with no method table | ||||
| IF_ERR_ENTRY = 3 ; method table slot holds address zero | IF_ERR_ENTRY = 3 ; method table slot holds address zero | ||||
| IF_ERR_STACK = 4 ; 6502 stack too low for a dispatch frame | IF_ERR_STACK = 4 ; 6502 stack too low for a dispatch frame | ||||
| IF_ERR_RANGE = 5 ; array element address wrapped past $FFFF | |||||
| .endif | .endif | ||||
| @@ -13,6 +13,11 @@ | |||||
| ; method in slot order, resolving each requirement to the | ; method in slot order, resolving each requirement to the | ||||
| ; class method row of the same name. C=0 on success; C=1 with | ; class method row of the same name. C=0 on success; C=1 with | ||||
| ; it_error set. | ; it_error set. | ||||
| ; it_find A = class name ID, X = interface name ID. A/X = the table | |||||
| ; address emitted for that pair, C=0. C=1 with | |||||
| ; IT_ERR_IFACE when this class emitted no table for that | |||||
| ; interface; conversion needs exactly one such table, so the | |||||
| ; caller reports E080 and emits nothing. | |||||
| ; | ; | ||||
| ; A failed it_class call is transactional: the buffer watermark and table | ; A failed it_class call is transactional: the buffer watermark and table | ||||
| ; count are restored, so a caller may fix the missing address and retry. | ; count are restored, so a caller may fix the missing address and retry. | ||||
| @@ -27,7 +32,7 @@ | |||||
| .import tb_get | .import tb_get | ||||
| .import find_method | .import find_method | ||||
| .export it_begin, it_set_addr, it_class | |||||
| .export it_begin, it_set_addr, it_class, it_find | |||||
| .export it_error, it_count, it_used, it_base, it_data | .export it_error, it_count, it_used, it_base, it_data | ||||
| .export it_class_ids, it_iface_ids, it_table_addrs, it_slots, it_offsets | .export it_class_ids, it_iface_ids, it_table_addrs, it_slots, it_offsets | ||||
| @@ -252,6 +257,51 @@ it_class: | |||||
| sec | sec | ||||
| rts | rts | ||||
| ; A = class name ID, X = interface name ID. A/X = that pair's table address. | |||||
| it_find: | |||||
| sta if_class | |||||
| stx if_iface | |||||
| lda #IT_OK | |||||
| sta it_error | |||||
| ldx #$00 | |||||
| @scan: cpx it_count | |||||
| beq @no | |||||
| lda it_class_ids,x | |||||
| cmp if_class | |||||
| bne @next | |||||
| lda it_iface_ids,x | |||||
| cmp if_iface | |||||
| beq @yes | |||||
| @next: inx | |||||
| bne @scan ; it_count <= IT_MAX_TABLES, so this ends | |||||
| @no: lda #IT_ERR_IFACE | |||||
| sta it_error | |||||
| lda #$00 | |||||
| tax | |||||
| sec | |||||
| rts | |||||
| @yes: stx if_idx | |||||
| lda #<it_table_addrs | |||||
| sta it_ptr | |||||
| lda #>it_table_addrs | |||||
| sta it_ptr+1 | |||||
| lda if_idx | |||||
| asl a | |||||
| clc | |||||
| adc it_ptr | |||||
| sta it_ptr | |||||
| bcc :+ | |||||
| inc it_ptr+1 | |||||
| : ldy #$00 | |||||
| lda (it_ptr),y | |||||
| pha | |||||
| iny | |||||
| lda (it_ptr),y | |||||
| tax | |||||
| pla | |||||
| clc | |||||
| rts | |||||
| ; C=1 when the current table (ic_slots entries) does not fit the buffer. | ; C=1 when the current table (ic_slots entries) does not fit the buffer. | ||||
| it_space: | it_space: | ||||
| lda ic_slots | lda ic_slots | ||||
| @@ -351,6 +401,9 @@ ic_addr: .res 2 | |||||
| ic_used0: .res 2 | ic_used0: .res 2 | ||||
| ic_need: .res 2 | ic_need: .res 2 | ||||
| ic_sum: .res 2 | ic_sum: .res 2 | ||||
| if_class: .res 1 | |||||
| if_iface: .res 1 | |||||
| if_idx: .res 1 | |||||
| it_data: .res IT_BUFFER_SIZE | it_data: .res IT_BUFFER_SIZE | ||||
| it_addrs: .res IT_MAX_ROWS * 2 | it_addrs: .res IT_MAX_ROWS * 2 | ||||
| it_class_ids: .res IT_MAX_TABLES | it_class_ids: .res IT_MAX_TABLES | ||||
| @@ -29,6 +29,21 @@ | |||||
| ; back unchanged and if_error is IF_OK, so if_error -- not C -- | ; back unchanged and if_error is IF_OK, so if_error -- not C -- | ||||
| ; tells the caller whether the call happened. | ; tells the caller whether the call happened. | ||||
| ; if_ret_load A/X = destination -> copies IF_RESULT there. | ; if_ret_load A/X = destination -> copies IF_RESULT there. | ||||
| ; if_assign A/X = destination, Y = mode. Y=0 copies if_src verbatim | |||||
| ; (interface to interface; a zero source pointer is | |||||
| ; IF_ERR_NULL and leaves the destination alone). Any other | |||||
| ; Y converts if_obj with the compile-time table in if_tab, | |||||
| ; which is how a class reference or null becomes an | |||||
| ; interface value (a zero object writes the canonical null). | |||||
| ; if_arg_push A/X = value pointer -> pushes its four bytes right-to-left | |||||
| ; so the object low byte lands at FP+2. IF_ERR_NULL for a | |||||
| ; zero pointer (nothing pushed) or IF_ERR_STACK when the | |||||
| ; frame stack refuses a byte. | |||||
| ; if_elem_store A/X = array base, Y = element index. Copies if_src into | |||||
| ; element Y at base + IF_VALUE_SIZE*index. IF_ERR_RANGE when | |||||
| ; that address wraps past $FFFF. | |||||
| ; if_elem_load A/X = array base, Y = element index. Copies element Y to | |||||
| ; if_dst; the same IF_ERR_RANGE refusal. | |||||
| ; | ; | ||||
| ; All destinations are caller-provided; nothing here allocates or validates a | ; All destinations are caller-provided; nothing here allocates or validates a | ||||
| ; destination pointer. Every routine may clobber A/X/Y: values and pointers | ; destination pointer. Every routine may clobber A/X/Y: values and pointers | ||||
| @@ -41,8 +56,11 @@ | |||||
| .include "../common/frames.inc" | .include "../common/frames.inc" | ||||
| .export if_conv, if_copy, if_is_null, if_slot, if_call, 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_assign, if_arg_push, if_elem_store, if_elem_load | |||||
| .export if_error, if_obj, if_tab, if_dst, if_src | .export if_error, if_obj, if_tab, if_dst, if_src | ||||
| .import frame_push_byte | |||||
| .segment "ZEROPAGE" | .segment "ZEROPAGE" | ||||
| if_obj: .res 2 ; concrete object pointer for if_conv | if_obj: .res 2 ; concrete object pointer for if_conv | ||||
| if_tab: .res 2 ; method table selected at compile time | if_tab: .res 2 ; method table selected at compile time | ||||
| @@ -224,6 +242,100 @@ if_call: | |||||
| rts | rts | ||||
| .assert <if_vec <> $FF, error, "if_vec must not straddle a page" | .assert <if_vec <> $FF, error, "if_vec must not straddle a page" | ||||
| ; ------------------------------------------------------------ assignment | |||||
| ; A/X = destination, Y = mode: 0 copies if_src, else converts if_obj/if_tab. | |||||
| if_assign: | |||||
| sta if_dst | |||||
| stx if_dst+1 | |||||
| cpy #$00 | |||||
| beq @copy | |||||
| jmp if_conv | |||||
| @copy: jmp if_copy | |||||
| ; A/X = value pointer. Four bytes right-to-left; object low at FP+2. | |||||
| if_arg_push: | |||||
| sta if_src | |||||
| stx if_src+1 | |||||
| lda #IF_OK | |||||
| sta if_error | |||||
| lda if_src | |||||
| ora if_src+1 | |||||
| beq @null | |||||
| ldy #IF_VALUE_SIZE - 1 | |||||
| @loop: lda (if_src),y | |||||
| sty if_i | |||||
| jsr frame_push_byte | |||||
| bcs @full | |||||
| ldy if_i | |||||
| dey | |||||
| bpl @loop | |||||
| clc | |||||
| rts | |||||
| @null: lda #IF_ERR_NULL | |||||
| sta if_error | |||||
| jmp if_refuse | |||||
| @full: lda #IF_ERR_STACK | |||||
| sta if_error | |||||
| jmp if_refuse | |||||
| ; ---------------------------------------------------------- array elements | |||||
| ; A/X = base, Y = index -> A/X = element address in if_elem; C=1 on wrap. | |||||
| if_elem_addr: | |||||
| sta if_base | |||||
| stx if_base+1 | |||||
| tya | |||||
| sta if_eoff | |||||
| lda #$00 | |||||
| sta if_eoff+1 | |||||
| asl if_eoff | |||||
| rol if_eoff+1 | |||||
| asl if_eoff | |||||
| rol if_eoff+1 | |||||
| clc | |||||
| lda if_base | |||||
| adc if_eoff | |||||
| sta if_elem | |||||
| lda if_base+1 | |||||
| adc if_eoff+1 | |||||
| sta if_elem+1 | |||||
| bcs @wrap | |||||
| clc | |||||
| rts | |||||
| @wrap: sec | |||||
| rts | |||||
| ; A/X = base, Y = index. if_src -> element Y. | |||||
| if_elem_store: | |||||
| jsr if_elem_addr | |||||
| bcs @range | |||||
| lda if_elem | |||||
| sta if_dst | |||||
| lda if_elem+1 | |||||
| sta if_dst+1 | |||||
| jmp if_copy | |||||
| @range: lda #IF_ERR_RANGE | |||||
| sta if_error | |||||
| jmp if_refuse | |||||
| ; A/X = base, Y = index. element Y -> if_dst. | |||||
| if_elem_load: | |||||
| jsr if_elem_addr | |||||
| bcs @range | |||||
| lda if_elem | |||||
| sta if_src | |||||
| lda if_elem+1 | |||||
| sta if_src+1 | |||||
| jmp if_copy | |||||
| @range: lda #IF_ERR_RANGE | |||||
| sta if_error | |||||
| jmp if_refuse | |||||
| if_refuse: | |||||
| lda #$00 | |||||
| tax | |||||
| sec | |||||
| rts | |||||
| ; A/X = value pointer -> IF_RESULT. | ; A/X = value pointer -> IF_RESULT. | ||||
| if_ret_store: | if_ret_store: | ||||
| sta if_src | sta if_src | ||||
| @@ -266,3 +378,7 @@ if_error: .res 1 | |||||
| if_slot_i: .res 1 | if_slot_i: .res 1 | ||||
| if_off: .res 1 | if_off: .res 1 | ||||
| if_entry: .res 2 | if_entry: .res 2 | ||||
| if_base: .res 2 | |||||
| if_eoff: .res 2 | |||||
| if_elem: .res 2 | |||||
| if_i: .res 1 | |||||
| @@ -30,7 +30,7 @@ | |||||
| .import out_table, out_table_iface, out_table_iface_len | .import out_table, out_table_iface, out_table_iface_len | ||||
| .import out_table_addr, out_table_slots, out_table_data | .import out_table_addr, out_table_slots, out_table_data | ||||
| .import tb_get, tb_set | .import tb_get, tb_set | ||||
| .import it_begin, it_set_addr, it_class | |||||
| .import it_begin, it_set_addr, it_class, it_find | |||||
| .import it_error, it_count, it_used, it_data | .import it_error, it_count, it_used, it_data | ||||
| .import it_class_ids, it_iface_ids, it_table_addrs, it_slots, it_offsets | .import it_class_ids, it_iface_ids, it_table_addrs, it_slots, it_offsets | ||||
| @@ -336,12 +336,63 @@ test_entry: | |||||
| jsr out_abort | jsr out_abort | ||||
| jmp @fail | jmp @fail | ||||
| ; 7: the watermark and record count match the three tables. | |||||
| ; 7: the watermark and record count match the three tables, and | |||||
| ; it_find selects a table by class and interface. | |||||
| @p7: | @p7: | ||||
| STEP $23 | STEP $23 | ||||
| CHK it_used, 10 | CHK it_used, 10 | ||||
| CHK it_used+1, 0 | CHK it_used+1, 0 | ||||
| CHK it_count, 3 | CHK it_count, 3 | ||||
| ; A implements IFOO at $B000 and IBAR at $B004. | |||||
| STEP $30 | |||||
| lda #3 | |||||
| ldx #1 | |||||
| jsr it_find | |||||
| bcc :+ | |||||
| jmp @fail | |||||
| : cmp #<TABLE_BASE | |||||
| beq :+ | |||||
| jmp @fail | |||||
| : cpx #>TABLE_BASE | |||||
| beq :+ | |||||
| jmp @fail | |||||
| : | |||||
| STEP $31 | |||||
| lda #3 | |||||
| ldx #2 | |||||
| jsr it_find | |||||
| bcc :+ | |||||
| jmp @fail | |||||
| : cmp #<(TABLE_BASE + 4) | |||||
| beq :+ | |||||
| jmp @fail | |||||
| : cpx #>(TABLE_BASE + 4) | |||||
| beq :+ | |||||
| jmp @fail | |||||
| : | |||||
| ; B implements IFOO at $B006, not IBAR. | |||||
| STEP $32 | |||||
| lda #4 | |||||
| ldx #1 | |||||
| jsr it_find | |||||
| bcc :+ | |||||
| jmp @fail | |||||
| : cmp #<(TABLE_BASE + 6) | |||||
| beq :+ | |||||
| jmp @fail | |||||
| : cpx #>(TABLE_BASE + 6) | |||||
| beq :+ | |||||
| jmp @fail | |||||
| : | |||||
| STEP $33 | |||||
| lda #4 | |||||
| ldx #2 | |||||
| jsr it_find | |||||
| bcs :+ ; a refusal is the expected result here | |||||
| jmp @fail | |||||
| : CHK it_error, IT_ERR_IFACE | |||||
| CHK it_count, 3 | |||||
| lda #$01 | lda #$01 | ||||
| sta MB_DATA+7 | sta MB_DATA+7 | ||||
| @@ -0,0 +1,531 @@ | |||||
| ; E06-S04: concrete-to-interface conversion fixture in x128. | |||||
| ; | |||||
| ; Runs under CR=$0E on the E06-S01 value ABI, the E06-S02 dispatch core, and | |||||
| ; the E06-S03 table shape. It checks: | |||||
| ; - assigning a class reference to an interface value writes the object | |||||
| ; pointer and the interface's method table (if_assign mode 1); | |||||
| ; - a null object converts to the canonical four zero bytes; | |||||
| ; - interface-to-interface assignment copies all four bytes verbatim, and a | |||||
| ; zero source pointer is IF_ERR_NULL; | |||||
| ; - a four-byte field and array elements at IF_VALUE_SIZE stride keep the | |||||
| ; pair, and an element address that wraps is IF_ERR_RANGE; | |||||
| ; - pushing an interface value as an argument leaves the object low byte at | |||||
| ; FP+2 and restores the frame stack; | |||||
| ; - a converted value survives the four-byte result area. | |||||
| ; | |||||
| ; The tables below are the shape E06-S03 emits: two-byte method addresses in | |||||
| ; interface slot order, no header. MB_DATA flags 0..5 report the six 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_discard | |||||
| .import if_assign, if_arg_push, if_elem_store, if_elem_load | |||||
| .import if_is_null, if_ret_store, if_ret_load | |||||
| .import if_error | |||||
| .importzp if_obj, if_tab, if_dst, if_src | |||||
| .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 POINT var | |||||
| lda #<var | |||||
| sta tptr | |||||
| lda #>var | |||||
| sta tptr+1 | |||||
| .endmacro | |||||
| .macro SETDST var | |||||
| lda #<var | |||||
| sta if_dst | |||||
| lda #>var | |||||
| sta if_dst+1 | |||||
| .endmacro | |||||
| .macro SETSRC var | |||||
| lda #<var | |||||
| sta if_src | |||||
| lda #>var | |||||
| sta if_src+1 | |||||
| .endmacro | |||||
| .macro OBJECT var | |||||
| lda #<var | |||||
| sta if_obj | |||||
| lda #>var | |||||
| sta if_obj+1 | |||||
| .endmacro | |||||
| .macro TABLE var | |||||
| lda #<var | |||||
| sta if_tab | |||||
| lda #>var | |||||
| sta if_tab+1 | |||||
| .endmacro | |||||
| .macro EXPECT v0, v1, v2, v3 | |||||
| lda #v0 | |||||
| sta e0 | |||||
| lda #v1 | |||||
| sta e1 | |||||
| lda #v2 | |||||
| sta e2 | |||||
| lda #v3 | |||||
| sta e3 | |||||
| .endmacro | |||||
| .macro FAIL_CS | |||||
| bcc :+ | |||||
| jmp @fail | |||||
| : | |||||
| .endmacro | |||||
| .macro FAIL_CC | |||||
| bcs :+ | |||||
| jmp @fail | |||||
| : | |||||
| .endmacro | |||||
| .macro FAIL_NE | |||||
| beq :+ | |||||
| jmp @fail | |||||
| : | |||||
| .endmacro | |||||
| .macro CHK addr, val | |||||
| lda addr | |||||
| cmp #val | |||||
| beq :+ | |||||
| pha | |||||
| lda #<addr | |||||
| sta MB_ADDR | |||||
| lda #>addr | |||||
| sta MB_ADDR+1 | |||||
| pla | |||||
| sta MB_CODE | |||||
| lda #$00 | |||||
| sta MB_CODE+1 | |||||
| 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" | |||||
| tptr: .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 | |||||
| sta MB_ADDR | |||||
| sta MB_ADDR+1 | |||||
| sta fail_mask | |||||
| ldx #$05 | |||||
| lda #$00 | |||||
| @flags: sta MB_DATA,x | |||||
| dex | |||||
| bpl @flags | |||||
| lda #$5A | |||||
| sta holder | |||||
| sta holder+1 | |||||
| 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: a class reference assigns the object/table pair. | |||||
| PHASE 1 | |||||
| OBJECT obj_a_stub | |||||
| TABLE tab_a | |||||
| lda #<val_a | |||||
| ldx #>val_a | |||||
| ldy #1 | |||||
| jsr if_assign | |||||
| FAIL_CS | |||||
| CHK if_error, IF_OK | |||||
| EXPECT <obj_a_stub, >obj_a_stub, <tab_a, >tab_a | |||||
| POINT val_a | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| lda #$01 | |||||
| sta MB_DATA+0 | |||||
| ; 2: null converts to the canonical four zero bytes. | |||||
| PHASE 2 | |||||
| lda #$00 | |||||
| sta if_obj | |||||
| sta if_obj+1 | |||||
| TABLE tab_a | |||||
| lda #<val_b | |||||
| ldx #>val_b | |||||
| ldy #1 | |||||
| jsr if_assign | |||||
| FAIL_CS | |||||
| CHK if_error, IF_OK | |||||
| EXPECT $00, $00, $00, $00 | |||||
| POINT val_b | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| lda #<val_b | |||||
| ldx #>val_b | |||||
| jsr if_is_null | |||||
| FAIL_CC | |||||
| ; A null value assigned verbatim stays canonical. | |||||
| SETSRC val_b | |||||
| lda #<val_c | |||||
| ldx #>val_c | |||||
| ldy #0 | |||||
| jsr if_assign | |||||
| FAIL_CS | |||||
| POINT val_c | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| lda #$01 | |||||
| sta MB_DATA+1 | |||||
| ; 3: interface-to-interface assignment preserves all four bytes. | |||||
| PHASE 3 | |||||
| SETSRC val_a | |||||
| lda #<val_d | |||||
| ldx #>val_d | |||||
| ldy #0 | |||||
| jsr if_assign | |||||
| FAIL_CS | |||||
| EXPECT <obj_a_stub, >obj_a_stub, <tab_a, >tab_a | |||||
| POINT val_d | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| lda #$00 | |||||
| sta if_src | |||||
| sta if_src+1 | |||||
| lda #<val_d | |||||
| ldx #>val_d | |||||
| ldy #0 | |||||
| jsr if_assign | |||||
| FAIL_CC | |||||
| CHK if_error, IF_ERR_NULL | |||||
| POINT val_d | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| lda #$01 | |||||
| sta MB_DATA+2 | |||||
| ; 4: one field and three array elements keep their own values. | |||||
| PHASE 4 | |||||
| SETSRC val_a | |||||
| lda #<holder_iface | |||||
| ldx #>holder_iface | |||||
| ldy #0 | |||||
| jsr if_assign | |||||
| FAIL_CS | |||||
| POINT holder_iface | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| CHK holder, $5A | |||||
| CHK holder+1, $5A | |||||
| SETSRC val_a | |||||
| lda #<elems | |||||
| ldx #>elems | |||||
| ldy #0 | |||||
| jsr if_elem_store | |||||
| FAIL_CS | |||||
| lda #<elems | |||||
| ldx #>elems | |||||
| ldy #2 | |||||
| jsr if_elem_store | |||||
| FAIL_CS | |||||
| SETSRC val_b | |||||
| lda #<elems | |||||
| ldx #>elems | |||||
| ldy #1 | |||||
| jsr if_elem_store | |||||
| FAIL_CS | |||||
| SETDST val_e | |||||
| lda #<elems | |||||
| ldx #>elems | |||||
| ldy #2 | |||||
| jsr if_elem_load | |||||
| FAIL_CS | |||||
| EXPECT <obj_a_stub, >obj_a_stub, <tab_a, >tab_a | |||||
| POINT val_e | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| SETDST val_f | |||||
| lda #<elems | |||||
| ldx #>elems | |||||
| ldy #1 | |||||
| jsr if_elem_load | |||||
| FAIL_CS | |||||
| EXPECT $00, $00, $00, $00 | |||||
| POINT val_f | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| SETDST val_g | |||||
| lda #<elems | |||||
| ldx #>elems | |||||
| ldy #0 | |||||
| jsr if_elem_load | |||||
| FAIL_CS | |||||
| EXPECT <obj_a_stub, >obj_a_stub, <tab_a, >tab_a | |||||
| POINT val_g | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| ; $FF00 + 4*200 wraps past $FFFF. | |||||
| SETDST val_g | |||||
| lda #$00 | |||||
| ldx #$FF | |||||
| ldy #200 | |||||
| jsr if_elem_load | |||||
| FAIL_CC | |||||
| CHK if_error, IF_ERR_RANGE | |||||
| lda #$01 | |||||
| sta MB_DATA+3 | |||||
| ; 5: an argument push puts the object low byte at FP+2. | |||||
| PHASE 5 | |||||
| jsr frame_init | |||||
| lda FRAME_SP | |||||
| sta saved_sp | |||||
| lda FRAME_SP+1 | |||||
| sta saved_sp+1 | |||||
| lda #<val_a | |||||
| ldx #>val_a | |||||
| jsr if_arg_push | |||||
| FAIL_CS | |||||
| jsr take_iface | |||||
| FAIL_CS | |||||
| lda #IF_VALUE_SIZE | |||||
| ldx #$00 | |||||
| jsr frame_discard | |||||
| lda FRAME_SP | |||||
| cmp saved_sp | |||||
| FAIL_NE | |||||
| lda FRAME_SP+1 | |||||
| cmp saved_sp+1 | |||||
| FAIL_NE | |||||
| lda #$00 | |||||
| ldx #$00 | |||||
| jsr if_arg_push | |||||
| FAIL_CC | |||||
| CHK if_error, IF_ERR_NULL | |||||
| lda FRAME_SP | |||||
| cmp saved_sp | |||||
| FAIL_NE | |||||
| lda FRAME_SP+1 | |||||
| cmp saved_sp+1 | |||||
| FAIL_NE | |||||
| lda #$01 | |||||
| sta MB_DATA+4 | |||||
| ; 6: a converted value survives the four-byte result area. | |||||
| PHASE 6 | |||||
| lda #<val_d | |||||
| ldx #>val_d | |||||
| jsr if_ret_store | |||||
| FAIL_CS | |||||
| lda #<val_c | |||||
| ldx #>val_c | |||||
| jsr if_ret_load | |||||
| FAIL_CS | |||||
| EXPECT <obj_a_stub, >obj_a_stub, <tab_a, >tab_a | |||||
| POINT val_c | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| OBJECT obj_a_stub | |||||
| TABLE tab_b | |||||
| lda #<val_e | |||||
| ldx #>val_e | |||||
| ldy #1 | |||||
| jsr if_assign | |||||
| FAIL_CS | |||||
| lda #<val_e | |||||
| ldx #>val_e | |||||
| jsr if_ret_store | |||||
| FAIL_CS | |||||
| lda #<val_g | |||||
| ldx #>val_g | |||||
| jsr if_ret_load | |||||
| FAIL_CS | |||||
| EXPECT <obj_a_stub, >obj_a_stub, <tab_b, >tab_b | |||||
| POINT val_g | |||||
| jsr cmp_val | |||||
| FAIL_CS | |||||
| lda #$01 | |||||
| sta MB_DATA+5 | |||||
| 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 | |||||
| ; Reads the four argument bytes at FP+2..FP+5: object, then table. | |||||
| take_iface: | |||||
| lda #$00 | |||||
| ldx #$00 | |||||
| jsr frame_enter | |||||
| bcs @bad | |||||
| ldy #2 | |||||
| lda (FRAME_FP),y | |||||
| cmp #<obj_a_stub | |||||
| bne @bad | |||||
| iny | |||||
| lda (FRAME_FP),y | |||||
| cmp #>obj_a_stub | |||||
| bne @bad | |||||
| iny | |||||
| lda (FRAME_FP),y | |||||
| cmp #<tab_a | |||||
| bne @bad | |||||
| iny | |||||
| lda (FRAME_FP),y | |||||
| cmp #>tab_a | |||||
| bne @bad | |||||
| jsr frame_leave | |||||
| clc | |||||
| rts | |||||
| @bad: sec | |||||
| rts | |||||
| ; C=1 when the four bytes at tptr differ from e0..e3. | |||||
| cmp_val: | |||||
| ldy #$00 | |||||
| lda (tptr),y | |||||
| cmp e0 | |||||
| bne @no | |||||
| iny | |||||
| lda (tptr),y | |||||
| cmp e1 | |||||
| bne @no | |||||
| iny | |||||
| lda (tptr),y | |||||
| cmp e2 | |||||
| bne @no | |||||
| iny | |||||
| lda (tptr),y | |||||
| cmp e3 | |||||
| bne @no | |||||
| clc | |||||
| rts | |||||
| @no: sec | |||||
| rts | |||||
| .segment "CODE" | |||||
| ; Method stubs the tables point at, as E06-S03 emits them. | |||||
| m_alpha_a: | |||||
| rts | |||||
| m_beta_a: | |||||
| rts | |||||
| m_alpha_b: | |||||
| rts | |||||
| m_beta_b: | |||||
| rts | |||||
| .segment "DATA" | |||||
| obj_a_stub: .res 2 ; stands in for an allocated object | |||||
| tab_a: .word m_alpha_a, m_beta_a | |||||
| tab_b: .word m_alpha_b, m_beta_b | |||||
| .assert * - tab_a = 2 * 2 * IF_SLOT_SIZE, error, "table size" | |||||
| .segment "RODATA" | |||||
| title: .byte "NOVA128 CONVERT TEST" | |||||
| title_len = * - title | |||||
| ok_msg: .byte "CONVERT OK" | |||||
| ok_len = * - ok_msg | |||||
| fail_msg: .byte "CONVERT FAIL" | |||||
| fail_len = * - fail_msg | |||||
| .segment "BSS" | |||||
| saved_cr: .res 1 | |||||
| saved_sp: .res 2 | |||||
| e0: .res 1 | |||||
| e1: .res 1 | |||||
| e2: .res 1 | |||||
| e3: .res 1 | |||||
| fail_mask: .res 1 | |||||
| val_a: .res IF_VALUE_SIZE | |||||
| val_b: .res IF_VALUE_SIZE | |||||
| val_c: .res IF_VALUE_SIZE | |||||
| val_d: .res IF_VALUE_SIZE | |||||
| val_e: .res IF_VALUE_SIZE | |||||
| val_f: .res IF_VALUE_SIZE | |||||
| val_g: .res IF_VALUE_SIZE | |||||
| holder: .res 2 | |||||
| holder_iface: .res IF_VALUE_SIZE | |||||
| elems: .res 3 * IF_VALUE_SIZE | |||||
| test_end: | |||||
Powered by TurnKey Linux.