diff --git a/newLang/docs/decisions.md b/newLang/docs/decisions.md index 8db83a4..604aacd 100644 --- a/newLang/docs/decisions.md +++ b/newLang/docs/decisions.md @@ -46,6 +46,7 @@ documented default. `Proposed` means a later change still needs approval. | 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. | +| 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 diff --git a/newLang/docs/memory-map.md b/newLang/docs/memory-map.md index e20d3e5..49416e5 100644 --- a/newLang/docs/memory-map.md +++ b/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 | | `$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 | + +`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 | Bank-1 data is reached only through `mmu.s` helpers (`mmu_peek1`/`mmu_poke1` diff --git a/newLang/planning/claims/E02-S03.md b/newLang/planning/claims/E02-S03.md new file mode 100644 index 0000000..4ead393 --- /dev/null +++ b/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). diff --git a/newLang/scripts/build-names-test.ps1 b/newLang/scripts/build-names-test.ps1 new file mode 100644 index 0000000..054adde --- /dev/null +++ b/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 diff --git a/newLang/scripts/verify-names-test.ps1 b/newLang/scripts/verify-names-test.ps1 new file mode 100644 index 0000000..f645cca --- /dev/null +++ b/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" diff --git a/newLang/src/common/names.inc b/newLang/src/common/names.inc new file mode 100644 index 0000000..c2d63eb --- /dev/null +++ b/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 diff --git a/newLang/src/compiler/names.s b/newLang/src/compiler/names.s new file mode 100644 index 0000000..0f309b0 --- /dev/null +++ b/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+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 diff --git a/newLang/tests/names/names-test.s b/newLang/tests/names/names-test.s new file mode 100644 index 0000000..eda431e --- /dev/null +++ b/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+1 + 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 + sta MB_DATA+1 + sec + lda dump_ptr + 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+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 diff --git a/newLang/tests/names/names.n8 b/newLang/tests/names/names.n8 new file mode 100644 index 0000000..56a8fc8 --- /dev/null +++ b/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