dcovington
/
C64-dev
1
0
Atdalīts 0
Kods Problēmas 0 Izmaiņu pieprasījumi 0 Laidieni 0 Vikivietne Aktivitāte
Pārlūkot izejas kodu

Emit Nova128 interface method tables and MAP records (E06-S03). 

Classes now build one table per implemented interface, in implements order with
one two-byte entry per interface slot, and a failed class rolls back so a
missing method address is refused instead of dispatching to zero. The MAP gains
one TABLE record per table, and the x128 fixture checks table contents, distinct
per-class tables, both rollback paths, and the exact MAP text.

Generated with Codebuff
Co-Authored-By: Codebuff <noreply@codebuff.com>
main
Daniel Covington pirms 3 dienas
vecāks
5eadd14f57
revīzija
94c14229df
12 mainītis faili ar 1355 papildinājumiem un 6 dzēšanām
Dalītais skats
Salīdzināšanas iespējas
Rādīt statistiku Lejupielādēt ielāpa failu Lejupielādēt izmaiņu failu
  1. +26
    -3
      newLang/docs/architecture.md
  2. +2
    -0
      newLang/docs/decisions.md
  3. +7
    -2
      newLang/docs/memory-map.md
  4. +109
    -0
      newLang/planning/claims/E06-S03.md
  5. +36
    -0
      newLang/scripts/build-iftable-test.ps1
  6. +84
    -0
      newLang/scripts/verify-iftable-test.ps1
  7. +3
    -0
      newLang/src/common/formats.inc
  8. +31
    -0
      newLang/src/common/iftables.inc
  9. +360
    -0
      newLang/src/compiler/iftables.s
  10. +1
    -1
      newLang/src/compiler/interfaces.s
  11. +202
    -0
      newLang/src/compiler/output.s
  12. +494
    -0
      newLang/tests/compiler/iftable-test.s

+ 26
- 3
newLang/docs/architecture.md Parādīt failu

@@ -12,7 +12,8 @@ E01-S05 (section 4.4, `docs/memory-map.md`). E04-S01 defines the generated
PRG/MAP container and low-memory startup; E04-S02 adds the frame runtime; E05-S01
supplies an explicit-region heap; E05-S02 freezes class descriptors and MAP
class records; E06-S01 freezes the interface value ABI; E06-S02 adds the
dispatch trampoline. Generated-program heap placement and banking remain open.
dispatch trampoline; E06-S03 emits one table per implemented interface.
Generated-program heap placement and banking remain open.

## 1. System Boundary

@@ -462,6 +463,20 @@ vectors are untouched.
`delete` through an interface uses the object pointer and its class descriptor,
not the interface table, to find the optional destructor and object size.

`src/compiler/iftables.s` builds those tables (E06-S03, D144). `it_begin` takes
the image address of the first table, `it_set_addr` records a method entry for a
member row, and `it_class` walks the class's implements entries and emits one
table per interface in implements order, one slot per interface method in slot
order. Each requirement resolves through `find_method` to the class's member row
of the same name, so one method fills every interface slot it satisfies. The
buffer holds `IT_BUFFER_SIZE` (512) bytes, at most `IT_MAX_TABLES` (16) tables,
and `IT_MAX_ROWS` (255) address rows; the parallel arrays
`it_class_ids`/`it_iface_ids`/`it_slots`/`it_table_addrs`/`it_offsets` describe
each table by number. A slot whose method has no address is `IT_ERR_UNSET`
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
addresses because method placement is pass 3.

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.
@@ -741,14 +756,22 @@ address:
```text
CLASS name address size destroy interface-count interface-directory
METHOD name address
TABLE class interface address slots slot0 .. slotN
```

All numeric fields are four hex digits except the interface count, which is
two. METHOD records follow all CLASS records in `out_method` call order; both
All numeric fields are four hex digits except the interface count and the slot
count, which are two. METHOD records follow all CLASS records in `out_method` call order; both
record kinds use the final linked addresses. Empty classes and no destructor are written as `0000`; records keep the
caller's order. The class test reads the emitted MAP back and compares it with
the descriptor's actual destructor and directory addresses.

`out_table` (E06-S03) appends one TABLE record per emitted interface table
after the METHOD records: class and interface name, the table's assigned
address, its slot count, and one address per slot in interface order. Records
are capped at `OUT_MAX_TABLES` (16) with `OUT_ERR_TABLES` (9). The interface
table fixture reads the MAP back and compares all three records with the linker
labels of the method stubs.

### 8.3 Construction and deletion (E05-S03)

`src/runtime/construct.s` implements `new` and `delete` on top of the heap and


+ 2
- 0
newLang/docs/decisions.md Parādīt failu

@@ -73,6 +73,8 @@ documented default. `Proposed` means a later change still needs approval.
| D142 | E06-S01 freezes the interface value ABI in `src/common/interfaces.inc`. A value is a four-byte fat reference, little-endian: object pointer at +0 and interface method-table pointer at +2. All four bytes zero is canonical null; a non-null object with a zero table is `IF_ERR_TABLE`. A per-class table holds two-byte method entries in the interface's declaration slot order with no header, so slot *n* sits at table+2*n. Interface parameters, locals, fields, and array elements occupy four bytes with no padding, and callers push all four bytes right-to-left so the object low byte is at `FP+2`. A four-byte result cannot use A/X: the callee writes it to fixed zero-page `IF_RESULT` (`$C6-$C9`) and the caller copies it out before another interface-returning call. `src/runtime/interfaces.s` supplies `if_conv`, `if_copy`, `if_is_null`, `if_slot`, `if_ret_store`, and `if_ret_load`, with `if_error` reporting `IF_OK`, `IF_ERR_NULL`, or `IF_ERR_TABLE`. | Implements the E06-S01 freeze above the object/descriptor ABI and settles the open interface-result convention. Dispatch, table emission, and interface lifetime remain E06-S02/E06-S03/E06-S06. The x128 fixture checks layout, null, copy, slot order, the result area, and argument order; the assertion keeps `IF_RESULT` clear of the print vectors and for-end values. |
| D143 | E06-S02 adds `if_call` to `src/runtime/interfaces.s` as the one interface dispatch path: A/X = interface value pointer, Y = slot. It resolves the slot through `if_slot`, stores the entry in page-safe `if_vec`, and jumps there with A/X = the object pointer as `self` after pushing one synthetic return address. Faults happen before any target executes: `IF_ERR_ENTRY` for a zero entry, `IF_ERR_NULL`, `IF_ERR_TABLE`, and `IF_ERR_STACK` when TSX is at or below `FRAME_HW_MIN`. The callee's A/X and flags come back unchanged, so a refusal is reported by `if_error` (`IF_OK` exactly when the call happened), not by C. | Gives every interface call one audited trampoline instead of duplicating synthetic-return code, and refuses invalid targets rather than jumping to address zero. The x128 fixture covers three runtime-selected targets, three-level nesting, 8- and 12-level recursion, SP/frame/argument/IRQ and I/D preservation, the three target faults, a full-stack refusal with recovery, and the page-safety assertion. |

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

## Deferred

- Native C128/80-column Vim port


+ 7
- 2
newLang/docs/memory-map.md Parādīt failu

@@ -157,14 +157,19 @@ its normal frame and reads them where the caller pushed them.
| Module status | `if_error`: `IF_OK`, `IF_ERR_NULL`, `IF_ERR_TABLE`, `IF_ERR_ENTRY`, `IF_ERR_STACK` |
| Dispatch | `if_call` takes A/X = value, Y = slot; a refusal leaves A/X=0, C=1 and sets `if_error` |
| Dispatch floor | TSX at or below `FRAME_HW_MIN` (`$40`) is refused with `IF_ERR_STACK` |
| Table emitter | `it_begin` A/X = first table address; `it_set_addr` A/X = address, Y = member row; `it_class` A = class name ID |
| Table emitter state | `it_count`, `it_used` (2-byte watermark), `it_error` (`IT_OK`..`IT_ERR_UNSET`), `it_data` (512-byte buffer) |
| 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 |
| MAP table record | `TABLE class interface address slots slot0 .. slotN` |
| Fixture | code below `$4000`, producer `$03`, six phase flags |

`src/common/interfaces.inc` fixes the layout; `src/runtime/interfaces.s`
implements `if_conv`, `if_copy`, `if_is_null`, `if_slot`, `if_call`,
`if_ret_store`, and `if_ret_load`. The module asserts at link time that
`IF_RESULT` follows the print vectors (`$C0-$C5`) and ends below the for-end
values (`$D0`), and that `if_vec` does not cross a page. Interface table
emission and interface lifetime remain E06-S03/E06-S06.
values (`$D0`), and that `if_vec` does not cross a page. Interface lifetime
remains E06-S06.

## Mappings



+ 109
- 0
newLang/planning/claims/E06-S03.md Parādīt failu

@@ -0,0 +1,109 @@
---
story: E06-S03
owner: codebuff
status: done
started: 2026-11-10
completed: 2026-11-10
depends-on: [E06-S01, E06-S02, E05-S02]
---

# E06-S03 Claim

## Intended change

Emit the per-class interface method tables the E06-S01 ABI froze and `if_call`
consumes. A new `src/compiler/iftables.s` walks each class's implements entries
and writes one table per interface in implements order, one slot per interface
method in slot order, resolving every requirement to the class member row of
the same name. `output.s` records each table in the MAP. A new x128 fixture
fills the real parser tables and proves table contents, distinct per-class
tables, both rollback paths, and the MAP records.

## File area

- `src/common/iftables.inc` (new): buffer, table, and row limits and `IT_ERR_*`
- `src/compiler/iftables.s` (new): `it_begin`, `it_set_addr`, `it_class`
- `src/common/formats.inc`: `OUT_MAX_TABLES`, `OUT_TABLE_RECORD_SIZE`,
`OUT_ERR_TABLES`
- `src/compiler/interfaces.s`: exports the existing `find_method`
- `src/compiler/output.s`: `out_table`, `out_write_tables`, TABLE records
- `tests/compiler/iftable-test.s` (new)
- `scripts/build-iftable-test.ps1`, `scripts/verify-iftable-test.ps1` (new)
- `docs/decisions.md` (D144), `docs/architecture.md` (7.5, 8.2, status),
`docs/memory-map.md` (table rows)
- `planning/claims/E06-S03.md`
- generated files under `build/`

## Acceptance evidence

- [x] One table per implemented interface, in implements order, slots in
interface order, two bytes per slot: class A's IFOO table holds
`m_alpha_a` then `m_beta_a` and its IBAR table holds `m_alpha_a`; the
fixture checks `it_data`, `it_class_ids`, `it_iface_ids`, `it_slots`,
`it_table_addrs`, and `it_offsets`.
- [x] Class B gets its own table with its own methods: phase 2 checks
`it_data+6..+9` against `m_alpha_b`/`m_beta_b` and the third address
`$B006`.
- [x] One method satisfies every interface slot of that signature: A's single
ALPHA method fills IFOO slot 0 and IBAR slot 0 (phases 0 and 3).
- [x] A slot with no address is refused, not written as zero: a table entry
supplied as 0 gives `IT_ERR_UNSET`, `it_count` stays 3, and `it_used`
returns to 10 (phase 4).
- [x] A table that cannot fit the buffer is refused and rolled back: interface
IFOO temporarily claiming 255 slots gives `IT_ERR_SPACE` with the same
restored watermark and count (phase 5).
- [x] The MAP gains one TABLE record per table: the fixture writes
`IFTTEST.PRG`/`IFTTEST.MAP` through `output.s` and the verifier compares the
three records with the linker labels of the four method stubs (phase 6).
- [x] Watermark and record count match the emitted tables: `it_used = $000A`,
`it_count = 3` (phase 7).

## Coordination notes

- Depends on E06-S01 (value/table ABI), E06-S02 (`if_call`), and E05-S02
(class descriptors); E06-S03 only builds bytes and MAP records and does not
link a descriptor's directory yet.
- `it_class` takes destination addresses from the caller because method
placement is pass 3; pass 3 wiring is E06-S04/E06-S05.
- `find_method` was exported from `interfaces.s` rather than duplicated, so
table emission and `check_interfaces` resolve names identically.
- ca65 2.19 lives in `C:\Program Files\cc65-snapshot-win32\bin`; VICE tools
resolve through the test module and `x128` (never `x64sc`) runs the fixture.

## Work log

- First fixture build hit two ca65 range errors (`bcc @fail` over more than
127 bytes); both became the project's `bcs :+`/`jmp` trampoline form.
- The run then hung: `@fail` jumped to the phase-7 label, so a phase-0 failure
re-ran phase 7 forever. `@fail` now jumps straight to the report block.
- `it_class` initially read `C_TYPE_ICOUNT` without storing it, so the loop
compared stale zeros and emitted no tables; `ic_n`/`ic_row`/`ic_i` are now
initialised from `C_TYPE_ICOUNT`/`C_TYPE_IFIRST`.
- The emitter advanced `it_dst` by one byte per slot, so pairs overlapped;
`it_dst` is now recomputed from the watermark after each slot.
- `it_addr_get` returned `hi|lo` because the unset test left the OR in A, so
`$72FC` became `$72FE`; it now reloads the low byte before returning.
- `@report` called `mmu_shutdown` first, but this fixture's `fail_mask` and
message strings live above `$4000`, so they must be read while MAIN is
mapped. The status and message are now decided first, the text is copied to
a `SCRATCH` buffer at `$1B00`, and shutdown happens before `CHROUT`.
- A stale D81 also made `out_begin` report `OUT_ERR_EXISTS`; the verifier now
reports the mailbox check address instead of throwing on a missing MAP.

## Completion

- Tests run: `scripts/verify-iftable-test.ps1` (x128, fresh D81 rebuilt by
the verifier); `git diff --check`.
- Results: PASS with all eight `MB_DATA` flags set; screen shows
`NOVA128 IFTABLE TEST OK`; `IFTTEST.MAP` is exactly:
`NOVA128 MAP 1`, `ENTRY 1C0D`, `SECTION STUB 1C01 000C`,
`SECTION START 1C0D 004A`,
`TABLE A IFOO B000 02 731C 731D`, `TABLE A IBAR B004 01 731C`,
`TABLE B IFOO B006 02 731F 7320`. The PRG image ends `$7EA5` (25,254
bytes).
- Remaining risks: tables are built in a 512-byte buffer with 16 tables and
255 address rows, so a very large interface set is refused rather than
spilled; `it_class` trusts the parser tables (an implements row that is not
an interface is `IT_ERR_STATE` but a method row is not otherwise validated).
Descriptor directories, interface conversion, and lifetime remain
E06-S04/E06-S05/E06-S06, and physical C128 testing remains P2 validation.

+ 36
- 0
newLang/scripts/build-iftable-test.ps1 Parādīt failu

@@ -0,0 +1,36 @@
# E06-S03: build the interface table 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\iftable-test"
New-Item -ItemType Directory -Force -Path $out | Out-Null

$link = Invoke-Nova128Link -Name "iftable-test" -BuildDir $out `
-Config (Join-Path $project "cfg\compiler.cfg") -Sources @(
(Join-Path $project "src\compiler\mmu.s"),
(Join-Path $project "src\compiler\diskio.s"),
(Join-Path $project "src\compiler\source.s"),
(Join-Path $project "src\compiler\lexer.s"),
(Join-Path $project "src\compiler\names.s"),
(Join-Path $project "src\compiler\diagnostics.s"),
(Join-Path $project "src\compiler\parser.s"),
(Join-Path $project "src\compiler\codegen.s"),
(Join-Path $project "src\compiler\flow.s"),
(Join-Path $project "src\compiler\members.s"),
(Join-Path $project "src\compiler\sizing.s"),
(Join-Path $project "src\compiler\emit.s"),
(Join-Path $project "src\compiler\interfaces.s"),
(Join-Path $project "src\compiler\types.s"),
(Join-Path $project "src\compiler\iftables.s"),
(Join-Path $project "src\compiler\output.s"),
(Join-Path $project "src\runtime\startup.s"),
(Join-Path $project "tests\compiler\iftable-test.s"))
if ((Get-Nova128Label $link.Labels "test_entry") -ne 0x1C0D) { throw "test_entry is not at `$1C0D" }

New-Nova128Disk -Path (Join-Path $out "iftable-test.d81") -Files @(
@{ Name = "IFTTEST"; Path = $link.Program; Type = "prg" })
Write-Host ("built {0}" -f $link.Program)
Write-Host ("disk {0}" -f (Join-Path $out "iftable-test.d81"))

+ 84
- 0
newLang/scripts/verify-iftable-test.ps1 Parādīt failu

@@ -0,0 +1,84 @@
# E06-S03: run the interface table fixture in x128 and check its mailbox and
# the TABLE records in IFTTEST.MAP.
[CmdletBinding()]
param([int]$Port = 6559, [int]$TimeoutSeconds = 180)

$ErrorActionPreference = "Stop"
$project = Split-Path $PSScriptRoot -Parent
Import-Module (Join-Path $PSScriptRoot "lib\Nova128Test.psm1") -Force
& (Join-Path $PSScriptRoot "build-iftable-test.ps1")

$out = Join-Path $project "build\iftable-test"
$disk = Join-Path $out "iftable-test.d81"
$labels = Join-Path $out "iftable-test.lbl"
$c1541 = Get-ViceTool "c1541"
$failures = @()

$session = Start-Nova128X128 -Autostart $disk -Drive8Image $disk -Port $Port `
-Screenshot (Join-Path $out "iftable-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 8; $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 "NOVA128 IFTABLE TEST OK")) {
$failures += "screen does not contain 'NOVA128 IFTABLE TEST OK'"
}

function Read-DiskFile([string]$Name, [string]$Dest, [bool]$Seq) {
if (Test-Path -LiteralPath $Dest) { Remove-Item -LiteralPath $Dest -Force }
$spec = if ($Seq) { "$Name,s" } else { $Name }
$prev = $ErrorActionPreference
$ErrorActionPreference = "Continue"
& $c1541 -attach $disk -read $spec $Dest 2>&1 | Out-Null
$ErrorActionPreference = $prev
return (Test-Path -LiteralPath $Dest)
}

$mapPath = Join-Path $out "IFTTEST.MAP"
if (Read-DiskFile "ifttest.map" $mapPath $true) {
$mapLines = ([IO.File]::ReadAllText($mapPath)).TrimEnd("`r", "`n") -split "`r`n|`r|`n"
} else {
$failures += ("no IFTTEST.MAP (check at {0:X2}{1:X2})" -f $mb[7], $mb[6])
$mapLines = @()
}
$alphaA = Get-Nova128Label $labels "m_alpha_a"
$betaA = Get-Nova128Label $labels "m_beta_a"
$alphaB = Get-Nova128Label $labels "m_alpha_b"
$betaB = Get-Nova128Label $labels "m_beta_b"
$expectedMap = @(
"NOVA128 MAP 1",
"ENTRY 1C0D",
"SECTION STUB 1C01 000C",
"SECTION START 1C0D 004A",
("TABLE A IFOO B000 02 {0:X4} {1:X4}" -f $alphaA, $betaA),
("TABLE A IBAR B004 01 {0:X4}" -f $alphaA),
("TABLE B IFOO B006 02 {0:X4} {1:X4}" -f $alphaB, $betaB))
if ($mapLines -and ($mapLines -join "`n") -ne ($expectedMap -join "`n")) {
$failures += ("IFTTEST.MAP differs:`n got: " + ($mapLines -join "`n ") +
"`n want: " + ($expectedMap -join "`n "))
}

if ($failures) { throw ("interface table verification failed:`n " + ($failures -join "`n ")) }
Write-Host "screen:"
$rows | Where-Object { $_ } | ForEach-Object { Write-Host " |$_" }
Write-Host "mailbox: producer 3, PASS, all 8 table flags set"
Write-Host "MAP:"
$expectedMap | ForEach-Object { Write-Host " |$_" }

+ 3
- 0
newLang/src/common/formats.inc Parādīt failu

@@ -19,6 +19,8 @@ OUT_MAX_CLASSES = 8
OUT_CLASS_RECORD_SIZE = 12 ; name ptr(2), len(1), addr(2), size(2), destroy(2), count(1), dir(2)
OUT_MAX_METHODS = 16
OUT_METHOD_RECORD_SIZE = 5 ; name ptr(2), len(1), address(2)
OUT_MAX_TABLES = 16
OUT_TABLE_RECORD_SIZE = 11 ; class ptr(2), len(1), iface ptr(2), len(1), addr(2), slots(1), data(2)

; out_begin/out_finish/out_abort result codes (out_err).
OUT_OK = 0
@@ -30,5 +32,6 @@ OUT_ERR_DISK = 5 ; KERNAL or DOS failure
OUT_ERR_STATE = 6 ; byte emitted outside a section
OUT_ERR_CLASSES = 7 ; more than OUT_MAX_CLASSES
OUT_ERR_METHODS = 8 ; more than OUT_MAX_METHODS
OUT_ERR_TABLES = 9 ; more than OUT_MAX_TABLES

.endif

+ 31
- 0
newLang/src/common/iftables.inc Parādīt failu

@@ -0,0 +1,31 @@
; iftables.inc - per-class interface method tables (E06-S03, D144).
;
; A class emits one table per interface it implements. A table is the
; interface's slots in declaration order, two bytes per slot holding the
; concrete method entry address, with no header: slot n is at table+2*n
; (E06-S01). src/compiler/iftables.s builds the bytes; it_base is the image
; address the first table was assigned.
;
; Table records are parallel arrays indexed by table number 0..it_count-1, so
; the MAP writer and later compiler passes read them without a record parser:
; it_class_ids[t] class name ID
; it_iface_ids[t] interface name ID
; it_table_addrs[t] assigned address (2 bytes)
; it_slots[t] slot count
; it_offsets[t] byte offset of the table in it_data (2 bytes)

.ifndef IFTABLES_INC
IFTABLES_INC = 1

IT_MAX_TABLES = 16 ; matches OUT_MAX_TABLES
IT_BUFFER_SIZE = $0200 ; 512 bytes of table data
IT_MAX_ROWS = 255 ; member rows addressable by it_addrs

IT_OK = 0
IT_ERR_SPACE = 1 ; the table data buffer is full
IT_ERR_TABLES = 2 ; more than IT_MAX_TABLES tables
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_UNSET = 5 ; that method has no address yet

.endif

+ 360
- 0
newLang/src/compiler/iftables.s Parādīt failu

@@ -0,0 +1,360 @@
; iftables.s - per-class interface method tables (E06-S03).
;
; Runs after assign_slots/check_interfaces, when every class, interface,
; member row, implements row, and slot is recorded in the parser tables.
;
; API (normal bank-0 compiler state; tables are read through tb_get):
; it_begin A/X = address of the first table in the generated image.
; Clears the error, table count, and buffer watermark.
; it_set_addr A = low, X = high, Y = member row. Records the method entry
; address later emitted into every table that uses that row.
; it_class A = class name ID. Emits one table per implemented
; interface, in implements order, and one slot per interface
; method in slot order, resolving each requirement to the
; class method row of the same name. C=0 on success; C=1 with
; it_error set.
;
; 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.
; Addresses are supplied by the caller because method placement is pass 3;
; a slot whose row has no address (0) is IT_ERR_UNSET rather than a table
; entry that would dispatch to address zero.

.setcpu "6502"
.include "../common/iftables.inc"
.include "../common/parser.inc"

.import tb_get
.import find_method

.export it_begin, it_set_addr, it_class
.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

.segment "ZEROPAGE"
it_ptr: .res 2
it_dst: .res 2

.segment "CODE"

; A/X = image address of the first table.
it_begin:
sta it_base
stx it_base+1
lda #IT_OK
sta it_error
lda #$00
sta it_count
sta it_used
sta it_used+1
clc
rts

; A = low, X = high, Y = member row.
it_set_addr:
sty it_row
sta it_lo
stx it_hi
lda #<it_addrs
sta it_ptr
lda #>it_addrs
sta it_ptr+1
lda it_row
asl a
sta it_pair_lo
lda #$00
rol a
sta it_pair_hi
clc
lda it_ptr
adc it_pair_lo
sta it_ptr
lda it_ptr+1
adc it_pair_hi
sta it_ptr+1
ldy #$00
lda it_lo
sta (it_ptr),y
iny
lda it_hi
sta (it_ptr),y
clc
rts

; A = class name ID.
it_class:
sta ic_class
lda #IT_OK
sta it_error
lda it_used
sta ic_used0
lda it_used+1
sta ic_used0+1
ldy ic_class
lda #C_TYPE_ICOUNT
jsr tb_get
sta ic_n
lda #$00
sta ic_i
ldy ic_class
lda #C_TYPE_IFIRST
jsr tb_get
sta ic_row
lda ic_n
bne @impl
jmp @done
@impl:
lda ic_i
cmp ic_n
beq @last
jmp @body
@last: jmp @done
@body:
ldy ic_row
lda #C_IMPL_IFACE
jsr tb_get
sta ic_iface
ldy ic_iface
lda #C_TYPE_KIND
jsr tb_get
cmp #TYPE_INTERFACE
beq @kind
lda #IT_ERR_STATE
jmp @fail
@kind:
lda it_count
cmp #IT_MAX_TABLES
bcc @slots
lda #IT_ERR_TABLES
jmp @fail
@slots:
lda it_used
sta ic_used0
lda it_used+1
sta ic_used0+1
ldy ic_iface
lda #C_TYPE_MCOUNT
jsr tb_get
sta ic_slots
jsr it_space
bcc @space
lda #IT_ERR_SPACE
jmp @fail
@space:
clc
lda it_base
adc it_used
sta ic_addr
lda it_base+1
adc it_used+1
sta ic_addr+1
clc
lda #<it_data
adc it_used
sta it_dst
lda #>it_data
adc it_used+1
sta it_dst+1
ldy ic_iface
lda #C_TYPE_MFIRST
jsr tb_get
sta ic_req
lda ic_slots
sta ic_left
@slot:
lda ic_left
bne @withreq
jmp @table
@withreq:
ldy ic_req
lda #C_MEM_NAME
jsr tb_get
sta ic_name
lda ic_class
ldx ic_name
jsr find_method
bcs @found
lda #IT_ERR_METHOD
jmp @fail
@found:
sty ic_method
tya
jsr it_addr_get
bcc @addr
lda #IT_ERR_UNSET
jmp @fail
@addr:
ldy #$00
sta (it_dst),y
iny
txa
sta (it_dst),y
clc
lda it_used
adc #$02
sta it_used
lda it_used+1
adc #$00
sta it_used+1
clc
lda #<it_data
adc it_used
sta it_dst
lda #>it_data
adc it_used+1
sta it_dst+1
inc ic_req
dec ic_left
jmp @slot
@table:
ldx it_count
lda ic_class
sta it_class_ids,x
lda ic_iface
sta it_iface_ids,x
lda ic_slots
sta it_slots,x
lda #<it_table_addrs
sta it_ptr
lda #>it_table_addrs
sta it_ptr+1
jsr it_pair
ldy #$00
lda ic_addr
sta (it_ptr),y
iny
lda ic_addr+1
sta (it_ptr),y
lda #<it_offsets
sta it_ptr
lda #>it_offsets
sta it_ptr+1
jsr it_pair
ldy #$00
lda ic_used0
sta (it_ptr),y
iny
lda ic_used0+1
sta (it_ptr),y
inc it_count
inc ic_row
inc ic_i
jmp @impl
@done:
clc
rts
@fail:
sta it_error
lda ic_used0
sta it_used
lda ic_used0+1
sta it_used+1
sec
rts

; C=1 when the current table (ic_slots entries) does not fit the buffer.
it_space:
lda ic_slots
asl a
sta ic_need
lda #$00
rol a
sta ic_need+1
clc
lda it_used
adc ic_need
sta ic_sum
lda it_used+1
adc ic_need+1
sta ic_sum+1
lda ic_sum+1
cmp #>IT_BUFFER_SIZE
bcc @ok
bne @no
lda ic_sum
cmp #<IT_BUFFER_SIZE
beq @ok
@no: sec
rts
@ok: clc
rts

; A = member row. A/X = recorded address, C=1 when it is still zero.
it_addr_get:
sta it_row
lda #<it_addrs
sta it_ptr
lda #>it_addrs
sta it_ptr+1
lda it_row
asl a
sta it_pair_lo
lda #$00
rol a
sta it_pair_hi
clc
lda it_ptr
adc it_pair_lo
sta it_ptr
lda it_ptr+1
adc it_pair_hi
sta it_ptr+1
ldy #$00
lda (it_ptr),y
pha
iny
lda (it_ptr),y
tax
pla
sta it_lo
txa
ora it_lo
beq @unset
lda it_lo
clc
rts
@unset: sec
rts

; it_ptr = it_ptr + 2 * it_count.
it_pair:
lda it_count
asl a
clc
adc it_ptr
sta it_ptr
bcc :+
inc it_ptr+1
: rts

.segment "BSS"
it_base: .res 2
it_error: .res 1
it_count: .res 1
it_used: .res 2
it_row: .res 1
it_lo: .res 1
it_hi: .res 1
it_pair_lo: .res 1
it_pair_hi: .res 1
ic_class: .res 1
ic_iface: .res 1
ic_n: .res 1
ic_row: .res 1
ic_i: .res 1
ic_slots: .res 1
ic_left: .res 1
ic_req: .res 1
ic_name: .res 1
ic_method: .res 1
ic_addr: .res 2
ic_used0: .res 2
ic_need: .res 2
ic_sum: .res 2
it_data: .res IT_BUFFER_SIZE
it_addrs: .res IT_MAX_ROWS * 2
it_class_ids: .res IT_MAX_TABLES
it_iface_ids: .res IT_MAX_TABLES
it_table_addrs: .res IT_MAX_TABLES * 2
it_slots: .res IT_MAX_TABLES
it_offsets: .res IT_MAX_TABLES * 2

+ 1
- 1
newLang/src/compiler/interfaces.s Parādīt failu

@@ -31,7 +31,7 @@
.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
.export assign_slots, check_interfaces, find_method

.segment "CODE"



+ 202
- 0
newLang/src/compiler/output.s Parādīt failu

@@ -8,6 +8,7 @@
; ENTRY hhhh
; SECTION name start size
; CLASS name address size destroy interface-count interface-directory
; TABLE class interface address slots slot0 .. slotN
;
; API (all calls in the bank-0 compiler state):
; out_begin A/X = source name (bank 0), Y = length. Sets out_load and
@@ -40,6 +41,8 @@
.export out_begin, out_startup, out_section, out_end_section
.export out_byte, out_bytes, out_finish, out_abort
.export out_class, out_class_addr, out_method, out_method_addr
.export out_table, out_table_iface, out_table_iface_len, out_table_addr
.export out_table_slots, out_table_data, out_table_count
.export out_class_size, out_class_destroy, out_class_ifaces, out_class_ifdir
.export out_load, out_entry, out_start, out_err

@@ -150,6 +153,24 @@ set_class_ptr:
bne @add
@done: rts

; out_rec_ptr = out_tables + out_index * OUT_TABLE_RECORD_SIZE.
set_table_ptr:
lda #<out_tables
sta out_rec_ptr
lda #>out_tables
sta out_rec_ptr+1
ldx out_index
beq @done
@add: clc
lda out_rec_ptr
adc #OUT_TABLE_RECORD_SIZE
sta out_rec_ptr
bcc :+
inc out_rec_ptr+1
: dex
bne @add
@done: rts

; out_rec_ptr = out_methods + out_index * OUT_METHOD_RECORD_SIZE.
set_method_ptr:
lda #<out_methods
@@ -254,6 +275,7 @@ out_begin:
sta out_count
sta out_class_count
sta out_method_count
sta out_table_count
sta out_class_addr
sta out_class_addr+1
sta out_in_section
@@ -681,6 +703,71 @@ out_method:
sec
rts

; A/X = class name, Y = length. out_table_iface/_len, out_table_addr,
; out_table_slots, and out_table_data supply the rest of the record.
out_table:
sta out_tmp
stx out_tmp+1
sty out_tmp_len
lda out_table_count
cmp #OUT_MAX_TABLES
bcs @too_many
lda out_tmp_len
cmp #OUT_SECTION_NAME_MAX + 1
bcs @bad_name
lda out_table_iface_len
cmp #OUT_SECTION_NAME_MAX + 1
bcs @bad_name
lda out_table_count
sta out_index
jsr set_table_ptr
ldy #0
lda out_tmp
sta (out_rec_ptr),y
iny
lda out_tmp+1
sta (out_rec_ptr),y
iny
lda out_tmp_len
sta (out_rec_ptr),y
iny
lda out_table_iface
sta (out_rec_ptr),y
iny
lda out_table_iface+1
sta (out_rec_ptr),y
iny
lda out_table_iface_len
sta (out_rec_ptr),y
iny
lda out_table_addr
sta (out_rec_ptr),y
iny
lda out_table_addr+1
sta (out_rec_ptr),y
iny
lda out_table_slots
sta (out_rec_ptr),y
iny
lda out_table_data
sta (out_rec_ptr),y
iny
lda out_table_data+1
sta (out_rec_ptr),y
inc out_table_count
clc
rts
@too_many:
lda #OUT_ERR_TABLES
sta out_err
sec
rts
@bad_name:
lda #OUT_ERR_NAME
sta out_err
sec
rts

out_finish:
jsr out_end_section
jsr out_close_prg
@@ -885,6 +972,8 @@ out_write_map:
bcs @out
jsr out_write_methods
bcs @out
jsr out_write_tables
bcs @out
clc
@out: rts

@@ -1072,6 +1161,109 @@ out_write_methods:
@done: clc
@out: rts

; Write TABLE records after the METHOD records, in out_table call order.
out_write_tables:
lda #$00
sta out_index
@next:
lda out_index
cmp out_table_count
bne @body
jmp @done
@body:
jsr set_table_ptr
lda #<table_prefix
ldx #>table_prefix
ldy #table_prefix_len
jsr out_text
bcc @prefix_ok
jmp @out
@prefix_ok:
ldy #0
jsr out_rec_name
bcs @out
lda #' '
jsr out_char
bcs @out
ldy #3
jsr out_rec_name
bcs @out
lda #' '
jsr out_char
bcs @out
ldy #6
lda (out_rec_ptr),y
sta out_num
iny
lda (out_rec_ptr),y
sta out_num+1
jsr out_hex4
bcs @out
lda #' '
jsr out_char
bcs @out
ldy #8
lda (out_rec_ptr),y
sta out_slot_left
jsr out_hex_byte
bcs @out
ldy #9
lda (out_rec_ptr),y
sta out_srcp
iny
lda (out_rec_ptr),y
sta out_srcp+1
ldy #0
@slot:
lda out_slot_left
beq @slots_done
lda #' '
jsr out_char
bcs @out
lda (out_srcp),y
sta out_num
iny
lda (out_srcp),y
sta out_num+1
iny
sty out_y
jsr out_hex4
bcs @out
ldy out_y
dec out_slot_left
jmp @slot
@slots_done:
jsr out_cr
bcs @out
inc out_index
jmp @next
@done:
clc
@out: rts

; Y = record offset of a name pointer then its length. Writes that name.
out_rec_name:
lda (out_rec_ptr),y
sta out_srcp
iny
lda (out_rec_ptr),y
sta out_srcp+1
iny
lda (out_rec_ptr),y
sta out_text_len
ldy #0
@loop: cpy out_text_len
beq @done
lda (out_srcp),y
sty out_y
jsr out_char
bcs @out
ldy out_y
iny
bne @loop
@done: clc
@out: rts

; A/X = text, Y = length.
out_text:
sta out_srcp
@@ -1155,6 +1347,8 @@ class_prefix: .byte "CLASS "
class_prefix_len = * - class_prefix
method_prefix: .byte "METHOD "
method_prefix_len = * - method_prefix
table_prefix: .byte "TABLE "
table_prefix_len = * - table_prefix
hex_digits: .byte "0123456789ABCDEF"

.segment "BSS"
@@ -1200,6 +1394,14 @@ out_class_size: .res 2
out_class_destroy: .res 2
out_class_ifaces: .res 1
out_class_ifdir: .res 2
out_table_count: .res 1
out_tables: .res OUT_MAX_TABLES * OUT_TABLE_RECORD_SIZE
out_table_iface: .res 2
out_table_iface_len: .res 1
out_table_addr: .res 2
out_table_slots: .res 1
out_table_data: .res 2
out_slot_left: .res 1
out_tmp: .res 2
out_tmp_len: .res 1
out_scratch_ptr: .res 2


+ 494
- 0
newLang/tests/compiler/iftable-test.s Parādīt failu

@@ -0,0 +1,494 @@
; E06-S03: interface method table fixture in x128.
;
; The fixture fills the real parser tables (tb_set) with two interfaces and two
; classes, supplies method addresses, and runs src/compiler/iftables.s:
;
; IFOO slots: 0 ALPHA, 1 BETA IBAR slots: 0 ALPHA (same signature)
; A implements IFOO, IBAR B implements IFOO
;
; It checks:
; - one table per implemented interface, in implements order, slots in
; interface order, two bytes per slot;
; - class B emits its own distinct table;
; - A's single ALPHA method fills IFOO slot 0 and IBAR slot 0;
; - a missing address is IT_ERR_UNSET and leaves no table or watermark change;
; - a table that cannot fit the buffer is IT_ERR_SPACE, also rolled back;
; - the MAP gains one TABLE record per table with its address and slots.
;
; MB_DATA flags 0..7 report the eight phases; MB_ADDR holds the last step.

.setcpu "6502"
.include "../../src/common/c128.inc"
.include "../../src/common/mailbox.inc"
.include "../../src/common/formats.inc"
.include "../../src/common/parser.inc"
.include "../../src/common/iftables.inc"

.import mmu_init, mmu_bank0, mmu_shutdown
.import out_begin, out_startup, out_finish, out_abort
.import out_load, out_entry, out_err, out_table_count
.import out_table, out_table_iface, out_table_iface_len
.import out_table_addr, out_table_slots, out_table_data
.import tb_get, tb_set
.import it_begin, it_set_addr, it_class
.import it_error, it_count, it_used, it_data
.import it_class_ids, it_iface_ids, it_table_addrs, it_slots, it_offsets

TABLE_BASE = $B000

.macro STEP n
lda #n
sta MB_ADDR
.endmacro

.macro TBSET col, row, val
lda #col
ldy #row
ldx #val
jsr tb_set
.endmacro

.macro SETADDR label, row
lda #<label
ldx #>label
ldy #row
jsr it_set_addr
.endmacro

.macro ABORT code
bcc :+
lda #code
sta MB_ADDR+1
jmp @p6_abort
:
.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"
p: .res 2
q: .res 2

.segment "STARTUP"
.export test_entry, test_end
.export m_alpha_a, m_beta_a, m_gamma_a, m_alpha_b, m_beta_b
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+1
sta fail_mask
ldx #$07
lda #$00
@flags: sta MB_DATA,x
dex
bpl @flags

jsr mmu_init
jsr mmu_bank0

; -------------------------------------------------- parser tables
STEP $01
; IFOO (row 1), IBAR (row 2), A (row 3), B (row 4)
TBSET C_TYPE_KIND, 1, TYPE_INTERFACE
TBSET C_TYPE_MFIRST, 1, 0
TBSET C_TYPE_MCOUNT, 1, 2
TBSET C_TYPE_KIND, 2, TYPE_INTERFACE
TBSET C_TYPE_MFIRST, 2, 2
TBSET C_TYPE_MCOUNT, 2, 1
TBSET C_TYPE_KIND, 3, TYPE_CLASS
TBSET C_TYPE_MFIRST, 3, 3
TBSET C_TYPE_MCOUNT, 3, 3
TBSET C_TYPE_IFIRST, 3, 0
TBSET C_TYPE_ICOUNT, 3, 2
TBSET C_TYPE_KIND, 4, TYPE_CLASS
TBSET C_TYPE_MFIRST, 4, 6
TBSET C_TYPE_MCOUNT, 4, 2
TBSET C_TYPE_IFIRST, 4, 2
TBSET C_TYPE_ICOUNT, 4, 1

; members: 0,1 IFOO ALPHA/BETA; 2 IBAR ALPHA; 3-5 A; 6,7 B
TBSET C_MEM_NAME, 0, 1
TBSET C_MEM_FLAGS, 0, MF_METHOD
TBSET C_MEM_SLOT, 0, 0
TBSET C_MEM_NAME, 1, 2
TBSET C_MEM_FLAGS, 1, MF_METHOD
TBSET C_MEM_SLOT, 1, 1
TBSET C_MEM_NAME, 2, 1
TBSET C_MEM_FLAGS, 2, MF_METHOD
TBSET C_MEM_SLOT, 2, 0
TBSET C_MEM_NAME, 3, 1
TBSET C_MEM_FLAGS, 3, MF_METHOD
TBSET C_MEM_NAME, 4, 2
TBSET C_MEM_FLAGS, 4, MF_METHOD
TBSET C_MEM_NAME, 5, 3
TBSET C_MEM_FLAGS, 5, MF_METHOD
TBSET C_MEM_NAME, 6, 1
TBSET C_MEM_FLAGS, 6, MF_METHOD
TBSET C_MEM_NAME, 7, 2
TBSET C_MEM_FLAGS, 7, MF_METHOD

; implements rows: A->IFOO, A->IBAR, B->IFOO
TBSET C_IMPL_IFACE, 0, 1
TBSET C_IMPL_IFACE, 1, 2
TBSET C_IMPL_IFACE, 2, 1

STEP $02
lda #<TABLE_BASE
ldx #>TABLE_BASE
jsr it_begin
SETADDR m_alpha_a, 3
SETADDR m_beta_a, 4
SETADDR m_gamma_a, 5
SETADDR m_alpha_b, 6
SETADDR m_beta_b, 7

lda #3
jsr it_class
bcc :+
jmp @fail
: lda #4
jsr it_class
bcc :+
jmp @fail
:

; 0: class A's two tables are ALPHA/BETA then ALPHA.
STEP $10
CHK it_data+0, <m_alpha_a
CHK it_data+1, >m_alpha_a
CHK it_data+2, <m_beta_a
CHK it_data+3, >m_beta_a
CHK it_data+4, <m_alpha_a
CHK it_data+5, >m_alpha_a
lda #$01
sta MB_DATA+0

; 1: three records with the expected classes, interfaces, addresses.
STEP $11
CHK it_count, 3
CHK it_class_ids+0, 3
CHK it_class_ids+1, 3
CHK it_class_ids+2, 4
CHK it_iface_ids+0, 1
CHK it_iface_ids+1, 2
CHK it_iface_ids+2, 1
CHK it_slots+0, 2
CHK it_slots+1, 1
CHK it_slots+2, 2
CHK it_table_addrs+0, <TABLE_BASE
CHK it_table_addrs+1, >TABLE_BASE
CHK it_table_addrs+2, <(TABLE_BASE + 4)
CHK it_table_addrs+3, >(TABLE_BASE + 4)
CHK it_table_addrs+4, <(TABLE_BASE + 6)
CHK it_table_addrs+5, >(TABLE_BASE + 6)
CHK it_offsets+0, 0
CHK it_offsets+1, 0
CHK it_offsets+2, 4
CHK it_offsets+3, 0
CHK it_offsets+4, 6
CHK it_offsets+5, 0
lda #$01
sta MB_DATA+1

; 2: class B's table is distinct and uses its own methods.
STEP $12
CHK it_data+6, <m_alpha_b
CHK it_data+7, >m_alpha_b
CHK it_data+8, <m_beta_b
CHK it_data+9, >m_beta_b
lda #$01
sta MB_DATA+2

; 3: one method populated IFOO slot 0 and IBAR slot 0.
STEP $13
CHK it_data+4, <m_alpha_a
CHK it_data+5, >m_alpha_a
lda #$01
sta MB_DATA+3

; 4: a missing address refuses the class and rolls back.
STEP $20
lda #$00
ldx #$00
ldy #4
jsr it_set_addr
lda #3
jsr it_class
bcs :+
jmp @fail
:
CHK it_error, IT_ERR_UNSET
CHK it_count, 3
CHK it_used, 10
CHK it_used+1, 0
SETADDR m_beta_a, 4
lda #$01
sta MB_DATA+4

; 5: a table larger than the buffer refuses the class.
STEP $21
TBSET C_TYPE_MCOUNT, 1, 255
lda #3
jsr it_class
bcs :+
jmp @fail
:
CHK it_error, IT_ERR_SPACE
CHK it_count, 3
CHK it_used, 10
TBSET C_TYPE_MCOUNT, 1, 2
lda #$01
sta MB_DATA+5

; 6: the MAP gains one TABLE record per emitted table.
STEP $22
lda #<PRG_LOAD_ADDR
sta out_load
lda #>PRG_LOAD_ADDR
sta out_load+1
lda #<PRG_ENTRY_ADDR
sta out_entry
lda #>PRG_ENTRY_ADDR
sta out_entry+1
lda #<name_source
ldx #>name_source
ldy #name_source_len
jsr out_begin
ABORT $C1
jsr out_startup
ABORT $C2
ldx #0
jsr set_out_table
lda #<name_a
ldx #>name_a
ldy #name_a_len
jsr out_table
ABORT $C3
ldx #1
jsr set_out_table
lda #<name_a
ldx #>name_a
ldy #name_a_len
jsr out_table
ABORT $C4
ldx #2
jsr set_out_table
lda #<name_b
ldx #>name_b
ldy #name_b_len
jsr out_table
ABORT $C5
jsr out_finish
ABORT $C6
CHK out_table_count, 3
lda #$01
sta MB_DATA+6
jmp @p7
@p6_abort:
lda out_err
sta MB_ADDR
jsr out_abort
jmp @fail

; 7: the watermark and record count match the three tables.
@p7:
STEP $23
CHK it_used, 10
CHK it_used+1, 0
CHK it_count, 3
lda #$01
sta MB_DATA+7

@report:
; fail_mask and the messages live above $4000 (MAIN), so decide the
; status and copy the text while MAIN is still mapped: mmu_shutdown
; restores the system mapping, and only SCRATCH ($1B00) stays put.
lda fail_mask
sta msg_fail
lda #MB_ST_FAIL
ldx fail_mask
bne @status
lda #MB_ST_PASS
@status:
sta MB_STATUS
lda #<ok_message
sta p
lda #>ok_message
sta p+1
lda msg_fail
beq @copy
lda #<fail_message
sta p
lda #>fail_message
sta p+1
@copy: ldy #$00
@cp: lda (p),y
sta msg_buf,y
beq @copied
iny
bne @cp
@copied:
jsr mmu_shutdown
ldy #$00
@print: lda msg_buf,y
beq @end
sty msg_idx
jsr CHROUT
ldy msg_idx
iny
bne @print
@end: rts

@fail:
lda #$01
sta fail_mask
jmp @report

.segment "CODE"
; Method stubs the tables point at.
m_alpha_a:
rts
m_beta_a:
rts
m_gamma_a:
rts
m_alpha_b:
rts
m_beta_b:
rts

; X = table index -> out_table_addr/slots/data/iface.
set_out_table:
stx rec_i
lda #<it_table_addrs
sta p
lda #>it_table_addrs
sta p+1
jsr add_2x
ldy #0
lda (p),y
sta out_table_addr
iny
lda (p),y
sta out_table_addr+1
ldx rec_i
lda it_slots,x
sta out_table_slots
lda #<it_offsets
sta p
lda #>it_offsets
sta p+1
jsr add_2x
ldy #0
lda (p),y
sta q
iny
lda (p),y
sta q+1
clc
lda #<it_data
adc q
sta out_table_data
lda #>it_data
adc q+1
sta out_table_data+1
ldx rec_i
cpx #1
beq @ibar
lda #<name_ifoo
sta out_table_iface
lda #>name_ifoo
sta out_table_iface+1
lda #name_ifoo_len
sta out_table_iface_len
rts
@ibar:
lda #<name_ibar
sta out_table_iface
lda #>name_ibar
sta out_table_iface+1
lda #name_ibar_len
sta out_table_iface_len
rts

; p = p + 2 * rec_i.
add_2x:
lda rec_i
asl a
clc
adc p
sta p
bcc :+
inc p+1
: rts

.segment "RODATA"
name_source: .byte "IFTTEST.N8"
name_source_len = * - name_source
name_a: .byte "A"
name_a_len = * - name_a
name_b: .byte "B"
name_b_len = * - name_b
name_ifoo: .byte "IFOO"
name_ifoo_len = * - name_ifoo
name_ibar: .byte "IBAR"
name_ibar_len = * - name_ibar
messages:
ok_message: .byte "NOVA128 IFTABLE TEST OK", $0D, $00
fail_message: .byte "NOVA128 IFTABLE TEST FAIL", $0D, $00

.segment "SCRATCH"
msg_buf: .res 32
msg_fail: .res 1
msg_idx: .res 1

.segment "BSS"
fail_mask: .res 1
rec_i: .res 1
test_end:

Rakstīt Priekšskatītījums
Notiek ielāde…
Atcelt
Saglabāt

Powered by TurnKey Linux.