dcovington
/
C64-dev
1
0
Форкнуть 0
Код Задачи 0 Pull Request'ы 0 Релизы 0 Вики Активность
Просмотр исходного кода

newLang: add identifier interning (E02-S03) 

names.s gives each distinct identifier a 1-byte ID (1-255), comparing
case-insensitively across both PETSCII letter ranges. The table lives in
bank 1: 64 hash-chain heads plus 20-byte records holding the original
spelling. name_declare replaces the first-use spelling with the first
declaration's spelling, so forward references keep the declared form.
A full table returns NAMES_ERR_FULL and writes nothing.

Verified in x128: the C128 dump equals a host model byte for byte across
case variants, an 8-name collision chain with an identical-hash pair, and
a 260-name overflow, with a guard after the table intact. A mutation that
skips the text compare is caught. D120 (proposed): 255-name limit.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
main
Daniel Covington 6 дней назад
Родитель
37bf335da9
Сommit
46e57a5667
9 измененных файлов: 943 добавлений и 0 удалений
Единый вид
Опции Diff
Показать статистику Скачать Patch файл Скачать Diff файл
  1. +1
    -0
      newLang/docs/decisions.md
  2. +6
    -0
      newLang/docs/memory-map.md
  3. +70
    -0
      newLang/planning/claims/E02-S03.md
  4. +150
    -0
      newLang/scripts/build-names-test.ps1
  5. +40
    -0
      newLang/scripts/verify-names-test.ps1
  6. +24
    -0
      newLang/src/common/names.inc
  7. +301
    -0
      newLang/src/compiler/names.s
  8. +321
    -0
      newLang/tests/names/names-test.s
  9. +30
    -0
      newLang/tests/names/names.n8

+ 1
- 0
newLang/docs/decisions.md Просмотреть файл

@@ -46,6 +46,7 @@ documented default. `Proposed` means a later change still needs approval.
| ID | Proposal | Consequence | | ID | Proposal | Consequence |
|---|---|---| |---|---|---|
| D119 | The string and character escapes `\n` and `\r` both produce PETSCII `$0D`. | Commodore output has one line-end character, so both escapes start a new line. Implemented as `ESC_N_VALUE`/`ESC_R_VALUE` in `src/common/tokens.inc`; changing them later affects only those constants and the lexer golden files. | | D119 | The string and character escapes `\n` and `\r` both produce PETSCII `$0D`. | Commodore output has one line-end character, so both escapes start a new line. Implemented as `ESC_N_VALUE`/`ESC_R_VALUE` in `src/common/tokens.inc`; changing them later affects only those constants and the lexer golden files. |
| D120 | A program may use at most 255 distinct identifiers (names are 1-byte IDs). | Covers well beyond a 599-line program's typical vocabulary at 5,164 bytes of bank 1. Exceeding it is a resource diagnostic; raising it means 2-byte name IDs in every later record. |


## Deferred ## Deferred




+ 6
- 0
newLang/docs/memory-map.md Просмотреть файл

@@ -45,6 +45,12 @@ COMMON, DISKBUF, private ZP, SCRATCH, and MAILBOX are visible from bank 1.
| `$0000-$1FFF` | | hidden | Covered by bottom common RAM in compiler states | | `$0000-$1FFF` | | hidden | Covered by bottom common RAM in compiler states |
| `$2000-$6AFF` | 19200 | SRCCACHE / `SOURCE` | Whole source file, loaded once by `src_load` (18,999-byte limit) | | `$2000-$6AFF` | 19200 | SRCCACHE / `SOURCE` | Whole source file, loaded once by `src_load` (18,999-byte limit) |
| `$6B00-$BFFF` | 21760 | BANK1 / `TABLES` | Names, symbols, class/interface/type records, pass workspaces | | `$6B00-$BFFF` | 21760 | BANK1 / `TABLES` | Names, symbols, class/interface/type records, pass workspaces |

`TABLES` allocations so far (in link order; ld65 rejects overflow):

| Owner | Bytes | Contents |
|---|---|---|
| `names.s` | 5,164 | 64 hash-chain heads + 255 name records of 20 bytes (D120) |
| `$C000-$FFFF` | | unmapped | System ROM is visible here instead; BASIC string space at the top of bank 1 is untouched | | `$C000-$FFFF` | | unmapped | System ROM is visible here instead; BASIC string space at the top of bank 1 is untouched |


Bank-1 data is reached only through `mmu.s` helpers (`mmu_peek1`/`mmu_poke1` Bank-1 data is reached only through `mmu.s` helpers (`mmu_peek1`/`mmu_poke1`


+ 70
- 0
newLang/planning/claims/E02-S03.md Просмотреть файл

@@ -0,0 +1,70 @@
---
story: E02-S03
owner: e02_names
status: done
started: 2026-11-07
depends-on: [E01-S05, E02-S02]
---

# E02-S03 Claim

## Intended change

Add the compiler's name table (`src/compiler/names.s`): case-insensitive
interning of identifiers into 1-byte IDs held in bank 1, a 64-bucket chained
hash, preservation of the first declaration's spelling, and a deterministic
resource error when the table is full.

## File area

- `src/compiler/names.s`, `src/common/names.inc`
- `tests/names/`
- `scripts/build-names-test.ps1`, `scripts/verify-names-test.ps1`
- `docs/memory-map.md` (bank-1 usage), `docs/decisions.md` (capacity)
- `planning/claims/E02-S03.md`
- generated files under `build/`

## Acceptance evidence

- [x] Equal normalized identifiers share an ID: the C128 dump equals the host
model byte for byte; `TICKER`/`Ticker`, `count`/`Count`/`COUNT`, and the
`$C1-$DA` respellings in `collide.n8` all reuse their IDs.
- [x] First-declaration spelling is preserved for diagnostics/MAP output:
`runner` (used first) is stored as `Runner` after `class Runner`; `tick`
keeps its first declaration over a later `method Tick()`; `Main` survives
later `main`/`MAIN`. `name_get` returns spelling and a declared flag.
- [x] Hash collisions are tested: `collide.n8` puts 8 names in one bucket,
including `x0`/`y2` with an identical 8-bit hash, plus near-miss names.
A mutation that skips the text compare merges `y2` into `x0` and fails.
- [x] Full tables report a resource error without memory corruption:
`full.n8` interns 255 names, then 5 new names (and 2 repeats of them)
get `NAMES_ERR_FULL` while existing names still resolve; an 8-byte guard
directly after the table in bank 1 stays intact.

## Coordination notes

The capacity (255 distinct names) is a user-visible limit, so it is recorded
as a proposed decision. The resource error is a names return code; E02-S04
maps it to an `Exxx` diagnostic.

## Work log

- Records keep the original spelling and fold case during comparison, so
no separate normalized copy is stored (20-byte records).
- Collision names are found by searching the hash function on the host;
the build fails if the chain is shorter than 5 or spans buckets.
- The test declares a name when the previous token is class, interface,
program, method, or var. The real declaration rules belong to the parser.

## Completion

- Tests run: `scripts/verify-names-test.ps1` (pass plus collision
mutation).
- Results: 2,217-byte dump identical to the host model; mutation detected.
- Files changed: `src/compiler/names.s`, `src/common/names.inc`,
`tests/names/`, `scripts/build-names-test.ps1`,
`scripts/verify-names-test.ps1`, `docs/memory-map.md`,
`docs/decisions.md` (D120, proposed), this claim.
- Remaining risks: D120 (255 names) awaits approval; lookups compare at most
a short chain but are not timed; NAMES_ERR_FULL still needs an `Exxx`
diagnostic (E02-S04).

+ 150
- 0
newLang/scripts/build-names-test.ps1 Просмотреть файл

@@ -0,0 +1,150 @@
# E02-S03: build the name-table test PRG, its fixtures, and a fresh D81, and
# compute the exact dump the C128 must produce (build/names-test/expected.bin).
[CmdletBinding()]
param()

$ErrorActionPreference = "Stop"
$project = Split-Path $PSScriptRoot -Parent
Import-Module (Join-Path $PSScriptRoot "lib\Nova128Test.psm1") -Force
. (Join-Path $project "tests\lexer\reference-lexer.ps1")
$out = Join-Path $project "build\names-test"
New-Item -ItemType Directory -Force -Path $out | Out-Null

$link = Invoke-Nova128Link -Name "names-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 "tests\names\names-test.s")) # last: guard follows the table
if ((Get-Nova128Label $link.Labels "test_entry") -ne 0x1C0D) { throw "test_entry is not at `$1C0D" }
$recs = Get-Nova128Label $link.Labels "name_recs"
$guard = Get-Nova128Label $link.Labels "guard"
if ($guard -ne $recs + 255 * 20) { throw ("guard `${0:X4} does not directly follow the name table" -f $guard) }

function Get-Lines([byte[]]$bytes) {
# Same line split as src_next_line: $0D ends a line; a tail without $0D
# is the last line.
$lines = New-Object System.Collections.Generic.List[byte[]]
$start = 0
for ($i = 0; $i -lt $bytes.Length; $i++) {
if ($bytes[$i] -eq 13) {
if ($i -gt $start) { $lines.Add([byte[]]$bytes[$start..($i - 1)]) } else { $lines.Add([byte[]]@()) }
$start = $i + 1
}
}
if ($start -lt $bytes.Length) { $lines.Add([byte[]]$bytes[$start..($bytes.Length - 1)]) }
return ,$lines
}

# ------------------------------------------------------------ name hashing
function Get-NameKey([byte[]]$spelling) {
return [byte[]]($spelling | ForEach-Object { if ($_ -ge 0xC1 -and $_ -le 0xDA) { $_ -band 0x7F } else { $_ } })
}
function Get-NameHash([byte[]]$key) {
$h = 0
foreach ($b in $key) { $h = ((($h -shl 1) -band 0xFF) -bor ($h -shr 7)) -bxor $b }
return $h
}
function Get-AsciiHash([string]$name) { return Get-NameHash (Get-NameKey (ConvertTo-Nova128Petscii $name)) }

# ------------------------------------------------------------ collide.n8
# Pick names that share a bucket, including two with the same full hash.
$byHash = @{}
foreach ($a in [char[]]"abcdefghijklmnopqrstuvwxyz") {
foreach ($b in [char[]]"abcdefghijklmnopqrstuvwxyz0123456789") {
$n = "$a$b"; $h = Get-AsciiHash $n
if (-not $byHash.ContainsKey($h)) { $byHash[$h] = New-Object System.Collections.Generic.List[string] }
$byHash[$h].Add($n)
}
}
$sameHash = $byHash[($byHash.Keys | Where-Object { $byHash[$_].Count -ge 2 } | Sort-Object | Select-Object -First 1)]
$h0 = Get-AsciiHash $sameHash[0]
$bucket = $h0 -band 63
$sameBucket = @($byHash.Keys | Where-Object { ($_ -band 63) -eq $bucket -and $_ -ne $h0 } | Sort-Object |
ForEach-Object { $byHash[$_] } | Select-Object -First 6)
$group = @($sameHash[0], $sameHash[1]) + $sameBucket # up to 8 names, one bucket
if ($group.Count -lt 5) { throw "collision chain too short: $($group -join ', ')" }
$collide = New-Object System.Text.StringBuilder
[void]$collide.AppendLine("// generated by build-names-test.ps1: one hash bucket ($bucket)")
foreach ($n in $group) { [void]$collide.AppendLine("var $n as word") }
[void]$collide.AppendLine(($group[($group.Count - 1)..0] | ForEach-Object { $_.ToUpper() }) -join " ")
[void]$collide.AppendLine(($group | ForEach-Object { $_ + "x" }) -join " ") # near misses
if ((Get-AsciiHash $group[0]) -ne (Get-AsciiHash $group[1])) { throw "no identical-hash pair" }
if (@($group | ForEach-Object { (Get-AsciiHash $_) -band 63 } | Select-Object -Unique).Count -ne 1) {
throw "collision group spans buckets"
}

# --------------------------------------------------------------- full.n8
$full = New-Object System.Text.StringBuilder
[void]$full.AppendLine("program Full") # ID 1
$names = 1..259 | ForEach-Object { "n$_" } # IDs 2..255, then 4 over
for ($i = 0; $i -lt $names.Count; $i += 8) {
[void]$full.AppendLine(($names[$i..([Math]::Min($i + 7, $names.Count - 1))]) -join " ")
}
[void]$full.AppendLine("N1 full n254 N259 n258") # lookups still work when full

$fixtures = [ordered]@{
"names.n8" = ConvertTo-Nova128Petscii (Get-Content -Raw (Join-Path $project "tests\names\names.n8"))
"collide.n8" = ConvertTo-Nova128Petscii $collide.ToString()
"full.n8" = ConvertTo-Nova128Petscii $full.ToString()
}

# ----------------------------------------------------- expected dump bytes
$declKinds = @("KW_CLASS", "KW_INTERFACE", "KW_PROGRAM", "KW_METHOD", "KW_VAR")
$expected = New-Object System.Collections.Generic.List[byte]
$index = 0
$summary = @()
foreach ($name in $fixtures.Keys) {
$src = $fixtures[$name]
$expected.AddRange([byte[]](0xFF, $index, 0))
$lines = (Get-Lines $src)
$table = New-Object System.Collections.Generic.List[object] # ID-1 -> record
$ids = @{}
$prev = "EOL"; $errors = 0
foreach ($t in (Get-ReferenceTokens $src)) {
$m = [regex]::Match($t, '^(\d+):(\d+) (\S+)(?: (\d+))?')
$kind = $m.Groups[3].Value
if ($kind -eq "EOF") { break }
if ($kind -eq "IDENT") {
$line = $lines[[int]$m.Groups[1].Value - 1]
$col = [int]$m.Groups[2].Value; $len = [int]$m.Groups[4].Value
$spelling = [byte[]]$line[($col - 1)..($col + $len - 2)]
$key = [Convert]::ToBase64String((Get-NameKey $spelling))
$decl = $declKinds -contains $prev
if ($ids.ContainsKey($key)) { $id = $ids[$key] }
elseif ($table.Count -lt 255) {
$table.Add([pscustomobject]@{ Flags = 0; Spelling = $spelling })
$id = $table.Count; $ids[$key] = $id
} else { $id = 0 }
if ($id -eq 0) { $expected.AddRange([byte[]](3, 1)); $errors++ }
elseif ($decl) {
$rec = $table[$id - 1]
if ($rec.Flags -eq 0) { $rec.Flags = 1; $rec.Spelling = $spelling }
$expected.AddRange([byte[]](2, $id))
} else { $expected.AddRange([byte[]](1, $id)) }
}
$prev = $kind
}
$expected.AddRange([byte[]](0xFD, $table.Count, 1))
foreach ($rec in $table) {
$expected.AddRange([byte[]]($rec.Flags, $rec.Spelling.Length))
$expected.AddRange($rec.Spelling)
}
$summary += [pscustomobject]@{ Fixture = $name; Names = $table.Count; FullErrors = $errors }
$index++
}
$expected.Add(0xFE)
[IO.File]::WriteAllBytes((Join-Path $out "expected.bin"), $expected.ToArray())
$summary | ConvertTo-Json | Set-Content (Join-Path $out "expected-summary.json")

$files = @(@{ Name = "names-test"; Path = $link.Program; Type = "prg" })
foreach ($name in $fixtures.Keys) {
$pet = Join-Path $out ($name -replace '\.n8$', '.pet')
[IO.File]::WriteAllBytes($pet, $fixtures[$name])
$files += @{ Name = $name; Path = $pet; Type = "seq" }
}
New-Nova128Disk -Path (Join-Path $out "names-test.d81") -Files $files
Write-Host ("built {0}; collision bucket {1}: {2}" -f $link.Program, $bucket, ($group -join ", "))
$summary | Format-Table -AutoSize | Out-String | Write-Host

+ 40
- 0
newLang/scripts/verify-names-test.ps1 Просмотреть файл

@@ -0,0 +1,40 @@
# E02-S03: run the name-table test in x128 and require its dump to equal the
# host-computed build/names-test/expected.bin byte for byte.
[CmdletBinding()]
param([int]$Port = 6533, [int]$TimeoutSeconds = 180)

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

$out = Join-Path $project "build\names-test"
$disk = Join-Path $out "names-test.d81"
$screenshot = Join-Path $out "names-test-vicii.png"
$expected = [IO.File]::ReadAllBytes((Join-Path $out "expected.bin"))

$session = Start-Nova128X128 -Autostart $disk -Drive8Image $disk -Port $Port -Screenshot $screenshot
try {
$mb = Wait-Nova128Mailbox $session -TimeoutSeconds $TimeoutSeconds
$dump = Read-Nova128Memory $session ($mb[8] + 256 * $mb[9]) ($mb[10] + 256 * $mb[11])
} finally {
Stop-Nova128X128 $session
}
[IO.File]::WriteAllBytes((Join-Path $out "names-dump.bin"), $dump)

if ($mb[3] -ne 0xA5) { throw ("C128 reported FAIL (code `${0:X2})" -f $mb[4]) }
$limit = [Math]::Min($dump.Length, $expected.Length)
$first = 0
while ($first -lt $limit -and $dump[$first] -eq $expected[$first]) { $first++ }
if ($first -lt $limit -or $dump.Length -ne $expected.Length) {
$from = [Math]::Max(0, $first - 8)
$show = { param($b) ($b[$from..([Math]::Min($b.Length - 1, $first + 8))] | ForEach-Object { $_.ToString("X2") }) -join ' ' }
throw ("dump differs at byte {0} (C128 {1} bytes, expected {2}):`n expected {3}`n C128 {4}" -f
$first, $dump.Length, $expected.Length, (& $show $expected), (& $show $dump))
}
$summary = Get-Content -Raw (Join-Path $out "expected-summary.json") | ConvertFrom-Json
foreach ($s in $summary) {
Write-Host (" {0,-11} {1,3} names, {2} table-full errors" -f $s.Fixture, $s.Names, $s.FullErrors)
}
Write-Host ("verified name table: {0}-byte dump matches the host model exactly, guards intact" -f $dump.Length)
Write-Host "screenshot: $screenshot"

+ 24
- 0
newLang/src/common/names.inc Просмотреть файл

@@ -0,0 +1,24 @@
; names.inc - name-table limits and result codes (E02-S03).

.ifndef NAMES_INC
NAMES_INC = 1

NAMES_MAX = 255 ; IDs 1..255; 0 means "no name"
NAMES_BUCKETS = 64 ; hash & (NAMES_BUCKETS - 1)
NAME_LEN_MAX = 16 ; = LEX_IDENT_MAX

; Record layout in bank 1 (NAME_REC_SIZE bytes per ID, ID 1 first)
NAME_NEXT = 0 ; next ID in the bucket chain (0 = end)
NAME_HASH = 1 ; 8-bit hash of the normalized name
NAME_LEN = 2
NAME_FLAGS = 3
NAME_SPELLING = 4 ; original bytes, NAME_LEN_MAX reserved
NAME_REC_SIZE = NAME_SPELLING + NAME_LEN_MAX

NAME_F_DECLARED = $01 ; spelling came from a declaration

NAMES_OK = 0
NAMES_ERR_FULL = 1 ; resource error: NAMES_MAX distinct names
NAMES_ERR_LONG = 2 ; caller bug: longer than NAME_LEN_MAX

.endif

+ 301
- 0
newLang/src/compiler/names.s Просмотреть файл

@@ -0,0 +1,301 @@
; names.s - identifier interning (E02-S03).
;
; Each distinct identifier (compared case-insensitively, PETSCII $C1-$DA ==
; $41-$5A) gets a 1-byte ID, 1..NAMES_MAX. The table lives in bank 1:
; name_heads NAMES_BUCKETS chain heads (ID or 0)
; name_recs NAMES_MAX records of NAME_REC_SIZE bytes (src/common/names.inc)
; Records keep the ORIGINAL spelling; comparisons fold case on the fly.
;
; hash = for each normalized byte b: h = rotate_left_8(h) XOR b, from h = 0.
; bucket = hash AND (NAMES_BUCKETS - 1).
;
; Callers run in the bank-0 state. Spellings are read from src_line (common
; RAM), so name_intern/name_declare take a column and length in the current
; source line, exactly as the lexer reports an identifier.

.setcpu "6502"
.include "../common/names.inc"

.import mmu_bank0, mmu_bank1
.importzp mmu_ptr, mmu_src
.import src_line

.export names_init, name_intern, name_declare, name_get, names_count
.export name_out, name_out_len, name_out_flags
.export name_heads, name_recs

; ------------------------------------------------------------------ CODE
.segment "CODE"

names_init:
lda #$00
sta names_count
jmp nt_clear_heads

; Intern the identifier at src_line[A-1], length X.
; out: C=0, A = ID (existing or new)
; C=1, A = NAMES_ERR_FULL (table unchanged) or NAMES_ERR_LONG
name_intern:
jsr set_key
bcs @out
lda #$01 ; adding allowed
sta nk_add
jsr nt_find
lda nk_result
bne @found
lda #NAMES_ERR_FULL
sec
rts
@found: clc
@out: rts

; Record the declaration spelling at src_line[Y-1], length X, for ID A,
; unless an earlier declaration already did. The spelling must normalize to
; the same name (the caller interned it from the same token).
name_declare:
sta nk_id
tya
jsr set_spell_ptr
stx nk_len
jmp nt_declare

; Copy the spelling of ID A to name_out / name_out_len / name_out_flags.
name_get:
sta nk_id
jmp nt_get

; Prepare nk_text/nk_len/nk_hash/nk_bucket and mmu_src from column A,
; length X. C=1 with A = NAMES_ERR_LONG if the name is too long.
set_key:
cpx #NAME_LEN_MAX + 1
bcc @ok
lda #NAMES_ERR_LONG
rts
@ok: stx nk_len
jsr set_spell_ptr
lda #$00
sta nk_hash
tay
@byte: cpy nk_len
beq @done
lda (mmu_src),y
jsr fold
sta nk_text,y
lda nk_hash ; h = rol8(h) xor b
asl a
adc #$00
eor nk_text,y
sta nk_hash
iny
bne @byte
@done: lda nk_hash
and #NAMES_BUCKETS - 1
sta nk_bucket
clc
rts

; mmu_src = src_line + A - 1
set_spell_ptr:
clc
adc #<(src_line - 1)
sta mmu_src
lda #>(src_line - 1)
adc #$00
sta mmu_src+1
rts

; ---------------------------------------------------------------- COMMON
; Everything below runs with bank 1 mapped and must live in common RAM.
.segment "COMMON"

; Fold $C1-$DA to $41-$5A; other bytes unchanged.
fold: cmp #$C1
bcc @done
cmp #$DB
bcs @done
and #$7F
@done: rts

; mmu_ptr = name_recs + (A - 1) * NAME_REC_SIZE (NAME_REC_SIZE = 20)
rec_addr:
.assert NAME_REC_SIZE = 20, error, "rec_addr multiplies by 20"
sec
sbc #$01
sta nt_t
lda #$00
sta nt_t+1
asl nt_t ; *4
rol nt_t+1
asl nt_t
rol nt_t+1
lda nt_t
sta nt_u
lda nt_t+1
sta nt_u+1
asl nt_t ; *16
rol nt_t+1
asl nt_t
rol nt_t+1
clc ; *16 + *4
lda nt_t
adc nt_u
sta nt_t
lda nt_t+1
adc nt_u+1
sta nt_t+1
clc
lda nt_t
adc #<name_recs
sta mmu_ptr
lda nt_t+1
adc #>name_recs
sta mmu_ptr+1
rts

nt_clear_heads:
jsr mmu_bank1
lda #$00
ldx #NAMES_BUCKETS - 1
@clr: sta name_heads,x
dex
bpl @clr
jmp mmu_bank0

; Find the key; if absent and nk_add is set and there is room, add it.
; nk_result = ID, or 0 when the table is full.
nt_find:
jsr mmu_bank1
ldx nk_bucket
lda name_heads,x
@walk: beq @absent
sta nk_id
jsr rec_addr
ldy #NAME_HASH
lda (mmu_ptr),y
cmp nk_hash
bne @next
ldy #NAME_LEN
lda (mmu_ptr),y
cmp nk_len
bne @next
ldx #$00
ldy #NAME_SPELLING
@cmp: lda (mmu_ptr),y
jsr fold
cmp nk_text,x
bne @next
iny
inx
cpx nk_len
bne @cmp
lda nk_id ; found
sta nk_result
jmp mmu_bank0
@next: ldy #NAME_NEXT
lda (mmu_ptr),y
jmp @walk

@absent:
lda #$00
sta nk_result
lda nk_add
beq @done
lda names_count
cmp #NAMES_MAX
bcs @done ; full: nothing is written
inc names_count
lda names_count
sta nk_id
sta nk_result
jsr rec_addr
ldx nk_bucket
ldy #NAME_NEXT
lda name_heads,x
sta (mmu_ptr),y
lda nk_id ; new record heads its bucket
sta name_heads,x
ldy #NAME_HASH
lda nk_hash
sta (mmu_ptr),y
iny ; NAME_LEN
lda nk_len
sta (mmu_ptr),y
iny ; NAME_FLAGS
lda #$00
sta (mmu_ptr),y
jsr copy_spelling
@done: jmp mmu_bank0

; Copy nk_len bytes from (mmu_src) to the record's spelling. Bank 1 mapped.
copy_spelling:
ldx #$00
@copy: cpx nk_len
beq @done
txa
tay
lda (mmu_src),y
pha
txa
clc
adc #NAME_SPELLING
tay
pla
sta (mmu_ptr),y
inx
bne @copy
@done: rts

nt_declare:
jsr mmu_bank1
lda nk_id
jsr rec_addr
ldy #NAME_FLAGS
lda (mmu_ptr),y
and #NAME_F_DECLARED
bne @done ; first declaration wins
lda (mmu_ptr),y
ora #NAME_F_DECLARED
sta (mmu_ptr),y
jsr copy_spelling
@done: jmp mmu_bank0

nt_get:
jsr mmu_bank1
lda nk_id
jsr rec_addr
ldy #NAME_LEN
lda (mmu_ptr),y
sta name_out_len
iny
lda (mmu_ptr),y
sta name_out_flags
ldx #$00
ldy #NAME_SPELLING
@copy: cpx name_out_len
beq @done
lda (mmu_ptr),y
sta name_out,x
iny
inx
bne @copy
@done: jmp mmu_bank0

; Shared state: visible from both banks.
names_count: .byte $00
nk_add: .byte $00
nk_len: .byte $00
nk_hash: .byte $00
nk_bucket: .byte $00
nk_id: .byte $00
nk_result: .byte $00
nk_text: .res NAME_LEN_MAX
nt_t: .word $0000
nt_u: .word $0000
name_out_len: .byte $00
name_out_flags: .byte $00
name_out: .res NAME_LEN_MAX

; ---------------------------------------------------------------- TABLES
.segment "TABLES"
name_heads: .res NAMES_BUCKETS
name_recs: .res NAMES_MAX * NAME_REC_SIZE

+ 321
- 0
newLang/tests/names/names-test.s Просмотреть файл

@@ -0,0 +1,321 @@
; E02-S03: name-table test in x128.
;
; For each fixture: src_load, names_init, then lex to EOF. Every identifier is
; interned; when the previous token is class/interface/program/method/var it
; is also declared. The dump records, per identifier:
; $01 id use $02 id declaration $03 code error
; then at EOF: $FD, names_count, guard flag (1 = guard bytes intact), and
; for each ID 1..count: flags, length, spelling bytes.
; Fixture header: $FF, index, src_load result. End of dump: $FE.
; The guard is 8 bytes of bank-1 TABLES placed directly after the name table
; (this module links after names.s), filled with $A5 before every fixture.
; Mailbox: MB_DATA+0/1 dump address, +2/3 length; PASS = loads ok, no overflow.

.setcpu "6502"
.include "../../src/common/c128.inc"
.include "../../src/common/mailbox.inc"
.include "../../src/common/tokens.inc"
.include "../../src/common/names.inc"

.import mmu_init, mmu_bank0, mmu_shutdown, mmu_peek1, mmu_poke1
.importzp mmu_ptr
.import src_load
.import lex_reset, lex_next, tok_kind, tok_col, tok_len
.import names_init, name_intern, name_declare, name_get, names_count
.import name_out, name_out_len, name_out_flags

DUMP_SIZE = $3000
GUARD_SIZE = 8

.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"
dump_ptr: .res 2
fx_ptr: .res 2

.segment "TABLES"
guard: .res GUARD_SIZE

.segment "STARTUP"
.export test_entry, dump, guard
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_PLATFORM
sta MB_PRODUCER
lda #MB_ST_RUNNING
sta MB_STATUS

jsr mmu_init
jsr mmu_bank0
lda #<dump
sta dump_ptr
lda #>dump
sta dump_ptr+1
lda #<fixtures
sta fx_ptr
lda #>fixtures
sta fx_ptr+1
lda #$00
sta failures
sta overflow
sta fx_index

@fixture:
lda #$FF
jsr emit
lda fx_index
jsr emit
ldy #0
lda (fx_ptr),y
sta name_lo
iny
lda (fx_ptr),y
tax
iny
lda (fx_ptr),y
tay
lda name_lo
jsr src_load
pha
jsr emit
pla
beq @run
inc failures
jmp @advance
@run: jsr run_fixture
@advance:
clc
lda fx_ptr
adc #3
sta fx_ptr
bcc :+
inc fx_ptr+1
: inc fx_index
lda fx_index
cmp #FIXTURE_COUNT
bne @fixture

lda #$FE
jsr emit
lda #<dump ; report while the private ZP is mapped
sta MB_DATA+0
lda #>dump
sta MB_DATA+1
sec
lda dump_ptr
sbc #<dump
sta MB_DATA+2
lda dump_ptr+1
sbc #>dump
sta MB_DATA+3
jsr mmu_shutdown
lda failures
ora overflow
sta MB_CODE
ldy #ok_msg - messages
lda MB_CODE
bne @fail
lda #MB_ST_PASS
bne @report
@fail: ldy #fail_msg - messages
lda #MB_ST_FAIL
@report:
sta MB_STATUS
plp
@print: lda messages,y
beq @end
sty print_y
jsr CHROUT
ldy print_y
iny
bne @print
@end: rts

.segment "CODE"

run_fixture:
jsr names_init
jsr set_guard_ptr
ldy #GUARD_SIZE - 1
@fill: lda #$A5
jsr mmu_poke1
dey
bpl @fill
jsr lex_reset
lda #TOK_EOL
sta prev_kind
@token: jsr lex_next
lda tok_kind
cmp #TOK_EOF
beq @eof
cmp #TOK_IDENT
bne @remember
lda tok_col
ldx tok_len
jsr name_intern
bcc @interned
pha
lda #$03
jsr emit
pla
jsr emit
jmp @remember
@interned:
sta last_id
jsr is_declaration
bcs @declare
lda #$01
jsr emit
lda last_id
jsr emit
jmp @remember
@declare:
lda last_id
ldx tok_len
ldy tok_col
jsr name_declare
lda #$02
jsr emit
lda last_id
jsr emit
@remember:
lda tok_kind
sta prev_kind
jmp @token

@eof: lda #$FD
jsr emit
lda names_count
jsr emit
jsr set_guard_ptr ; guard intact?
ldy #GUARD_SIZE - 1
lda #$01
sta guard_ok
@check: jsr mmu_peek1
cmp #$A5
beq :+
lda #$00
sta guard_ok
: dey
bpl @check
lda guard_ok
jsr emit
lda #$01
sta last_id
@names: lda last_id
cmp names_count
beq :+
bcs @done
: jsr name_get
lda name_out_flags
jsr emit
lda name_out_len
jsr emit
ldx #$00
@spell: cpx name_out_len
beq @next
lda name_out,x
stx emit_x
jsr emit
ldx emit_x
inx
bne @spell
@next: inc last_id
bne @names ; IDs stop at 255, so this always loops
@done: rts

; C=1 when the previous token introduces a declaration name.
is_declaration:
lda prev_kind
ldx #decl_count - 1
@find: cmp decl_kinds,x
beq @yes
dex
bpl @find
clc
rts
@yes: sec
rts

set_guard_ptr:
lda #<guard
sta mmu_ptr
lda #>guard
sta mmu_ptr+1
rts

emit: ldy dump_ptr+1
cpy #>(dump + DUMP_SIZE)
bcc @room
lda #$01
sta overflow
rts
@room: sty emit_y
ldy #$00
sta (dump_ptr),y
ldy emit_y
inc dump_ptr
bne :+
inc dump_ptr+1
: rts

.segment "RODATA"
decl_kinds:
.byte KW_CLASS, KW_INTERFACE, KW_PROGRAM, KW_METHOD, KW_VAR
decl_count = * - decl_kinds

fixtures:
.macro FIXTURE name
.local text, done
.word text
.byte done - text
.pushseg
.segment "DATA"
text: .byte name
done:
.popseg
.endmacro
FIXTURE "NAMES.N8"
FIXTURE "COLLIDE.N8"
FIXTURE "FULL.N8"
FIXTURE_COUNT = 3

messages:
ok_msg: .byte "NOVA128 NAMES TEST OK", $0D, $00
fail_msg: .byte "NOVA128 NAMES TEST FAIL", $0D, $00

.segment "BSS"
failures: .res 1
overflow: .res 1
fx_index: .res 1
name_lo: .res 1
prev_kind: .res 1
last_id: .res 1
guard_ok: .res 1
emit_x: .res 1
emit_y: .res 1
print_y: .res 1
dump: .res DUMP_SIZE

+ 30
- 0
newLang/tests/names/names.n8 Просмотреть файл

@@ -0,0 +1,30 @@
// E02-S03 name-table fixture: case-insensitive IDs and declaration spelling.
// "runner" and "ticker" are used before their declarations; the declaration
// spelling must replace the first-use spelling. "Main" is declared once and
// later written differently; the first declaration spelling must stay.
interface Ticker
method tick()
end interface

class Worker implements TICKER
private runner count
public method Tick()
count.go(Count, COUNT)
end method
end class

class RunnerJob
end class

class Runner
public method go(a as word, b as word)
end method
end class

program Main
var w as WORKER
var job_2 as runnerjob
var Count as word
w = new worker()
main = MAIN
end program

Редактирование Предпросмотр
Загрузка…
Отмена
Сохранить

Powered by TurnKey Linux.