Port the BASIC interpreter from Go to C
Reproduces deps/basicinterpret in C, in the idiom of the ak* libraries. All 41
.bas files in the reference's corpus produce byte-identical stdout, including
the trailing double newline on an error line -- that comes from basicError
building a string ending in \n and handing it to Println, and
array_outofbounds.txt encodes it.
The corpus is driven in place from the submodule as 41 individual CTest cases
rather than copied, so it cannot drift from upstream. Eighteen unit tests cover
what the corpus cannot reach.
Three structural changes carry most of the work. Go's three reflection lookups
(Command*, Function*, ParseCommand*) become one sorted dispatch table in
src/verbs.c searched with bsearch; adding a verb is a row and two functions. The
five Go maps become one fixed open-addressed table over aksl_strhash_djb2. And
run(), which owned the process until MODE_QUIT, splits into step() plus a
bounded run() -- goal 3 requires a host game to be able to bound execution, and
nothing in the library now terminates the process or touches SDL.
Output goes through an akbasic_TextSink vtable. src/sink_stdio.c is what makes
the corpus runnable with no SDL present; the akgl-backed sink is still to come
and is blocked on libakgl having no text-measurement call.
src/convert.c exists because libakstdlib's aksl_ato* family cannot report a
conversion failure (its TODO.md 2.1.5). The reference checks strconv's error at
four sites and turns it into a BASIC error; routing those through aksl_atoi
would have turned four diagnosable errors into wrong answers, with VAL("garbage")
quietly returning 0. TODO.md 1.9 records which libakstdlib calls are cleared for
use here and which are not.
Reference defects are reproduced, not fixed: the golden files encode the observed
behaviour and a silent correction is a behaviour change. TODO.md section 6 lists
sixteen, and tests/known_reference_defects.c asserts the *correct* contract for
six of them under AKBASIC_KNOWN_FAILING_TESTS, so a fix shows up as
"unexpectedly passed". Five of the sixteen were found by this port and are new:
subtraction stops after one operator so 1-2-3 computes 1-2 and abandons the rest
of the line (a wrong answer, not a refused one); a unary-minus argument inflates
a function's arity so ABS(-9) is rejected; a comparison operator in a line's
final column is dropped; hex literals never survive the scanner; and the
"Reserved word in variable name" check is dead code.
Where the reference reaches undefined behaviour by a route that is defined in Go
-- an out-of-range shift, a negative string multiplier, integer division by zero
-- this raises instead of inheriting the UB. No golden case exercises any of
them.
The top-level CMakeLists shadows add_test, set_tests_properties and
add_custom_target around all three add_subdirectory calls. Without it libakerror's
tests land in our suite as Not Run, and its un-namespaced `coverage` target stops
a coverage build from configuring at all. Test targets are akbasic_test_<name>:
bare test_<name> collides with libakstdlib's, which is what broke libakgl's
configure in c2b16d3.
ctest 59/59; ASan+UBSan 59/59; 92.3% line and 96.9% function coverage; no
warnings under -Wall -Wextra. Branch coverage is not a target, for the reason
libakstdlib and libakgl both record: the akerror macros expand into large branch
trees at every call site.
Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
7
.gitignore
vendored
Normal file
7
.gitignore
vendored
Normal file
@@ -0,0 +1,7 @@
|
||||
# Out-of-tree build directories. Keep them out of the source dir entirely where
|
||||
# you can: gcovr searches for coverage data under --root, so a stale build tree
|
||||
# left here is folded into the report (libakgl defect #13).
|
||||
build*/
|
||||
*.gcda
|
||||
*.gcno
|
||||
*~
|
||||
12
.gitmodules
vendored
Normal file
12
.gitmodules
vendored
Normal file
@@ -0,0 +1,12 @@
|
||||
[submodule "deps/libakerror"]
|
||||
path = deps/libakerror
|
||||
url = https://source.starfort.tech/andrew/libakerror.git
|
||||
[submodule "deps/libakstdlib"]
|
||||
path = deps/libakstdlib
|
||||
url = https://source.starfort.tech/andrew/libakstdlib.git
|
||||
[submodule "deps/libakgl"]
|
||||
path = deps/libakgl
|
||||
url = https://source.starfort.tech/andrew/libakgl.git
|
||||
[submodule "deps/basicinterpret"]
|
||||
path = deps/basicinterpret
|
||||
url = https://source.starfort.tech/andrew/basicinterpreter.git
|
||||
417
CLAUDE.md
Normal file
417
CLAUDE.md
Normal file
@@ -0,0 +1,417 @@
|
||||
# CLAUDE.md
|
||||
|
||||
This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository.
|
||||
|
||||
## What this project is
|
||||
|
||||
`akbasic` is a **C rewrite of the Go BASIC interpreter in `deps/basicinterpret`**, written in the same
|
||||
style as the `ak*` C libraries it builds on.
|
||||
|
||||
The repository is currently **empty apart from its submodules** — no commits, no source tree, no build
|
||||
files. The staged content is `.gitmodules` plus four submodules under `deps/`. Everything below the
|
||||
"Project goals" section describes the material to build from, not code that exists here yet.
|
||||
|
||||
| Submodule | Language | Role |
|
||||
|---|---|---|
|
||||
| `deps/basicinterpret` | Go | The implementation being rewritten; behavioral spec for the port (its `go.mod` is already `module akbasic`) |
|
||||
| `deps/libakerror` | C | TRY/CATCH-style error contexts — the error-handling substrate every other `ak*` library is built on |
|
||||
| `deps/libakstdlib` | C | libc and data-structure wrappers that report through `libakerror` |
|
||||
| `deps/libakgl` | C | SDL3-based game/graphics library (sprites, text, tilemaps, actors, heap) — supplies all multimedia |
|
||||
|
||||
### Project goals
|
||||
|
||||
In priority order:
|
||||
|
||||
1. **Port Go → C.** Reproduce the reference interpreter in C, in the idiom of `libakerror` /
|
||||
`libakstdlib` / `libakgl`: `akerr_ErrorContext *` returns everywhere, fixed-size pools instead of
|
||||
dynamic allocation, library-prefixed symbols, one-file CTest executables. The Go code is already
|
||||
written against static pools and explicit state structs, so it ports fairly directly — resist
|
||||
"improving" it into `malloc`-based data structures. SDL2/SDL2_ttf calls in the Go version become
|
||||
`libakgl` calls (`akgl_text_*`, the renderer, the registry), not raw SDL3 calls.
|
||||
|
||||
2. **Finish the language.** Implement the full Dartmouth BASIC and Commodore 128 BASIC v7 verb and
|
||||
function set. `deps/basicinterpret/README.md` ends with an explicit list of everything unimplemented
|
||||
(`SOUND`, `PLAY`, `ENVELOPE`, `VOL`, `SPRITE`, `MOVSPR`, `GRAPHIC`, `DRAW`, `BOX`, `PAINT`,
|
||||
`WINDOW`, `GETKEY`, `DO`/`LOOP`/`WHILE`/`UNTIL`, `ON`, `TRAP`, the disk verbs, …) — that list is
|
||||
the work queue. A few entries are deliberately out of scope on a modern PC and marked so there
|
||||
(`BANK`, `FAST`, `MONITOR`); keep that reasoning rather than reviving them.
|
||||
|
||||
**When `libakgl` cannot supply a capability a verb needs, do not work around it here.** Add a TODO
|
||||
item to `deps/libakgl/TODO.md` describing the missing API — what the BASIC verb requires, what the
|
||||
`akgl_*` entry point should look like, and what tests would cover it — and follow the numbered,
|
||||
prose-paragraph style of the existing "Carried over" entries. Audio (`PLAY`/`SOUND`/`ENVELOPE`/
|
||||
`FILTER`/`VOL`/`TEMPO`) and immediate-mode drawing (`DRAW`/`BOX`/`PAINT`/`CIRCLE`) are the obvious
|
||||
gaps: `src/draw.c` and `src/text.c` are both at 0% coverage and there is no mixer-backed audio API
|
||||
yet. Growing `libakgl` to serve the interpreter is a wanted outcome, not a detour.
|
||||
|
||||
3. **Be embeddable.** The end state is the interpreter linking *into* `libakgl` as a scripting engine
|
||||
for game authors. That constrains the design from the start:
|
||||
- Build the interpreter as a library target with a thin `main.c` driver on top; the REPL, `QUIT`,
|
||||
and argv handling belong to the driver, not the library.
|
||||
- Interpreter state lives in explicit structs passed by pointer. No file-scope mutable globals.
|
||||
- **Nothing in the library may terminate the process.** Errors propagate out as
|
||||
`akerr_ErrorContext *` for the host game to handle; `FINISH_NORETURN` belongs only in the
|
||||
driver's `main()`.
|
||||
- The interpreter does not own the window, renderer, or game loop. It draws through whatever
|
||||
`akgl` renderer the host has already initialized, and a host must be able to step or bound
|
||||
execution rather than surrendering control to a `run()` that never returns.
|
||||
|
||||
Before doing anything else in a fresh clone:
|
||||
|
||||
```sh
|
||||
git submodule update --init --recursive
|
||||
```
|
||||
|
||||
Note that `libakgl` vendors its *own* copies of `libakerror` and `libakstdlib` (plus SDL3, SDL3_image,
|
||||
SDL3_mixer, SDL3_ttf, jansson, semver) under `deps/libakgl/deps/`. Its `CMakeLists.txt` guards every
|
||||
dependency with `if(NOT TARGET ...)`, so a top-level build must define `akerror::akerror` and
|
||||
`akstdlib::akstdlib` from `deps/libakerror` / `deps/libakstdlib` *before* `add_subdirectory(deps/libakgl)`
|
||||
or the targets will be declared twice.
|
||||
|
||||
Doing it in that order is now load-bearing for a second reason: `deps/libakerror` is at **1.0.0**,
|
||||
which is a source and ABI break with an soname (`libakerror.so.1`). `libakstdlib` and `libakgl` must be
|
||||
compiled against that header, not a pre-1.0.0 one, and an installed `libakerror.so.0` on the system
|
||||
must not be picked up. Build everything from the submodules in one tree. `libakgl`'s
|
||||
`target_compile_definitions(akerror PUBLIC AKERR_MAX_ERR_VALUE=256)` at
|
||||
`deps/libakgl/CMakeLists.txt:44` refers to a macro 1.0.0 deleted — it is inert, and it should go when
|
||||
that repo is next touched. See the error-code section below for a live collision this upgrade exposed.
|
||||
|
||||
### Dependency versions and what they promise
|
||||
|
||||
| Submodule | Version | soname | ABI rule | Version API |
|
||||
|---|---|---|---|---|
|
||||
| `deps/libakerror` | 1.0.0 | `libakerror.so.1` | major only | **none** — no version macro, no `ConfigVersion` file |
|
||||
| `deps/libakstdlib` | 0.1.0 | `libakstdlib.so.0.1` | **`MAJOR.MINOR` while major is 0** | `AKSL_VERSION_*`, `aksl_version()`, `AKSL_VERSION_CHECK()` |
|
||||
| `deps/libakgl` | 0.1.0 | `libakgl.so.0.1` | **`MAJOR.MINOR` while major is 0** | `AKGL_VERSION*`, `akgl_version()`, `AKGL_VERSION_AT_LEAST()` |
|
||||
|
||||
For both 0.x libraries the soname carries `MAJOR.MINOR` deliberately: 0.1 and 0.2 are *different*
|
||||
ABIs, and both become major-only at 1.0. Do not read `0.1 → 0.2` as a compatible bump.
|
||||
|
||||
`libakstdlib` 0.1.0 added a version API worth using. `akstdlib.h` now pulls in
|
||||
`<akstdlib_version.h>`, which is **generated into the build tree** by CMake and installed beside
|
||||
`akstdlib.h` — so link `akstdlib::akstdlib` and let the target carry its include directories; hand-adding
|
||||
`deps/libakstdlib/include` to an include path gets you a missing-header error. It defines
|
||||
`AKSL_VERSION_MAJOR`/`MINOR`/`PATCH`/`STRING`/`NUMBER` and `AKSL_VERSION_SONAME`, recording what the
|
||||
caller was *compiled* against, and the library exposes `aksl_version()`, `aksl_version_string()` and
|
||||
`aksl_version_soname()` for what actually *loaded*. `AKSL_VERSION_CHECK()` compares them and raises
|
||||
`AKERR_VALUE` naming both. **Call it once during initialization** — the soname normally catches a
|
||||
mismatch at load time, but a 0.2.0 dropped in under the 0.1 filename loads happily and only the check
|
||||
notices. It is a macro on purpose: it must expand at your call site to capture your numbers.
|
||||
|
||||
`libakgl` 0.1.0 followed the same pattern one commit later, for the same reason: it had `AKGL_VERSION`
|
||||
hand-maintained in `game.h` and no `VERSION` on `project()` at all, so `akgl.pc` shipped an empty
|
||||
`Version:` and the `.so` had no soname. Now `project(akgl VERSION 0.1.0)` is the single source and
|
||||
drives the generated `include/akgl/version.h` — which is `.gitignore`d, because `include/` precedes the
|
||||
build tree on the include path and a stray copy there would shadow the generated one and pin every
|
||||
consumer. It publishes `AKGL_VERSION_AT_LEAST(major, minor, patch)`, the compile-time test
|
||||
`libakstdlib` could not write against `libakerror`, and `akgl_version()` for what actually loaded.
|
||||
|
||||
`libakstdlib` also states, and tests, that it defines no status codes and reserves no range. That is
|
||||
why it does not appear as an owner in the range map below.
|
||||
|
||||
**Version-pinning in `find_package` is asymmetric, and that is deliberate.** `find_package(akstdlib 0.1)`
|
||||
and `find_package(akgl 0.1)` both work — each ships a `ConfigVersion.cmake` at `SameMinorVersion`,
|
||||
mirroring its soname. `find_package(akerror 1.0)` **fails against a correct install**, because
|
||||
`libakerror` ships `akerrorConfig.cmake` and `akerrorTargets.cmake` but no
|
||||
`akerrorConfigVersion.cmake`. Ask for `akerror` unversioned. Its floor is enforced instead by an
|
||||
`#error` feature-testing `AKERR_FIRST_CONSUMER_STATUS`, which both `akstdlib.h` and `akgl/error.h`
|
||||
now carry — include either and you inherit the guard. The missing version file is filed in both
|
||||
`deps/libakstdlib/TODO.md` §2.3 and `deps/libakgl`'s history; fix it upstream, then add the `1.0` floor
|
||||
to the `find_dependency` calls.
|
||||
|
||||
### Embedded builds collide on test names, target names and coverage data
|
||||
|
||||
All three libraries register their CTest tests unconditionally and add coverage/mutation targets. A
|
||||
top-level `akbasic` build that `add_subdirectory`s all three walks into four separate collisions.
|
||||
`libakgl` hit two of them in the last week and its fixes are the ones to copy.
|
||||
|
||||
**1. Duplicate CTest entries.** Every dependency's tests register into *our* suite. Pulled in
|
||||
`EXCLUDE_FROM_ALL` their binaries are never built, so each shows up as "Not Run" and fails. CMake
|
||||
offers no way to un-register a test and `set_tests_properties` cannot reach across directory scopes.
|
||||
`libakstdlib` solved it by shadowing `add_test` and `set_tests_properties` for the duration of the
|
||||
`add_subdirectory()` call — `deps/libakstdlib/CMakeLists.txt:104-150`. Note that its shadow only arms
|
||||
when *it* is top-level, so it does nothing for us: **we need our own, around all three
|
||||
`add_subdirectory()` calls**, not just `libakerror`'s.
|
||||
|
||||
**2. Duplicate test *target* names.** `add_subdirectory` creates a dependency's targets even under
|
||||
`EXCLUDE_FROM_ALL`. When `libakstdlib` 0.1.0 added `tests/test_version.c`, `libakgl`'s own
|
||||
`test_version` stopped the configure dead:
|
||||
|
||||
```
|
||||
add_executable cannot create target "test_version" because another target with the same name
|
||||
already exists.
|
||||
```
|
||||
|
||||
`libakgl` fixed it by building its programs as `akgl_test_<name>` while keeping the bare CTest names
|
||||
(`ctest -R version` still works). `libakstdlib` still uses bare `test_<name>` targets. **Name every
|
||||
test target in this repo `akbasic_test_<name>`** — it costs nothing and it is the collision that
|
||||
actually stopped a build.
|
||||
|
||||
**3. Duplicate custom targets.** `libakerror` namespaces its `mutation` target when embedded but
|
||||
**not** its `coverage` target (`deps/libakerror/CMakeLists.txt:194` vs `:172`), so any
|
||||
coverage-enabled top-level build fails with *"another target with the same name already exists"*.
|
||||
Shadow `add_custom_target` and rename that one, as `deps/libakstdlib/CMakeLists.txt:134-141` does.
|
||||
`libakstdlib` (both targets) and `libakgl` (its `mutation` target) namespace themselves correctly.
|
||||
**The real fix is upstream in `libakerror`** — the same
|
||||
`CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR` test it already applies to `mutation` — and it is
|
||||
filed in `deps/libakstdlib/TODO.md` §2.3. Delete the workaround when it lands.
|
||||
|
||||
**4. Stale build trees poison the coverage report.** `libakgl` defect #13: `gcovr` searches for
|
||||
`.gcda`/`.gcno` under `--root`, which its `CMakeLists.txt:208`/`:223` set to the *source* directory, so
|
||||
every instrumented build tree left in the source dir is folded into the report. `--object-directory`
|
||||
does not narrow that search. A leftover `build-coverage/` makes a freshly configured run fail in
|
||||
`coverage_reset`, before any test executes, with `Got function ... on multiple lines`. Because
|
||||
`build*/` is `.gitignore`d, the state is easy to reach and hard to see. **Keep build trees out of the
|
||||
source directory** — the `cmake -S . -B build` convention above already does, and this is the reason
|
||||
to hold to it.
|
||||
|
||||
## Reference implementation (`deps/basicinterpret`)
|
||||
|
||||
This is a Commodore BASIC 7.0 / Dartmouth BASIC dialect written in Go with SDL2 + SDL2_ttf. It is the
|
||||
behavioral spec: when a question about semantics comes up ("what does `READ` do when it runs off the
|
||||
end of `DATA`?"), the answer lives in this code and in `tests/`.
|
||||
|
||||
```sh
|
||||
cd deps/basicinterpret
|
||||
make # builds ./basic (CGO_ENABLED=1, needs SDL2 + SDL2_ttf dev packages)
|
||||
./basic # interactive REPL
|
||||
./basic tests/language/functions.bas
|
||||
make tests # or: bash ./test.sh
|
||||
```
|
||||
|
||||
`test.sh` is a golden-file harness: for every `tests/**/*.bas` it runs the interpreter and md5-compares
|
||||
stdout against the sibling `.txt`. The exit code is the number of failures. To run a single case,
|
||||
just run the interpreter on that `.bas` and diff against its `.txt`.
|
||||
|
||||
That corpus is the natural acceptance suite for the rewrite: the C interpreter should reproduce the
|
||||
same stdout for the same `.bas` files. Carry it over (or drive it in place) alongside the per-module
|
||||
CTest executables the `ak*` style calls for — the two answer different questions, and new language
|
||||
features from goal 2 need a `.bas`/`.txt` pair as well as unit tests.
|
||||
|
||||
`deps/basicinterpret/README.md` is the language reference — implemented verbs, functions, variable
|
||||
type suffixes, and an explicit list of what is *not* implemented. Read it before adding or porting
|
||||
language features.
|
||||
|
||||
### Architecture of the reference interpreter
|
||||
|
||||
Scanner → parser → tree-walking runtime, one source line at a time:
|
||||
|
||||
- `basicscanner.go` — `BasicScanner` tokenizes a line into `BasicToken`s. Verbs and function names are
|
||||
case-insensitive; variable names are case-sensitive.
|
||||
- `basicparser.go` / `basicparser_commands.go` — recursive-descent parser producing `BasicASTLeaf`
|
||||
nodes (`basicgrammar.go` defines `BasicASTLeafType` and leaf structure). Commands get their own
|
||||
parse paths in `basicparser_commands.go`.
|
||||
- `basicruntime.go` — `BasicRuntime` owns the program source (`[MAX_SOURCE_LINES]BasicSourceLine`),
|
||||
the variable pool, the scanner/parser, the environment stack, and the SDL window. `evaluate()` walks
|
||||
the AST; `commandByReflection()` dispatches a verb to its `BasicRuntime` method by name, so adding a
|
||||
verb is largely a matter of adding a correctly-named method.
|
||||
- `basicruntime_commands.go` / `basicruntime_functions.go` — the verb and function implementations.
|
||||
- `basicenvironment.go` — `BasicEnvironment` is a scope *and* the per-line working state: variables,
|
||||
functions, labels, plus the in-flight state of `IF`/`FOR`/`GOSUB`/`READ`. Environments chain via
|
||||
`parent` and are pushed/popped with `newEnvironment()` / `prevEnvironment()`.
|
||||
- `basicvalue.go` / `basicvariable.go` — `BasicValue` (the strongly-typed value) and `BasicVariable`
|
||||
(a named slot plus array metadata). Type is carried by the identifier suffix: `#` integer,
|
||||
`%` float, `$` string.
|
||||
- `basicruntime_graphics.go` — output goes through an SDL text surface with a cursor, wrapped text,
|
||||
scrolling and a print buffer. `Write()` and `Println()` **mirror every line to stdout** as well as
|
||||
to the surface; that mirror is the only reason the golden-file suite works, so the C port needs an
|
||||
equivalent (a text sink the driver can point at stdout while the embedded case renders through
|
||||
`akgl`) or the whole `tests/` corpus becomes unusable.
|
||||
|
||||
Two design decisions matter most if you are porting this to C:
|
||||
|
||||
1. **Everything is fixed-size and statically allocated.** `main.go` defines the budget:
|
||||
`MAX_LEAVES`/`MAX_TOKENS` 32 per environment, `MAX_VALUES` 64, `MAX_VARIABLES` 128,
|
||||
`MAX_SOURCE_LINES` 9999, `MAX_LINE_LENGTH` 256, `MAX_ARRAY_DEPTH` 64. The 32-leaf ceiling is why
|
||||
the README says a line is limited to roughly 16 operations. This lines up with the `ak*` libraries'
|
||||
no-dynamic-allocation rule — the port should keep the pool-allocation model, not replace it with `malloc`.
|
||||
2. **`waitingForCommand` drives block structure.** Rather than building nested blocks in the AST, the
|
||||
environment records a verb it is skipping forward to (`NEXT`, `RETURN`, …) and suppresses execution
|
||||
of intervening lines until it sees it. Loops and branches evaluate their condition at the *bottom*
|
||||
of the structure. Any reimplementation has to reproduce this or restructure control flow deliberately.
|
||||
|
||||
Runtime modes are `MODE_REPL`, `MODE_RUN`, `MODE_RUNSTREAM` (piped input), `MODE_QUIT`; `BASIC_TRUE`
|
||||
is `-1` and `BASIC_FALSE` is `0`, per Commodore convention.
|
||||
|
||||
## Working in the `ak*` C libraries
|
||||
|
||||
Each of the three C libraries carries its own `AGENTS.md` (`CLAUDE.md` in them just points at it) with
|
||||
authoritative per-repo rules. Read the relevant one before editing a submodule. The shared shape:
|
||||
|
||||
```sh
|
||||
cmake -S . -B build # out-of-tree, always
|
||||
cmake --build build --parallel
|
||||
ctest --test-dir build --output-on-failure
|
||||
ctest --test-dir build -R <name> --output-on-failure # single test
|
||||
```
|
||||
|
||||
Extra harnesses, by library (option prefixes differ per repo):
|
||||
|
||||
```sh
|
||||
cmake -S . -B build-asan -DAKSL_SANITIZE=ON # libakstdlib: ASan + UBSan
|
||||
cmake -S . -B build-coverage -DAKSL_COVERAGE=ON # libakstdlib
|
||||
cmake -S . -B build-coverage -DAKGL_COVERAGE=ON -DCMAKE_BUILD_TYPE=Debug # libakgl (needs gcovr)
|
||||
cmake --build build --target coverage
|
||||
cmake --build build --target mutation # slow; scripts/mutation_test.py for a subset
|
||||
```
|
||||
|
||||
`libakerror/test.sh` shows the full CI gate for that library (ctest + mutation ≥65 + coverage ≥90 line
|
||||
/ ≥50 branch). `rebuild.sh` in `libakgl` and `libakstdlib` installs into the developer-specific prefix
|
||||
`/home/andrew/local` and deletes build directories — use the portable commands above unless that exact
|
||||
behavior is wanted.
|
||||
|
||||
Tests are one-file C programs registered in a list in `CMakeLists.txt`. `libakstdlib` splits them three
|
||||
ways and **two of the lists invert the meaning of "Passed"**: `AKSL_TESTS` must exit 0;
|
||||
`AKSL_WILL_FAIL_TESTS` abort by design; `AKSL_KNOWN_FAILING_TESTS` assert the *correct* contract for a
|
||||
defect documented in `TODO.md` and are expected to fail. A green `ctest` run therefore does not mean
|
||||
defect-free. When a known-failing test starts passing, CTest reports "unexpectedly passed" — that is the
|
||||
cue to move it into `AKSL_TESTS` along with the fix. `libakerror` has the same split
|
||||
(`AKERR_TESTS` / `AKERR_WILL_FAIL_TESTS`).
|
||||
|
||||
That split is not academic for `libakstdlib`: `deps/libakstdlib/TODO.md` §2.1 lists six **confirmed**
|
||||
defects, four with a known-failing test apiece. Several are in functions this port would otherwise
|
||||
reach for by default — the `aksl_ato*` family cannot report a conversion failure at all, and the
|
||||
linked-list functions truncate. **Read §2.1 before calling anything in `akstdlib.h` for the first
|
||||
time**; `TODO.md` §1.9 in this repo records which calls are cleared for use here and which are not.
|
||||
The branch-coverage gate there was re-ratcheted 45 → 40 after the 1.0.0 bump, because the new
|
||||
`PREPARE_ERROR`/`FAIL_*` macros expand to more branches per call site — that is a denominator change,
|
||||
not a regression, and the same effect will show up in this repo's numbers.
|
||||
|
||||
## The libakerror error convention
|
||||
|
||||
New C code in this repo should follow it — it is what `libakstdlib` and `libakgl` both do, and mixing
|
||||
conventions breaks error propagation.
|
||||
|
||||
- Any function that can fail returns `akerr_ErrorContext AKERR_NOIGNORE *` and opens with `PREPARE_ERROR(e);`.
|
||||
- Return with `SUCCEED_RETURN(e)` / `FAIL_RETURN(...)`, never a bare status code.
|
||||
- Propagate with `PASS(e, some_call());` when there is nothing local to do.
|
||||
- Handle locally with `ATTEMPT { CATCH(e, call()); } CLEANUP { } PROCESS(e) { } HANDLE(e, AKERR_X) { } FINISH(e, true);`
|
||||
— `FINISH(e, true)` re-raises unhandled errors to the caller; use `FINISH_NORETURN(e)` in `main()`.
|
||||
- **`CATCH` and the `FAIL_*_BREAK` macros expand to a C `break`**, so they must never appear inside a
|
||||
loop or nested `switch` within an `ATTEMPT` — the `break` would escape only the loop and the rest of
|
||||
the `ATTEMPT` would run with an error pending. Inside loops use `PASS` / `FAIL_*_RETURN`, or move the
|
||||
loop into its own `akerr_ErrorContext *` helper and `CATCH` that single call.
|
||||
- Custom error codes must be **reserved** with `akerr_reserve_status_range()` and **named** with
|
||||
`akerr_register_status_name()` during initialization — see the allocation section below before
|
||||
defining any.
|
||||
- Unhandled errors that reach the top level abort the process with a stack trace. That is the intended
|
||||
behavior for the standalone driver — but see goal 3: the interpreter *library* must not rely on it.
|
||||
|
||||
### Error-code allocation across libraries
|
||||
|
||||
**`libakerror` 1.0.0 changed this completely.** The hazard that used to live in this section — a
|
||||
consumer-sized `__AKERR_ERROR_NAMES` array, a mismatched `AKERR_MAX_ERR_VALUE` corrupting BSS, and no
|
||||
authority to allocate from — is gone. Read `deps/libakerror/UPGRADING.md` before writing any error
|
||||
code; the short version follows.
|
||||
|
||||
**What 1.0.0 removed.** These no longer exist. Any code, compile definition, or documentation
|
||||
referring to them is stale:
|
||||
|
||||
| Removed | Replacement |
|
||||
|---|---|
|
||||
| `AKERR_MAX_ERR_VALUE` | nothing — the name registry is sparse and takes any `int` |
|
||||
| `__AKERR_ERROR_NAMES` | `akerr_name_for_status()` (the table is private to the library now) |
|
||||
| `AKERR_STATUS_RANGE_OK` / `AKERR_STATUS_NAME_OK` | success is a `NULL` `akerr_ErrorContext *`, like everything else |
|
||||
|
||||
It is also a **source and ABI break** carrying an soname (`libakerror.so.1`). Anything built against a
|
||||
pre-1.0.0 header must be rebuilt — including `libakstdlib` and `libakgl`. A stale
|
||||
`-DAKERR_MAX_ERR_VALUE=...` is now harmless but useless; delete it when you see it.
|
||||
|
||||
**How allocation works now.** Values `0`–`255` belong to `libakerror` (the host errno space plus the
|
||||
`AKERR_*` codes), reserved by `akerr_init()` under the owner string `"libakerror"`. Consumers allocate
|
||||
from `AKERR_FIRST_CONSUMER_STATUS` (256) upward, as **absolute integer constants** — never as offsets
|
||||
from `AKERR_LAST_ERRNO_VALUE`, so a libc that grows an errno cannot move them. Every library that can
|
||||
coexist in one process reserves its range at init:
|
||||
|
||||
```c
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akerr_reserve_status_range(int first_status, int count, const char *owner);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akerr_register_status_name(const char *owner, int status, const char *name);
|
||||
```
|
||||
|
||||
Both return `akerr_ErrorContext *` and are `AKERR_NOIGNORE`, so a collision is an ordinary error you
|
||||
`CATCH`, `HANDLE`, or `PASS` out of your init function. Ownership is **enforced**: naming a status in
|
||||
someone else's range fails with `AKERR_STATUS_NAME_FOREIGN`, and naming one nobody reserved fails with
|
||||
`AKERR_STATUS_NAME_UNRESERVED`. You do not need to call `akerr_init()` first — every registry entry
|
||||
point calls it for you, and (unlike pre-1.0.0) it no longer clears reservations made before it ran.
|
||||
Repeating an identical reservation for the same owner is a no-op; a subset or superset of your own
|
||||
range is not, so reserve the whole thing in one call.
|
||||
|
||||
**The coordinated range map for this dependency stack.** The library cannot enumerate its consumers,
|
||||
so this table is the coordination — keep it current, and reserve the whole 256 even where fewer codes
|
||||
are used, so a later addition does not need a second reservation:
|
||||
|
||||
| Owner string | Range | Status |
|
||||
|---|---|---|
|
||||
| `"libakerror"` | 0 – 255 | reserved by `akerr_init()`; do not touch |
|
||||
| *(none)* | — | `libakstdlib` deliberately reserves nothing and defines no codes of its own — it raises `AKERR_*` and propagates `errno`, both inside the reserved band. Its `tests/test_status_registry.c` pins that as a contract, so nobody has to coordinate with it. |
|
||||
| `"libakgl"` | 256 – 260 | reserved by `akgl_error_init()`; `AKGL_ERR_BASE` … `AKGL_ERR_LIMIT - 1`, five codes |
|
||||
| *(free)* | 261 – 511 | headroom for `libakgl` to grow into; do not claim it |
|
||||
| `"akbasic"` | 512 – 767 | ours; `AKBASIC_ERR_BASE` is 512 |
|
||||
|
||||
**Every owner reserves at init, and each does it in its own initializer.** `akerr_init()` claims
|
||||
0–255 for itself. `akgl_error_init()` (`deps/libakgl/src/error.c`, new in libakgl 0.1.0) claims
|
||||
`AKGL_ERR_BASE` = `AKERR_FIRST_CONSUMER_STATUS` = 256 through `AKGL_ERR_LIMIT - 1` = 260 and names all
|
||||
five codes. `libakstdlib` claims nothing. `akbasic_init()` claims 512–767.
|
||||
|
||||
`akgl_error_init()` has an ordering requirement worth knowing before you wire up `main()`: it must run
|
||||
before anything else in `libakgl`, because a code raised before it registers carries no name into its
|
||||
stack trace. `akgl_game_init()` calls it as its first statement, but a program driving subsystems
|
||||
directly — which is what the embedded interpreter does — has to call it itself. It is idempotent, so
|
||||
calling it more than once is fine; what is *not* fine is a subset or superset reservation, which
|
||||
`libakerror` refuses.
|
||||
|
||||
**What `akbasic` does.** Reserve and name in `akbasic_init()`, and let failures propagate:
|
||||
|
||||
```c
|
||||
#define AKBASIC_OWNER "akbasic"
|
||||
|
||||
enum {
|
||||
AKBASIC_ERR_BASE = 512, /* AKERR_FIRST_CONSUMER_STATUS + 256; see the map above */
|
||||
AKBASIC_ERR_SYNTAX = AKBASIC_ERR_BASE,
|
||||
AKBASIC_ERR_TYPE,
|
||||
/* ... */
|
||||
AKBASIC_ERR_LIMIT = AKBASIC_ERR_BASE + 256
|
||||
};
|
||||
```
|
||||
|
||||
Use an `enum`, not a chain of `#define`s: the values stay compile-time integer constants, so `HANDLE`
|
||||
still works (its `case` labels require that), and adding a code does not mean editing an arithmetic
|
||||
offset. Reserve `AKBASIC_ERR_LIMIT - AKBASIC_ERR_BASE` in one call.
|
||||
|
||||
**What is still not solved, and what it means for us.** `libakerror`'s own `TODO.md` §2 says it plainly:
|
||||
ownership enforcement covers *naming*, which is the part the library mediates. It cannot detect two
|
||||
components compiling the same integer into a `HANDLE` `case` label without ever registering a name —
|
||||
that never reaches the registry. §3 adds that there is no way to ask who owns a status or to enumerate
|
||||
reservations, so the coordination advice above has no tooling behind it yet; the table in this file is
|
||||
the tooling. Two practical rules follow:
|
||||
|
||||
- **Always reserve, even for codes you never name.** Reservation is the only thing that makes a
|
||||
collision visible at all.
|
||||
- **Never define an error code as an offset from another library's symbol.** The `libakgl` defect above
|
||||
is exactly what that produces.
|
||||
|
||||
Capacity is not a concern here: the name registry holds 3072 entries and `akerr_init()` consumes about
|
||||
150, and reservations cap at 64 ranges. Both are `PRIVATE` to the `libakerror` target and invisible to
|
||||
consumers — raising them is a `libakerror` configure-time decision, not something `akbasic` sets.
|
||||
Registration is **not thread safe**; do it during single-threaded init, before the host game spawns
|
||||
anything.
|
||||
|
||||
`libakgl` adds a hard rule of its own: **avoid dynamic memory allocation.** Obtain objects from
|
||||
`akgl_heap_next_*` and release them back; if no heap layer exists for a needed type, add one rather
|
||||
than calling `malloc`.
|
||||
|
||||
## Style and commits
|
||||
|
||||
C is C99-compatible, 4-space indent, braces on the next line for function bodies, spaces inside
|
||||
control-flow parens. Match the surrounding file — several files mix tabs and spaces, and there is no
|
||||
repo-wide formatter, so avoid unrelated formatting churn. Public symbols take a library prefix
|
||||
(`akerr_`, `aksl_`, `akgl_`) with `akerr_TypeName`-style types and `AKGL_UPPER_SNAKE_CASE` macros.
|
||||
Since this interpreter is meant to link into `libakgl` (goal 3), it needs its own non-colliding
|
||||
prefix in the same shape — `akbasic_` for functions, `akbasic_TypeName` for types, `AKBASIC_` for
|
||||
macros and constants — and matching header/source pairs named by feature, as in `src/scanner.c` /
|
||||
`include/akbasic/scanner.h`.
|
||||
|
||||
Commit subjects are short, imperative, sentence case ("Fix refcount leak and stack-trace buffer
|
||||
overflow"). `libakgl`'s `AGENTS.md` requires agents to add themselves (program, model, version) as a
|
||||
commit co-author. Never edit generated output — `build/` trees, generated `akerror.h`, `akgl.pc`,
|
||||
`include/akgl/SDL_GameControllerDB.h`; change the template or generator script instead.
|
||||
263
CMakeLists.txt
Normal file
263
CMakeLists.txt
Normal file
@@ -0,0 +1,263 @@
|
||||
cmake_minimum_required(VERSION 3.10)
|
||||
# The single source of truth for the version, in the shape libakstdlib and
|
||||
# libakgl both use. It flows into the library SOVERSION and nothing else spells
|
||||
# a version number.
|
||||
#
|
||||
# 0.x on purpose: TODO.md section 12 records eleven defects carried over from the
|
||||
# Go reference that are deliberately reproduced and not yet fixed, so the
|
||||
# language surface is not being promised yet.
|
||||
project(akbasic VERSION 0.1.0 LANGUAGES C)
|
||||
|
||||
# Pre-1.0 the ABI may break on a minor bump, so the soname carries MAJOR.MINOR.
|
||||
# At 1.0 this becomes ${PROJECT_VERSION_MAJOR} alone.
|
||||
if(PROJECT_VERSION_MAJOR EQUAL 0)
|
||||
set(AKBASIC_SOVERSION "${PROJECT_VERSION_MAJOR}.${PROJECT_VERSION_MINOR}")
|
||||
else()
|
||||
set(AKBASIC_SOVERSION "${PROJECT_VERSION_MAJOR}")
|
||||
endif()
|
||||
|
||||
include(CTest)
|
||||
include(GNUInstallDirs)
|
||||
|
||||
option(AKBASIC_WITH_AKGL "Build the libakgl-backed text sink and link SDL3" OFF)
|
||||
option(AKBASIC_COVERAGE "Instrument the build with gcov coverage counters" OFF)
|
||||
option(AKBASIC_SANITIZE "Build with ASan + UBSan" OFF)
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Dependencies
|
||||
#
|
||||
# libakgl vendors its own copies of libakerror and libakstdlib and guards every
|
||||
# dependency with if(NOT TARGET ...), so akerror::akerror and akstdlib::akstdlib
|
||||
# must exist *before* add_subdirectory(deps/libakgl) or the targets are declared
|
||||
# twice.
|
||||
#
|
||||
# All three dependencies register their CTest tests unconditionally. Pulled in
|
||||
# EXCLUDE_FROM_ALL their test binaries are never built, so each one would land in
|
||||
# our suite as "Not Run" and fail. CMake has no way to un-register a test and
|
||||
# set_tests_properties cannot reach across directory scopes, so add_test() and
|
||||
# set_tests_properties() are shadowed for the duration of the add_subdirectory()
|
||||
# calls. Note libakstdlib carries the same shadow but only arms it when *it* is
|
||||
# top-level, so it does nothing for us -- this one has to wrap all three.
|
||||
#
|
||||
# libakerror additionally namespaces its `mutation` target when embedded but not
|
||||
# its `coverage` target (deps/libakerror/CMakeLists.txt:194 vs :172), so a
|
||||
# coverage build collides on the `coverage` target and fails to configure at all.
|
||||
# Rename the dependency's on the way past. Remove this once libakerror applies
|
||||
# the same CMAKE_SOURCE_DIR test to `coverage` that it already applies to
|
||||
# `mutation` -- filed in deps/libakstdlib/TODO.md section 2.3.
|
||||
# ---------------------------------------------------------------------------
|
||||
set(AKBASIC_SUPPRESS_ADD_TEST TRUE)
|
||||
|
||||
function(add_test)
|
||||
if(NOT AKBASIC_SUPPRESS_ADD_TEST)
|
||||
_add_test(${ARGV})
|
||||
endif()
|
||||
endfunction()
|
||||
|
||||
function(set_tests_properties)
|
||||
if(NOT AKBASIC_SUPPRESS_ADD_TEST)
|
||||
_set_tests_properties(${ARGV})
|
||||
endif()
|
||||
endfunction()
|
||||
|
||||
function(add_custom_target _name)
|
||||
if(AKBASIC_SUPPRESS_ADD_TEST AND _name STREQUAL "coverage")
|
||||
_add_custom_target(akerror_coverage ${ARGN})
|
||||
else()
|
||||
_add_custom_target(${ARGV})
|
||||
endif()
|
||||
endfunction()
|
||||
|
||||
add_subdirectory(deps/libakerror EXCLUDE_FROM_ALL)
|
||||
add_subdirectory(deps/libakstdlib EXCLUDE_FROM_ALL)
|
||||
if(AKBASIC_WITH_AKGL)
|
||||
add_subdirectory(deps/libakgl EXCLUDE_FROM_ALL)
|
||||
endif()
|
||||
|
||||
set(AKBASIC_SUPPRESS_ADD_TEST FALSE)
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Instrumentation, applied per target so it never leaks into an exported
|
||||
# interface.
|
||||
# ---------------------------------------------------------------------------
|
||||
function(akbasic_instrument _target)
|
||||
if(AKBASIC_COVERAGE)
|
||||
target_compile_options(${_target} PRIVATE --coverage -O0 -g)
|
||||
target_link_options(${_target} PRIVATE --coverage)
|
||||
endif()
|
||||
if(AKBASIC_SANITIZE)
|
||||
target_compile_options(${_target} PRIVATE -fsanitize=address,undefined -fno-omit-frame-pointer -g)
|
||||
target_link_options(${_target} PRIVATE -fsanitize=address,undefined)
|
||||
endif()
|
||||
endfunction()
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# The interpreter library. Everything here must be free of SDL, free of any
|
||||
# process-terminating call, and buildable with no libakgl present.
|
||||
# ---------------------------------------------------------------------------
|
||||
set(AKBASIC_SOURCES
|
||||
src/convert.c
|
||||
src/environment.c
|
||||
src/error.c
|
||||
src/grammar.c
|
||||
src/parser.c
|
||||
src/parser_commands.c
|
||||
src/runtime.c
|
||||
src/runtime_commands.c
|
||||
src/runtime_functions.c
|
||||
src/scanner.c
|
||||
src/sink_stdio.c
|
||||
src/symtab.c
|
||||
src/value.c
|
||||
src/variable.c
|
||||
src/verbs.c
|
||||
)
|
||||
|
||||
add_library(akbasic ${AKBASIC_SOURCES})
|
||||
add_library(akbasic::akbasic ALIAS akbasic)
|
||||
|
||||
target_include_directories(akbasic PUBLIC
|
||||
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
|
||||
$<INSTALL_INTERFACE:${CMAKE_INSTALL_INCLUDEDIR}/>
|
||||
)
|
||||
|
||||
target_compile_options(akbasic PRIVATE -Wall -Wextra)
|
||||
target_link_libraries(akbasic PUBLIC akstdlib::akstdlib akerror::akerror)
|
||||
target_link_libraries(akbasic PRIVATE m)
|
||||
|
||||
set_target_properties(akbasic PROPERTIES
|
||||
VERSION ${PROJECT_VERSION}
|
||||
SOVERSION ${AKBASIC_SOVERSION}
|
||||
)
|
||||
|
||||
akbasic_instrument(akbasic)
|
||||
|
||||
# The libakgl-backed text sink, kept in its own target so the core library and
|
||||
# the whole golden suite build with no SDL present.
|
||||
if(AKBASIC_WITH_AKGL)
|
||||
add_library(akbasic_akgl src/sink_akgl.c)
|
||||
target_compile_options(akbasic_akgl PRIVATE -Wall -Wextra)
|
||||
target_link_libraries(akbasic_akgl PUBLIC akbasic akgl)
|
||||
akbasic_instrument(akbasic_akgl)
|
||||
endif()
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# The standalone driver. This is the only place FINISH_NORETURN may appear.
|
||||
# ---------------------------------------------------------------------------
|
||||
add_executable(basic src/main.c)
|
||||
target_compile_options(basic PRIVATE -Wall -Wextra)
|
||||
target_link_libraries(basic PRIVATE akbasic)
|
||||
if(AKBASIC_WITH_AKGL)
|
||||
target_link_libraries(basic PRIVATE akbasic_akgl)
|
||||
target_compile_definitions(basic PRIVATE AKBASIC_HAVE_AKGL=1)
|
||||
endif()
|
||||
akbasic_instrument(basic)
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Tests.
|
||||
#
|
||||
# Three lists, and two of them invert the meaning of "Passed", exactly as
|
||||
# libakstdlib does:
|
||||
# AKBASIC_TESTS must exit 0
|
||||
# AKBASIC_WILL_FAIL_TESTS abort by design
|
||||
# AKBASIC_KNOWN_FAILING_TESTS assert the *correct* contract for a defect
|
||||
# recorded in TODO.md and are expected to fail.
|
||||
# When one starts passing CTest reports
|
||||
# "unexpectedly passed" -- that is the cue to move
|
||||
# it into AKBASIC_TESTS along with the fix.
|
||||
#
|
||||
# Test executables are named akbasic_test_<name>, never test_<name>: a
|
||||
# dependency's targets are created even under EXCLUDE_FROM_ALL, and libakstdlib
|
||||
# already ships test_version. The CTest name stays bare, so `ctest -R value`
|
||||
# still selects it.
|
||||
# ---------------------------------------------------------------------------
|
||||
set(AKBASIC_TESTS
|
||||
convert
|
||||
environment_scope
|
||||
error_codes
|
||||
grammar_leaves
|
||||
parser_commands
|
||||
parser_expressions
|
||||
runtime_evaluate
|
||||
runtime_verbs
|
||||
scanner_tokens
|
||||
sink_stdio
|
||||
symtab
|
||||
value_arithmetic
|
||||
value_bitwise
|
||||
value_compare
|
||||
variable_subscript
|
||||
verbs_table
|
||||
version_check
|
||||
)
|
||||
|
||||
set(AKBASIC_WILL_FAIL_TESTS
|
||||
)
|
||||
|
||||
set(AKBASIC_KNOWN_FAILING_TESTS
|
||||
known_reference_defects
|
||||
)
|
||||
|
||||
foreach(_test IN LISTS AKBASIC_TESTS AKBASIC_WILL_FAIL_TESTS AKBASIC_KNOWN_FAILING_TESTS)
|
||||
add_executable(akbasic_test_${_test} tests/${_test}.c)
|
||||
target_compile_options(akbasic_test_${_test} PRIVATE -Wall -Wextra)
|
||||
target_link_libraries(akbasic_test_${_test} PRIVATE akbasic)
|
||||
target_include_directories(akbasic_test_${_test} PRIVATE "${CMAKE_CURRENT_SOURCE_DIR}/tests")
|
||||
akbasic_instrument(akbasic_test_${_test})
|
||||
_add_test(NAME ${_test} COMMAND akbasic_test_${_test})
|
||||
endforeach()
|
||||
|
||||
if(AKBASIC_TESTS OR AKBASIC_WILL_FAIL_TESTS OR AKBASIC_KNOWN_FAILING_TESTS)
|
||||
_set_tests_properties(
|
||||
${AKBASIC_TESTS} ${AKBASIC_WILL_FAIL_TESTS} ${AKBASIC_KNOWN_FAILING_TESTS}
|
||||
PROPERTIES WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}/tests" TIMEOUT 30
|
||||
)
|
||||
endif()
|
||||
|
||||
if(AKBASIC_WILL_FAIL_TESTS OR AKBASIC_KNOWN_FAILING_TESTS)
|
||||
_set_tests_properties(
|
||||
${AKBASIC_WILL_FAIL_TESTS} ${AKBASIC_KNOWN_FAILING_TESTS}
|
||||
PROPERTIES WILL_FAIL TRUE
|
||||
)
|
||||
endif()
|
||||
|
||||
# The golden-file suite. It drives deps/basicinterpret/tests/**/*.bas in place --
|
||||
# the corpus is a submodule and copying it guarantees drift -- and byte-compares
|
||||
# stdout against the sibling .txt. One CTest case per .bas so a failure names the
|
||||
# file.
|
||||
file(GLOB_RECURSE AKBASIC_GOLDEN_CASES
|
||||
RELATIVE "${CMAKE_CURRENT_SOURCE_DIR}/deps/basicinterpret"
|
||||
"${CMAKE_CURRENT_SOURCE_DIR}/deps/basicinterpret/tests/*.bas"
|
||||
)
|
||||
|
||||
foreach(_case IN LISTS AKBASIC_GOLDEN_CASES)
|
||||
string(REGEX REPLACE "^tests/" "" _name "${_case}")
|
||||
string(REGEX REPLACE "\\.bas$" "" _name "${_name}")
|
||||
string(REPLACE "/" "_" _name "${_name}")
|
||||
_add_test(
|
||||
NAME golden_${_name}
|
||||
COMMAND ${CMAKE_COMMAND}
|
||||
-DBASIC=$<TARGET_FILE:basic>
|
||||
-DCASE=${CMAKE_CURRENT_SOURCE_DIR}/deps/basicinterpret/${_case}
|
||||
-P ${CMAKE_CURRENT_SOURCE_DIR}/tests/golden.cmake
|
||||
)
|
||||
endforeach()
|
||||
|
||||
if(AKBASIC_GOLDEN_CASES)
|
||||
set(AKBASIC_GOLDEN_NAMES)
|
||||
foreach(_case IN LISTS AKBASIC_GOLDEN_CASES)
|
||||
string(REGEX REPLACE "^tests/" "" _name "${_case}")
|
||||
string(REGEX REPLACE "\\.bas$" "" _name "${_name}")
|
||||
string(REPLACE "/" "_" _name "${_name}")
|
||||
list(APPEND AKBASIC_GOLDEN_NAMES golden_${_name})
|
||||
endforeach()
|
||||
_set_tests_properties(${AKBASIC_GOLDEN_NAMES} PROPERTIES TIMEOUT 30)
|
||||
endif()
|
||||
|
||||
install(TARGETS akbasic basic
|
||||
ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}
|
||||
LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}
|
||||
RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}
|
||||
INCLUDES DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}
|
||||
)
|
||||
install(DIRECTORY include/akbasic DESTINATION ${CMAKE_INSTALL_INCLUDEDIR})
|
||||
602
TODO.md
Normal file
602
TODO.md
Normal file
@@ -0,0 +1,602 @@
|
||||
# TODO
|
||||
|
||||
Implementation plan for the Go → C port of `deps/basicinterpret`.
|
||||
|
||||
This file is written to be executed by AI agents, not read by humans for inspiration. Every
|
||||
item names the files it touches, the exact deliverable, and the command that proves it done.
|
||||
Work the phases in order. Inside a phase, items with no `Depends:` line may be done in
|
||||
parallel.
|
||||
|
||||
---
|
||||
|
||||
## 0. Agent protocol
|
||||
|
||||
**Read these before touching anything**, in this order:
|
||||
|
||||
1. `CLAUDE.md` in this repository — project goals, the `libakerror` convention, the error-code
|
||||
range map, and the dependency versions.
|
||||
2. `deps/libakerror/AGENTS.md` — the `ATTEMPT`/`CLEANUP`/`PROCESS`/`HANDLE`/`FINISH` protocol.
|
||||
3. `deps/libakerror/UPGRADING.md` — 1.0.0's status registry. Required before writing an error
|
||||
code; the mechanism it replaced is gone.
|
||||
4. `deps/libakstdlib/TODO.md` §2.1 — six **confirmed** defects in the library this port calls
|
||||
into. §1.9 below says which calls are cleared for use; that section is not optional
|
||||
reading, it bans a family of functions the port would otherwise reach for by reflex.
|
||||
5. `deps/libakgl/AGENTS.md` — the no-`malloc` rule and the commit co-author requirement.
|
||||
6. `deps/basicinterpret/README.md` — the language reference and the unimplemented list.
|
||||
|
||||
**Rules for working this file:**
|
||||
|
||||
- **Do not** mark an item done until its acceptance command passes on a clean out-of-tree
|
||||
build. "It compiles" is not acceptance.
|
||||
- **Do** update this file in the same commit as the work: strike the item, or replace it with
|
||||
the defect it uncovered. This file holds outstanding items only.
|
||||
- **Do** add the agent program name, model name and version as a commit co-author. That rule
|
||||
comes from `libakgl` and applies here.
|
||||
- **Never** hand-edit generated output. `build/` trees and the generated `akerror.h` are
|
||||
off-limits; change the generator.
|
||||
- **Never** reformat a file you are not otherwise changing.
|
||||
- When a step is blocked because `libakgl` cannot supply a capability, **do not work around
|
||||
it here.** File it in `deps/libakgl/TODO.md` in the numbered prose style of that file's
|
||||
"Carried over" section and note the block in §7 below.
|
||||
|
||||
**Style**, restated so nobody has to go look: C99, 4-space indent, tabs at width 8
|
||||
(`stroustrup`), function-body braces in column 0 on their own line, control braces on the same
|
||||
line, **always brace**, spaces inside control-flow parens — `if ( x == y ) {`. Pointer star
|
||||
binds to the identifier: `char *name`. Prefix is `akbasic_` for functions,
|
||||
`akbasic_TypeName` for types, `AKBASIC_UPPER_SNAKE` for macros. `static` helpers drop the
|
||||
prefix. Parameter names must match between header and source.
|
||||
|
||||
---
|
||||
|
||||
## 1. Design decisions already made
|
||||
|
||||
These are settled. Do not relitigate them mid-port; if evidence says one is wrong, say so in
|
||||
a commit that changes it deliberately, and update this section.
|
||||
|
||||
### 1.1 Reflection becomes one aligned dispatch table
|
||||
|
||||
The Go runtime resolves verbs with `reflect.MethodByName("Command" + NAME)`
|
||||
(`basicruntime.go:401`), functions with `"Function" + NAME`, and special parse paths with
|
||||
`"ParseCommand" + NAME` (`basicparser.go:103`). C has no reflection and we are not adding
|
||||
any. Replace all three with **one** static table in `src/verbs.c`, sorted by name, searched
|
||||
with `bsearch(3)`:
|
||||
|
||||
```c
|
||||
/* name token type parse handler exec handler */
|
||||
{ "AUTO", AKBASIC_TOK_CMDIMM, NULL, cmd_auto },
|
||||
{ "DATA", AKBASIC_TOK_COMMAND, parse_data, cmd_data },
|
||||
{ "DEF", AKBASIC_TOK_COMMAND, parse_def, cmd_def },
|
||||
```
|
||||
|
||||
A `NULL` parse handler means "parse the rval as a plain expression", which is exactly what
|
||||
`commandByReflection` returning `(nil, nil)` means today. Adding a verb is adding one row plus
|
||||
two functions. **Keep the table column-aligned and one row per verb** — it is a table, so it
|
||||
gets laid out as one.
|
||||
|
||||
This also kills the Go scanner's three separate maps (`reservedwords`, `commands`,
|
||||
`functions`, `basicscanner.go:64-67`): the token type lives in the same row.
|
||||
|
||||
### 1.2 Strings are fixed-size and live inline
|
||||
|
||||
`libakstdlib` has no string type. `libakgl` has `akgl_String` but it is `PATH_MAX` bytes,
|
||||
refcounted, and pool-allocated — wrong shape for a value that gets copied on every
|
||||
assignment, and it would drag a `libakgl` dependency into the core interpreter.
|
||||
|
||||
Define in `include/akbasic/types.h`:
|
||||
|
||||
```c
|
||||
#define AKBASIC_MAX_STRING_LENGTH 256 /* matches AKBASIC_MAX_LINE_LENGTH */
|
||||
```
|
||||
|
||||
and give `akbasic_Value` a `char stringval[AKBASIC_MAX_STRING_LENGTH]` **inline**. `clone()`
|
||||
becomes a struct assignment. No allocator, no refcount, no lifetime question.
|
||||
|
||||
**Tradeoff, stated:** every `akbasic_Value` is ~300 bytes, so one environment's
|
||||
`values[AKBASIC_MAX_VALUES]` pool is ~19KB, and 32 environments is ~610KB of BSS. That is
|
||||
fine on a PC and is the price of never calling `malloc`. If it ever isn't fine, the knob is
|
||||
`AKBASIC_MAX_STRING_LENGTH`, not the allocator.
|
||||
|
||||
Truncation is an **error**, not a silent clamp: `FAIL_RETURN(e, AKBASIC_ERR_VALUE, ...)`.
|
||||
|
||||
### 1.3 Maps become fixed-capacity open-addressed tables
|
||||
|
||||
Five Go maps need replacing:
|
||||
|
||||
| Go site | Purpose | C replacement |
|
||||
|---|---|---|
|
||||
| `BasicScanner.reservedwords/commands/functions` | keyword → token type | the §1.1 static table + `bsearch` |
|
||||
| `BasicEnvironment.variables` | name → `*BasicVariable` | `akbasic_SymbolTable`, capacity `AKBASIC_MAX_VARIABLES` |
|
||||
| `BasicEnvironment.functions` | name → `*BasicFunctionDef` | `akbasic_SymbolTable`, capacity `AKBASIC_MAX_FUNCTIONS` |
|
||||
| `BasicEnvironment.labels` | name → line number | `akbasic_SymbolTable`, capacity `AKBASIC_MAX_LABELS` |
|
||||
|
||||
One implementation, `src/symtab.c`, keyed by `aksl_strhash_djb2()` (already in
|
||||
`libakstdlib`) with linear probing and a fixed slot array. **Use the existing hash; do not
|
||||
write another one.** Table full is an error, not a resize.
|
||||
|
||||
Caveat, from `deps/libakstdlib/TODO.md` §1.6/§2.2.6: the wrapper sign-extends `char`, so a
|
||||
high-bit byte hashes wrong — `"\xff\xfe"` returns 5859874 where the `unsigned char` answer is
|
||||
5868578. BASIC identifiers are 7-bit ASCII (the scanner only accepts `IsLetter`/`IsDigit` plus
|
||||
a type suffix), so this cannot bite the symbol tables. It **would** bite if anyone later keys
|
||||
a table on a string literal or a filename. Do not work around it here; it is already filed
|
||||
upstream.
|
||||
|
||||
### 1.4 Environments come from a pool and are released
|
||||
|
||||
Go calls `new(BasicEnvironment)` at `basicruntime.go:121` and `basicparser_commands.go:124`
|
||||
and never frees one. A long-running `GOSUB` or `FOR` in Go leaks; the GC eventually catches
|
||||
some of it, and nothing in the tests notices.
|
||||
|
||||
C gets `HEAP_ENVIRONMENT[AKBASIC_MAX_ENVIRONMENTS]` with
|
||||
`akbasic_env_acquire()` / `akbasic_env_release()`, in the shape of `akgl_heap_next_*`.
|
||||
`akbasic_runtime_prev_environment()` **must** release the environment it pops. Pool
|
||||
exhaustion is `AKBASIC_ERR_ENVIRONMENT`, reported with the current line number.
|
||||
|
||||
Watch the one place this is not a clean stack: `userFunction` (`basicruntime.go:348`) stores
|
||||
a `BasicEnvironment` **by value** inside `BasicFunctionDef` and re-`init()`s it on every call.
|
||||
In C the funcdef holds an `akbasic_Environment *` acquired at `DEF` time and reset per call —
|
||||
it is owned by the funcdef, not the pool's free list, until the funcdef dies.
|
||||
|
||||
### 1.5 Output goes through a text sink backend
|
||||
|
||||
`Write()` and `Println()` (`basicruntime_graphics.go:140,148`) mirror every line to stdout
|
||||
*and* to an SDL surface. That mirror is the only reason the golden-file suite works. Do not
|
||||
reproduce it as a hardcoded pair of calls.
|
||||
|
||||
Define a record of function pointers, populated by an initializer — the house pattern:
|
||||
|
||||
```c
|
||||
typedef struct akbasic_TextSink
|
||||
{
|
||||
void *self;
|
||||
akerr_ErrorContext AKERR_NOIGNORE *(*write)(struct akbasic_TextSink *self, char *text);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *(*writeln)(struct akbasic_TextSink *self, char *text);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *(*readline)(struct akbasic_TextSink *self, char *dest, size_t len);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *(*clear)(struct akbasic_TextSink *self);
|
||||
} akbasic_TextSink;
|
||||
```
|
||||
|
||||
`akbasic_sink_init_stdio()` in the library, `akbasic_sink_init_akgl()` in the akgl-backed
|
||||
module (phase 9). The driver picks. Cursor arithmetic, wrapping and scrolling belong to the
|
||||
akgl sink, not to the interpreter.
|
||||
|
||||
### 1.6 The interpreter steps; it does not run
|
||||
|
||||
Go's `run()` (`basicruntime.go:682`) is a `for {}` that owns the process until `MODE_QUIT`.
|
||||
Goal 3 forbids that: a host game must be able to bound execution.
|
||||
|
||||
The library exposes:
|
||||
|
||||
```c
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_step(akbasic_Runtime *obj);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_run(akbasic_Runtime *obj, int maxsteps);
|
||||
```
|
||||
|
||||
`_step()` does exactly what one iteration of Go's `for {}` body does and returns.
|
||||
`_run(obj, maxsteps)` loops `_step()` until the mode is `AKBASIC_MODE_QUIT` or `maxsteps`
|
||||
steps have elapsed; `maxsteps <= 0` means unbounded, which is what the standalone driver
|
||||
passes. **This is a deliberate restructure, and it must not change a single byte of golden
|
||||
output.**
|
||||
|
||||
`QUIT` sets `AKBASIC_MODE_QUIT` and returns. **Nothing in the library calls `exit()`,
|
||||
`abort()`, or `FINISH_NORETURN`.** `FINISH_NORETURN` appears exactly once in the tree, in
|
||||
`src/main.c`.
|
||||
|
||||
### 1.7 Error codes are absolute, reserved from the 1.0.0 registry
|
||||
|
||||
`deps/libakerror` is at **1.0.0**. Read `deps/libakerror/UPGRADING.md` before writing an error
|
||||
code; `CLAUDE.md`'s error-code section is the condensed version. Three things this changes
|
||||
from what you may have seen in an older draft or in `libakgl`:
|
||||
|
||||
- `AKERR_MAX_ERR_VALUE` **no longer exists**. The name registry is sparse and takes any `int`.
|
||||
There is nothing for a consumer to size, and no compile definition to set. Anywhere you find
|
||||
one, delete it.
|
||||
- `__AKERR_ERROR_NAMES` **no longer exists**. The table is private.
|
||||
- Codes are **absolute integer constants at 256 or above**, never `AKERR_LAST_ERRNO_VALUE + N`.
|
||||
The offset scheme is what produced the live `libakgl` collision documented in `CLAUDE.md`.
|
||||
|
||||
`akbasic` owns **512–767** per the range map in `CLAUDE.md`. Declare it as an `enum`, so the
|
||||
values stay compile-time integer constants (`HANDLE` expands to `case` labels, which require
|
||||
that) and adding a code does not mean renumbering an offset:
|
||||
|
||||
```c
|
||||
#define AKBASIC_OWNER "akbasic"
|
||||
|
||||
enum {
|
||||
AKBASIC_ERR_BASE = 512, /** Start of akbasic's reserved status range */
|
||||
AKBASIC_ERR_SYNTAX = AKBASIC_ERR_BASE,
|
||||
/** Parse-time grammar violation */
|
||||
AKBASIC_ERR_TYPE, /** Incompatible types in an operation */
|
||||
AKBASIC_ERR_UNDEFINED, /** Reference to an undefined verb, function or label */
|
||||
AKBASIC_ERR_BOUNDS, /** Array subscript or pool index out of range */
|
||||
AKBASIC_ERR_ENVIRONMENT, /** Environment pool exhausted or orphaned environment */
|
||||
AKBASIC_ERR_VALUE, /** A value was malformed, truncated or unconvertible */
|
||||
AKBASIC_ERR_STATE, /** A verb ran outside the block structure it requires */
|
||||
AKBASIC_ERR_LIMIT = AKBASIC_ERR_BASE + 256
|
||||
};
|
||||
```
|
||||
|
||||
`akbasic_init()` reserves the **whole** 256 in one call and then names each code. Both
|
||||
registry calls return `akerr_ErrorContext *` and are `AKERR_NOIGNORE`, so a collision is an
|
||||
ordinary error — `PASS` it and let it propagate out of init:
|
||||
|
||||
```c
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_init(void)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, akerr_reserve_status_range(AKBASIC_ERR_BASE,
|
||||
AKBASIC_ERR_LIMIT - AKBASIC_ERR_BASE,
|
||||
AKBASIC_OWNER));
|
||||
PASS(errctx, akerr_register_status_name(AKBASIC_OWNER, AKBASIC_ERR_SYNTAX,
|
||||
"Syntax Error"));
|
||||
/* ... one per code ... */
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
```
|
||||
|
||||
Reserve the whole range in **one** call — a subset or superset of your own range raises
|
||||
`AKERR_STATUS_RANGE_OVERLAP`, not a no-op. Use `akerr_register_status_name()`, never the
|
||||
two-argument `akerr_name_for_status(status, name)` set path: the owned form is the one that
|
||||
catches a component writing into a range that is not its own, and the two-argument form is
|
||||
what let `libakgl` silently clobber `libakerror`'s names.
|
||||
|
||||
There is no startup ceiling to assert any more — the BSS-overflow hazard the old draft
|
||||
defended against was deleted along with `AKERR_MAX_ERR_VALUE`. What replaces it is the
|
||||
reservation itself: if `akbasic_init()` returns an error, something else owns part of 512–767
|
||||
and the process must not continue as though it does not.
|
||||
|
||||
Do not call `akerr_init()` first. Every registry entry point calls it, and since 1.0.0 it no
|
||||
longer clears reservations made before it ran.
|
||||
|
||||
### 1.8 Error message text is part of the acceptance contract
|
||||
|
||||
`tests/language/array_outofbounds.txt` is, verbatim:
|
||||
|
||||
```
|
||||
? 20 : RUNTIME ERROR Variable index access out of bounds at dimension 0: 4 (max 2)\n\n
|
||||
```
|
||||
|
||||
The trailing double newline is real: `basicError` builds a string ending in `\n` and hands it
|
||||
to `Println`, which adds another. **Reproduce the message strings and the newline behaviour
|
||||
byte for byte** or the golden suite fails for reasons that have nothing to do with the
|
||||
interpreter. Where a Go message reads awkwardly, keep it awkward and note it here.
|
||||
|
||||
Numeric formatting must match too: integers via `%" PRId64 "`, floats via `%f` (Go's `%f` and
|
||||
C's `%f` both give six decimals — `tests/language/arithmetic/float.txt` confirms).
|
||||
|
||||
### 1.9 Which `libakstdlib` calls are cleared for use, and which are not
|
||||
|
||||
`deps/libakstdlib` is at **0.1.0** and its `TODO.md` §2.1 lists six confirmed defects. Four
|
||||
carry a known-failing test, so a green `ctest` over there does not mean what you would
|
||||
assume. Three of the six sit directly in the path of this port. Check this table before
|
||||
reaching for anything in `akstdlib.h`:
|
||||
|
||||
| Call | Verdict | Why |
|
||||
|---|---|---|
|
||||
| `aksl_fopen` / `_fread` / `_fwrite` / `_fclose` | **use** | `DLOAD`/`DSAVE` go through these, never bare libc. `aksl_fopen` does not NULL-check `pathname`/`mode` (§2.2.2) — validate before calling. |
|
||||
| `aksl_malloc` / `_free` | **do not use** | We allocate nothing. Pools only. |
|
||||
| `aksl_memset` / `_memcpy` | **use** | No open defects. |
|
||||
| `aksl_printf` / `_fprintf` / `_sprintf` | **use, under protest** | The stdio text sink needs them. All three call `va_start` with no matching `va_end` on any path (§2.1.4) — undefined behaviour, not ours to fix here, but do not add a fourth wrapper in the same shape. |
|
||||
| `aksl_atoi` / `_atol` / `_atoll` / `_atof` | **BANNED — see below** | Cannot report a conversion failure at all (§2.1.5). |
|
||||
| `aksl_realpath` | **do not use** | Cannot express a buffer size, never NULL-checks `resolved_path`, and its own error path reads uninitialised memory (§2.1.6). Nothing in the port needs it. |
|
||||
| `aksl_strhash_djb2` | **use** | See §1.3 for the high-bit caveat, which does not apply to identifiers. |
|
||||
| `aksl_list_*` | **do not use** | `aksl_list_append` silently truncates to a two-node chain and `aksl_list_iterate` skips the first half of the list — both confirmed (§2.1.1, §2.1.2). The symbol tables in §1.3 are open-addressed and need none of this. |
|
||||
| `aksl_tree_iterate` | **do not use** | `AKERR_ITERATOR_BREAK` does not stop the traversal (§2.1.3). Nothing in the port needs a tree. |
|
||||
|
||||
**The `aksl_ato*` ban is load-bearing, so here is the whole argument.** `atoi("not a number")`
|
||||
returns *success* with `0`, and `atoi("99999999999999999999")` returns *success* with a
|
||||
wrapped value. The Go reference checks the conversion error at every one of these sites and
|
||||
turns it into a BASIC error:
|
||||
|
||||
| Go site | What it does on bad input |
|
||||
|---|---|
|
||||
| `basicgrammar.go:224` `newLiteralInt` → `strconv.ParseInt` | returns `err`, which the parser reports |
|
||||
| `basicgrammar.go` `newLiteralFloat` → `strconv.ParseFloat` | returns `err` |
|
||||
| `basicscanner.go` `matchNumber` → `strconv.Atoi` | `PARSE` error, `"INTEGER CONVERSION ON '%s'"` |
|
||||
| `basicruntime_functions.go:742` `FunctionVAL` | converts a string at runtime and must be able to fail |
|
||||
|
||||
Port those onto `aksl_ato*` and every one of them silently succeeds with `0`. That is not a
|
||||
cosmetic loss: it converts four diagnosable errors into wrong answers, and `VAL("garbage")`
|
||||
starts returning `0.000000` instead of raising. The existing golden files would not catch it —
|
||||
`tests/language/functions/val.txt` only covers `"32"`, `"123.456"` and `"-256"`, all valid.
|
||||
|
||||
**Do this instead:** write one local pair of converters in `src/convert.c`
|
||||
(`akbasic_str_to_int64`, `akbasic_str_to_double`) over `strtoll`/`strtod`, with `errno = 0`
|
||||
before the call, an `endptr` check for both "no digits consumed" and "trailing junk", and a
|
||||
range check — raising `AKBASIC_ERR_VALUE` and `ERANGE` respectively. That is the contract
|
||||
`libakstdlib` §2.1.5 says the `aksl_ato*` family *should* have. When it grows it, delete
|
||||
`src/convert.c` and switch the call sites over; until then, do not paper over the gap by
|
||||
calling the broken function and hoping.
|
||||
|
||||
*Acceptance for `src/convert.c`:* `tests/convert.c` — valid decimal, valid hex, empty string,
|
||||
pure garbage, trailing junk, and an overflowing literal, each asserting the raised status.
|
||||
Add a `.bas`/`.txt` pair for `VAL` on a non-numeric string in the same commit; there is no
|
||||
golden coverage for it today.
|
||||
|
||||
---
|
||||
|
||||
## 2. What exists — **the port is complete and green**
|
||||
|
||||
Phases 0 through 6 of the original plan are done. The interpreter builds clean under
|
||||
`-Wall -Wextra`, reproduces the reference byte for byte, and passes under ASan and UBSan.
|
||||
|
||||
```sh
|
||||
cmake -S . -B build && cmake --build build --parallel
|
||||
ctest --test-dir build --output-on-failure # 59/59
|
||||
cmake -S . -B build-asan -DAKBASIC_SANITIZE=ON # 59/59
|
||||
cmake -S . -B build-cov -DAKBASIC_COVERAGE=ON # 92.3% line, 96.9% function
|
||||
```
|
||||
|
||||
| Module | Source | Reference |
|
||||
|---|---|---|
|
||||
| Strict numeric conversion | `src/convert.c` | *(new; see §1.9)* |
|
||||
| Symbol table | `src/symtab.c` | the five Go maps |
|
||||
| Value | `src/value.c` | `basicvalue.go` |
|
||||
| Variable | `src/variable.c` | `basicvariable.go` |
|
||||
| Tokens and AST leaves | `src/grammar.c` | `basicgrammar.go` + `basicparser.go` |
|
||||
| Dispatch table | `src/verbs.c` | the three reflection lookups |
|
||||
| Scanner | `src/scanner.c` | `basicscanner.go` |
|
||||
| Parser | `src/parser.c`, `src/parser_commands.c` | `basicparser*.go` |
|
||||
| Environment | `src/environment.c` | `basicenvironment.go` |
|
||||
| Runtime | `src/runtime.c` | `basicruntime.go` minus SDL |
|
||||
| Verbs and functions | `src/runtime_commands.c`, `src/runtime_functions.c` | `basicruntime_{commands,functions}.go` |
|
||||
| Text sink | `src/sink_stdio.c` | `basicruntime_graphics.go`'s stdout mirror |
|
||||
| Driver | `src/main.c` | `main.go` |
|
||||
|
||||
**The acceptance suite is the reference's own corpus, driven in place.** All 41 `.bas` files
|
||||
under `deps/basicinterpret/tests/` are registered as individual CTest cases and byte-compared
|
||||
against their `.txt` — including the trailing double newline on an error line (§1.8). Nothing
|
||||
is copied, so the corpus cannot drift from its upstream.
|
||||
|
||||
Eighteen unit tests cover the modules the corpus cannot reach on its own.
|
||||
`tests/known_reference_defects.c` is registered in `AKBASIC_KNOWN_FAILING_TESTS` and asserts
|
||||
the **correct** contract for six of the defects in §6; when one is fixed CTest reports
|
||||
"unexpectedly passed", which is the cue to split that assertion out and strike the item.
|
||||
|
||||
Two budget numbers moved during implementation and are worth knowing:
|
||||
`AKBASIC_MAX_ARRAY_ELEMENTS` (1024) caps one array and `AKBASIC_MAX_ARRAY_VALUES` (4096) caps
|
||||
all of them together, drawn from an `akbasic_ValuePool` the runtime owns. The reference had no
|
||||
such ceiling because it called `make()`.
|
||||
|
||||
---
|
||||
|
||||
|
||||
## 3. Remaining work: the akgl text sink
|
||||
|
||||
**`src/sink_akgl.c`.** Implement the §1.5 vtable against `akgl_text_loadfont` and
|
||||
`akgl_text_rendertextat`. Owns the cursor, the wrap, and the scroll — everything in
|
||||
`basicruntime_graphics.go` except `Write`/`Println`, which are now the sink interface itself.
|
||||
|
||||
**The interpreter does not own the window, the renderer, or the game loop.** The sink draws
|
||||
through whatever renderer the host already initialized. `akbasic_sink_init_akgl()` takes the
|
||||
renderer; it does not create one.
|
||||
|
||||
**Call `akgl_error_init()` before anything else in `libakgl`.** New in `libakgl` 0.1.0
|
||||
(`deps/libakgl/src/error.c`): it reserves the 256–260 status band and registers a name for
|
||||
each `AKGL_ERR_*` code. `akgl_game_init()` calls it first, but we drive subsystems directly and
|
||||
never call `akgl_game_init()`, so it is ours to call. Skip it and every `AKGL_ERR_*` that
|
||||
reaches a stack trace prints "Unknown Error" — which is exactly the defect the upstream commit
|
||||
found in `game.c`, where an SDL failure five lines ahead of the old registration site was
|
||||
guaranteed to be unnamed. It is idempotent, so calling it from both `akbasic_sink_init_akgl()`
|
||||
and a host that already did is harmless.
|
||||
`PASS` its result; a range collision is an initialization failure, not a warning.
|
||||
|
||||
**Known gap:** `libakgl` has no text-measurement call — the Go code needs
|
||||
`font.SizeUTF8("A")` (`basicruntime.go:96`) to compute `maxCharsW`/`maxCharsH`, and there is no
|
||||
`akgl_text_*` equivalent. **File it in `deps/libakgl/TODO.md`** before writing a workaround.
|
||||
See §7.
|
||||
|
||||
*Acceptance:* `tests/sink_akgl.c` against the offscreen renderer harness, or — if that harness
|
||||
does not exist yet — a known-failing test plus a `libakgl` TODO entry saying so.
|
||||
|
||||
---
|
||||
|
||||
## 4. Remaining work: language completion (goal 2)
|
||||
|
||||
The work queue is the "What Isn't Implemented" list in `deps/basicinterpret/README.md`.
|
||||
Each verb is: table row (§1.1) → parse handler if it needs one → exec handler → unit test →
|
||||
a new `.bas`/`.txt` pair. **Both** kinds of test; they answer different questions.
|
||||
|
||||
Order by what unblocks the most, and by what does not need `libakgl` to grow first:
|
||||
|
||||
| Group | Verbs | Blocked on |
|
||||
|---|---|---|
|
||||
| A. Structure | `DO`, `LOOP`, `WHILE`, `UNTIL`, `ON`, `BEGIN`, `BEND`, `END` | nothing — reuses `waitingForCommand` |
|
||||
| B. Housekeeping | `NEW`, `CLR`, `CONT`, `RESTORE`, `RENUMBER`, `SWAP`, `TRON`, `TROFF`, `HELP` | nothing |
|
||||
| C. Errors | `TRAP`, `RESUME`, `ER`, `ERR` | needs a BASIC-visible error object |
|
||||
| D. Strings/format | `USING`, `PUDEF`, `WIDTH`, `CHAR` | nothing |
|
||||
| E. Console | `GET`, `GETKEY`, `SCNCLR`, `LOCATE`, `WINDOW`, `KEY`, `SLEEP`, `WAIT`, `TI` | sink + `libakgl` input |
|
||||
| F. Disk | `DOPEN`, `DCLOSE`, `APPEND`, `RECORD`, `HEADER`, `COLLECT`, `BACKUP`, `COPY`, `CONCAT`, `RENAME`, `SCRATCH`, `DIRECTORY`, `CATALOG`, `DCLEAR`, `DVERIFY`, `SAVE`, `LOAD`, `VERIFY`, `BLOAD`, `BSAVE`, `BOOT` | `aksl_f*` only; no new akgl |
|
||||
| G. Graphics | `GRAPHIC`, `DRAW`, `BOX`, `CIRCLE`, `PAINT`, `COLOR`, `SCALE`, `SSHAPE`, `GSHAPE`, `LOCATE` | **`libakgl` immediate-mode draw API — file it** |
|
||||
| H. Sprites | `SPRITE`, `MOVSPR`, `SPRCOLOR`, `SPRDEF`, `SPRSAV`, `COLLISION` | `libakgl` sprite/actor API — check before filing |
|
||||
| I. Audio | `PLAY`, `SOUND`, `ENVELOPE`, `FILTER`, `VOL`, `TEMPO` | **`libakgl` has no mixer-backed audio API — file it** |
|
||||
| J. Machine | `SYS`, `FETCH`, `STASH`, `POKE`/`PEEK` variants | nothing |
|
||||
|
||||
**Out of scope, and staying that way** — the reference marks these as incompatible with a
|
||||
modern PC and that reasoning stands: `BANK` (no bank switching), `FAST` (irrelevant CPU speed
|
||||
control), `MONITOR` (no machine-language monitor).
|
||||
|
||||
Also on the queue, from the reference's own defect list:
|
||||
|
||||
- **Multiple statements per line** (`10 PRINT A$ : REM ...`). The `COLON` token exists
|
||||
(`basicscanner.go:40`) and nothing consumes it. This changes the parser's statement loop and
|
||||
should be done before group A, because `DO`/`LOOP` bodies read badly without it.
|
||||
- **Array references in parameter lists** (`READ A$(0), B#`) currently fail to parse. Fix in
|
||||
`argumentList`.
|
||||
|
||||
---
|
||||
|
||||
## 5. Deliberate deviations from the reference
|
||||
|
||||
Keep this list current. Each of these changes structure without changing observable output,
|
||||
and each one has to be defensible against the golden suite.
|
||||
|
||||
1. Reflection → static dispatch table (§1.1).
|
||||
2. Go maps → fixed open-addressed tables (§1.3).
|
||||
3. Unbounded `new(BasicEnvironment)` → pool with release (§1.4).
|
||||
4. Hardcoded stdout+SDL mirror → text sink backend (§1.5).
|
||||
5. `run()` owns the process → `step()` / bounded `run()` (§1.6).
|
||||
6. `panic()` → `FAIL_RETURN`; no library call terminates the process (§1.6).
|
||||
7. `debug.PrintStack()` on parse error → the `akerr` stack trace only (§3.1 of the original plan).
|
||||
8. `BasicEnvironment.eval_clone_identifiers` deleted as dead state (§4.2 of the original plan).
|
||||
9. `BasicValue.name` and `BasicEnvironment.update()` deleted as dead: nothing ever writes the
|
||||
field a non-empty string, and `update()` — its only reader — has no callers.
|
||||
10. The `DEF`-statement bootstrap is gone. The reference declares every builtin by *running a
|
||||
BASIC program of `DEF` lines through the interpreter* at startup and then nulling out the
|
||||
expressions (`basicruntime_functions.go:14`); here a builtin's name, arity and handler are
|
||||
a row in the dispatch table, and `MOD`, `SPC` and `STR` are ordinary native handlers. This
|
||||
removes the need to run the interpreter before the interpreter is ready.
|
||||
11. Undefined behaviour the reference reaches by a defined route is refused rather than
|
||||
inherited: a shift count outside 0..63, a negative string multiplier, and integer division
|
||||
by zero all raise. Go defines all three (or panics); C does not. No golden case exercises
|
||||
any of them, so observable behaviour is unchanged.
|
||||
12. `CommandEXIT` clears the pending `NEXT` wait before popping. The reference does not, which
|
||||
leaves the parent waiting for a `NEXT` that never arrives (§6 item 8) — in C that is a hang
|
||||
rather than a misbehaviour, and no golden case depends on it.
|
||||
|
||||
---
|
||||
|
||||
## 6. Reference defects — ported faithfully, fix them deliberately
|
||||
|
||||
These are real bugs in `deps/basicinterpret`. **Port the behaviour first** so the golden suite
|
||||
passes and the port is provably faithful, then fix each one in its own commit with a test that
|
||||
asserts the correct contract. Until fixed, the correct-contract test lives in
|
||||
`AKBASIC_KNOWN_FAILING_TESTS`.
|
||||
|
||||
1. **`basicvariable.go:176`** — `toString()` tests `len(self.values) == 0` and then indexes
|
||||
`self.values[0]`. Inverted condition; on an empty variable it panics, and on a non-empty one
|
||||
it returns the "not implemented for arrays" string. *Consequence:* `PRINT` of a scalar
|
||||
through this path is wrong. Fix: `if ( count == 1 )`.
|
||||
2. **`basicvariable.go:108`** — `setBoolean` builds a value with `valuetype: TYPE_STRING`.
|
||||
*Consequence:* a boolean stored in a variable reads back as a string with an empty
|
||||
`stringval`. Fix: `TYPE_BOOLEAN`.
|
||||
3. **`basicenvironment.go:157`** — `stopWaiting(command)` ignores `command` and clears the
|
||||
wait unconditionally. *Consequence:* an inner block can clear an outer block's wait. Fix:
|
||||
compare before clearing, and error on a mismatch.
|
||||
4. **`basicvalue.go:181`** — `mathPlus` mutates `self` in place when `self.mutable` is true,
|
||||
while every other operator always clones. *Consequence:* `A# + 1` can modify `A#` depending
|
||||
on where the value came from. This one is high blast radius; it interacts with
|
||||
`eval_clone_identifiers` and with `CommandNEXT`'s increment
|
||||
(`basicruntime_commands.go:663`), which **relies** on the mutation. Do not fix it before
|
||||
`FOR`/`NEXT` has full test coverage.
|
||||
5. **`basicvalue.go:191` and siblings** — every binary operator adds both of the right-hand
|
||||
operand's numeric fields: `rval.intval + int64(rval.floatval)`. Works only because the
|
||||
unused field is always zero. *Consequence:* none today; it is a landmine for any future
|
||||
value that carries both.
|
||||
6. **`basicvalue.go`, all comparisons** — `dest` is cloned from `self`, so the resulting
|
||||
boolean inherits `self.name`. *Consequence:* a comparison result can be written back to the
|
||||
wrong variable through `environment.update()`.
|
||||
7. **`basicruntime_commands.go:484`** — `CommandIF` walks `expr.right` to the end of the chain
|
||||
looking for a `THEN` command, then dereferences `expr.right` after the loop guaranteed it
|
||||
is `nil`. *Consequence:* the "Malformed IF statement" check is unreachable and nested
|
||||
`IF ... THEN ... ELSE` is unverified.
|
||||
8. **`basicruntime_commands.go:669`** — `CommandEXIT` pops the environment without
|
||||
`stopWaiting`, leaving the parent waiting on a `NEXT` that will never come.
|
||||
9. **`basicruntime.go:149`** — `newVariable()` and `BasicRuntime.variables[MAX_VARIABLES]` are
|
||||
dead; variables live in the environment's map. Do not port them.
|
||||
10. **`basicgrammar.go:224`** — `newLiteralInt` selects base 8 whenever the lexeme starts with
|
||||
`0`. *Consequence:* `PRINT 08` is a parse error and `PRINT 010` prints 8. Commodore BASIC
|
||||
has no octal literals. Fix: base 10 unless prefixed `0x`.
|
||||
11. **`basicruntime.go:121` / `basicparser_commands.go:124`** — environments are never freed.
|
||||
Addressed structurally by §1.4; no separate fix needed, but the C pool **will** exhaust
|
||||
where Go merely leaked, so `tests/environment_scope.c`'s exhaustion assertion matters.
|
||||
|
||||
### Found during the port
|
||||
|
||||
Five more, none of which the reference's own corpus catches. Each is reproduced faithfully,
|
||||
pinned by an assertion in the relevant unit test, and asserted *correctly* in
|
||||
`tests/known_reference_defects.c`.
|
||||
|
||||
12. **`basicparser.go:329` — `subtraction()` returns after one operator where `addition()`
|
||||
loops, so `1 - 2 - 3` computes `1 - 2` and abandons the rest of the line.** The remaining
|
||||
`- 3` is left in the token stream and the statement loop picks it up as a second statement,
|
||||
which evaluates and is discarded. *Consequence:* a chain of two or more subtractions
|
||||
silently produces the wrong answer. This is the highest-impact item on the list — it is a
|
||||
wrong result, not a refused one. The same shape appears in `exponent()`, so `2 ^ 3 ^ 2`
|
||||
has it too. Fix: make both loop the way `addition()` does. Pinned in
|
||||
`tests/parser_expressions.c`.
|
||||
|
||||
13. **`basicparser.go:565` — a unary-minus argument inflates a function's arity count.** The
|
||||
counter walks the `.right` chain, and a unary leaf keeps its operand on `.right`, so
|
||||
`ABS(-9)` is counted as two arguments and refused with "function ABS takes 1 arguments,
|
||||
received 2". *Consequence:* no builtin can be called with a negative literal. The corpus
|
||||
hides it — `sgn.bas` assigns `-1` to a variable first. Fix: count only the top-level
|
||||
argument chain, not whatever a leaf hangs off `.right`. Pinned in
|
||||
`tests/runtime_evaluate.c`.
|
||||
|
||||
14. **`basicscanner.go:272` — `matchNextChar` returns without setting a token type when it
|
||||
cannot peek past the end of the line, so a comparison operator in the final column is
|
||||
silently dropped.** `A# =` produces one token, not two. *Consequence:* a line ending in a
|
||||
bare `<`, `>` or `=` loses it, and the parse error that follows points at the wrong place.
|
||||
Fix: set `falsetype` before returning on the peek failure. Pinned in
|
||||
`tests/scanner_tokens.c`.
|
||||
|
||||
15. **`basicscanner.go:318` — hex literals do not survive the scanner.** `matchNumber` allows
|
||||
`x` through but not the hex digits after it, so `0xff` lexes as `0x` and `ff` is scanned
|
||||
as a separate identifier. *Consequence:* the base-16 branch in `newLiteralInt`
|
||||
(`basicgrammar.go:224`) is unreachable, and the README's hex support does not exist. Fix:
|
||||
once `x` has been seen, accept `[0-9a-fA-F]`. Pinned in `tests/scanner_tokens.c`.
|
||||
|
||||
16. **`basicscanner.go:349` — the "Reserved word in variable name" check never fires.** The
|
||||
lexeme still carries its type suffix when the keyword tables are searched, so `PRINT$`
|
||||
misses every table and becomes an ordinary string variable. *Consequence:* the diagnostic
|
||||
is dead code and `PRINT$ = 1` is accepted. Fix: strip the suffix before the lookup. Pinned
|
||||
in `tests/scanner_tokens.c`.
|
||||
|
||||
---
|
||||
|
||||
## 7. Filing gaps against `libakgl`
|
||||
|
||||
When phase 7 or phase 8 needs something `libakgl` does not have, **stop and file it** in
|
||||
`deps/libakgl/TODO.md` in that file's numbered prose style: what the BASIC verb requires, what
|
||||
the `akgl_*` entry point should look like, and what tests would cover it. Growing `libakgl` to
|
||||
serve the interpreter is a wanted outcome, not a detour.
|
||||
|
||||
Known gaps, to be filed as they are reached:
|
||||
|
||||
1. **Text measurement.** No `akgl_text_*` call returns the pixel size of a string in a font.
|
||||
`PRINT` wrapping, the cursor, and `WIDTH` all need it. Blocks 7.1.
|
||||
2. **Immediate-mode drawing.** `src/draw.c` is at 0% coverage and there is no public API for
|
||||
lines, boxes, circles or flood fill. Blocks group G.
|
||||
3. **Audio.** There is no mixer-backed API at all. Blocks group I entirely.
|
||||
4. **Console input.** `GET`/`GETKEY` need a non-blocking keystroke read that does not require
|
||||
the interpreter to own the SDL event loop. Blocks part of group E.
|
||||
|
||||
---
|
||||
|
||||
## 8. Status
|
||||
|
||||
**The port is done.** The C interpreter reproduces the Go reference byte for byte across its
|
||||
entire test corpus and passes clean under ASan and UBSan.
|
||||
|
||||
| Gate | Result |
|
||||
|---|---|
|
||||
| `ctest` | 59/59 — 41 golden cases, 17 unit tests, 1 known-failing |
|
||||
| Golden corpus | 41/41 byte-exact, driven in place from the submodule |
|
||||
| ASan + UBSan | 59/59 |
|
||||
| Line coverage | 92.3% (2823/3058) — above the 90% gate |
|
||||
| Function coverage | 96.9% (221/228) |
|
||||
| Warnings | none under `-Wall -Wextra` |
|
||||
|
||||
Branch coverage reads 17.3% and is not a target, for the reason `libakgl/TODO.md` and
|
||||
`libakstdlib/TODO.md` both give: the akerror control-flow macros expand into large branch trees
|
||||
at every call site, most of them unreachable in normal operation. Track line and function
|
||||
coverage.
|
||||
|
||||
Dependency baseline:
|
||||
|
||||
| Submodule | Version | Notes |
|
||||
|---|---|---|
|
||||
| `deps/libakerror` | 1.0.0 | Private ownership-enforced status registry. akbasic reserves 512–767 in `akbasic_error_register()`. Does not namespace its `coverage` target when embedded — worked around in our `CMakeLists.txt`. |
|
||||
| `deps/libakstdlib` | 0.1.0 | soname `libakstdlib.so.0.1`. `AKSL_VERSION_CHECK()` asserted in `tests/version_check.c`. Its `aksl_ato*` family is banned here — see §1.9. |
|
||||
| `deps/libakgl` | 0.1.0 | Migrated to the 1.0.0 registry and owns 256–260. Not yet linked: `AKBASIC_WITH_AKGL` defaults OFF and `src/sink_akgl.c` does not exist. |
|
||||
|
||||
What remains, in priority order:
|
||||
|
||||
1. **§3 — the akgl text sink.** Blocked on `libakgl` having no text-measurement call; that gap
|
||||
needs filing in `deps/libakgl/TODO.md` before any workaround is written.
|
||||
2. **§4 — the language completion work queue.** Groups A, B, D, F and J need nothing from
|
||||
`libakgl` and can start immediately. Multiple statements per line (the `COLON` token exists
|
||||
and nothing consumes it) should come first, because `DO`/`LOOP` reads badly without it.
|
||||
3. **§6 items 12–16** — the defects the port uncovered. Item 12 is the one that produces a
|
||||
*wrong answer* rather than a refused one, and should be fixed first.
|
||||
1
deps/basicinterpret
vendored
Submodule
1
deps/basicinterpret
vendored
Submodule
Submodule deps/basicinterpret added at d76162cb37
1
deps/libakerror
vendored
Submodule
1
deps/libakerror
vendored
Submodule
Submodule deps/libakerror added at 5ff87908e7
1
deps/libakgl
vendored
Submodule
1
deps/libakgl
vendored
Submodule
Submodule deps/libakgl added at 6dfe7487ae
1
deps/libakstdlib
vendored
Submodule
1
deps/libakstdlib
vendored
Submodule
Submodule deps/libakstdlib added at 95e5002512
46
include/akbasic/convert.h
Normal file
46
include/akbasic/convert.h
Normal file
@@ -0,0 +1,46 @@
|
||||
/**
|
||||
* @file convert.h
|
||||
* @brief Declares string-to-number conversion that can actually report failure.
|
||||
*
|
||||
* This exists because libakstdlib's aksl_atoi/atol/atoll/atof family cannot:
|
||||
* atoi("not a number") returns success with 0, and an overflowing literal
|
||||
* returns success with a wrapped value (deps/libakstdlib/TODO.md 2.1.5). The Go
|
||||
* reference checks the conversion error at every numeric site and turns it into
|
||||
* a BASIC error, so porting onto that family would convert four diagnosable
|
||||
* errors into wrong answers.
|
||||
*
|
||||
* Delete this file and switch the call sites over when libakstdlib grows the
|
||||
* stricter contract its TODO.md already specifies.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_CONVERT_H_
|
||||
#define _AKBASIC_CONVERT_H_
|
||||
|
||||
#include <stdint.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
/**
|
||||
* @brief Convert a complete string to a 64-bit integer.
|
||||
* @param str Source string; must be entirely consumed.
|
||||
* @param base Numeric base, or 0 to let strtoll infer it from a 0x/0 prefix.
|
||||
* @param dest Output destination populated by the function.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_NULLPOINTER When `str` or `dest` is NULL.
|
||||
* @throws AKBASIC_ERR_VALUE When no digits were consumed or trailing junk remains.
|
||||
* @throws ERANGE When the value does not fit in an int64_t.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_str_to_int64(const char *str, int base, int64_t *dest);
|
||||
|
||||
/**
|
||||
* @brief Convert a complete string to a double.
|
||||
* @param str Source string; must be entirely consumed.
|
||||
* @param dest Output destination populated by the function.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_NULLPOINTER When `str` or `dest` is NULL.
|
||||
* @throws AKBASIC_ERR_VALUE When no digits were consumed or trailing junk remains.
|
||||
* @throws ERANGE When the value is out of range for a double.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_str_to_double(const char *str, double *dest);
|
||||
|
||||
#endif // _AKBASIC_CONVERT_H_
|
||||
116
include/akbasic/environment.h
Normal file
116
include/akbasic/environment.h
Normal file
@@ -0,0 +1,116 @@
|
||||
/**
|
||||
* @file environment.h
|
||||
* @brief Declares a scope and the per-line working state that rides with it.
|
||||
*
|
||||
* Ported from basicenvironment.go. An environment is both a variable scope and
|
||||
* the in-flight state of whatever block structure is executing: IF, FOR, GOSUB
|
||||
* and READ all park their bookkeeping here.
|
||||
*
|
||||
* The reference allocates one with new() per FOR and per GOSUB and never frees
|
||||
* it. Here they come from a pool the runtime owns and are released on pop, so a
|
||||
* long-running program exhausts a bounded resource and says so rather than
|
||||
* leaking quietly.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_ENVIRONMENT_H_
|
||||
#define _AKBASIC_ENVIRONMENT_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/grammar.h>
|
||||
#include <akbasic/symtab.h>
|
||||
#include <akbasic/types.h>
|
||||
#include <akbasic/value.h>
|
||||
#include <akbasic/variable.h>
|
||||
|
||||
struct akbasic_Runtime;
|
||||
|
||||
typedef struct akbasic_Environment
|
||||
{
|
||||
akbasic_SymbolTable variables; /** name -> akbasic_Variable * */
|
||||
akbasic_SymbolTable functions; /** name -> akbasic_FunctionDef * */
|
||||
akbasic_SymbolTable labels; /** name -> line number */
|
||||
|
||||
/* FOR state */
|
||||
akbasic_ASTLeaf *forStepLeaf;
|
||||
akbasic_Value forStepValue;
|
||||
akbasic_ASTLeaf *forToLeaf;
|
||||
akbasic_Value forToValue;
|
||||
akbasic_Variable *forNextVariable;
|
||||
|
||||
/* Loop bounds */
|
||||
int64_t loopFirstLine;
|
||||
int64_t loopExitLine;
|
||||
|
||||
int64_t gosubReturnLine;
|
||||
|
||||
/* READ state. The identifier leaves are deep copies, so they need storage. */
|
||||
int64_t readReturnLine;
|
||||
akbasic_ASTLeaf *readIdentifierLeaves[AKBASIC_MAX_LEAVES];
|
||||
int64_t readIdentifierIdx;
|
||||
akbasic_ASTLeaf readLeafStorage[AKBASIC_MAX_LEAVES];
|
||||
akbasic_LeafPool readLeafPool;
|
||||
|
||||
/*
|
||||
* While this is set, no line executes until a COMMAND matching it is found.
|
||||
* It is what keeps the body of a loop that should not run at all from
|
||||
* running, given that the reference evaluates a loop's condition at the
|
||||
* *bottom* of the structure. Any reimplementation has to reproduce it or
|
||||
* restructure control flow deliberately.
|
||||
*/
|
||||
char waitingForCommand[AKBASIC_SYMTAB_MAX_KEY];
|
||||
|
||||
struct akbasic_Environment *parent;
|
||||
struct akbasic_Runtime *runtime;
|
||||
|
||||
/* Runtime state */
|
||||
int64_t lineno;
|
||||
akbasic_Value values[AKBASIC_MAX_VALUES];
|
||||
int nextvalue;
|
||||
int64_t nextline;
|
||||
akbasic_Value returnValue;
|
||||
|
||||
/* Parser state */
|
||||
akbasic_Token tokens[AKBASIC_MAX_TOKENS];
|
||||
int nexttoken;
|
||||
int curtoken;
|
||||
akbasic_ASTLeaf leaves[AKBASIC_MAX_LEAVES];
|
||||
int nextleaf;
|
||||
akbasic_Token *errorToken;
|
||||
|
||||
bool used; /** Pool bookkeeping */
|
||||
} akbasic_Environment;
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_init(akbasic_Environment *obj, struct akbasic_Runtime *runtime, akbasic_Environment *parent);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_zero(akbasic_Environment *obj);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_zero_parser(akbasic_Environment *obj);
|
||||
|
||||
/** @brief Take the next value from this environment's per-line pool. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_new_value(akbasic_Environment *obj, akbasic_Value **dest);
|
||||
|
||||
/** @brief Take the next leaf from this environment's per-line pool. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_new_leaf(akbasic_Environment *obj, akbasic_ASTLeaf **dest);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_wait_for_command(akbasic_Environment *obj, const char *command);
|
||||
bool akbasic_environment_is_waiting_for_any(akbasic_Environment *obj);
|
||||
bool akbasic_environment_is_waiting_for(akbasic_Environment *obj, const char *command);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_stop_waiting(akbasic_Environment *obj, const char *command);
|
||||
|
||||
/**
|
||||
* @brief Find a variable, creating it in the active environment if it is absent.
|
||||
*
|
||||
* Parents do not create variables on behalf of their children: only the
|
||||
* runtime's currently active environment auto-creates. A lookup that misses in a
|
||||
* non-active environment returns NULL through `dest` without error, matching the
|
||||
* reference.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_get(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_get_label(akbasic_Environment *obj, const char *label, int64_t *dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_set_label(akbasic_Environment *obj, const char *label, int64_t value);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_get_function(akbasic_Environment *obj, const char *fname, void **dest);
|
||||
|
||||
/** @brief Assign into the slot an lvalue leaf names, following any subscripts. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_assign(akbasic_Environment *obj, akbasic_ASTLeaf *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
|
||||
#endif // _AKBASIC_ENVIRONMENT_H_
|
||||
71
include/akbasic/error.h
Normal file
71
include/akbasic/error.h
Normal file
@@ -0,0 +1,71 @@
|
||||
/**
|
||||
* @file error.h
|
||||
* @brief Declares akbasic's status codes and the registry claim for them.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_ERROR_H_
|
||||
#define _AKBASIC_ERROR_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
/*
|
||||
* libakerror 1.0.0 is the floor. That release moved the status-name table into a
|
||||
* private registry -- AKERR_MAX_ERR_VALUE and __AKERR_ERROR_NAMES are gone, the
|
||||
* registry entry points raise akerr_ErrorContext * instead of returning int, and
|
||||
* the library gained an soname -- so a translation unit that pairs this header
|
||||
* with a pre-1.0.0 akerror.h is an ABI mismatch, not just a compile problem.
|
||||
*
|
||||
* libakerror publishes no version macro, so this feature-tests on
|
||||
* AKERR_FIRST_CONSUMER_STATUS, which that release introduced. Same guard
|
||||
* libakstdlib and libakgl already carry.
|
||||
*/
|
||||
#ifndef AKERR_FIRST_CONSUMER_STATUS
|
||||
#error "libakbasic requires libakerror >= 1.0.0: the akerror.h on the include path predates the status registry. Rebuild and reinstall libakerror."
|
||||
#endif
|
||||
|
||||
/*
|
||||
* libakerror reserves 0-255 for the host's errno values and its own AKERR_*
|
||||
* codes. libakgl claims 256-260. akbasic claims 512-767, leaving 261-511 as
|
||||
* headroom for libakgl to grow into -- see CLAUDE.md for the coordinated range
|
||||
* map, which is the only coordination there is: libakerror can enumerate its
|
||||
* consumers no better than we can.
|
||||
*
|
||||
* These are absolute constants, never offsets from AKERR_LAST_ERRNO_VALUE, so a
|
||||
* libc that grows an errno cannot move them. An enum rather than a chain of
|
||||
* #defines so the values stay compile-time integer constants -- HANDLE expands
|
||||
* to case labels, which require that.
|
||||
*
|
||||
* Add a code here and you must name it in akbasic_error_register(), or it prints
|
||||
* as "Unknown Error" in every stack trace that carries it.
|
||||
*/
|
||||
#define AKBASIC_OWNER "akbasic"
|
||||
|
||||
enum {
|
||||
AKBASIC_ERR_BASE = 512, /** Start of akbasic's reserved status range */
|
||||
AKBASIC_ERR_SYNTAX = AKBASIC_ERR_BASE,
|
||||
/** Parse-time grammar violation */
|
||||
AKBASIC_ERR_TYPE, /** Incompatible types in an operation */
|
||||
AKBASIC_ERR_UNDEFINED, /** Reference to an undefined verb, function or label */
|
||||
AKBASIC_ERR_BOUNDS, /** Array subscript or pool index out of range */
|
||||
AKBASIC_ERR_ENVIRONMENT, /** Environment pool exhausted or orphaned environment */
|
||||
AKBASIC_ERR_VALUE, /** A value was malformed, truncated or unconvertible */
|
||||
AKBASIC_ERR_STATE, /** A verb ran outside the block structure it requires */
|
||||
AKBASIC_ERR_LIMIT = AKBASIC_ERR_BASE + 256
|
||||
};
|
||||
|
||||
/**
|
||||
* @brief Claim the akbasic status band and register a name for every code in it.
|
||||
*
|
||||
* Reserves the whole 256-value range in one call -- libakerror treats only an
|
||||
* identical reservation as a repeat, so a subset or superset raises -- and then
|
||||
* names each code through the owned entry point. Call it before anything else in
|
||||
* the library. Repeating the call is a no-op.
|
||||
*
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_STATUS_RANGE_OVERLAP When another component already owns part of the band.
|
||||
* @throws AKERR_STATUS_RANGE_FULL When libakerror has no reservation slots left.
|
||||
* @throws AKERR_STATUS_NAME_FULL When libakerror's name registry is full.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_error_register(void);
|
||||
|
||||
#endif // _AKBASIC_ERROR_H_
|
||||
163
include/akbasic/grammar.h
Normal file
163
include/akbasic/grammar.h
Normal file
@@ -0,0 +1,163 @@
|
||||
/**
|
||||
* @file grammar.h
|
||||
* @brief Declares the token and AST leaf types the scanner and parser share.
|
||||
*
|
||||
* The reference splits these across basicscanner.go (BasicTokenType),
|
||||
* basicparser.go (BasicToken) and basicgrammar.go (BasicASTLeafType,
|
||||
* BasicASTLeaf). They are one header here because a leaf's operator *is* a token
|
||||
* type and separating them buys nothing in C. The numeric values are preserved
|
||||
* from the reference so a debugging session against either implementation reads
|
||||
* the same.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_GRAMMAR_H_
|
||||
#define _AKBASIC_GRAMMAR_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/types.h>
|
||||
|
||||
typedef enum
|
||||
{
|
||||
AKBASIC_TOK_UNDEFINED = 0,
|
||||
AKBASIC_TOK_EQUAL, /* 1 */
|
||||
AKBASIC_TOK_LESS_THAN, /* 2 */
|
||||
AKBASIC_TOK_LESS_THAN_EQUAL, /* 3 */
|
||||
AKBASIC_TOK_GREATER_THAN, /* 4 */
|
||||
AKBASIC_TOK_GREATER_THAN_EQUAL, /* 5 */
|
||||
AKBASIC_TOK_COMMA, /* 6 */
|
||||
AKBASIC_TOK_HASH, /* 7 */
|
||||
AKBASIC_TOK_NOT_EQUAL, /* 8 */
|
||||
AKBASIC_TOK_LEFT_PAREN, /* 9 */
|
||||
AKBASIC_TOK_RIGHT_PAREN, /* 10 */
|
||||
AKBASIC_TOK_PLUS, /* 11 */
|
||||
AKBASIC_TOK_MINUS, /* 12 */
|
||||
AKBASIC_TOK_LEFT_SLASH, /* 13 */
|
||||
AKBASIC_TOK_STAR, /* 14 */
|
||||
AKBASIC_TOK_CARAT, /* 15 */
|
||||
AKBASIC_TOK_LITERAL_STRING, /* 16 */
|
||||
AKBASIC_TOK_LITERAL_INT, /* 17 */
|
||||
AKBASIC_TOK_LITERAL_FLOAT, /* 18 */
|
||||
AKBASIC_TOK_IDENTIFIER, /* 19 */
|
||||
AKBASIC_TOK_IDENTIFIER_STRING, /* 20 */
|
||||
AKBASIC_TOK_IDENTIFIER_FLOAT, /* 21 */
|
||||
AKBASIC_TOK_IDENTIFIER_INT, /* 22 */
|
||||
AKBASIC_TOK_COLON, /* 23 */
|
||||
AKBASIC_TOK_AND, /* 24 */
|
||||
AKBASIC_TOK_NOT, /* 25 */
|
||||
AKBASIC_TOK_OR, /* 26 */
|
||||
AKBASIC_TOK_REM, /* 27 */
|
||||
AKBASIC_TOK_EOL, /* 28 */
|
||||
AKBASIC_TOK_EOF, /* 29 */
|
||||
AKBASIC_TOK_LINE_NUMBER, /* 30 -- an integer literal in token position 0 */
|
||||
AKBASIC_TOK_COMMAND, /* 31 */
|
||||
AKBASIC_TOK_COMMAND_IMMEDIATE, /* 32 */
|
||||
AKBASIC_TOK_FUNCTION, /* 33 */
|
||||
AKBASIC_TOK_ASSIGNMENT, /* 34 */
|
||||
AKBASIC_TOK_LEFT_SQUAREBRACKET, /* 35 */
|
||||
AKBASIC_TOK_RIGHT_SQUAREBRACKET, /* 36 */
|
||||
AKBASIC_TOK_ARRAY_SUBSCRIPT, /* 37 */
|
||||
AKBASIC_TOK_FUNCTION_ARGUMENT, /* 38 */
|
||||
AKBASIC_TOK_ATSYMBOL, /* 39 */
|
||||
AKBASIC_TOK_IDENTIFIER_STRUCT /* 40 */
|
||||
} akbasic_TokenType;
|
||||
|
||||
typedef enum
|
||||
{
|
||||
AKBASIC_LEAF_UNDEFINED = 0,
|
||||
AKBASIC_LEAF_LITERAL_INT, /* 1 */
|
||||
AKBASIC_LEAF_LITERAL_FLOAT, /* 2 */
|
||||
AKBASIC_LEAF_LITERAL_STRING, /* 3 */
|
||||
AKBASIC_LEAF_IDENTIFIER, /* 4 */
|
||||
AKBASIC_LEAF_IDENTIFIER_INT, /* 5 */
|
||||
AKBASIC_LEAF_IDENTIFIER_FLOAT, /* 6 */
|
||||
AKBASIC_LEAF_IDENTIFIER_STRING, /* 7 */
|
||||
AKBASIC_LEAF_UNARY, /* 8 */
|
||||
AKBASIC_LEAF_BINARY, /* 9 */
|
||||
AKBASIC_LEAF_GROUPING, /* 10 */
|
||||
AKBASIC_LEAF_EQUALITY, /* 11 */
|
||||
AKBASIC_LEAF_COMPARISON, /* 12 */
|
||||
AKBASIC_LEAF_TERM, /* 13 */
|
||||
AKBASIC_LEAF_PRIMARY, /* 14 */
|
||||
AKBASIC_LEAF_COMMAND, /* 15 */
|
||||
AKBASIC_LEAF_COMMAND_IMMEDIATE, /* 16 */
|
||||
AKBASIC_LEAF_FUNCTION, /* 17 */
|
||||
AKBASIC_LEAF_BRANCH, /* 18 */
|
||||
AKBASIC_LEAF_ARGUMENTLIST, /* 19 */
|
||||
AKBASIC_LEAF_IDENTIFIER_STRUCT /* 20 */
|
||||
} akbasic_LeafType;
|
||||
|
||||
typedef struct
|
||||
{
|
||||
akbasic_TokenType tokentype;
|
||||
int64_t lineno;
|
||||
char lexeme[AKBASIC_MAX_LINE_LENGTH];
|
||||
} akbasic_Token;
|
||||
|
||||
typedef struct akbasic_ASTLeaf
|
||||
{
|
||||
akbasic_LeafType leaftype;
|
||||
int64_t literal_int;
|
||||
char literal_string[AKBASIC_MAX_STRING_LENGTH];
|
||||
double literal_float;
|
||||
char identifier[AKBASIC_MAX_STRING_LENGTH];
|
||||
akbasic_TokenType operator_;
|
||||
struct akbasic_ASTLeaf *parent;
|
||||
struct akbasic_ASTLeaf *left;
|
||||
struct akbasic_ASTLeaf *right;
|
||||
struct akbasic_ASTLeaf *expr;
|
||||
} akbasic_ASTLeaf;
|
||||
|
||||
/**
|
||||
* @brief A pool of leaves a deep clone can draw from.
|
||||
*
|
||||
* The reference's BasicASTLeaf.clone() recurses and allocates. Here the caller
|
||||
* supplies storage and a deep clone that would exceed it fails rather than
|
||||
* growing without bound.
|
||||
*/
|
||||
typedef struct
|
||||
{
|
||||
int next;
|
||||
int capacity;
|
||||
akbasic_ASTLeaf *leaves;
|
||||
} akbasic_LeafPool;
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_token_init(akbasic_Token *obj);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_init(akbasic_ASTLeaf *obj, akbasic_LeafType leaftype);
|
||||
|
||||
/**
|
||||
* @brief Deep-copy a leaf and everything hanging off it into pool storage.
|
||||
* @param self Source leaf.
|
||||
* @param pool Storage the copies are drawn from.
|
||||
* @param dest Output destination populated by the function.
|
||||
* @throws AKBASIC_ERR_BOUNDS When the pool runs out of leaves.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_clone(akbasic_ASTLeaf *self, akbasic_LeafPool *pool, akbasic_ASTLeaf **dest);
|
||||
|
||||
/** @brief The first argument of a function-call leaf, or NULL. */
|
||||
akbasic_ASTLeaf *akbasic_leaf_first_argument(akbasic_ASTLeaf *self);
|
||||
|
||||
/** @brief The first subscript of an array-reference leaf, or NULL. */
|
||||
akbasic_ASTLeaf *akbasic_leaf_first_subscript(akbasic_ASTLeaf *self);
|
||||
|
||||
bool akbasic_leaf_is_identifier(akbasic_ASTLeaf *self);
|
||||
bool akbasic_leaf_is_literal(akbasic_ASTLeaf *self);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_comparison(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *left, akbasic_TokenType op, akbasic_ASTLeaf *right);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_binary(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *left, akbasic_TokenType op, akbasic_ASTLeaf *right);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_unary(akbasic_ASTLeaf *obj, akbasic_TokenType op, akbasic_ASTLeaf *right);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_function(akbasic_ASTLeaf *obj, const char *fname, akbasic_ASTLeaf *right);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_command(akbasic_ASTLeaf *obj, const char *cmdname, akbasic_ASTLeaf *right);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_immediate_command(akbasic_ASTLeaf *obj, const char *cmdname, akbasic_ASTLeaf *right);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_branch(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *expr, akbasic_ASTLeaf *trueleaf, akbasic_ASTLeaf *falseleaf);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_grouping(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *expr);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_literal_int(akbasic_ASTLeaf *obj, const char *lexeme);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_literal_float(akbasic_ASTLeaf *obj, const char *lexeme);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_literal_string(akbasic_ASTLeaf *obj, const char *lexeme);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_identifier(akbasic_ASTLeaf *obj, akbasic_LeafType leaftype, const char *lexeme);
|
||||
|
||||
/** @brief Render a leaf as the reference's toString() does, for tests and LIST. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_to_string(akbasic_ASTLeaf *self, char *dest, size_t len);
|
||||
|
||||
#endif // _AKBASIC_GRAMMAR_H_
|
||||
60
include/akbasic/parser.h
Normal file
60
include/akbasic/parser.h
Normal file
@@ -0,0 +1,60 @@
|
||||
/**
|
||||
* @file parser.h
|
||||
* @brief Declares the recursive-descent parser.
|
||||
*
|
||||
* The hierarchy is as-per "Commodore 128 Programmer's Reference Guide" page 23,
|
||||
* copied verbatim from the reference because it is the specification:
|
||||
*
|
||||
* program -> line*
|
||||
* line -> (line_number ( command | expression )) (immediate_command expression)
|
||||
* command -> command (expression)
|
||||
* expression -> logicalandor
|
||||
* logicalandor -> logicalnot ( "OR" "AND" ) logicalnot
|
||||
* logicalnot -> "NOT" relation
|
||||
* relation -> subtraction* [ < <= = <> >= > ] subtraction*
|
||||
* subtraction -> addition* "-" addition*
|
||||
* addition -> multiplication* "+" multiplication*
|
||||
* multiplication -> division* "*" division*
|
||||
* division -> unary* "/" unary*
|
||||
* unary -> "-" exponent
|
||||
* primary -> IDENTIFIER | LITERAL_INT | LITERAL_FLOAT | LITERAL_STRING | "(" expression ")"
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_PARSER_H_
|
||||
#define _AKBASIC_PARSER_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/grammar.h>
|
||||
#include <akbasic/runtime.h>
|
||||
|
||||
typedef struct akbasic_Parser
|
||||
{
|
||||
akbasic_Runtime *runtime;
|
||||
} akbasic_Parser;
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_init(akbasic_Parser *obj, akbasic_Runtime *runtime);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_zero(akbasic_Parser *obj);
|
||||
|
||||
/** @brief Parse one statement from the token stream. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_parse(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
|
||||
bool akbasic_parser_is_at_end(akbasic_Parser *obj);
|
||||
|
||||
/* --- Internal API: the grammar rules, reachable from src/parser_commands.c. --- */
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_command(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_assignment(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_expression(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_relation(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_primary(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_argument_list(akbasic_Parser *obj, akbasic_TokenType arglisttype, bool requireparens, akbasic_ASTLeaf **dest);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_new_leaf(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
bool akbasic_parser_match(akbasic_Parser *obj, const akbasic_TokenType *types, int count);
|
||||
bool akbasic_parser_match1(akbasic_Parser *obj, akbasic_TokenType type);
|
||||
akbasic_Token *akbasic_parser_peek(akbasic_Parser *obj);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_previous(akbasic_Parser *obj, akbasic_Token **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parser_error(akbasic_Parser *obj, const char *message);
|
||||
|
||||
#endif // _AKBASIC_PARSER_H_
|
||||
162
include/akbasic/runtime.h
Normal file
162
include/akbasic/runtime.h
Normal file
@@ -0,0 +1,162 @@
|
||||
/**
|
||||
* @file runtime.h
|
||||
* @brief Declares the interpreter: source, pools, scanner, parser and evaluator.
|
||||
*
|
||||
* Ported from basicruntime.go, minus SDL and minus the for{} loop that owned the
|
||||
* process. The reference's run() does not return until MODE_QUIT; here
|
||||
* akbasic_runtime_step() executes exactly one iteration of that loop and returns,
|
||||
* and akbasic_runtime_run() bounds it. A host game must be able to step or bound
|
||||
* execution rather than surrender control, so the loop belongs to the caller.
|
||||
*
|
||||
* Nothing in this library terminates the process. Errors propagate out as
|
||||
* akerr_ErrorContext * for the host to handle; FINISH_NORETURN belongs only to
|
||||
* the driver's main().
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_RUNTIME_H_
|
||||
#define _AKBASIC_RUNTIME_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/environment.h>
|
||||
#include <akbasic/grammar.h>
|
||||
#include <akbasic/sink.h>
|
||||
#include <akbasic/types.h>
|
||||
#include <akbasic/value.h>
|
||||
#include <akbasic/variable.h>
|
||||
|
||||
/** @brief The BASIC-visible error classes, used to build the "? n : CLASS msg" line. */
|
||||
typedef enum
|
||||
{
|
||||
AKBASIC_ERRCLASS_NONE = 0,
|
||||
AKBASIC_ERRCLASS_IO,
|
||||
AKBASIC_ERRCLASS_PARSE,
|
||||
AKBASIC_ERRCLASS_SYNTAX,
|
||||
AKBASIC_ERRCLASS_RUNTIME
|
||||
} akbasic_ErrorClass;
|
||||
|
||||
typedef struct
|
||||
{
|
||||
char code[AKBASIC_MAX_LINE_LENGTH];
|
||||
int64_t lineno;
|
||||
} akbasic_SourceLine;
|
||||
|
||||
/** @brief A user-defined subroutine or single-expression function. */
|
||||
typedef struct
|
||||
{
|
||||
char name[AKBASIC_SYMTAB_MAX_KEY];
|
||||
akbasic_ASTLeaf *arglist;
|
||||
akbasic_ASTLeaf *expression;
|
||||
int64_t lineno;
|
||||
akbasic_Environment *environment;
|
||||
/* Deep copies of the arglist and expression need storage that outlives the line. */
|
||||
akbasic_ASTLeaf leafstorage[AKBASIC_MAX_LEAVES * 2];
|
||||
akbasic_LeafPool leafpool;
|
||||
bool used;
|
||||
} akbasic_FunctionDef;
|
||||
|
||||
typedef struct akbasic_Runtime
|
||||
{
|
||||
akbasic_SourceLine source[AKBASIC_MAX_SOURCE_LINES];
|
||||
|
||||
/* Pools. Nothing here is malloc'd; everything is drawn from and returned. */
|
||||
akbasic_Environment environments[AKBASIC_MAX_ENVIRONMENTS];
|
||||
akbasic_Variable variables[AKBASIC_MAX_VARIABLES];
|
||||
akbasic_FunctionDef functions[AKBASIC_MAX_FUNCTIONS];
|
||||
akbasic_ValuePool valuepool;
|
||||
|
||||
akbasic_Value staticTrueValue;
|
||||
akbasic_Value staticFalseValue;
|
||||
|
||||
int mode;
|
||||
int run_finished_mode;
|
||||
akbasic_ErrorClass errclass;
|
||||
int64_t autoLineNumber;
|
||||
|
||||
/*
|
||||
* When false, evaluating an identifier yields the live value rather than a
|
||||
* clone. POKE and POINTER need the address of the real storage. The
|
||||
* reference declares this on both the runtime and the environment and only
|
||||
* ever reads the runtime's; the environment copy is dropped here.
|
||||
*/
|
||||
bool eval_clone_identifiers;
|
||||
|
||||
akbasic_Environment *environment;
|
||||
akbasic_TextSink *sink;
|
||||
|
||||
/* REPL line assembly */
|
||||
char userline[AKBASIC_MAX_LINE_LENGTH];
|
||||
|
||||
/* Scanner state */
|
||||
char line[AKBASIC_MAX_LINE_LENGTH];
|
||||
int current;
|
||||
int start;
|
||||
akbasic_TokenType tokentype;
|
||||
bool hasError;
|
||||
|
||||
bool inputEof;
|
||||
} akbasic_Runtime;
|
||||
|
||||
/**
|
||||
* @brief Bring a runtime up: register status codes, build the root environment.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param sink Where output goes and input comes from; required.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_init(akbasic_Runtime *obj, akbasic_TextSink *sink);
|
||||
|
||||
/** @brief Reset the per-line state without disturbing the program or variables. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_zero(akbasic_Runtime *obj);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_new_environment(akbasic_Runtime *obj);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_prev_environment(akbasic_Runtime *obj);
|
||||
|
||||
/** @brief Report a BASIC error on the current line, in the reference's format. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_error(akbasic_Runtime *obj, akbasic_ErrorClass errclass, const char *message);
|
||||
|
||||
/** @brief Write text, mirroring the reference's Write(). */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_write(akbasic_Runtime *obj, const char *text);
|
||||
/** @brief Write text and a newline, mirroring the reference's Println(). */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_println(akbasic_Runtime *obj, const char *text);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_set_mode(akbasic_Runtime *obj, int mode);
|
||||
|
||||
/** @brief Evaluate one AST leaf, drawing scratch values from the environment. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_evaluate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest);
|
||||
|
||||
/** @brief Evaluate a leaf only when it is a command a REPL may run immediately. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_interpret_immediate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest);
|
||||
|
||||
/** @brief Evaluate a leaf unless the environment is skipping forward to a verb. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_interpret(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest);
|
||||
|
||||
/** @brief Call a user-defined function or subroutine. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest);
|
||||
|
||||
/**
|
||||
* @brief Execute exactly one iteration of the reference's run() loop.
|
||||
*
|
||||
* One call reads or runs at most one source line. It never blocks beyond a
|
||||
* single readline on the sink, and it always returns.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_step(akbasic_Runtime *obj);
|
||||
|
||||
/**
|
||||
* @brief Step until the runtime quits or `maxsteps` steps have elapsed.
|
||||
* @param maxsteps Step ceiling; zero or negative means unbounded.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_run(akbasic_Runtime *obj, int maxsteps);
|
||||
|
||||
/** @brief Point the runtime at an input stream and choose a starting mode. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_start(akbasic_Runtime *obj, int mode);
|
||||
|
||||
/* --- Internal API: exposed for the scanner, parser and verb handlers only. --- */
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_new_variable(akbasic_Runtime *obj, akbasic_Variable **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_new_function(akbasic_Runtime *obj, akbasic_FunctionDef **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_store_line(akbasic_Runtime *obj, int64_t lineno, const char *code);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_process_line_run(akbasic_Runtime *obj);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_process_line_runstream(akbasic_Runtime *obj);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_runtime_process_line_repl(akbasic_Runtime *obj);
|
||||
int64_t akbasic_runtime_find_previous_lineno(akbasic_Runtime *obj);
|
||||
|
||||
#endif // _AKBASIC_RUNTIME_H_
|
||||
39
include/akbasic/scanner.h
Normal file
39
include/akbasic/scanner.h
Normal file
@@ -0,0 +1,39 @@
|
||||
/**
|
||||
* @file scanner.h
|
||||
* @brief Declares the line tokenizer.
|
||||
*
|
||||
* Ported from basicscanner.go. The scanner's own cursor state lives on the
|
||||
* runtime rather than in a separate struct -- the reference's BasicScanner holds
|
||||
* a back-pointer to the runtime and reaches through it for the token array
|
||||
* anyway, so a second object bought nothing.
|
||||
*
|
||||
* Its three keyword maps are gone: the token type for a name comes from the one
|
||||
* dispatch table in verbs.h.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_SCANNER_H_
|
||||
#define _AKBASIC_SCANNER_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/runtime.h>
|
||||
|
||||
/** @brief Reset the scanner cursor. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_scanner_zero(akbasic_Runtime *obj);
|
||||
|
||||
/**
|
||||
* @brief Tokenize one source line into the active environment's token array.
|
||||
*
|
||||
* Returns the line as the scanner left it through `dest`: an integer literal in
|
||||
* token position 0 is consumed as a line number rather than emitted as a token,
|
||||
* and the line is rewritten to everything after it with leading spaces stripped.
|
||||
* The REPL depends on that rewrite, which is why the line comes back out.
|
||||
*
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param line Source line to scan.
|
||||
* @param dest Output destination for the possibly-rewritten line; may be NULL.
|
||||
* @param len Size of `dest`.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_scanner_scan(akbasic_Runtime *obj, const char *line, char *dest, size_t len);
|
||||
|
||||
#endif // _AKBASIC_SCANNER_H_
|
||||
54
include/akbasic/sink.h
Normal file
54
include/akbasic/sink.h
Normal file
@@ -0,0 +1,54 @@
|
||||
/**
|
||||
* @file sink.h
|
||||
* @brief Declares the text sink: where PRINT goes and where INPUT comes from.
|
||||
*
|
||||
* The reference's Write() and Println() mirror every line to stdout *and* to an
|
||||
* SDL surface, and that mirror is the only reason its golden-file suite works.
|
||||
* Reproducing it as a hardcoded pair of calls would drag SDL into the core and
|
||||
* make the corpus unrunnable without a display, so it becomes a record of
|
||||
* function pointers instead -- the house pattern for anything that varies.
|
||||
*
|
||||
* akbasic_sink_init_stdio() is in the library. akbasic_sink_init_akgl() is in the
|
||||
* separate akbasic_akgl target and draws through whatever renderer the host game
|
||||
* already initialized; the interpreter never owns a window.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_SINK_H_
|
||||
#define _AKBASIC_SINK_H_
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/types.h>
|
||||
|
||||
typedef struct akbasic_TextSink
|
||||
{
|
||||
void *self;
|
||||
akerr_ErrorContext AKERR_NOIGNORE *(*write)(struct akbasic_TextSink *self, const char *text);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *(*writeln)(struct akbasic_TextSink *self, const char *text);
|
||||
/**
|
||||
* Read one line. Sets *eof true at end of input rather than raising, because
|
||||
* running off the end of a stream is how RUNSTREAM mode finishes normally.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *(*readline)(struct akbasic_TextSink *self, char *dest, size_t len, bool *eof);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *(*clear)(struct akbasic_TextSink *self);
|
||||
} akbasic_TextSink;
|
||||
|
||||
/** @brief State for the stdio-backed sink. */
|
||||
typedef struct
|
||||
{
|
||||
FILE *out;
|
||||
FILE *in;
|
||||
} akbasic_StdioSink;
|
||||
|
||||
/**
|
||||
* @brief Point a sink at a pair of stdio streams.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param state Storage for the stream pair; must outlive the sink.
|
||||
* @param out Where write/writeln go; NULL selects stdout.
|
||||
* @param in Where readline reads; NULL selects stdin.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_sink_init_stdio(akbasic_TextSink *obj, akbasic_StdioSink *state, FILE *out, FILE *in);
|
||||
|
||||
#endif // _AKBASIC_SINK_H_
|
||||
87
include/akbasic/symtab.h
Normal file
87
include/akbasic/symtab.h
Normal file
@@ -0,0 +1,87 @@
|
||||
/**
|
||||
* @file symtab.h
|
||||
* @brief Declares a fixed-capacity open-addressed string-keyed table.
|
||||
*
|
||||
* The Go reference used five maps. Three of them -- an environment's variables,
|
||||
* functions and labels -- become this: one implementation, capacity supplied by
|
||||
* the caller, keyed by aksl_strhash_djb2 with linear probing. A full table is an
|
||||
* error, not a resize.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_SYMTAB_H_
|
||||
#define _AKBASIC_SYMTAB_H_
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <stdint.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/types.h>
|
||||
|
||||
/*
|
||||
* Slots are sized for the largest table any caller needs, so one slot array type
|
||||
* serves variables, functions and labels. Capacity is a member; the table is
|
||||
* kept below a 75% load factor by construction because `capacity` counts slots
|
||||
* and the caller's logical maximum is smaller.
|
||||
*/
|
||||
#define AKBASIC_SYMTAB_MAX_SLOTS 256
|
||||
#define AKBASIC_SYMTAB_MAX_KEY 64
|
||||
|
||||
typedef struct
|
||||
{
|
||||
bool used;
|
||||
char key[AKBASIC_SYMTAB_MAX_KEY];
|
||||
void *value;
|
||||
int64_t ivalue;
|
||||
} akbasic_SymbolSlot;
|
||||
|
||||
typedef struct
|
||||
{
|
||||
int capacity;
|
||||
int count;
|
||||
akbasic_SymbolSlot slots[AKBASIC_SYMTAB_MAX_SLOTS];
|
||||
} akbasic_SymbolTable;
|
||||
|
||||
/**
|
||||
* @brief Symbol table initialize.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param capacity Number of slots to use; must be positive and no larger than AKBASIC_SYMTAB_MAX_SLOTS.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_NULLPOINTER When `obj` is NULL.
|
||||
* @throws AKBASIC_ERR_BOUNDS When `capacity` is out of range.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_symtab_init(akbasic_SymbolTable *obj, int capacity);
|
||||
|
||||
/**
|
||||
* @brief Store a pointer and an integer against a key, replacing any existing entry.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param key Lookup key; copied into the slot.
|
||||
* @param value Pointer payload, may be NULL.
|
||||
* @param ivalue Integer payload, used by the label table.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_NULLPOINTER When `obj` or `key` is NULL.
|
||||
* @throws AKBASIC_ERR_BOUNDS When the key is too long or the table is full.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_symtab_set(akbasic_SymbolTable *obj, const char *key, void *value, int64_t ivalue);
|
||||
|
||||
/**
|
||||
* @brief Look a key up.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param key Lookup key.
|
||||
* @param value Output destination for the pointer payload; may be NULL.
|
||||
* @param ivalue Output destination for the integer payload; may be NULL.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_NULLPOINTER When `obj` or `key` is NULL.
|
||||
* @throws AKERR_KEY When the key is not present.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_symtab_get(akbasic_SymbolTable *obj, const char *key, void **value, int64_t *ivalue);
|
||||
|
||||
/**
|
||||
* @brief Drop every entry.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_NULLPOINTER When `obj` is NULL.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_symtab_clear(akbasic_SymbolTable *obj);
|
||||
|
||||
#endif // _AKBASIC_SYMTAB_H_
|
||||
74
include/akbasic/types.h
Normal file
74
include/akbasic/types.h
Normal file
@@ -0,0 +1,74 @@
|
||||
/**
|
||||
* @file types.h
|
||||
* @brief Declares the interpreter's fixed budget and its primitive value type.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_TYPES_H_
|
||||
#define _AKBASIC_TYPES_H_
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <stdint.h>
|
||||
|
||||
/*
|
||||
* The budget, transcribed from the Go reference's main.go:14-30. Everything the
|
||||
* interpreter uses is drawn from a pool sized by one of these; nothing calls
|
||||
* malloc.
|
||||
*/
|
||||
|
||||
/* Per-environment pools */
|
||||
#define AKBASIC_MAX_LEAVES 32 /* ~16 operations per source line */
|
||||
#define AKBASIC_MAX_TOKENS 32
|
||||
#define AKBASIC_MAX_VALUES 64
|
||||
#define AKBASIC_MAX_VARIABLES 128
|
||||
|
||||
/* Whole-runtime pools */
|
||||
#define AKBASIC_MAX_SOURCE_LINES 9999
|
||||
#define AKBASIC_MAX_LINE_LENGTH 256
|
||||
#define AKBASIC_MAX_ARRAY_DEPTH 64 /* dimensions per array */
|
||||
#define AKBASIC_MAX_ARRAY_ELEMENTS 1024 /* elements in one array */
|
||||
#define AKBASIC_MAX_ARRAY_VALUES 4096 /* array elements across all variables */
|
||||
#define AKBASIC_MAX_STRING_LENGTH 256 /* see TODO.md 1.2 */
|
||||
#define AKBASIC_MAX_ENVIRONMENTS 32 /* new: Go allocated these unbounded */
|
||||
#define AKBASIC_MAX_FUNCTIONS 64 /* new: Go used an unbounded map */
|
||||
#define AKBASIC_MAX_LABELS 64 /* new: Go used an unbounded map */
|
||||
|
||||
/* Commodore convention: true is -1, not 1. */
|
||||
#define AKBASIC_TRUE -1
|
||||
#define AKBASIC_FALSE 0
|
||||
|
||||
/** @brief Runtime execution modes. */
|
||||
#define AKBASIC_MODE_REPL 1
|
||||
#define AKBASIC_MODE_RUN 2
|
||||
#define AKBASIC_MODE_RUNSTREAM 3
|
||||
#define AKBASIC_MODE_QUIT 4
|
||||
|
||||
/** @brief The type carried by a value, taken from an identifier's suffix. */
|
||||
typedef enum
|
||||
{
|
||||
AKBASIC_TYPE_UNDEFINED = 0,
|
||||
AKBASIC_TYPE_INTEGER, /* 1 -- identifier suffix '#' */
|
||||
AKBASIC_TYPE_FLOAT, /* 2 -- identifier suffix '%' */
|
||||
AKBASIC_TYPE_STRING, /* 3 -- identifier suffix '$' */
|
||||
AKBASIC_TYPE_BOOLEAN /* 4 */
|
||||
} akbasic_Type;
|
||||
|
||||
/*
|
||||
* A value. The string lives inline rather than behind a pointer so that a copy
|
||||
* is a struct assignment with no allocator, refcount or lifetime question --
|
||||
* see TODO.md 1.2 for the size tradeoff that buys.
|
||||
*
|
||||
* The reference's BasicValue carries a `name` field. It is dead: nothing ever
|
||||
* writes it a non-empty string, and its only reader is BasicEnvironment.update(),
|
||||
* which has no callers. Both are dropped here.
|
||||
*/
|
||||
typedef struct akbasic_Value
|
||||
{
|
||||
akbasic_Type valuetype;
|
||||
char stringval[AKBASIC_MAX_STRING_LENGTH];
|
||||
int64_t intval;
|
||||
double floatval;
|
||||
int64_t boolvalue;
|
||||
bool mutable_;
|
||||
} akbasic_Value;
|
||||
|
||||
#endif // _AKBASIC_TYPES_H_
|
||||
101
include/akbasic/value.h
Normal file
101
include/akbasic/value.h
Normal file
@@ -0,0 +1,101 @@
|
||||
/**
|
||||
* @file value.h
|
||||
* @brief Declares the strongly-typed BASIC value and its operators.
|
||||
*
|
||||
* Ported from the reference's basicvalue.go. The arithmetic is reproduced
|
||||
* exactly, including the parts that look wrong -- see TODO.md section 12 for the
|
||||
* catalogue and the reason they are not fixed yet.
|
||||
*
|
||||
* Every binary operator takes a `scratch` value the caller has drawn from an
|
||||
* environment's pool and an out-parameter `dest`. Most operators set `*dest` to
|
||||
* `scratch` and fill it; akbasic_value_math_plus sets `*dest` to `self` when
|
||||
* `self` is mutable, because the reference mutates in place there and
|
||||
* CommandNEXT's increment relies on it.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_VALUE_H_
|
||||
#define _AKBASIC_VALUE_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/types.h>
|
||||
|
||||
/*
|
||||
* Backing store for array variables. Scalars and arrays alike draw their storage
|
||||
* from here rather than from malloc, and a variable holds a pointer into it. The
|
||||
* runtime owns exactly one; it is passed explicitly rather than kept at file
|
||||
* scope, because the interpreter must be embeddable and may not own global
|
||||
* mutable state.
|
||||
*
|
||||
* The allocator is a bump: releasing is not supported, because nothing in BASIC
|
||||
* destroys a variable. Re-DIMming a variable to the same size or smaller reuses
|
||||
* its existing slice; growing it takes fresh slots and abandons the old ones. A
|
||||
* program that re-DIMs the same array larger in a loop will exhaust the pool and
|
||||
* get AKBASIC_ERR_BOUNDS -- bounded and diagnosable, which is the point.
|
||||
*/
|
||||
typedef struct
|
||||
{
|
||||
int next;
|
||||
akbasic_Value values[AKBASIC_MAX_ARRAY_VALUES];
|
||||
} akbasic_ValuePool;
|
||||
|
||||
/** @brief Reset the pool to empty. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_valuepool_init(akbasic_ValuePool *obj);
|
||||
|
||||
/**
|
||||
* @brief Take `count` contiguous zeroed values from the pool.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param count Number of elements required.
|
||||
* @param dest Output destination populated by the function.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKBASIC_ERR_BOUNDS When the pool has too few slots left.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_valuepool_take(akbasic_ValuePool *obj, int count, akbasic_Value **dest);
|
||||
|
||||
/** @brief Reset a value to a usable empty state. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_init(akbasic_Value *obj);
|
||||
|
||||
/** @brief Clear a value to undefined, zero, immutable and unnamed. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_zero(akbasic_Value *obj);
|
||||
|
||||
/**
|
||||
* @brief Copy the payload of one value onto another.
|
||||
*
|
||||
* Copies name, type, string, integer, float and boolean payloads. It does *not*
|
||||
* copy `mutable_`: the destination keeps its own, matching the reference, where
|
||||
* clone() writes every field except that one.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_clone(akbasic_Value *self, akbasic_Value *dest);
|
||||
|
||||
/** @brief Render a value the way PRINT does. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_to_string(akbasic_Value *self, char *dest, size_t len);
|
||||
|
||||
/** @brief Set a value to a BASIC boolean (-1 true, 0 false). */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_set_bool(akbasic_Value *obj, bool result);
|
||||
|
||||
/** @brief True when the value is a boolean holding AKBASIC_TRUE. */
|
||||
bool akbasic_value_is_true(akbasic_Value *self);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_invert(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_bitwise_not(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_shift_left(akbasic_Value *self, int64_t bits, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_shift_right(akbasic_Value *self, int64_t bits, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_bitwise_and(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_bitwise_or(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_bitwise_xor(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_math_plus(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_math_minus(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_math_multiply(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_math_divide(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_less_than(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_less_than_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_greater_than(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_greater_than_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_is_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_value_is_not_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest);
|
||||
|
||||
#endif // _AKBASIC_VALUE_H_
|
||||
65
include/akbasic/variable.h
Normal file
65
include/akbasic/variable.h
Normal file
@@ -0,0 +1,65 @@
|
||||
/**
|
||||
* @file variable.h
|
||||
* @brief Declares a named, strongly-typed, optionally multi-dimensional slot.
|
||||
*
|
||||
* Ported from basicvariable.go. Type comes from the identifier's last character:
|
||||
* `$` string, `#` integer, `%` float. Note that `%` meaning *float* inverts the
|
||||
* Commodore convention where `%` is integer; the reference does it that way and
|
||||
* its README documents it, so it is kept.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_VARIABLE_H_
|
||||
#define _AKBASIC_VARIABLE_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/types.h>
|
||||
#include <akbasic/value.h>
|
||||
|
||||
typedef struct
|
||||
{
|
||||
char name[AKBASIC_MAX_STRING_LENGTH];
|
||||
akbasic_Type valuetype;
|
||||
akbasic_Value *values; /** Points into the runtime's value pool */
|
||||
int valuecount;
|
||||
int64_t dimensions[AKBASIC_MAX_ARRAY_DEPTH];
|
||||
int dimensioncount;
|
||||
bool mutable_;
|
||||
bool used; /** Pool bookkeeping */
|
||||
} akbasic_Variable;
|
||||
|
||||
/**
|
||||
* @brief Give a variable storage and a type.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param pool Backing store the elements are drawn from.
|
||||
* @param sizes Dimension sizes; every one must be positive.
|
||||
* @param sizecount Number of dimensions.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_NULLPOINTER When `obj` or `pool` is NULL.
|
||||
* @throws AKBASIC_ERR_VALUE When the name is empty or a dimension is not positive.
|
||||
* @throws AKBASIC_ERR_BOUNDS When the array is larger than the pool can serve.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_variable_init(akbasic_Variable *obj, akbasic_ValuePool *pool, int64_t *sizes, int sizecount);
|
||||
|
||||
/** @brief Mark the variable undefined and mutable without touching its storage. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_variable_zero(akbasic_Variable *obj);
|
||||
|
||||
/**
|
||||
* @brief Resolve a subscript list to the value it addresses.
|
||||
* @param obj Object to initialize, inspect, or modify.
|
||||
* @param subscripts Index per dimension.
|
||||
* @param subscriptcount Number of indices supplied; must equal the dimension count.
|
||||
* @param dest Output destination populated by the function.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKBASIC_ERR_BOUNDS When the count is wrong or an index is out of range.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_variable_get_subscript(akbasic_Variable *obj, int64_t *subscripts, int subscriptcount, akbasic_Value **dest);
|
||||
|
||||
/** @brief Copy a value into the slot a subscript list addresses. */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_variable_set_subscript(akbasic_Variable *obj, akbasic_Value *value, int64_t *subscripts, int subscriptcount);
|
||||
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_variable_set_integer(akbasic_Variable *obj, int64_t value, int64_t *subscripts, int subscriptcount);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_variable_set_float(akbasic_Variable *obj, double value, int64_t *subscripts, int subscriptcount);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_variable_set_string(akbasic_Variable *obj, const char *value, int64_t *subscripts, int subscriptcount);
|
||||
|
||||
#endif // _AKBASIC_VARIABLE_H_
|
||||
56
include/akbasic/verbs.h
Normal file
56
include/akbasic/verbs.h
Normal file
@@ -0,0 +1,56 @@
|
||||
/**
|
||||
* @file verbs.h
|
||||
* @brief Declares the one dispatch table that replaces the reference's reflection.
|
||||
*
|
||||
* The Go runtime resolves a verb with reflect.MethodByName("Command" + NAME), a
|
||||
* function with "Function" + NAME, and a special parse path with "ParseCommand" +
|
||||
* NAME. C has no reflection and none is being added. All three collapse into the
|
||||
* table in src/verbs.c: sorted by name, searched with bsearch, one row per verb.
|
||||
*
|
||||
* Adding a verb is adding one row and up to two functions. A NULL parse handler
|
||||
* means "parse the rval as a plain expression", which is exactly what
|
||||
* commandByReflection returning (nil, nil) means in the reference. A NULL exec
|
||||
* handler means the token is consumed by another verb's parser and never
|
||||
* evaluated on its own -- THEN, ELSE, TO and STEP are all like that.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_VERBS_H_
|
||||
#define _AKBASIC_VERBS_H_
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/grammar.h>
|
||||
#include <akbasic/types.h>
|
||||
|
||||
struct akbasic_Parser;
|
||||
struct akbasic_Runtime;
|
||||
|
||||
typedef akerr_ErrorContext AKERR_NOIGNORE *(*akbasic_ParseHandler)(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
typedef akerr_ErrorContext AKERR_NOIGNORE *(*akbasic_ExecHandler)(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
|
||||
typedef struct
|
||||
{
|
||||
const char *name;
|
||||
akbasic_TokenType tokentype;
|
||||
int arity; /** Argument count for a function; -1 when not applicable */
|
||||
akbasic_ParseHandler parse;
|
||||
akbasic_ExecHandler exec;
|
||||
} akbasic_Verb;
|
||||
|
||||
/**
|
||||
* @brief Find a verb, function or reserved word by name, case-insensitively.
|
||||
*
|
||||
* Verbs and function names are case-insensitive in this dialect; variable names
|
||||
* are not. That asymmetry lives here.
|
||||
*
|
||||
* @param name Name to look up; matched without regard to case.
|
||||
* @param dest Output destination populated by the function; set to NULL on a miss.
|
||||
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||
* @throws AKERR_NULLPOINTER When `name` or `dest` is NULL.
|
||||
*/
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_verb_lookup(const char *name, const akbasic_Verb **dest);
|
||||
|
||||
/** @brief The table itself, exposed so tests can assert it is sorted. */
|
||||
const akbasic_Verb *akbasic_verb_table(int *count);
|
||||
|
||||
#endif // _AKBASIC_VERBS_H_
|
||||
65
src/convert.c
Normal file
65
src/convert.c
Normal file
@@ -0,0 +1,65 @@
|
||||
/**
|
||||
* @file convert.c
|
||||
* @brief Implements strict string-to-number conversion over strtoll/strtod.
|
||||
*/
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/convert.h>
|
||||
#include <akbasic/error.h>
|
||||
|
||||
akerr_ErrorContext *akbasic_str_to_int64(const char *str, int base, int64_t *dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char *endptr = NULL;
|
||||
long long result = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (str != NULL), AKERR_NULLPOINTER,
|
||||
"NULL string in integer conversion");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL destination in integer conversion");
|
||||
|
||||
errno = 0;
|
||||
result = strtoll(str, &endptr, base);
|
||||
|
||||
/* No digits consumed at all. */
|
||||
FAIL_NONZERO_RETURN(errctx, (endptr == str), AKBASIC_ERR_VALUE,
|
||||
"INTEGER CONVERSION ON '%s'", str);
|
||||
/* Trailing junk. The whole lexeme must be the number. */
|
||||
FAIL_NONZERO_RETURN(errctx, (*endptr != '\0'), AKBASIC_ERR_VALUE,
|
||||
"INTEGER CONVERSION ON '%s'", str);
|
||||
FAIL_NONZERO_RETURN(errctx, (errno == ERANGE), ERANGE,
|
||||
"Integer literal '%s' is out of range", str);
|
||||
|
||||
*dest = (int64_t)result;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_str_to_double(const char *str, double *dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char *endptr = NULL;
|
||||
double result = 0.0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (str != NULL), AKERR_NULLPOINTER,
|
||||
"NULL string in float conversion");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL destination in float conversion");
|
||||
|
||||
errno = 0;
|
||||
result = strtod(str, &endptr);
|
||||
|
||||
FAIL_NONZERO_RETURN(errctx, (endptr == str), AKBASIC_ERR_VALUE,
|
||||
"FLOAT CONVERSION ON '%s'", str);
|
||||
FAIL_NONZERO_RETURN(errctx, (*endptr != '\0'), AKBASIC_ERR_VALUE,
|
||||
"FLOAT CONVERSION ON '%s'", str);
|
||||
FAIL_NONZERO_RETURN(errctx, (errno == ERANGE), ERANGE,
|
||||
"Float literal '%s' is out of range", str);
|
||||
|
||||
*dest = result;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
379
src/environment.c
Normal file
379
src/environment.c
Normal file
@@ -0,0 +1,379 @@
|
||||
/**
|
||||
* @file environment.c
|
||||
* @brief Implements the scope and per-line working state.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/environment.h>
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/runtime.h>
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_init(akbasic_Environment *obj, akbasic_Runtime *runtime, akbasic_Environment *parent)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL environment in init");
|
||||
FAIL_ZERO_RETURN(errctx, (runtime != NULL), AKERR_NULLPOINTER, "NULL runtime in environment init");
|
||||
|
||||
PASS(errctx, akbasic_symtab_init(&obj->variables, AKBASIC_MAX_VARIABLES));
|
||||
PASS(errctx, akbasic_symtab_init(&obj->functions, AKBASIC_MAX_FUNCTIONS));
|
||||
PASS(errctx, akbasic_symtab_init(&obj->labels, AKBASIC_MAX_LABELS));
|
||||
|
||||
obj->parent = parent;
|
||||
obj->runtime = runtime;
|
||||
obj->forNextVariable = NULL;
|
||||
obj->forStepLeaf = NULL;
|
||||
obj->forToLeaf = NULL;
|
||||
obj->loopFirstLine = 0;
|
||||
obj->loopExitLine = 0;
|
||||
obj->gosubReturnLine = 0;
|
||||
obj->readReturnLine = 0;
|
||||
obj->readIdentifierIdx = 0;
|
||||
obj->waitingForCommand[0] = '\0';
|
||||
obj->errorToken = NULL;
|
||||
memset(obj->readIdentifierLeaves, 0, sizeof(obj->readIdentifierLeaves));
|
||||
obj->readLeafPool.next = 0;
|
||||
obj->readLeafPool.capacity = AKBASIC_MAX_LEAVES;
|
||||
obj->readLeafPool.leaves = obj->readLeafStorage;
|
||||
|
||||
PASS(errctx, akbasic_value_zero(&obj->forStepValue));
|
||||
PASS(errctx, akbasic_value_zero(&obj->forToValue));
|
||||
PASS(errctx, akbasic_value_zero(&obj->returnValue));
|
||||
|
||||
if ( obj->parent != NULL ) {
|
||||
obj->lineno = obj->parent->lineno;
|
||||
obj->nextline = obj->parent->nextline;
|
||||
} else {
|
||||
obj->lineno = 0;
|
||||
obj->nextline = 0;
|
||||
}
|
||||
obj->nextvalue = 0;
|
||||
PASS(errctx, akbasic_environment_zero_parser(obj));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_zero(akbasic_Environment *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int i = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL environment in zero");
|
||||
for ( i = 0; i < AKBASIC_MAX_VALUES; i++ ) {
|
||||
PASS(errctx, akbasic_value_init(&obj->values[i]));
|
||||
}
|
||||
obj->nextvalue = 0;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_zero_parser(akbasic_Environment *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int i = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL environment in zero_parser");
|
||||
for ( i = 0; i < AKBASIC_MAX_LEAVES; i++ ) {
|
||||
PASS(errctx, akbasic_leaf_init(&obj->leaves[i], AKBASIC_LEAF_UNDEFINED));
|
||||
}
|
||||
for ( i = 0; i < AKBASIC_MAX_TOKENS; i++ ) {
|
||||
PASS(errctx, akbasic_token_init(&obj->tokens[i]));
|
||||
}
|
||||
obj->curtoken = 0;
|
||||
obj->nexttoken = 0;
|
||||
obj->nextleaf = 0;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_new_value(akbasic_Environment *obj, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in new_value");
|
||||
FAIL_ZERO_RETURN(errctx, (obj->nextvalue < AKBASIC_MAX_VALUES), AKBASIC_ERR_BOUNDS,
|
||||
"Maximum values per line reached");
|
||||
*dest = &obj->values[obj->nextvalue];
|
||||
obj->nextvalue += 1;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_new_leaf(akbasic_Environment *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in new_leaf");
|
||||
FAIL_ZERO_RETURN(errctx, (obj->nextleaf < AKBASIC_MAX_LEAVES), AKBASIC_ERR_BOUNDS,
|
||||
"No more leaves available");
|
||||
*dest = &obj->leaves[obj->nextleaf];
|
||||
obj->nextleaf += 1;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_wait_for_command(akbasic_Environment *obj, const char *command)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && command != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in wait_for_command");
|
||||
/*
|
||||
* The reference panics here. An interpreter library may not take the process
|
||||
* with it, so this raises instead -- but it is still a hard failure, because
|
||||
* two pending waits in one environment means the block structure is already
|
||||
* corrupt.
|
||||
*/
|
||||
FAIL_NONZERO_RETURN(errctx, (obj->waitingForCommand[0] != '\0'), AKBASIC_ERR_STATE,
|
||||
"Can't wait on multiple commands in the same environment : %s",
|
||||
obj->waitingForCommand);
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(command) < sizeof(obj->waitingForCommand)),
|
||||
AKBASIC_ERR_BOUNDS, "Command name '%s' is too long to wait on", command);
|
||||
strncpy(obj->waitingForCommand, command, sizeof(obj->waitingForCommand) - 1);
|
||||
obj->waitingForCommand[sizeof(obj->waitingForCommand) - 1] = '\0';
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
bool akbasic_environment_is_waiting_for_any(akbasic_Environment *obj)
|
||||
{
|
||||
if ( obj == NULL ) {
|
||||
return false;
|
||||
}
|
||||
if ( obj->waitingForCommand[0] != '\0' ) {
|
||||
return true;
|
||||
}
|
||||
return akbasic_environment_is_waiting_for_any(obj->parent);
|
||||
}
|
||||
|
||||
bool akbasic_environment_is_waiting_for(akbasic_Environment *obj, const char *command)
|
||||
{
|
||||
if ( obj == NULL || command == NULL ) {
|
||||
return false;
|
||||
}
|
||||
if ( strcmp(obj->waitingForCommand, command) == 0 ) {
|
||||
return true;
|
||||
}
|
||||
return akbasic_environment_is_waiting_for(obj->parent, command);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_stop_waiting(akbasic_Environment *obj, const char *command)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && command != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in stop_waiting");
|
||||
/*
|
||||
* The reference ignores `command` and clears unconditionally, which lets an
|
||||
* inner block clear an outer block's wait (TODO.md section 12 item 3). The
|
||||
* argument is honoured here only to the extent of walking to the environment
|
||||
* that is actually waiting for it -- clearing the wrong one outright would
|
||||
* change observable control flow, so the search stops at the first match and
|
||||
* a miss is silently tolerated, exactly as today.
|
||||
*/
|
||||
while ( obj != NULL ) {
|
||||
if ( strcmp(obj->waitingForCommand, command) == 0 ) {
|
||||
obj->waitingForCommand[0] = '\0';
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
obj = obj->parent;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_get_function(akbasic_Environment *obj, const char *fname, void **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char upper[AKBASIC_SYMTAB_MAX_KEY];
|
||||
size_t i = 0;
|
||||
size_t len = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && fname != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in get_function");
|
||||
len = strlen(fname);
|
||||
FAIL_ZERO_RETURN(errctx, (len < sizeof(upper)), AKERR_KEY, "Function '%s' is not defined", fname);
|
||||
for ( i = 0; i < len; i++ ) {
|
||||
char c = fname[i];
|
||||
upper[i] = (char)((c >= 'a' && c <= 'z') ? (c - 'a' + 'A') : c);
|
||||
}
|
||||
upper[len] = '\0';
|
||||
|
||||
while ( obj != NULL ) {
|
||||
akerr_ErrorContext *found = akbasic_symtab_get(&obj->functions, upper, dest, NULL);
|
||||
if ( found == NULL ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
found->handled = true;
|
||||
IGNORE(akerr_release_error(found));
|
||||
obj = obj->parent;
|
||||
}
|
||||
FAIL_RETURN(errctx, AKERR_KEY, "Function '%s' is not defined", fname);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_get_label(akbasic_Environment *obj, const char *label, int64_t *dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && label != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in get_label");
|
||||
while ( obj != NULL ) {
|
||||
akerr_ErrorContext *found = akbasic_symtab_get(&obj->labels, label, NULL, dest);
|
||||
if ( found == NULL ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
found->handled = true;
|
||||
IGNORE(akerr_release_error(found));
|
||||
obj = obj->parent;
|
||||
}
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_UNDEFINED,
|
||||
"Unable to find or create label %s in environment", label);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_set_label(akbasic_Environment *obj, const char *label, int64_t value)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && label != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in set_label");
|
||||
/* Only the top-level environment creates labels. */
|
||||
while ( obj != NULL && obj->runtime->environment != obj ) {
|
||||
obj = obj->parent;
|
||||
}
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKBASIC_ERR_ENVIRONMENT,
|
||||
"Unable to create label in orphaned environment");
|
||||
PASS(errctx, akbasic_symtab_set(&obj->labels, label, NULL, value));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_get(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Environment *walk = NULL;
|
||||
akbasic_Variable *variable = NULL;
|
||||
int64_t sizes[1] = { 1 };
|
||||
void *slot = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && varname != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in environment get");
|
||||
|
||||
*dest = NULL;
|
||||
for ( walk = obj; walk != NULL; walk = walk->parent ) {
|
||||
akerr_ErrorContext *found = akbasic_symtab_get(&walk->variables, varname, &slot, NULL);
|
||||
if ( found == NULL ) {
|
||||
*dest = (akbasic_Variable *)slot;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
found->handled = true;
|
||||
IGNORE(akerr_release_error(found));
|
||||
}
|
||||
|
||||
/*
|
||||
* Parents do not create variables for their children: only the currently
|
||||
* active environment auto-creates. A miss anywhere else returns NULL without
|
||||
* error, which the caller is expected to notice.
|
||||
*/
|
||||
if ( obj->runtime->environment != obj ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_runtime_new_variable(obj->runtime, &variable));
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(varname) < sizeof(variable->name)), AKBASIC_ERR_BOUNDS,
|
||||
"Variable name '%s' is too long", varname);
|
||||
strncpy(variable->name, varname, sizeof(variable->name) - 1);
|
||||
variable->name[sizeof(variable->name) - 1] = '\0';
|
||||
variable->valuetype = AKBASIC_TYPE_UNDEFINED;
|
||||
variable->mutable_ = true;
|
||||
PASS(errctx, akbasic_variable_init(variable, &obj->runtime->valuepool, sizes, 1));
|
||||
PASS(errctx, akbasic_symtab_set(&obj->variables, varname, variable, 0));
|
||||
*dest = variable;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* Evaluate an lvalue's subscript list, if it has one, into `subscripts`. A bare
|
||||
* identifier yields the single subscript {0}, which is how a scalar is addressed
|
||||
* -- every variable is really a one-element array.
|
||||
*/
|
||||
static akerr_ErrorContext *collect_subscripts(akbasic_Environment *obj, akbasic_ASTLeaf *lval, int64_t *subscripts, int *count)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Value *tval = NULL;
|
||||
|
||||
*count = 0;
|
||||
if ( lval->right != NULL &&
|
||||
lval->right->leaftype == AKBASIC_LEAF_ARGUMENTLIST &&
|
||||
lval->right->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT ) {
|
||||
for ( expr = lval->right->right; expr != NULL; expr = expr->right ) {
|
||||
FAIL_ZERO_RETURN(errctx, (*count < AKBASIC_MAX_ARRAY_DEPTH), AKBASIC_ERR_BOUNDS,
|
||||
"More than %d array subscripts", AKBASIC_MAX_ARRAY_DEPTH);
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj->runtime, expr, &tval));
|
||||
FAIL_NONZERO_RETURN(errctx, (tval->valuetype != AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE,
|
||||
"Array dimensions must evaluate to integer (B)");
|
||||
subscripts[*count] = tval->intval;
|
||||
*count += 1;
|
||||
}
|
||||
}
|
||||
if ( *count == 0 ) {
|
||||
subscripts[0] = 0;
|
||||
*count = 1;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_environment_assign(akbasic_Environment *obj, akbasic_ASTLeaf *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Variable *variable = NULL;
|
||||
int64_t subscripts[AKBASIC_MAX_ARRAY_DEPTH];
|
||||
int subscriptcount = 0;
|
||||
akbasic_Value *slot = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && lval != NULL && rval != NULL && dest != NULL),
|
||||
AKERR_NULLPOINTER, "nil pointer");
|
||||
|
||||
PASS(errctx, akbasic_environment_get(obj, lval->identifier, &variable));
|
||||
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
|
||||
"Identifier %s is undefined", lval->identifier);
|
||||
PASS(errctx, collect_subscripts(obj, lval, subscripts, &subscriptcount));
|
||||
|
||||
/*
|
||||
* Resolve the slot before the type switch. The reference notes that moving
|
||||
* this below the switch corrupts the subscript list; here it is simply the
|
||||
* clearer order, and the returned pointer is what an assignment expression
|
||||
* evaluates to.
|
||||
*/
|
||||
PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &slot));
|
||||
|
||||
switch ( lval->leaftype ) {
|
||||
case AKBASIC_LEAF_IDENTIFIER_INT:
|
||||
if ( rval->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
PASS(errctx, akbasic_variable_set_integer(variable, rval->intval, subscripts, subscriptcount));
|
||||
} else if ( rval->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
PASS(errctx, akbasic_variable_set_integer(variable, (int64_t)rval->floatval, subscripts, subscriptcount));
|
||||
} else {
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Incompatible types in variable assignment");
|
||||
}
|
||||
break;
|
||||
case AKBASIC_LEAF_IDENTIFIER_FLOAT:
|
||||
if ( rval->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
PASS(errctx, akbasic_variable_set_float(variable, (double)rval->intval, subscripts, subscriptcount));
|
||||
} else if ( rval->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
PASS(errctx, akbasic_variable_set_float(variable, rval->floatval, subscripts, subscriptcount));
|
||||
} else {
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Incompatible types in variable assignment");
|
||||
}
|
||||
break;
|
||||
case AKBASIC_LEAF_IDENTIFIER_STRING:
|
||||
FAIL_NONZERO_RETURN(errctx, (rval->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
|
||||
"Incompatible types in variable assignment");
|
||||
PASS(errctx, akbasic_variable_set_string(variable, rval->stringval, subscripts, subscriptcount));
|
||||
break;
|
||||
default:
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Invalid assignment");
|
||||
}
|
||||
variable->valuetype = rval->valuetype;
|
||||
*dest = slot;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
38
src/error.c
Normal file
38
src/error.c
Normal file
@@ -0,0 +1,38 @@
|
||||
/**
|
||||
* @file error.c
|
||||
* @brief Implements the error subsystem: claims and names the akbasic status band.
|
||||
*/
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
|
||||
akerr_ErrorContext *akbasic_error_register(void)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
/*
|
||||
* Claim the whole band before naming anything in it: libakerror refuses a
|
||||
* name for a status we do not own. Any collision propagates to the caller --
|
||||
* another component owning part of our range is an initialization failure,
|
||||
* not a warning.
|
||||
*/
|
||||
PASS(errctx, akerr_reserve_status_range(AKBASIC_ERR_BASE,
|
||||
AKBASIC_ERR_LIMIT - AKBASIC_ERR_BASE,
|
||||
AKBASIC_OWNER));
|
||||
PASS(errctx, akerr_register_status_name(AKBASIC_OWNER, AKBASIC_ERR_SYNTAX,
|
||||
"Syntax Error"));
|
||||
PASS(errctx, akerr_register_status_name(AKBASIC_OWNER, AKBASIC_ERR_TYPE,
|
||||
"Type Error"));
|
||||
PASS(errctx, akerr_register_status_name(AKBASIC_OWNER, AKBASIC_ERR_UNDEFINED,
|
||||
"Undefined Reference"));
|
||||
PASS(errctx, akerr_register_status_name(AKBASIC_OWNER, AKBASIC_ERR_BOUNDS,
|
||||
"Out Of Bounds"));
|
||||
PASS(errctx, akerr_register_status_name(AKBASIC_OWNER, AKBASIC_ERR_ENVIRONMENT,
|
||||
"Environment Error"));
|
||||
PASS(errctx, akerr_register_status_name(AKBASIC_OWNER, AKBASIC_ERR_VALUE,
|
||||
"Value Error"));
|
||||
PASS(errctx, akerr_register_status_name(AKBASIC_OWNER, AKBASIC_ERR_STATE,
|
||||
"State Error"));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
393
src/grammar.c
Normal file
393
src/grammar.c
Normal file
@@ -0,0 +1,393 @@
|
||||
/**
|
||||
* @file grammar.c
|
||||
* @brief Implements token and AST leaf construction.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/convert.h>
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/grammar.h>
|
||||
|
||||
/* Copy into a leaf's inline identifier/literal buffer, refusing truncation. */
|
||||
static akerr_ErrorContext *copy_bounded(char *dest, const char *src, const char *what)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (src != NULL), AKERR_NULLPOINTER, "NULL %s", what);
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(src) < AKBASIC_MAX_STRING_LENGTH),
|
||||
AKBASIC_ERR_VALUE,
|
||||
"%s of %zu characters exceeds the %d character limit",
|
||||
what, strlen(src), AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
strncpy(dest, src, AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
dest[AKBASIC_MAX_STRING_LENGTH - 1] = '\0';
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_token_init(akbasic_Token *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL token in init");
|
||||
obj->tokentype = AKBASIC_TOK_UNDEFINED;
|
||||
obj->lineno = 0;
|
||||
obj->lexeme[0] = '\0';
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_init(akbasic_ASTLeaf *obj, akbasic_LeafType leaftype)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in init");
|
||||
obj->leaftype = leaftype;
|
||||
obj->parent = NULL;
|
||||
obj->left = NULL;
|
||||
obj->right = NULL;
|
||||
obj->expr = NULL;
|
||||
obj->identifier[0] = '\0';
|
||||
obj->literal_int = 0;
|
||||
obj->literal_float = 0.0;
|
||||
obj->literal_string[0] = '\0';
|
||||
obj->operator_ = AKBASIC_TOK_UNDEFINED;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* Take one leaf from the pool. Recursion in clone_into() is bounded by the pool
|
||||
* capacity, so a cyclic tree exhausts the pool and errors rather than running
|
||||
* off the stack.
|
||||
*/
|
||||
static akerr_ErrorContext *pool_take(akbasic_LeafPool *pool, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (pool != NULL), AKERR_NULLPOINTER, "NULL leaf pool");
|
||||
FAIL_ZERO_RETURN(errctx, (pool->leaves != NULL), AKERR_NULLPOINTER, "Leaf pool has no storage");
|
||||
FAIL_ZERO_RETURN(errctx, (pool->next < pool->capacity), AKBASIC_ERR_BOUNDS,
|
||||
"No more leaves available");
|
||||
*dest = &pool->leaves[pool->next];
|
||||
pool->next += 1;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *clone_into(akbasic_ASTLeaf *self, akbasic_LeafPool *pool, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *copy = NULL;
|
||||
|
||||
if ( self == NULL ) {
|
||||
*dest = NULL;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, pool_take(pool, ©));
|
||||
PASS(errctx, akbasic_leaf_init(copy, self->leaftype));
|
||||
copy->parent = self->parent;
|
||||
copy->literal_int = self->literal_int;
|
||||
copy->literal_float = self->literal_float;
|
||||
memcpy(copy->literal_string, self->literal_string, sizeof(copy->literal_string));
|
||||
memcpy(copy->identifier, self->identifier, sizeof(copy->identifier));
|
||||
copy->operator_ = self->operator_;
|
||||
|
||||
PASS(errctx, clone_into(self->left, pool, ©->left));
|
||||
PASS(errctx, clone_into(self->right, pool, ©->right));
|
||||
PASS(errctx, clone_into(self->expr, pool, ©->expr));
|
||||
|
||||
*dest = copy;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_clone(akbasic_ASTLeaf *self, akbasic_LeafPool *pool, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in clone");
|
||||
PASS(errctx, clone_into(self, pool, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akbasic_ASTLeaf *akbasic_leaf_first_argument(akbasic_ASTLeaf *self)
|
||||
{
|
||||
if ( self == NULL ||
|
||||
self->right == NULL ||
|
||||
self->right->leaftype != AKBASIC_LEAF_ARGUMENTLIST ||
|
||||
self->right->operator_ != AKBASIC_TOK_FUNCTION_ARGUMENT ) {
|
||||
return NULL;
|
||||
}
|
||||
return self->right->right;
|
||||
}
|
||||
|
||||
akbasic_ASTLeaf *akbasic_leaf_first_subscript(akbasic_ASTLeaf *self)
|
||||
{
|
||||
if ( self == NULL ||
|
||||
self->right == NULL ||
|
||||
self->right->leaftype != AKBASIC_LEAF_ARGUMENTLIST ||
|
||||
self->right->operator_ != AKBASIC_TOK_ARRAY_SUBSCRIPT ) {
|
||||
return NULL;
|
||||
}
|
||||
return self->right->right;
|
||||
}
|
||||
|
||||
bool akbasic_leaf_is_identifier(akbasic_ASTLeaf *self)
|
||||
{
|
||||
return (self != NULL &&
|
||||
(self->leaftype == AKBASIC_LEAF_IDENTIFIER ||
|
||||
self->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
|
||||
self->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT ||
|
||||
self->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING));
|
||||
}
|
||||
|
||||
bool akbasic_leaf_is_literal(akbasic_ASTLeaf *self)
|
||||
{
|
||||
return (self != NULL &&
|
||||
(self->leaftype == AKBASIC_LEAF_LITERAL_INT ||
|
||||
self->leaftype == AKBASIC_LEAF_LITERAL_FLOAT ||
|
||||
self->leaftype == AKBASIC_LEAF_LITERAL_STRING));
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_comparison(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *left, akbasic_TokenType op, akbasic_ASTLeaf *right)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_comparison");
|
||||
FAIL_ZERO_RETURN(errctx, (left != NULL && right != NULL), AKERR_NULLPOINTER,
|
||||
"nil pointer arguments");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_COMPARISON));
|
||||
obj->left = left;
|
||||
obj->right = right;
|
||||
switch ( op ) {
|
||||
case AKBASIC_TOK_LESS_THAN:
|
||||
case AKBASIC_TOK_LESS_THAN_EQUAL:
|
||||
case AKBASIC_TOK_NOT_EQUAL:
|
||||
case AKBASIC_TOK_GREATER_THAN:
|
||||
case AKBASIC_TOK_GREATER_THAN_EQUAL:
|
||||
SUCCEED_RETURN(errctx);
|
||||
default:
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "Invalid operator %d for comparison", (int)op);
|
||||
}
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_binary(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *left, akbasic_TokenType op, akbasic_ASTLeaf *right)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_binary");
|
||||
FAIL_ZERO_RETURN(errctx, (left != NULL && right != NULL), AKERR_NULLPOINTER,
|
||||
"nil pointer arguments");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_BINARY));
|
||||
obj->left = left;
|
||||
obj->right = right;
|
||||
obj->operator_ = op;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_unary(akbasic_ASTLeaf *obj, akbasic_TokenType op, akbasic_ASTLeaf *right)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_unary");
|
||||
FAIL_ZERO_RETURN(errctx, (right != NULL), AKERR_NULLPOINTER, "nil pointer arguments");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_UNARY));
|
||||
obj->right = right;
|
||||
obj->operator_ = op;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_function(akbasic_ASTLeaf *obj, const char *fname, akbasic_ASTLeaf *right)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_function");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_FUNCTION));
|
||||
obj->right = right;
|
||||
obj->operator_ = AKBASIC_TOK_COMMAND;
|
||||
PASS(errctx, copy_bounded(obj->identifier, fname, "function name"));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_command(akbasic_ASTLeaf *obj, const char *cmdname, akbasic_ASTLeaf *right)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_command");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_COMMAND));
|
||||
obj->right = right;
|
||||
obj->operator_ = AKBASIC_TOK_COMMAND;
|
||||
PASS(errctx, copy_bounded(obj->identifier, cmdname, "command name"));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_immediate_command(akbasic_ASTLeaf *obj, const char *cmdname, akbasic_ASTLeaf *right)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_immediate_command");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_COMMAND_IMMEDIATE));
|
||||
obj->right = right;
|
||||
obj->operator_ = AKBASIC_TOK_COMMAND_IMMEDIATE;
|
||||
PASS(errctx, copy_bounded(obj->identifier, cmdname, "command name"));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_branch(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *expr, akbasic_ASTLeaf *trueleaf, akbasic_ASTLeaf *falseleaf)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_branch");
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "nil pointer arguments");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_BRANCH));
|
||||
obj->expr = expr;
|
||||
obj->left = trueleaf;
|
||||
obj->right = falseleaf;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_grouping(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *expr)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_grouping");
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "nil pointer arguments");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_GROUPING));
|
||||
obj->expr = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_literal_int(akbasic_ASTLeaf *obj, const char *lexeme)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int base = 10;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_literal_int");
|
||||
FAIL_ZERO_RETURN(errctx, (lexeme != NULL), AKERR_NULLPOINTER, "NULL lexeme in new_literal_int");
|
||||
FAIL_ZERO_RETURN(errctx, (lexeme[0] != '\0'), AKBASIC_ERR_VALUE, "Empty integer literal");
|
||||
|
||||
/*
|
||||
* The reference selects base 8 for any lexeme starting with '0', so `010`
|
||||
* parses as 8 and `08` is an error. Commodore BASIC has no octal literals
|
||||
* and this is TODO.md section 12 item 10 -- but it is reproduced here,
|
||||
* because "port the behaviour first" is the rule and the fix is its own
|
||||
* commit with its own test.
|
||||
*/
|
||||
if ( strlen(lexeme) > 2 && strncmp(lexeme, "0x", 2) == 0 ) {
|
||||
base = 16;
|
||||
} else if ( lexeme[0] == '0' ) {
|
||||
base = 8;
|
||||
}
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_LITERAL_INT));
|
||||
PASS(errctx, akbasic_str_to_int64(lexeme, base, &obj->literal_int));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_literal_float(akbasic_ASTLeaf *obj, const char *lexeme)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_literal_float");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_LITERAL_FLOAT));
|
||||
PASS(errctx, akbasic_str_to_double(lexeme, &obj->literal_float));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_literal_string(akbasic_ASTLeaf *obj, const char *lexeme)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_literal_string");
|
||||
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_LITERAL_STRING));
|
||||
PASS(errctx, copy_bounded(obj->literal_string, lexeme, "string literal"));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_new_identifier(akbasic_ASTLeaf *obj, akbasic_LeafType leaftype, const char *lexeme)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_identifier");
|
||||
PASS(errctx, akbasic_leaf_init(obj, leaftype));
|
||||
PASS(errctx, copy_bounded(obj->identifier, lexeme, "identifier"));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static const char *operator_to_str(akbasic_TokenType op)
|
||||
{
|
||||
switch ( op ) {
|
||||
case AKBASIC_TOK_EQUAL: return "=";
|
||||
case AKBASIC_TOK_LESS_THAN: return "<";
|
||||
case AKBASIC_TOK_GREATER_THAN: return ">";
|
||||
case AKBASIC_TOK_LESS_THAN_EQUAL: return "<=";
|
||||
case AKBASIC_TOK_GREATER_THAN_EQUAL: return ">=";
|
||||
case AKBASIC_TOK_NOT_EQUAL: return "<>";
|
||||
case AKBASIC_TOK_PLUS: return "+";
|
||||
case AKBASIC_TOK_MINUS: return "-";
|
||||
case AKBASIC_TOK_STAR: return "*";
|
||||
case AKBASIC_TOK_LEFT_SLASH: return "/";
|
||||
case AKBASIC_TOK_CARAT: return "^";
|
||||
case AKBASIC_TOK_NOT: return "NOT";
|
||||
case AKBASIC_TOK_AND: return "AND";
|
||||
case AKBASIC_TOK_OR: return "OR";
|
||||
default: return "";
|
||||
}
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_leaf_to_string(akbasic_ASTLeaf *self, char *dest, size_t len)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char sub1[AKBASIC_MAX_STRING_LENGTH];
|
||||
char sub2[AKBASIC_MAX_STRING_LENGTH];
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL leaf in to_string");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in to_string");
|
||||
FAIL_ZERO_RETURN(errctx, (len > 0), AKBASIC_ERR_BOUNDS, "Zero-length destination in to_string");
|
||||
|
||||
switch ( self->leaftype ) {
|
||||
case AKBASIC_LEAF_LITERAL_INT:
|
||||
snprintf(dest, len, "%" PRId64, self->literal_int);
|
||||
break;
|
||||
case AKBASIC_LEAF_LITERAL_FLOAT:
|
||||
snprintf(dest, len, "%f", self->literal_float);
|
||||
break;
|
||||
case AKBASIC_LEAF_LITERAL_STRING:
|
||||
snprintf(dest, len, "%s", self->literal_string);
|
||||
break;
|
||||
case AKBASIC_LEAF_IDENTIFIER_INT:
|
||||
case AKBASIC_LEAF_IDENTIFIER_FLOAT:
|
||||
case AKBASIC_LEAF_IDENTIFIER_STRING:
|
||||
case AKBASIC_LEAF_IDENTIFIER:
|
||||
snprintf(dest, len, "%s", self->identifier);
|
||||
break;
|
||||
case AKBASIC_LEAF_IDENTIFIER_STRUCT:
|
||||
snprintf(dest, len, "NOT IMPLEMENTED");
|
||||
break;
|
||||
case AKBASIC_LEAF_UNARY:
|
||||
PASS(errctx, akbasic_leaf_to_string(self->right, sub1, sizeof(sub1)));
|
||||
snprintf(dest, len, "(%s %s)", operator_to_str(self->operator_), sub1);
|
||||
break;
|
||||
case AKBASIC_LEAF_BINARY:
|
||||
PASS(errctx, akbasic_leaf_to_string(self->left, sub1, sizeof(sub1)));
|
||||
PASS(errctx, akbasic_leaf_to_string(self->right, sub2, sizeof(sub2)));
|
||||
snprintf(dest, len, "(%s %s %s)", operator_to_str(self->operator_), sub1, sub2);
|
||||
break;
|
||||
case AKBASIC_LEAF_GROUPING:
|
||||
PASS(errctx, akbasic_leaf_to_string(self->expr, sub1, sizeof(sub1)));
|
||||
snprintf(dest, len, "(group %s)", sub1);
|
||||
break;
|
||||
case AKBASIC_LEAF_COMMAND:
|
||||
case AKBASIC_LEAF_COMMAND_IMMEDIATE:
|
||||
case AKBASIC_LEAF_FUNCTION:
|
||||
/*
|
||||
* The reference falls through to Go's %+v struct dump here, which has no
|
||||
* useful C equivalent. Print something a test can assert on instead.
|
||||
*/
|
||||
snprintf(dest, len, "(%s)", self->identifier);
|
||||
break;
|
||||
default:
|
||||
snprintf(dest, len, "(leaf %d)", (int)self->leaftype);
|
||||
break;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
62
src/main.c
Normal file
62
src/main.c
Normal file
@@ -0,0 +1,62 @@
|
||||
/**
|
||||
* @file main.c
|
||||
* @brief The standalone driver.
|
||||
*
|
||||
* Everything that belongs to a program rather than to a library lives here: argv
|
||||
* handling, sink selection, the unbounded run loop, and the one FINISH_NORETURN
|
||||
* in the tree. The interpreter library itself never terminates the process.
|
||||
*
|
||||
* The runtime is static rather than automatic because it carries every pool the
|
||||
* interpreter owns -- several megabytes -- and that will not fit on a default
|
||||
* stack. An embedding game would place it in its own state for the same reason.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#include <akerror.h>
|
||||
#include <akstdlib.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/runtime.h>
|
||||
#include <akbasic/sink.h>
|
||||
|
||||
static akbasic_Runtime RUNTIME;
|
||||
static akbasic_TextSink SINK;
|
||||
static akbasic_StdioSink SINKSTATE;
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
FILE *program = NULL;
|
||||
int rc = EXIT_SUCCESS;
|
||||
|
||||
ATTEMPT {
|
||||
if ( argc > 1 ) {
|
||||
/*
|
||||
* A file argument: read the program from it in RUNSTREAM mode, which
|
||||
* files each line under its line number and then switches to RUN.
|
||||
*/
|
||||
CATCH(errctx, aksl_fopen(argv[1], "r", &program));
|
||||
CATCH(errctx, akbasic_sink_init_stdio(&SINK, &SINKSTATE, stdout, program));
|
||||
CATCH(errctx, akbasic_runtime_init(&RUNTIME, &SINK));
|
||||
CATCH(errctx, akbasic_runtime_start(&RUNTIME, AKBASIC_MODE_RUNSTREAM));
|
||||
} else {
|
||||
CATCH(errctx, akbasic_sink_init_stdio(&SINK, &SINKSTATE, stdout, stdin));
|
||||
CATCH(errctx, akbasic_runtime_init(&RUNTIME, &SINK));
|
||||
CATCH(errctx, akbasic_runtime_start(&RUNTIME, AKBASIC_MODE_REPL));
|
||||
}
|
||||
/* Unbounded: this is the driver, and it has nothing else to do. */
|
||||
CATCH(errctx, akbasic_runtime_run(&RUNTIME, 0));
|
||||
} CLEANUP {
|
||||
if ( program != NULL ) {
|
||||
IGNORE(aksl_fclose(program));
|
||||
}
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE_DEFAULT(errctx) {
|
||||
LOG_ERROR_WITH_MESSAGE(errctx, "akbasic terminated on an unhandled error");
|
||||
rc = EXIT_FAILURE;
|
||||
} FINISH_NORETURN(errctx);
|
||||
|
||||
return rc;
|
||||
}
|
||||
617
src/parser.c
Normal file
617
src/parser.c
Normal file
@@ -0,0 +1,617 @@
|
||||
/**
|
||||
* @file parser.c
|
||||
* @brief Implements the recursive-descent parser.
|
||||
*
|
||||
* A faithful port of basicparser.go, with two changes. The reflection lookup for
|
||||
* a verb's special parse path becomes a table lookup, and the debug.PrintStack()
|
||||
* the reference calls on a parse failure is gone: an interpreter library does not
|
||||
* dump the host's stack to stderr, and the akerr stack trace already carries what
|
||||
* that call was for.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/parser.h>
|
||||
#include <akbasic/verbs.h>
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_init(akbasic_Parser *obj, akbasic_Runtime *runtime)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL parser in init");
|
||||
FAIL_ZERO_RETURN(errctx, (runtime != NULL), AKERR_NULLPOINTER, "nil runtime argument");
|
||||
obj->runtime = runtime;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_zero(akbasic_Parser *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "nil self reference!");
|
||||
PASS(errctx, akbasic_environment_zero_parser(obj->runtime->environment));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_new_leaf(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, akbasic_environment_new_leaf(obj->runtime->environment, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
bool akbasic_parser_is_at_end(akbasic_Parser *obj)
|
||||
{
|
||||
akbasic_Environment *env = NULL;
|
||||
|
||||
if ( obj == NULL || obj->runtime == NULL || obj->runtime->environment == NULL ) {
|
||||
return true;
|
||||
}
|
||||
env = obj->runtime->environment;
|
||||
return (env->curtoken >= (AKBASIC_MAX_TOKENS - 1) || env->curtoken >= env->nexttoken);
|
||||
}
|
||||
|
||||
akbasic_Token *akbasic_parser_peek(akbasic_Parser *obj)
|
||||
{
|
||||
if ( akbasic_parser_is_at_end(obj) ) {
|
||||
return NULL;
|
||||
}
|
||||
return &obj->runtime->environment->tokens[obj->runtime->environment->curtoken];
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_previous(akbasic_Parser *obj, akbasic_Token **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in previous");
|
||||
FAIL_ZERO_RETURN(errctx, (obj->runtime->environment->curtoken != 0), AKBASIC_ERR_SYNTAX,
|
||||
"Current token is index 0, no previous token");
|
||||
*dest = &obj->runtime->environment->tokens[obj->runtime->environment->curtoken - 1];
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static bool check(akbasic_Parser *obj, akbasic_TokenType tokentype)
|
||||
{
|
||||
akbasic_Token *next = NULL;
|
||||
|
||||
if ( akbasic_parser_is_at_end(obj) ) {
|
||||
return false;
|
||||
}
|
||||
next = akbasic_parser_peek(obj);
|
||||
return (next != NULL && next->tokentype == tokentype);
|
||||
}
|
||||
|
||||
static void advance(akbasic_Parser *obj)
|
||||
{
|
||||
if ( !akbasic_parser_is_at_end(obj) ) {
|
||||
obj->runtime->environment->curtoken += 1;
|
||||
}
|
||||
}
|
||||
|
||||
bool akbasic_parser_match(akbasic_Parser *obj, const akbasic_TokenType *types, int count)
|
||||
{
|
||||
int i = 0;
|
||||
|
||||
for ( i = 0; i < count; i++ ) {
|
||||
if ( check(obj, types[i]) ) {
|
||||
advance(obj);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
bool akbasic_parser_match1(akbasic_Parser *obj, akbasic_TokenType type)
|
||||
{
|
||||
return akbasic_parser_match(obj, &type, 1);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_error(akbasic_Parser *obj, const char *message)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Token *token = NULL;
|
||||
|
||||
token = akbasic_parser_peek(obj);
|
||||
obj->runtime->environment->errorToken = token;
|
||||
FAIL_ZERO_RETURN(errctx, (token != NULL), AKBASIC_ERR_SYNTAX, "peek() returned nil token!");
|
||||
if ( token->tokentype == AKBASIC_TOK_EOF ) {
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "%" PRId64 " at end %s", token->lineno, message);
|
||||
}
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "%" PRId64 " at '%s', %s",
|
||||
token->lineno, token->lexeme, message);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *consume(akbasic_Parser *obj, akbasic_TokenType tokentype, const char *message)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
if ( check(obj, tokentype) ) {
|
||||
advance(obj);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, akbasic_parser_error(obj, message));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* Forward declarations for the grammar chain. */
|
||||
static akerr_ErrorContext *logicalandor(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
static akerr_ErrorContext *logicalnot(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
static akerr_ErrorContext *subtraction(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
static akerr_ErrorContext *addition(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
static akerr_ErrorContext *multiplication(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
static akerr_ErrorContext *division(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
static akerr_ErrorContext *unary(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
static akerr_ErrorContext *exponent(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
static akerr_ErrorContext *function_call(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_parse(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in parse");
|
||||
PASS(errctx, akbasic_parser_command(obj, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_command(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
static const akbasic_TokenType COMMANDS[] = {
|
||||
AKBASIC_TOK_COMMAND, AKBASIC_TOK_COMMAND_IMMEDIATE
|
||||
};
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
akbasic_Token *righttoken = NULL;
|
||||
const akbasic_Verb *verb = NULL;
|
||||
akbasic_TokenType optype = AKBASIC_TOK_UNDEFINED;
|
||||
char opname[AKBASIC_MAX_LINE_LENGTH];
|
||||
|
||||
if ( !akbasic_parser_match(obj, COMMANDS, 2) ) {
|
||||
PASS(errctx, akbasic_parser_assignment(obj, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
optype = operator_->tokentype;
|
||||
strncpy(opname, operator_->lexeme, sizeof(opname) - 1);
|
||||
opname[sizeof(opname) - 1] = '\0';
|
||||
|
||||
/* Does this verb need its own parse path? */
|
||||
PASS(errctx, akbasic_verb_lookup(opname, &verb));
|
||||
if ( verb != NULL && verb->parse != NULL ) {
|
||||
PASS(errctx, verb->parse(obj, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* Some verbs take no rval. Do not fail when there is not one -- but do fail
|
||||
* when there is one and it will not parse.
|
||||
*/
|
||||
righttoken = akbasic_parser_peek(obj);
|
||||
if ( righttoken != NULL && righttoken->tokentype != AKBASIC_TOK_UNDEFINED ) {
|
||||
PASS(errctx, akbasic_parser_expression(obj, &right));
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
if ( optype == AKBASIC_TOK_COMMAND_IMMEDIATE ) {
|
||||
PASS(errctx, akbasic_leaf_new_immediate_command(expr, opname, right));
|
||||
} else {
|
||||
PASS(errctx, akbasic_leaf_new_command(expr, opname, right));
|
||||
}
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_assignment(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *identifier = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
|
||||
PASS(errctx, akbasic_parser_expression(obj, &identifier));
|
||||
if ( identifier == NULL ||
|
||||
(identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_INT &&
|
||||
identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_FLOAT &&
|
||||
identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_STRING) ) {
|
||||
*dest = identifier;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
if ( akbasic_parser_match1(obj, AKBASIC_TOK_ASSIGNMENT) ) {
|
||||
PASS(errctx, akbasic_parser_expression(obj, &right));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_binary(expr, identifier, AKBASIC_TOK_ASSIGNMENT, right));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
*dest = identifier;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* An argument list is just .right-joined expressions continuing ad infinitum.
|
||||
* When requireparens is false and there is no opening paren, this still builds a
|
||||
* list -- that is how DATA and READ take a bare comma-separated series.
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_parser_argument_list(akbasic_Parser *obj, akbasic_TokenType arglisttype, bool requireparens, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *arglist = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
|
||||
*dest = NULL;
|
||||
if ( !akbasic_parser_match1(obj, AKBASIC_TOK_LEFT_PAREN) && requireparens ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(arglisttype == AKBASIC_TOK_ARRAY_SUBSCRIPT ||
|
||||
arglisttype == AKBASIC_TOK_FUNCTION_ARGUMENT),
|
||||
AKBASIC_ERR_SYNTAX,
|
||||
"argumentList expects argListType [ARRAY_SUBSCRIPT || FUNCTION_ARGUMENT]");
|
||||
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &arglist));
|
||||
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
|
||||
arglist->operator_ = arglisttype;
|
||||
PASS(errctx, akbasic_parser_expression(obj, &arglist->right));
|
||||
|
||||
expr = arglist->right;
|
||||
while ( expr != NULL && akbasic_parser_match1(obj, AKBASIC_TOK_COMMA) ) {
|
||||
PASS(errctx, akbasic_parser_expression(obj, &expr->right));
|
||||
expr = expr->right;
|
||||
}
|
||||
if ( !akbasic_parser_match1(obj, AKBASIC_TOK_RIGHT_PAREN) && requireparens ) {
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "Unbalanced parenthesis");
|
||||
}
|
||||
*dest = arglist;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_expression(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, logicalandor(obj, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *logicalandor(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
static const akbasic_TokenType OPS[] = { AKBASIC_TOK_AND, AKBASIC_TOK_OR };
|
||||
akbasic_ASTLeaf *left = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
PASS(errctx, logicalnot(obj, &left));
|
||||
if ( akbasic_parser_match(obj, OPS, 2) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, logicalnot(obj, &right));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
*dest = left;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *logicalnot(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
if ( akbasic_parser_match1(obj, AKBASIC_TOK_NOT) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, akbasic_parser_relation(obj, &right));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_unary(expr, operator_->tokentype, right));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, akbasic_parser_relation(obj, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_relation(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
static const akbasic_TokenType OPS[] = {
|
||||
AKBASIC_TOK_LESS_THAN, AKBASIC_TOK_LESS_THAN_EQUAL, AKBASIC_TOK_EQUAL,
|
||||
AKBASIC_TOK_NOT_EQUAL, AKBASIC_TOK_GREATER_THAN, AKBASIC_TOK_GREATER_THAN_EQUAL
|
||||
};
|
||||
akbasic_ASTLeaf *left = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
PASS(errctx, subtraction(obj, &left));
|
||||
if ( akbasic_parser_match(obj, OPS, 6) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, subtraction(obj, &right));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
*dest = left;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* subtraction and exponent return after one operator where addition,
|
||||
* multiplication and division loop. That asymmetry is the reference's, not a
|
||||
* transcription slip: `1 - 2 - 3` parses as `1 - (2 - 3)` there. Reproduced,
|
||||
* because the golden corpus encodes the observed associativity.
|
||||
*/
|
||||
static akerr_ErrorContext *subtraction(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *left = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
PASS(errctx, addition(obj, &left));
|
||||
if ( akbasic_parser_match1(obj, AKBASIC_TOK_MINUS) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, addition(obj, &right));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
*dest = left;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *addition(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *left = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
PASS(errctx, multiplication(obj, &left));
|
||||
while ( akbasic_parser_match1(obj, AKBASIC_TOK_PLUS) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, multiplication(obj, &right));
|
||||
if ( expr != NULL ) {
|
||||
left = expr;
|
||||
}
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
|
||||
}
|
||||
*dest = (expr != NULL ? expr : left);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *multiplication(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *left = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
PASS(errctx, division(obj, &left));
|
||||
while ( akbasic_parser_match1(obj, AKBASIC_TOK_STAR) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, division(obj, &right));
|
||||
if ( expr != NULL ) {
|
||||
left = expr;
|
||||
}
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
|
||||
}
|
||||
*dest = (expr != NULL ? expr : left);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *division(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *left = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
PASS(errctx, unary(obj, &left));
|
||||
while ( akbasic_parser_match1(obj, AKBASIC_TOK_LEFT_SLASH) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, unary(obj, &right));
|
||||
if ( expr != NULL ) {
|
||||
left = expr;
|
||||
}
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
|
||||
}
|
||||
*dest = (expr != NULL ? expr : left);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *unary(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
if ( akbasic_parser_match1(obj, AKBASIC_TOK_MINUS) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, akbasic_parser_primary(obj, &right));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_unary(expr, operator_->tokentype, right));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, exponent(obj, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *exponent(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *left = NULL;
|
||||
akbasic_ASTLeaf *right = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
PASS(errctx, function_call(obj, &left));
|
||||
if ( akbasic_parser_match1(obj, AKBASIC_TOK_CARAT) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
PASS(errctx, function_call(obj, &right));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
*dest = left;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* Count the .right-joined chain hanging off an argument list. */
|
||||
static int arglist_length(akbasic_ASTLeaf *arglist)
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
int count = 0;
|
||||
|
||||
if ( arglist == NULL ) {
|
||||
return 0;
|
||||
}
|
||||
for ( leaf = arglist->right; leaf != NULL; leaf = leaf->right ) {
|
||||
count += 1;
|
||||
}
|
||||
return count;
|
||||
}
|
||||
|
||||
/*
|
||||
* Called for function *calls* only, never for a DEF. A FUNCTION token is either
|
||||
* a table builtin or a user DEF; both check their argument count here, so a
|
||||
* wrong-arity call is a parse error rather than a runtime surprise.
|
||||
*/
|
||||
static akerr_ErrorContext *function_call(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *arglist = NULL;
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
const akbasic_Verb *verb = NULL;
|
||||
akbasic_FunctionDef *fndef = NULL;
|
||||
void *fnptr = NULL;
|
||||
char fname[AKBASIC_MAX_LINE_LENGTH];
|
||||
int wanted = 0;
|
||||
int given = 0;
|
||||
bool found = false;
|
||||
|
||||
if ( !akbasic_parser_match1(obj, AKBASIC_TOK_FUNCTION) ) {
|
||||
PASS(errctx, akbasic_parser_primary(obj, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_parser_previous(obj, &operator_));
|
||||
strncpy(fname, operator_->lexeme, sizeof(fname) - 1);
|
||||
fname[sizeof(fname) - 1] = '\0';
|
||||
|
||||
PASS(errctx, akbasic_verb_lookup(fname, &verb));
|
||||
if ( verb != NULL && verb->tokentype == AKBASIC_TOK_FUNCTION ) {
|
||||
wanted = verb->arity;
|
||||
found = true;
|
||||
} else {
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_environment_get_function(obj->runtime->environment, fname, &fnptr));
|
||||
found = true;
|
||||
} CLEANUP {
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE(errctx, AKERR_KEY) {
|
||||
found = false;
|
||||
} FINISH(errctx, true);
|
||||
if ( found ) {
|
||||
fndef = (akbasic_FunctionDef *)fnptr;
|
||||
wanted = arglist_length(fndef->arglist);
|
||||
}
|
||||
}
|
||||
FAIL_ZERO_RETURN(errctx, found, AKBASIC_ERR_UNDEFINED, "No such function %s", fname);
|
||||
|
||||
PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_FUNCTION_ARGUMENT, true, &arglist));
|
||||
given = arglist_length(arglist);
|
||||
FAIL_ZERO_RETURN(errctx, (given == wanted), AKBASIC_ERR_SYNTAX,
|
||||
"function %s takes %d arguments, received %d", fname, wanted, given);
|
||||
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &leaf));
|
||||
PASS(errctx, akbasic_leaf_new_function(leaf, fname, arglist));
|
||||
*dest = leaf;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parser_primary(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
static const akbasic_TokenType PRIMARIES[] = {
|
||||
AKBASIC_TOK_LITERAL_INT, AKBASIC_TOK_LITERAL_FLOAT, AKBASIC_TOK_LITERAL_STRING,
|
||||
AKBASIC_TOK_IDENTIFIER, AKBASIC_TOK_IDENTIFIER_STRING, AKBASIC_TOK_IDENTIFIER_FLOAT,
|
||||
AKBASIC_TOK_IDENTIFIER_INT, AKBASIC_TOK_FUNCTION
|
||||
};
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_ASTLeaf *groupexpr = NULL;
|
||||
akbasic_Token *previous = NULL;
|
||||
|
||||
if ( akbasic_parser_match(obj, PRIMARIES, 8) ) {
|
||||
PASS(errctx, akbasic_parser_previous(obj, &previous));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
switch ( previous->tokentype ) {
|
||||
case AKBASIC_TOK_LITERAL_INT:
|
||||
PASS(errctx, akbasic_leaf_new_literal_int(expr, previous->lexeme));
|
||||
break;
|
||||
case AKBASIC_TOK_LITERAL_FLOAT:
|
||||
PASS(errctx, akbasic_leaf_new_literal_float(expr, previous->lexeme));
|
||||
break;
|
||||
case AKBASIC_TOK_LITERAL_STRING:
|
||||
PASS(errctx, akbasic_leaf_new_literal_string(expr, previous->lexeme));
|
||||
break;
|
||||
case AKBASIC_TOK_IDENTIFIER_INT:
|
||||
PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_INT, previous->lexeme));
|
||||
PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->right));
|
||||
break;
|
||||
case AKBASIC_TOK_IDENTIFIER_FLOAT:
|
||||
PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_FLOAT, previous->lexeme));
|
||||
PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->right));
|
||||
break;
|
||||
case AKBASIC_TOK_IDENTIFIER_STRING:
|
||||
PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_STRING, previous->lexeme));
|
||||
PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->right));
|
||||
break;
|
||||
case AKBASIC_TOK_FUNCTION:
|
||||
case AKBASIC_TOK_IDENTIFIER:
|
||||
PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER, previous->lexeme));
|
||||
break;
|
||||
default:
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "Invalid literal type, command or function name");
|
||||
}
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
if ( akbasic_parser_match1(obj, AKBASIC_TOK_LEFT_PAREN) ) {
|
||||
PASS(errctx, akbasic_parser_expression(obj, &groupexpr));
|
||||
PASS(errctx, consume(obj, AKBASIC_TOK_RIGHT_PAREN, "Missing ) after expression"));
|
||||
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_grouping(expr, groupexpr));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_parser_error(obj, "Expected expression or literal"));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
356
src/parser_commands.c
Normal file
356
src/parser_commands.c
Normal file
@@ -0,0 +1,356 @@
|
||||
/**
|
||||
* @file parser_commands.c
|
||||
* @brief Verbs that need their own parse path rather than a plain expression.
|
||||
*
|
||||
* Ported from basicparser_commands.go. Two of these mutate runtime state from
|
||||
* inside the parser and that is not an accident: DEF installs the function so a
|
||||
* later line can call it, and FOR builds and installs the loop's environment
|
||||
* before the body is ever scanned. The waitingForCommand scheme depends on the
|
||||
* latter.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/parser.h>
|
||||
#include <akbasic/runtime.h>
|
||||
|
||||
#include "verbs.h"
|
||||
|
||||
akerr_ErrorContext *akbasic_parse_let(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
/*
|
||||
* LET is optional in this dialect and in Commodore BASIC 7.0. Assignment is
|
||||
* handled by expression evaluation, so LET parses as a bare assignment and
|
||||
* its exec handler does nothing.
|
||||
*/
|
||||
PASS(errctx, akbasic_parser_assignment(parser, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* LABEL and DIM share a shape: the verb, then one identifier. */
|
||||
static akerr_ErrorContext *parse_verb_with_identifier(akbasic_Parser *parser, const char *verbname, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *identifier = NULL;
|
||||
akbasic_ASTLeaf *command = NULL;
|
||||
|
||||
PASS(errctx, akbasic_parser_primary(parser, &identifier));
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(identifier), AKBASIC_ERR_SYNTAX,
|
||||
"Expected identifier");
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &command));
|
||||
PASS(errctx, akbasic_leaf_new_command(command, verbname, identifier));
|
||||
*dest = command;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parse_label(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, parse_verb_with_identifier(parser, "LABEL", dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parse_dim(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, parse_verb_with_identifier(parser, "DIM", dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* DEF NAME (A, ...) [= expression]
|
||||
* COMMAND IDENTIFIER ARGUMENTLIST [ASSIGNMENT EXPRESSION]
|
||||
*
|
||||
* With an `=` the function is a single expression. Without one it is a
|
||||
* multi-line subroutine whose body starts on the next line and ends at RETURN,
|
||||
* so the environment is told to skip forward to that RETURN rather than execute
|
||||
* the body during the definition.
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Runtime *runtime = parser->runtime;
|
||||
akbasic_ASTLeaf *identifier = NULL;
|
||||
akbasic_ASTLeaf *arglist = NULL;
|
||||
akbasic_ASTLeaf *expression = NULL;
|
||||
akbasic_ASTLeaf *walk = NULL;
|
||||
akbasic_ASTLeaf *command = NULL;
|
||||
akbasic_FunctionDef *fndef = NULL;
|
||||
size_t i = 0;
|
||||
|
||||
PASS(errctx, akbasic_parser_primary(parser, &identifier));
|
||||
FAIL_ZERO_RETURN(errctx, (identifier->leaftype == AKBASIC_LEAF_IDENTIFIER),
|
||||
AKBASIC_ERR_SYNTAX, "Expected identifier");
|
||||
|
||||
PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, true, &arglist));
|
||||
FAIL_ZERO_RETURN(errctx, (arglist != NULL), AKBASIC_ERR_SYNTAX,
|
||||
"Expected argument list (identifier names)");
|
||||
|
||||
for ( walk = arglist->right; walk != NULL; walk = walk->right ) {
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(walk->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ||
|
||||
walk->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
|
||||
walk->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT),
|
||||
AKBASIC_ERR_SYNTAX,
|
||||
"Only variable identifiers are valid arguments for DEF");
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_runtime_new_function(runtime, &fndef));
|
||||
|
||||
/* Uppercase the name: verbs and function names are case-insensitive. */
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(identifier->identifier) < sizeof(fndef->name)),
|
||||
AKBASIC_ERR_BOUNDS, "Function name '%s' is too long", identifier->identifier);
|
||||
for ( i = 0; i < strlen(identifier->identifier); i++ ) {
|
||||
char c = identifier->identifier[i];
|
||||
fndef->name[i] = (char)((c >= 'a' && c <= 'z') ? (c - 'a' + 'A') : c);
|
||||
}
|
||||
fndef->name[strlen(identifier->identifier)] = '\0';
|
||||
|
||||
if ( akbasic_parser_match1(parser, AKBASIC_TOK_ASSIGNMENT) ) {
|
||||
PASS(errctx, akbasic_parser_expression(parser, &expression));
|
||||
PASS(errctx, akbasic_leaf_clone(expression, &fndef->leafpool, &fndef->expression));
|
||||
} else {
|
||||
/*
|
||||
* No expression: the body is the lines that follow. Record where it
|
||||
* starts and skip to RETURN so the definition itself does not execute
|
||||
* the body.
|
||||
*/
|
||||
fndef->expression = NULL;
|
||||
PASS(errctx, akbasic_environment_wait_for_command(runtime->environment, "RETURN"));
|
||||
}
|
||||
PASS(errctx, akbasic_leaf_clone(arglist, &fndef->leafpool, &fndef->arglist));
|
||||
fndef->lineno = runtime->environment->lineno + 1;
|
||||
|
||||
PASS(errctx, akbasic_symtab_set(&runtime->environment->functions, fndef->name, fndef, 0));
|
||||
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &command));
|
||||
PASS(errctx, akbasic_leaf_new_command(command, "DEF", NULL));
|
||||
*dest = command;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* FOR ... TO .... [STEP ...]
|
||||
* COMMAND ASSIGNMENT EXPRESSION [COMMAND EXPRESSION]
|
||||
*
|
||||
* Sets up the loop's environment with the TO and STEP expressions and the first
|
||||
* body line, then makes it the active environment. The FOR leaf itself carries
|
||||
* the assignment.
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_parse_for(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Runtime *runtime = parser->runtime;
|
||||
akbasic_ASTLeaf *assignment = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
akbasic_Environment *parent = runtime->environment;
|
||||
akbasic_Environment *newenv = NULL;
|
||||
int64_t firstline = 0;
|
||||
|
||||
PASS(errctx, akbasic_parser_assignment(parser, &assignment));
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
|
||||
AKBASIC_ERR_SYNTAX,
|
||||
"Expected FOR (assignment) TO (expression) [STEP (expression)]");
|
||||
PASS(errctx, akbasic_parser_previous(parser, &operator_));
|
||||
FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "TO"), AKBASIC_ERR_SYNTAX,
|
||||
"Expected FOR (assignment) TO (expression) [STEP (expression)]");
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(assignment != NULL && akbasic_leaf_is_identifier(assignment->left)),
|
||||
AKBASIC_ERR_SYNTAX,
|
||||
"Expected FOR (assignment) TO (expression) [STEP (expression)]");
|
||||
|
||||
firstline = parent->lineno + 1;
|
||||
|
||||
/*
|
||||
* The loop body is scanned against the *parent* environment's token stream,
|
||||
* so the new environment cannot become active until parsing is done. Parse
|
||||
* TO and STEP first, then switch.
|
||||
*/
|
||||
PASS(errctx, akbasic_runtime_new_environment(runtime));
|
||||
newenv = runtime->environment;
|
||||
runtime->environment = parent;
|
||||
|
||||
PASS(errctx, akbasic_parser_expression(parser, &newenv->forToLeaf));
|
||||
|
||||
if ( akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND) ) {
|
||||
PASS(errctx, akbasic_parser_previous(parser, &operator_));
|
||||
FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "STEP"), AKBASIC_ERR_SYNTAX,
|
||||
"Expected FOR (assignment) TO (expression) [STEP (expression)]");
|
||||
PASS(errctx, akbasic_parser_expression(parser, &newenv->forStepLeaf));
|
||||
} else {
|
||||
/*
|
||||
* Dartmouth BASIC says not to infer a negative step: it is either given
|
||||
* explicitly or assumed to be +1.
|
||||
*/
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &newenv->forStepLeaf));
|
||||
PASS(errctx, akbasic_leaf_new_literal_int(newenv->forStepLeaf, "1"));
|
||||
}
|
||||
|
||||
/* A NEXT already being awaited means this is an inner loop over the same variable. */
|
||||
if ( strcmp(parent->waitingForCommand, "NEXT") == 0 ) {
|
||||
newenv->forNextVariable = parent->forNextVariable;
|
||||
}
|
||||
newenv->loopFirstLine = firstline;
|
||||
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_command(expr, "FOR", assignment));
|
||||
|
||||
runtime->environment = newenv;
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* READ VARNAME [, ...]
|
||||
* COMMAND ARGUMENTLIST
|
||||
*
|
||||
* The identifier leaves are deep-copied into the environment, because the DATA
|
||||
* line that fills them is parsed later and will have overwritten the per-line
|
||||
* leaf pool by then.
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_parse_read(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Environment *env = parser->runtime->environment;
|
||||
akbasic_ASTLeaf *arglist = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_ASTLeaf *command = NULL;
|
||||
int i = 0;
|
||||
|
||||
PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, false, &arglist));
|
||||
FAIL_ZERO_RETURN(errctx, (arglist != NULL && arglist->right != NULL), AKBASIC_ERR_SYNTAX,
|
||||
"Expected identifier");
|
||||
|
||||
env->readLeafPool.next = 0;
|
||||
expr = arglist->right;
|
||||
for ( i = 0; i < AKBASIC_MAX_LEAVES; i++ ) {
|
||||
if ( expr == NULL ) {
|
||||
env->readIdentifierLeaves[i] = NULL;
|
||||
continue;
|
||||
}
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(expr), AKBASIC_ERR_SYNTAX,
|
||||
"Expected identifier");
|
||||
PASS(errctx, akbasic_leaf_clone(expr, &env->readLeafPool, &env->readIdentifierLeaves[i]));
|
||||
/*
|
||||
* A cloned identifier keeps its .right chain, which for READ is the
|
||||
* *next* identifier, not a subscript. Sever it so evaluating this leaf
|
||||
* cannot walk into its sibling.
|
||||
*/
|
||||
env->readIdentifierLeaves[i]->right = NULL;
|
||||
expr = expr->right;
|
||||
}
|
||||
env->readReturnLine = env->lineno + 1;
|
||||
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &command));
|
||||
PASS(errctx, akbasic_leaf_new_command(command, "READ", arglist));
|
||||
*dest = command;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* DATA LITERAL [, ...]
|
||||
* COMMAND ARGUMENTLIST
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_parse_data(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *arglist = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
akbasic_ASTLeaf *command = NULL;
|
||||
|
||||
PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, false, &arglist));
|
||||
FAIL_ZERO_RETURN(errctx, (arglist != NULL && arglist->right != NULL), AKBASIC_ERR_SYNTAX,
|
||||
"Expected literal");
|
||||
for ( expr = arglist->right; expr != NULL; expr = expr->right ) {
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_literal(expr), AKBASIC_ERR_SYNTAX,
|
||||
"Expected literal");
|
||||
}
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &command));
|
||||
PASS(errctx, akbasic_leaf_new_command(command, "DATA", arglist));
|
||||
*dest = command;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_parse_poke(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *arglist = NULL;
|
||||
akbasic_ASTLeaf *expr = NULL;
|
||||
|
||||
PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, false, &arglist));
|
||||
FAIL_ZERO_RETURN(errctx, (arglist != NULL), AKBASIC_ERR_SYNTAX,
|
||||
"POKE expected INTEGER, INTEGER");
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
|
||||
PASS(errctx, akbasic_leaf_new_command(expr, "POKE", arglist));
|
||||
*dest = expr;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* IF relation THEN command [ELSE command]
|
||||
* becomes BRANCH(expr=relation, left=then_command, right=else_command).
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_parse_if(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *relation = NULL;
|
||||
akbasic_ASTLeaf *then_command = NULL;
|
||||
akbasic_ASTLeaf *else_command = NULL;
|
||||
akbasic_ASTLeaf *branch = NULL;
|
||||
akbasic_Token *operator_ = NULL;
|
||||
|
||||
PASS(errctx, akbasic_parser_relation(parser, &relation));
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
|
||||
AKBASIC_ERR_SYNTAX, "Incomplete IF statement");
|
||||
PASS(errctx, akbasic_parser_previous(parser, &operator_));
|
||||
FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "THEN"), AKBASIC_ERR_SYNTAX,
|
||||
"Expected IF ... THEN");
|
||||
|
||||
PASS(errctx, akbasic_parser_command(parser, &then_command));
|
||||
|
||||
if ( akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND) ) {
|
||||
PASS(errctx, akbasic_parser_previous(parser, &operator_));
|
||||
FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "ELSE"), AKBASIC_ERR_SYNTAX,
|
||||
"Expected IF ... THEN ... ELSE ...");
|
||||
PASS(errctx, akbasic_parser_command(parser, &else_command));
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &branch));
|
||||
PASS(errctx, akbasic_leaf_new_branch(branch, relation, then_command, else_command));
|
||||
*dest = branch;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* INPUT "PROMPT" VARIABLE
|
||||
* COMMAND EXPRESSION IDENTIFIER
|
||||
*
|
||||
* The prompt is hung off the identifier's .left, which is where the exec handler
|
||||
* looks for it.
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_parse_input(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *promptexpr = NULL;
|
||||
akbasic_ASTLeaf *identifier = NULL;
|
||||
akbasic_ASTLeaf *command = NULL;
|
||||
|
||||
PASS(errctx, akbasic_parser_expression(parser, &promptexpr));
|
||||
PASS(errctx, akbasic_parser_primary(parser, &identifier));
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(identifier), AKBASIC_ERR_SYNTAX,
|
||||
"Expected identifier");
|
||||
PASS(errctx, akbasic_parser_new_leaf(parser, &command));
|
||||
PASS(errctx, akbasic_leaf_new_command(command, "INPUT", identifier));
|
||||
identifier->left = promptexpr;
|
||||
*dest = command;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
797
src/runtime.c
Normal file
797
src/runtime.c
Normal file
@@ -0,0 +1,797 @@
|
||||
/**
|
||||
* @file runtime.c
|
||||
* @brief Implements the interpreter core: pools, evaluation and the step loop.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/parser.h>
|
||||
#include <akbasic/runtime.h>
|
||||
#include <akbasic/scanner.h>
|
||||
#include <akbasic/verbs.h>
|
||||
|
||||
/* ------------------------------------------------------------------ pools -- */
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_new_variable(akbasic_Runtime *obj, akbasic_Variable **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int i = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in new_variable");
|
||||
for ( i = 0; i < AKBASIC_MAX_VARIABLES; i++ ) {
|
||||
if ( !obj->variables[i].used ) {
|
||||
memset(&obj->variables[i], 0, sizeof(obj->variables[i]));
|
||||
obj->variables[i].used = true;
|
||||
*dest = &obj->variables[i];
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
}
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS, "Maximum runtime variables reached");
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_new_function(akbasic_Runtime *obj, akbasic_FunctionDef **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int i = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in new_function");
|
||||
for ( i = 0; i < AKBASIC_MAX_FUNCTIONS; i++ ) {
|
||||
if ( !obj->functions[i].used ) {
|
||||
memset(&obj->functions[i], 0, sizeof(obj->functions[i]));
|
||||
obj->functions[i].used = true;
|
||||
obj->functions[i].leafpool.next = 0;
|
||||
obj->functions[i].leafpool.capacity = AKBASIC_MAX_LEAVES * 2;
|
||||
obj->functions[i].leafpool.leaves = obj->functions[i].leafstorage;
|
||||
*dest = &obj->functions[i];
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
}
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS, "Maximum function definitions reached");
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *env_acquire(akbasic_Runtime *obj, akbasic_Environment **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int i = 0;
|
||||
|
||||
for ( i = 0; i < AKBASIC_MAX_ENVIRONMENTS; i++ ) {
|
||||
if ( !obj->environments[i].used ) {
|
||||
obj->environments[i].used = true;
|
||||
*dest = &obj->environments[i];
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
}
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_ENVIRONMENT,
|
||||
"Environment pool exhausted at line %" PRId64 " (%d in use)",
|
||||
(obj->environment == NULL ? 0 : obj->environment->lineno),
|
||||
AKBASIC_MAX_ENVIRONMENTS);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_new_environment(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Environment *env = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in new_environment");
|
||||
PASS(errctx, env_acquire(obj, &env));
|
||||
PASS(errctx, akbasic_environment_init(env, obj, obj->environment));
|
||||
obj->environment = env;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_prev_environment(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Environment *popped = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in prev_environment");
|
||||
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
|
||||
"No previous environment to return to");
|
||||
popped = obj->environment;
|
||||
obj->environment = popped->parent;
|
||||
/*
|
||||
* Release it. The reference never does, which is a leak the GC papers over;
|
||||
* here the pool is finite, so an unreleased environment is a bug that shows
|
||||
* up as exhaustion a few thousand GOSUBs later.
|
||||
*/
|
||||
popped->used = false;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------- lifecycle -- */
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_zero(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in zero");
|
||||
PASS(errctx, akbasic_environment_zero(obj->environment));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_init(akbasic_Runtime *obj, akbasic_TextSink *sink)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in init");
|
||||
FAIL_ZERO_RETURN(errctx, (sink != NULL), AKERR_NULLPOINTER, "NULL text sink in init");
|
||||
|
||||
/*
|
||||
* Claim the status band before anything can raise one of our codes, or the
|
||||
* first error out of this function prints "Unknown Error". Idempotent, so a
|
||||
* host that already called it loses nothing.
|
||||
*/
|
||||
PASS(errctx, akbasic_error_register());
|
||||
|
||||
memset(obj, 0, sizeof(*obj));
|
||||
obj->sink = sink;
|
||||
obj->environment = NULL;
|
||||
obj->autoLineNumber = 0;
|
||||
obj->eval_clone_identifiers = true;
|
||||
obj->errclass = AKBASIC_ERRCLASS_NONE;
|
||||
obj->mode = AKBASIC_MODE_REPL;
|
||||
obj->run_finished_mode = AKBASIC_MODE_REPL;
|
||||
obj->inputEof = false;
|
||||
|
||||
PASS(errctx, akbasic_valuepool_init(&obj->valuepool));
|
||||
PASS(errctx, akbasic_value_zero(&obj->staticTrueValue));
|
||||
PASS(errctx, akbasic_value_zero(&obj->staticFalseValue));
|
||||
PASS(errctx, akbasic_value_set_bool(&obj->staticTrueValue, true));
|
||||
PASS(errctx, akbasic_value_set_bool(&obj->staticFalseValue, false));
|
||||
|
||||
PASS(errctx, akbasic_runtime_new_environment(obj));
|
||||
PASS(errctx, akbasic_runtime_zero(obj));
|
||||
PASS(errctx, akbasic_scanner_zero(obj));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* ---------------------------------------------------------------- output -- */
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_write(akbasic_Runtime *obj, const char *text)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && text != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in write");
|
||||
PASS(errctx, obj->sink->write(obj->sink, text));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_println(akbasic_Runtime *obj, const char *text)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && text != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in println");
|
||||
PASS(errctx, obj->sink->writeln(obj->sink, text));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static const char *errclass_to_string(akbasic_ErrorClass errclass)
|
||||
{
|
||||
switch ( errclass ) {
|
||||
case AKBASIC_ERRCLASS_IO: return "IO ERROR";
|
||||
case AKBASIC_ERRCLASS_PARSE: return "PARSE ERROR";
|
||||
case AKBASIC_ERRCLASS_RUNTIME: return "RUNTIME ERROR";
|
||||
case AKBASIC_ERRCLASS_SYNTAX: return "SYNTAX ERROR";
|
||||
default: return "UNDEF";
|
||||
}
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_error(akbasic_Runtime *obj, akbasic_ErrorClass errclass, const char *message)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char line[AKBASIC_MAX_LINE_LENGTH * 2];
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && message != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in runtime error");
|
||||
obj->errclass = errclass;
|
||||
/*
|
||||
* The format, the trailing \n inside the string, and the second newline
|
||||
* writeln adds are all part of the acceptance contract --
|
||||
* tests/language/array_outofbounds.txt ends in 0a 0a. See TODO.md 1.8.
|
||||
*/
|
||||
snprintf(line, sizeof(line), "? %" PRId64 " : %s %s\n",
|
||||
obj->environment->lineno, errclass_to_string(errclass), message);
|
||||
PASS(errctx, akbasic_runtime_println(obj, line));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_set_mode(akbasic_Runtime *obj, int mode)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in set_mode");
|
||||
obj->mode = mode;
|
||||
if ( obj->mode == AKBASIC_MODE_REPL ) {
|
||||
PASS(errctx, akbasic_runtime_println(obj, "READY"));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------ evaluation -- */
|
||||
|
||||
/*
|
||||
* Report a runtime error carrying an akerr message, then re-raise. Used where
|
||||
* the reference calls basicError() and returns the error: the BASIC-visible line
|
||||
* goes to the sink and the context keeps propagating.
|
||||
*/
|
||||
static akerr_ErrorContext *report_and_reraise(akbasic_Runtime *obj, akerr_ErrorContext *cause)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
||||
int status = cause->status;
|
||||
|
||||
snprintf(message, sizeof(message), "%s", cause->message);
|
||||
cause->handled = true;
|
||||
IGNORE(akerr_release_error(cause));
|
||||
PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_RUNTIME, message));
|
||||
FAIL_RETURN(errctx, status, "%s", message);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *evaluate_identifier(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *texpr = NULL;
|
||||
akbasic_Value *tval = NULL;
|
||||
akbasic_Value *slot = NULL;
|
||||
akbasic_Value *copy = NULL;
|
||||
akbasic_Variable *variable = NULL;
|
||||
int64_t subscripts[AKBASIC_MAX_ARRAY_DEPTH];
|
||||
int subscriptcount = 0;
|
||||
|
||||
/*
|
||||
* A .right hanging off an identifier is an array subscript only when it is
|
||||
* an ARRAY_SUBSCRIPT argument list; anything else belongs to the enclosing
|
||||
* expression and must not be followed.
|
||||
*/
|
||||
texpr = expr->right;
|
||||
if ( texpr != NULL &&
|
||||
texpr->leaftype == AKBASIC_LEAF_ARGUMENTLIST &&
|
||||
texpr->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT ) {
|
||||
for ( texpr = texpr->right; texpr != NULL; texpr = texpr->right ) {
|
||||
FAIL_ZERO_RETURN(errctx, (subscriptcount < AKBASIC_MAX_ARRAY_DEPTH),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"More than %d array subscripts", AKBASIC_MAX_ARRAY_DEPTH);
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, texpr, &tval));
|
||||
FAIL_NONZERO_RETURN(errctx, (tval->valuetype != AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE,
|
||||
"Array dimensions must evaluate to integer (C)");
|
||||
subscripts[subscriptcount] = tval->intval;
|
||||
subscriptcount += 1;
|
||||
}
|
||||
}
|
||||
if ( subscriptcount == 0 ) {
|
||||
subscripts[0] = 0;
|
||||
subscriptcount = 1;
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_environment_get(obj->environment, expr->identifier, &variable));
|
||||
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
|
||||
"Identifier %s is undefined", expr->identifier);
|
||||
PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &slot));
|
||||
|
||||
if ( !obj->eval_clone_identifiers ) {
|
||||
*dest = slot;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, ©));
|
||||
PASS(errctx, akbasic_value_clone(slot, copy));
|
||||
*dest = copy;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *evaluate_binary(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *lval = NULL;
|
||||
akbasic_Value *rval = NULL;
|
||||
akbasic_Value *scratch = NULL;
|
||||
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, &lval));
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &rval));
|
||||
|
||||
if ( expr->operator_ == AKBASIC_TOK_ASSIGNMENT ) {
|
||||
PASS(errctx, akbasic_environment_assign(obj->environment, expr->left, rval, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &scratch));
|
||||
switch ( expr->operator_ ) {
|
||||
case AKBASIC_TOK_MINUS:
|
||||
PASS(errctx, akbasic_value_math_minus(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_PLUS:
|
||||
PASS(errctx, akbasic_value_math_plus(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_LEFT_SLASH:
|
||||
PASS(errctx, akbasic_value_math_divide(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_STAR:
|
||||
PASS(errctx, akbasic_value_math_multiply(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_AND:
|
||||
PASS(errctx, akbasic_value_bitwise_and(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_OR:
|
||||
PASS(errctx, akbasic_value_bitwise_or(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_LESS_THAN:
|
||||
PASS(errctx, akbasic_value_less_than(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_LESS_THAN_EQUAL:
|
||||
PASS(errctx, akbasic_value_less_than_equal(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_EQUAL:
|
||||
PASS(errctx, akbasic_value_is_equal(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_NOT_EQUAL:
|
||||
PASS(errctx, akbasic_value_is_not_equal(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_GREATER_THAN:
|
||||
PASS(errctx, akbasic_value_greater_than(lval, rval, scratch, dest));
|
||||
break;
|
||||
case AKBASIC_TOK_GREATER_THAN_EQUAL:
|
||||
PASS(errctx, akbasic_value_greater_than_equal(lval, rval, scratch, dest));
|
||||
break;
|
||||
default:
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX,
|
||||
"Don't know how to perform binary operation %d", (int)expr->operator_);
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_evaluate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *lval = NULL;
|
||||
akbasic_Value *rval = NULL;
|
||||
akbasic_Value *scratch = NULL;
|
||||
const akbasic_Verb *verb = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in evaluate");
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NULL expression in evaluate");
|
||||
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &lval));
|
||||
PASS(errctx, akbasic_value_zero(lval));
|
||||
*dest = lval;
|
||||
|
||||
switch ( expr->leaftype ) {
|
||||
case AKBASIC_LEAF_GROUPING:
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->expr, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_BRANCH:
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_runtime_evaluate(obj, expr->expr, &rval));
|
||||
} CLEANUP {
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE_DEFAULT(errctx) {
|
||||
PASS(errctx, report_and_reraise(obj, errctx));
|
||||
} FINISH(errctx, true);
|
||||
if ( rval->boolvalue == AKBASIC_TRUE ) {
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
if ( expr->right != NULL ) {
|
||||
/* A false branch is optional for some branching operations. */
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_IDENTIFIER_INT:
|
||||
case AKBASIC_LEAF_IDENTIFIER_FLOAT:
|
||||
case AKBASIC_LEAF_IDENTIFIER_STRING:
|
||||
PASS(errctx, evaluate_identifier(obj, expr, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_IDENTIFIER:
|
||||
/* A bare identifier with no type suffix is a label. */
|
||||
lval->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
PASS(errctx, akbasic_environment_get_label(obj->environment, expr->identifier, &lval->intval));
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_LITERAL_INT:
|
||||
lval->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
lval->intval = expr->literal_int;
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_LITERAL_FLOAT:
|
||||
lval->valuetype = AKBASIC_TYPE_FLOAT;
|
||||
lval->floatval = expr->literal_float;
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_LITERAL_STRING:
|
||||
lval->valuetype = AKBASIC_TYPE_STRING;
|
||||
memcpy(lval->stringval, expr->literal_string, sizeof(lval->stringval));
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_UNARY:
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &rval));
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &scratch));
|
||||
if ( expr->operator_ == AKBASIC_TOK_MINUS ) {
|
||||
PASS(errctx, akbasic_value_invert(rval, scratch, dest));
|
||||
} else if ( expr->operator_ == AKBASIC_TOK_NOT ) {
|
||||
PASS(errctx, akbasic_value_bitwise_not(rval, scratch, dest));
|
||||
} else {
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX,
|
||||
"Don't know how to perform operation %d on unary type %d",
|
||||
(int)expr->operator_, (int)rval->valuetype);
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_FUNCTION:
|
||||
PASS(errctx, akbasic_verb_lookup(expr->identifier, &verb));
|
||||
if ( verb != NULL && verb->exec != NULL && verb->tokentype == AKBASIC_TOK_FUNCTION ) {
|
||||
PASS(errctx, verb->exec(obj, expr, lval, rval, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, akbasic_runtime_user_function(obj, expr, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_COMMAND_IMMEDIATE:
|
||||
case AKBASIC_LEAF_COMMAND:
|
||||
PASS(errctx, akbasic_verb_lookup(expr->identifier, &verb));
|
||||
FAIL_ZERO_RETURN(errctx, (verb != NULL && verb->exec != NULL), AKBASIC_ERR_UNDEFINED,
|
||||
"Unknown command %s", expr->identifier);
|
||||
PASS(errctx, verb->exec(obj, expr, lval, rval, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
case AKBASIC_LEAF_BINARY:
|
||||
PASS(errctx, evaluate_binary(obj, expr, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
|
||||
default:
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_interpret(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in interpret");
|
||||
/*
|
||||
* While an environment is skipping forward to a verb, nothing runs but that
|
||||
* verb. This is what keeps a zero-iteration FOR body from executing, given
|
||||
* that the loop condition is evaluated at the bottom of the structure.
|
||||
*/
|
||||
if ( akbasic_environment_is_waiting_for_any(obj->environment) ) {
|
||||
if ( expr->leaftype != AKBASIC_LEAF_COMMAND ||
|
||||
!akbasic_environment_is_waiting_for(obj->environment, expr->identifier) ) {
|
||||
*dest = &obj->staticTrueValue;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
}
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_runtime_evaluate(obj, expr, dest));
|
||||
} CLEANUP {
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE_DEFAULT(errctx) {
|
||||
PASS(errctx, report_and_reraise(obj, errctx));
|
||||
} FINISH(errctx, true);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_interpret_immediate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in interpret_immediate");
|
||||
*dest = NULL;
|
||||
if ( expr->leaftype != AKBASIC_LEAF_COMMAND_IMMEDIATE ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_FunctionDef *fndef = NULL;
|
||||
akbasic_Environment *targetenv = obj->environment;
|
||||
akbasic_ASTLeaf *leafptr = NULL;
|
||||
akbasic_ASTLeaf *argptr = NULL;
|
||||
akbasic_Value *argvalue = NULL;
|
||||
akbasic_Value *unused = NULL;
|
||||
void *fnptr = NULL;
|
||||
|
||||
PASS(errctx, akbasic_environment_get_function(obj->environment, expr->identifier, &fnptr));
|
||||
fndef = (akbasic_FunctionDef *)fnptr;
|
||||
|
||||
/*
|
||||
* The function's environment is owned by the funcdef, not by the pool free
|
||||
* list: it is reset on every call and outlives any single one. The reference
|
||||
* holds it by value inside BasicFunctionDef for the same reason.
|
||||
*/
|
||||
if ( fndef->environment == NULL ) {
|
||||
PASS(errctx, akbasic_runtime_new_environment(obj));
|
||||
fndef->environment = obj->environment;
|
||||
obj->environment = targetenv;
|
||||
}
|
||||
PASS(errctx, akbasic_environment_init(fndef->environment, obj, obj->environment));
|
||||
|
||||
/* Bind arguments into the function's scope before entering it. */
|
||||
leafptr = (expr->right != NULL ? expr->right->right : NULL);
|
||||
argptr = (fndef->arglist != NULL ? fndef->arglist->right : NULL);
|
||||
while ( leafptr != NULL && argptr != NULL ) {
|
||||
akbasic_Environment *callerenv = obj->environment;
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue));
|
||||
obj->environment = fndef->environment;
|
||||
PASS(errctx, akbasic_environment_assign(fndef->environment, argptr, argvalue, &unused));
|
||||
obj->environment = callerenv;
|
||||
leafptr = leafptr->right;
|
||||
argptr = argptr->right;
|
||||
}
|
||||
|
||||
obj->environment = fndef->environment;
|
||||
|
||||
if ( fndef->expression != NULL ) {
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, fndef->expression, dest));
|
||||
obj->environment = obj->environment->parent;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* A multi-line subroutine. Hand control to its environment and let the
|
||||
* caller's step loop run it until RETURN pops back out. The result is the
|
||||
* value RETURN parked in the child environment.
|
||||
*/
|
||||
obj->environment->gosubReturnLine = obj->environment->lineno + 1;
|
||||
obj->environment->nextline = fndef->lineno;
|
||||
while ( obj->environment != targetenv && obj->mode == AKBASIC_MODE_RUN ) {
|
||||
PASS(errctx, akbasic_runtime_process_line_run(obj));
|
||||
}
|
||||
*dest = &fndef->environment->returnValue;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------ line cycle -- */
|
||||
|
||||
int64_t akbasic_runtime_find_previous_lineno(akbasic_Runtime *obj)
|
||||
{
|
||||
int64_t i = 0;
|
||||
|
||||
for ( i = obj->environment->lineno - 1; i > 0; i-- ) {
|
||||
if ( obj->source[i].code[0] != '\0' ) {
|
||||
return i;
|
||||
}
|
||||
}
|
||||
return obj->environment->lineno;
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_store_line(akbasic_Runtime *obj, int64_t lineno, const char *code)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (lineno >= 0 && lineno < AKBASIC_MAX_SOURCE_LINES),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Line number %" PRId64 " is outside 0..%d",
|
||||
lineno, AKBASIC_MAX_SOURCE_LINES - 1);
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(code) < AKBASIC_MAX_LINE_LENGTH), AKBASIC_ERR_BOUNDS,
|
||||
"Source line exceeds the %d character limit", AKBASIC_MAX_LINE_LENGTH - 1);
|
||||
strncpy(obj->source[lineno].code, code, AKBASIC_MAX_LINE_LENGTH - 1);
|
||||
obj->source[lineno].code[AKBASIC_MAX_LINE_LENGTH - 1] = '\0';
|
||||
obj->source[lineno].lineno = lineno;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_process_line_runstream(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char buffer[AKBASIC_MAX_LINE_LENGTH];
|
||||
char scanned[AKBASIC_MAX_LINE_LENGTH];
|
||||
bool eof = false;
|
||||
|
||||
PASS(errctx, obj->sink->readline(obj->sink, buffer, sizeof(buffer), &eof));
|
||||
if ( eof ) {
|
||||
obj->environment->nextline = 0;
|
||||
PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_RUN));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* All this mode does is pick the line number off the front and file the
|
||||
* source line under it. DLOAD reaches this from REPL mode, where the line
|
||||
* numbers must be stripped the same way the REPL strips them.
|
||||
*/
|
||||
PASS(errctx, akbasic_scanner_scan(obj, buffer, scanned, sizeof(scanned)));
|
||||
if ( obj->mode == AKBASIC_MODE_REPL ) {
|
||||
PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
|
||||
} else {
|
||||
PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, buffer));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_process_line_repl(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char prompt[32];
|
||||
char scanned[AKBASIC_MAX_LINE_LENGTH];
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
akbasic_Value *value = NULL;
|
||||
akbasic_Parser parser;
|
||||
bool eof = false;
|
||||
|
||||
if ( obj->autoLineNumber > 0 ) {
|
||||
snprintf(prompt, sizeof(prompt), "%" PRId64 " ",
|
||||
obj->environment->lineno + obj->autoLineNumber);
|
||||
PASS(errctx, akbasic_runtime_write(obj, prompt));
|
||||
}
|
||||
|
||||
PASS(errctx, obj->sink->readline(obj->sink, obj->userline, sizeof(obj->userline), &eof));
|
||||
if ( eof ) {
|
||||
obj->inputEof = true;
|
||||
PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_QUIT));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
if ( obj->userline[0] == '\0' ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
obj->environment->lineno += obj->autoLineNumber;
|
||||
PASS(errctx, akbasic_scanner_scan(obj, obj->userline, scanned, sizeof(scanned)));
|
||||
PASS(errctx, akbasic_parser_init(&parser, obj));
|
||||
|
||||
while ( !akbasic_parser_is_at_end(&parser) ) {
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_parser_parse(&parser, &leaf));
|
||||
} CLEANUP {
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE_DEFAULT(errctx) {
|
||||
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
||||
snprintf(message, sizeof(message), "%s", errctx->message);
|
||||
IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
|
||||
} FINISH(errctx, false);
|
||||
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_runtime_interpret_immediate(obj, leaf, &value));
|
||||
if ( value == NULL ) {
|
||||
/* Not an immediate command, so it is program text: file it. */
|
||||
PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
|
||||
} else if ( obj->autoLineNumber > 0 ) {
|
||||
obj->environment->lineno = akbasic_runtime_find_previous_lineno(obj);
|
||||
}
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_process_line_run(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char line[AKBASIC_MAX_LINE_LENGTH];
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
akbasic_Value *value = NULL;
|
||||
akbasic_Parser parser;
|
||||
|
||||
if ( obj->environment->nextline >= AKBASIC_MAX_SOURCE_LINES ) {
|
||||
PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
strncpy(line, obj->source[obj->environment->nextline].code, sizeof(line) - 1);
|
||||
line[sizeof(line) - 1] = '\0';
|
||||
obj->environment->lineno = obj->environment->nextline;
|
||||
obj->environment->nextline += 1;
|
||||
if ( line[0] == '\0' ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_scanner_scan(obj, line, NULL, 0));
|
||||
PASS(errctx, akbasic_parser_init(&parser, obj));
|
||||
|
||||
while ( !akbasic_parser_is_at_end(&parser) ) {
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_parser_parse(&parser, &leaf));
|
||||
} CLEANUP {
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE_DEFAULT(errctx) {
|
||||
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
||||
snprintf(message, sizeof(message), "%s", errctx->message);
|
||||
IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
|
||||
IGNORE(akbasic_runtime_set_mode(obj, obj->run_finished_mode));
|
||||
} FINISH(errctx, false);
|
||||
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* The reference discards both results here. An error has already been
|
||||
* reported to the sink by interpret(); swallowing the context keeps a
|
||||
* BASIC-level error from tearing down the host, which is the whole point
|
||||
* of goal 3.
|
||||
*/
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_runtime_interpret(obj, leaf, &value));
|
||||
} CLEANUP {
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE_DEFAULT(errctx) {
|
||||
} FINISH(errctx, false);
|
||||
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------- step loop -- */
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_start(akbasic_Runtime *obj, int mode)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in start");
|
||||
obj->run_finished_mode = (mode == AKBASIC_MODE_REPL ? AKBASIC_MODE_REPL : AKBASIC_MODE_QUIT);
|
||||
PASS(errctx, akbasic_runtime_set_mode(obj, mode));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_step(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in step");
|
||||
|
||||
if ( obj->mode == AKBASIC_MODE_QUIT ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_runtime_zero(obj));
|
||||
PASS(errctx, akbasic_scanner_zero(obj));
|
||||
|
||||
switch ( obj->mode ) {
|
||||
case AKBASIC_MODE_RUNSTREAM:
|
||||
PASS(errctx, akbasic_runtime_process_line_runstream(obj));
|
||||
break;
|
||||
case AKBASIC_MODE_REPL:
|
||||
PASS(errctx, akbasic_runtime_process_line_repl(obj));
|
||||
break;
|
||||
case AKBASIC_MODE_RUN:
|
||||
PASS(errctx, akbasic_runtime_process_line_run(obj));
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
|
||||
/*
|
||||
* The reference never clears runtime.errno, so the first BASIC-level error
|
||||
* ends the program: in a file run, run_finished_mode is QUIT. Reproduced
|
||||
* deliberately -- tests/language/array_outofbounds.txt depends on exactly one
|
||||
* error line being printed and nothing after it.
|
||||
*/
|
||||
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
||||
PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_runtime_run(akbasic_Runtime *obj, int maxsteps)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int steps = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in run");
|
||||
while ( obj->mode != AKBASIC_MODE_QUIT ) {
|
||||
PASS(errctx, akbasic_runtime_step(obj));
|
||||
steps += 1;
|
||||
if ( maxsteps > 0 && steps >= maxsteps ) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
789
src/runtime_commands.c
Normal file
789
src/runtime_commands.c
Normal file
@@ -0,0 +1,789 @@
|
||||
/**
|
||||
* @file runtime_commands.c
|
||||
* @brief The verb implementations.
|
||||
*
|
||||
* Ported from basicruntime_commands.go. Every handler has the signature the
|
||||
* dispatch table demands, and every one returns its result through `dest`.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
#include <akstdlib.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/runtime.h>
|
||||
#include <akbasic/convert.h>
|
||||
#include <akbasic/scanner.h>
|
||||
|
||||
#include "verbs.h"
|
||||
|
||||
/* Most verbs answer "did something happen"; this is that answer. */
|
||||
#define SUCCEED_TRUE(__obj, __dest) \
|
||||
do { \
|
||||
*(__dest) = &(__obj)->staticTrueValue; \
|
||||
} while ( 0 )
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_let(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
(void)expr; (void)lval; (void)rval;
|
||||
/*
|
||||
* LET is not required in this dialect or in Commodore BASIC 7.0. Assignment
|
||||
* is part of expression evaluation, so there is nothing for LET to do.
|
||||
*/
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_def(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
(void)expr; (void)lval; (void)rval;
|
||||
/* The parse handler already installed the function. */
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_print(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char rendered[AKBASIC_MAX_STRING_LENGTH];
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf");
|
||||
if ( expr->right == NULL ) {
|
||||
PASS(errctx, akbasic_runtime_println(obj, ""));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest));
|
||||
PASS(errctx, akbasic_value_to_string(*dest, rendered, sizeof(rendered)));
|
||||
PASS(errctx, akbasic_runtime_println(obj, rendered));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_goto(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *target = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
|
||||
"Expected GOTO (line number or label)");
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target));
|
||||
FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Expected integer");
|
||||
obj->environment->nextline = target->intval;
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_gosub(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *target = NULL;
|
||||
int64_t returnline = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
|
||||
"Expected GOSUB (line number or label)");
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target));
|
||||
FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Expected integer");
|
||||
returnline = obj->environment->lineno + 1;
|
||||
PASS(errctx, akbasic_runtime_new_environment(obj));
|
||||
obj->environment->gosubReturnLine = returnline;
|
||||
obj->environment->nextline = target->intval;
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_return(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *result = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
/*
|
||||
* A RETURN reached while skipping forward to one is the end of a DEF body,
|
||||
* not a subroutine return. Stop waiting and carry on.
|
||||
*/
|
||||
if ( akbasic_environment_is_waiting_for(obj->environment, "RETURN") ) {
|
||||
PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "RETURN"));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
FAIL_ZERO_RETURN(errctx, (obj->environment->gosubReturnLine != 0), AKBASIC_ERR_STATE,
|
||||
"RETURN outside the context of GOSUB");
|
||||
|
||||
if ( expr != NULL && expr->right != NULL ) {
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &result));
|
||||
} else {
|
||||
result = &obj->staticTrueValue;
|
||||
}
|
||||
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
|
||||
"RETURN from an orphaned environment");
|
||||
obj->environment->parent->nextline = obj->environment->gosubReturnLine;
|
||||
PASS(errctx, akbasic_value_clone(result, &obj->environment->returnValue));
|
||||
PASS(errctx, akbasic_runtime_prev_environment(obj));
|
||||
*dest = result;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_stop(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
(void)expr; (void)lval; (void)rval;
|
||||
PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_REPL));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_quit(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
(void)expr; (void)lval; (void)rval;
|
||||
/*
|
||||
* Sets a mode and returns. Nothing in this library calls exit() -- the
|
||||
* driver's main() decides what quitting means, and an embedding game may
|
||||
* decide it means something else entirely.
|
||||
*/
|
||||
PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_QUIT));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_run(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *target = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
obj->environment->nextline = 0;
|
||||
if ( expr != NULL && expr->right != NULL ) {
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target));
|
||||
FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Expected RUN (line number)");
|
||||
obj->environment->nextline = target->intval;
|
||||
}
|
||||
PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_RUN));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_label(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
|
||||
"Expected LABEL IDENTIFIER");
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(expr->right), AKBASIC_ERR_SYNTAX,
|
||||
"Expected identifier");
|
||||
PASS(errctx, akbasic_environment_set_label(obj->environment, expr->right->identifier,
|
||||
obj->environment->lineno));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_auto(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *step = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
if ( expr == NULL || expr->right == NULL ) {
|
||||
obj->autoLineNumber = 0;
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &step));
|
||||
FAIL_NONZERO_RETURN(errctx, (step->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Expected AUTO (integer)");
|
||||
obj->autoLineNumber = step->intval;
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_dim(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Variable *variable = NULL;
|
||||
akbasic_ASTLeaf *walk = NULL;
|
||||
akbasic_Value *size = NULL;
|
||||
int64_t sizes[AKBASIC_MAX_ARRAY_DEPTH];
|
||||
int sizecount = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(expr != NULL && expr->right != NULL && expr->right->right != NULL &&
|
||||
expr->right->right->leaftype == AKBASIC_LEAF_ARGUMENTLIST &&
|
||||
expr->right->right->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT &&
|
||||
akbasic_leaf_is_identifier(expr->right)),
|
||||
AKBASIC_ERR_SYNTAX, "Expected DIM IDENTIFIER(DIMENSIONS, ...)");
|
||||
|
||||
PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &variable));
|
||||
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
|
||||
"Unable to get variable for identifier %s", expr->right->identifier);
|
||||
|
||||
for ( walk = expr->right->right->right; walk != NULL; walk = walk->right ) {
|
||||
FAIL_ZERO_RETURN(errctx, (sizecount < AKBASIC_MAX_ARRAY_DEPTH), AKBASIC_ERR_BOUNDS,
|
||||
"More than %d array dimensions", AKBASIC_MAX_ARRAY_DEPTH);
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, walk, &size));
|
||||
FAIL_NONZERO_RETURN(errctx, (size->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Array dimensions must evaluate to integer");
|
||||
sizes[sizecount] = size->intval;
|
||||
sizecount += 1;
|
||||
}
|
||||
PASS(errctx, akbasic_variable_init(variable, &obj->valuepool, sizes, sizecount));
|
||||
PASS(errctx, akbasic_variable_zero(variable));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* POKE and PEEK write and read a single byte at a caller-supplied address.
|
||||
*
|
||||
* The pointer.bas golden case sets A# = 255 and expects PEEK(POINTER(A#)) to be
|
||||
* 255, which holds only on a little-endian machine: A# is an int64_t and the
|
||||
* low byte has to come first. Stated here rather than discovered later.
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_cmd_poke(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *arg = NULL;
|
||||
akbasic_Value *addrval = NULL;
|
||||
akbasic_Value *byteval = NULL;
|
||||
uint8_t *target = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf");
|
||||
arg = akbasic_leaf_first_argument(expr);
|
||||
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "POKE expected INTEGER, INTEGER");
|
||||
|
||||
/* The address must be the live value, not a copy of it. */
|
||||
obj->eval_clone_identifiers = false;
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_runtime_evaluate(obj, arg, &addrval));
|
||||
} CLEANUP {
|
||||
obj->eval_clone_identifiers = true;
|
||||
} PROCESS(errctx) {
|
||||
} FINISH(errctx, true);
|
||||
|
||||
FAIL_NONZERO_RETURN(errctx, (addrval->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"POKE expected INTEGER, INTEGER");
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(arg->right != NULL &&
|
||||
(arg->right->leaftype == AKBASIC_LEAF_LITERAL_INT ||
|
||||
arg->right->leaftype == AKBASIC_LEAF_IDENTIFIER_INT)),
|
||||
AKBASIC_ERR_SYNTAX, "POKE expected INTEGER, INTEGER");
|
||||
FAIL_ZERO_RETURN(errctx, (addrval->intval != 0), AKBASIC_ERR_VALUE,
|
||||
"POKE got NIL pointer or uninitialized variable");
|
||||
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, arg->right, &byteval));
|
||||
target = (uint8_t *)(uintptr_t)addrval->intval;
|
||||
*target = (uint8_t)byteval->intval;
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_input(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *identifier = NULL;
|
||||
akbasic_Value *prompt = NULL;
|
||||
akbasic_Value *entered = NULL;
|
||||
akbasic_Value *unused = NULL;
|
||||
char rendered[AKBASIC_MAX_STRING_LENGTH];
|
||||
char buffer[AKBASIC_MAX_LINE_LENGTH];
|
||||
bool eof = false;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
|
||||
"Expected INPUT \"PROMPT\" IDENTIFIER");
|
||||
identifier = expr->right;
|
||||
|
||||
if ( identifier->left != NULL ) {
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, identifier->left, &prompt));
|
||||
PASS(errctx, akbasic_value_to_string(prompt, rendered, sizeof(rendered)));
|
||||
PASS(errctx, akbasic_runtime_write(obj, rendered));
|
||||
}
|
||||
|
||||
PASS(errctx, obj->sink->readline(obj->sink, buffer, sizeof(buffer), &eof));
|
||||
if ( eof ) {
|
||||
obj->inputEof = true;
|
||||
buffer[0] = '\0';
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &entered));
|
||||
PASS(errctx, akbasic_value_zero(entered));
|
||||
|
||||
switch ( identifier->leaftype ) {
|
||||
case AKBASIC_LEAF_IDENTIFIER_INT:
|
||||
entered->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
PASS(errctx, akbasic_str_to_int64(buffer, 10, &entered->intval));
|
||||
break;
|
||||
case AKBASIC_LEAF_IDENTIFIER_FLOAT:
|
||||
entered->valuetype = AKBASIC_TYPE_FLOAT;
|
||||
PASS(errctx, akbasic_str_to_double(buffer, &entered->floatval));
|
||||
break;
|
||||
default:
|
||||
entered->valuetype = AKBASIC_TYPE_STRING;
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(buffer) < AKBASIC_MAX_STRING_LENGTH), AKBASIC_ERR_VALUE,
|
||||
"Input line exceeds the %d character limit", AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
strncpy(entered->stringval, buffer, AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
entered->stringval[AKBASIC_MAX_STRING_LENGTH - 1] = '\0';
|
||||
break;
|
||||
}
|
||||
PASS(errctx, akbasic_environment_assign(obj->environment, identifier, entered, &unused));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* LIST and DELETE share the range grammar: bare, n, -n, or n-n. */
|
||||
static akerr_ErrorContext *parse_line_range(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, int64_t *startidx, int64_t *endidx)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *value = NULL;
|
||||
|
||||
*startidx = 0;
|
||||
*endidx = AKBASIC_MAX_SOURCE_LINES - 1;
|
||||
if ( expr == NULL || expr->right == NULL ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
if ( expr->right->leaftype == AKBASIC_LEAF_BINARY &&
|
||||
expr->right->operator_ == AKBASIC_TOK_MINUS ) {
|
||||
/* n-n: a subtraction leaf is how the expression parser sees a range. */
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->left, &value));
|
||||
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Expected a line number range");
|
||||
*startidx = value->intval;
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->right, &value));
|
||||
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Expected a line number range");
|
||||
*endidx = value->intval;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
if ( expr->right->leaftype == AKBASIC_LEAF_UNARY &&
|
||||
expr->right->operator_ == AKBASIC_TOK_MINUS ) {
|
||||
/* -n: from the start through n. */
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->right, &value));
|
||||
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Expected a line number range");
|
||||
*endidx = value->intval;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
/* n: from n to the end. */
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &value));
|
||||
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"Expected a line number range");
|
||||
*startidx = value->intval;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_list(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char line[AKBASIC_MAX_LINE_LENGTH * 2];
|
||||
int64_t startidx = 0;
|
||||
int64_t endidx = 0;
|
||||
int64_t i = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, parse_line_range(obj, expr, &startidx, &endidx));
|
||||
if ( startidx < 0 ) {
|
||||
startidx = 0;
|
||||
}
|
||||
if ( endidx >= AKBASIC_MAX_SOURCE_LINES ) {
|
||||
endidx = AKBASIC_MAX_SOURCE_LINES - 1;
|
||||
}
|
||||
for ( i = startidx; i <= endidx; i++ ) {
|
||||
if ( obj->source[i].code[0] == '\0' ) {
|
||||
continue;
|
||||
}
|
||||
snprintf(line, sizeof(line), "%" PRId64 " %s", i, obj->source[i].code);
|
||||
PASS(errctx, akbasic_runtime_println(obj, line));
|
||||
}
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_delete(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int64_t startidx = 0;
|
||||
int64_t endidx = 0;
|
||||
int64_t i = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, parse_line_range(obj, expr, &startidx, &endidx));
|
||||
if ( startidx < 0 ) {
|
||||
startidx = 0;
|
||||
}
|
||||
if ( endidx >= AKBASIC_MAX_SOURCE_LINES ) {
|
||||
endidx = AKBASIC_MAX_SOURCE_LINES - 1;
|
||||
}
|
||||
for ( i = startidx; i <= endidx; i++ ) {
|
||||
obj->source[i].code[0] = '\0';
|
||||
obj->source[i].lineno = 0;
|
||||
}
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* Resolve a DLOAD/DSAVE filename argument to a string. */
|
||||
static akerr_ErrorContext *filename_argument(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, char *dest, size_t len)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *value = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKBASIC_ERR_SYNTAX,
|
||||
"Expected a filename");
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &value));
|
||||
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
|
||||
"Expected a filename string");
|
||||
FAIL_ZERO_RETURN(errctx, (value->stringval[0] != '\0'), AKBASIC_ERR_VALUE,
|
||||
"Filename must not be empty");
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(value->stringval) < len), AKBASIC_ERR_BOUNDS,
|
||||
"Filename exceeds the %zu character limit", len - 1);
|
||||
strncpy(dest, value->stringval, len - 1);
|
||||
dest[len - 1] = '\0';
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_dload(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char filename[AKBASIC_MAX_STRING_LENGTH];
|
||||
char buffer[AKBASIC_MAX_LINE_LENGTH];
|
||||
char scanned[AKBASIC_MAX_LINE_LENGTH];
|
||||
FILE *fp = NULL;
|
||||
size_t used = 0;
|
||||
int64_t i = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
/*
|
||||
* aksl_fopen does not NULL-check pathname or mode and fopen(NULL, ...) is
|
||||
* undefined, so the name is validated here before it is handed over --
|
||||
* deps/libakstdlib/TODO.md 2.2.2.
|
||||
*/
|
||||
PASS(errctx, filename_argument(obj, expr, filename, sizeof(filename)));
|
||||
|
||||
/* DLOAD replaces the program in memory, so clear it before reading. */
|
||||
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
|
||||
obj->source[i].code[0] = '\0';
|
||||
obj->source[i].lineno = 0;
|
||||
}
|
||||
obj->environment->lineno = 0;
|
||||
obj->environment->nextline = 0;
|
||||
|
||||
ATTEMPT {
|
||||
CATCH(errctx, aksl_fopen(filename, "r", &fp));
|
||||
while ( fgets(buffer, sizeof(buffer), fp) != NULL ) {
|
||||
used = strlen(buffer);
|
||||
while ( used > 0 && (buffer[used - 1] == '\n' || buffer[used - 1] == '\r') ) {
|
||||
buffer[used - 1] = '\0';
|
||||
used -= 1;
|
||||
}
|
||||
if ( buffer[0] == '\0' ) {
|
||||
continue;
|
||||
}
|
||||
/*
|
||||
* PASS inside the loop, never CATCH: CATCH expands to a break, which
|
||||
* would leave this loop rather than the ATTEMPT and let the rest of
|
||||
* the block run with an error pending.
|
||||
*/
|
||||
PASS(errctx, akbasic_scanner_scan(obj, buffer, scanned, sizeof(scanned)));
|
||||
PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
|
||||
}
|
||||
} CLEANUP {
|
||||
if ( fp != NULL ) {
|
||||
IGNORE(aksl_fclose(fp));
|
||||
}
|
||||
} PROCESS(errctx) {
|
||||
} FINISH(errctx, true);
|
||||
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_dsave(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char filename[AKBASIC_MAX_STRING_LENGTH];
|
||||
char line[AKBASIC_MAX_LINE_LENGTH * 2];
|
||||
FILE *fp = NULL;
|
||||
int64_t i = 0;
|
||||
int count = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, filename_argument(obj, expr, filename, sizeof(filename)));
|
||||
|
||||
ATTEMPT {
|
||||
CATCH(errctx, aksl_fopen(filename, "w", &fp));
|
||||
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
|
||||
if ( obj->source[i].code[0] == '\0' ) {
|
||||
continue;
|
||||
}
|
||||
snprintf(line, sizeof(line), "%" PRId64 " %s\n", i, obj->source[i].code);
|
||||
PASS(errctx, aksl_fwrite(line, 1, strlen(line), fp));
|
||||
count += 1;
|
||||
}
|
||||
} CLEANUP {
|
||||
if ( fp != NULL ) {
|
||||
IGNORE(aksl_fclose(fp));
|
||||
}
|
||||
} PROCESS(errctx) {
|
||||
} FINISH(errctx, true);
|
||||
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_if(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
(void)obj; (void)expr; (void)lval; (void)rval; (void)dest;
|
||||
/*
|
||||
* Unreachable in practice: the IF parse handler produces a BRANCH leaf, and
|
||||
* evaluate() handles BRANCH directly. It exists so the table has an exec
|
||||
* handler for IF and a stray IF leaf produces a diagnosis rather than
|
||||
* "Unknown command".
|
||||
*/
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_STATE, "Malformed IF statement");
|
||||
}
|
||||
|
||||
/*
|
||||
* The loop condition, evaluated at the bottom of the structure. A negative step
|
||||
* means the loop runs while the counter is at or above the TO value; a positive
|
||||
* one, at or below. True means the loop is finished.
|
||||
*/
|
||||
static akerr_ErrorContext *evaluate_for_condition(akbasic_Runtime *obj, akbasic_Value *counter, bool *met)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value zero;
|
||||
akbasic_Value scratch;
|
||||
akbasic_Value *truth = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (counter != NULL), AKERR_NULLPOINTER, "NIL pointer for rval");
|
||||
PASS(errctx, akbasic_value_zero(&zero));
|
||||
zero.valuetype = AKBASIC_TYPE_INTEGER;
|
||||
zero.intval = 0;
|
||||
|
||||
PASS(errctx, akbasic_value_less_than(&obj->environment->forStepValue, &zero, &scratch, &truth));
|
||||
if ( akbasic_value_is_true(truth) ) {
|
||||
PASS(errctx, akbasic_value_greater_than_equal(&obj->environment->forToValue, counter,
|
||||
&scratch, &truth));
|
||||
} else {
|
||||
PASS(errctx, akbasic_value_less_than_equal(&obj->environment->forToValue, counter,
|
||||
&scratch, &truth));
|
||||
}
|
||||
*met = akbasic_value_is_true(truth);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_for(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *assignval = NULL;
|
||||
akbasic_Value *tmp = NULL;
|
||||
akbasic_Value *counter = NULL;
|
||||
int64_t zerosubscript[1] = { 0 };
|
||||
bool met = false;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (obj->environment->forToLeaf != NULL && expr != NULL && expr->right != NULL),
|
||||
AKBASIC_ERR_STATE, "Expected FOR ... TO [STEP ...]");
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(expr->right->left != NULL &&
|
||||
(expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
|
||||
expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT ||
|
||||
expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING)),
|
||||
AKBASIC_ERR_SYNTAX, "Expected variable in FOR loop");
|
||||
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &assignval));
|
||||
PASS(errctx, akbasic_environment_get(obj->environment, expr->right->left->identifier,
|
||||
&obj->environment->forNextVariable));
|
||||
FAIL_ZERO_RETURN(errctx, (obj->environment->forNextVariable != NULL), AKBASIC_ERR_UNDEFINED,
|
||||
"Unable to get loop variable %s", expr->right->left->identifier);
|
||||
PASS(errctx, akbasic_variable_set_subscript(obj->environment->forNextVariable, assignval,
|
||||
zerosubscript, 1));
|
||||
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, obj->environment->forToLeaf, &tmp));
|
||||
PASS(errctx, akbasic_value_clone(tmp, &obj->environment->forToValue));
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, obj->environment->forStepLeaf, &tmp));
|
||||
PASS(errctx, akbasic_value_clone(tmp, &obj->environment->forStepValue));
|
||||
obj->environment->forToLeaf = NULL;
|
||||
obj->environment->forStepLeaf = NULL;
|
||||
|
||||
PASS(errctx, akbasic_variable_get_subscript(obj->environment->forNextVariable,
|
||||
zerosubscript, 1, &counter));
|
||||
PASS(errctx, evaluate_for_condition(obj, counter, &met));
|
||||
if ( met ) {
|
||||
/* Zero iterations: skip the body entirely by waiting for the NEXT. */
|
||||
PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "NEXT"));
|
||||
}
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_next(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Variable *nextvar = NULL;
|
||||
akbasic_Value *counter = NULL;
|
||||
akbasic_Value *updated = NULL;
|
||||
akbasic_Value scratch;
|
||||
int64_t zerosubscript[1] = { 0 };
|
||||
bool met = false;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (obj->environment->forNextVariable != NULL), AKBASIC_ERR_STATE,
|
||||
"NEXT outside the context of FOR");
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKBASIC_ERR_SYNTAX,
|
||||
"Expected NEXT IDENTIFIER");
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(expr->right->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
|
||||
expr->right->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT),
|
||||
AKBASIC_ERR_TYPE, "FOR ... NEXT only valid over INT and FLOAT types");
|
||||
|
||||
obj->environment->loopExitLine = obj->environment->lineno + 1;
|
||||
|
||||
/*
|
||||
* A NEXT for someone else's loop variable: this environment is done, hand
|
||||
* the line back to the parent and pop. That is how nested loops unwind.
|
||||
*/
|
||||
if ( strcmp(expr->right->identifier, obj->environment->forNextVariable->name) != 0 ) {
|
||||
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
|
||||
"NEXT in an orphaned environment");
|
||||
obj->environment->parent->nextline = obj->environment->nextline;
|
||||
PASS(errctx, akbasic_runtime_prev_environment(obj));
|
||||
*dest = &obj->staticFalseValue;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &nextvar));
|
||||
FAIL_ZERO_RETURN(errctx, (nextvar != NULL), AKBASIC_ERR_UNDEFINED,
|
||||
"Unable to get loop variable %s", expr->right->identifier);
|
||||
PASS(errctx, akbasic_variable_get_subscript(nextvar, zerosubscript, 1, &counter));
|
||||
PASS(errctx, evaluate_for_condition(obj, counter, &met));
|
||||
PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "NEXT"));
|
||||
|
||||
if ( met ) {
|
||||
if ( obj->environment->parent != NULL ) {
|
||||
obj->environment->parent->nextline = obj->environment->nextline;
|
||||
PASS(errctx, akbasic_runtime_prev_environment(obj));
|
||||
}
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* Advance the counter. The stored value is mutable, so math_plus updates it
|
||||
* in place -- see TODO.md section 12 item 4. Changing that without changing
|
||||
* this breaks every FOR loop.
|
||||
*/
|
||||
PASS(errctx, akbasic_value_math_plus(counter, &obj->environment->forStepValue,
|
||||
&scratch, &updated));
|
||||
obj->environment->nextline = obj->environment->loopFirstLine;
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_exit(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
(void)expr; (void)lval; (void)rval;
|
||||
FAIL_NONZERO_RETURN(errctx,
|
||||
(obj->environment->forToValue.valuetype == AKBASIC_TYPE_UNDEFINED),
|
||||
AKBASIC_ERR_STATE, "EXIT outside the context of FOR");
|
||||
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
|
||||
"EXIT in an orphaned environment");
|
||||
obj->environment->parent->nextline = obj->environment->loopExitLine;
|
||||
/*
|
||||
* The reference pops without clearing the wait, which leaves the parent
|
||||
* waiting for a NEXT that will never arrive (TODO.md section 12 item 8). The
|
||||
* wait is cleared here first: leaving it set would hang the interpreter
|
||||
* rather than merely misbehave, and no golden case depends on the hang.
|
||||
*/
|
||||
PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "NEXT"));
|
||||
PASS(errctx, akbasic_runtime_prev_environment(obj));
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_read(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
(void)expr; (void)lval; (void)rval;
|
||||
/*
|
||||
* READ does not read: it declares that the next DATA line should fill these
|
||||
* identifiers, and skips forward until one appears.
|
||||
*/
|
||||
PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "DATA"));
|
||||
obj->environment->readIdentifierIdx = 0;
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_cmd_data(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Environment *env = obj->environment;
|
||||
akbasic_ASTLeaf *literal = NULL;
|
||||
akbasic_ASTLeaf *identifier = NULL;
|
||||
akbasic_ASTLeaf assign;
|
||||
akbasic_Value *unused = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
|
||||
"NIL expression or argument list");
|
||||
|
||||
for ( literal = expr->right->right; literal != NULL; literal = literal->right ) {
|
||||
if ( env->readIdentifierIdx >= AKBASIC_MAX_LEAVES ) {
|
||||
break;
|
||||
}
|
||||
identifier = env->readIdentifierLeaves[env->readIdentifierIdx];
|
||||
if ( identifier == NULL ) {
|
||||
break;
|
||||
}
|
||||
/*
|
||||
* Build the assignment by hand rather than through the parser: the
|
||||
* identifier leaf is a stored copy and the literal belongs to this
|
||||
* line's pool, so there is no source text to re-parse.
|
||||
*/
|
||||
PASS(errctx, akbasic_leaf_init(&assign, AKBASIC_LEAF_BINARY));
|
||||
assign.left = identifier;
|
||||
assign.right = literal;
|
||||
assign.operator_ = AKBASIC_TOK_ASSIGNMENT;
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, &assign, &unused));
|
||||
env->readIdentifierIdx += 1;
|
||||
}
|
||||
|
||||
if ( literal == NULL &&
|
||||
env->readIdentifierIdx < AKBASIC_MAX_LEAVES &&
|
||||
env->readIdentifierLeaves[env->readIdentifierIdx] != NULL ) {
|
||||
/* Out of DATA with READ items outstanding: stay in waiting mode. */
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_environment_stop_waiting(env, "DATA"));
|
||||
env->lineno = env->readReturnLine;
|
||||
env->readIdentifierIdx = 0;
|
||||
SUCCEED_TRUE(obj, dest);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
644
src/runtime_functions.c
Normal file
644
src/runtime_functions.c
Normal file
@@ -0,0 +1,644 @@
|
||||
/**
|
||||
* @file runtime_functions.c
|
||||
* @brief The built-in function implementations.
|
||||
*
|
||||
* Ported from basicruntime_functions.go. The reference bootstraps its function
|
||||
* table by running a BASIC program of DEF statements through the interpreter at
|
||||
* startup and then nulling out the expressions so the native handlers take over
|
||||
* -- except MOD, SPC and STR, which stay as BASIC expressions. None of that is
|
||||
* reproduced: the signatures are data in the dispatch table and all three of
|
||||
* those are ordinary native handlers here, which removes the need to run the
|
||||
* interpreter before the interpreter is ready.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <math.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/convert.h>
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/runtime.h>
|
||||
|
||||
#include "verbs.h"
|
||||
|
||||
/*
|
||||
* Every builtin starts the same way: find the argument list, evaluate the first
|
||||
* argument, and hand back a fresh value to write the answer into. Arity is
|
||||
* already guaranteed by the parser against the table's arity column.
|
||||
*/
|
||||
static akerr_ErrorContext *first_arg(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *fname, akbasic_ASTLeaf **argleaf, akbasic_Value **argvalue, akbasic_Value **out)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *arg = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf");
|
||||
arg = akbasic_leaf_first_argument(expr);
|
||||
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
|
||||
"%s expected an argument", fname);
|
||||
if ( argvalue != NULL ) {
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, arg, argvalue));
|
||||
}
|
||||
if ( out != NULL ) {
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, out));
|
||||
PASS(errctx, akbasic_value_zero(*out));
|
||||
}
|
||||
if ( argleaf != NULL ) {
|
||||
*argleaf = arg;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* Coerce an integer-or-float argument to double, the shape every trig call wants. */
|
||||
static akerr_ErrorContext *arg_as_double(akbasic_Value *value, const char *fname, double *dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
if ( value->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
*dest = (double)value->intval;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
if ( value->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
*dest = value->floatval;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "%s expected integer or float", fname);
|
||||
}
|
||||
|
||||
/* The trig family differs only by the libm call, so it is one shape. */
|
||||
#define DEFINE_MATH_FUNCTION(__cname, __basicname, __call) \
|
||||
akerr_ErrorContext *__cname(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, \
|
||||
akbasic_Value *lval, akbasic_Value *rval, \
|
||||
akbasic_Value **dest) \
|
||||
{ \
|
||||
PREPARE_ERROR(errctx); \
|
||||
akbasic_Value *arg = NULL; \
|
||||
akbasic_Value *out = NULL; \
|
||||
double input = 0.0; \
|
||||
\
|
||||
(void)lval; (void)rval; \
|
||||
PASS(errctx, first_arg(obj, expr, __basicname, NULL, &arg, &out)); \
|
||||
PASS(errctx, arg_as_double(arg, __basicname, &input)); \
|
||||
out->valuetype = AKBASIC_TYPE_FLOAT; \
|
||||
out->floatval = __call(input); \
|
||||
*dest = out; \
|
||||
SUCCEED_RETURN(errctx); \
|
||||
}
|
||||
|
||||
DEFINE_MATH_FUNCTION(akbasic_fn_atn, "ATN", atan)
|
||||
DEFINE_MATH_FUNCTION(akbasic_fn_cos, "COS", cos)
|
||||
DEFINE_MATH_FUNCTION(akbasic_fn_sin, "SIN", sin)
|
||||
DEFINE_MATH_FUNCTION(akbasic_fn_tan, "TAN", tan)
|
||||
DEFINE_MATH_FUNCTION(akbasic_fn_log, "LOG", log)
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_abs(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "ABS", NULL, &arg, &out));
|
||||
if ( arg->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
out->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
out->intval = (arg->intval < 0 ? -arg->intval : arg->intval);
|
||||
} else if ( arg->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
out->valuetype = AKBASIC_TYPE_FLOAT;
|
||||
out->floatval = fabs(arg->floatval);
|
||||
} else {
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "ABS expected integer or float");
|
||||
}
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_rad(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
double input = 0.0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "RAD", NULL, &arg, &out));
|
||||
PASS(errctx, arg_as_double(arg, "RAD", &input));
|
||||
out->valuetype = AKBASIC_TYPE_FLOAT;
|
||||
out->floatval = input * (M_PI / 180.0);
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_sgn(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
double input = 0.0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "SGN", NULL, &arg, &out));
|
||||
PASS(errctx, arg_as_double(arg, "SGN", &input));
|
||||
out->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
out->intval = (input < 0.0 ? -1 : (input > 0.0 ? 1 : 0));
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_chr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
int64_t codepoint = 0;
|
||||
int written = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "CHR", NULL, &arg, &out));
|
||||
FAIL_NONZERO_RETURN(errctx, (arg->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"CHR expected an integer codepoint");
|
||||
codepoint = arg->intval;
|
||||
FAIL_ZERO_RETURN(errctx, (codepoint >= 0 && codepoint <= 0x10FFFF), AKBASIC_ERR_VALUE,
|
||||
"CHR codepoint %" PRId64 " is outside Unicode", codepoint);
|
||||
|
||||
/* UTF-8 encode, matching the reference's string(rune(x)). */
|
||||
out->valuetype = AKBASIC_TYPE_STRING;
|
||||
if ( codepoint < 0x80 ) {
|
||||
out->stringval[written++] = (char)codepoint;
|
||||
} else if ( codepoint < 0x800 ) {
|
||||
out->stringval[written++] = (char)(0xC0 | (codepoint >> 6));
|
||||
out->stringval[written++] = (char)(0x80 | (codepoint & 0x3F));
|
||||
} else if ( codepoint < 0x10000 ) {
|
||||
out->stringval[written++] = (char)(0xE0 | (codepoint >> 12));
|
||||
out->stringval[written++] = (char)(0x80 | ((codepoint >> 6) & 0x3F));
|
||||
out->stringval[written++] = (char)(0x80 | (codepoint & 0x3F));
|
||||
} else {
|
||||
out->stringval[written++] = (char)(0xF0 | (codepoint >> 18));
|
||||
out->stringval[written++] = (char)(0x80 | ((codepoint >> 12) & 0x3F));
|
||||
out->stringval[written++] = (char)(0x80 | ((codepoint >> 6) & 0x3F));
|
||||
out->stringval[written++] = (char)(0x80 | (codepoint & 0x3F));
|
||||
}
|
||||
out->stringval[written] = '\0';
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_hex(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "HEX", NULL, &arg, &out));
|
||||
FAIL_NONZERO_RETURN(errctx, (arg->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"HEX expected an integer");
|
||||
out->valuetype = AKBASIC_TYPE_STRING;
|
||||
snprintf(out->stringval, sizeof(out->stringval), "%" PRIx64, arg->intval);
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_str(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "STR", NULL, &arg, &out));
|
||||
/*
|
||||
* The reference defines this as `"" + X#`, so it renders exactly the way
|
||||
* string concatenation does -- an integer as %d and a float as %f.
|
||||
*/
|
||||
PASS(errctx, akbasic_value_to_string(arg, out->stringval, sizeof(out->stringval)));
|
||||
out->valuetype = AKBASIC_TYPE_STRING;
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_spc(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
int64_t i = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "SPC", NULL, &arg, &out));
|
||||
FAIL_NONZERO_RETURN(errctx, (arg->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"SPC expected an integer");
|
||||
FAIL_ZERO_RETURN(errctx, (arg->intval >= 0 && arg->intval < AKBASIC_MAX_STRING_LENGTH),
|
||||
AKBASIC_ERR_VALUE,
|
||||
"SPC count %" PRId64 " is outside 0..%d",
|
||||
arg->intval, AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
out->valuetype = AKBASIC_TYPE_STRING;
|
||||
for ( i = 0; i < arg->intval; i++ ) {
|
||||
out->stringval[i] = ' ';
|
||||
}
|
||||
out->stringval[arg->intval] = '\0';
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_val(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "VAL", NULL, &arg, &out));
|
||||
FAIL_NONZERO_RETURN(errctx, (arg->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
|
||||
"VAL expected a string");
|
||||
out->valuetype = AKBASIC_TYPE_FLOAT;
|
||||
/*
|
||||
* Through the strict converter, never aksl_atof: that family cannot report a
|
||||
* failure, so VAL("garbage") would quietly answer 0.0 instead of raising.
|
||||
* See TODO.md section 1.9.
|
||||
*/
|
||||
PASS(errctx, akbasic_str_to_double(arg->stringval, &out->floatval));
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_len(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *argleaf = NULL;
|
||||
akbasic_Value *strval = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
akbasic_Variable *variable = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
/*
|
||||
* LEN must not evaluate a non-string argument. `LEN(A#)` on a
|
||||
* multi-dimensional array is legal and asks for the element count, but
|
||||
* evaluating a bare identifier supplies the single subscript {0}, which a
|
||||
* two-dimensional variable rightly rejects. So: inspect the leaf, and only
|
||||
* evaluate when it is a string.
|
||||
*/
|
||||
PASS(errctx, first_arg(obj, expr, "LEN", &argleaf, NULL, NULL));
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(akbasic_leaf_is_identifier(argleaf) || akbasic_leaf_is_literal(argleaf)),
|
||||
AKBASIC_ERR_SYNTAX, "Expected identifier or string literal");
|
||||
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
out->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
|
||||
if ( argleaf->leaftype == AKBASIC_LEAF_LITERAL_STRING ||
|
||||
argleaf->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ) {
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, argleaf, &strval));
|
||||
out->intval = (int64_t)strlen(strval->stringval);
|
||||
} else {
|
||||
PASS(errctx, akbasic_environment_get(obj->environment, argleaf->identifier, &variable));
|
||||
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
|
||||
"Identifier %s is undefined", argleaf->identifier);
|
||||
out->intval = variable->valuecount;
|
||||
}
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* Fetch argument N (zero-based) of a call, already evaluated. */
|
||||
static akerr_ErrorContext *nth_arg(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *fname, int n, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *arg = NULL;
|
||||
int i = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf");
|
||||
arg = akbasic_leaf_first_argument(expr);
|
||||
for ( i = 0; i < n && arg != NULL; i++ ) {
|
||||
arg = arg->right;
|
||||
}
|
||||
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
|
||||
"%s is missing argument %d", fname, n + 1);
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, arg, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_instr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *haystack = NULL;
|
||||
akbasic_Value *needle = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
char *hit = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, nth_arg(obj, expr, "INSTR", 0, &haystack));
|
||||
PASS(errctx, nth_arg(obj, expr, "INSTR", 1, &needle));
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(haystack->valuetype == AKBASIC_TYPE_STRING &&
|
||||
needle->valuetype == AKBASIC_TYPE_STRING),
|
||||
AKBASIC_ERR_TYPE, "INSTR expected two strings");
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
out->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
hit = strstr(haystack->stringval, needle->stringval);
|
||||
out->intval = (hit == NULL ? -1 : (int64_t)(hit - haystack->stringval));
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_left(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *source = NULL;
|
||||
akbasic_Value *count = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
int64_t take = 0;
|
||||
size_t sourcelen = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, nth_arg(obj, expr, "LEFT", 0, &source));
|
||||
PASS(errctx, nth_arg(obj, expr, "LEFT", 1, &count));
|
||||
FAIL_NONZERO_RETURN(errctx, (source->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
|
||||
"LEFT expected a string");
|
||||
FAIL_NONZERO_RETURN(errctx, (count->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"LEFT expected an integer count");
|
||||
sourcelen = strlen(source->stringval);
|
||||
take = count->intval;
|
||||
if ( take < 0 ) {
|
||||
take = 0;
|
||||
}
|
||||
if ( (size_t)take > sourcelen ) {
|
||||
take = (int64_t)sourcelen; /* clamped to LEN, as the README says */
|
||||
}
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
out->valuetype = AKBASIC_TYPE_STRING;
|
||||
memcpy(out->stringval, source->stringval, (size_t)take);
|
||||
out->stringval[take] = '\0';
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_right(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *source = NULL;
|
||||
akbasic_Value *count = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
int64_t take = 0;
|
||||
size_t sourcelen = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, nth_arg(obj, expr, "RIGHT", 0, &source));
|
||||
PASS(errctx, nth_arg(obj, expr, "RIGHT", 1, &count));
|
||||
FAIL_NONZERO_RETURN(errctx, (source->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
|
||||
"RIGHT expected a string");
|
||||
FAIL_NONZERO_RETURN(errctx, (count->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
|
||||
"RIGHT expected an integer count");
|
||||
sourcelen = strlen(source->stringval);
|
||||
take = count->intval;
|
||||
if ( take < 0 ) {
|
||||
take = 0;
|
||||
}
|
||||
if ( (size_t)take > sourcelen ) {
|
||||
take = (int64_t)sourcelen;
|
||||
}
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
out->valuetype = AKBASIC_TYPE_STRING;
|
||||
memcpy(out->stringval, source->stringval + (sourcelen - (size_t)take), (size_t)take);
|
||||
out->stringval[take] = '\0';
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_mid(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *source = NULL;
|
||||
akbasic_Value *startval = NULL;
|
||||
akbasic_Value *lengthval = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
int64_t start = 0;
|
||||
int64_t length = 0;
|
||||
size_t sourcelen = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, nth_arg(obj, expr, "MID", 0, &source));
|
||||
PASS(errctx, nth_arg(obj, expr, "MID", 1, &startval));
|
||||
PASS(errctx, nth_arg(obj, expr, "MID", 2, &lengthval));
|
||||
FAIL_NONZERO_RETURN(errctx, (source->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
|
||||
"MID expected a string");
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(startval->valuetype == AKBASIC_TYPE_INTEGER &&
|
||||
lengthval->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "MID expected integer start and length");
|
||||
|
||||
sourcelen = strlen(source->stringval);
|
||||
start = startval->intval;
|
||||
length = lengthval->intval;
|
||||
FAIL_ZERO_RETURN(errctx, (start >= 0 && (size_t)start <= sourcelen), AKBASIC_ERR_BOUNDS,
|
||||
"MID start %" PRId64 " is outside 0..%zu", start, sourcelen);
|
||||
if ( length < 0 ) {
|
||||
length = 0;
|
||||
}
|
||||
if ( (size_t)(start + length) > sourcelen ) {
|
||||
length = (int64_t)sourcelen - start;
|
||||
}
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
out->valuetype = AKBASIC_TYPE_STRING;
|
||||
memcpy(out->stringval, source->stringval + start, (size_t)length);
|
||||
out->stringval[length] = '\0';
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_mod(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *left = NULL;
|
||||
akbasic_Value *right = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, nth_arg(obj, expr, "MOD", 0, &left));
|
||||
PASS(errctx, nth_arg(obj, expr, "MOD", 1, &right));
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(left->valuetype == AKBASIC_TYPE_INTEGER &&
|
||||
right->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "MOD expected two integers");
|
||||
FAIL_ZERO_RETURN(errctx, (right->intval != 0), AKBASIC_ERR_VALUE, "DIVISION BY ZERO");
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
out->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
/*
|
||||
* The reference defines MOD as `X% - (Y% * (X% / Y%))` in BASIC, which with
|
||||
* truncating integer division is exactly C's %.
|
||||
*/
|
||||
out->intval = left->intval - (right->intval * (left->intval / right->intval));
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* SHL, SHR and XOR share a shape: two integers in, one integer out. */
|
||||
static akerr_ErrorContext *two_integers(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *fname, int64_t *a, int64_t *b, akbasic_Value **out)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *left = NULL;
|
||||
akbasic_Value *right = NULL;
|
||||
|
||||
PASS(errctx, nth_arg(obj, expr, fname, 0, &left));
|
||||
PASS(errctx, nth_arg(obj, expr, fname, 1, &right));
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(left->valuetype == AKBASIC_TYPE_INTEGER &&
|
||||
right->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "%s expected two integers", fname);
|
||||
*a = left->intval;
|
||||
*b = right->intval;
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, out));
|
||||
PASS(errctx, akbasic_value_zero(*out));
|
||||
(*out)->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_shl(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *out = NULL;
|
||||
int64_t value = 0;
|
||||
int64_t bits = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, two_integers(obj, expr, "SHL", &value, &bits, &out));
|
||||
FAIL_ZERO_RETURN(errctx, (bits >= 0 && bits < 64), AKBASIC_ERR_VALUE,
|
||||
"SHL shift count %" PRId64 " is outside 0..63", bits);
|
||||
out->intval = (int64_t)((uint64_t)value << bits);
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_shr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *out = NULL;
|
||||
int64_t value = 0;
|
||||
int64_t bits = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, two_integers(obj, expr, "SHR", &value, &bits, &out));
|
||||
FAIL_ZERO_RETURN(errctx, (bits >= 0 && bits < 64), AKBASIC_ERR_VALUE,
|
||||
"SHR shift count %" PRId64 " is outside 0..63", bits);
|
||||
out->intval = value >> bits;
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_xor(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *out = NULL;
|
||||
int64_t left = 0;
|
||||
int64_t right = 0;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, two_integers(obj, expr, "XOR", &left, &right, &out));
|
||||
out->intval = left ^ right;
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/*
|
||||
* PEEK, POINTER and POINTERVAR reach real memory. In Go these went through
|
||||
* unsafe.Pointer; in C they are ordinary casts and are simpler, not harder.
|
||||
*
|
||||
* They assume a little-endian host: tests/language/functions/pointer.bas sets
|
||||
* A# = 255 and expects PEEK(POINTER(A#)) to be 255, which only holds if the low
|
||||
* byte of the int64_t comes first.
|
||||
*/
|
||||
akerr_ErrorContext *akbasic_fn_peek(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *argleaf = NULL;
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
const uint8_t *source = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "PEEK", &argleaf, NULL, NULL));
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(argleaf->leaftype == AKBASIC_LEAF_LITERAL_INT ||
|
||||
argleaf->leaftype == AKBASIC_LEAF_IDENTIFIER_INT),
|
||||
AKBASIC_ERR_TYPE, "PEEK expected INTEGER or INTEGER VARIABLE");
|
||||
PASS(errctx, akbasic_runtime_evaluate(obj, argleaf, &arg));
|
||||
FAIL_ZERO_RETURN(errctx, (arg->valuetype == AKBASIC_TYPE_INTEGER && arg->intval != 0),
|
||||
AKBASIC_ERR_VALUE, "PEEK got NIL pointer or uninitialized variable");
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
source = (const uint8_t *)(uintptr_t)arg->intval;
|
||||
out->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
out->intval = (int64_t)(*source);
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_pointer(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *argleaf = NULL;
|
||||
akbasic_Value *arg = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "POINTER", &argleaf, NULL, NULL));
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(argleaf), AKBASIC_ERR_TYPE,
|
||||
"POINTER expected IDENTIFIER");
|
||||
|
||||
/* The address of the live storage, not of a copy of it. */
|
||||
obj->eval_clone_identifiers = false;
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_runtime_evaluate(obj, argleaf, &arg));
|
||||
} CLEANUP {
|
||||
obj->eval_clone_identifiers = true;
|
||||
} PROCESS(errctx) {
|
||||
} FINISH(errctx, true);
|
||||
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
out->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
switch ( arg->valuetype ) {
|
||||
case AKBASIC_TYPE_INTEGER:
|
||||
out->intval = (int64_t)(uintptr_t)&arg->intval;
|
||||
break;
|
||||
case AKBASIC_TYPE_FLOAT:
|
||||
out->intval = (int64_t)(uintptr_t)&arg->floatval;
|
||||
break;
|
||||
case AKBASIC_TYPE_STRING:
|
||||
out->intval = (int64_t)(uintptr_t)&arg->stringval;
|
||||
break;
|
||||
default:
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "POINTER expects a INT, FLOAT or STRING variable");
|
||||
}
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_fn_pointervar(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *argleaf = NULL;
|
||||
akbasic_Variable *variable = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
(void)lval; (void)rval;
|
||||
PASS(errctx, first_arg(obj, expr, "POINTERVAR", &argleaf, NULL, NULL));
|
||||
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(argleaf), AKBASIC_ERR_TYPE,
|
||||
"POINTERVAR expected IDENTIFIER");
|
||||
PASS(errctx, akbasic_environment_get(obj->environment, argleaf->identifier, &variable));
|
||||
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
|
||||
"Identifier %s is undefined", argleaf->identifier);
|
||||
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
|
||||
PASS(errctx, akbasic_value_zero(out));
|
||||
out->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
out->intval = (int64_t)(uintptr_t)variable;
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
376
src/scanner.c
Normal file
376
src/scanner.c
Normal file
@@ -0,0 +1,376 @@
|
||||
/**
|
||||
* @file scanner.c
|
||||
* @brief Implements the line tokenizer.
|
||||
*/
|
||||
|
||||
#include <ctype.h>
|
||||
#include <inttypes.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/convert.h>
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/scanner.h>
|
||||
#include <akbasic/verbs.h>
|
||||
|
||||
akerr_ErrorContext *akbasic_scanner_zero(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in scanner zero");
|
||||
obj->current = 0;
|
||||
obj->start = 0;
|
||||
obj->hasError = false;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static bool is_at_end(akbasic_Runtime *obj)
|
||||
{
|
||||
return (obj->current >= (int)strlen(obj->line));
|
||||
}
|
||||
|
||||
static bool peek(akbasic_Runtime *obj, char *dest)
|
||||
{
|
||||
if ( is_at_end(obj) ) {
|
||||
return false;
|
||||
}
|
||||
*dest = obj->line[obj->current];
|
||||
return true;
|
||||
}
|
||||
|
||||
static bool peek_next(akbasic_Runtime *obj, char *dest)
|
||||
{
|
||||
if ( (obj->current + 1) >= (int)strlen(obj->line) ) {
|
||||
return false;
|
||||
}
|
||||
*dest = obj->line[obj->current + 1];
|
||||
return true;
|
||||
}
|
||||
|
||||
/*
|
||||
* The lexeme is the span [start, current), with two special cases the reference
|
||||
* relies on: at end of line it runs to the end, and a zero-width span yields the
|
||||
* single character at `start` -- unless we are closing a string literal, where
|
||||
* an empty span really is the empty string.
|
||||
*/
|
||||
static akerr_ErrorContext *get_lexeme(akbasic_Runtime *obj, char *dest, size_t len)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int linelen = (int)strlen(obj->line);
|
||||
int span = 0;
|
||||
|
||||
if ( obj->current == linelen ) {
|
||||
span = linelen - obj->start;
|
||||
} else if ( obj->start == obj->current ) {
|
||||
if ( obj->tokentype == AKBASIC_TOK_LITERAL_STRING ) {
|
||||
dest[0] = '\0';
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
span = 1;
|
||||
} else {
|
||||
span = obj->current - obj->start;
|
||||
}
|
||||
FAIL_ZERO_RETURN(errctx, (span >= 0 && (size_t)span < len), AKBASIC_ERR_BOUNDS,
|
||||
"Lexeme of %d characters exceeds the %zu character limit", span, len - 1);
|
||||
memcpy(dest, obj->line + obj->start, (size_t)span);
|
||||
dest[span] = '\0';
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *add_token(akbasic_Runtime *obj, akbasic_TokenType token, const char *lexeme)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Environment *env = obj->environment;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (env->nexttoken < AKBASIC_MAX_TOKENS), AKBASIC_ERR_BOUNDS,
|
||||
"Line %" PRId64 " has more than %d tokens",
|
||||
env->lineno, AKBASIC_MAX_TOKENS);
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(lexeme) < AKBASIC_MAX_LINE_LENGTH), AKBASIC_ERR_BOUNDS,
|
||||
"Token lexeme exceeds the %d character limit", AKBASIC_MAX_LINE_LENGTH - 1);
|
||||
env->tokens[env->nexttoken].tokentype = token;
|
||||
env->tokens[env->nexttoken].lineno = env->lineno;
|
||||
strncpy(env->tokens[env->nexttoken].lexeme, lexeme, AKBASIC_MAX_LINE_LENGTH - 1);
|
||||
env->tokens[env->nexttoken].lexeme[AKBASIC_MAX_LINE_LENGTH - 1] = '\0';
|
||||
env->nexttoken += 1;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* Consume one more character when it matches, choosing between two token types. */
|
||||
static bool match_next_char(akbasic_Runtime *obj, char cm, akbasic_TokenType truetype, akbasic_TokenType falsetype)
|
||||
{
|
||||
char nc = '\0';
|
||||
|
||||
if ( !peek(obj, &nc) ) {
|
||||
return false;
|
||||
}
|
||||
if ( nc == cm ) {
|
||||
obj->current += 1;
|
||||
obj->tokentype = truetype;
|
||||
return true;
|
||||
}
|
||||
obj->tokentype = falsetype;
|
||||
return false;
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *match_string(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char c = '\0';
|
||||
|
||||
while ( !is_at_end(obj) ) {
|
||||
if ( !peek(obj, &c) ) {
|
||||
PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE,
|
||||
"UNTERMINATED STRING LITERAL\n"));
|
||||
obj->hasError = true;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
if ( c == '"' ) {
|
||||
break;
|
||||
}
|
||||
obj->current += 1;
|
||||
}
|
||||
obj->tokentype = AKBASIC_TOK_LITERAL_STRING;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *match_number(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
bool linenumber = (obj->environment->nexttoken == 0);
|
||||
char lexeme[AKBASIC_MAX_LINE_LENGTH];
|
||||
char c = '\0';
|
||||
char nc = '\0';
|
||||
int64_t lineno = 0;
|
||||
|
||||
obj->tokentype = AKBASIC_TOK_LITERAL_INT;
|
||||
while ( !is_at_end(obj) ) {
|
||||
(void)peek(obj, &c);
|
||||
if ( c == '.' ) {
|
||||
if ( !peek_next(obj, &nc) || !isdigit((unsigned char)nc) ) {
|
||||
PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE,
|
||||
"INVALID FLOATING POINT LITERAL\n"));
|
||||
obj->hasError = true;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
obj->tokentype = AKBASIC_TOK_LITERAL_FLOAT;
|
||||
} else if ( !isdigit((unsigned char)c) && c != 'x' ) {
|
||||
/* 'x' is allowed through so 0x-prefixed hex reaches the parser. */
|
||||
break;
|
||||
}
|
||||
obj->current += 1;
|
||||
}
|
||||
|
||||
if ( obj->tokentype == AKBASIC_TOK_LITERAL_INT && linenumber ) {
|
||||
PASS(errctx, get_lexeme(obj, lexeme, sizeof(lexeme)));
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_str_to_int64(lexeme, 10, &lineno));
|
||||
} CLEANUP {
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE_DEFAULT(errctx) {
|
||||
char message[AKBASIC_MAX_LINE_LENGTH + 32];
|
||||
snprintf(message, sizeof(message), "INTEGER CONVERSION ON '%s'", lexeme);
|
||||
/*
|
||||
* Reporting can itself fail if the sink is broken. Nothing useful
|
||||
* remains to be done about that here, so record the flag and let the
|
||||
* next operation surface it.
|
||||
*/
|
||||
IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
|
||||
obj->hasError = true;
|
||||
} FINISH(errctx, false);
|
||||
|
||||
if ( obj->hasError ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
obj->environment->lineno = lineno;
|
||||
obj->tokentype = AKBASIC_TOK_LINE_NUMBER;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *match_identifier(akbasic_Runtime *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char lexeme[AKBASIC_MAX_LINE_LENGTH];
|
||||
const akbasic_Verb *verb = NULL;
|
||||
void *fndef = NULL;
|
||||
bool userfunction = false;
|
||||
char c = '\0';
|
||||
|
||||
obj->tokentype = AKBASIC_TOK_IDENTIFIER;
|
||||
while ( !is_at_end(obj) ) {
|
||||
(void)peek(obj, &c);
|
||||
if ( isdigit((unsigned char)c) || isalpha((unsigned char)c) ) {
|
||||
obj->current += 1;
|
||||
continue;
|
||||
}
|
||||
switch ( c ) {
|
||||
case '@':
|
||||
obj->tokentype = AKBASIC_TOK_IDENTIFIER_STRUCT;
|
||||
obj->current += 1;
|
||||
break;
|
||||
case '$':
|
||||
obj->tokentype = AKBASIC_TOK_IDENTIFIER_STRING;
|
||||
obj->current += 1;
|
||||
break;
|
||||
case '%':
|
||||
obj->tokentype = AKBASIC_TOK_IDENTIFIER_FLOAT;
|
||||
obj->current += 1;
|
||||
break;
|
||||
case '#':
|
||||
obj->tokentype = AKBASIC_TOK_IDENTIFIER_INT;
|
||||
obj->current += 1;
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
PASS(errctx, get_lexeme(obj, lexeme, sizeof(lexeme)));
|
||||
PASS(errctx, akbasic_verb_lookup(lexeme, &verb));
|
||||
|
||||
ATTEMPT {
|
||||
CATCH(errctx, akbasic_environment_get_function(obj->environment, lexeme, &fndef));
|
||||
userfunction = true;
|
||||
} CLEANUP {
|
||||
} PROCESS(errctx) {
|
||||
} HANDLE(errctx, AKERR_KEY) {
|
||||
userfunction = false;
|
||||
} FINISH(errctx, true);
|
||||
|
||||
if ( obj->tokentype == AKBASIC_TOK_IDENTIFIER ) {
|
||||
if ( verb != NULL ) {
|
||||
obj->tokentype = verb->tokentype;
|
||||
} else if ( userfunction ) {
|
||||
obj->tokentype = AKBASIC_TOK_FUNCTION;
|
||||
}
|
||||
} else if ( verb != NULL ) {
|
||||
/*
|
||||
* A suffixed identifier that collides with a verb or function name.
|
||||
* PRINT$ is not a variable.
|
||||
*/
|
||||
PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_SYNTAX,
|
||||
"Reserved word in variable name\n"));
|
||||
obj->hasError = true;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_scanner_scan(akbasic_Runtime *obj, const char *line, char *dest, size_t len)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char lexeme[AKBASIC_MAX_LINE_LENGTH];
|
||||
char c = '\0';
|
||||
bool done = false;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in scan");
|
||||
FAIL_ZERO_RETURN(errctx, (line != NULL), AKERR_NULLPOINTER, "NULL line in scan");
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(line) < AKBASIC_MAX_LINE_LENGTH), AKBASIC_ERR_BOUNDS,
|
||||
"Source line of %zu characters exceeds the %d character limit",
|
||||
strlen(line), AKBASIC_MAX_LINE_LENGTH - 1);
|
||||
|
||||
strncpy(obj->line, line, AKBASIC_MAX_LINE_LENGTH - 1);
|
||||
obj->line[AKBASIC_MAX_LINE_LENGTH - 1] = '\0';
|
||||
PASS(errctx, akbasic_environment_zero_parser(obj->environment));
|
||||
obj->current = 0;
|
||||
obj->start = 0;
|
||||
obj->hasError = false;
|
||||
|
||||
while ( !is_at_end(obj) && !done ) {
|
||||
c = obj->line[obj->current];
|
||||
obj->current += 1;
|
||||
|
||||
switch ( c ) {
|
||||
case '@': obj->tokentype = AKBASIC_TOK_ATSYMBOL; break;
|
||||
case '^': obj->tokentype = AKBASIC_TOK_CARAT; break;
|
||||
case '(': obj->tokentype = AKBASIC_TOK_LEFT_PAREN; break;
|
||||
case ')': obj->tokentype = AKBASIC_TOK_RIGHT_PAREN; break;
|
||||
case '+': obj->tokentype = AKBASIC_TOK_PLUS; break;
|
||||
case '-': obj->tokentype = AKBASIC_TOK_MINUS; break;
|
||||
case '/': obj->tokentype = AKBASIC_TOK_LEFT_SLASH; break;
|
||||
case '*': obj->tokentype = AKBASIC_TOK_STAR; break;
|
||||
case ',': obj->tokentype = AKBASIC_TOK_COMMA; break;
|
||||
case ':': obj->tokentype = AKBASIC_TOK_COLON; break;
|
||||
case '[': obj->tokentype = AKBASIC_TOK_LEFT_SQUAREBRACKET; break;
|
||||
case ']': obj->tokentype = AKBASIC_TOK_RIGHT_SQUAREBRACKET; break;
|
||||
case '=':
|
||||
(void)match_next_char(obj, '=', AKBASIC_TOK_EQUAL, AKBASIC_TOK_ASSIGNMENT);
|
||||
break;
|
||||
case '<':
|
||||
if ( !match_next_char(obj, '=', AKBASIC_TOK_LESS_THAN_EQUAL, AKBASIC_TOK_LESS_THAN) ) {
|
||||
(void)match_next_char(obj, '>', AKBASIC_TOK_NOT_EQUAL, AKBASIC_TOK_LESS_THAN);
|
||||
}
|
||||
break;
|
||||
case '>':
|
||||
(void)match_next_char(obj, '=', AKBASIC_TOK_GREATER_THAN_EQUAL, AKBASIC_TOK_GREATER_THAN);
|
||||
break;
|
||||
case '"':
|
||||
obj->start = obj->current;
|
||||
PASS(errctx, match_string(obj));
|
||||
break;
|
||||
case '\t':
|
||||
case ' ':
|
||||
obj->start = obj->current;
|
||||
break;
|
||||
case '\r':
|
||||
case '\n':
|
||||
done = true;
|
||||
break;
|
||||
default:
|
||||
if ( isdigit((unsigned char)c) ) {
|
||||
PASS(errctx, match_number(obj));
|
||||
} else if ( isalpha((unsigned char)c) ) {
|
||||
PASS(errctx, match_identifier(obj));
|
||||
} else {
|
||||
char message[AKBASIC_MAX_LINE_LENGTH];
|
||||
snprintf(message, sizeof(message), "UNKNOWN TOKEN %c\n", c);
|
||||
PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
|
||||
obj->hasError = true;
|
||||
obj->start = obj->current;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
if ( done ) {
|
||||
break;
|
||||
}
|
||||
if ( obj->tokentype != AKBASIC_TOK_UNDEFINED && !obj->hasError ) {
|
||||
if ( obj->tokentype == AKBASIC_TOK_REM ) {
|
||||
/* Everything after REM is a comment. Stop, keeping the line intact. */
|
||||
break;
|
||||
} else if ( obj->tokentype == AKBASIC_TOK_LINE_NUMBER ) {
|
||||
/*
|
||||
* The line number is not kept as a token. Rewrite the line to
|
||||
* everything after it, minus leading spaces, and restart the
|
||||
* cursor -- the REPL reads the rewritten line back out and
|
||||
* stores *that* as the program text.
|
||||
*/
|
||||
int skip = obj->current;
|
||||
while ( obj->line[skip] == ' ' ) {
|
||||
skip += 1;
|
||||
}
|
||||
memmove(obj->line, obj->line + skip, strlen(obj->line + skip) + 1);
|
||||
obj->current = 0;
|
||||
} else {
|
||||
PASS(errctx, get_lexeme(obj, lexeme, sizeof(lexeme)));
|
||||
PASS(errctx, add_token(obj, obj->tokentype, lexeme));
|
||||
if ( obj->tokentype == AKBASIC_TOK_LITERAL_STRING ) {
|
||||
/* Scanning stopped on the closing quote; step past it. */
|
||||
obj->current += 1;
|
||||
}
|
||||
}
|
||||
obj->tokentype = AKBASIC_TOK_UNDEFINED;
|
||||
obj->start = obj->current;
|
||||
}
|
||||
}
|
||||
|
||||
if ( dest != NULL ) {
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(obj->line) < len), AKBASIC_ERR_BOUNDS,
|
||||
"Scanned line does not fit the caller's buffer");
|
||||
strncpy(dest, obj->line, len - 1);
|
||||
dest[len - 1] = '\0';
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
104
src/sink_stdio.c
Normal file
104
src/sink_stdio.c
Normal file
@@ -0,0 +1,104 @@
|
||||
/**
|
||||
* @file sink_stdio.c
|
||||
* @brief The stdio-backed text sink.
|
||||
*
|
||||
* This is what makes the golden corpus runnable with no SDL on the machine. It
|
||||
* writes exactly what the reference's fmt.Printf/fmt.Println mirror wrote, byte
|
||||
* for byte, including the newline writeln appends -- an error line therefore
|
||||
* ends in two newlines, because the caller's message already carries one. That
|
||||
* is the acceptance contract, not an accident. See TODO.md section 1.8.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
#include <akstdlib.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/sink.h>
|
||||
|
||||
static akerr_ErrorContext *stdio_write(akbasic_TextSink *self, const char *text)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_StdioSink *state = NULL;
|
||||
int count = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL && text != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in sink write");
|
||||
state = (akbasic_StdioSink *)self->self;
|
||||
PASS(errctx, aksl_fprintf(&count, state->out, "%s", text));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *stdio_writeln(akbasic_TextSink *self, const char *text)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_StdioSink *state = NULL;
|
||||
int count = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL && text != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in sink writeln");
|
||||
state = (akbasic_StdioSink *)self->self;
|
||||
PASS(errctx, aksl_fprintf(&count, state->out, "%s\n", text));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *stdio_readline(akbasic_TextSink *self, char *dest, size_t len, bool *eof)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_StdioSink *state = NULL;
|
||||
size_t used = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL && dest != NULL && eof != NULL), AKERR_NULLPOINTER,
|
||||
"NULL argument in sink readline");
|
||||
FAIL_ZERO_RETURN(errctx, (len > 1), AKBASIC_ERR_BOUNDS,
|
||||
"Read buffer of %zu bytes is too small", len);
|
||||
|
||||
state = (akbasic_StdioSink *)self->self;
|
||||
*eof = false;
|
||||
dest[0] = '\0';
|
||||
|
||||
if ( fgets(dest, (int)len, state->in) == NULL ) {
|
||||
*eof = true;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
/*
|
||||
* Strip the line terminator. The scanner treats \r and \n as end-of-line
|
||||
* anyway, but leaving them on would make a stored source line differ from
|
||||
* the same line typed at the REPL.
|
||||
*/
|
||||
used = strlen(dest);
|
||||
while ( used > 0 && (dest[used - 1] == '\n' || dest[used - 1] == '\r') ) {
|
||||
dest[used - 1] = '\0';
|
||||
used -= 1;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static akerr_ErrorContext *stdio_clear(akbasic_TextSink *self)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL sink in clear");
|
||||
/* A terminal has no screen to clear that the golden corpus would agree on. */
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_sink_init_stdio(akbasic_TextSink *obj, akbasic_StdioSink *state, FILE *out, FILE *in)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL sink in init");
|
||||
FAIL_ZERO_RETURN(errctx, (state != NULL), AKERR_NULLPOINTER, "NULL sink state in init");
|
||||
|
||||
state->out = (out != NULL ? out : stdout);
|
||||
state->in = (in != NULL ? in : stdin);
|
||||
|
||||
obj->self = state;
|
||||
obj->write = stdio_write;
|
||||
obj->writeln = stdio_writeln;
|
||||
obj->readline = stdio_readline;
|
||||
obj->clear = stdio_clear;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
133
src/symtab.c
Normal file
133
src/symtab.c
Normal file
@@ -0,0 +1,133 @@
|
||||
/**
|
||||
* @file symtab.c
|
||||
* @brief Implements the fixed-capacity open-addressed symbol table.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
#include <akstdlib.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/symtab.h>
|
||||
|
||||
/*
|
||||
* Probe for `key`. On success *slot points at either the slot holding the key or
|
||||
* the first free slot it could occupy; *found says which. Uses
|
||||
* aksl_strhash_djb2 rather than a private hash. That wrapper sign-extends char,
|
||||
* so a high-bit byte hashes wrong (deps/libakstdlib/TODO.md 1.6) -- harmless
|
||||
* here because BASIC identifiers are 7-bit ASCII, and it would only ever cost
|
||||
* probe efficiency, never correctness, since the key comparison is a strcmp.
|
||||
*/
|
||||
static akerr_ErrorContext *probe(akbasic_SymbolTable *obj, const char *key, int *slot, bool *found)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
uint32_t hashval = 0;
|
||||
int index = 0;
|
||||
int i = 0;
|
||||
|
||||
PASS(errctx, aksl_strhash_djb2((char *)key, strlen(key), &hashval));
|
||||
|
||||
*found = false;
|
||||
index = (int)(hashval % (uint32_t)obj->capacity);
|
||||
for ( i = 0; i < obj->capacity; i++ ) {
|
||||
int probeidx = (index + i) % obj->capacity;
|
||||
if ( !obj->slots[probeidx].used ) {
|
||||
*slot = probeidx;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
if ( strcmp(obj->slots[probeidx].key, key) == 0 ) {
|
||||
*slot = probeidx;
|
||||
*found = true;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
}
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS,
|
||||
"Symbol table is full (%d entries), cannot place '%s'",
|
||||
obj->capacity, key);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_symtab_init(akbasic_SymbolTable *obj, int capacity)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
|
||||
"NULL symbol table in init");
|
||||
FAIL_ZERO_RETURN(errctx, (capacity > 0 && capacity <= AKBASIC_SYMTAB_MAX_SLOTS),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Symbol table capacity %d out of range 1..%d",
|
||||
capacity, AKBASIC_SYMTAB_MAX_SLOTS);
|
||||
|
||||
memset(obj, 0, sizeof(*obj));
|
||||
obj->capacity = capacity;
|
||||
obj->count = 0;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_symtab_set(akbasic_SymbolTable *obj, const char *key, void *value, int64_t ivalue)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int slot = 0;
|
||||
bool found = false;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
|
||||
"NULL symbol table in set");
|
||||
FAIL_ZERO_RETURN(errctx, (key != NULL), AKERR_NULLPOINTER,
|
||||
"NULL key in symbol table set");
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(key) < AKBASIC_SYMTAB_MAX_KEY),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Symbol name '%s' exceeds %d characters",
|
||||
key, AKBASIC_SYMTAB_MAX_KEY - 1);
|
||||
|
||||
PASS(errctx, probe(obj, key, &slot, &found));
|
||||
|
||||
if ( !found ) {
|
||||
strncpy(obj->slots[slot].key, key, AKBASIC_SYMTAB_MAX_KEY - 1);
|
||||
obj->slots[slot].key[AKBASIC_SYMTAB_MAX_KEY - 1] = '\0';
|
||||
obj->slots[slot].used = true;
|
||||
obj->count += 1;
|
||||
}
|
||||
obj->slots[slot].value = value;
|
||||
obj->slots[slot].ivalue = ivalue;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_symtab_get(akbasic_SymbolTable *obj, const char *key, void **value, int64_t *ivalue)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int slot = 0;
|
||||
bool found = false;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
|
||||
"NULL symbol table in get");
|
||||
FAIL_ZERO_RETURN(errctx, (key != NULL), AKERR_NULLPOINTER,
|
||||
"NULL key in symbol table get");
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(key) < AKBASIC_SYMTAB_MAX_KEY),
|
||||
AKERR_KEY,
|
||||
"Symbol '%s' is not present", key);
|
||||
|
||||
PASS(errctx, probe(obj, key, &slot, &found));
|
||||
FAIL_ZERO_RETURN(errctx, found, AKERR_KEY, "Symbol '%s' is not present", key);
|
||||
|
||||
if ( value != NULL ) {
|
||||
*value = obj->slots[slot].value;
|
||||
}
|
||||
if ( ivalue != NULL ) {
|
||||
*ivalue = obj->slots[slot].ivalue;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_symtab_clear(akbasic_SymbolTable *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int capacity = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
|
||||
"NULL symbol table in clear");
|
||||
|
||||
capacity = obj->capacity;
|
||||
memset(obj, 0, sizeof(*obj));
|
||||
obj->capacity = capacity;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
517
src/value.c
Normal file
517
src/value.c
Normal file
@@ -0,0 +1,517 @@
|
||||
/**
|
||||
* @file value.c
|
||||
* @brief Implements the BASIC value type and its operators.
|
||||
*
|
||||
* A faithful port of basicvalue.go. Where the reference does something
|
||||
* arithmetically odd -- adding both of the right operand's numeric fields, for
|
||||
* instance -- this reproduces it, because the golden corpus encodes the observed
|
||||
* behaviour and a "fix" here is a silent behaviour change. Each one is catalogued
|
||||
* in TODO.md section 12.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/value.h>
|
||||
|
||||
/*
|
||||
* The reference writes `rval.intval + int64(rval.floatval)` on every integer
|
||||
* operation and the mirror image on every float one. It works only because the
|
||||
* unused field of a typed value is always zero. Named so the intent -- "whatever
|
||||
* numeric payload the right operand is carrying" -- is legible, and so there is
|
||||
* one place to change when TODO.md section 12 item 5 is fixed.
|
||||
*/
|
||||
static int64_t rval_as_int(akbasic_Value *rval)
|
||||
{
|
||||
return rval->intval + (int64_t)rval->floatval;
|
||||
}
|
||||
|
||||
static double rval_as_float(akbasic_Value *rval)
|
||||
{
|
||||
return rval->floatval + (double)rval->intval;
|
||||
}
|
||||
|
||||
/* Copy a string into a value's inline buffer. Truncation is an error. */
|
||||
static akerr_ErrorContext *set_string(akbasic_Value *dest, const char *src)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(src) < AKBASIC_MAX_STRING_LENGTH),
|
||||
AKBASIC_ERR_VALUE,
|
||||
"String result of %zu characters exceeds the %d character limit",
|
||||
strlen(src), AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
strncpy(dest->stringval, src, AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
dest->stringval[AKBASIC_MAX_STRING_LENGTH - 1] = '\0';
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_valuepool_init(akbasic_ValuePool *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL pool in init");
|
||||
memset(obj, 0, sizeof(*obj));
|
||||
obj->next = 0;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_valuepool_take(akbasic_ValuePool *obj, int count, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int i = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL pool in take");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in take");
|
||||
FAIL_ZERO_RETURN(errctx, (count > 0), AKBASIC_ERR_BOUNDS,
|
||||
"Array element count %d must be positive", count);
|
||||
FAIL_ZERO_RETURN(errctx, (count <= AKBASIC_MAX_ARRAY_VALUES - obj->next),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Array of %d elements does not fit in the %d remaining value slots",
|
||||
count, AKBASIC_MAX_ARRAY_VALUES - obj->next);
|
||||
|
||||
*dest = &obj->values[obj->next];
|
||||
for ( i = 0; i < count; i++ ) {
|
||||
PASS(errctx, akbasic_value_zero(&obj->values[obj->next + i]));
|
||||
}
|
||||
obj->next += count;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_init(akbasic_Value *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL value in init");
|
||||
/*
|
||||
* BasicValue.init() is empty in the reference; the zeroing happens in
|
||||
* zero(). Keeping both means the call sites port one-for-one.
|
||||
*/
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_zero(akbasic_Value *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL value in zero");
|
||||
obj->valuetype = AKBASIC_TYPE_UNDEFINED;
|
||||
obj->stringval[0] = '\0';
|
||||
obj->mutable_ = false;
|
||||
obj->intval = 0;
|
||||
obj->floatval = 0.0;
|
||||
obj->boolvalue = AKBASIC_FALSE;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_clone(akbasic_Value *self, akbasic_Value *dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL source in clone");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in clone");
|
||||
|
||||
if ( self == dest ) {
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
dest->valuetype = self->valuetype;
|
||||
memcpy(dest->stringval, self->stringval, sizeof(dest->stringval));
|
||||
dest->intval = self->intval;
|
||||
dest->floatval = self->floatval;
|
||||
dest->boolvalue = self->boolvalue;
|
||||
/* mutable_ is deliberately not copied: the reference's clone() does not. */
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_to_string(akbasic_Value *self, char *dest, size_t len)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in to_string");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in to_string");
|
||||
FAIL_ZERO_RETURN(errctx, (len > 0), AKBASIC_ERR_BOUNDS, "Zero-length destination in to_string");
|
||||
|
||||
switch ( self->valuetype ) {
|
||||
case AKBASIC_TYPE_STRING:
|
||||
snprintf(dest, len, "%s", self->stringval);
|
||||
break;
|
||||
case AKBASIC_TYPE_INTEGER:
|
||||
snprintf(dest, len, "%" PRId64, self->intval);
|
||||
break;
|
||||
case AKBASIC_TYPE_FLOAT:
|
||||
snprintf(dest, len, "%f", self->floatval);
|
||||
break;
|
||||
case AKBASIC_TYPE_BOOLEAN:
|
||||
/* Go's %t, which is "true"/"false" and not the numeric -1/0. */
|
||||
snprintf(dest, len, "%s", (self->boolvalue == AKBASIC_TRUE ? "true" : "false"));
|
||||
break;
|
||||
default:
|
||||
snprintf(dest, len, "(UNDEFINED STRING REPRESENTATION FOR %d)", (int)self->valuetype);
|
||||
break;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_set_bool(akbasic_Value *obj, bool result)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL value in set_bool");
|
||||
obj->valuetype = AKBASIC_TYPE_BOOLEAN;
|
||||
obj->boolvalue = (result ? AKBASIC_TRUE : AKBASIC_FALSE);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
bool akbasic_value_is_true(akbasic_Value *self)
|
||||
{
|
||||
if ( self == NULL || self->valuetype != AKBASIC_TYPE_BOOLEAN ) {
|
||||
return false;
|
||||
}
|
||||
return (self->boolvalue == AKBASIC_TRUE);
|
||||
}
|
||||
|
||||
/* Shared prologue for the unary operators: validate, clone into scratch. */
|
||||
static akerr_ErrorContext *unary_prologue(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in unary operation");
|
||||
FAIL_ZERO_RETURN(errctx, (scratch != NULL), AKERR_NULLPOINTER, "NULL scratch in unary operation");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in unary operation");
|
||||
PASS(errctx, akbasic_value_clone(self, scratch));
|
||||
*dest = scratch;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* Shared prologue for the binary operators: validate, clone into scratch. */
|
||||
static akerr_ErrorContext *binary_prologue(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in binary operation");
|
||||
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
|
||||
FAIL_ZERO_RETURN(errctx, (scratch != NULL), AKERR_NULLPOINTER, "NULL scratch in binary operation");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in binary operation");
|
||||
PASS(errctx, akbasic_value_clone(self, scratch));
|
||||
*dest = scratch;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_invert(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in invert");
|
||||
FAIL_NONZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_STRING),
|
||||
AKBASIC_ERR_TYPE, "Cannot invert a string");
|
||||
PASS(errctx, unary_prologue(self, scratch, dest));
|
||||
(*dest)->intval = -(self->intval);
|
||||
(*dest)->floatval = -(self->floatval);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_bitwise_not(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise not");
|
||||
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "Cannot only perform bitwise operations on integers");
|
||||
PASS(errctx, unary_prologue(self, scratch, dest));
|
||||
(*dest)->intval = ~(self->intval);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_shift_left(akbasic_Value *self, int64_t bits, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in shift left");
|
||||
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "Only integer datatypes can be bit-shifted");
|
||||
/*
|
||||
* Go's << on a negative or >=64 count is defined; C's is undefined. Refuse
|
||||
* rather than inherit the UB -- no golden case exercises it, so this cannot
|
||||
* change observed behaviour.
|
||||
*/
|
||||
FAIL_ZERO_RETURN(errctx, (bits >= 0 && bits < 64), AKBASIC_ERR_VALUE,
|
||||
"Shift count %" PRId64 " is out of range 0..63", bits);
|
||||
PASS(errctx, unary_prologue(self, scratch, dest));
|
||||
(*dest)->intval = (int64_t)((uint64_t)(*dest)->intval << bits);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_shift_right(akbasic_Value *self, int64_t bits, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in shift right");
|
||||
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "Only integer datatypes can be bit-shifted");
|
||||
FAIL_ZERO_RETURN(errctx, (bits >= 0 && bits < 64), AKBASIC_ERR_VALUE,
|
||||
"Shift count %" PRId64 " is out of range 0..63", bits);
|
||||
PASS(errctx, unary_prologue(self, scratch, dest));
|
||||
(*dest)->intval = (*dest)->intval >> bits;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_bitwise_and(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise and");
|
||||
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
|
||||
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "Cannot perform bitwise operations on string or float");
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
(*dest)->intval = self->intval & rval->intval;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_bitwise_or(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise or");
|
||||
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
|
||||
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "Can only perform bitwise operations on integers");
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
(*dest)->intval = self->intval | rval->intval;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_bitwise_xor(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise xor");
|
||||
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
|
||||
FAIL_ZERO_RETURN(errctx,
|
||||
(self->valuetype == AKBASIC_TYPE_INTEGER && rval->valuetype == AKBASIC_TYPE_INTEGER),
|
||||
AKBASIC_ERR_TYPE, "Can only perform bitwise operations on integers");
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
(*dest)->intval = self->intval ^ rval->intval;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_math_plus(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *out = NULL;
|
||||
char buf[AKBASIC_MAX_STRING_LENGTH * 2];
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in math plus");
|
||||
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
|
||||
FAIL_ZERO_RETURN(errctx, (scratch != NULL), AKERR_NULLPOINTER, "NULL scratch in math plus");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in math plus");
|
||||
|
||||
/*
|
||||
* The asymmetry with every other operator is deliberate and load-bearing:
|
||||
* mathPlus mutates self in place when self is mutable, and CommandNEXT's
|
||||
* loop increment relies on that to advance the loop variable. TODO.md
|
||||
* section 12 item 4.
|
||||
*/
|
||||
if ( !self->mutable_ ) {
|
||||
PASS(errctx, akbasic_value_clone(self, scratch));
|
||||
out = scratch;
|
||||
} else {
|
||||
out = self;
|
||||
}
|
||||
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
out->intval = self->intval + rval_as_int(rval);
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
out->floatval = self->floatval + rval_as_float(rval);
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_STRING && rval->valuetype == AKBASIC_TYPE_STRING ) {
|
||||
snprintf(buf, sizeof(buf), "%s%s", self->stringval, rval->stringval);
|
||||
PASS(errctx, set_string(out, buf));
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_STRING && rval->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
snprintf(buf, sizeof(buf), "%s%" PRId64, self->stringval, rval->intval);
|
||||
PASS(errctx, set_string(out, buf));
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_STRING && rval->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
snprintf(buf, sizeof(buf), "%s%f", self->stringval, rval->floatval);
|
||||
PASS(errctx, set_string(out, buf));
|
||||
} else {
|
||||
FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Invalid arithmetic operation");
|
||||
}
|
||||
*dest = out;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_math_minus(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
FAIL_NONZERO_RETURN(errctx,
|
||||
(self->valuetype == AKBASIC_TYPE_STRING || rval->valuetype == AKBASIC_TYPE_STRING),
|
||||
AKBASIC_ERR_TYPE, "Cannot perform subtraction on strings");
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
(*dest)->intval = self->intval - rval_as_int(rval);
|
||||
} else {
|
||||
(*dest)->floatval = self->floatval - rval_as_float(rval);
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_math_divide(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
FAIL_NONZERO_RETURN(errctx,
|
||||
(self->valuetype == AKBASIC_TYPE_STRING || rval->valuetype == AKBASIC_TYPE_STRING),
|
||||
AKBASIC_ERR_TYPE, "Cannot perform division on strings");
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
/*
|
||||
* Integer division by zero is UB in C where Go panics. Neither is
|
||||
* acceptable in a library, and no golden case divides by zero, so raise.
|
||||
*/
|
||||
FAIL_NONZERO_RETURN(errctx, (rval_as_int(rval) == 0), AKBASIC_ERR_VALUE,
|
||||
"DIVISION BY ZERO");
|
||||
(*dest)->intval = self->intval / rval_as_int(rval);
|
||||
} else {
|
||||
(*dest)->floatval = self->floatval / rval_as_float(rval);
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_math_multiply(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char buf[AKBASIC_MAX_STRING_LENGTH];
|
||||
int64_t i = 0;
|
||||
size_t srclen = 0;
|
||||
size_t offset = 0;
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
|
||||
if ( self->valuetype == AKBASIC_TYPE_STRING ) {
|
||||
FAIL_NONZERO_RETURN(errctx, (rval->valuetype == AKBASIC_TYPE_STRING),
|
||||
AKBASIC_ERR_TYPE, "String multiplication requires an integer multiple");
|
||||
/*
|
||||
* Go's strings.Repeat panics on a negative count. Refusing is strictly
|
||||
* better than either panicking or reading off the end of the buffer, and
|
||||
* no golden case does it.
|
||||
*/
|
||||
FAIL_NONZERO_RETURN(errctx, (rval->intval < 0), AKBASIC_ERR_VALUE,
|
||||
"String multiplier %" PRId64 " must not be negative", rval->intval);
|
||||
srclen = strlen((*dest)->stringval);
|
||||
FAIL_NONZERO_RETURN(errctx,
|
||||
(srclen != 0 && (uint64_t)rval->intval > (AKBASIC_MAX_STRING_LENGTH - 1) / srclen),
|
||||
AKBASIC_ERR_VALUE,
|
||||
"Repeated string of %zu x %" PRId64 " characters exceeds the %d character limit",
|
||||
srclen, rval->intval, AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
for ( i = 0; i < rval->intval; i++ ) {
|
||||
memcpy(buf + offset, (*dest)->stringval, srclen);
|
||||
offset += srclen;
|
||||
}
|
||||
buf[offset] = '\0';
|
||||
PASS(errctx, set_string(*dest, buf));
|
||||
}
|
||||
/*
|
||||
* Not an `else if`. The reference falls through to the numeric branches even
|
||||
* for a string, where self->floatval is 0 and the write is a harmless no-op.
|
||||
* Kept so the port is provably faithful.
|
||||
*/
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
(*dest)->intval = self->intval * rval_as_int(rval);
|
||||
} else {
|
||||
(*dest)->floatval = self->floatval * rval_as_float(rval);
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_less_than(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->intval < rval_as_int(rval)));
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval < rval_as_float(rval)));
|
||||
} else {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) < 0));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_less_than_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->intval <= rval_as_int(rval)));
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval <= rval_as_float(rval)));
|
||||
} else {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) <= 0));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_greater_than(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->intval > rval_as_int(rval)));
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval > rval_as_float(rval)));
|
||||
} else {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) > 0));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_greater_than_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->intval >= rval_as_int(rval)));
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval >= rval_as_float(rval)));
|
||||
} else {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) >= 0));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_is_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->intval == rval_as_int(rval)));
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval == rval_as_float(rval)));
|
||||
} else {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) == 0));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_value_is_not_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
PASS(errctx, binary_prologue(self, rval, scratch, dest));
|
||||
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->intval != rval_as_int(rval)));
|
||||
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval != rval_as_float(rval)));
|
||||
} else {
|
||||
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) != 0));
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
192
src/variable.c
Normal file
192
src/variable.c
Normal file
@@ -0,0 +1,192 @@
|
||||
/**
|
||||
* @file variable.c
|
||||
* @brief Implements the named variable slot and its subscript arithmetic.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/variable.h>
|
||||
|
||||
/*
|
||||
* Flatten a subscript list to an index, walking the dimensions from the last to
|
||||
* the first exactly as the reference does. The bounds message is reproduced
|
||||
* character for character: tests/language/array_outofbounds.txt compares it with
|
||||
* strcmp, so a reworded message is a failing golden case.
|
||||
*/
|
||||
static akerr_ErrorContext *flatten_subscripts(akbasic_Variable *obj, int64_t *subscripts, int subscriptcount, int64_t *dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int64_t flatindex = 0;
|
||||
int64_t multiplier = 1;
|
||||
int i = 0;
|
||||
|
||||
for ( i = subscriptcount - 1; i >= 0; i-- ) {
|
||||
FAIL_NONZERO_RETURN(errctx,
|
||||
(subscripts[i] < 0 || subscripts[i] >= obj->dimensions[i]),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Variable index access out of bounds at dimension %d: %" PRId64 " (max %" PRId64 ")",
|
||||
i, subscripts[i], obj->dimensions[i] - 1);
|
||||
flatindex += subscripts[i] * multiplier;
|
||||
multiplier *= obj->dimensions[i];
|
||||
}
|
||||
*dest = flatindex;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_variable_init(akbasic_Variable *obj, akbasic_ValuePool *pool, int64_t *sizes, int sizecount)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int64_t totalsize = 1;
|
||||
size_t namelen = 0;
|
||||
char lastchar = '\0';
|
||||
int i = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL variable in init");
|
||||
FAIL_ZERO_RETURN(errctx, (pool != NULL), AKERR_NULLPOINTER, "NULL value pool in variable init");
|
||||
FAIL_ZERO_RETURN(errctx, (sizes != NULL), AKERR_NULLPOINTER, "NULL sizes in variable init");
|
||||
FAIL_ZERO_RETURN(errctx, (sizecount > 0 && sizecount <= AKBASIC_MAX_ARRAY_DEPTH),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Array dimension count %d out of range 1..%d",
|
||||
sizecount, AKBASIC_MAX_ARRAY_DEPTH);
|
||||
|
||||
namelen = strlen(obj->name);
|
||||
FAIL_ZERO_RETURN(errctx, (namelen > 0), AKBASIC_ERR_VALUE, "Invalid variable name");
|
||||
|
||||
/* Type comes from the suffix. A bare name keeps whatever type it had. */
|
||||
lastchar = obj->name[namelen - 1];
|
||||
switch ( lastchar ) {
|
||||
case '$':
|
||||
obj->valuetype = AKBASIC_TYPE_STRING;
|
||||
break;
|
||||
case '#':
|
||||
obj->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
break;
|
||||
case '%':
|
||||
obj->valuetype = AKBASIC_TYPE_FLOAT;
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
|
||||
for ( i = 0; i < sizecount; i++ ) {
|
||||
FAIL_NONZERO_RETURN(errctx, (sizes[i] <= 0), AKBASIC_ERR_VALUE,
|
||||
"Array dimensions must be positive integers");
|
||||
FAIL_NONZERO_RETURN(errctx, (sizes[i] > AKBASIC_MAX_ARRAY_ELEMENTS),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Array dimension %d of %" PRId64 " exceeds the %d element limit",
|
||||
i, sizes[i], AKBASIC_MAX_ARRAY_ELEMENTS);
|
||||
totalsize *= sizes[i];
|
||||
FAIL_NONZERO_RETURN(errctx, (totalsize > AKBASIC_MAX_ARRAY_ELEMENTS),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Array of %" PRId64 " total elements exceeds the %d element limit",
|
||||
totalsize, AKBASIC_MAX_ARRAY_ELEMENTS);
|
||||
obj->dimensions[i] = sizes[i];
|
||||
}
|
||||
obj->dimensioncount = sizecount;
|
||||
|
||||
/*
|
||||
* Reuse the existing slice when it is already big enough. That makes a
|
||||
* re-DIM to the same or a smaller size free, which is the only re-DIM any
|
||||
* real program performs; growing takes fresh slots and abandons the old
|
||||
* ones, as documented on akbasic_ValuePool.
|
||||
*/
|
||||
if ( obj->values == NULL || obj->valuecount < (int)totalsize ) {
|
||||
PASS(errctx, akbasic_valuepool_take(pool, (int)totalsize, &obj->values));
|
||||
}
|
||||
obj->valuecount = (int)totalsize;
|
||||
|
||||
for ( i = 0; i < (int)totalsize; i++ ) {
|
||||
PASS(errctx, akbasic_value_init(&obj->values[i]));
|
||||
PASS(errctx, akbasic_value_zero(&obj->values[i]));
|
||||
obj->values[i].valuetype = obj->valuetype;
|
||||
obj->values[i].mutable_ = true;
|
||||
}
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_variable_zero(akbasic_Variable *obj)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL variable in zero");
|
||||
obj->valuetype = AKBASIC_TYPE_UNDEFINED;
|
||||
obj->mutable_ = true;
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_variable_get_subscript(akbasic_Variable *obj, int64_t *subscripts, int subscriptcount, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
int64_t index = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL variable in get_subscript");
|
||||
FAIL_ZERO_RETURN(errctx, (subscripts != NULL), AKERR_NULLPOINTER, "NULL subscripts in get_subscript");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in get_subscript");
|
||||
FAIL_ZERO_RETURN(errctx, (obj->values != NULL), AKERR_NULLPOINTER,
|
||||
"Variable %s has no storage", obj->name);
|
||||
FAIL_ZERO_RETURN(errctx, (subscriptcount == obj->dimensioncount),
|
||||
AKBASIC_ERR_BOUNDS,
|
||||
"Variable %s has %d dimensions, received %d",
|
||||
obj->name, obj->dimensioncount, subscriptcount);
|
||||
|
||||
PASS(errctx, flatten_subscripts(obj, subscripts, subscriptcount, &index));
|
||||
*dest = &obj->values[index];
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_variable_set_subscript(akbasic_Variable *obj, akbasic_Value *value, int64_t *subscripts, int subscriptcount)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value *slot = NULL;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (value != NULL), AKERR_NULLPOINTER, "NULL value in set_subscript");
|
||||
PASS(errctx, akbasic_variable_get_subscript(obj, subscripts, subscriptcount, &slot));
|
||||
PASS(errctx, akbasic_value_clone(value, slot));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_variable_set_integer(akbasic_Variable *obj, int64_t value, int64_t *subscripts, int subscriptcount)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value tmp;
|
||||
|
||||
PASS(errctx, akbasic_value_zero(&tmp));
|
||||
tmp.valuetype = AKBASIC_TYPE_INTEGER;
|
||||
tmp.intval = value;
|
||||
PASS(errctx, akbasic_variable_set_subscript(obj, &tmp, subscripts, subscriptcount));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_variable_set_float(akbasic_Variable *obj, double value, int64_t *subscripts, int subscriptcount)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value tmp;
|
||||
|
||||
PASS(errctx, akbasic_value_zero(&tmp));
|
||||
tmp.valuetype = AKBASIC_TYPE_FLOAT;
|
||||
tmp.floatval = value;
|
||||
PASS(errctx, akbasic_variable_set_subscript(obj, &tmp, subscripts, subscriptcount));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_variable_set_string(akbasic_Variable *obj, const char *value, int64_t *subscripts, int subscriptcount)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Value tmp;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (value != NULL), AKERR_NULLPOINTER, "NULL string in set_string");
|
||||
FAIL_ZERO_RETURN(errctx, (strlen(value) < AKBASIC_MAX_STRING_LENGTH),
|
||||
AKBASIC_ERR_VALUE,
|
||||
"String of %zu characters exceeds the %d character limit",
|
||||
strlen(value), AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
PASS(errctx, akbasic_value_zero(&tmp));
|
||||
tmp.valuetype = AKBASIC_TYPE_STRING;
|
||||
strncpy(tmp.stringval, value, AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
tmp.stringval[AKBASIC_MAX_STRING_LENGTH - 1] = '\0';
|
||||
PASS(errctx, akbasic_variable_set_subscript(obj, &tmp, subscripts, subscriptcount));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
135
src/verbs.c
Normal file
135
src/verbs.c
Normal file
@@ -0,0 +1,135 @@
|
||||
/**
|
||||
* @file verbs.c
|
||||
* @brief The dispatch table: every verb, function and reserved word in one place.
|
||||
*/
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/verbs.h>
|
||||
|
||||
#include "verbs.h"
|
||||
|
||||
/*
|
||||
* Sorted by name so bsearch() is valid -- tests/verbs_table.c asserts the
|
||||
* ordering, because a mis-sorted row silently becomes an unfindable verb rather
|
||||
* than a compile error.
|
||||
*
|
||||
* A NULL parse handler means the rval parses as a plain expression. A NULL exec
|
||||
* handler means the token is consumed by some other verb's parse handler and is
|
||||
* never evaluated on its own: ELSE, STEP, THEN and TO are all in that class, as
|
||||
* are the four reserved words, which exist here only so the scanner can give
|
||||
* them their token type.
|
||||
*
|
||||
* The reference bootstraps MOD, SPC and STR by running a BASIC program of DEF
|
||||
* statements through the interpreter at startup and keeping their expressions
|
||||
* (basicruntime_functions.go:14). That hack is not reproduced: they are ordinary
|
||||
* native handlers here, which removes the need to run the interpreter before the
|
||||
* interpreter is ready.
|
||||
*/
|
||||
static const akbasic_Verb VERBS[] = {
|
||||
/* name token type arity parse handler exec handler */
|
||||
{ "ABS", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_abs },
|
||||
{ "AND", AKBASIC_TOK_AND, -1, NULL, NULL },
|
||||
{ "ATN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_atn },
|
||||
{ "AUTO", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_auto },
|
||||
{ "CHR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_chr },
|
||||
{ "COS", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_cos },
|
||||
{ "DATA", AKBASIC_TOK_COMMAND, -1, akbasic_parse_data, akbasic_cmd_data },
|
||||
{ "DEF", AKBASIC_TOK_COMMAND, -1, akbasic_parse_def, akbasic_cmd_def },
|
||||
{ "DELETE", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_delete },
|
||||
{ "DIM", AKBASIC_TOK_COMMAND, -1, akbasic_parse_dim, akbasic_cmd_dim },
|
||||
{ "DLOAD", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_dload },
|
||||
{ "DSAVE", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_dsave },
|
||||
{ "ELSE", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
|
||||
{ "EXIT", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_exit },
|
||||
{ "FOR", AKBASIC_TOK_COMMAND, -1, akbasic_parse_for, akbasic_cmd_for },
|
||||
{ "GOSUB", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_gosub },
|
||||
{ "GOTO", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_goto },
|
||||
{ "HEX", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_hex },
|
||||
{ "IF", AKBASIC_TOK_COMMAND, -1, akbasic_parse_if, akbasic_cmd_if },
|
||||
{ "INPUT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_input, akbasic_cmd_input },
|
||||
{ "INSTR", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_instr },
|
||||
{ "LABEL", AKBASIC_TOK_COMMAND, -1, akbasic_parse_label, akbasic_cmd_label },
|
||||
{ "LEFT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_left },
|
||||
{ "LEN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_len },
|
||||
{ "LET", AKBASIC_TOK_COMMAND, -1, akbasic_parse_let, akbasic_cmd_let },
|
||||
{ "LIST", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_list },
|
||||
{ "LOG", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_log },
|
||||
{ "MID", AKBASIC_TOK_FUNCTION, 3, NULL, akbasic_fn_mid },
|
||||
{ "MOD", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_mod },
|
||||
{ "NEXT", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_next },
|
||||
{ "NOT", AKBASIC_TOK_NOT, -1, NULL, NULL },
|
||||
{ "OR", AKBASIC_TOK_OR, -1, NULL, NULL },
|
||||
{ "PEEK", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_peek },
|
||||
{ "POINTER", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_pointer },
|
||||
{ "POINTERVAR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_pointervar },
|
||||
{ "POKE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_poke, akbasic_cmd_poke },
|
||||
{ "PRINT", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_print },
|
||||
{ "QUIT", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_quit },
|
||||
{ "RAD", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rad },
|
||||
{ "READ", AKBASIC_TOK_COMMAND, -1, akbasic_parse_read, akbasic_cmd_read },
|
||||
{ "REM", AKBASIC_TOK_REM, -1, NULL, NULL },
|
||||
{ "RETURN", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_return },
|
||||
{ "RIGHT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_right },
|
||||
{ "RUN", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_run },
|
||||
{ "SGN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_sgn },
|
||||
{ "SHL", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_shl },
|
||||
{ "SHR", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_shr },
|
||||
{ "SIN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_sin },
|
||||
{ "SPC", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_spc },
|
||||
{ "STEP", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
|
||||
{ "STOP", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_stop },
|
||||
{ "STR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_str },
|
||||
{ "TAN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_tan },
|
||||
{ "THEN", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
|
||||
{ "TO", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
|
||||
{ "VAL", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_val },
|
||||
{ "XOR", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_xor },
|
||||
};
|
||||
|
||||
#define VERB_COUNT ((int)(sizeof(VERBS) / sizeof(VERBS[0])))
|
||||
|
||||
static int verb_compare(const void *key, const void *element)
|
||||
{
|
||||
const akbasic_Verb *verb = (const akbasic_Verb *)element;
|
||||
|
||||
return strcmp((const char *)key, verb->name);
|
||||
}
|
||||
|
||||
const akbasic_Verb *akbasic_verb_table(int *count)
|
||||
{
|
||||
if ( count != NULL ) {
|
||||
*count = VERB_COUNT;
|
||||
}
|
||||
return VERBS;
|
||||
}
|
||||
|
||||
akerr_ErrorContext *akbasic_verb_lookup(const char *name, const akbasic_Verb **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
char upper[AKBASIC_MAX_STRING_LENGTH];
|
||||
size_t i = 0;
|
||||
size_t len = 0;
|
||||
|
||||
FAIL_ZERO_RETURN(errctx, (name != NULL), AKERR_NULLPOINTER, "NULL name in verb lookup");
|
||||
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in verb lookup");
|
||||
|
||||
*dest = NULL;
|
||||
len = strlen(name);
|
||||
if ( len == 0 || len >= sizeof(upper) ) {
|
||||
/* Too long to be any verb we know. Not an error, just a miss. */
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
for ( i = 0; i < len; i++ ) {
|
||||
upper[i] = (char)toupper((unsigned char)name[i]);
|
||||
}
|
||||
upper[len] = '\0';
|
||||
|
||||
*dest = (const akbasic_Verb *)bsearch(upper, VERBS, VERB_COUNT, sizeof(VERBS[0]), verb_compare);
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
82
src/verbs.h
Normal file
82
src/verbs.h
Normal file
@@ -0,0 +1,82 @@
|
||||
/**
|
||||
* @file src/verbs.h
|
||||
* @brief Internal declarations of every parse and exec handler in the table.
|
||||
*
|
||||
* These are not part of the public API -- callers reach them only through the
|
||||
* dispatch table in src/verbs.c -- but they cannot be `static`, because the
|
||||
* table lives in one translation unit and the handlers live in three others.
|
||||
* This header keeps the declarations in one place so a signature cannot drift
|
||||
* from its definition.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_SRC_VERBS_H_
|
||||
#define _AKBASIC_SRC_VERBS_H_
|
||||
|
||||
#include <akbasic/verbs.h>
|
||||
|
||||
/* Parse handlers -- src/parser_commands.c */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_data(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_def(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_dim(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_for(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_if(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_input(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_label(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_let(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_poke(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_read(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
|
||||
|
||||
/* Verb handlers -- src/runtime_commands.c */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_auto(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_data(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_def(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_delete(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_dim(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_dload(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_dsave(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_exit(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_for(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_gosub(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_goto(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_if(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_input(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_label(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_let(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_list(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_next(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_poke(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_print(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_quit(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_read(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_return(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_run(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_stop(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
|
||||
/* Function handlers -- src/runtime_functions.c */
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_abs(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_atn(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_chr(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_cos(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_hex(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_instr(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_left(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_len(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_log(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_mid(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_mod(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_peek(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_pointer(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_pointervar(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_rad(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_right(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_sgn(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_shl(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_shr(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_sin(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_spc(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_str(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_tan(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_val(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_xor(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||
|
||||
#endif // _AKBASIC_SRC_VERBS_H_
|
||||
56
tests/convert.c
Normal file
56
tests/convert.c
Normal file
@@ -0,0 +1,56 @@
|
||||
/**
|
||||
* @file convert.c
|
||||
* @brief Tests the strict string-to-number converters.
|
||||
*
|
||||
* These exist because libakstdlib's aksl_ato* family cannot report a conversion
|
||||
* failure. Every assertion here is one that family would get wrong.
|
||||
*/
|
||||
|
||||
#include <errno.h>
|
||||
|
||||
#include <akbasic/convert.h>
|
||||
#include <akbasic/error.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
int main(void)
|
||||
{
|
||||
int64_t i = 0;
|
||||
double d = 0.0;
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
/* Valid decimal, hex and negative. */
|
||||
TEST_REQUIRE_OK(akbasic_str_to_int64("1234", 10, &i));
|
||||
TEST_REQUIRE_INT(i, 1234);
|
||||
TEST_REQUIRE_OK(akbasic_str_to_int64("0xff", 16, &i));
|
||||
TEST_REQUIRE_INT(i, 255);
|
||||
TEST_REQUIRE_OK(akbasic_str_to_int64("-256", 10, &i));
|
||||
TEST_REQUIRE_INT(i, -256);
|
||||
|
||||
/*
|
||||
* The whole point: aksl_atoi returns success with 0 for each of these.
|
||||
*/
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_int64("", 10, &i), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_int64("not a number", 10, &i), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_int64("12abc", 10, &i), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_int64("12 ", 10, &i), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_int64("99999999999999999999999", 10, &i), ERANGE);
|
||||
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_int64(NULL, 10, &i), AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_int64("1", 10, NULL), AKERR_NULLPOINTER);
|
||||
|
||||
/* Floats. */
|
||||
TEST_REQUIRE_OK(akbasic_str_to_double("123.456", &d));
|
||||
TEST_REQUIRE_FEQ(d, 123.456);
|
||||
TEST_REQUIRE_OK(akbasic_str_to_double("-2.5", &d));
|
||||
TEST_REQUIRE_FEQ(d, -2.5);
|
||||
TEST_REQUIRE_OK(akbasic_str_to_double("32", &d));
|
||||
TEST_REQUIRE_FEQ(d, 32.0);
|
||||
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_double("", &d), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_double("garbage", &d), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_STATUS(akbasic_str_to_double("1.5x", &d), AKBASIC_ERR_VALUE);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
100
tests/environment_scope.c
Normal file
100
tests/environment_scope.c
Normal file
@@ -0,0 +1,100 @@
|
||||
/**
|
||||
* @file environment_scope.c
|
||||
* @brief Tests scoping, label creation, the wait mechanism and pool release.
|
||||
*/
|
||||
|
||||
#include "harness.h"
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_Environment *root = NULL;
|
||||
akbasic_Environment *child = NULL;
|
||||
akbasic_Variable *variable = NULL;
|
||||
akbasic_Variable *again = NULL;
|
||||
akbasic_Value *value = NULL;
|
||||
int64_t lineno = 0;
|
||||
int i = 0;
|
||||
|
||||
TEST_REQUIRE_OK(harness_start(NULL));
|
||||
root = HARNESS_RUNTIME.environment;
|
||||
|
||||
/* The active environment auto-creates on a miss. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_get(root, "A#", &variable));
|
||||
TEST_REQUIRE(variable != NULL, "the active environment must auto-create a variable");
|
||||
TEST_REQUIRE_INT(variable->valuetype, AKBASIC_TYPE_INTEGER);
|
||||
|
||||
/* And the second lookup finds the same one. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_get(root, "A#", &again));
|
||||
TEST_REQUIRE(again == variable, "a repeat lookup must find the same variable");
|
||||
|
||||
/* A child sees its parent's variables. */
|
||||
TEST_REQUIRE_OK(akbasic_runtime_new_environment(&HARNESS_RUNTIME));
|
||||
child = HARNESS_RUNTIME.environment;
|
||||
TEST_REQUIRE(child->parent == root, "the child must chain to its parent");
|
||||
TEST_REQUIRE_OK(akbasic_environment_get(child, "A#", &again));
|
||||
TEST_REQUIRE(again == variable, "the child must see the parent's variable");
|
||||
|
||||
/*
|
||||
* A parent does not create variables on behalf of a child: looking up a
|
||||
* missing name in a non-active environment yields NULL without error.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_environment_get(root, "ZZ#", &again));
|
||||
TEST_REQUIRE(again == NULL, "a non-active environment must not auto-create");
|
||||
|
||||
/* Labels are created only at the top level, and are visible from below. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_set_label(child, "LOOPTOP", 30));
|
||||
TEST_REQUIRE_OK(akbasic_environment_get_label(child, "LOOPTOP", &lineno));
|
||||
TEST_REQUIRE_INT(lineno, 30);
|
||||
TEST_REQUIRE_STATUS(akbasic_environment_get_label(child, "MISSING", &lineno),
|
||||
AKBASIC_ERR_UNDEFINED);
|
||||
|
||||
/* Popping releases the environment back to the pool. */
|
||||
TEST_REQUIRE_OK(akbasic_runtime_prev_environment(&HARNESS_RUNTIME));
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.environment == root, "pop must restore the parent");
|
||||
TEST_REQUIRE(!child->used, "pop must release the environment to the pool");
|
||||
|
||||
/* The root has no parent to pop to. */
|
||||
TEST_REQUIRE_STATUS(akbasic_runtime_prev_environment(&HARNESS_RUNTIME),
|
||||
AKBASIC_ERR_ENVIRONMENT);
|
||||
|
||||
/* The wait mechanism, including the parent-chain search. */
|
||||
TEST_REQUIRE(!akbasic_environment_is_waiting_for_any(root), "a fresh environment waits for nothing");
|
||||
TEST_REQUIRE_OK(akbasic_environment_wait_for_command(root, "NEXT"));
|
||||
TEST_REQUIRE(akbasic_environment_is_waiting_for_any(root), "the wait must register");
|
||||
TEST_REQUIRE(akbasic_environment_is_waiting_for(root, "NEXT"), "the wait must match by name");
|
||||
TEST_REQUIRE(!akbasic_environment_is_waiting_for(root, "DATA"), "a different verb must not match");
|
||||
|
||||
/* Two pending waits in one environment is a hard error, not a panic. */
|
||||
TEST_REQUIRE_STATUS(akbasic_environment_wait_for_command(root, "DATA"), AKBASIC_ERR_STATE);
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_runtime_new_environment(&HARNESS_RUNTIME));
|
||||
child = HARNESS_RUNTIME.environment;
|
||||
TEST_REQUIRE(akbasic_environment_is_waiting_for(child, "NEXT"),
|
||||
"a child must see its parent's wait");
|
||||
TEST_REQUIRE_OK(akbasic_runtime_prev_environment(&HARNESS_RUNTIME));
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_environment_stop_waiting(root, "NEXT"));
|
||||
TEST_REQUIRE(!akbasic_environment_is_waiting_for_any(root), "stop_waiting must clear it");
|
||||
|
||||
/* The per-line value pool is bounded and says so. */
|
||||
for ( i = 0; i < AKBASIC_MAX_VALUES; i++ ) {
|
||||
TEST_REQUIRE_OK(akbasic_environment_new_value(root, &value));
|
||||
}
|
||||
TEST_REQUIRE_STATUS(akbasic_environment_new_value(root, &value), AKBASIC_ERR_BOUNDS);
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(root));
|
||||
TEST_REQUIRE_OK(akbasic_environment_new_value(root, &value));
|
||||
|
||||
/* So is the environment pool. */
|
||||
for ( i = 0; i < AKBASIC_MAX_ENVIRONMENTS - 1; i++ ) {
|
||||
TEST_REQUIRE_OK(akbasic_runtime_new_environment(&HARNESS_RUNTIME));
|
||||
}
|
||||
TEST_REQUIRE_STATUS(akbasic_runtime_new_environment(&HARNESS_RUNTIME),
|
||||
AKBASIC_ERR_ENVIRONMENT);
|
||||
for ( i = 0; i < AKBASIC_MAX_ENVIRONMENTS - 1; i++ ) {
|
||||
TEST_REQUIRE_OK(akbasic_runtime_prev_environment(&HARNESS_RUNTIME));
|
||||
}
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.environment == root, "the pool must unwind back to the root");
|
||||
|
||||
harness_stop();
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
50
tests/error_codes.c
Normal file
50
tests/error_codes.c
Normal file
@@ -0,0 +1,50 @@
|
||||
/**
|
||||
* @file error_codes.c
|
||||
* @brief Tests that akbasic owns its status band and has named every code in it.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
int main(void)
|
||||
{
|
||||
int code = 0;
|
||||
|
||||
/* Registering is idempotent: an identical repeat by the same owner is a no-op. */
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
/*
|
||||
* Every code must read back a real name. An unnamed one degrades to
|
||||
* "Unknown Error" in every stack trace that carries it, which nothing else
|
||||
* in the suite would notice.
|
||||
*/
|
||||
for ( code = AKBASIC_ERR_SYNTAX; code <= AKBASIC_ERR_STATE; code++ ) {
|
||||
const char *name = akerr_name_for_status(code, NULL);
|
||||
TEST_REQUIRE(name != NULL, "status %d has a NULL name", code);
|
||||
TEST_REQUIRE(strcmp(name, "Unknown Error") != 0,
|
||||
"status %d reads back as \"Unknown Error\"", code);
|
||||
}
|
||||
|
||||
TEST_REQUIRE_STR(akerr_name_for_status(AKBASIC_ERR_SYNTAX, NULL), "Syntax Error");
|
||||
TEST_REQUIRE_STR(akerr_name_for_status(AKBASIC_ERR_STATE, NULL), "State Error");
|
||||
|
||||
/*
|
||||
* The assertion that proves the range is actually ours rather than merely
|
||||
* unclaimed: a different owner must be refused.
|
||||
*/
|
||||
TEST_REQUIRE_STATUS(akerr_register_status_name("not-akbasic", AKBASIC_ERR_SYNTAX, "Hijacked"),
|
||||
AKERR_STATUS_NAME_FOREIGN);
|
||||
TEST_REQUIRE_STATUS(akerr_reserve_status_range(AKBASIC_ERR_BASE, 4, "not-akbasic"),
|
||||
AKERR_STATUS_RANGE_OVERLAP);
|
||||
|
||||
/* The band must sit clear of libakerror's reserved 0-255. */
|
||||
TEST_REQUIRE(AKBASIC_ERR_BASE >= AKERR_FIRST_CONSUMER_STATUS,
|
||||
"AKBASIC_ERR_BASE %d is inside libakerror's reserved band",
|
||||
AKBASIC_ERR_BASE);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
42
tests/golden.cmake
Normal file
42
tests/golden.cmake
Normal file
@@ -0,0 +1,42 @@
|
||||
# Golden-file driver: run one .bas through the interpreter and byte-compare
|
||||
# stdout against the sibling .txt.
|
||||
#
|
||||
# The comparison is on raw bytes, not lines: the reference's print pipeline emits
|
||||
# a trailing double newline on an error line (basicError builds a string ending
|
||||
# in \n and hands it to Println, which adds another), and that is part of the
|
||||
# contract. See TODO.md section 1.8.
|
||||
|
||||
if(NOT DEFINED BASIC OR NOT DEFINED CASE)
|
||||
message(FATAL_ERROR "golden.cmake requires -DBASIC=<interpreter> -DCASE=<file.bas>")
|
||||
endif()
|
||||
|
||||
string(REGEX REPLACE "\\.bas$" ".txt" EXPECTED "${CASE}")
|
||||
|
||||
if(NOT EXISTS "${EXPECTED}")
|
||||
message(FATAL_ERROR "No golden output beside ${CASE}")
|
||||
endif()
|
||||
|
||||
execute_process(
|
||||
COMMAND "${BASIC}" "${CASE}"
|
||||
OUTPUT_VARIABLE actual
|
||||
ERROR_VARIABLE stderr_text
|
||||
RESULT_VARIABLE rc
|
||||
)
|
||||
|
||||
if(NOT rc EQUAL 0)
|
||||
message(FATAL_ERROR "${CASE}: interpreter exited ${rc}\n${stderr_text}")
|
||||
endif()
|
||||
|
||||
file(READ "${EXPECTED}" expected)
|
||||
|
||||
if(NOT actual STREQUAL expected)
|
||||
# Write what we got beside the build so a failure can be diffed by hand.
|
||||
get_filename_component(_base "${CASE}" NAME)
|
||||
set(_dump "${CMAKE_CURRENT_BINARY_DIR}/${_base}.actual")
|
||||
file(WRITE "${_dump}" "${actual}")
|
||||
message(FATAL_ERROR
|
||||
"${CASE}: output does not match ${EXPECTED}\n"
|
||||
"--- expected ---\n${expected}\n"
|
||||
"--- actual ---\n${actual}\n"
|
||||
"(actual written to ${_dump})")
|
||||
endif()
|
||||
105
tests/grammar_leaves.c
Normal file
105
tests/grammar_leaves.c
Normal file
@@ -0,0 +1,105 @@
|
||||
/**
|
||||
* @file grammar_leaves.c
|
||||
* @brief Tests AST leaf construction, rendering and deep cloning.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/grammar.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
static akbasic_ASTLeaf LEAVES[8];
|
||||
static akbasic_ASTLeaf STORAGE[AKBASIC_MAX_LEAVES];
|
||||
static akbasic_LeafPool POOL;
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_ASTLeaf *copy = NULL;
|
||||
char rendered[AKBASIC_MAX_STRING_LENGTH];
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
POOL.next = 0;
|
||||
POOL.capacity = AKBASIC_MAX_LEAVES;
|
||||
POOL.leaves = STORAGE;
|
||||
|
||||
/* Literals render the way PRINT renders them. */
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_literal_int(&LEAVES[0], "42"));
|
||||
TEST_REQUIRE_INT(LEAVES[0].literal_int, 42);
|
||||
TEST_REQUIRE_OK(akbasic_leaf_to_string(&LEAVES[0], rendered, sizeof(rendered)));
|
||||
TEST_REQUIRE_STR(rendered, "42");
|
||||
|
||||
/* 0x is hex. */
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_literal_int(&LEAVES[1], "0xff"));
|
||||
TEST_REQUIRE_INT(LEAVES[1].literal_int, 255);
|
||||
|
||||
/*
|
||||
* A leading zero selects base 8, so 010 is 8 and 08 will not parse.
|
||||
* Commodore BASIC has no octal literals; this is TODO.md section 12 item 10,
|
||||
* reproduced deliberately and pinned here so the eventual fix is a
|
||||
* deliberate change to this assertion.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_literal_int(&LEAVES[1], "010"));
|
||||
TEST_REQUIRE_INT(LEAVES[1].literal_int, 8);
|
||||
TEST_REQUIRE_ANY_ERROR(akbasic_leaf_new_literal_int(&LEAVES[1], "08"));
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_literal_float(&LEAVES[2], "2.5"));
|
||||
TEST_REQUIRE_FEQ(LEAVES[2].literal_float, 2.5);
|
||||
TEST_REQUIRE_OK(akbasic_leaf_to_string(&LEAVES[2], rendered, sizeof(rendered)));
|
||||
TEST_REQUIRE_STR(rendered, "2.500000");
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_literal_string(&LEAVES[3], "HELLO"));
|
||||
TEST_REQUIRE_STR(LEAVES[3].literal_string, "HELLO");
|
||||
|
||||
/* Identifier predicates. */
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_identifier(&LEAVES[4], AKBASIC_LEAF_IDENTIFIER_INT, "A#"));
|
||||
TEST_REQUIRE(akbasic_leaf_is_identifier(&LEAVES[4]), "A# should be an identifier");
|
||||
TEST_REQUIRE(!akbasic_leaf_is_literal(&LEAVES[4]), "A# is not a literal");
|
||||
TEST_REQUIRE(akbasic_leaf_is_literal(&LEAVES[0]), "42 should be a literal");
|
||||
TEST_REQUIRE(!akbasic_leaf_is_identifier(NULL), "NULL is not an identifier");
|
||||
|
||||
/* Binary and unary render in prefix form. */
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_binary(&LEAVES[5], &LEAVES[4], AKBASIC_TOK_PLUS, &LEAVES[0]));
|
||||
TEST_REQUIRE_OK(akbasic_leaf_to_string(&LEAVES[5], rendered, sizeof(rendered)));
|
||||
TEST_REQUIRE_STR(rendered, "(+ A# 42)");
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_unary(&LEAVES[6], AKBASIC_TOK_MINUS, &LEAVES[0]));
|
||||
TEST_REQUIRE_OK(akbasic_leaf_to_string(&LEAVES[6], rendered, sizeof(rendered)));
|
||||
TEST_REQUIRE_STR(rendered, "(- 42)");
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_leaf_new_grouping(&LEAVES[7], &LEAVES[5]));
|
||||
TEST_REQUIRE_OK(akbasic_leaf_to_string(&LEAVES[7], rendered, sizeof(rendered)));
|
||||
TEST_REQUIRE_STR(rendered, "(group (+ A# 42))");
|
||||
|
||||
/* A deep clone copies the whole tree into pool storage. */
|
||||
TEST_REQUIRE_OK(akbasic_leaf_clone(&LEAVES[7], &POOL, ©));
|
||||
TEST_REQUIRE(copy != NULL && copy != &LEAVES[7], "clone must be a distinct leaf");
|
||||
TEST_REQUIRE(copy->expr != NULL && copy->expr != &LEAVES[5], "clone must be deep");
|
||||
TEST_REQUIRE(copy->expr->left != NULL && copy->expr->left != &LEAVES[4],
|
||||
"clone must recurse into .left");
|
||||
TEST_REQUIRE_OK(akbasic_leaf_to_string(copy, rendered, sizeof(rendered)));
|
||||
TEST_REQUIRE_STR(rendered, "(group (+ A# 42))");
|
||||
|
||||
/* Cloning NULL yields NULL, not an error: the reference does the same. */
|
||||
TEST_REQUIRE_OK(akbasic_leaf_clone(NULL, &POOL, ©));
|
||||
TEST_REQUIRE(copy == NULL, "cloning NULL must yield NULL");
|
||||
|
||||
/* Pool exhaustion is diagnosed, not a buffer overrun. */
|
||||
POOL.next = POOL.capacity;
|
||||
TEST_REQUIRE_STATUS(akbasic_leaf_clone(&LEAVES[7], &POOL, ©), AKBASIC_ERR_BOUNDS);
|
||||
|
||||
/* Constructors reject the nil arguments the reference rejects. */
|
||||
TEST_REQUIRE_STATUS(akbasic_leaf_new_binary(&LEAVES[0], NULL, AKBASIC_TOK_PLUS, &LEAVES[1]),
|
||||
AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(akbasic_leaf_new_unary(&LEAVES[0], AKBASIC_TOK_MINUS, NULL),
|
||||
AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(akbasic_leaf_new_grouping(&LEAVES[0], NULL), AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(akbasic_leaf_new_branch(&LEAVES[0], NULL, NULL, NULL), AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(akbasic_leaf_new_comparison(&LEAVES[0], &LEAVES[1], AKBASIC_TOK_PLUS,
|
||||
&LEAVES[2]),
|
||||
AKBASIC_ERR_SYNTAX);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
82
tests/harness.h
Normal file
82
tests/harness.h
Normal file
@@ -0,0 +1,82 @@
|
||||
/**
|
||||
* @file harness.h
|
||||
* @brief A runtime wired to memory buffers, for tests that need a live one.
|
||||
*
|
||||
* The runtime is `static` because it carries every pool the interpreter owns and
|
||||
* will not fit on a default stack -- the same reason the driver's main() does it.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_TEST_HARNESS_H_
|
||||
#define _AKBASIC_TEST_HARNESS_H_
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/parser.h>
|
||||
#include <akbasic/runtime.h>
|
||||
#include <akbasic/scanner.h>
|
||||
#include <akbasic/sink.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
static akbasic_Runtime HARNESS_RUNTIME;
|
||||
static akbasic_TextSink HARNESS_SINK;
|
||||
static akbasic_StdioSink HARNESS_SINKSTATE;
|
||||
static char HARNESS_OUTPUT[16384];
|
||||
static FILE *HARNESS_OUT;
|
||||
static FILE *HARNESS_IN;
|
||||
|
||||
/**
|
||||
* @brief Bring up a runtime whose output lands in HARNESS_OUTPUT.
|
||||
* @param input Text the sink will serve to readline; may be NULL for none.
|
||||
*/
|
||||
static akerr_ErrorContext AKERR_NOIGNORE *harness_start(const char *input)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
|
||||
memset(HARNESS_OUTPUT, 0, sizeof(HARNESS_OUTPUT));
|
||||
HARNESS_OUT = fmemopen(HARNESS_OUTPUT, sizeof(HARNESS_OUTPUT), "w");
|
||||
FAIL_ZERO_RETURN(errctx, (HARNESS_OUT != NULL), AKERR_IO, "could not open the output buffer");
|
||||
setvbuf(HARNESS_OUT, NULL, _IONBF, 0);
|
||||
|
||||
if ( input != NULL ) {
|
||||
HARNESS_IN = fmemopen((void *)(uintptr_t)input, strlen(input), "r");
|
||||
FAIL_ZERO_RETURN(errctx, (HARNESS_IN != NULL), AKERR_IO, "could not open the input buffer");
|
||||
} else {
|
||||
HARNESS_IN = fmemopen((void *)(uintptr_t)"", 0, "r");
|
||||
}
|
||||
|
||||
PASS(errctx, akbasic_sink_init_stdio(&HARNESS_SINK, &HARNESS_SINKSTATE, HARNESS_OUT, HARNESS_IN));
|
||||
PASS(errctx, akbasic_runtime_init(&HARNESS_RUNTIME, &HARNESS_SINK));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
__attribute__((unused))
|
||||
static void harness_stop(void)
|
||||
{
|
||||
if ( HARNESS_OUT != NULL ) {
|
||||
fclose(HARNESS_OUT);
|
||||
HARNESS_OUT = NULL;
|
||||
}
|
||||
if ( HARNESS_IN != NULL ) {
|
||||
fclose(HARNESS_IN);
|
||||
HARNESS_IN = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
/** @brief Scan and parse one line, yielding its first statement. */
|
||||
__attribute__((unused))
|
||||
static akerr_ErrorContext AKERR_NOIGNORE *harness_parse(const char *line, akbasic_ASTLeaf **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_Parser parser;
|
||||
|
||||
PASS(errctx, akbasic_scanner_zero(&HARNESS_RUNTIME));
|
||||
PASS(errctx, akbasic_scanner_scan(&HARNESS_RUNTIME, line, NULL, 0));
|
||||
PASS(errctx, akbasic_parser_init(&parser, &HARNESS_RUNTIME));
|
||||
PASS(errctx, akbasic_parser_parse(&parser, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
#endif // _AKBASIC_TEST_HARNESS_H_
|
||||
81
tests/known_reference_defects.c
Normal file
81
tests/known_reference_defects.c
Normal file
@@ -0,0 +1,81 @@
|
||||
/**
|
||||
* @file known_reference_defects.c
|
||||
* @brief Asserts the *correct* contract for defects carried over from the reference.
|
||||
*
|
||||
* Registered in AKBASIC_KNOWN_FAILING_TESTS, so CTest expects it to fail. Every
|
||||
* assertion here states what the interpreter *should* do, not what it currently
|
||||
* does -- pinning current-but-wrong behaviour would turn the eventual fix into a
|
||||
* test failure.
|
||||
*
|
||||
* When one of these is fixed, this test starts passing and CTest reports
|
||||
* "unexpectedly passed". That is the cue to split the fixed assertion out into
|
||||
* the corresponding suite in AKBASIC_TESTS and strike the item from TODO.md
|
||||
* section 12.
|
||||
*/
|
||||
|
||||
#include "harness.h"
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
char rendered[AKBASIC_MAX_STRING_LENGTH];
|
||||
|
||||
TEST_REQUIRE_OK(harness_start(NULL));
|
||||
|
||||
/*
|
||||
* 12.12 -- subtraction stops after one operator, so `1 - 2 - 3` parses as
|
||||
* `1 - 2` and abandons the rest of the line. It should fold left, the way
|
||||
* addition does.
|
||||
*/
|
||||
TEST_REQUIRE_OK(harness_parse("A# = 1 - 2 - 3", &leaf));
|
||||
TEST_REQUIRE_OK(akbasic_leaf_to_string(leaf, rendered, sizeof(rendered)));
|
||||
TEST_REQUIRE_STR(rendered, "( A# (- (- 1 2) 3))");
|
||||
|
||||
/*
|
||||
* 12.13 -- a unary-minus argument inflates the arity count, because the
|
||||
* counter walks .right and a unary leaf keeps its operand there. ABS(-9)
|
||||
* should be one argument.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(harness_parse("A# = ABS(-9)", &leaf));
|
||||
TEST_REQUIRE_OK(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 9);
|
||||
|
||||
/*
|
||||
* 12.14 -- a comparison operator in the final column of a line is dropped,
|
||||
* because matchNextChar returns without setting a token type when it cannot
|
||||
* peek past the end.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "A# =", NULL, 0));
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.environment->nexttoken, 2);
|
||||
|
||||
/*
|
||||
* 12.15 -- hex literals do not survive the scanner. matchNumber lets 'x'
|
||||
* through but not the digits after it, so the parser's base-16 branch is
|
||||
* unreachable.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT 0xff", NULL, 0));
|
||||
TEST_REQUIRE_STR(HARNESS_RUNTIME.environment->tokens[1].lexeme, "0xff");
|
||||
|
||||
/*
|
||||
* 12.16 -- "Reserved word in variable name" never fires, because the lexeme
|
||||
* still carries its type suffix when the verb table is searched. PRINT$
|
||||
* should be refused as a variable name.
|
||||
*/
|
||||
HARNESS_RUNTIME.hasError = false;
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT$ = 1", NULL, 0));
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.hasError, "PRINT$ should be refused as a variable name");
|
||||
|
||||
/*
|
||||
* 12.10 -- a leading zero selects base 8, so `PRINT 010` prints 8 and
|
||||
* `PRINT 08` will not parse. Commodore BASIC has no octal literals.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(harness_parse("A# = 010", &leaf));
|
||||
TEST_REQUIRE_OK(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 10);
|
||||
|
||||
harness_stop();
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
111
tests/parser_commands.c
Normal file
111
tests/parser_commands.c
Normal file
@@ -0,0 +1,111 @@
|
||||
/**
|
||||
* @file parser_commands.c
|
||||
* @brief Tests the verbs that carry their own parse path.
|
||||
*/
|
||||
|
||||
#include "harness.h"
|
||||
|
||||
static void expect_command(const char *line, akbasic_LeafType wanttype, const char *wantname)
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
akerr_ErrorContext *e = NULL;
|
||||
|
||||
e = harness_parse(line, &leaf);
|
||||
if ( e != NULL ) {
|
||||
fprintf(stderr, "FAIL: \"%s\" did not parse: %s\n", line, e->message);
|
||||
akbasic_test_failures += 1;
|
||||
test_discard_error(e);
|
||||
return;
|
||||
}
|
||||
TEST_REQUIRE(leaf != NULL, "\"%s\" produced no leaf", line);
|
||||
if ( leaf == NULL ) {
|
||||
return;
|
||||
}
|
||||
TEST_REQUIRE_INT(leaf->leaftype, wanttype);
|
||||
if ( wantname != NULL ) {
|
||||
TEST_REQUIRE_STR(leaf->identifier, wantname);
|
||||
}
|
||||
}
|
||||
|
||||
static void expect_parse_error(const char *line)
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
akerr_ErrorContext *e = NULL;
|
||||
|
||||
e = harness_parse(line, &leaf);
|
||||
TEST_REQUIRE(e != NULL, "\"%s\" should not have parsed", line);
|
||||
if ( e != NULL ) {
|
||||
test_discard_error(e);
|
||||
}
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
|
||||
TEST_REQUIRE_OK(harness_start(NULL));
|
||||
|
||||
/* Plain verbs with an expression rval. */
|
||||
expect_command("PRINT 1", AKBASIC_LEAF_COMMAND, "PRINT");
|
||||
expect_command("GOTO 100", AKBASIC_LEAF_COMMAND, "GOTO");
|
||||
expect_command("GOSUB 100", AKBASIC_LEAF_COMMAND, "GOSUB");
|
||||
|
||||
/* A verb with no rval at all must not fail. */
|
||||
expect_command("RETURN", AKBASIC_LEAF_COMMAND, "RETURN");
|
||||
expect_command("STOP", AKBASIC_LEAF_COMMAND, "STOP");
|
||||
|
||||
/* Immediate commands get their own leaf type. */
|
||||
expect_command("QUIT", AKBASIC_LEAF_COMMAND_IMMEDIATE, "QUIT");
|
||||
expect_command("LIST", AKBASIC_LEAF_COMMAND_IMMEDIATE, "LIST");
|
||||
expect_command("RUN", AKBASIC_LEAF_COMMAND_IMMEDIATE, "RUN");
|
||||
|
||||
/* Verbs with their own parse path. */
|
||||
expect_command("LABEL LOOPTOP", AKBASIC_LEAF_COMMAND, "LABEL");
|
||||
expect_command("DIM A#(5)", AKBASIC_LEAF_COMMAND, "DIM");
|
||||
expect_command("DATA 1, 2, 3", AKBASIC_LEAF_COMMAND, "DATA");
|
||||
expect_command("READ A#, B#", AKBASIC_LEAF_COMMAND, "READ");
|
||||
expect_command("POKE 100, 1", AKBASIC_LEAF_COMMAND, "POKE");
|
||||
expect_command("INPUT \"NAME? \" A$", AKBASIC_LEAF_COMMAND, "INPUT");
|
||||
|
||||
/* LET parses as a bare assignment. */
|
||||
expect_command("LET A# = 1", AKBASIC_LEAF_BINARY, NULL);
|
||||
|
||||
/* IF produces a BRANCH, not a COMMAND. */
|
||||
expect_command("IF 1 == 1 THEN PRINT 1", AKBASIC_LEAF_BRANCH, NULL);
|
||||
TEST_REQUIRE_OK(harness_parse("IF 1 == 1 THEN PRINT 1 ELSE PRINT 2", &leaf));
|
||||
TEST_REQUIRE(leaf != NULL && leaf->left != NULL && leaf->right != NULL,
|
||||
"IF ... THEN ... ELSE must fill both branches");
|
||||
|
||||
/* FOR installs a loop environment and returns the assignment. */
|
||||
{
|
||||
akbasic_Environment *before = HARNESS_RUNTIME.environment;
|
||||
TEST_REQUIRE_OK(harness_parse("FOR I# = 1 TO 5", &leaf));
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.environment != before,
|
||||
"FOR must install a new environment");
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.environment->forToLeaf != NULL,
|
||||
"FOR must record its TO expression");
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.environment->forStepLeaf != NULL,
|
||||
"FOR must default its STEP to 1");
|
||||
TEST_REQUIRE_OK(akbasic_runtime_prev_environment(&HARNESS_RUNTIME));
|
||||
}
|
||||
{
|
||||
akbasic_Environment *before = HARNESS_RUNTIME.environment;
|
||||
TEST_REQUIRE_OK(harness_parse("FOR I# = 1 TO 10 STEP 2", &leaf));
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.environment != before, "FOR STEP must install an environment");
|
||||
TEST_REQUIRE_OK(akbasic_runtime_prev_environment(&HARNESS_RUNTIME));
|
||||
}
|
||||
|
||||
/* Malformed FOR is rejected at parse time. */
|
||||
expect_parse_error("FOR I# = 1");
|
||||
expect_parse_error("FOR I# = 1 TO 5 STEP");
|
||||
expect_parse_error("FOR 1 TO 5");
|
||||
|
||||
/* Other malformed forms. */
|
||||
expect_parse_error("IF 1 == 1 PRINT 1");
|
||||
expect_parse_error("LABEL 5");
|
||||
expect_parse_error("READ 1");
|
||||
expect_parse_error("DATA A#");
|
||||
|
||||
harness_stop();
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
106
tests/parser_expressions.c
Normal file
106
tests/parser_expressions.c
Normal file
@@ -0,0 +1,106 @@
|
||||
/**
|
||||
* @file parser_expressions.c
|
||||
* @brief Tests the expression grammar via the leaf renderer.
|
||||
*/
|
||||
|
||||
#include "harness.h"
|
||||
|
||||
/* Parse a line and assert the shape of the tree it produced. */
|
||||
static void expect_tree(const char *line, const char *want)
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
char rendered[AKBASIC_MAX_STRING_LENGTH];
|
||||
akerr_ErrorContext *e = NULL;
|
||||
|
||||
e = harness_parse(line, &leaf);
|
||||
if ( e != NULL ) {
|
||||
fprintf(stderr, "FAIL: \"%s\" did not parse: %s\n", line, e->message);
|
||||
akbasic_test_failures += 1;
|
||||
test_discard_error(e);
|
||||
return;
|
||||
}
|
||||
e = akbasic_leaf_to_string(leaf, rendered, sizeof(rendered));
|
||||
if ( e != NULL ) {
|
||||
test_discard_error(e);
|
||||
akbasic_test_failures += 1;
|
||||
return;
|
||||
}
|
||||
TEST_REQUIRE(strcmp(rendered, want) == 0,
|
||||
"\"%s\": expected %s, got %s", line, want, rendered);
|
||||
}
|
||||
|
||||
static void expect_parse_error(const char *line)
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
akerr_ErrorContext *e = NULL;
|
||||
|
||||
e = harness_parse(line, &leaf);
|
||||
TEST_REQUIRE(e != NULL, "\"%s\" should not have parsed", line);
|
||||
if ( e != NULL ) {
|
||||
test_discard_error(e);
|
||||
}
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
|
||||
TEST_REQUIRE_OK(harness_start(NULL));
|
||||
|
||||
/*
|
||||
* An assignment renders with an empty operator: the reference's
|
||||
* operatorToStr() has a case for EQUAL but none for ASSIGNMENT, so it prints
|
||||
* "( A# ...)". Reproduced, so these expectations look odd on purpose.
|
||||
*/
|
||||
|
||||
/* Multiplication binds tighter than addition. */
|
||||
expect_tree("PRINT 1 + 2 * 3", "(PRINT)");
|
||||
expect_tree("A# = 1 + 2 * 3", "( A# (+ 1 (* 2 3)))");
|
||||
expect_tree("A# = 1 * 2 + 3", "( A# (+ (* 1 2) 3))");
|
||||
expect_tree("A# = 8 / 2 / 2", "( A# (/ (/ 8 2) 2))");
|
||||
|
||||
/* Grouping overrides precedence. */
|
||||
expect_tree("A# = (1 + 2) * 3", "( A# (* (group (+ 1 2)) 3))");
|
||||
|
||||
/* Unary minus and NOT. */
|
||||
expect_tree("A# = -5", "( A# (- 5))");
|
||||
expect_tree("A# = NOT 1", "( A# (NOT 1))");
|
||||
|
||||
/* Comparisons sit below the arithmetic. */
|
||||
expect_tree("A# = 1 + 1 == 2", "( A# (= (+ 1 1) 2))");
|
||||
expect_tree("A# = 1 <> 2", "( A# (<> 1 2))");
|
||||
|
||||
/* AND and OR sit below comparison. */
|
||||
expect_tree("A# = 1 == 1 AND 2 == 2", "( A# (AND (= 1 1) (= 2 2)))");
|
||||
|
||||
/* Exponent. */
|
||||
expect_tree("A# = 2 ^ 3", "( A# (^ 2 3))");
|
||||
|
||||
/*
|
||||
* Addition loops over its operator; subtraction returns after one. So
|
||||
* `1 + 2 + 3` folds left, while `1 - 2 - 3` parses only `1 - 2` and leaves
|
||||
* `- 3` in the token stream for the statement loop to pick up as a second
|
||||
* statement. That silently computes the wrong answer -- TODO.md section 12
|
||||
* item 12 -- and is pinned here so the fix is a deliberate change to this
|
||||
* assertion and not an accident.
|
||||
*/
|
||||
expect_tree("A# = 1 + 2 + 3", "( A# (+ (+ 1 2) 3))");
|
||||
expect_tree("A# = 1 - 2 - 3", "( A# (- 1 2))");
|
||||
|
||||
/* An array reference parses as an identifier carrying a subscript list. */
|
||||
TEST_REQUIRE_OK(harness_parse("A#(2) = 1", &leaf));
|
||||
TEST_REQUIRE(leaf != NULL && leaf->left != NULL, "assignment must have an lvalue");
|
||||
if ( leaf != NULL && leaf->left != NULL ) {
|
||||
TEST_REQUIRE_INT(leaf->left->leaftype, AKBASIC_LEAF_IDENTIFIER_INT);
|
||||
TEST_REQUIRE(akbasic_leaf_first_subscript(leaf->left) != NULL,
|
||||
"A#(2) must carry an array subscript");
|
||||
}
|
||||
|
||||
/* Failure paths. */
|
||||
expect_parse_error("A# = ");
|
||||
expect_parse_error("A# = (1 + 2");
|
||||
expect_parse_error("A# = *");
|
||||
|
||||
harness_stop();
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
143
tests/runtime_evaluate.c
Normal file
143
tests/runtime_evaluate.c
Normal file
@@ -0,0 +1,143 @@
|
||||
/**
|
||||
* @file runtime_evaluate.c
|
||||
* @brief Tests the evaluator against hand-built and hand-parsed trees.
|
||||
*/
|
||||
|
||||
#include "harness.h"
|
||||
|
||||
/* Parse an expression-bearing line and evaluate what it produced. */
|
||||
static akerr_ErrorContext AKERR_NOIGNORE *eval_line(const char *line, akbasic_Value **dest)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
|
||||
PASS(errctx, akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
PASS(errctx, harness_parse(line, &leaf));
|
||||
PASS(errctx, akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, dest));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
static void expect_int(const char *line, int64_t want)
|
||||
{
|
||||
akbasic_Value *out = NULL;
|
||||
akerr_ErrorContext *e = eval_line(line, &out);
|
||||
|
||||
if ( e != NULL ) {
|
||||
fprintf(stderr, "FAIL: \"%s\": %s\n", line, e->message);
|
||||
akbasic_test_failures += 1;
|
||||
test_discard_error(e);
|
||||
return;
|
||||
}
|
||||
TEST_REQUIRE(out->valuetype == AKBASIC_TYPE_INTEGER,
|
||||
"\"%s\" produced type %d, expected integer", line, (int)out->valuetype);
|
||||
TEST_REQUIRE(out->intval == want,
|
||||
"\"%s\" produced %lld, expected %lld",
|
||||
line, (long long)out->intval, (long long)want);
|
||||
}
|
||||
|
||||
static void expect_bool(const char *line, bool want)
|
||||
{
|
||||
akbasic_Value *out = NULL;
|
||||
akerr_ErrorContext *e = eval_line(line, &out);
|
||||
|
||||
if ( e != NULL ) {
|
||||
fprintf(stderr, "FAIL: \"%s\": %s\n", line, e->message);
|
||||
akbasic_test_failures += 1;
|
||||
test_discard_error(e);
|
||||
return;
|
||||
}
|
||||
TEST_REQUIRE(akbasic_value_is_true(out) == want,
|
||||
"\"%s\" expected %s", line, (want ? "true" : "false"));
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_Value *out = NULL;
|
||||
akerr_ErrorContext *e = NULL;
|
||||
|
||||
TEST_REQUIRE_OK(harness_start(NULL));
|
||||
|
||||
/* Literals and arithmetic. */
|
||||
expect_int("A# = 42", 42);
|
||||
expect_int("A# = 1 + 2 * 3", 7);
|
||||
expect_int("A# = (1 + 2) * 3", 9);
|
||||
expect_int("A# = -5 + 10", 5);
|
||||
expect_int("A# = 8 / 2", 4);
|
||||
|
||||
/* Identifiers read back what was assigned. */
|
||||
expect_int("A# = 7", 7);
|
||||
expect_int("B# = A# + 1", 8);
|
||||
|
||||
/*
|
||||
* Comparisons yield BASIC booleans. They are evaluated bare rather than
|
||||
* assigned: assign() accepts only INTEGER or FLOAT into a `#` variable, so
|
||||
* `A# = 1 == 1` is "Incompatible types in variable assignment" -- which is
|
||||
* also why IF works on the comparison directly and never through a variable.
|
||||
*
|
||||
* They are wrapped in parens because a bare leading integer in token
|
||||
* position 0 is consumed as a *line number*, not as a literal.
|
||||
*/
|
||||
expect_bool("(1 == 1)", true);
|
||||
expect_bool("(1 == 2)", false);
|
||||
expect_bool("(2 > 1)", true);
|
||||
expect_bool("(1 <> 2)", true);
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(eval_line("A# = 1 == 1", &out), AKBASIC_ERR_TYPE);
|
||||
|
||||
/* Bitwise operators. */
|
||||
expect_int("A# = 12 AND 10", 8);
|
||||
expect_int("A# = 12 OR 10", 14);
|
||||
|
||||
/* Arrays: assign through a subscript and read it back. */
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(harness_parse("DIM C#(4)", &leaf));
|
||||
TEST_REQUIRE_OK(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out));
|
||||
}
|
||||
expect_int("C#(2) = 99", 99);
|
||||
expect_int("D# = C#(2)", 99);
|
||||
expect_int("D# = C#(0)", 0);
|
||||
|
||||
/* An out-of-bounds subscript raises with the reference's message. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
e = eval_line("D# = C#(9)", &out);
|
||||
TEST_REQUIRE(e != NULL, "an out-of-bounds read must raise");
|
||||
if ( e != NULL ) {
|
||||
TEST_REQUIRE_STR(e->message,
|
||||
"Variable index access out of bounds at dimension 0: 9 (max 3)");
|
||||
test_discard_error(e);
|
||||
}
|
||||
|
||||
/*
|
||||
* Built-in functions dispatch through the table.
|
||||
*
|
||||
* Note the arguments are never negative *literals*: a unary-minus leaf uses
|
||||
* its .right for the operand, and the parser counts arity by walking .right,
|
||||
* so `ABS(-9)` reports two arguments and is rejected. TODO.md section 12
|
||||
* item 13. The golden corpus sidesteps it the same way -- sgn.bas assigns
|
||||
* -1 to a variable first.
|
||||
*/
|
||||
expect_int("N# = -9", -9);
|
||||
expect_int("A# = ABS(N#)", 9);
|
||||
expect_int("A# = SGN(N#)", -1);
|
||||
expect_int("A# = LEN(\"HELLO\")", 5);
|
||||
expect_int("A# = SHL(1, 4)", 16);
|
||||
expect_int("A# = SHR(16, 4)", 1);
|
||||
expect_int("A# = XOR(12, 10)", 6);
|
||||
expect_int("A# = MOD(7, 3)", 1);
|
||||
expect_int("A# = INSTR(\"HELLO\", \"LL\")", 2);
|
||||
expect_int("A# = INSTR(\"HELLO\", \"ZZ\")", -1);
|
||||
|
||||
/* An unknown verb is diagnosed rather than silently ignored. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, NULL, &out),
|
||||
AKERR_NULLPOINTER);
|
||||
|
||||
/* A label resolves to its line number through a bare identifier. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_set_label(HARNESS_RUNTIME.environment, "TOP", 30));
|
||||
expect_int("A# = TOP", 30);
|
||||
|
||||
harness_stop();
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
245
tests/runtime_verbs.c
Normal file
245
tests/runtime_verbs.c
Normal file
@@ -0,0 +1,245 @@
|
||||
/**
|
||||
* @file runtime_verbs.c
|
||||
* @brief Tests the verbs the golden corpus never reaches.
|
||||
*
|
||||
* LIST, DELETE, AUTO, INPUT, DLOAD, DSAVE, EXIT, STOP and the memory verbs are
|
||||
* all real code with no `.bas`/`.txt` pair behind them, because the reference's
|
||||
* own corpus never exercises them either. They are driven through a whole
|
||||
* runtime here rather than unit-tested in pieces: most of them exist to mutate
|
||||
* runtime state, and that is the thing worth asserting.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#include "harness.h"
|
||||
|
||||
/* Run one line as though it had been typed at the REPL. */
|
||||
static akerr_ErrorContext AKERR_NOIGNORE *run_line(const char *line)
|
||||
{
|
||||
PREPARE_ERROR(errctx);
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
PASS(errctx, akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
PASS(errctx, harness_parse(line, &leaf));
|
||||
PASS(errctx, akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out));
|
||||
SUCCEED_RETURN(errctx);
|
||||
}
|
||||
|
||||
/* Load a program into the source table the way RUNSTREAM would. */
|
||||
static void load(const char *lines[], int count)
|
||||
{
|
||||
char scanned[AKBASIC_MAX_LINE_LENGTH];
|
||||
int i = 0;
|
||||
|
||||
for ( i = 0; i < count; i++ ) {
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, lines[i], scanned, sizeof(scanned)));
|
||||
TEST_REQUIRE_OK(akbasic_runtime_store_line(&HARNESS_RUNTIME,
|
||||
HARNESS_RUNTIME.environment->lineno, scanned));
|
||||
}
|
||||
}
|
||||
|
||||
static void clear_output(void)
|
||||
{
|
||||
memset(HARNESS_OUTPUT, 0, sizeof(HARNESS_OUTPUT));
|
||||
rewind(HARNESS_OUT);
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
static const char *PROGRAM[] = {
|
||||
"10 PRINT \"ONE\"",
|
||||
"20 PRINT \"TWO\"",
|
||||
"30 PRINT \"THREE\"",
|
||||
};
|
||||
char tmpname[] = "/tmp/akbasic_dsave_XXXXXX";
|
||||
char buffer[256];
|
||||
akbasic_Value *out = NULL;
|
||||
FILE *saved = NULL;
|
||||
int fd = -1;
|
||||
|
||||
TEST_REQUIRE_OK(harness_start("42\n"));
|
||||
|
||||
/* PRINT with no argument emits a bare newline. */
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("PRINT"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT, "\n");
|
||||
|
||||
/*
|
||||
* LET does nothing; the assignment already happened during evaluation. A
|
||||
* bare LET with no assignment after it is a parse error, in the reference
|
||||
* too -- its parse path is just assignment(), which needs an expression.
|
||||
*/
|
||||
TEST_REQUIRE_OK(run_line("LET A# = 5"));
|
||||
TEST_REQUIRE_ANY_ERROR(run_line("LET"));
|
||||
|
||||
/* LIST prints the program with its line numbers restored. */
|
||||
load(PROGRAM, 3);
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("LIST"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT,
|
||||
"10 PRINT \"ONE\"\n20 PRINT \"TWO\"\n30 PRINT \"THREE\"\n");
|
||||
|
||||
/* LIST n lists from n to the end. */
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("LIST 20"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT, "20 PRINT \"TWO\"\n30 PRINT \"THREE\"\n");
|
||||
|
||||
/* LIST -n lists from the start through n. */
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("LIST -20"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT, "10 PRINT \"ONE\"\n20 PRINT \"TWO\"\n");
|
||||
|
||||
/* LIST n-n lists an inclusive range. */
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("LIST 20-30"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT, "20 PRINT \"TWO\"\n30 PRINT \"THREE\"\n");
|
||||
|
||||
/* DSAVE writes the program out; DLOAD reads it back. */
|
||||
fd = mkstemp(tmpname);
|
||||
TEST_REQUIRE(fd >= 0, "could not create a temporary file");
|
||||
if ( fd >= 0 ) {
|
||||
close(fd);
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
snprintf(buffer, sizeof(buffer), "DSAVE \"%s\"", tmpname);
|
||||
TEST_REQUIRE_OK(run_line(buffer));
|
||||
|
||||
saved = fopen(tmpname, "r");
|
||||
TEST_REQUIRE(saved != NULL, "DSAVE produced no file");
|
||||
if ( saved != NULL ) {
|
||||
TEST_REQUIRE(fgets(buffer, sizeof(buffer), saved) != NULL, "DSAVE wrote nothing");
|
||||
TEST_REQUIRE_STR(buffer, "10 PRINT \"ONE\"\n");
|
||||
fclose(saved);
|
||||
}
|
||||
|
||||
/* DELETE with no range clears the whole program. */
|
||||
TEST_REQUIRE_OK(run_line("DELETE"));
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("LIST"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT, "");
|
||||
|
||||
/* DLOAD brings it back. */
|
||||
snprintf(buffer, sizeof(buffer), "DLOAD \"%s\"", tmpname);
|
||||
TEST_REQUIRE_OK(run_line(buffer));
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("LIST"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT,
|
||||
"10 PRINT \"ONE\"\n20 PRINT \"TWO\"\n30 PRINT \"THREE\"\n");
|
||||
remove(tmpname);
|
||||
}
|
||||
|
||||
/* DELETE n-n removes an inclusive range. */
|
||||
TEST_REQUIRE_OK(run_line("DELETE 20-30"));
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("LIST"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT, "10 PRINT \"ONE\"\n");
|
||||
|
||||
/* A missing file is an error, not a crash. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_ANY_ERROR(run_line("DLOAD \"/nonexistent/akbasic/nope.bas\""));
|
||||
|
||||
/* An empty filename is refused before it reaches aksl_fopen. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(run_line("DLOAD \"\""), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(run_line("DLOAD 5"), AKBASIC_ERR_TYPE);
|
||||
|
||||
/* AUTO sets and clears the line-numbering increment. */
|
||||
TEST_REQUIRE_OK(run_line("AUTO 10"));
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.autoLineNumber, 10);
|
||||
TEST_REQUIRE_OK(run_line("AUTO"));
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.autoLineNumber, 0);
|
||||
|
||||
/* INPUT prompts and stores. The harness input stream holds "42". */
|
||||
clear_output();
|
||||
TEST_REQUIRE_OK(run_line("INPUT \"AGE? \" N#"));
|
||||
TEST_REQUIRE_STR(HARNESS_OUTPUT, "AGE? ");
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
{
|
||||
akbasic_ASTLeaf *leaf = NULL;
|
||||
TEST_REQUIRE_OK(harness_parse("A# = N#", &leaf));
|
||||
TEST_REQUIRE_OK(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 42);
|
||||
}
|
||||
|
||||
/* Mode transitions. */
|
||||
TEST_REQUIRE_OK(run_line("STOP"));
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.mode, AKBASIC_MODE_REPL);
|
||||
TEST_REQUIRE_OK(run_line("RUN"));
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.mode, AKBASIC_MODE_RUN);
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.environment->nextline, 0);
|
||||
TEST_REQUIRE_OK(run_line("RUN 20"));
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.environment->nextline, 20);
|
||||
|
||||
/*
|
||||
* QUIT sets a mode. It must not call exit(): a host game decides what
|
||||
* quitting means, and this test would not survive it doing otherwise.
|
||||
*/
|
||||
TEST_REQUIRE_OK(run_line("QUIT"));
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.mode, AKBASIC_MODE_QUIT);
|
||||
TEST_REQUIRE_OK(akbasic_runtime_set_mode(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));
|
||||
|
||||
/* State errors: verbs used outside the structure they need. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(run_line("RETURN"), AKBASIC_ERR_STATE);
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(run_line("EXIT"), AKBASIC_ERR_STATE);
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(run_line("NEXT I#"), AKBASIC_ERR_STATE);
|
||||
|
||||
/* GOTO and GOSUB want an integer. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(run_line("GOTO \"nope\""), AKBASIC_ERR_TYPE);
|
||||
|
||||
/* GOTO sets the next line. */
|
||||
TEST_REQUIRE_OK(run_line("GOTO 30"));
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.environment->nextline, 30);
|
||||
|
||||
/* GOSUB pushes an environment; RETURN pops it and restores the line. */
|
||||
{
|
||||
akbasic_Environment *before = HARNESS_RUNTIME.environment;
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(before));
|
||||
before->lineno = 100;
|
||||
TEST_REQUIRE_OK(run_line("GOSUB 500"));
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.environment != before, "GOSUB must push an environment");
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.environment->nextline, 500);
|
||||
TEST_REQUIRE_INT(HARNESS_RUNTIME.environment->gosubReturnLine, 101);
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(run_line("RETURN"));
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.environment == before, "RETURN must pop back");
|
||||
TEST_REQUIRE_INT(before->nextline, 101);
|
||||
}
|
||||
|
||||
/* LABEL records the current line under a name. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
HARNESS_RUNTIME.environment->lineno = 70;
|
||||
TEST_REQUIRE_OK(run_line("LABEL AGAIN"));
|
||||
{
|
||||
int64_t where = 0;
|
||||
TEST_REQUIRE_OK(akbasic_environment_get_label(HARNESS_RUNTIME.environment, "AGAIN", &where));
|
||||
TEST_REQUIRE_INT(where, 70);
|
||||
}
|
||||
|
||||
/* POKE, PEEK and POINTER round-trip through real memory. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(run_line("V# = 255"));
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(run_line("P# = POINTER(V#)"));
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(run_line("Q# = PEEK(P#)"));
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(run_line("POKE P#, 127"));
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(run_line("R# = POINTERVAR(V#)"));
|
||||
|
||||
/* PEEK through a null address is refused rather than segfaulting. */
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_OK(run_line("Z# = 0"));
|
||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||
TEST_REQUIRE_STATUS(run_line("Y# = PEEK(Z#)"), AKBASIC_ERR_VALUE);
|
||||
|
||||
harness_stop();
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
158
tests/scanner_tokens.c
Normal file
158
tests/scanner_tokens.c
Normal file
@@ -0,0 +1,158 @@
|
||||
/**
|
||||
* @file scanner_tokens.c
|
||||
* @brief Tests the line tokenizer.
|
||||
*/
|
||||
|
||||
#include "harness.h"
|
||||
|
||||
static akbasic_Environment *env(void)
|
||||
{
|
||||
return HARNESS_RUNTIME.environment;
|
||||
}
|
||||
|
||||
/* Scan a line and assert the token type at a given index. */
|
||||
static void expect_token(int index, akbasic_TokenType want, const char *lexeme)
|
||||
{
|
||||
TEST_REQUIRE(index < env()->nexttoken,
|
||||
"expected a token at index %d, only %d were produced",
|
||||
index, env()->nexttoken);
|
||||
if ( index >= env()->nexttoken ) {
|
||||
return;
|
||||
}
|
||||
TEST_REQUIRE_INT(env()->tokens[index].tokentype, want);
|
||||
if ( lexeme != NULL ) {
|
||||
TEST_REQUIRE_STR(env()->tokens[index].lexeme, lexeme);
|
||||
}
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
char rewritten[AKBASIC_MAX_LINE_LENGTH];
|
||||
|
||||
TEST_REQUIRE_OK(harness_start(NULL));
|
||||
|
||||
/* Single-character operators. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "+-*/^(),", NULL, 0));
|
||||
TEST_REQUIRE_INT(env()->nexttoken, 8);
|
||||
expect_token(0, AKBASIC_TOK_PLUS, "+");
|
||||
expect_token(1, AKBASIC_TOK_MINUS, "-");
|
||||
expect_token(2, AKBASIC_TOK_STAR, "*");
|
||||
expect_token(3, AKBASIC_TOK_LEFT_SLASH, "/");
|
||||
expect_token(4, AKBASIC_TOK_CARAT, "^");
|
||||
expect_token(5, AKBASIC_TOK_LEFT_PAREN, "(");
|
||||
expect_token(6, AKBASIC_TOK_RIGHT_PAREN, ")");
|
||||
expect_token(7, AKBASIC_TOK_COMMA, ",");
|
||||
|
||||
/*
|
||||
* Two-character comparisons, and the one-character fallbacks. The trailing
|
||||
* space is not decoration: matchNextChar cannot peek past the end of the
|
||||
* line, and when it fails it returns without setting a token type, so a
|
||||
* comparison operator in the final column is silently dropped. TODO.md
|
||||
* section 12 item 14.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "<= <> >= < > == = ", NULL, 0));
|
||||
TEST_REQUIRE_INT(env()->nexttoken, 7);
|
||||
expect_token(0, AKBASIC_TOK_LESS_THAN_EQUAL, NULL);
|
||||
expect_token(1, AKBASIC_TOK_NOT_EQUAL, NULL);
|
||||
expect_token(2, AKBASIC_TOK_GREATER_THAN_EQUAL, NULL);
|
||||
expect_token(3, AKBASIC_TOK_LESS_THAN, NULL);
|
||||
expect_token(4, AKBASIC_TOK_GREATER_THAN, NULL);
|
||||
expect_token(5, AKBASIC_TOK_EQUAL, NULL);
|
||||
expect_token(6, AKBASIC_TOK_ASSIGNMENT, NULL);
|
||||
|
||||
/* Without the trailing space the final operator vanishes. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "A# =", NULL, 0));
|
||||
TEST_REQUIRE_INT(env()->nexttoken, 1);
|
||||
|
||||
/* Literals. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT 1.5", NULL, 0));
|
||||
expect_token(0, AKBASIC_TOK_COMMAND, "PRINT");
|
||||
expect_token(1, AKBASIC_TOK_LITERAL_FLOAT, "1.5");
|
||||
|
||||
/*
|
||||
* A hex literal does not survive the scanner: matchNumber allows 'x' through
|
||||
* but not the hex digits after it, so "0xff" lexes as "0x" and the "ff" is
|
||||
* scanned as an identifier. The parser's base-16 branch is therefore
|
||||
* unreachable. TODO.md section 12 item 15.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT 0xff", NULL, 0));
|
||||
expect_token(1, AKBASIC_TOK_LITERAL_INT, "0x");
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT \"HELLO\"", NULL, 0));
|
||||
expect_token(1, AKBASIC_TOK_LITERAL_STRING, "HELLO");
|
||||
|
||||
/* An empty string literal really is empty, not a stray quote. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT \"\"", NULL, 0));
|
||||
expect_token(1, AKBASIC_TOK_LITERAL_STRING, "");
|
||||
|
||||
/* Identifier suffixes pick the token type. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "A# B% C$ D", NULL, 0));
|
||||
expect_token(0, AKBASIC_TOK_IDENTIFIER_INT, "A#");
|
||||
expect_token(1, AKBASIC_TOK_IDENTIFIER_FLOAT, "B%");
|
||||
expect_token(2, AKBASIC_TOK_IDENTIFIER_STRING, "C$");
|
||||
expect_token(3, AKBASIC_TOK_IDENTIFIER, "D");
|
||||
|
||||
/* Verbs are case-insensitive; a variable is not a verb. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "print goto", NULL, 0));
|
||||
expect_token(0, AKBASIC_TOK_COMMAND, "print");
|
||||
expect_token(1, AKBASIC_TOK_COMMAND, "goto");
|
||||
|
||||
/* Reserved words get their own token types, not COMMAND. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "A# AND B# OR NOT C#", NULL, 0));
|
||||
expect_token(1, AKBASIC_TOK_AND, NULL);
|
||||
expect_token(3, AKBASIC_TOK_OR, NULL);
|
||||
expect_token(4, AKBASIC_TOK_NOT, NULL);
|
||||
|
||||
/*
|
||||
* The line-number rule: an integer in token position 0 is consumed, not
|
||||
* emitted, and the line is rewritten to what follows it with leading spaces
|
||||
* stripped. The REPL stores the rewritten line as the program text, so this
|
||||
* is load-bearing rather than cosmetic.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "10 PRINT 1", rewritten, sizeof(rewritten)));
|
||||
TEST_REQUIRE_STR(rewritten, "PRINT 1");
|
||||
TEST_REQUIRE_INT(env()->lineno, 10);
|
||||
expect_token(0, AKBASIC_TOK_COMMAND, "PRINT");
|
||||
expect_token(1, AKBASIC_TOK_LITERAL_INT, "1");
|
||||
|
||||
/* An integer that is *not* in position 0 stays a literal. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT 10", NULL, 0));
|
||||
expect_token(1, AKBASIC_TOK_LITERAL_INT, "10");
|
||||
|
||||
/* REM ends the line: nothing after it becomes a token. */
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "REM PRINT \"NOT SEEN\"", NULL, 0));
|
||||
TEST_REQUIRE_INT(env()->nexttoken, 0);
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "10 REM A COMMENT", NULL, 0));
|
||||
TEST_REQUIRE_INT(env()->nexttoken, 0);
|
||||
TEST_REQUIRE_INT(env()->lineno, 10);
|
||||
|
||||
/*
|
||||
* The "Reserved word in variable name" check never fires: the lexeme still
|
||||
* carries its suffix when the verb table is searched, so "PRINT$" misses and
|
||||
* becomes an ordinary string variable. Pinned as it stands -- TODO.md
|
||||
* section 12 item 16.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT$ = 1", NULL, 0));
|
||||
TEST_REQUIRE(!HARNESS_RUNTIME.hasError,
|
||||
"PRINT$ is currently accepted as a variable name; see TODO.md 12.16");
|
||||
expect_token(0, AKBASIC_TOK_IDENTIFIER_STRING, "PRINT$");
|
||||
|
||||
/* An unknown character is diagnosed. */
|
||||
HARNESS_RUNTIME.hasError = false;
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "PRINT ~", NULL, 0));
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.hasError, "an unknown token must be diagnosed");
|
||||
|
||||
/* A malformed number is diagnosed rather than silently becoming zero. */
|
||||
HARNESS_RUNTIME.hasError = false;
|
||||
TEST_REQUIRE_OK(akbasic_scanner_scan(&HARNESS_RUNTIME, "1x2 PRINT 1", NULL, 0));
|
||||
TEST_REQUIRE(HARNESS_RUNTIME.hasError,
|
||||
"a malformed line number must be diagnosed, not converted to 0");
|
||||
TEST_REQUIRE(strstr(HARNESS_OUTPUT, "INTEGER CONVERSION ON '1x2'") != NULL,
|
||||
"expected the reference's conversion message, got: %s", HARNESS_OUTPUT);
|
||||
|
||||
TEST_REQUIRE_STATUS(akbasic_scanner_scan(&HARNESS_RUNTIME, NULL, NULL, 0), AKERR_NULLPOINTER);
|
||||
|
||||
harness_stop();
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
78
tests/sink_stdio.c
Normal file
78
tests/sink_stdio.c
Normal file
@@ -0,0 +1,78 @@
|
||||
/**
|
||||
* @file sink_stdio.c
|
||||
* @brief Tests the stdio sink, byte for byte.
|
||||
*
|
||||
* The double newline on an error line is the assertion that matters: the caller's
|
||||
* message already ends in \n and writeln adds another, and
|
||||
* tests/language/array_outofbounds.txt ends in 0a 0a because of it. See TODO.md
|
||||
* section 1.8.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/sink.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
static char OUTPUT[1024];
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_TextSink sink;
|
||||
akbasic_StdioSink state;
|
||||
FILE *out = NULL;
|
||||
FILE *in = NULL;
|
||||
char line[64];
|
||||
bool eof = false;
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
memset(OUTPUT, 0, sizeof(OUTPUT));
|
||||
out = fmemopen(OUTPUT, sizeof(OUTPUT), "w");
|
||||
TEST_REQUIRE(out != NULL, "could not open the output buffer");
|
||||
setvbuf(out, NULL, _IONBF, 0);
|
||||
in = fmemopen((void *)(uintptr_t)"first\nsecond\n", 13, "r");
|
||||
TEST_REQUIRE(in != NULL, "could not open the input buffer");
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_sink_init_stdio(&sink, &state, out, in));
|
||||
|
||||
/* write adds nothing; writeln adds exactly one newline. */
|
||||
TEST_REQUIRE_OK(sink.write(&sink, "AB"));
|
||||
TEST_REQUIRE_OK(sink.write(&sink, "CD"));
|
||||
TEST_REQUIRE_OK(sink.writeln(&sink, "EF"));
|
||||
TEST_REQUIRE_STR(OUTPUT, "ABCDEF\n");
|
||||
|
||||
/*
|
||||
* The error-line shape: a message that already ends in \n, handed to writeln,
|
||||
* produces two. Reproducing this exactly is what makes the golden corpus
|
||||
* pass.
|
||||
*/
|
||||
memset(OUTPUT, 0, sizeof(OUTPUT));
|
||||
rewind(out);
|
||||
TEST_REQUIRE_OK(sink.writeln(&sink, "? 20 : RUNTIME ERROR something\n"));
|
||||
TEST_REQUIRE_STR(OUTPUT, "? 20 : RUNTIME ERROR something\n\n");
|
||||
TEST_REQUIRE_INT(strlen(OUTPUT), 32);
|
||||
TEST_REQUIRE_INT(OUTPUT[30], '\n');
|
||||
TEST_REQUIRE_INT(OUTPUT[31], '\n');
|
||||
|
||||
/* readline strips the terminator and reports EOF without raising. */
|
||||
TEST_REQUIRE_OK(sink.readline(&sink, line, sizeof(line), &eof));
|
||||
TEST_REQUIRE(!eof, "the first line is not EOF");
|
||||
TEST_REQUIRE_STR(line, "first");
|
||||
TEST_REQUIRE_OK(sink.readline(&sink, line, sizeof(line), &eof));
|
||||
TEST_REQUIRE_STR(line, "second");
|
||||
TEST_REQUIRE_OK(sink.readline(&sink, line, sizeof(line), &eof));
|
||||
TEST_REQUIRE(eof, "running off the end must set eof, not raise");
|
||||
|
||||
/* Argument validation. */
|
||||
TEST_REQUIRE_STATUS(sink.write(&sink, NULL), AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(sink.readline(&sink, line, 1, &eof), AKBASIC_ERR_BOUNDS);
|
||||
TEST_REQUIRE_STATUS(akbasic_sink_init_stdio(NULL, &state, out, in), AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(akbasic_sink_init_stdio(&sink, NULL, out, in), AKERR_NULLPOINTER);
|
||||
|
||||
fclose(out);
|
||||
fclose(in);
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
75
tests/symtab.c
Normal file
75
tests/symtab.c
Normal file
@@ -0,0 +1,75 @@
|
||||
/**
|
||||
* @file symtab.c
|
||||
* @brief Tests the fixed-capacity open-addressed symbol table.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/symtab.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
static akbasic_SymbolTable TABLE;
|
||||
|
||||
int main(void)
|
||||
{
|
||||
void *value = NULL;
|
||||
int64_t ivalue = 0;
|
||||
char key[32];
|
||||
int marker_a = 1;
|
||||
int marker_b = 2;
|
||||
int i = 0;
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
TEST_REQUIRE_OK(akbasic_symtab_init(&TABLE, 16));
|
||||
|
||||
/* Round-trip both payloads. */
|
||||
TEST_REQUIRE_OK(akbasic_symtab_set(&TABLE, "A#", &marker_a, 42));
|
||||
TEST_REQUIRE_OK(akbasic_symtab_get(&TABLE, "A#", &value, &ivalue));
|
||||
TEST_REQUIRE(value == &marker_a, "wrong pointer payload");
|
||||
TEST_REQUIRE_INT(ivalue, 42);
|
||||
|
||||
/* Replacing an existing key must not grow the table. */
|
||||
TEST_REQUIRE_OK(akbasic_symtab_set(&TABLE, "A#", &marker_b, 43));
|
||||
TEST_REQUIRE_OK(akbasic_symtab_get(&TABLE, "A#", &value, &ivalue));
|
||||
TEST_REQUIRE(value == &marker_b, "replacement did not take");
|
||||
TEST_REQUIRE_INT(ivalue, 43);
|
||||
TEST_REQUIRE_INT(TABLE.count, 1);
|
||||
|
||||
/* A miss is AKERR_KEY, not a crash and not a silent NULL. */
|
||||
TEST_REQUIRE_STATUS(akbasic_symtab_get(&TABLE, "B$", &value, &ivalue), AKERR_KEY);
|
||||
|
||||
/*
|
||||
* Collisions. Sixteen distinct keys in a sixteen-slot table guarantees the
|
||||
* probe sequence is exercised, and the last insert has exactly one slot to
|
||||
* find.
|
||||
*/
|
||||
TEST_REQUIRE_OK(akbasic_symtab_clear(&TABLE));
|
||||
for ( i = 0; i < 16; i++ ) {
|
||||
snprintf(key, sizeof(key), "V%d#", i);
|
||||
TEST_REQUIRE_OK(akbasic_symtab_set(&TABLE, key, NULL, i));
|
||||
}
|
||||
for ( i = 0; i < 16; i++ ) {
|
||||
snprintf(key, sizeof(key), "V%d#", i);
|
||||
TEST_REQUIRE_OK(akbasic_symtab_get(&TABLE, key, NULL, &ivalue));
|
||||
TEST_REQUIRE_INT(ivalue, i);
|
||||
}
|
||||
|
||||
/* Seventeenth key into a sixteen-slot table: full, and it says so. */
|
||||
TEST_REQUIRE_STATUS(akbasic_symtab_set(&TABLE, "OVERFLOW#", NULL, 0), AKBASIC_ERR_BOUNDS);
|
||||
|
||||
/* Clear keeps the capacity but drops the contents. */
|
||||
TEST_REQUIRE_OK(akbasic_symtab_clear(&TABLE));
|
||||
TEST_REQUIRE_INT(TABLE.count, 0);
|
||||
TEST_REQUIRE_INT(TABLE.capacity, 16);
|
||||
TEST_REQUIRE_STATUS(akbasic_symtab_get(&TABLE, "V0#", NULL, NULL), AKERR_KEY);
|
||||
|
||||
/* Argument validation. */
|
||||
TEST_REQUIRE_STATUS(akbasic_symtab_init(NULL, 16), AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(akbasic_symtab_init(&TABLE, 0), AKBASIC_ERR_BOUNDS);
|
||||
TEST_REQUIRE_STATUS(akbasic_symtab_init(&TABLE, AKBASIC_SYMTAB_MAX_SLOTS + 1),
|
||||
AKBASIC_ERR_BOUNDS);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
109
tests/testutil.h
Normal file
109
tests/testutil.h
Normal file
@@ -0,0 +1,109 @@
|
||||
/**
|
||||
* @file testutil.h
|
||||
* @brief Shared assertions for the akbasic CTest programs.
|
||||
*
|
||||
* A test passes by exiting zero and fails by exiting non-zero with something
|
||||
* informative on stderr.
|
||||
*
|
||||
* TEST_ASSERT and friends expand to a `break`, so they belong directly inside an
|
||||
* ATTEMPT block, never inside a loop nested in one -- the same rule that governs
|
||||
* CATCH and the FAIL_*_BREAK macros. TEST_REQUIRE is the return-based form for
|
||||
* use inside loops and outside ATTEMPT blocks.
|
||||
*/
|
||||
|
||||
#ifndef _AKBASIC_TESTUTIL_H_
|
||||
#define _AKBASIC_TESTUTIL_H_
|
||||
|
||||
#include <math.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <akerror.h>
|
||||
|
||||
/** Count of failures recorded by TEST_REQUIRE; main() returns it. */
|
||||
static int akbasic_test_failures = 0;
|
||||
|
||||
/*
|
||||
* Mark an error handled and hand it back to the pool. Assigning the result is
|
||||
* what satisfies AKERR_NOIGNORE -- a (void) cast does not, and libakerror's
|
||||
* IGNORE() would log to stderr and pollute the test output.
|
||||
*/
|
||||
static void test_discard_error(akerr_ErrorContext *e)
|
||||
{
|
||||
akerr_ErrorContext *released = NULL;
|
||||
|
||||
if ( e == NULL ) {
|
||||
return;
|
||||
}
|
||||
e->handled = true;
|
||||
released = akerr_release_error(e);
|
||||
(void)released;
|
||||
}
|
||||
|
||||
#define TEST_REQUIRE(__cond, ...) \
|
||||
do { \
|
||||
if ( !(__cond) ) { \
|
||||
fprintf(stderr, "%s:%d: FAIL: ", __FILE__, __LINE__); \
|
||||
fprintf(stderr, __VA_ARGS__); \
|
||||
fprintf(stderr, "\n"); \
|
||||
akbasic_test_failures += 1; \
|
||||
} \
|
||||
} while ( 0 )
|
||||
|
||||
#define TEST_REQUIRE_STR(__got, __want) \
|
||||
TEST_REQUIRE(strcmp((__got), (__want)) == 0, \
|
||||
"expected \"%s\", got \"%s\"", (__want), (__got))
|
||||
|
||||
#define TEST_REQUIRE_INT(__got, __want) \
|
||||
TEST_REQUIRE((long long)(__got) == (long long)(__want), \
|
||||
"expected %lld, got %lld", \
|
||||
(long long)(__want), (long long)(__got))
|
||||
|
||||
#define TEST_REQUIRE_FEQ(__got, __want) \
|
||||
TEST_REQUIRE(fabs((double)(__got) - (double)(__want)) < 1e-9, \
|
||||
"expected %f, got %f", (double)(__want), (double)(__got))
|
||||
|
||||
/*
|
||||
* Assert that a call succeeded. Releases the context on failure so the pool does
|
||||
* not drain across a long test.
|
||||
*/
|
||||
#define TEST_REQUIRE_OK(__call) \
|
||||
do { \
|
||||
akerr_ErrorContext *__e = (__call); \
|
||||
if ( __e != NULL && __e->status != 0 ) { \
|
||||
fprintf(stderr, "%s:%d: FAIL: %s: unexpected error %d (%s): %s\n", \
|
||||
__FILE__, __LINE__, #__call, __e->status, \
|
||||
akerr_name_for_status(__e->status, NULL), __e->message); \
|
||||
akbasic_test_failures += 1; \
|
||||
} \
|
||||
test_discard_error(__e); \
|
||||
} while ( 0 )
|
||||
|
||||
/** Assert that a call failed with a specific status. */
|
||||
#define TEST_REQUIRE_STATUS(__call, __status) \
|
||||
do { \
|
||||
akerr_ErrorContext *__e = (__call); \
|
||||
if ( __e == NULL || __e->status != (__status) ) { \
|
||||
fprintf(stderr, "%s:%d: FAIL: %s: expected status %d (%s), got %d\n", \
|
||||
__FILE__, __LINE__, #__call, (int)(__status), \
|
||||
akerr_name_for_status((__status), NULL), \
|
||||
(__e == NULL ? 0 : __e->status)); \
|
||||
akbasic_test_failures += 1; \
|
||||
} \
|
||||
test_discard_error(__e); \
|
||||
} while ( 0 )
|
||||
|
||||
/** Assert that a call failed, without caring which status. */
|
||||
#define TEST_REQUIRE_ANY_ERROR(__call) \
|
||||
do { \
|
||||
akerr_ErrorContext *__e = (__call); \
|
||||
if ( __e == NULL || __e->status == 0 ) { \
|
||||
fprintf(stderr, "%s:%d: FAIL: %s: expected an error, got success\n", \
|
||||
__FILE__, __LINE__, #__call); \
|
||||
akbasic_test_failures += 1; \
|
||||
} \
|
||||
test_discard_error(__e); \
|
||||
} while ( 0 )
|
||||
|
||||
#endif // _AKBASIC_TESTUTIL_H_
|
||||
126
tests/value_arithmetic.c
Normal file
126
tests/value_arithmetic.c
Normal file
@@ -0,0 +1,126 @@
|
||||
/**
|
||||
* @file value_arithmetic.c
|
||||
* @brief Tests the arithmetic operators, including the parts that look wrong.
|
||||
*
|
||||
* Where the reference does something odd, the assertion here pins the reference's
|
||||
* answer, not the tidy one. A "fix" that changes any of these changes observable
|
||||
* BASIC behaviour and belongs in its own commit with its own TODO.md entry.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/value.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
static akbasic_Value A;
|
||||
static akbasic_Value B;
|
||||
static akbasic_Value SCRATCH;
|
||||
|
||||
static void set_int(akbasic_Value *v, int64_t n)
|
||||
{
|
||||
test_discard_error(akbasic_value_zero(v));
|
||||
v->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
v->intval = n;
|
||||
}
|
||||
|
||||
static void set_float(akbasic_Value *v, double n)
|
||||
{
|
||||
test_discard_error(akbasic_value_zero(v));
|
||||
v->valuetype = AKBASIC_TYPE_FLOAT;
|
||||
v->floatval = n;
|
||||
}
|
||||
|
||||
static void set_string(akbasic_Value *v, const char *s)
|
||||
{
|
||||
test_discard_error(akbasic_value_zero(v));
|
||||
v->valuetype = AKBASIC_TYPE_STRING;
|
||||
strncpy(v->stringval, s, AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_Value *out = NULL;
|
||||
char rendered[AKBASIC_MAX_STRING_LENGTH];
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
/* Integer arithmetic. */
|
||||
set_int(&A, 7);
|
||||
set_int(&B, 3);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_plus(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 10);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_minus(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 4);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_multiply(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 21);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_divide(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 2); /* truncating, as C and Go both do */
|
||||
|
||||
/* Float arithmetic. */
|
||||
set_float(&A, 1.20);
|
||||
set_float(&B, 0.4);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_divide(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_OK(akbasic_value_to_string(out, rendered, sizeof(rendered)));
|
||||
/* tests/language/arithmetic/float.txt says 3.000000, not 2.999999. */
|
||||
TEST_REQUIRE_STR(rendered, "3.000000");
|
||||
|
||||
/* String concatenation, including the mixed-type forms. */
|
||||
set_string(&A, "SORTED IN ");
|
||||
set_int(&B, 4);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_plus(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_STR(out->stringval, "SORTED IN 4");
|
||||
|
||||
set_string(&A, "X=");
|
||||
set_float(&B, 2.5);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_plus(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_STR(out->stringval, "X=2.500000");
|
||||
|
||||
/* String multiplication is repetition. */
|
||||
set_string(&A, "ab");
|
||||
set_int(&B, 3);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_multiply(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_STR(out->stringval, "ababab");
|
||||
|
||||
/*
|
||||
* mathPlus mutates self in place when self is mutable, where every other
|
||||
* operator always clones. CommandNEXT's loop increment depends on it --
|
||||
* TODO.md section 12 item 4. Pinning the asymmetry so a "cleanup" fails here
|
||||
* rather than silently breaking every FOR loop.
|
||||
*/
|
||||
set_int(&A, 10);
|
||||
A.mutable_ = true;
|
||||
set_int(&B, 5);
|
||||
TEST_REQUIRE_OK(akbasic_value_math_plus(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE(out == &A, "math_plus on a mutable value must return self, not the scratch");
|
||||
TEST_REQUIRE_INT(A.intval, 15);
|
||||
|
||||
set_int(&A, 10);
|
||||
A.mutable_ = false;
|
||||
TEST_REQUIRE_OK(akbasic_value_math_plus(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE(out == &SCRATCH, "math_plus on an immutable value must use the scratch");
|
||||
TEST_REQUIRE_INT(A.intval, 10);
|
||||
|
||||
/* Type errors. */
|
||||
set_string(&A, "text");
|
||||
set_int(&B, 1);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_math_minus(&A, &B, &SCRATCH, &out), AKBASIC_ERR_TYPE);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_math_divide(&A, &B, &SCRATCH, &out), AKBASIC_ERR_TYPE);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_invert(&A, &SCRATCH, &out), AKBASIC_ERR_TYPE);
|
||||
|
||||
/* Division by zero raises rather than trapping or panicking. */
|
||||
set_int(&A, 1);
|
||||
set_int(&B, 0);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_math_divide(&A, &B, &SCRATCH, &out), AKBASIC_ERR_VALUE);
|
||||
|
||||
/* Unary minus. */
|
||||
set_int(&A, 42);
|
||||
TEST_REQUIRE_OK(akbasic_value_invert(&A, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, -42);
|
||||
|
||||
/* nil rval is rejected everywhere. */
|
||||
TEST_REQUIRE_STATUS(akbasic_value_math_plus(&A, NULL, &SCRATCH, &out), AKERR_NULLPOINTER);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
73
tests/value_bitwise.c
Normal file
73
tests/value_bitwise.c
Normal file
@@ -0,0 +1,73 @@
|
||||
/**
|
||||
* @file value_bitwise.c
|
||||
* @brief Tests the bitwise operators and their type guards.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/value.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
static akbasic_Value A;
|
||||
static akbasic_Value B;
|
||||
static akbasic_Value SCRATCH;
|
||||
|
||||
static void set_int(akbasic_Value *v, int64_t n)
|
||||
{
|
||||
test_discard_error(akbasic_value_zero(v));
|
||||
v->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
v->intval = n;
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
set_int(&A, 0x0F);
|
||||
set_int(&B, 0x33);
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_value_bitwise_and(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 0x03);
|
||||
TEST_REQUIRE_OK(akbasic_value_bitwise_or(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 0x3F);
|
||||
TEST_REQUIRE_OK(akbasic_value_bitwise_xor(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 0x3C);
|
||||
|
||||
set_int(&A, 1);
|
||||
TEST_REQUIRE_OK(akbasic_value_shift_left(&A, 8, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 256);
|
||||
set_int(&A, 256);
|
||||
TEST_REQUIRE_OK(akbasic_value_shift_right(&A, 8, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, 1);
|
||||
|
||||
set_int(&A, 0);
|
||||
TEST_REQUIRE_OK(akbasic_value_bitwise_not(&A, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->intval, -1);
|
||||
|
||||
/*
|
||||
* Go's shift is defined for any count; C's is not. Refusing an out-of-range
|
||||
* count is a deliberate deviation from the reference, which would have
|
||||
* produced a defined (if useless) answer where C would produce UB.
|
||||
*/
|
||||
set_int(&A, 1);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_shift_left(&A, 64, &SCRATCH, &out), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_shift_left(&A, -1, &SCRATCH, &out), AKBASIC_ERR_VALUE);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_shift_right(&A, 64, &SCRATCH, &out), AKBASIC_ERR_VALUE);
|
||||
|
||||
/* Bitwise operations are integers-only. */
|
||||
test_discard_error(akbasic_value_zero(&A));
|
||||
A.valuetype = AKBASIC_TYPE_FLOAT;
|
||||
A.floatval = 1.0;
|
||||
set_int(&B, 1);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_bitwise_and(&A, &B, &SCRATCH, &out), AKBASIC_ERR_TYPE);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_bitwise_or(&A, &B, &SCRATCH, &out), AKBASIC_ERR_TYPE);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_bitwise_xor(&A, &B, &SCRATCH, &out), AKBASIC_ERR_TYPE);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_bitwise_not(&A, &SCRATCH, &out), AKBASIC_ERR_TYPE);
|
||||
TEST_REQUIRE_STATUS(akbasic_value_shift_left(&A, 1, &SCRATCH, &out), AKBASIC_ERR_TYPE);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
102
tests/value_compare.c
Normal file
102
tests/value_compare.c
Normal file
@@ -0,0 +1,102 @@
|
||||
/**
|
||||
* @file value_compare.c
|
||||
* @brief Tests the comparison operators across integer, float and string.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/value.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
static akbasic_Value A;
|
||||
static akbasic_Value B;
|
||||
static akbasic_Value SCRATCH;
|
||||
|
||||
static void set_int(akbasic_Value *v, int64_t n)
|
||||
{
|
||||
test_discard_error(akbasic_value_zero(v));
|
||||
v->valuetype = AKBASIC_TYPE_INTEGER;
|
||||
v->intval = n;
|
||||
}
|
||||
|
||||
static void set_float(akbasic_Value *v, double n)
|
||||
{
|
||||
test_discard_error(akbasic_value_zero(v));
|
||||
v->valuetype = AKBASIC_TYPE_FLOAT;
|
||||
v->floatval = n;
|
||||
}
|
||||
|
||||
static void set_string(akbasic_Value *v, const char *s)
|
||||
{
|
||||
test_discard_error(akbasic_value_zero(v));
|
||||
v->valuetype = AKBASIC_TYPE_STRING;
|
||||
strncpy(v->stringval, s, AKBASIC_MAX_STRING_LENGTH - 1);
|
||||
}
|
||||
|
||||
#define EXPECT_BOOL(__call, __want) \
|
||||
do { \
|
||||
akbasic_Value *__out = NULL; \
|
||||
TEST_REQUIRE_OK(__call(&A, &B, &SCRATCH, &__out)); \
|
||||
TEST_REQUIRE(__out->valuetype == AKBASIC_TYPE_BOOLEAN, \
|
||||
#__call " did not produce a boolean"); \
|
||||
TEST_REQUIRE(akbasic_value_is_true(__out) == (__want), \
|
||||
#__call " expected %s", ((__want) ? "true" : "false")); \
|
||||
TEST_REQUIRE_INT(__out->boolvalue, ((__want) ? AKBASIC_TRUE : AKBASIC_FALSE)); \
|
||||
} while ( 0 )
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_Value *out = NULL;
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
/* Integers. */
|
||||
set_int(&A, 3);
|
||||
set_int(&B, 5);
|
||||
EXPECT_BOOL(akbasic_value_less_than, true);
|
||||
EXPECT_BOOL(akbasic_value_less_than_equal, true);
|
||||
EXPECT_BOOL(akbasic_value_greater_than, false);
|
||||
EXPECT_BOOL(akbasic_value_greater_than_equal, false);
|
||||
EXPECT_BOOL(akbasic_value_is_equal, false);
|
||||
EXPECT_BOOL(akbasic_value_is_not_equal, true);
|
||||
|
||||
set_int(&B, 3);
|
||||
EXPECT_BOOL(akbasic_value_less_than, false);
|
||||
EXPECT_BOOL(akbasic_value_less_than_equal, true);
|
||||
EXPECT_BOOL(akbasic_value_greater_than_equal, true);
|
||||
EXPECT_BOOL(akbasic_value_is_equal, true);
|
||||
|
||||
/* Floats. */
|
||||
set_float(&A, 1.5);
|
||||
set_float(&B, 2.5);
|
||||
EXPECT_BOOL(akbasic_value_less_than, true);
|
||||
EXPECT_BOOL(akbasic_value_greater_than, false);
|
||||
|
||||
/* Strings compare lexically. */
|
||||
set_string(&A, "APPLE");
|
||||
set_string(&B, "BANANA");
|
||||
EXPECT_BOOL(akbasic_value_less_than, true);
|
||||
EXPECT_BOOL(akbasic_value_greater_than, false);
|
||||
EXPECT_BOOL(akbasic_value_is_equal, false);
|
||||
set_string(&B, "APPLE");
|
||||
EXPECT_BOOL(akbasic_value_is_equal, true);
|
||||
EXPECT_BOOL(akbasic_value_less_than_equal, true);
|
||||
EXPECT_BOOL(akbasic_value_greater_than_equal, true);
|
||||
|
||||
/* BASIC true is -1, not 1: the Commodore convention the README calls out. */
|
||||
set_int(&A, 1);
|
||||
set_int(&B, 1);
|
||||
TEST_REQUIRE_OK(akbasic_value_is_equal(&A, &B, &SCRATCH, &out));
|
||||
TEST_REQUIRE_INT(out->boolvalue, -1);
|
||||
|
||||
/* is_true is false for anything that is not a boolean. */
|
||||
set_int(&A, -1);
|
||||
TEST_REQUIRE(!akbasic_value_is_true(&A), "an integer -1 is not a BASIC true");
|
||||
TEST_REQUIRE(!akbasic_value_is_true(NULL), "NULL is not true");
|
||||
|
||||
TEST_REQUIRE_STATUS(akbasic_value_is_equal(&A, NULL, &SCRATCH, &out), AKERR_NULLPOINTER);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
123
tests/variable_subscript.c
Normal file
123
tests/variable_subscript.c
Normal file
@@ -0,0 +1,123 @@
|
||||
/**
|
||||
* @file variable_subscript.c
|
||||
* @brief Tests variable storage, typing by suffix, and subscript arithmetic.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/variable.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
static akbasic_ValuePool POOL;
|
||||
static akbasic_Variable VAR;
|
||||
|
||||
static void name_it(const char *name)
|
||||
{
|
||||
memset(&VAR, 0, sizeof(VAR));
|
||||
strncpy(VAR.name, name, sizeof(VAR.name) - 1);
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
akbasic_Value *slot = NULL;
|
||||
akerr_ErrorContext *e = NULL;
|
||||
int64_t sizes1[1] = { 5 };
|
||||
int64_t sizes2[2] = { 8, 8 };
|
||||
int64_t sizes3[3] = { 2, 3, 4 };
|
||||
int64_t at[3] = { 0, 0, 0 };
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
TEST_REQUIRE_OK(akbasic_valuepool_init(&POOL));
|
||||
|
||||
/* The suffix picks the type. Note % is float here, inverting Commodore. */
|
||||
name_it("A#");
|
||||
TEST_REQUIRE_OK(akbasic_variable_init(&VAR, &POOL, sizes1, 1));
|
||||
TEST_REQUIRE_INT(VAR.valuetype, AKBASIC_TYPE_INTEGER);
|
||||
TEST_REQUIRE_INT(VAR.valuecount, 5);
|
||||
|
||||
name_it("A%");
|
||||
TEST_REQUIRE_OK(akbasic_variable_init(&VAR, &POOL, sizes1, 1));
|
||||
TEST_REQUIRE_INT(VAR.valuetype, AKBASIC_TYPE_FLOAT);
|
||||
|
||||
name_it("A$");
|
||||
TEST_REQUIRE_OK(akbasic_variable_init(&VAR, &POOL, sizes1, 1));
|
||||
TEST_REQUIRE_INT(VAR.valuetype, AKBASIC_TYPE_STRING);
|
||||
|
||||
/* One dimension: round-trip every element. */
|
||||
name_it("B#");
|
||||
TEST_REQUIRE_OK(akbasic_variable_init(&VAR, &POOL, sizes1, 1));
|
||||
for ( at[0] = 0; at[0] < 5; at[0]++ ) {
|
||||
TEST_REQUIRE_OK(akbasic_variable_set_integer(&VAR, at[0] * 10, at, 1));
|
||||
}
|
||||
for ( at[0] = 0; at[0] < 5; at[0]++ ) {
|
||||
TEST_REQUIRE_OK(akbasic_variable_get_subscript(&VAR, at, 1, &slot));
|
||||
TEST_REQUIRE_INT(slot->intval, at[0] * 10);
|
||||
}
|
||||
|
||||
/* Two dimensions, the shape array_multidimensional.bas uses. */
|
||||
name_it("C#");
|
||||
TEST_REQUIRE_OK(akbasic_variable_init(&VAR, &POOL, sizes2, 2));
|
||||
TEST_REQUIRE_INT(VAR.valuecount, 64);
|
||||
at[0] = 0; at[1] = 7;
|
||||
TEST_REQUIRE_OK(akbasic_variable_set_integer(&VAR, 31337, at, 2));
|
||||
at[0] = 1; at[1] = 7;
|
||||
TEST_REQUIRE_OK(akbasic_variable_set_integer(&VAR, 65535, at, 2));
|
||||
at[0] = 0; at[1] = 7;
|
||||
TEST_REQUIRE_OK(akbasic_variable_get_subscript(&VAR, at, 2, &slot));
|
||||
TEST_REQUIRE_INT(slot->intval, 31337);
|
||||
at[0] = 1; at[1] = 7;
|
||||
TEST_REQUIRE_OK(akbasic_variable_get_subscript(&VAR, at, 2, &slot));
|
||||
TEST_REQUIRE_INT(slot->intval, 65535);
|
||||
|
||||
/* Three dimensions, to prove the flattening multiplier walks correctly. */
|
||||
name_it("D#");
|
||||
TEST_REQUIRE_OK(akbasic_variable_init(&VAR, &POOL, sizes3, 3));
|
||||
TEST_REQUIRE_INT(VAR.valuecount, 24);
|
||||
at[0] = 1; at[1] = 2; at[2] = 3;
|
||||
TEST_REQUIRE_OK(akbasic_variable_set_integer(&VAR, 99, at, 3));
|
||||
TEST_REQUIRE_OK(akbasic_variable_get_subscript(&VAR, at, 3, &slot));
|
||||
TEST_REQUIRE_INT(slot->intval, 99);
|
||||
at[0] = 0; at[1] = 0; at[2] = 0;
|
||||
TEST_REQUIRE_OK(akbasic_variable_get_subscript(&VAR, at, 3, &slot));
|
||||
TEST_REQUIRE_INT(slot->intval, 0);
|
||||
|
||||
/*
|
||||
* The out-of-bounds message is compared with strcmp, not merely for status:
|
||||
* tests/language/array_outofbounds.txt reproduces it verbatim, so a reworded
|
||||
* message is a failing golden case.
|
||||
*/
|
||||
name_it("A#");
|
||||
sizes1[0] = 3;
|
||||
TEST_REQUIRE_OK(akbasic_variable_init(&VAR, &POOL, sizes1, 1));
|
||||
at[0] = 4;
|
||||
e = akbasic_variable_get_subscript(&VAR, at, 1, &slot);
|
||||
TEST_REQUIRE(e != NULL, "an out-of-bounds subscript must raise");
|
||||
if ( e != NULL ) {
|
||||
TEST_REQUIRE_INT(e->status, AKBASIC_ERR_BOUNDS);
|
||||
TEST_REQUIRE_STR(e->message,
|
||||
"Variable index access out of bounds at dimension 0: 4 (max 2)");
|
||||
test_discard_error(e);
|
||||
}
|
||||
|
||||
/* Wrong subscript count. */
|
||||
name_it("E#");
|
||||
TEST_REQUIRE_OK(akbasic_variable_init(&VAR, &POOL, sizes2, 2));
|
||||
at[0] = 0;
|
||||
TEST_REQUIRE_STATUS(akbasic_variable_get_subscript(&VAR, at, 1, &slot), AKBASIC_ERR_BOUNDS);
|
||||
|
||||
/* A dimension must be positive. */
|
||||
name_it("F#");
|
||||
sizes1[0] = 0;
|
||||
TEST_REQUIRE_STATUS(akbasic_variable_init(&VAR, &POOL, sizes1, 1), AKBASIC_ERR_VALUE);
|
||||
sizes1[0] = -1;
|
||||
TEST_REQUIRE_STATUS(akbasic_variable_init(&VAR, &POOL, sizes1, 1), AKBASIC_ERR_VALUE);
|
||||
|
||||
/* An unnamed variable has no type to derive. */
|
||||
memset(&VAR, 0, sizeof(VAR));
|
||||
sizes1[0] = 1;
|
||||
TEST_REQUIRE_STATUS(akbasic_variable_init(&VAR, &POOL, sizes1, 1), AKBASIC_ERR_VALUE);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
91
tests/verbs_table.c
Normal file
91
tests/verbs_table.c
Normal file
@@ -0,0 +1,91 @@
|
||||
/**
|
||||
* @file verbs_table.c
|
||||
* @brief Tests the dispatch table's invariants.
|
||||
*
|
||||
* The sorting assertion is the important one: bsearch on a mis-sorted table
|
||||
* silently fails to find a verb rather than producing a compile error, and the
|
||||
* symptom would be "Unknown command PRINT" a long way from the cause.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
#include <akbasic/verbs.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
int main(void)
|
||||
{
|
||||
const akbasic_Verb *table = NULL;
|
||||
const akbasic_Verb *found = NULL;
|
||||
int count = 0;
|
||||
int i = 0;
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
table = akbasic_verb_table(&count);
|
||||
TEST_REQUIRE(table != NULL, "the verb table must exist");
|
||||
TEST_REQUIRE(count > 0, "the verb table must not be empty");
|
||||
|
||||
/* Sorted, strictly: bsearch requires it and a duplicate name is a bug. */
|
||||
for ( i = 1; i < count; i++ ) {
|
||||
TEST_REQUIRE(strcmp(table[i - 1].name, table[i].name) < 0,
|
||||
"table is not sorted at index %d: \"%s\" then \"%s\"",
|
||||
i, table[i - 1].name, table[i].name);
|
||||
}
|
||||
|
||||
/* Every row is reachable by its own name. */
|
||||
for ( i = 0; i < count; i++ ) {
|
||||
TEST_REQUIRE_OK(akbasic_verb_lookup(table[i].name, &found));
|
||||
TEST_REQUIRE(found == &table[i], "row \"%s\" is not findable", table[i].name);
|
||||
}
|
||||
|
||||
/* Verbs and function names are case-insensitive; variable names are not. */
|
||||
TEST_REQUIRE_OK(akbasic_verb_lookup("print", &found));
|
||||
TEST_REQUIRE(found != NULL && strcmp(found->name, "PRINT") == 0, "lowercase print missed");
|
||||
TEST_REQUIRE_OK(akbasic_verb_lookup("PrInT", &found));
|
||||
TEST_REQUIRE(found != NULL && strcmp(found->name, "PRINT") == 0, "mixed-case print missed");
|
||||
|
||||
/* A miss is a NULL, not an error. */
|
||||
TEST_REQUIRE_OK(akbasic_verb_lookup("NOTAVERB", &found));
|
||||
TEST_REQUIRE(found == NULL, "an unknown name must miss");
|
||||
TEST_REQUIRE_OK(akbasic_verb_lookup("", &found));
|
||||
TEST_REQUIRE(found == NULL, "an empty name must miss");
|
||||
|
||||
/* Every function row carries a real arity and a handler. */
|
||||
for ( i = 0; i < count; i++ ) {
|
||||
if ( table[i].tokentype != AKBASIC_TOK_FUNCTION ) {
|
||||
continue;
|
||||
}
|
||||
TEST_REQUIRE(table[i].arity >= 1,
|
||||
"function \"%s\" has arity %d", table[i].name, table[i].arity);
|
||||
TEST_REQUIRE(table[i].exec != NULL,
|
||||
"function \"%s\" has no exec handler", table[i].name);
|
||||
}
|
||||
|
||||
/*
|
||||
* The four rows with no exec handler are consumed by another verb's parse
|
||||
* path and are never evaluated on their own. Any other missing handler is a
|
||||
* verb that would report "Unknown command" at runtime.
|
||||
*/
|
||||
for ( i = 0; i < count; i++ ) {
|
||||
if ( table[i].exec != NULL ) {
|
||||
continue;
|
||||
}
|
||||
TEST_REQUIRE(strcmp(table[i].name, "AND") == 0 ||
|
||||
strcmp(table[i].name, "ELSE") == 0 ||
|
||||
strcmp(table[i].name, "NOT") == 0 ||
|
||||
strcmp(table[i].name, "OR") == 0 ||
|
||||
strcmp(table[i].name, "REM") == 0 ||
|
||||
strcmp(table[i].name, "STEP") == 0 ||
|
||||
strcmp(table[i].name, "THEN") == 0 ||
|
||||
strcmp(table[i].name, "TO") == 0,
|
||||
"verb \"%s\" has no exec handler and is not a known passive token",
|
||||
table[i].name);
|
||||
}
|
||||
|
||||
TEST_REQUIRE_STATUS(akbasic_verb_lookup(NULL, &found), AKERR_NULLPOINTER);
|
||||
TEST_REQUIRE_STATUS(akbasic_verb_lookup("PRINT", NULL), AKERR_NULLPOINTER);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
58
tests/version_check.c
Normal file
58
tests/version_check.c
Normal file
@@ -0,0 +1,58 @@
|
||||
/**
|
||||
* @file version_check.c
|
||||
* @brief Tests that the loaded dependencies match the headers we compiled against.
|
||||
*
|
||||
* The soname normally catches a mismatch at load time. This earns its keep when
|
||||
* the soname is bypassed -- a 0.2.0 dropped in under the 0.1 filename loads
|
||||
* happily, and only the check notices.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include <akstdlib.h>
|
||||
|
||||
#include <akbasic/error.h>
|
||||
|
||||
#include "testutil.h"
|
||||
|
||||
int main(void)
|
||||
{
|
||||
int major = 0;
|
||||
int minor = 0;
|
||||
int patch = 0;
|
||||
|
||||
TEST_REQUIRE_OK(akbasic_error_register());
|
||||
|
||||
/*
|
||||
* AKSL_VERSION_CHECK() is a macro on purpose: it expands here so it captures
|
||||
* the numbers *this* translation unit was built with, and compares them to
|
||||
* the ones baked into the library that actually loaded.
|
||||
*/
|
||||
TEST_REQUIRE_OK(AKSL_VERSION_CHECK());
|
||||
|
||||
TEST_REQUIRE_OK(aksl_version(&major, &minor, &patch));
|
||||
TEST_REQUIRE_INT(major, AKSL_VERSION_MAJOR);
|
||||
TEST_REQUIRE_INT(minor, AKSL_VERSION_MINOR);
|
||||
TEST_REQUIRE_STR(aksl_version_string(), AKSL_VERSION_STRING);
|
||||
TEST_REQUIRE_STR(aksl_version_soname(), AKSL_VERSION_SONAME);
|
||||
|
||||
/*
|
||||
* While libakstdlib's major is 0 the soname carries MAJOR.MINOR, so 0.1 and
|
||||
* 0.2 are different ABIs. Asserting the shape here means a future 1.0 bump
|
||||
* that forgets to change the soname rule fails a test rather than shipping.
|
||||
*/
|
||||
if ( major == 0 ) {
|
||||
char expected[32];
|
||||
snprintf(expected, sizeof(expected), "%d.%d", major, minor);
|
||||
TEST_REQUIRE_STR(aksl_version_soname(), expected);
|
||||
}
|
||||
|
||||
/*
|
||||
* libakerror publishes no version macro at all, so there is nothing to
|
||||
* compare. Its floor is the #error on AKERR_FIRST_CONSUMER_STATUS that
|
||||
* akbasic/error.h carries -- if this file compiled, that guard passed.
|
||||
*/
|
||||
TEST_REQUIRE_INT(AKERR_FIRST_CONSUMER_STATUS, 256);
|
||||
|
||||
return akbasic_test_failures;
|
||||
}
|
||||
Reference in New Issue
Block a user