Ви не можете вибрати більше 25 тем Теми мають розпочинатися з літери або цифри, можуть містити дефіси (-) і не повинні перевищувати 35 символів.

151 рядки
7.3KB

  1. # E02-S03: build the name-table test PRG, its fixtures, and a fresh D81, and
  2. # compute the exact dump the C128 must produce (build/names-test/expected.bin).
  3. [CmdletBinding()]
  4. param()
  5. $ErrorActionPreference = "Stop"
  6. $project = Split-Path $PSScriptRoot -Parent
  7. Import-Module (Join-Path $PSScriptRoot "lib\Nova128Test.psm1") -Force
  8. . (Join-Path $project "tests\lexer\reference-lexer.ps1")
  9. $out = Join-Path $project "build\names-test"
  10. New-Item -ItemType Directory -Force -Path $out | Out-Null
  11. $link = Invoke-Nova128Link -Name "names-test" -BuildDir $out `
  12. -Config (Join-Path $project "cfg\compiler.cfg") -Sources @(
  13. (Join-Path $project "src\compiler\mmu.s"),
  14. (Join-Path $project "src\compiler\diskio.s"),
  15. (Join-Path $project "src\compiler\source.s"),
  16. (Join-Path $project "src\compiler\lexer.s"),
  17. (Join-Path $project "src\compiler\names.s"),
  18. (Join-Path $project "tests\names\names-test.s")) # last: guard follows the table
  19. if ((Get-Nova128Label $link.Labels "test_entry") -ne 0x1C0D) { throw "test_entry is not at `$1C0D" }
  20. $recs = Get-Nova128Label $link.Labels "name_recs"
  21. $guard = Get-Nova128Label $link.Labels "guard"
  22. if ($guard -ne $recs + 255 * 20) { throw ("guard `${0:X4} does not directly follow the name table" -f $guard) }
  23. function Get-Lines([byte[]]$bytes) {
  24. # Same line split as src_next_line: $0D ends a line; a tail without $0D
  25. # is the last line.
  26. $lines = New-Object System.Collections.Generic.List[byte[]]
  27. $start = 0
  28. for ($i = 0; $i -lt $bytes.Length; $i++) {
  29. if ($bytes[$i] -eq 13) {
  30. if ($i -gt $start) { $lines.Add([byte[]]$bytes[$start..($i - 1)]) } else { $lines.Add([byte[]]@()) }
  31. $start = $i + 1
  32. }
  33. }
  34. if ($start -lt $bytes.Length) { $lines.Add([byte[]]$bytes[$start..($bytes.Length - 1)]) }
  35. return ,$lines
  36. }
  37. # ------------------------------------------------------------ name hashing
  38. function Get-NameKey([byte[]]$spelling) {
  39. return [byte[]]($spelling | ForEach-Object { if ($_ -ge 0xC1 -and $_ -le 0xDA) { $_ -band 0x7F } else { $_ } })
  40. }
  41. function Get-NameHash([byte[]]$key) {
  42. $h = 0
  43. foreach ($b in $key) { $h = ((($h -shl 1) -band 0xFF) -bor ($h -shr 7)) -bxor $b }
  44. return $h
  45. }
  46. function Get-AsciiHash([string]$name) { return Get-NameHash (Get-NameKey (ConvertTo-Nova128Petscii $name)) }
  47. # ------------------------------------------------------------ collide.n8
  48. # Pick names that share a bucket, including two with the same full hash.
  49. $byHash = @{}
  50. foreach ($a in [char[]]"abcdefghijklmnopqrstuvwxyz") {
  51. foreach ($b in [char[]]"abcdefghijklmnopqrstuvwxyz0123456789") {
  52. $n = "$a$b"; $h = Get-AsciiHash $n
  53. if (-not $byHash.ContainsKey($h)) { $byHash[$h] = New-Object System.Collections.Generic.List[string] }
  54. $byHash[$h].Add($n)
  55. }
  56. }
  57. $sameHash = $byHash[($byHash.Keys | Where-Object { $byHash[$_].Count -ge 2 } | Sort-Object | Select-Object -First 1)]
  58. $h0 = Get-AsciiHash $sameHash[0]
  59. $bucket = $h0 -band 63
  60. $sameBucket = @($byHash.Keys | Where-Object { ($_ -band 63) -eq $bucket -and $_ -ne $h0 } | Sort-Object |
  61. ForEach-Object { $byHash[$_] } | Select-Object -First 6)
  62. $group = @($sameHash[0], $sameHash[1]) + $sameBucket # up to 8 names, one bucket
  63. if ($group.Count -lt 5) { throw "collision chain too short: $($group -join ', ')" }
  64. $collide = New-Object System.Text.StringBuilder
  65. [void]$collide.AppendLine("// generated by build-names-test.ps1: one hash bucket ($bucket)")
  66. foreach ($n in $group) { [void]$collide.AppendLine("var $n as word") }
  67. [void]$collide.AppendLine(($group[($group.Count - 1)..0] | ForEach-Object { $_.ToUpper() }) -join " ")
  68. [void]$collide.AppendLine(($group | ForEach-Object { $_ + "x" }) -join " ") # near misses
  69. if ((Get-AsciiHash $group[0]) -ne (Get-AsciiHash $group[1])) { throw "no identical-hash pair" }
  70. if (@($group | ForEach-Object { (Get-AsciiHash $_) -band 63 } | Select-Object -Unique).Count -ne 1) {
  71. throw "collision group spans buckets"
  72. }
  73. # --------------------------------------------------------------- full.n8
  74. $full = New-Object System.Text.StringBuilder
  75. [void]$full.AppendLine("program Full") # ID 1
  76. $names = 1..259 | ForEach-Object { "n$_" } # IDs 2..255, then 4 over
  77. for ($i = 0; $i -lt $names.Count; $i += 8) {
  78. [void]$full.AppendLine(($names[$i..([Math]::Min($i + 7, $names.Count - 1))]) -join " ")
  79. }
  80. [void]$full.AppendLine("N1 full n254 N259 n258") # lookups still work when full
  81. $fixtures = [ordered]@{
  82. "names.n8" = ConvertTo-Nova128Petscii (Get-Content -Raw (Join-Path $project "tests\names\names.n8"))
  83. "collide.n8" = ConvertTo-Nova128Petscii $collide.ToString()
  84. "full.n8" = ConvertTo-Nova128Petscii $full.ToString()
  85. }
  86. # ----------------------------------------------------- expected dump bytes
  87. $declKinds = @("KW_CLASS", "KW_INTERFACE", "KW_PROGRAM", "KW_METHOD", "KW_VAR")
  88. $expected = New-Object System.Collections.Generic.List[byte]
  89. $index = 0
  90. $summary = @()
  91. foreach ($name in $fixtures.Keys) {
  92. $src = $fixtures[$name]
  93. $expected.AddRange([byte[]](0xFF, $index, 0))
  94. $lines = (Get-Lines $src)
  95. $table = New-Object System.Collections.Generic.List[object] # ID-1 -> record
  96. $ids = @{}
  97. $prev = "EOL"; $errors = 0
  98. foreach ($t in (Get-ReferenceTokens $src)) {
  99. $m = [regex]::Match($t, '^(\d+):(\d+) (\S+)(?: (\d+))?')
  100. $kind = $m.Groups[3].Value
  101. if ($kind -eq "EOF") { break }
  102. if ($kind -eq "IDENT") {
  103. $line = $lines[[int]$m.Groups[1].Value - 1]
  104. $col = [int]$m.Groups[2].Value; $len = [int]$m.Groups[4].Value
  105. $spelling = [byte[]]$line[($col - 1)..($col + $len - 2)]
  106. $key = [Convert]::ToBase64String((Get-NameKey $spelling))
  107. $decl = $declKinds -contains $prev
  108. if ($ids.ContainsKey($key)) { $id = $ids[$key] }
  109. elseif ($table.Count -lt 255) {
  110. $table.Add([pscustomobject]@{ Flags = 0; Spelling = $spelling })
  111. $id = $table.Count; $ids[$key] = $id
  112. } else { $id = 0 }
  113. if ($id -eq 0) { $expected.AddRange([byte[]](3, 1)); $errors++ }
  114. elseif ($decl) {
  115. $rec = $table[$id - 1]
  116. if ($rec.Flags -eq 0) { $rec.Flags = 1; $rec.Spelling = $spelling }
  117. $expected.AddRange([byte[]](2, $id))
  118. } else { $expected.AddRange([byte[]](1, $id)) }
  119. }
  120. $prev = $kind
  121. }
  122. $expected.AddRange([byte[]](0xFD, $table.Count, 1))
  123. foreach ($rec in $table) {
  124. $expected.AddRange([byte[]]($rec.Flags, $rec.Spelling.Length))
  125. $expected.AddRange($rec.Spelling)
  126. }
  127. $summary += [pscustomobject]@{ Fixture = $name; Names = $table.Count; FullErrors = $errors }
  128. $index++
  129. }
  130. $expected.Add(0xFE)
  131. [IO.File]::WriteAllBytes((Join-Path $out "expected.bin"), $expected.ToArray())
  132. $summary | ConvertTo-Json | Set-Content (Join-Path $out "expected-summary.json")
  133. $files = @(@{ Name = "names-test"; Path = $link.Program; Type = "prg" })
  134. foreach ($name in $fixtures.Keys) {
  135. $pet = Join-Path $out ($name -replace '\.n8$', '.pet')
  136. [IO.File]::WriteAllBytes($pet, $fixtures[$name])
  137. $files += @{ Name = $name; Path = $pet; Type = "seq" }
  138. }
  139. New-Nova128Disk -Path (Join-Path $out "names-test.d81") -Files $files
  140. Write-Host ("built {0}; collision bucket {1}: {2}" -f $link.Program, $bucket, ($group -join ", "))
  141. $summary | Format-Table -AutoSize | Out-String | Write-Host

Powered by TurnKey Linux.