diff --git a/.github/workflows/TestingCI.yml b/.github/workflows/TestingCI.yml index b971f4f..2dc4130 100644 --- a/.github/workflows/TestingCI.yml +++ b/.github/workflows/TestingCI.yml @@ -73,5 +73,68 @@ jobs: & ./target/release/xbasic64.exe $_.FullName -o example.exe if ($LASTEXITCODE -ne 0) { throw "compile failed: $($_.Name)" } & ./example.exe | Out-Null - if ($LASTEXITCODE -ne 0) { throw "run failed: $($_.Name)" } + # Report the code, not just the failure. Windows says what went + # wrong in it, and nothing else here can: 1 is the compiler's own + # diagnosed abort, while 0xC0000005 (access violation), 0xC0000409 + # (stack buffer overrun) and 0xC0000374 (heap corruption) each name + # a different defect, and none of the three can be reproduced on + # the Linux job. + if ($LASTEXITCODE -ne 0) { + # `-f` with X8 renders a negative Int32 as its two's-complement + # hex on its own. Masking first needed no cast and got one: in + # PowerShell 0xFFFFFFFF is Int32 -1, so the -band was a no-op and + # [uint32] then threw on the very value it was there to show. + throw ("run failed: {0} (exit {1}, 0x{2:X8})" -f $_.Name, $LASTEXITCODE, $LASTEXITCODE) + } } + + # An example is a whole program, so a crash in one names the program and + # not the statement. These are one statement each, and they are the only + # coverage the console statements have anywhere: the test suite runs on + # Linux, and CLS, LOCATE and COLOR are precisely the helpers whose two + # implementations differ most. + # + # Every probe runs, and the step reports the whole table before failing, + # so one CI run says which statements are broken rather than the first. + - name: Probe each console statement + if: always() + shell: pwsh + run: | + $probes = [ordered]@{ + 'CLS' = 'CLS' + 'CLS after PRINT' = "PRINT `"x`"`nCLS" + 'CLS twice' = "CLS`nCLS" + 'PRINT alone' = 'PRINT "x"' + 'COLOR' = 'COLOR 14, 1' + 'LOCATE' = 'LOCATE 2, 5' + 'LOCATE row only' = 'LOCATE 3' + 'POS' = 'PRINT POS(0)' + 'TIMER' = 'PRINT TIMER' + 'RANDOMIZE n' = 'RANDOMIZE 42' + 'RANDOMIZE TIMER' = 'RANDOMIZE TIMER' + 'RND' = 'PRINT RND' + 'RND(0)' = 'PRINT RND(0)' + 'BEEP' = 'BEEP' + 'DATE$' = 'PRINT DATE$' + 'TIME$' = 'PRINT TIME$' + 'FRE' = 'PRINT FRE(0)' + 'DEFINT' = "DEFINT A-Z`nX = 3`nPRINT X" + 'EQV' = 'PRINT 1 EQV 1' + 'ERASE' = "DIM A(3)`nERASE A" + 'SYSTEM' = 'SYSTEM' + } + $failed = @() + foreach ($p in $probes.GetEnumerator()) { + Set-Content -Path probe.bas -Value $p.Value + & ./target/release/xbasic64.exe probe.bas -o probe.exe | Out-Null + if ($LASTEXITCODE -ne 0) { + Write-Host ("{0,-20} DID NOT COMPILE" -f $p.Key) + $failed += $p.Key + continue + } + & ./probe.exe | Out-Null + $code = $LASTEXITCODE + Write-Host ("{0,-20} exit {1} (0x{2:X8})" -f $p.Key, $code, $code) + if ($code -ne 0) { $failed += $p.Key } + } + if ($failed.Count -gt 0) { throw "crashed: $($failed -join ', ')" } diff --git a/CLAUDE.md b/CLAUDE.md index f2979db..49a0cc0 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -72,13 +72,20 @@ Integration tests organized by feature area: - **Runtime checks on by default**: `--unsafe` removes them - **Two runtimes in lockstep**: `runtime/sysv/` and `runtime/win64-native/` export the same `.globl` names; a new helper must be added to both +- **Two assemblers, not just two runtimes**: `main.rs` assembles with GNU `as` + on Linux and `clang -c` on Windows, so the Win64 tree is the one built by the + assembler no test here runs. They disagree about `.equ len, . - label`: GNU + `as` folds it to an immediate, and an assembler that cannot prove the symbol + absolute assembles `mov reg, len` as a *load from that address* instead. + `CLS` did that on every Windows run. Bracket data with an `_end` label and + subtract at run time - **A runtime helper takes at most four arguments**: Win64 passes only four in registers, so `arg_reg(4)` panics there while System V accepts six. A helper that needs a fifth is invisible on Linux and breaks every Windows compile; fold an argument away instead (see `_rt_file_open_random`) - **Unsupported GW-BASIC names are refused, not ignored**: an unrecognised name is otherwise just a new variable, so `UNSUPPORTED` in `sema.rs` names the - keywords this compiler does not provide and why. See [NONGOALS.md](NONGOALS.md) + keywords this compiler does not provide and why - **String builtins returning a static buffer must copy**: two calls in one expression would otherwise alias, which is why `_rt_str`, `_rt_chr`, `_rt_hex`, `_rt_oct` and `_rt_mk` end in `_rt_strdup` diff --git a/LANGREF.md b/LANGREF.md index 5446ae3..4f26433 100644 --- a/LANGREF.md +++ b/LANGREF.md @@ -144,7 +144,24 @@ xbasic64 supports five data types, indicated by suffix characters: ### Default Type -**Unsuffixed numeric variables default to DOUBLE (`#`).** +**Unsuffixed numeric variables default to DOUBLE (`#`)** unless a `DEF*` +statement says otherwise. + +### DEFINT, DEFLNG, DEFSNG, DEFDBL, DEFSTR + +These set the default type for names beginning with the given letters, so a +listing need not suffix every variable: + +```basic +DEFINT A-Z ' every unsuffixed name is an INTEGER +DEFSTR S ' except those starting with S, which are strings +DEFINT A, C-E ' single letters and ranges, comma separated +``` + +A suffix always wins over the default, and the two spellings of one name are +the same variable: after `DEFINT A`, `A` and `A%` share storage. The default +applies to the whole program rather than from the statement onwards, which is +where these are written in practice. ```basic X = 3.14159 ' X is Double @@ -269,6 +286,8 @@ case-sensitive and a prefix sorts before the longer string (`"ab" < "abc"`). | `OR` | Bitwise/logical OR | | `XOR` | Bitwise/logical XOR | | `NOT` | Bitwise/logical NOT | +| `EQV` | Bitwise equivalence | +| `IMP` | Bitwise implication | These operate bitwise on integers, allowing both logical tests and bit manipulation. Their operands are converted to integers first, and the result is @@ -302,6 +321,8 @@ From highest to lowest: 6. `NOT` 7. `AND` 8. `OR`, `XOR` +9. `EQV` +10. `IMP` Because `^` binds tighter than unary negation, `-2 ^ 2` is `-(2 ^ 2)` = -4. @@ -663,6 +684,46 @@ Clear screen: CLS ``` +### BEEP, ERASE and SYSTEM + +```basic +BEEP ' Ring the terminal bell +DIM Scores(10) +ERASE Scores ' Release it, so it may be DIMed again +DIM Scores(50) +SYSTEM ' End the program, as END does +``` + +`ERASE` is recognised only before a name, so `Erase` remains usable as a label +or a variable elsewhere. Its argument must be an array that is DIMed somewhere +-- a name that is not one is a mistake, not a statement that does nothing. + +### LOCATE and COLOR + +Console control, written as ANSI escape sequences: + +```basic +CLS +LOCATE 5, 10 ' Row 5, column 10; both count from 1 +LOCATE 3 ' Row only; the column is left alone +LOCATE , 20 ' Column only +COLOR 14, 1 ' Bright yellow on blue +COLOR 7 ' Foreground only +PRINT "positioned" +``` + +Colours are GW-BASIC's 0-15, where 8-15 are the bright half. GW-BASIC's third +`COLOR` argument sets the border, which a terminal has no equivalent for, and is +refused rather than ignored. `LOCATE` with no row asks for row 1, since the row +is not tracked the way the column is. + +`POS(0)` gives the column the next character will be written to, counting from 1: + +```basic +PRINT "abc"; +PRINT POS(0) ' 4 +``` + ### SWAP Exchange two values of the same type, including array elements: @@ -847,23 +908,41 @@ STOP ' Terminate (historically for debugging) | `EXP(x)` | e raised to power x | | `LOG(x)` | Natural logarithm | | `RND` | Random number 0 ≤ r < 1 | +| `FRE(x)` | Free memory; a large constant here | **Numeric output:** `PRINT` writes the shortest decimal that reads back as the same value, so a `DOUBLE` shows its full precision (`PRINT 1 / 3` gives `0.3333333333333333`) and a `SINGLE` shows only the ~7 digits it carries. -**RND behavior:** +**RND behavior:** the argument selects between three behaviours. + ```basic X = RND ' Next random number -X = RND(0) ' Same as RND -X = RND(-1) ' Reseed with system time (implementation-defined) +X = RND(1) ' Next random number; any positive value does this +X = RND(0) ' The previous number again +X = RND(-7) ' Reseed from -7, then return the next number +``` + +The generator starts from a fixed seed, so a program that never reseeds replays +the same numbers on every run -- which is useful while debugging and wrong for a +game. `RANDOMIZE` is how a program chooses: + +```basic +RANDOMIZE ' Seed from the clock: a different run every time +RANDOMIZE TIMER ' The same thing, written out +RANDOMIZE 42 ' A fixed seed: the same run every time ``` +GW-BASIC's bare `RANDOMIZE` asks the operator for a seed. A compiled program has +nobody to ask, so it takes the clock. + ### String Functions | Function | Description | |-----------------------|------------------------------------------------| | `LEN(s$)` | Length of string | +| `DATE$` | Current date, as `MM-DD-YYYY` | +| `TIME$` | Current time, as `HH:MM:SS` | | `LEFT$(s$, n)` | Leftmost n characters | | `RIGHT$(s$, n)` | Rightmost n characters | | `MID$(s$, start, len)`| Substring (1-based index) | @@ -1283,20 +1362,30 @@ Each of these is practical on both Linux and Windows and simply has not been written. Programs using them are refused today. - **Error trapping** -- `ON ERROR GOTO`, `RESUME`, `RESUME NEXT`, `ERR`, `ERL`, `ERROR` -- **Console control** -- `LOCATE`, `COLOR`, `WIDTH`, `CSRLIN`, `POS`, `VIEW PRINT`, `INKEY$`, `BEEP`, `SLEEP` -- **Date and time** -- `DATE$`, `TIME$` +- **Console control** -- `WIDTH`, `CSRLIN`, `VIEW PRINT`, `INKEY$`, `BEEP`, `SLEEP` - **Operating system** -- `SHELL`, `ENVIRON$`, `KILL`, `NAME`, `FILES`, `CHDIR`, `MKDIR`, `RMDIR` -- **Odds and ends** -- `RANDOMIZE`, `ERASE`, `INPUT$`, `FRE`, `SHARED`, `STATIC` -- **`DEFINT` and friends** -- `DEFINT`, `DEFLNG`, `DEFSNG`, `DEFDBL`, `DEFSTR`; use a - type suffix or `DIM ... AS` +- **Odds and ends** -- `INPUT$`, `SHARED`, `STATIC` + +### Out of scope + +**Graphics** -- `SCREEN`, `PSET`, `PRESET`, `LINE` in its graphics form, +`CIRCLE`, `DRAW`, `PAINT`, `POINT`, `VIEW`, `WINDOW`, `PALETTE`, `PMAP`. These +need a display this compiler does not provide. + +**The 8086's machine** -- `PEEK`, `POKE`, `DEF SEG`, `VARPTR`, `VARPTR$`, `USR`, +`INP`, `OUT`, `WAIT`, `BLOAD`, `BSAVE`. There is no fixed address worth naming +in a 64-bit hosted program: the video buffer is not memory, addresses are +randomised, and the pages are protected. A `POKE` that appeared to work would be +the worst outcome available, so these are refused rather than emulated. + +**Commands to the interpreter** -- `RUN`, `LIST`, `LOAD`, `SAVE`, `MERGE`, +`NEW`, `EDIT`, `RENUM`, `AUTO`, `CONT`, `DELETE`, `TRON`, `TROFF`, `CLEAR`. +These operate on program text that a compiled program no longer has. -### Never +**Program chaining** -- `CHAIN` and `COMMON` need separate compilation. -Graphics, sound, joysticks, light pens, direct memory access, port I/O, the -line printer, and the interpreter's own commands (`RUN`, `LIST`, `CHAIN`, ...) -are permanent non-goals: they describe a machine and a way of working that a -compiled 64-bit program does not have. **[NONGOALS.md](NONGOALS.md)** gives the -full list and the reasoning. +Everything else GW-BASIC provides that is missing here is listed above as not +yet implemented. Each refused name says which of the two it is. ### Structural diff --git a/NONGOALS.md b/NONGOALS.md deleted file mode 100644 index 634e91a..0000000 --- a/NONGOALS.md +++ /dev/null @@ -1,265 +0,0 @@ -# What xbasic64 Will Never Support - -xbasic64 compiles 1980s BASIC to native x86-64 for Linux and Windows. A good -deal of GW-BASIC cannot follow it there — not because the work is hard, but -because the features describe a machine that no longer exists and a way of -working that a compiler does not have. - -This document is the decision, so that the question does not have to be -reopened every time someone finds a listing that uses `POKE`. The companion -list of features that *are* coming is in -[LANGREF.md](LANGREF.md#not-implemented-yet). - -Every name here is **refused by the compiler with a reason**, not silently -accepted. That is the part that matters. An unrecognised name in BASIC is -ordinarily just a new variable, so without this a program using `PEEK` would -compile without complaint and read zero forever. - ---- - -## The four reasons - -Everything below is out for one of four reasons. - -**1. It addresses the 8086.** GW-BASIC ran in a 64 KB segmented address space -it shared with the BIOS, the video buffer and the interpreter itself. `PEEK`, -`POKE` and `DEF SEG` are how programs reached that memory, and `VARPTR` is how -they found their own variables in it. On x86-64 under a modern operating -system there is no fixed address worth naming: the video buffer is not memory, -the addresses are randomised, and the pages are protected. A `POKE` that did -anything at all would be a bug. - -**2. It drives hardware directly.** `INP`, `OUT` and `WAIT` are I/O port -instructions. `SOUND` and `PLAY` program the PC speaker's timer chip. `STICK` -and `STRIG` read the game port. These are privileged operations in user mode; -a program that executes them is killed by the kernel, not obeyed. - -**3. It is a command to the interpreter, not a statement in a program.** -`RUN`, `LIST`, `SAVE`, `RENUM` and the rest operate on the program text that -GW-BASIC kept in memory while you worked on it. A compiled program has no -program text at run time — that was the point of compiling it — so these have -nothing to act on. - -**4. It belongs to a display model we do not have.** GW-BASIC's graphics -statements assume a CGA or EGA screen mode, a current cursor position, a -palette of at most 16 entries, and a coordinate space the interpreter owns -outright. Reproducing that faithfully means shipping a graphics stack; not -reproducing it faithfully means programs that draw the wrong thing. Text-mode -console control is a different matter and *is* planned — see -[LANGREF.md](LANGREF.md#not-implemented-yet). - ---- - -## The list - -### Memory and hardware access - -`PEEK`, `POKE`, `DEF SEG`, `VARPTR`, `VARPTR$`, `VARSEG`, `DEF USR`, `USR`, -`CALL` (the GW-BASIC form, which calls machine code at an address), `INP`, -`OUT`, `WAIT`, `BLOAD`, `BSAVE`, `IOCTL`, `IOCTL$`, `ERDEV`, `ERDEV$`, -`EXTERR` - -Reasons 1 and 2. Note that QuickBASIC's `CALL` — calling a `SUB` by name — is -a different statement that happens to share a keyword; that one is merely -[not implemented yet](LANGREF.md#not-implemented-yet), and `SUB` calls work -without it today. - -### Graphics - -`SCREEN`, `PSET`, `PRESET`, `LINE` (the drawing statement; `LINE INPUT` is -supported and unrelated), `CIRCLE`, `PAINT`, `DRAW`, `GET`/`PUT` in their -graphics forms, `VIEW`, `WINDOW`, `PMAP`, `POINT`, `PALETTE`, `PALETTE USING` - -Reason 4. `GET` and `PUT` *are* supported in their file forms — see -[Random-Access Files](LANGREF.md#random-access-files) — which is why the -graphics forms are called out separately here. - -### Sound - -`SOUND`, `PLAY`, `PLAY(n)`, `ON PLAY` - -Reason 2. (`BEEP` is the exception: it is one control character, and it is -planned rather than refused forever.) - -### Light pen, joystick and soft keys - -`PEN`, `ON PEN`, `STICK`, `STRIG`, `ON STRIG`, `KEY`, `KEY(n)`, `ON KEY(n)` - -Reason 2, and in the case of `KEY` a display model — the soft-key line across -the bottom of the screen — that reason 4 covers. - -### Serial communications - -`COM(n)`, `ON COM(n)`, `OPEN "COM1:..."` - -Reason 2. Serial ports are reachable on both platforms, but through the -operating system rather than through GW-BASIC's model of them, and a program -written against that model would not work unchanged anyway. A program needing -a serial port is better served by the host OS than by a 1983 abstraction of -it. - -### Event trapping - -`ON TIMER(n)`, and the `ON` forms of the device statements above - -GW-BASIC checked for pending events between statements. Reproducing that means -a check between every statement of compiled code, which would slow down every -program to serve a feature almost none of them use. `ON ERROR` is not in this -category and is [planned](LANGREF.md#not-implemented-yet). - -### The line printer - -`LPRINT`, `LPRINT USING`, `LPOS` - -There is no `LPT1:`. A program that wants a printer on either supported -platform should write a file and hand it to the spooler; `PRINT #` already -does the first half. - -### Interpreter and editor commands - -`AUTO`, `CONT`, `DELETE`, `EDIT`, `LIST`, `LLIST`, `LOAD`, `MERGE`, `NEW`, -`RENUM`, `RUN`, `SAVE`, `TRON`, `TROFF`, `CLEAR` - -Reason 3. - -### Program chaining - -`CHAIN`, `COMMON` - -Reason 3. `CHAIN` loads another BASIC program over the running one and jumps -into it, with `COMMON` naming the variables that survive the transition. A -compiled executable cannot absorb another program's code, and the modern -equivalent — running a second program and passing data through a file, a pipe -or the command line — is a different design rather than a port of this one. - ---- - -## Deliberately different, not missing - -Some GW-BASIC behaviour is supported but does not match exactly. Those choices -are listed in -[LANGREF.md](LANGREF.md#deliberate-differences-from-gw-basic) — number -formatting, integer assignment, and the requirement that arrays be declared -before use. - ---- - -## Keeping this honest - -The compiler's own table of refused names lives in `UNSUPPORTED` in -`src/sema.rs`, and `tests/errors/mod.rs` checks that these names are diagnosed -rather than quietly accepted. If a name is added here, it belongs in that table -too, so that the documentation and the compiler cannot drift apart. - ---- - -## Appendix: every GW-BASIC keyword, accounted for - -The keyword list is the index of the *Microsoft GW-BASIC User's Guide and -Reference*. Every entry has a status: - -- **yes** — supported -- **later** — practical on both platforms, not written yet -- **never** — one of the four reasons above - -| Keyword | Status | Keyword | Status | -|---|---|---|---| -| `ABS` | yes | `LOC` | yes | -| `ASC` | yes | `LOCATE` | later | -| `ATN` | yes | `LOCK` | yes | -| `AUTO` | never | `LOF` | yes | -| `BEEP` | later | `LOG` | yes | -| `BLOAD` | never | `LPOS` | never | -| `BSAVE` | never | `LPRINT` | never | -| `CALL` | later (QB form) | `LPRINT USING` | never | -| `CDBL` | yes | `LSET` | yes | -| `CHAIN` | never | `MERGE` | never | -| `CHDIR` | later | `MID$` (function) | yes | -| `CHR$` | yes | `MID$` (statement) | yes | -| `CINT` | yes | `MKDIR` | later | -| `CIRCLE` | never | `MKD$` | yes | -| `CLEAR` | never | `MKI$` | yes | -| `CLOSE` | yes | `MKS$` | yes | -| `CLS` | yes | `NAME` | later | -| `COLOR` | later (text) | `NEW` | never | -| `COM(n)` | never | `NEXT` | yes | -| `COMMON` | never | `OCT$` | yes | -| `CONT` | never | `ON COM(n)` | never | -| `COS` | yes | `ON ERROR GOTO` | later | -| `CSNG` | yes | `ON KEY(n)` | never | -| `CSRLIN` | later | `ON PEN` | never | -| `CVD` | yes | `ON PLAY(n)` | never | -| `CVI` | yes | `ON STRIG(n)` | never | -| `CVS` | yes | `ON TIMER(n)` | never | -| `DATA` | yes | `ON...GOSUB` | yes | -| `DATE$` | later | `ON...GOTO` | yes | -| `DEF FN` | yes | `OPEN` | yes | -| `DEF SEG` | never | `OPEN "COM(n)"` | never | -| `DEF USR` | never | `OPTION BASE` | yes | -| `DEFDBL` | later | `OUT` | never | -| `DEFINT` | later | `PAINT` | never | -| `DEFSNG` | later | `PALETTE` | never | -| `DEFSTR` | later | `PCOPY` | never | -| `DELETE` | never | `PEEK` | never | -| `DIM` | yes | `PEN` | never | -| `DRAW` | never | `PLAY` | never | -| `EDIT` | never | `PMAP` | never | -| `END` | yes | `POINT` | never | -| `ENVIRON` | later | `POKE` | never | -| `ENVIRON$` | later | `POS` | later | -| `EOF` | yes | `PRESET` | never | -| `ERASE` | later | `PRINT` | yes | -| `ERDEV` | never | `PRINT USING` | yes | -| `ERL` | later | `PRINT#` | yes | -| `ERR` | later | `PRINT# USING` | no (see LANGREF) | -| `ERROR` | later | `PSET` | never | -| `EXP` | yes | `PUT` (files) | yes | -| `EXTERR` | never | `PUT` (graphics) | never | -| `FIELD` | yes | `RANDOMIZE` | later | -| `FILES` | later | `READ` | yes | -| `FIX` | yes | `REM` | yes | -| `FOR` | yes | `RENUM` | never | -| `FRE` | later | `RESET` | never | -| `GET` (files) | yes | `RESTORE` | yes | -| `GET` (graphics) | never | `RESUME` | later | -| `GOSUB` | yes | `RETURN` | yes | -| `GOTO` | yes | `RIGHT$` | yes | -| `HEX$` | yes | `RMDIR` | later | -| `IF` | yes | `RND` | yes | -| `INKEY$` | later | `RSET` | yes | -| `INP` | never | `RUN` | never | -| `INPUT` | yes | `SAVE` | never | -| `INPUT#` | yes | `SCREEN` | never | -| `INPUT$` | later | `SGN` | yes | -| `INSTR` | yes | `SHELL` | later | -| `INT` | yes | `SIN` | yes | -| `IOCTL` | never | `SOUND` | never | -| `IOCTL$` | never | `SPACE$` | yes | -| `KEY` | never | `SPC` | yes | -| `KEY(n)` | never | `SQR` | yes | -| `KILL` | later | `STICK` | never | -| `LEFT$` | yes | `STOP` | yes | -| `LEN` | yes | `STR$` | yes | -| `LET` | yes | `STRIG` | never | -| `LINE` (graphics) | never | `STRING$` | yes | -| `LINE INPUT` | yes | `SWAP` | yes | -| `LINE INPUT#` | yes | `SYSTEM` | never | -| `LIST` | never | `TAB` | yes | -| `LLIST` | never | `TAN` | yes | -| `LOAD` | never | `TIME$` | later | -| `TIMER` | yes | `USR` | never | -| `TROFF` | never | `VAL` | yes | -| `TRON` | never | `VARPTR` | never | -| `UNLOCK` | yes | `VARPTR$` | never | -| `VIEW` | never | `WAIT` | never | -| `VIEW PRINT` | later | `WEND` | yes | -| `WHILE` | yes | `WIDTH` | later | -| `WINDOW` | never | `WRITE` | yes | -| `WRITE#` | yes | | | - -### Beyond GW-BASIC - -xbasic64 also supports these later QuickBASIC features, which GW-BASIC has no -equivalent for: `SUB`/`FUNCTION` with recursion, `TYPE` records, `SELECT CASE`, -`DO`/`LOOP`, `EXIT`, `CONST`, `REDIM`/`REDIM PRESERVE`, `LBOUND`/`UBOUND`, -named labels, `UCASE$`, `LCASE$`, `LTRIM$`, `RTRIM$`, `CLNG`, `MKL$` and `CVL`. diff --git a/README.md b/README.md index 71498de..be34eb9 100644 --- a/README.md +++ b/README.md @@ -77,8 +77,6 @@ Save as `fib.bas`, compile with `xbasic64 fib.bas`, and run `./fib`. ## Documentation - **[Language Reference](LANGREF.md)** - Complete guide to the supported BASIC dialect -- **[Non-Goals](NONGOALS.md)** - The parts of GW-BASIC that will never be - supported, and why ## Architecture diff --git a/examples/guess.bas b/examples/guess.bas new file mode 100644 index 0000000..8a5774a --- /dev/null +++ b/examples/guess.bas @@ -0,0 +1,27 @@ +10 REM Guess the number - a listing in the period style +20 DEFINT A-Z +30 RANDOMIZE TIMER +40 CLS +50 COLOR 14, 1 +60 LOCATE 2, 5 +70 PRINT "GUESS THE NUMBER" +80 COLOR 7, 0 +90 SECRET = INT(RND * 100) + 1 +100 TRIES = 0 +110 LOCATE 4, 5 +120 PRINT "I am thinking of a number from 1 to 100." +130 REM The listing plays itself, so the example needs no input +140 LOW = 1 : HIGH = 100 +150 GUESS = INT((LOW + HIGH) / 2) +160 TRIES = TRIES + 1 +170 LOCATE 6 + TRIES, 5 +180 PRINT "Guess"; TRIES; "is"; GUESS; +190 IF GUESS = SECRET THEN GOTO 250 +200 IF GUESS < SECRET THEN PRINT "- too low" : LOW = GUESS + 1 : GOTO 150 +210 PRINT "- too high" +220 HIGH = GUESS - 1 +230 GOTO 150 +250 PRINT "- correct!" +260 LOCATE 8 + TRIES, 5 +270 PRINT "Found"; SECRET; "in"; TRIES; "guesses." +280 END diff --git a/src/codegen.rs b/src/codegen.rs index 8206751..50a6edd 100644 --- a/src/codegen.rs +++ b/src/codegen.rs @@ -268,6 +268,8 @@ enum Builtin { static RT_BUILTINS: LazyLock> = LazyLock::new(|| { HashMap::from([ ("TIMER", Builtin::Call0("_rt_timer")), + ("DATE$", Builtin::Call0("_rt_date")), + ("TIME$", Builtin::Call0("_rt_time")), ("VAL", Builtin::CallStr("_rt_val")), ("LTRIM$", Builtin::CallStr("_rt_ltrim")), ("RTRIM$", Builtin::CallStr("_rt_rtrim")), @@ -904,6 +906,15 @@ impl CodeGen { self.gen_coercion(ty, DataType::Double); } + /// Evaluate `expr` and leave it in `eax` as a Long. + /// + /// The counterpart of `gen_expr_to_double` for the statements whose + /// arguments are screen coordinates and colours. + fn gen_expr_to_long(&mut self, expr: &Expr) { + let ty = self.gen_expr(expr); + self.gen_coercion(ty, DataType::Long); + } + /// Evaluate `expr` into the working register for `ct`, coerced. /// /// Routes a Double target through the pooled path and everything else @@ -1186,7 +1197,7 @@ impl CodeGen { // Built-in functions that return integers match upper.as_str() { "LEN" | "ASC" | "INSTR" | "CINT" | "CLNG" => DataType::Long, - "EOF" | "LBOUND" | "UBOUND" => DataType::Long, + "EOF" | "LBOUND" | "UBOUND" | "POS" | "FRE" => DataType::Long, // CSNG converts to SINGLE; saying Double here made its result print // with a Double's digits. "CSNG" => DataType::Single, @@ -1229,7 +1240,10 @@ impl CodeGen { // in EAX while every consumer read xmm0 and found the *left operand* // still there: `A = 12 : B = 10 : PRINT A AND B` printed 12. Literal // operands are folded before reaching here, which is why it hid. - if matches!(op, BinaryOp::And | BinaryOp::Or | BinaryOp::Xor) { + if matches!( + op, + BinaryOp::And | BinaryOp::Or | BinaryOp::Xor | BinaryOp::Eqv | BinaryOp::Imp + ) { return DataType::Long; } @@ -3386,6 +3400,75 @@ impl CodeGen { self.emit(" call _rt_cls"); } + // DEF* is consumed by sema, which rewrites the names it affects; + // nothing is left to emit. + StmtKind::DefType { .. } => {} + + // An omitted coordinate means "leave it alone", which the escape + // sequence has no way to say -- so the current value is supplied. + // The column tracker knows the column; the row is not tracked, so + // an omitted row asks the terminal for line 1, which is the one + // divergence here and is documented. + StmtKind::Locate { row, col } => { + match row { + Some(e) => self.gen_expr_to_long(e), + None => self.emit(" mov eax, 1"), + } + self.emit(" movsxd r10, eax"); + match col { + Some(e) => self.gen_expr_to_long(e), + None => self.emit(" call _rt_pos"), + } + self.emit(" movsxd r11, eax"); + self.emit_arg_reg(0, "r10"); + self.emit_arg_reg(1, "r11"); + self.emit(" call _rt_locate"); + } + + StmtKind::Color { fg, bg } => { + match fg { + Some(e) => self.gen_expr_to_long(e), + None => self.emit(" mov eax, 7"), // the usual default + } + self.emit(" movsxd r10, eax"); + match bg { + Some(e) => self.gen_expr_to_long(e), + None => self.emit(" xor eax, eax"), + } + self.emit(" movsxd r11, eax"); + self.emit_arg_reg(0, "r10"); + self.emit_arg_reg(1, "r11"); + self.emit(" call _rt_color"); + } + + StmtKind::Beep => self.emit(" call _rt_beep"), + + // ERASE releases the storage and nulls the descriptor, so the array + // reads as undimensioned again and a later DIM allocates afresh. + // free(NULL) is defined, so erasing an array that was never + // dimensioned is harmless. + StmtKind::Erase(names) => { + for name in names { + let Some(loc) = self.lookup_array(name).map(|i| i.loc.clone()) else { + continue; // sema has already complained + }; + emit!(self, " mov {}, {}", Self::arg_reg(0), loc.q(0)); + self.emit_call_libc("free"); + emit!(self, " mov {}, 0", loc.q(0)); + } + } + + StmtKind::Randomize(seed) => { + // With no seed, take the clock: GW-BASIC prompts the operator + // for one, and a compiled program has nobody to ask. TIMER + // already returns fractional seconds, so it is the clock. + match seed { + Some(e) => self.gen_expr_to_double(e), + None => self.emit(" call _rt_timer"), + } + self.emit(" call _rt_randomize"); + } + StmtKind::SelectCase { expr, cases } => { let end_label = self.new_label("endselect"); @@ -4006,6 +4089,20 @@ impl CodeGen { }; emit!(self, " {} eax, ecx", instr); } + + // EQV is NOT (a XOR b); IMP is (NOT a) OR b. Both are bitwise, so + // they are built from the instructions already here rather than + // given any of their own. + BinaryOp::Eqv => { + self.emit_cvt_float_to_int(work_type); + self.emit(" xor eax, ecx"); + self.emit(" not eax"); + } + BinaryOp::Imp => { + self.emit_cvt_float_to_int(work_type); + self.emit(" not eax"); + self.emit(" or eax, ecx"); + } } self.expr_depth -= 1; @@ -5602,7 +5699,13 @@ impl CodeGen { self.emit(" cvtsi2sd xmm0, eax"); } "RND" => { - if !args.is_empty() { + if args.is_empty() { + // A bare RND means "next value", which _rt_rnd spells as a + // positive argument. This used to leave whatever happened to + // be in xmm0 -- harmless only while the argument was ignored. + let one = self.f64_operand(1.0); + emit!(self, " movsd xmm0, {}", one); + } else { self.gen_expr_to_double(&args[0]); } self.emit(" call _rt_rnd"); @@ -5753,6 +5856,19 @@ impl CodeGen { // Result is in rax self.emit(" mov eax, eax"); // zero-extend/truncate to 32-bit } + "FRE" => { + // A compiled program has no BASIC string heap to run out of, so + // this answers a plausible figure rather than pretending to. + // Listings use it as `IF FRE(0) < n THEN`, which then passes. + self.gen_expr(&args[0]); + self.emit(" mov eax, 65535"); + } + "POS" => { + // The argument is ignored, as in GW-BASIC: POS(0) is the idiom + // and any value means the same thing. + self.gen_expr(&args[0]); + self.emit(" call _rt_pos"); + } "ASC" => { self.gen_expr(&args[0]); // The empty string has no first character. This read one diff --git a/src/lexer.rs b/src/lexer.rs index 9a13da2..f49323d 100644 --- a/src/lexer.rs +++ b/src/lexer.rs @@ -73,6 +73,16 @@ fn keyword(s: &str) -> Option { "END" => Some(Token::End), "STOP" => Some(Token::Stop), "READ" => Some(Token::Read), + "DEFINT" => Some(Token::DefType(DataTypeWord::Integer)), + "DEFLNG" => Some(Token::DefType(DataTypeWord::Long)), + "DEFSNG" => Some(Token::DefType(DataTypeWord::Single)), + "DEFDBL" => Some(Token::DefType(DataTypeWord::Double)), + "DEFSTR" => Some(Token::DefType(DataTypeWord::String)), + "BEEP" => Some(Token::Beep), + "SYSTEM" => Some(Token::System), + "LOCATE" => Some(Token::Locate), + "COLOR" => Some(Token::Color), + "RANDOMIZE" => Some(Token::Randomize), "RESTORE" => Some(Token::Restore), "CLS" => Some(Token::Cls), "OPEN" => Some(Token::Open), @@ -84,6 +94,8 @@ fn keyword(s: &str) -> Option { "OR" => Some(Token::Or), "NOT" => Some(Token::Not), "XOR" => Some(Token::Xor), + "EQV" => Some(Token::Eqv), + "IMP" => Some(Token::Imp), "MOD" => Some(Token::Mod), "USING" => Some(Token::Using), "SWAP" => Some(Token::Swap), @@ -101,6 +113,19 @@ fn keyword(s: &str) -> Option { } } +/// The type a `DEF*` statement names. +/// +/// Spelled out here rather than reusing the parser's `DataType` so the lexer +/// keeps no dependency on the parser. +#[derive(Debug, Clone, Copy, PartialEq, Eq)] +pub enum DataTypeWord { + Integer, + Long, + Single, + Double, + String, +} + #[derive(Debug, Clone, PartialEq)] pub enum Token { // Literals @@ -148,6 +173,13 @@ pub enum Token { /// See `Lexer::read_data_text` for why it is not tokenized. DataText(String), Read, + /// `DEFINT`/`DEFLNG`/`DEFSNG`/`DEFDBL`/`DEFSTR`, carrying which one. + DefType(DataTypeWord), + Beep, + System, + Locate, + Color, + Randomize, Restore, Cls, Open, @@ -159,6 +191,8 @@ pub enum Token { Or, Not, Xor, + Eqv, + Imp, Mod, Using, Swap, diff --git a/src/parser.rs b/src/parser.rs index eeec215..adf31ec 100644 --- a/src/parser.rs +++ b/src/parser.rs @@ -3,7 +3,7 @@ // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT -use crate::lexer::Token; +use crate::lexer::{DataTypeWord, Token}; use std::collections::{HashSet, VecDeque}; /// Binary operator precedence levels (higher = tighter binding) @@ -16,28 +16,32 @@ use std::collections::{HashSet, VecDeque}; /// Returns (precedence, BinaryOp) or None if not a binary operator fn binary_op_info(token: &Token) -> Option<(u8, BinaryOp)> { match token { - // Precedence 1: logical OR and XOR (lowest), which share a level - Token::Or => Some((1, BinaryOp::Or)), - Token::Xor => Some((1, BinaryOp::Xor)), - // Precedence 2: logical AND - Token::And => Some((2, BinaryOp::And)), - // Precedence 3 is NOT, a prefix operator; see `parse_prec_inner`. - // Precedence 4: comparison + // Precedence 1: implication (lowest) + Token::Imp => Some((1, BinaryOp::Imp)), + // Precedence 2: equivalence + Token::Eqv => Some((2, BinaryOp::Eqv)), + // Precedence 3: logical OR and XOR, which share a level + Token::Or => Some((3, BinaryOp::Or)), + Token::Xor => Some((3, BinaryOp::Xor)), + // Precedence 4: logical AND + Token::And => Some((4, BinaryOp::And)), + // Precedence 5 is NOT, a prefix operator; see `parse_prec_inner`. + // Precedence 6: comparison Token::Eq => Some((CMP_PREC, BinaryOp::Eq)), Token::Ne => Some((CMP_PREC, BinaryOp::Ne)), Token::Lt => Some((CMP_PREC, BinaryOp::Lt)), Token::Gt => Some((CMP_PREC, BinaryOp::Gt)), Token::Le => Some((CMP_PREC, BinaryOp::Le)), Token::Ge => Some((CMP_PREC, BinaryOp::Ge)), - // Precedence 5: additive - Token::Plus => Some((5, BinaryOp::Add)), - Token::Minus => Some((5, BinaryOp::Sub)), - // Precedence 6: multiplicative - Token::Star => Some((6, BinaryOp::Mul)), - Token::Slash => Some((6, BinaryOp::Div)), - Token::Backslash => Some((6, BinaryOp::IntDiv)), - Token::Mod => Some((6, BinaryOp::Mod)), - // Precedence 7: power + // Precedence 7: additive + Token::Plus => Some((7, BinaryOp::Add)), + Token::Minus => Some((7, BinaryOp::Sub)), + // Precedence 8: multiplicative + Token::Star => Some((8, BinaryOp::Mul)), + Token::Slash => Some((8, BinaryOp::Div)), + Token::Backslash => Some((8, BinaryOp::IntDiv)), + Token::Mod => Some((8, BinaryOp::Mod)), + // Precedence 9: power Token::Caret => Some((POWER_PREC, BinaryOp::Pow)), _ => None, } @@ -48,10 +52,10 @@ fn binary_op_info(token: &Token) -> Option<(u8, BinaryOp)> { /// Named because `NOT` sits directly below it: `NOT` takes an operand at this /// level, which is what makes `NOT A = B` group as `NOT (A = B)` while /// `NOT A AND B` groups as `(NOT A) AND B`. -const CMP_PREC: u8 = 4; +const CMP_PREC: u8 = 6; /// Precedence of `^`, the tightest-binding binary operator. -const POWER_PREC: u8 = 7; +const POWER_PREC: u8 = 9; /// How deeply expressions and blocks may nest before the parser gives up. /// @@ -221,6 +225,37 @@ pub enum StmtKind { }, Data(Vec), Read(Vec), + /// `DEFINT A-Z` and friends -- the default type for unsuffixed names whose + /// first letter falls in one of the ranges. + /// + /// Held as (first, last) inclusive letter pairs, already upper-cased. + DefType { + ty: DataType, + ranges: Vec<(char, char)>, + }, + /// `BEEP` -- ring the terminal bell. + Beep, + /// `ERASE a, b` -- release arrays so they can be dimensioned again. + Erase(Vec), + /// `LOCATE [row][, col]` -- move the cursor. + /// + /// Either part may be omitted, in which case that coordinate is left where + /// it is; GW-BASIC also takes cursor-shape arguments, which have no meaning + /// on a terminal and are refused. + Locate { + row: Option, + col: Option, + }, + /// `COLOR fg[, bg]` -- set the text colours. + Color { + fg: Option, + bg: Option, + }, + /// `RANDOMIZE [expr]` -- reseed the random number generator. + /// + /// GW-BASIC prompts for a seed when none is given; a compiled program has + /// nobody to prompt, so `None` means "seed from the clock". + Randomize(Option), Restore(Option), Cls, SelectCase { @@ -439,6 +474,10 @@ pub enum BinaryOp { And, Or, Xor, + /// Bitwise equivalence: `NOT (a XOR b)`. + Eqv, + /// Bitwise implication: `(NOT a) OR b`. + Imp, } /// BASIC data types following GW-BASIC/QuickBASIC conventions @@ -682,6 +721,18 @@ fn token_spelling(tok: &Token) -> Option<&'static str> { Token::Stop => "STOP", Token::DataText(_) => "DATA", Token::Read => "READ", + Token::DefType(w) => match w { + DataTypeWord::Integer => "DEFINT", + DataTypeWord::Long => "DEFLNG", + DataTypeWord::Single => "DEFSNG", + DataTypeWord::Double => "DEFDBL", + DataTypeWord::String => "DEFSTR", + }, + Token::Beep => "BEEP", + Token::System => "SYSTEM", + Token::Locate => "LOCATE", + Token::Color => "COLOR", + Token::Randomize => "RANDOMIZE", Token::Restore => "RESTORE", Token::Cls => "CLS", Token::Open => "OPEN", @@ -693,6 +744,8 @@ fn token_spelling(tok: &Token) -> Option<&'static str> { Token::Or => "OR", Token::Not => "NOT", Token::Xor => "XOR", + Token::Eqv => "EQV", + Token::Imp => "IMP", Token::Mod => "MOD", Token::Using => "USING", Token::Swap => "SWAP", @@ -1270,6 +1323,19 @@ impl Parser { Token::Function => self.parse_function(), Token::DataText(text) => self.parse_data(&text), Token::Read => self.parse_read(), + Token::DefType(w) => self.parse_def_type(w), + Token::Beep => { + self.advance(); + Ok(StmtKind::Beep) + } + // SYSTEM ends the program, which is what END already means. + Token::System => { + self.advance(); + Ok(StmtKind::End) + } + Token::Locate => self.parse_locate(), + Token::Color => self.parse_color(), + Token::Randomize => self.parse_randomize(), Token::Restore => self.parse_restore(), Token::Cls => { self.advance(); @@ -1304,6 +1370,7 @@ impl Parser { "LOCK" if self.next_is(Token::Hash) => self.parse_lock(false), "UNLOCK" if self.next_is(Token::Hash) => self.parse_lock(true), "CALL" if self.next_is_ident() => self.parse_call(), + "ERASE" if self.next_is_ident() => self.parse_erase(), "LSET" if self.next_is_ident() => self.parse_set_field(false), "RSET" if self.next_is_ident() => self.parse_set_field(true), _ => self.parse_assignment_or_call(), @@ -2578,6 +2645,149 @@ impl Parser { Ok(StmtKind::Read(vars)) } + /// `ERASE A, B` -- one or more array names. + /// + /// Contextual rather than reserved, like CALL above it: LANGREF's own + /// `ON ... GOSUB Draw, Erase` example uses the word as a label, and a + /// reserved ERASE would take that name away from every program. + fn parse_erase(&mut self) -> PResult { + self.advance(); // consume ERASE + let mut names = Vec::new(); + loop { + let Token::Ident(name) = self.advance() else { + return err("ERASE needs an array name"); + }; + names.push(name); + if matches!(self.peek(), Token::Comma) { + self.advance(); + } else { + break; + } + } + Ok(StmtKind::Erase(names)) + } + + /// `LOCATE row, col`, `LOCATE row`, `LOCATE , col`. + fn parse_locate(&mut self) -> PResult { + self.advance(); // consume LOCATE + let (row, col) = self.parse_two_optional_args()?; + if row.is_none() && col.is_none() { + return err("LOCATE needs a row, a column, or both"); + } + Ok(StmtKind::Locate { row, col }) + } + + /// `COLOR fg, bg`, `COLOR fg`, `COLOR , bg`. + fn parse_color(&mut self) -> PResult { + self.advance(); // consume COLOR + let (fg, bg) = self.parse_two_optional_args()?; + if fg.is_none() && bg.is_none() { + return err("COLOR needs a foreground, a background, or both"); + } + // GW-BASIC's third argument is the border colour, which a terminal has + // no equivalent for. + if matches!(self.peek(), Token::Comma) { + return err("COLOR takes a foreground and a background; a terminal has no border"); + } + Ok(StmtKind::Color { fg, bg }) + } + + /// `a, b` where either side may be left out -- the shape LOCATE and COLOR + /// share. + fn parse_two_optional_args(&mut self) -> PResult<(Option, Option)> { + let ends = |t: &Token| matches!(t, Token::Newline | Token::Colon | Token::Eof); + let first = if matches!(self.peek(), Token::Comma) || ends(self.peek()) { + None + } else { + Some(self.parse_expression()?) + }; + let second = if matches!(self.peek(), Token::Comma) { + self.advance(); + if ends(self.peek()) { + None + } else { + Some(self.parse_expression()?) + } + } else { + None + }; + Ok((first, second)) + } + + /// `DEFINT A-Z`, `DEFSTR S`, `DEFINT A, C-E`. + /// + /// Each clause is a single letter or an inclusive range of them. The lexer + /// has already upper-cased the identifiers, so `a-z` and `A-Z` arrive the + /// same. + fn parse_def_type(&mut self, word: DataTypeWord) -> PResult { + self.advance(); // consume DEFINT/DEFLNG/... + let ty = match word { + DataTypeWord::Integer => DataType::Integer, + DataTypeWord::Long => DataType::Long, + DataTypeWord::Single => DataType::Single, + DataTypeWord::Double => DataType::Double, + DataTypeWord::String => DataType::String, + }; + + let mut ranges = Vec::new(); + loop { + let first = self.def_type_letter()?; + let last = if matches!(self.peek(), Token::Minus) { + self.advance(); + self.def_type_letter()? + } else { + first + }; + if last < first { + return err(format!( + "the letter range {}-{} runs backwards", + first, last + )); + } + ranges.push((first, last)); + if matches!(self.peek(), Token::Comma) { + self.advance(); + } else { + break; + } + } + Ok(StmtKind::DefType { ty, ranges }) + } + + /// One letter of a `DEF*` range. + /// + /// A single letter lexes as an identifier, so this checks the length here + /// rather than trusting the token. + fn def_type_letter(&mut self) -> PResult { + let tok = self.advance(); + if let Token::Ident(name) = &tok { + let mut chars = name.chars(); + if let (Some(c), None) = (chars.next(), chars.next()) { + if c.is_ascii_alphabetic() { + return Ok(c); + } + } + } + err(format!( + "expected a single letter in the range, got {}", + describe_token(&tok) + )) + } + + /// `RANDOMIZE`, `RANDOMIZE n`, `RANDOMIZE TIMER`. + /// + /// `TIMER` needs no special case: it is an ordinary builtin, so the general + /// expression form covers it. + fn parse_randomize(&mut self) -> PResult { + self.advance(); // consume RANDOMIZE + let seed = if matches!(self.peek(), Token::Newline | Token::Colon | Token::Eof) { + None + } else { + Some(self.parse_expression()?) + }; + Ok(StmtKind::Randomize(seed)) + } + fn parse_restore(&mut self) -> PResult { self.advance(); // consume RESTORE let target = if matches!(self.peek(), Token::Integer(_) | Token::Ident(_)) { diff --git a/src/runtime/sysv/data_defs.s b/src/runtime/sysv/data_defs.s index d79f4e6..a8854e7 100644 --- a/src/runtime/sysv/data_defs.s +++ b/src/runtime/sysv/data_defs.s @@ -28,7 +28,12 @@ _fmt_input_str: .asciz "%1023[^\n]" _fmt_hex: .asciz "%llX" _fmt_oct: .asciz "%llo" _rng_state: .quad 0x12345678DEADBEEF +_rng_last: .quad 0 # last value RND returned, for RND(0) _cls_seq: .asciz "\033[2J\033[H" +_locate_fmt: .asciz "\033[%d;%dH" +_date_fmt: .asciz "%m-%d-%Y" +_time_fmt: .asciz "%H:%M:%S" +_color_fmt: .asciz "\033[%d;%dm" _redo_msg: .asciz "?Redo from start\n" # Scratch buffers. These start as zeros, so they belong in .bss: in .data diff --git a/src/runtime/sysv/math.s b/src/runtime/sysv/math.s index fb6d54f..f416603 100644 --- a/src/runtime/sysv/math.s +++ b/src/runtime/sysv/math.s @@ -39,6 +39,29 @@ _rt_rnd: push rbp mov rbp, rsp + # GW-BASIC's argument selects the behaviour: + # RND(<0) reseeds from that value and returns the next number + # RND(0) returns the previous number again + # RND(>0), and a bare RND, return the next number + # The argument used to be ignored entirely, so RND(0) advanced like any + # other call and RND(-1) -- the idiom for a repeatable run -- did nothing. + xorpd xmm1, xmm1 + ucomisd xmm0, xmm1 + jp .Lrnd_next # NaN: treat as "next" + je .Lrnd_repeat + jb .Lrnd_reseed + jmp .Lrnd_next + +.Lrnd_reseed: + call _rt_randomize # consumes xmm0, leaves the state seeded + jmp .Lrnd_next + +.Lrnd_repeat: + movsd xmm0, QWORD PTR [rip + _rng_last] + leave + ret + +.Lrnd_next: # Load current state mov rax, QWORD PTR [rip + _rng_state] # Xorshift64 algorithm @@ -62,6 +85,205 @@ _rt_rnd: mov rcx, 0x3FF0000000000000 movq xmm1, rcx subsd xmm0, xmm1 # result = [1,2) - 1.0 = [0,1) + # Remember it, so that RND(0) can hand back the same number. + movsd QWORD PTR [rip + _rng_last], xmm0 + leave + ret + +# _rt_randomize - RANDOMIZE: set the generator's seed +# +# The state was a fixed constant with no way to change it, so every run of every +# program produced the same numbers -- a dice game rolled the same dice every +# time it was played. +# +# The seed's bit pattern is passed through a splitmix64 avalanche rather than +# used directly: BASIC seeds are small integers, and xorshift64 started from a +# small state produces a visibly poor first few values. Zero is replaced, +# because it is xorshift's fixed point and would return 0 forever. +# +# Arguments: xmm0 = seed +# Returns: nothing +.globl _rt_randomize +_rt_randomize: + push rbp + mov rbp, rsp + movq rax, xmm0 + mov rcx, 0x9E3779B97F4A7C15 + add rax, rcx + mov rcx, rax + shr rcx, 30 + xor rax, rcx + mov rcx, 0xBF58476D1CE4E5B9 + imul rax, rcx + mov rcx, rax + shr rcx, 27 + xor rax, rcx + mov rcx, 0x94D049BB133111EB + imul rax, rcx + mov rcx, rax + shr rcx, 31 + xor rax, rcx + test rax, rax + jnz .Lrandomize_store + mov rax, 0x12345678DEADBEEF # xorshift64 must never hold zero +.Lrandomize_store: + mov QWORD PTR [rip + _rng_state], rax + leave + ret + +# _rt_beep - BEEP: ring the terminal bell +# +# Arguments: none Returns: nothing +.globl _rt_beep +_rt_beep: + push rbp + mov rbp, rsp + mov edi, 7 # BEL + call putchar + leave + ret + +# _rt_date - DATE$: the date as MM-DD-YYYY, GW-BASIC's shape +# +# Arguments: none +# Returns: rax = pointer, rdx = length +.globl _rt_date +_rt_date: + push rbp + mov rbp, rsp + sub rsp, 16 + lea rdi, [rsp] + call time + lea rdi, [rsp] + call localtime + mov rcx, rax # struct tm * + lea rdi, [rip + _num_buf] + mov rsi, 64 + lea rdx, [rip + _date_fmt] + call strftime + lea rdi, [rip + _num_buf] + mov rsi, rax + leave + jmp _rt_strdup # the caller may hold another such result + +# _rt_time - TIME$: the time as HH:MM:SS +# +# Arguments: none +# Returns: rax = pointer, rdx = length +.globl _rt_time +_rt_time: + push rbp + mov rbp, rsp + sub rsp, 16 + lea rdi, [rsp] + call time + lea rdi, [rsp] + call localtime + mov rcx, rax # struct tm * + lea rdi, [rip + _num_buf] + mov rsi, 64 + lea rdx, [rip + _time_fmt] + call strftime + lea rdi, [rip + _num_buf] + mov rsi, rax + leave + jmp _rt_strdup # the caller may hold another such result + +# _rt_pos - POS(n): the column the next character will be written to +# +# The tracker counts characters already on the line, and BASIC columns start at +# one, so this is that count plus one. +# +# Arguments: none +# Returns: eax = column (1-based) +.globl _rt_pos +_rt_pos: + push rbp + mov rbp, rsp + lea rax, [rip + _file_col] + mov rax, QWORD PTR [rax] + inc rax + leave + ret + +# _rt_locate - LOCATE row, col: move the cursor +# +# Written as an ANSI escape, the same way _rt_cls clears the screen. The column +# tracker is updated to match, so that a following TAB or PRINT zone counts from +# where the cursor actually is. +# +# Arguments: rdi = row (1-based), rsi = column (1-based) +# Returns: nothing +.globl _rt_locate +_rt_locate: + push rbp + mov rbp, rsp + push rbx + sub rsp, 8 # keep rsp 16-byte aligned across the call + + mov rbx, rsi # remember the column + mov rdx, rsi + mov rsi, rdi + lea rdi, [rip + _locate_fmt] + xor eax, eax + call printf + + # The tracker counts characters before the cursor, so column 1 is 0. + dec rbx + lea rax, [rip + _file_col] + mov QWORD PTR [rax], rbx + + add rsp, 8 + pop rbx + leave + ret + +# _rt_color - COLOR foreground, background +# +# GW-BASIC numbers 0-15 with 8-15 as the bright half; ANSI splits that into two +# ranges, 30-37 and 90-97 for the foreground and 40-47 and 100-107 for the +# background. Values outside 0-15 are left to the terminal. +# +# Arguments: rdi = foreground, rsi = background +# Returns: nothing +.globl _rt_color +_rt_color: + push rbp + mov rbp, rsp + push rbx + sub rsp, 8 # keep rsp 16-byte aligned across the call + + # Foreground: 0-7 -> 30-37, 8-15 -> 90-97 + mov rax, rdi + cmp rax, 8 + jl .Lcolor_fg_normal + sub rax, 8 + add rax, 90 + jmp .Lcolor_fg_done +.Lcolor_fg_normal: + add rax, 30 +.Lcolor_fg_done: + mov rbx, rax + + # Background: 0-7 -> 40-47, 8-15 -> 100-107 + mov rax, rsi + cmp rax, 8 + jl .Lcolor_bg_normal + sub rax, 8 + add rax, 100 + jmp .Lcolor_bg_done +.Lcolor_bg_normal: + add rax, 40 +.Lcolor_bg_done: + + mov rdx, rax + mov rsi, rbx + lea rdi, [rip + _color_fmt] + xor eax, eax + call printf + + add rsp, 8 + pop rbx leave ret @@ -117,6 +339,11 @@ _rt_timer: _rt_cls: push rbp mov rbp, rsp + # Home the column tracker too. The cursor is at column 1 after this, and a + # later TAB that believed the old column emitted a newline to reach a + # column it had already passed. + lea rax, [rip + _file_col] + mov QWORD PTR [rax], 0 lea rdi, [rip + _cls_seq] # ANSI escape sequence xor eax, eax # no vector args call printf diff --git a/src/runtime/win64-native/data_defs.s b/src/runtime/win64-native/data_defs.s index cd934ad..47e390f 100644 --- a/src/runtime/win64-native/data_defs.s +++ b/src/runtime/win64-native/data_defs.s @@ -29,7 +29,8 @@ _fmt_g9: .asciz "%.9g" .p2align 3 _fmt_g_single_table: .quad _fmt_g6, _fmt_g7, _fmt_g8, _fmt_g9, 0 _redo_msg: .ascii "?Redo from start\r\n" -.equ _redo_msg_len, . - _redo_msg +# Bracketed rather than measured by the assembler; see _cls_seq in math.s. +_redo_msg_end: # Error messages # Lengths are computed by the assembler (. - label), never hand-counted: a @@ -45,4 +46,5 @@ _redo_msg: .ascii "?Redo from start\r\n" .bss .p2align 3 _num_buf: .skip 64 +_console_mode: .skip 4 # GetConsoleMode's output, for the VT enable diff --git a/src/runtime/win64-native/input.s b/src/runtime/win64-native/input.s index f964c22..7bc602e 100644 --- a/src/runtime/win64-native/input.s +++ b/src/runtime/win64-native/input.s @@ -171,7 +171,8 @@ _rt_input_number: .Linput_num_redo: lea rcx, [rip + _redo_msg] - mov rdx, _redo_msg_len + lea rdx, [rip + _redo_msg_end] + sub rdx, rcx # length, from the data's own labels call _rt_con_string jmp .Linput_num_try diff --git a/src/runtime/win64-native/math.s b/src/runtime/win64-native/math.s index 89a0a04..f3c87a4 100644 --- a/src/runtime/win64-native/math.s +++ b/src/runtime/win64-native/math.s @@ -14,8 +14,19 @@ .data _rng_state: .quad 0x12345678DEADBEEF +_rng_last: .quad 0 # last value RND returned, for RND(0) _cls_seq: .ascii "\033[2J\033[H" -.equ _cls_seq_len, . - _cls_seq +# The length is bracketed by labels and subtracted at run time rather than +# computed by the assembler, because this tree has two assemblers: GNU as +# builds it nowhere, and clang builds it on Windows, where `.equ len, . - lbl` +# did not reach WriteFile as 7. Two instructions buy an answer that does not +# depend on which one ran. +_cls_seq_end: +_locate_fmt: .asciz "\033[%d;%dH" +_date_fmt: .asciz "%m-%d-%Y" +_time_fmt: .asciz "%H:%M:%S" +_color_fmt: .asciz "\033[%d;%dm" +_esc_buf: .skip 32 # Zero-filled scratch, so .bss rather than .data -- see data_defs.s. The # .text below restores the section for the code that follows. @@ -40,6 +51,31 @@ _rt_rnd: push rbp mov rbp, rsp + # GW-BASIC's argument selects the behaviour: + # RND(<0) reseeds from that value and returns the next number + # RND(0) returns the previous number again + # RND(>0), and a bare RND, return the next number + # The argument used to be ignored entirely, so RND(0) advanced like any + # other call and RND(-1) -- the idiom for a repeatable run -- did nothing. + xorpd xmm1, xmm1 + ucomisd xmm0, xmm1 + jp .Lrnd_next # NaN: treat as "next" + je .Lrnd_repeat + jb .Lrnd_reseed + jmp .Lrnd_next + +.Lrnd_reseed: + sub rsp, 32 # shadow space for the call + call _rt_randomize # consumes xmm0, leaves the state seeded + add rsp, 32 + jmp .Lrnd_next + +.Lrnd_repeat: + movsd xmm0, QWORD PTR [rip + _rng_last] + leave + ret + +.Lrnd_next: # Load current state mov rax, QWORD PTR [rip + _rng_state] @@ -70,6 +106,237 @@ _rt_rnd: movq xmm1, rcx subsd xmm0, xmm1 + # Remember it, so that RND(0) can hand back the same number. + movsd QWORD PTR [rip + _rng_last], xmm0 + + leave + ret + +# _rt_beep - BEEP: ring the terminal bell +# +# Arguments: none Returns: nothing +.globl _rt_beep +_rt_beep: + push rbp + mov rbp, rsp + sub rsp, 32 + mov ecx, 7 # BEL + call putchar + add rsp, 32 + leave + ret + +# _rt_date - DATE$: the date as MM-DD-YYYY, GW-BASIC's shape +# +# Arguments: none +# Returns: rax = pointer, rdx = length +.globl _rt_date +_rt_date: + push rbp + mov rbp, rsp + sub rsp, 48 # shadow space + a time_t + lea rcx, [rsp + 32] + call time + lea rcx, [rsp + 32] + call localtime + mov r9, rax # struct tm * + lea rcx, [rip + _num_buf] + mov rdx, 64 + lea r8, [rip + _date_fmt] + call strftime + lea rcx, [rip + _num_buf] + mov rdx, rax + add rsp, 48 + leave + jmp _rt_strdup # the caller may hold another such result + +# _rt_time - TIME$: the time as HH:MM:SS +# +# Arguments: none +# Returns: rax = pointer, rdx = length +.globl _rt_time +_rt_time: + push rbp + mov rbp, rsp + sub rsp, 48 # shadow space + a time_t + lea rcx, [rsp + 32] + call time + lea rcx, [rsp + 32] + call localtime + mov r9, rax # struct tm * + lea rcx, [rip + _num_buf] + mov rdx, 64 + lea r8, [rip + _time_fmt] + call strftime + lea rcx, [rip + _num_buf] + mov rdx, rax + add rsp, 48 + leave + jmp _rt_strdup # the caller may hold another such result + +# _rt_pos - POS(n): the column the next character will be written to +# +# The tracker counts characters already on the line, and BASIC columns start at +# one, so this is that count plus one. +# +# Arguments: none +# Returns: eax = column (1-based) +.globl _rt_pos +_rt_pos: + push rbp + mov rbp, rsp + lea rax, [rip + _file_col] + mov rax, QWORD PTR [rax] + inc rax + leave + ret + +# _rt_locate - LOCATE row, col: move the cursor +# +# Written as an ANSI escape, the same way _rt_cls clears the screen. The column +# tracker is updated to match, so that a following TAB or PRINT zone counts from +# where the cursor actually is. +# +# Arguments: rcx = row (1-based), rdx = column (1-based) +# Returns: nothing +.globl _rt_locate +_rt_locate: + push rbp + mov rbp, rsp + push rbx + push r12 + sub rsp, 48 # shadow space + the 5th WriteFile argument + + mov r12, rdx # column, kept for the tracker + + # sprintf(_esc_buf, _locate_fmt, row, col) + mov r8, rcx # row + mov r9, rdx # col + lea rcx, [rip + _esc_buf] + lea rdx, [rip + _locate_fmt] + call sprintf + mov rbx, rax # length written + + mov ecx, STD_OUTPUT_HANDLE + call GetStdHandle + mov rcx, rax + lea rdx, [rip + _esc_buf] + mov r8, rbx + lea r9, [rip + _cls_bytes_written] + mov QWORD PTR [rsp + 32], 0 + call WriteFile + + # The tracker counts characters before the cursor, so column 1 is 0. + dec r12 + lea rax, [rip + _file_col] + mov QWORD PTR [rax], r12 + + add rsp, 48 + pop r12 + pop rbx + leave + ret + +# _rt_color - COLOR foreground, background +# +# GW-BASIC numbers 0-15 with 8-15 as the bright half; ANSI splits that into two +# ranges, 30-37 and 90-97 for the foreground and 40-47 and 100-107 for the +# background. Values outside 0-15 are left to the terminal. +# +# Arguments: rcx = foreground, rdx = background +# Returns: nothing +.globl _rt_color +_rt_color: + push rbp + mov rbp, rsp + push rbx + push r12 + sub rsp, 48 # shadow space + the 5th WriteFile argument + + # Foreground: 0-7 -> 30-37, 8-15 -> 90-97 + mov rax, rcx + cmp rax, 8 + jl .Lwcolor_fg_normal + sub rax, 8 + add rax, 90 + jmp .Lwcolor_fg_done +.Lwcolor_fg_normal: + add rax, 30 +.Lwcolor_fg_done: + mov r12, rax + + # Background: 0-7 -> 40-47, 8-15 -> 100-107 + mov rax, rdx + cmp rax, 8 + jl .Lwcolor_bg_normal + sub rax, 8 + add rax, 100 + jmp .Lwcolor_bg_done +.Lwcolor_bg_normal: + add rax, 40 +.Lwcolor_bg_done: + + # sprintf(_esc_buf, _color_fmt, fg, bg) + mov r9, rax # background + mov r8, r12 # foreground + lea rcx, [rip + _esc_buf] + lea rdx, [rip + _color_fmt] + call sprintf + mov rbx, rax + + mov ecx, STD_OUTPUT_HANDLE + call GetStdHandle + mov rcx, rax + lea rdx, [rip + _esc_buf] + mov r8, rbx + lea r9, [rip + _cls_bytes_written] + mov QWORD PTR [rsp + 32], 0 + call WriteFile + + add rsp, 48 + pop r12 + pop rbx + leave + ret + +# _rt_randomize - RANDOMIZE: set the generator's seed +# +# The state was a fixed constant with no way to change it, so every run of every +# program produced the same numbers -- a dice game rolled the same dice every +# time it was played. +# +# The seed's bit pattern is passed through a splitmix64 avalanche rather than +# used directly: BASIC seeds are small integers, and xorshift64 started from a +# small state produces a visibly poor first few values. Zero is replaced, +# because it is xorshift's fixed point and would return 0 forever. +# +# Arguments: xmm0 = seed +# Returns: nothing +.globl _rt_randomize +_rt_randomize: + push rbp + mov rbp, rsp + movq rax, xmm0 + mov rcx, 0x9E3779B97F4A7C15 + add rax, rcx + mov rcx, rax + shr rcx, 30 + xor rax, rcx + mov rcx, 0xBF58476D1CE4E5B9 + imul rax, rcx + mov rcx, rax + shr rcx, 27 + xor rax, rcx + mov rcx, 0x94D049BB133111EB + imul rax, rcx + mov rcx, rax + shr rcx, 31 + xor rax, rcx + test rax, rax + jnz .Lrandomize_store + mov rax, 0x12345678DEADBEEF # xorshift64 must never hold zero +.Lrandomize_store: + mov QWORD PTR [rip + _rng_state], rax leave ret @@ -131,6 +398,12 @@ _rt_cls: mov rbp, rsp sub rsp, 48 # Shadow space + stack arg + # Home the column tracker too. The cursor is at column 1 after this, and a + # later TAB that believed the old column emitted a newline to reach a + # column it had already passed. + lea rax, [rip + _file_col] + mov QWORD PTR [rax], 0 + # Get stdout handle mov ecx, STD_OUTPUT_HANDLE call GetStdHandle @@ -138,7 +411,8 @@ _rt_cls: # WriteFile(handle, cls_seq, cls_seq_len, &bytesWritten, NULL) mov rcx, rax # handle lea rdx, [rip + _cls_seq] - mov r8, _cls_seq_len + lea r8, [rip + _cls_seq_end] + sub r8, rdx # length, from the data's own labels lea r9, [rip + _cls_bytes_written] mov QWORD PTR [rsp + 32], 0 call WriteFile diff --git a/src/runtime/win64-native/print.s b/src/runtime/win64-native/print.s index 163a27d..ab47d3f 100644 --- a/src/runtime/win64-native/print.s +++ b/src/runtime/win64-native/print.s @@ -11,6 +11,7 @@ # Win32 API Constants .equ STD_OUTPUT_HANDLE, -11 +.equ ENABLE_VIRTUAL_TERMINAL_PROCESSING, 4 # I/O size constants .equ SINGLE_BYTE, 1 @@ -48,6 +49,28 @@ _rt_platform_init: lea rcx, [rip + _file_handles] mov [rcx], rax + # Turn on VT processing, so the escape sequences CLS, LOCATE and COLOR + # write are acted on rather than printed literally. CLS has emitted them + # since it was written and simply assumed this was already set; on a + # console where it is not, it printed "^[[2J^[[H" and cleared nothing. + # + # Best effort: a failure here means the handle is not a console -- output + # redirected to a file, say -- and the escapes are then just bytes in the + # file, which is what any terminal program does. + mov rcx, [rcx] # the handle just stored + lea rdx, [rip + _console_mode] + call GetConsoleMode + test eax, eax + jz .Lplatform_no_console + lea rax, [rip + _console_mode] + mov ecx, DWORD PTR [rax] + or ecx, ENABLE_VIRTUAL_TERMINAL_PROCESSING + mov edx, ecx + lea rcx, [rip + _file_handles] + mov rcx, [rcx] + call SetConsoleMode +.Lplatform_no_console: + call _rt_init_input leave diff --git a/src/runtime/win64-native/using.s b/src/runtime/win64-native/using.s index d8ed355..5346ff3 100644 --- a/src/runtime/win64-native/using.s +++ b/src/runtime/win64-native/using.s @@ -326,7 +326,9 @@ _rt_print_using_str: test r13, r13 jz .Luse_str_whole - lea rdi, [rip + _using_out] + # r8, not rdi: rdi is callee-saved on Win64 and volatile on System V, so + # scratching it here is invisible on the tree this is not compiled into. + lea r8, [rip + _using_out] xor rcx, rcx .Luse_str_copy: cmp rcx, r13 @@ -334,11 +336,11 @@ _rt_print_using_str: cmp rcx, r12 jae .Luse_str_pad mov al, BYTE PTR [rbx + rcx] - mov BYTE PTR [rdi + rcx], al + mov BYTE PTR [r8 + rcx], al inc rcx jmp .Luse_str_copy .Luse_str_pad: - mov BYTE PTR [rdi + rcx], ' ' + mov BYTE PTR [r8 + rcx], ' ' inc rcx jmp .Luse_str_copy .Luse_str_copied: diff --git a/src/sema.rs b/src/sema.rs index c2e295e..300dd84 100644 --- a/src/sema.rs +++ b/src/sema.rs @@ -73,6 +73,10 @@ const BUILTINS: &[(&str, usize, usize)] = &[ ("MKL$", 1, 1), ("MKS$", 1, 1), ("OCT$", 1, 1), + ("POS", 1, 1), + ("DATE$", 0, 0), + ("TIME$", 0, 0), + ("FRE", 1, 1), ("RIGHT$", 2, 2), ("RTRIM$", 1, 1), ("RND", 0, 1), @@ -109,26 +113,15 @@ const UNSUPPORTED: &[(&str, &str)] = &[ ("ERL", "error trapping is not implemented yet"), ("ERROR", "error trapping is not implemented yet"), ("RESUME", "error trapping is not implemented yet"), - ("DATE$", "DATE$ is not implemented yet"), - ("TIME$", "TIME$ is not implemented yet"), ( "INKEY$", "INKEY$ needs raw console input, which is not implemented yet", ), ("INPUT$", "INPUT$ is not implemented yet"), - ("LOCATE", "console cursor control is not implemented yet"), - ("COLOR", "console colour control is not implemented yet"), ("WIDTH", "console width control is not implemented yet"), ("CSRLIN", "console cursor position is not implemented yet"), - ("POS", "console cursor position is not implemented yet"), ("VIEW", "console windowing is not implemented yet"), - ("BEEP", "BEEP is not implemented yet"), ("SLEEP", "SLEEP is not implemented yet"), - ("RANDOMIZE", "RANDOMIZE is not implemented yet"), - ( - "ERASE", - "ERASE is not implemented yet; REDIM clears an array", - ), ( "SHARED", "SHARED is not implemented; module-level names are already global", @@ -137,32 +130,15 @@ const UNSUPPORTED: &[(&str, &str)] = &[ ("SHELL", "SHELL is not implemented yet"), ("ENVIRON$", "ENVIRON$ is not implemented yet"), ("KILL", "KILL is not implemented yet"), + ("NAME", "NAME is not implemented yet"), ("FILES", "FILES is not implemented yet"), ("CHDIR", "CHDIR is not implemented yet"), ("MKDIR", "MKDIR is not implemented yet"), ("RMDIR", "RMDIR is not implemented yet"), - ("FRE", "FRE is not implemented yet"), - ( - "DEFINT", - "DEFINT is not supported; use a type suffix or DIM ... AS", - ), - ( - "DEFLNG", - "DEFLNG is not supported; use a type suffix or DIM ... AS", - ), - ( - "DEFSNG", - "DEFSNG is not supported; use a type suffix or DIM ... AS", - ), - ( - "DEFDBL", - "DEFDBL is not supported; use a type suffix or DIM ... AS", - ), - ( - "DEFSTR", - "DEFSTR is not supported; use a type suffix or DIM ... AS", - ), - // Permanent non-goals: these describe a machine xbasic64 does not target. + // Refused for now with a reason, rather than a promise about the future. + // Some of these describe a machine xbasic64 does not target -- the 8086's + // memory map, its I/O ports, its display adapters -- and some are simply + // not written yet. ( "PEEK", "direct memory access has no meaning in a 64-bit hosted program", @@ -187,26 +163,23 @@ const UNSUPPORTED: &[(&str, &str)] = &[ ("BLOAD", "memory images are tied to the 8086 memory map"), ("BSAVE", "memory images are tied to the 8086 memory map"), ("SCREEN", "graphics modes are not supported"), - ("PSET", "graphics is not supported"), - ("PRESET", "graphics is not supported"), - ("CIRCLE", "graphics is not supported"), - ("PAINT", "graphics is not supported"), - ("DRAW", "graphics is not supported"), - ("PALETTE", "graphics is not supported"), - ("WINDOW", "graphics is not supported"), - ("PMAP", "graphics is not supported"), - ("POINT", "graphics is not supported"), - ("SOUND", "sound is not supported"), - ("PLAY", "sound is not supported"), + ("PSET", "graphics is not supported by this compiler"), + ("PRESET", "graphics is not supported by this compiler"), + ("CIRCLE", "graphics is not supported by this compiler"), + ("PAINT", "graphics is not supported by this compiler"), + ("DRAW", "graphics is not supported by this compiler"), + ("PALETTE", "graphics is not supported by this compiler"), + ("WINDOW", "graphics is not supported by this compiler"), + ("PMAP", "graphics is not supported by this compiler"), + ("POINT", "graphics is not supported by this compiler"), + ("SOUND", "SOUND is not implemented yet"), + ("PLAY", "PLAY is not implemented yet"), ("PEN", "light-pen input is not supported"), ("STICK", "joystick input is not supported"), ("STRIG", "joystick input is not supported"), - ("KEY", "soft function keys are not supported"), - ( - "LPRINT", - "there is no line printer; PRINT to a file instead", - ), - ("LPOS", "there is no line printer"), + ("KEY", "KEY is not implemented yet"), + ("LPRINT", "LPRINT is not implemented yet"), + ("LPOS", "LPOS is not implemented yet"), ( "CHAIN", "a compiled program cannot load another program's code", @@ -394,7 +367,14 @@ pub struct Diagnostic { /// which meant the same source produced a different AST depending on whether /// its DIM came earlier or later in the file, and ignored scope entirely. pub fn analyze(program: &mut Program) -> (Symbols, Vec) { + apply_default_types(program); + let mut a = Analyzer::default(); + walk_stmts(&program.statements, &mut |stmt| { + if let StmtKind::Erase(names) = &stmt.kind { + a.erased.extend(names.iter().cloned()); + } + }); a.collect(&program.statements, &Scope::Module); a.check_name_collisions(); a.check_return_has_a_gosub(&program.statements); @@ -403,6 +383,252 @@ pub fn analyze(program: &mut Program) -> (Symbols, Vec) { (a.symbols, a.diagnostics) } +/// Give every unsuffixed name the suffix its `DEF*` statement implies. +/// +/// `DEFINT A-Z` makes `X` an INTEGER. Rather than teach the nineteen places that +/// ask "what type is this name" to consult a table -- `DataType::from_suffix` in +/// thirteen of them and `is_string_var` in six more -- this rewrites `X` to `X%` +/// once, up front, and every one of them then answers correctly without +/// changing. Two oracles disagreeing is exactly the bug shape that made +/// `LEN(S)` fail on a `DIM S AS STRING * 4`, and `DEFSTR` would have recreated +/// it precisely. +/// +/// Merging is the correct reading, not a side effect: in GW-BASIC `DEFINT A` +/// makes `A` and `A%` the same variable, and rewriting the first to the second +/// is what makes them share storage here. +/// +/// Two kinds of name are left alone. A builtin is not a variable, so `DEFSTR +/// A-Z` must not turn `LEN` into `LEN$`. A procedure is not one either, and its +/// name has to read the same at its definition and at every call, so both are +/// excluded together rather than half-rewritten. +fn apply_default_types(program: &mut Program) { + let table = collect_def_types(&program.statements); + if table.iter().all(|t| *t == DataType::Double) { + return; // no DEF* in the program, or all of them redundant + } + let procs = procedure_names(&program.statements); + rewrite_names(&mut program.statements, &table, &procs); +} + +/// The default type for each initial letter, `A` first. +/// +/// GW-BASIC applies a `DEF*` from where it appears onwards; this applies it to +/// the whole program. In practice these sit on a listing's first line, and a +/// name whose type changed halfway through a program would be a different +/// variable in every place that reads it. +fn collect_def_types(stmts: &[Stmt]) -> [DataType; 26] { + let mut table = [DataType::Double; 26]; + walk_stmts(stmts, &mut |stmt| { + if let StmtKind::DefType { ty, ranges } = &stmt.kind { + for (first, last) in ranges { + for c in *first..=*last { + table[(c as u8 - b'A') as usize] = *ty; + } + } + } + }); + table +} + +/// Every SUB and FUNCTION name in the program, upper-cased. +fn procedure_names(stmts: &[Stmt]) -> HashSet { + let mut names = HashSet::new(); + walk_stmts(stmts, &mut |stmt| match &stmt.kind { + StmtKind::Sub { name, .. } | StmtKind::Function { name, .. } => { + names.insert(name.clone()); + } + _ => {} + }); + names +} + +/// The suffix `name` should carry, or `None` to leave it alone. +fn defaulted(name: &str, table: &[DataType; 26], procs: &HashSet) -> Option { + if name.ends_with(['%', '&', '!', '#', '$']) { + return None; // an explicit suffix always wins + } + if procs.contains(name) || builtin(name).is_some() { + return None; + } + let first = name.chars().next()?; + if !first.is_ascii_uppercase() { + return None; + } + let suffix = match table[(first as u8 - b'A') as usize] { + DataType::Integer => '%', + DataType::Long => '&', + DataType::Single => '!', + DataType::String => '$', + DataType::Double => return None, // already the default + }; + Some(format!("{}{}", name, suffix)) +} + +/// Rewrite every name that denotes a variable or an array. +/// +/// Record field names and TYPE names are deliberately absent: a field's type +/// comes from its own `AS` clause, and a TYPE name is not a value at all. +fn rewrite_names(stmts: &mut [Stmt], table: &[DataType; 26], procs: &HashSet) { + fn expr(e: &mut Expr, table: &[DataType; 26], procs: &HashSet) { + match e { + Expr::Variable(name) | Expr::ArrayAccess { name, .. } | Expr::FnCall { name, .. } => { + if let Some(renamed) = defaulted(name, table, procs) { + *name = renamed; + } + } + _ => {} + } + match e { + Expr::Unary { operand, .. } => expr(operand, table, procs), + Expr::Binary { left, right, .. } => { + expr(left, table, procs); + expr(right, table, procs); + } + Expr::Field { base, .. } => expr(base, table, procs), + Expr::ArrayAccess { indices, .. } => { + indices.iter_mut().for_each(|i| expr(i, table, procs)) + } + Expr::FnCall { args, .. } => args.iter_mut().for_each(|a| expr(a, table, procs)), + Expr::Literal(_) | Expr::Variable(_) => {} + } + } + + fn lvalue(lv: &mut LValue, table: &[DataType; 26], procs: &HashSet) { + if let Some(renamed) = defaulted(&lv.name, table, procs) { + lv.name = renamed; + } + } + + for stmt in stmts.iter_mut() { + // Every expression the statement holds, including those inside the + // LValues it owns -- `for_each_expr_mut` already visits both. + for_each_expr_mut(stmt, &mut |e| expr(e, table, procs)); + + // The names a statement carries outside an expression, including the + // LValues `for_each_expr_mut` does not reach. + // + // Deliberately without a wildcard, like `for_each_expr_mut` and + // `gen_stmt`: a statement kind that carries a name and is missing here + // keeps the name the program wrote, while every other mention of it is + // renamed, so the two stop matching and the statement silently does + // nothing. `ERASE` did exactly that -- it sat in the wildcard, went on + // naming `A` after `DEFINT A-Z` had made the array `A%`, and erased + // nothing. A new variant is now a compile error until it says which it + // is. + match &mut stmt.kind { + StmtKind::Let { name, .. } | StmtKind::Const { name, .. } => { + if let Some(renamed) = defaulted(name, table, procs) { + *name = renamed; + } + } + StmtKind::For { var, .. } => { + if let Some(renamed) = defaulted(var, table, procs) { + *var = renamed; + } + } + StmtKind::Dim { decls } | StmtKind::Redim { decls, .. } => { + for d in decls.iter_mut() { + // A declarator with an `AS` clause states its own type. + if d.ty.is_none() { + if let Some(renamed) = defaulted(&d.name, table, procs) { + d.name = renamed; + } + } + } + } + StmtKind::Sub { params, .. } | StmtKind::Function { params, .. } => { + for p in params.iter_mut() { + if p.ty.is_none() { + if let Some(renamed) = defaulted(&p.name, table, procs) { + p.name = renamed; + } + } + } + } + StmtKind::Erase(names) => { + for name in names.iter_mut() { + if let Some(renamed) = defaulted(name, table, procs) { + *name = renamed; + } + } + } + StmtKind::Input { vars, .. } | StmtKind::Read(vars) => { + vars.iter_mut().for_each(|v| lvalue(v, table, procs)) + } + StmtKind::LineInput { var, .. } => lvalue(var, table, procs), + StmtKind::Swap(a, b) => { + lvalue(a, table, procs); + lvalue(b, table, procs); + } + StmtKind::MidAssign { target, .. } + | StmtKind::FieldAssign { target, .. } + | StmtKind::SetField { target, .. } => lvalue(target, table, procs), + StmtKind::Field { fields, .. } => fields + .iter_mut() + .for_each(|f| lvalue(&mut f.target, table, procs)), + + // Nothing outside an expression to rename. A procedure call names + // a procedure, a GOTO names a label, and neither is a variable. + StmtKind::Label(_) + | StmtKind::LabelName(_) + | StmtKind::Print { .. } + | StmtKind::If { .. } + | StmtKind::While { .. } + | StmtKind::DoLoop { .. } + | StmtKind::Goto(_) + | StmtKind::Gosub(_) + | StmtKind::Return + | StmtKind::OnGoto { .. } + | StmtKind::OnGosub { .. } + | StmtKind::Call { .. } + | StmtKind::ExitLoop { .. } + | StmtKind::ExitProc + | StmtKind::OptionBase(_) + | StmtKind::TypeDef { .. } + | StmtKind::Data(_) + | StmtKind::DefType { .. } + | StmtKind::Beep + | StmtKind::Locate { .. } + | StmtKind::Color { .. } + | StmtKind::Randomize(_) + | StmtKind::Restore(_) + | StmtKind::Cls + | StmtKind::SelectCase { .. } + | StmtKind::End + | StmtKind::Stop + | StmtKind::Open { .. } + | StmtKind::Close { .. } + | StmtKind::GetPut { .. } + | StmtKind::Lock { .. } => {} + } + + // Nested bodies. + match &mut stmt.kind { + StmtKind::If { + then_branch, + else_branch, + .. + } => { + rewrite_names(then_branch, table, procs); + if let Some(eb) = else_branch { + rewrite_names(eb, table, procs); + } + } + StmtKind::SelectCase { cases, .. } => { + for (_, body) in cases.iter_mut() { + rewrite_names(body, table, procs); + } + } + StmtKind::For { body, .. } + | StmtKind::While { body, .. } + | StmtKind::DoLoop { body, .. } + | StmtKind::Sub { body, .. } + | StmtKind::Function { body, .. } => rewrite_names(body, table, procs), + _ => {} + } + } +} + /// Call `f` for every statement in `stmts`, nested bodies included. fn walk_stmts(stmts: &[Stmt], f: &mut impl FnMut(&Stmt)) { for stmt in stmts { @@ -491,6 +717,15 @@ fn for_each_expr_mut(stmt: &mut Stmt, f: &mut impl FnMut(&mut Expr)) { lvalue(a, f); lvalue(b, f); } + StmtKind::Locate { row, col } => { + row.iter_mut().for_each(&mut *f); + col.iter_mut().for_each(&mut *f); + } + StmtKind::Color { fg, bg } => { + fg.iter_mut().for_each(&mut *f); + bg.iter_mut().for_each(&mut *f); + } + StmtKind::Randomize(seed) => seed.iter_mut().for_each(&mut *f), StmtKind::Const { value, .. } => f(value), StmtKind::FieldAssign { target, value } => { lvalue(target, f); @@ -562,6 +797,9 @@ fn for_each_expr_mut(stmt: &mut Stmt, f: &mut impl FnMut(&mut Expr)) { | StmtKind::ExitProc | StmtKind::OptionBase(_) | StmtKind::TypeDef { .. } + | StmtKind::DefType { .. } + | StmtKind::Beep + | StmtKind::Erase(_) | StmtKind::Data(_) | StmtKind::Restore(_) | StmtKind::Cls @@ -573,6 +811,8 @@ fn for_each_expr_mut(stmt: &mut Stmt, f: &mut impl FnMut(&mut Expr)) { #[derive(Default)] struct Analyzer { symbols: Symbols, + /// Arrays the program ERASEs somewhere, which may therefore be DIMed again. + erased: HashSet, diagnostics: Vec, /// Enclosing loops, innermost last: true for FOR, false for WHILE/DO. loops: Vec, @@ -749,7 +989,7 @@ impl Analyzer { ); } if let Some(prev) = self.symbols.arrays.get(&key) { - if !is_redim { + if !is_redim && !self.erased.contains(&key.1) { self.error( stmt.line, format!("array '{}' is already declared", decl.name), @@ -1384,6 +1624,21 @@ impl Analyzer { } } } + // Codegen skips an ERASE name it cannot resolve, on the grounds + // that sema has already complained. It had not: this arm did not + // exist, so `ERASE TOTLA` for `ERASE TOTAL` compiled clean and + // erased nothing. The lookup is the one every array use gets -- + // the enclosing procedure first, then the module. + StmtKind::Erase(names) => { + for name in names { + if self.symbols.lookup_array(scope, name).is_none() { + self.error( + line, + format!("ERASE needs an array, and '{name}' is not a declared array"), + ); + } + } + } _ => {} } } @@ -2114,6 +2369,8 @@ fn op_name(op: BinaryOp) -> &'static str { BinaryOp::Div => "/", BinaryOp::IntDiv => "\\", BinaryOp::Mod => "MOD", + BinaryOp::Eqv => "EQV", + BinaryOp::Imp => "IMP", BinaryOp::Pow => "^", BinaryOp::Eq => "=", BinaryOp::Ne => "<>", diff --git a/tests/arithmetic/mod.rs b/tests/arithmetic/mod.rs index 3ea72a2..86cd9a2 100644 --- a/tests/arithmetic/mod.rs +++ b/tests/arithmetic/mod.rs @@ -514,3 +514,50 @@ PRINT 2 ^ 3 ^ 2 ^ 1 assert_eq!(lines[4], "2", "division is left to right"); assert_eq!(lines[5], "64", "((2^3)^2)^1"); } + +/// `EQV` and `IMP` are the two remaining logical operators. +/// +/// Neither was a keyword, so `PRINT 1 EQV 1` printed `101` -- the items `1`, +/// an undefined variable named EQV, and `1`. A wrong answer with no +/// diagnostic, in the same family as the bitwise bugs. +#[test] +fn test_eqv_and_imp() { + let output = compile_and_run( + r#" +PRINT -1 EQV -1 +PRINT -1 EQV 0 +PRINT 0 EQV 0 +PRINT 12 EQV 10 +PRINT -1 IMP -1 +PRINT -1 IMP 0 +PRINT 0 IMP -1 +PRINT 0 IMP 0 +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + // EQV is bitwise equivalence: NOT (a XOR b). + assert_eq!(&lines[0..4], &["-1", "0", "-1", "-7"], "EQV"); + // IMP is implication: (NOT a) OR b. + assert_eq!(&lines[4..8], &["-1", "0", "-1", "-1"], "IMP"); +} + +/// They sit below OR and XOR, and IMP below EQV, as GW-BASIC orders them. +#[test] +fn test_eqv_and_imp_precedence() { + let output = compile_and_run( + r#" +A% = 0 : B% = 0 +PRINT A% EQV B% OR B% +PRINT (A% EQV B%) OR B% +PRINT A% EQV (B% OR B%) +PRINT -1 IMP 0 EQV 0 +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + // OR binds tighter, so the first two disagree and the first matches the third. + assert_eq!(lines[0], lines[2], "OR binds tighter than EQV"); + // -1 IMP (0 EQV 0) = -1 IMP -1 = -1 + assert_eq!(lines[3], "-1", "EQV binds tighter than IMP"); +} diff --git a/tests/common/mod.rs b/tests/common/mod.rs index 13c0c1f..d3ca9a2 100644 --- a/tests/common/mod.rs +++ b/tests/common/mod.rs @@ -32,6 +32,29 @@ impl RunOutput { pub fn lines(&self) -> Vec<&str> { self.stdout.trim().lines().collect() } + + /// Panic unless the program ran to completion. + /// + /// [`compile_and_run_raw`] deliberately returns `Ok` whatever the program + /// did, which makes a crash look like truncated output -- and an assertion + /// phrased as "this must not appear" then passes *because* the program + /// died. The CLS test was written that way and stayed green on Windows + /// while the program it ran was aborting with an access violation. + /// + /// Any test that reads stdout for what a statement produced wants this + /// too. The exit code is printed in hex: Windows says what went wrong in + /// it, and 0xC0000005 is not a number the compiler ever chooses. + pub fn assert_ran_to_completion(&self, what: &str) { + assert_eq!( + self.exit_code, + Some(0), + "{what} did not run to completion: exit {:?} (0x{:08X}), stdout {:?}, stderr {:?}", + self.exit_code, + self.exit_code.unwrap_or(-1), + self.stdout, + self.stderr + ); + } } /// A failure of the compiler itself (lexer, parser, sema, codegen, assembler, linker). diff --git a/tests/control/mod.rs b/tests/control/mod.rs index 1b2ba8a..1a1ff43 100644 --- a/tests/control/mod.rs +++ b/tests/control/mod.rs @@ -3,7 +3,7 @@ // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT -use crate::common::compile_and_run; +use crate::common::{compile_and_run, compile_only}; #[test] fn test_for_loops() { @@ -1086,3 +1086,119 @@ PRINT "after" let lines: Vec<&str> = output.trim().lines().collect(); assert_eq!(lines, &["in", "after"]); } + +/// `SYSTEM` ends the program, as `END` does. +#[test] +fn test_system_ends_the_program() { + let run = crate::common::compile_and_run_raw("PRINT \"before\"\nSYSTEM\nPRINT \"after\"\n", "") + .expect("should compile"); + assert_eq!(run.lines(), vec!["before"], "SYSTEM stops the program"); + assert_eq!(run.exit_code, Some(0)); +} + +/// `BEEP` writes the bell character. +#[test] +fn test_beep_rings_the_bell() { + let run = crate::common::compile_and_run_raw("BEEP\n", "").expect("should compile"); + run.assert_ran_to_completion("BEEP"); + assert!( + run.stdout.contains('\u{7}'), + "BEEP writes BEL: {:?}", + run.stdout + ); +} + +/// `ERASE` releases an array so it can be dimensioned again. +#[test] +fn test_erase_allows_a_second_dim() { + let output = compile_and_run( + r#" +DIM A(3) +A(1) = 7 +PRINT A(1) +ERASE A +DIM A(10) +PRINT A(1) +A(9) = 5 +PRINT A(9) +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + assert_eq!( + lines, + &["7", "0", "5"], + "the new array starts zeroed and is larger" + ); +} + +/// The same, under `DEFINT A-Z`. +/// +/// The default-type pass renames every unsuffixed name that a DEF* range +/// covers, so `DIM A(3)` declares `A%` -- but ERASE carried its names outside +/// an expression and outside the list of statements the pass rewrote, so it +/// went on naming `A`. Nothing matched, ERASE quietly did nothing, and the +/// second DIM was rejected as a redeclaration of an array the program had +/// just asked to be rid of. +#[test] +fn test_erase_under_a_def_type_default() { + let output = compile_and_run( + r#" +DEFINT A-Z +DIM A(3) +A(1) = 7 +PRINT A(1) +ERASE A +DIM A(10) +A(9) = 5 +PRINT A(9) +"#, + ) + .unwrap(); + assert_eq!(output.trim().lines().collect::>(), &["7", "5"]); +} + +/// ERASE of something that is not an array is a mistake, not a no-op. +/// +/// Codegen skips a name it cannot resolve to an array, on the grounds that +/// sema has already complained -- which sema did not do, so `ERASE TOTLA` for +/// `ERASE TOTAL` compiled clean and erased nothing. +#[test] +fn test_erase_of_a_non_array_is_diagnosed() { + for source in [ + "ERASE NOSUCH\n", + "X = 5\nERASE X\n", + "DIM A(3)\nERASE A, B\n", + ] { + let err = compile_only(source).expect_err("ERASE of a non-array must be refused"); + assert!( + err.contains("not a declared array"), + "expected an explanation, got: {}", + err.stderr + ); + assert!(err.is_clean_rejection()); + } +} + +/// A procedure's own array is erasable, and a module-level one stays visible +/// from inside a procedure -- the same two-step lookup every array use gets. +#[test] +fn test_erase_resolves_like_any_other_array_use() { + let output = compile_and_run( + r#" +DIM G(3) +SUB Wipe + DIM L(2) + L(0) = 1 + ERASE L + ERASE G + DIM L(4) + DIM G(9) + PRINT "ok" +END SUB +CALL Wipe +"#, + ) + .unwrap(); + assert_eq!(output.trim(), "ok"); +} diff --git a/tests/errors/mod.rs b/tests/errors/mod.rs index 7f2e5d6..671a05f 100644 --- a/tests/errors/mod.rs +++ b/tests/errors/mod.rs @@ -856,18 +856,11 @@ fn test_zero_arg_builtins_are_not_assignable() { #[test] fn test_unimplemented_gwbasic_names_are_diagnosed() { let cases = [ - ("PRINT DATE$\n", "DATE$"), - ("PRINT TIME$\n", "TIME$"), ("A$ = INKEY$\n", "INKEY$"), ("PRINT ERR\n", "ERR"), ("PRINT ERL\n", "ERL"), ("PRINT CSRLIN\n", "CSRLIN"), - ("PRINT FRE(0)\n", "FRE"), ("A$ = INPUT$(3)\n", "INPUT$"), - ("LOCATE 1, 1\n", "LOCATE"), - ("COLOR 7\n", "COLOR"), - ("RANDOMIZE 5\n", "RANDOMIZE"), - ("DEFINT A-Z\n", "DEFINT"), ("PRINT PEEK(0)\n", "PEEK"), ("POKE 0, 1\n", "POKE"), ("SCREEN 13\n", "SCREEN"), @@ -910,11 +903,17 @@ fn test_on_error_goto_is_refused() { } /// Assigning to one of these names is a GW-BASIC statement, not the creation -/// of a variable that happens to be called DATE$. +/// of a variable that happens to be called TIME$ or INKEY$. #[test] fn test_assignment_to_an_unimplemented_name_is_refused() { - let err = compile_only("DATE$ = \"01-01-2026\"\n").expect_err("DATE$ = ... must be refused"); + // Still unimplemented: the refusal explains itself. + let err = compile_only("INKEY$ = \"x\"\n").expect_err("INKEY$ = ... must be refused"); assert!(err.contains("not supported"), "got: {}", err.stderr); + + // Implemented as a function: GW-BASIC's `DATE$ = ...` sets the system + // clock, which this does not do, so it is refused for a different reason. + let err = compile_only("DATE$ = \"01-01-2026\"\n").expect_err("DATE$ = ... must be refused"); + assert!(err.contains("built-in function"), "got: {}", err.stderr); } /// The diagnostic says why, and distinguishes "not yet" from "not ever". @@ -927,12 +926,44 @@ fn test_unsupported_diagnostics_explain_themselves() { err.stderr ); - let err = compile_only("RANDOMIZE 5\n").expect_err("RANDOMIZE must be refused"); + let err = compile_only("PRINT INKEY$\n").expect_err("INKEY$ must be refused"); assert!( err.contains("not implemented yet"), "a planned feature should say so: {}", err.stderr ); + + // Sound was once refused as "not supported", which read as a decision + // rather than a queue position. These are deferred, not declined. + for source in ["SOUND 440, 5\n", "PLAY \"cde\"\n", "LPRINT \"x\"\n"] { + let err = compile_only(source).expect_err("must still be refused"); + assert!( + err.contains("not implemented yet"), + "a deferred feature should say so: {}", + err.stderr + ); + } +} + +/// `NAME` was documented as unimplemented but missing from the table, so it +/// fell through to "unknown subroutine" -- the generic message the table exists +/// to replace. Nothing else distinguishes a name this compiler knows about and +/// has not written from one the program simply misspelled. +#[test] +fn test_documented_unimplemented_names_are_all_in_the_table() { + for source in ["NAME \"a\"\n", "KILL \"a\"\n", "FILES\n", "SHELL \"ls\"\n"] { + let err = compile_only(source).expect_err("must be refused"); + assert!( + err.contains("not implemented yet"), + "expected the table's message, got: {}", + err.stderr + ); + assert!( + !err.contains("unknown subroutine"), + "fell through to the generic message: {}", + err.stderr + ); + } } /// A name cannot be both an array and a procedure, or an array and a builtin. diff --git a/tests/math/mod.rs b/tests/math/mod.rs index cd26244..e527e31 100644 --- a/tests/math/mod.rs +++ b/tests/math/mod.rs @@ -276,3 +276,113 @@ fn seconds_since_midnight_utc() -> f64 { .expect("the clock is after 1970"); (now.as_secs() % 86_400) as f64 + f64::from(now.subsec_millis()) / 1000.0 } + +/// `RANDOMIZE` reseeds, so a program does not replay the same numbers forever. +/// +/// The generator's state was a hardcoded constant and `_rt_rnd` ignored its +/// argument outright, so every run of every program produced the identical +/// sequence — three runs of the same three-dice program printed `939913` each +/// time. A dice game, a shuffle and a maze were all the same on every play, and +/// no statement existed to change that. +#[test] +fn test_randomize_timer_differs_between_runs() { + let source = "RANDOMIZE TIMER\nFOR I = 1 TO 5\nPRINT INT(RND * 1000);\nNEXT I\n"; + let a = compile_and_run(source).unwrap(); + let b = compile_and_run(source).unwrap(); + assert_ne!(a.trim(), b.trim(), "RANDOMIZE TIMER must reseed"); +} + +/// A named seed is reproducible, which is what makes a program debuggable. +#[test] +fn test_randomize_with_a_seed_is_reproducible() { + let source = "RANDOMIZE 42\nFOR I = 1 TO 5\nPRINT INT(RND * 1000);\nNEXT I\n"; + let a = compile_and_run(source).unwrap(); + let b = compile_and_run(source).unwrap(); + assert_eq!(a.trim(), b.trim(), "the same seed must give the same run"); + + let other = + compile_and_run("RANDOMIZE 7\nFOR I = 1 TO 5\nPRINT INT(RND * 1000);\nNEXT I\n").unwrap(); + assert_ne!(a.trim(), other.trim(), "a different seed must differ"); +} + +/// GW-BASIC's `RND` argument selects between three behaviours. +#[test] +fn test_rnd_argument_semantics() { + let output = compile_and_run( + r#" +RANDOMIZE 1 +A = RND +B = RND(0) +C = RND(0) +D = RND(1) +IF A = B THEN PRINT "zero-repeats" ELSE PRINT "zero-advanced" +IF B = C THEN PRINT "zero-stable" ELSE PRINT "zero-moved" +IF A = D THEN PRINT "positive-stuck" ELSE PRINT "positive-advances" +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + assert_eq!( + lines, + &["zero-repeats", "zero-stable", "positive-advances"], + "RND(0) repeats the last value; RND(positive) and bare RND advance" + ); +} + +/// A negative argument reseeds from that value, so it is reproducible without +/// RANDOMIZE — the idiom `X = RND(-1)` at the top of a listing. +#[test] +fn test_rnd_negative_reseeds() { + let source = "X = RND(-1)\nFOR I = 1 TO 3\nPRINT INT(RND * 1000);\nNEXT I\n"; + let a = compile_and_run(source).unwrap(); + let b = compile_and_run(source).unwrap(); + assert_eq!(a.trim(), b.trim(), "the same negative seed replays"); + + let other = + compile_and_run("X = RND(-99)\nFOR I = 1 TO 3\nPRINT INT(RND * 1000);\nNEXT I\n").unwrap(); + assert_ne!(a.trim(), other.trim(), "a different negative seed differs"); +} + +/// Values stay in [0, 1) whichever form is used. +#[test] +fn test_rnd_stays_in_range() { + let output = compile_and_run( + r#" +RANDOMIZE 5 +BAD = 0 +FOR I = 1 TO 200 + R = RND + IF R < 0 OR R >= 1 THEN BAD = BAD + 1 +NEXT I +PRINT BAD +"#, + ) + .unwrap(); + assert_eq!(output.trim(), "0", "every value must be in [0, 1)"); +} + +/// `DATE$` and `TIME$` report the date and time in GW-BASIC's shapes. +#[test] +fn test_date_and_time_strings() { + let output = + compile_and_run("PRINT DATE$\nPRINT TIME$\nPRINT LEN(DATE$); LEN(TIME$)\n").unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + let date = lines[0]; + let time = lines[1]; + assert_eq!(date.len(), 10, "DATE$ is MM-DD-YYYY: {date:?}"); + assert_eq!(&date[2..3], "-", "separators at 3 and 6: {date:?}"); + assert_eq!(&date[5..6], "-", "separators at 3 and 6: {date:?}"); + assert_eq!(time.len(), 8, "TIME$ is HH:MM:SS: {time:?}"); + assert_eq!(&time[2..3], ":", "separators at 3 and 6: {time:?}"); + assert_eq!(&time[5..6], ":", "separators at 3 and 6: {time:?}"); + assert_eq!(lines[2], "108", "and LEN sees them as strings: 10 and 8"); +} + +/// `FRE` reports free memory. A compiled program has no BASIC heap limit, so +/// it answers a large number rather than pretending to run out. +#[test] +fn test_fre_returns_something_plausible() { + let output = + compile_and_run("IF FRE(0) > 1000 THEN PRINT \"plenty\" ELSE PRINT \"tight\"\n").unwrap(); + assert_eq!(output.trim(), "plenty"); +} diff --git a/tests/print/mod.rs b/tests/print/mod.rs index 2c7db83..9adeb21 100644 --- a/tests/print/mod.rs +++ b/tests/print/mod.rs @@ -138,3 +138,134 @@ fn test_tab_and_spc() { "TAB accounts for text already printed" ); } + +/// `LOCATE` positions the cursor, and `COLOR` sets the colours. +/// +/// Both are written as ANSI escapes, which is the model `CLS` already uses on +/// both platforms. The test reads the escape bytes out of stdout rather than +/// looking at a terminal. +#[test] +fn test_locate_and_color_emit_escapes() { + let out = crate::common::compile_and_run_raw( + "LOCATE 5, 10\nPRINT \"x\";\nCOLOR 14, 1\nPRINT \"y\";\n", + "", + ) + .expect("should compile"); + out.assert_ran_to_completion("LOCATE then COLOR"); + assert!( + out.stdout.contains("\u{1b}[5;10H"), + "LOCATE 5,10 should home the cursor there: {:?}", + out.stdout + ); + assert!( + out.stdout.contains('x') && out.stdout.contains('y'), + "the text still prints: {:?}", + out.stdout + ); + assert!( + out.stdout.contains("\u{1b}[") && out.stdout.contains('m'), + "COLOR should emit an SGR sequence: {:?}", + out.stdout + ); +} + +/// `LOCATE` with only a row leaves the column alone, as GW-BASIC does. +#[test] +fn test_locate_row_only() { + let out = crate::common::compile_and_run_raw("LOCATE 7\n", "").expect("should compile"); + out.assert_ran_to_completion("LOCATE with a row only"); + assert!( + out.stdout.contains("\u{1b}[7;"), + "row given, column preserved: {:?}", + out.stdout + ); +} + +/// `POS(0)` reports the column the next character will go to, counting from 1. +#[test] +fn test_pos_reports_the_column() { + let output = compile_and_run( + r#" +PRINT POS(0) +PRINT "abc"; +PRINT POS(0) +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + assert_eq!(lines[0], "1", "a fresh line starts at column 1"); + assert!( + lines[1].ends_with('4'), + "after \"abc\" the column is 4: {lines:?}" + ); +} + +/// `CLS` puts the cursor at home, so the column tracker must agree. +/// +/// It did not: after clearing, `TAB` still believed the column it had before +/// and emitted a spurious newline to reach a column already passed. +#[test] +fn test_cls_resets_the_column() { + let out = crate::common::compile_and_run_raw( + "PRINT \"0123456789012345678901234567890123456789\";\nCLS\nPRINT TAB(5); \"X\"\n", + "", + ) + .expect("should compile"); + // Before this line the test could not fail on a crash: a program that died + // in CLS left nothing after the escape, which is exactly what the + // assertion below wants to see. + out.assert_ran_to_completion("PRINT then CLS then TAB"); + let after_cls = out.stdout.rsplit("\u{1b}[H").next().unwrap_or(""); + assert!( + !after_cls.starts_with('\n'), + "TAB after CLS must not wrap to a new line: {:?}", + out.stdout + ); +} + +/// Every console statement's program runs to completion. +/// +/// Blunt on purpose. These helpers are written twice, and the Win64 half is +/// the one no developer runs -- CI is the only place it executes at all. The +/// tests above read what each statement *wrote*, which a crash can satisfy by +/// writing nothing; this one only asks whether the program survived, which a +/// crash cannot. +#[test] +fn test_console_statements_run_to_completion() { + for (what, source) in [ + ("CLS", "CLS\n"), + ("CLS after PRINT", "PRINT \"x\"\nCLS\n"), + ("CLS twice", "CLS\nCLS\n"), + ("LOCATE", "LOCATE 2, 5\n"), + ("LOCATE row only", "LOCATE 3\n"), + ("LOCATE column only", "LOCATE , 8\n"), + ("COLOR", "COLOR 14, 1\n"), + ("POS", "PRINT POS(0)\n"), + ("BEEP", "BEEP\n"), + ("TIMER", "PRINT TIMER\n"), + ("RANDOMIZE", "RANDOMIZE 42\n"), + ("RANDOMIZE TIMER", "RANDOMIZE TIMER\n"), + ("RND", "PRINT RND\n"), + ("DATE$ and TIME$", "PRINT DATE$\nPRINT TIME$\n"), + ("FRE", "PRINT FRE(0)\n"), + ( + "the lot together", + "CLS\nCOLOR 14, 1\nLOCATE 2, 5\nPRINT \"x\"; POS(0)\n", + ), + ] { + let run = crate::common::compile_and_run_raw(source, "") + .unwrap_or_else(|e| panic!("{what} should compile: {e}")); + run.assert_ran_to_completion(what); + } +} + +/// `LOCATE` also sets the column the tracker believes, for the same reason. +#[test] +fn test_locate_sets_the_column() { + let output = compile_and_run("LOCATE 3, 12\nPRINT POS(0)\n").unwrap(); + // The escape sequence LOCATE wrote precedes the number on the same line. + assert!( + output.trim().ends_with("12"), + "POS should follow LOCATE: {output:?}" + ); +} diff --git a/tests/runtime/mod.rs b/tests/runtime/mod.rs index 809d31a..1199d92 100644 --- a/tests/runtime/mod.rs +++ b/tests/runtime/mod.rs @@ -82,40 +82,109 @@ fn test_runtimes_export_the_same_helpers() { ); } -/// Message lengths must be computed by the assembler, never hand-counted. +/// A message length must not be an assembler constant. /// -/// A hand-counted length was wrong by one and made WriteFile emit a stray -/// byte; a commit "fixing" it changed the correct value to the incorrect one. +/// `.equ len, . - label` reads as the safe way to avoid hand-counting, and it +/// is -- under GNU as, which folds it to an immediate. This tree is assembled +/// by GNU as on Linux and by clang on Windows, and where an assembler cannot +/// prove the symbol absolute it assembles `mov reg, len` as a *memory load +/// from that address* instead. `error.s` says so at the top: it hit this with +/// forward references and now measures its messages at run time. +/// +/// `_cls_seq_len` was the same shape, so every `CLS` on Windows loaded from +/// address 7 and died with an access violation, while Linux ran it as the +/// immediate the source appears to say. Nothing else was wrong with the +/// helper, which is why it took a table of exit codes to find. +/// +/// Bracket the data with labels and subtract at run time instead. Two +/// instructions, and the same answer whichever assembler ran. #[test] -fn test_message_lengths_are_computed() { +fn test_message_lengths_are_not_assembler_constants() { + let mut problems = Vec::new(); + for dir in ["src/runtime/sysv", "src/runtime/win64-native"] { - for entry in std::fs::read_dir(dir).expect("readable runtime directory") { - let path = entry.expect("readable directory entry").path(); - if path.extension().is_none_or(|e| e != "s") { - continue; - } - let text = std::fs::read_to_string(&path).expect("readable .s file"); + for (path, text) in runtime_sources(dir) { for (i, line) in text.lines().enumerate() { - // Both spellings of an assembler constant: `.equ N, v` and - // `N = v`. Only checking `.equ` let a hand-counted `=` through - // in the Win64 tree. let trimmed = line.split('#').next().unwrap_or("").trim(); - let name = match trimmed.strip_prefix(".equ ") { - Some(rest) => rest.split(',').next().unwrap_or("").trim(), + // Both spellings of an assembler constant: `.equ N, v` and + // `N = v`. Only checking `.equ` let one through before. + let (name, value) = match trimmed.strip_prefix(".equ ") { + Some(rest) => match rest.split_once(',') { + Some((n, v)) => (n.trim(), v.trim()), + None => continue, + }, None => match trimmed.split_once('=') { - Some((lhs, _)) if !lhs.trim().contains(char::is_whitespace) => lhs.trim(), + Some((lhs, rhs)) if !lhs.trim().contains(char::is_whitespace) => { + (lhs.trim(), rhs.trim()) + } _ => continue, }, }; - if !name.ends_with("_len") { + // A plain number is fine: it is absolute to any assembler. + // Anything naming a label is not. + let symbolic = value + .split(|c: char| !(c.is_alphanumeric() || c == '_' || c == '.')) + .any(|t| { + !t.is_empty() && !t.chars().all(|c| c.is_ascii_hexdigit() || c == 'x') + }); + if symbolic || value.contains(". -") { + problems.push(format!( + "{path}:{}: `{trimmed}` measures {name} with the assembler. Bracket the \ + data with a `_end` label and subtract at run time: an assembler that \ + cannot prove this absolute turns `mov reg, {name}` into a memory load.", + i + 1 + )); + } + } + } + } + + assert!( + problems.is_empty(), + "{} assembler-computed length(s):\n{}", + problems.len(), + problems.join("\n") + ); +} + +/// An `_end` label must sit directly after the data it bounds. +/// +/// It is the run-time replacement for `. - label`, and it inherits the same +/// hazard: anything inserted between the data and the label is measured as +/// part of the message. Four format strings once were, and `CLS` wrote 75 +/// bytes where it meant to write 7. +#[test] +fn test_end_labels_bound_their_own_data() { + for dir in ["src/runtime/sysv", "src/runtime/win64-native"] { + for (path, text) in runtime_sources(dir) { + let lines: Vec<&str> = text + .lines() + .map(|l| l.split('#').next().unwrap_or("").trim()) + .collect(); + for (i, line) in lines.iter().enumerate() { + let Some(label) = line.strip_suffix(':') else { + continue; + }; + let Some(measured) = label.strip_suffix("_end") else { + continue; + }; + // Only labels that bound something. `.Lfile_past_end` is a + // branch target, and `_rt_end` is a helper whose name happens + // to split this way -- neither has a `_x:` data line to sit + // after. + let bounds_data = lines + .iter() + .any(|l| l.starts_with(&format!("{measured}: ."))); + if !bounds_data { continue; } + let previous = lines[..i].iter().rev().find(|l| !l.is_empty()); assert!( - trimmed.contains(". -"), - "{}:{}: length should be computed with `. - label`, not hand-counted: {}", - path.display(), + previous.is_some_and(|p| p.starts_with(&format!("{measured}:"))), + "{path}:{}: {label} must sit directly after {measured}'s data, but {:?} \ + intervenes -- everything between them is measured as part of the message", i + 1, - trimmed + previous.copied().unwrap_or("") ); } } @@ -197,3 +266,96 @@ fn test_runtime_calls_are_stack_aligned() { problems.join("\n") ); } + +/// A helper must preserve the registers its own ABI calls callee-saved. +/// +/// The lists differ, and that is the whole hazard: `rdi` and `rsi` are +/// callee-saved on Win64 and scratch on System V, so a Win64 helper that uses +/// one as a temporary is wrong in a way no Linux run can show. `_rt_print_using_str` +/// did exactly that, and only survived because the code that calls it happens +/// not to keep anything in `rdi`. +/// +/// Deliberately crude: any `push` of a register anywhere in the helper counts +/// as saving it, and only writes through a named destination are seen. That is +/// enough for hand-written assembly of this shape, and a false negative is +/// better here than a test nobody trusts. +#[test] +fn test_helpers_preserve_callee_saved_registers() { + // `rbp` is excluded: every helper frames with it and restores it via + // `leave`, which this scan would have to model separately to no purpose. + const SYSV_SAVED: &[&str] = &["rbx", "r12", "r13", "r14", "r15"]; + const WIN64_SAVED: &[&str] = &[ + "rbx", "rdi", "rsi", "r12", "r13", "r14", "r15", "xmm6", "xmm7", "xmm8", "xmm9", "xmm10", + "xmm11", "xmm12", "xmm13", "xmm14", "xmm15", + ]; + + // `_rt_random_prepare` returns four values in callee-saved registers and + // says so: it is reached only from GET and PUT, which save them for it. + // A helper listed here has a private convention its own comment states. + const PRIVATE_CONVENTION: &[&str] = &["_rt_random_prepare"]; + + let mut problems = Vec::new(); + + for (dir, saved) in [ + ("src/runtime/sysv", SYSV_SAVED), + ("src/runtime/win64-native", WIN64_SAVED), + ] { + for (path, text) in runtime_sources(dir) { + let mut helper = String::new(); + let mut pushed: BTreeSet = BTreeSet::new(); + let mut used: Vec<(usize, String)> = Vec::new(); + + let mut flush = |helper: &str, pushed: &BTreeSet, used: &[(usize, String)]| { + if PRIVATE_CONVENTION.contains(&helper) { + return; + } + for (line, reg) in used { + if !pushed.contains(reg) { + problems.push(format!( + "{path}:{line}: {helper} writes {reg}, which is callee-saved here, \ + without pushing it" + )); + } + } + }; + + for (i, raw) in text.lines().enumerate() { + let line = raw.split('#').next().unwrap_or("").trim(); + if let Some(name) = line.strip_prefix(".globl ") { + flush(&helper, &pushed, &used); + helper = name.trim().to_string(); + pushed.clear(); + used.clear(); + continue; + } + if let Some(reg) = line.strip_prefix("push ") { + pushed.insert(reg.trim().to_string()); + continue; + } + // ` , ...` -- the destination is what gets written. + let Some((_, rest)) = line.split_once(' ') else { + continue; + }; + let dest = rest.split(',').next().unwrap_or("").trim(); + // 32-bit writes clear the upper half, so they count too. + let full = match dest { + "edi" => "rdi", + "esi" => "rsi", + "ebx" => "rbx", + other => other, + }; + if saved.contains(&full) { + used.push((i + 1, full.to_string())); + } + } + flush(&helper, &pushed, &used); + } + } + + assert!( + problems.is_empty(), + "{} clobbered callee-saved register(s):\n{}", + problems.len(), + problems.join("\n") + ); +} diff --git a/tests/types/mod.rs b/tests/types/mod.rs index e715ccb..651c2f2 100644 --- a/tests/types/mod.rs +++ b/tests/types/mod.rs @@ -439,3 +439,159 @@ PRINT LEN(S) let lines: Vec<&str> = output.trim().lines().collect(); assert_eq!(lines, &["[xy ]", "-1", "4"]); } + +/// `DEFINT A-Z` and friends set the default type for unsuffixed names. +/// +/// `DEFINT A-Z` is the idiomatic first line of a great many listings; without +/// it every unsuffixed variable is a Double, which changes both arithmetic and +/// what PRINT shows. +#[test] +fn test_defint_sets_the_default_type() { + let output = compile_and_run( + r#" +DEFINT A-Z +X = 7 / 2 +PRINT X +Y = 3.7 +PRINT Y +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + // Assignment to an integer truncates here; LANGREF records that as a + // deliberate divergence from GW-BASIC, which rounds. + assert_eq!(lines, &["3", "3"], "7/2 and 3.7 both truncate to 3"); +} + +/// A suffix always wins over the default. +#[test] +fn test_suffix_overrides_the_default_type() { + let output = compile_and_run( + r#" +DEFINT A-Z +X = 3.7 +X# = 3.7 +PRINT X +PRINT X# +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + assert_eq!(lines, &["3", "3.7"], "X is INTEGER, X# is DOUBLE"); +} + +/// Each of the five spellings, over its own letter range. +#[test] +fn test_all_def_type_statements() { + let output = compile_and_run( + r#" +DEFINT I-J +DEFLNG L +DEFSNG S +DEFDBL D +DEFSTR T +I = 3.7 +L = 100000.9 +S = 1 / 3 +D = 1 / 3 +T = "text" +PRINT I +PRINT L +PRINT S +PRINT D +PRINT T +PRINT LEN(T) +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + assert_eq!(lines[0], "3", "DEFINT"); + assert_eq!(lines[1], "100000", "DEFLNG"); + assert_eq!(lines[2], "0.33333334", "DEFSNG carries ~7 digits"); + assert_eq!( + lines[3], "0.3333333333333333", + "DEFDBL carries full precision" + ); + assert_eq!(lines[4], "text", "DEFSTR"); + assert_eq!(lines[5], "4", "and a DEFSTR name is a string to LEN"); +} + +/// In GW-BASIC a defaulted name and the explicitly suffixed one are the same +/// variable, so `DEFINT A` makes `A` and `A%` refer to one storage location. +#[test] +fn test_defaulted_and_suffixed_names_are_the_same_variable() { + let output = compile_and_run( + r#" +DEFINT A +A = 5 +PRINT A% +A% = 9 +PRINT A +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + assert_eq!(lines, &["5", "9"]); +} + +/// A single letter, a range, and several clauses on one statement. +#[test] +fn test_def_type_ranges() { + let output = compile_and_run( + r#" +DEFINT A, C-E +A = 1.7 +B = 1.7 +C = 1.7 +E = 1.7 +F = 1.7 +PRINT A; B; C; E; F +"#, + ) + .unwrap(); + assert_eq!( + output.trim(), + "11.7111.7", + "A, C and E are INTEGER; B and F stay DOUBLE" + ); +} + +/// The default applies inside procedures too, and to arrays. +#[test] +fn test_def_type_reaches_arrays_and_procedures() { + let output = compile_and_run( + r#" +DEFINT A-Z +DIM V(3) +V(1) = 9.7 +PRINT V(1) +SUB Show(N) + PRINT N +END SUB +Show 4.6 +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + assert_eq!( + lines, + &["9", "4"], + "array elements and parameters both default" + ); +} + +/// A builtin's name is not a variable and must not be re-typed by DEF*. +#[test] +fn test_def_type_does_not_touch_builtins() { + let output = compile_and_run( + r#" +DEFSTR A-Z +PRINT LEN("abcd") +PRINT SQR(16) +PRINT MID$("hello", 2, 3) +"#, + ) + .unwrap(); + let lines: Vec<&str> = output.trim().lines().collect(); + assert_eq!(lines, &["4", "4", "ell"]); +}