1 Commits
12 ... 16

Author SHA1 Message Date
9ea5af67ae Add native RND and ASC functions
Some checks failed
akbasic CI Build / cmake_build (push) Failing after 3m28s
akbasic CI Build / sanitizers (push) Failing after 5m35s
akbasic CI Build / coverage (push) Failing after 4m10s
akbasic CI Build / mutation_test (push) Failing after 3m37s
akbasic CI Build / akgl_build (push) Failing after 7m24s
Implement bounded random integers with lazy clock seeding and add ASC as the inverse of CHR. Cover dispatch, validation, deterministic LCG output, UTF-8 round trips, function reference, and the breakout tutorial.

Closes #16.

Co-authored-by: andrew <andrew@aklabs.net>
2026-08-05 15:53:15 -04:00
10 changed files with 155 additions and 109 deletions

View File

@@ -9,6 +9,7 @@ so a call with the wrong number is a syntax error rather than a surprise.
| Function | Args | Form | What it gives |
|---|---|---|---|
| `ABS` | 1 | `ABS(n)` | The absolute value of an integer or float. |
| `ASC` | 1 | `ASC(A$)` | The Unicode code point of a string's first character. |
| `ATN` | 1 | `ATN(n)` | Arctangent, in radians. |
| `BUMP` | 1 | `BUMP(1)` | Which sprites have collided, as a bitmask. **Reading clears it.** |
| `CHR` | 1 | `CHR(n)` | The character for a Unicode code point, as a string. |
@@ -29,6 +30,7 @@ so a call with the wrong number is a syntax error rather than a surprise.
| `RGR` | 1 | `RGR(f)` | The `GRAPHIC` mode (0), the drawing surface's width (1) or height (2) in pixels, or a character cell's width (3) or height (4). |
| `RIGHT` | 2 | `RIGHT(A$, n)` | The rightmost `n` characters. Clamped. |
| `RMENU` | 2 | `RMENU(n, f)` | A menu's state: field 0 the highlighted entry, field 1 whether it has been confirmed. **Reading field 1 clears it.** |
| `RND` | 1 | `RND(n)` | A random integer from 0 up to but not including `n`. |
| `RWINDOW` | 1 | `RWINDOW(f)` | The current text window's rows (0) or columns (1). Field 2 is a C128 screen mode and is refused. |
| `RSPCOLOR` | 1 | `RSPCOLOR(n)` | One of `SPRCOLOR`'s two shared registers, 1 or 2. |
| `RSPHIT` | 2 | `RSPHIT(n, f)` | One of `SPRHIT`'s settings for sprite `n`, in `SPRHIT`'s own argument order: 0 the kind, 1 to 4 the two corners. |

View File

@@ -1005,20 +1005,48 @@ IF NUDGE# = 1 THEN GOSUB UNSTICK
LABEL UNSTICK
NUDGE# = 0
STALL# = 0
RMAX# = 4
GOSUB RANDOM
BVX# = (RND# * 3) - 6
BVX# = (RND(4) * 3) - 6
IF BVX# = 0 THEN BVX# = 3
RETURN
```
### You have to write your own random numbers
### Random numbers are built in
**There is no `RND` in this dialect**, and no `INT`, `SQR`, `ASC` or `TIMER` either. A
linear congruential generator is nine tokens and does the job. Put the number of possible
answers in `RMAX#` and read the result from `RND#`:
There is no `INT`, `SQR` or `TIMER` in this dialect, but
`RND(n)` returns an integer from zero through `n - 1`. It seeds itself
from the host clock the first time it is called, so a program only needs the bound:
```basic
I# = 0
FOR I# = 1 TO 5
PRINT "ROLL " + (RND(6) + 1)
NEXT I#
END
```
Use `RND` for the serve, too, so the ball does not always leave in the same direction:
```basic norun
LABEL SERVE
PX# = (SCW# - PW#) / 2
HELD# = 1
BX# = PX# + ((PW# / 2) - 4)
BY# = PY# - 10
BVX# = BSPD#
IF RND(2) = 0 THEN BVX# = 0 - BSPD#
BVY# = 0 - BSPD#
PDEC# = 0
GOSUB SHOWSPR
RETURN
```
<details>
<summary>Historical aside: the LCG this chapter used to teach</summary>
Before `RND` existed, this nine-token linear congruential generator was copied into
every program. It remains a useful from-scratch PRNG example:
```basic norun
SEED# = 12345
RMAX# = 6
RND# = 0
@@ -1035,43 +1063,11 @@ RND# = MOD((SEED# / 65536), RMAX#)
RETURN
```
```output
ROLL 1
ROLL 5
ROLL 2
ROLL 1
ROLL 2
```
The multiplication stays inside a 64-bit integer for any seed below 2147483648. The
answer is taken from the middle bits because the low bits of a power-of-two modulus
barely change from one call to the next. This used to be required; it is now built in.
The multiplication stays inside a 64-bit integer for any seed below 2147483648, which is
why the modulus is that number. The answer is taken from the middle bits — `SEED# / 65536`
— because the low bits of a power-of-two modulus barely change from one call to the next.
Integer division truncating for free is the `INT` you do not have.
Seed it from the clock at startup. `TI#` is the host's uptime in sixtieths of a second,
which is different every time the game is run:
```basic norun
SEED# = TI#
```
Use `RANDOM` for the serve, too, so the ball does not always leave in the same direction:
```basic norun
LABEL SERVE
PX# = (SCW# - PW#) / 2
HELD# = 1
BX# = PX# + ((PW# / 2) - 4)
BY# = PY# - 10
RMAX# = 2
GOSUB RANDOM
BVX# = BSPD#
IF RND# = 0 THEN BVX# = 0 - BSPD#
BVY# = 0 - BSPD#
PDEC# = 0
GOSUB SHOWSPR
RETURN
```
</details>
`HELD#` is the flag Step 6's loop tests: while it is 1 the ball sits on the paddle, and
`HOLDBAL` keeps it there:
@@ -1422,9 +1418,7 @@ PX# = PX# + D#
RETURN
LABEL DEMOAIM
RMAX# = 81
GOSUB RANDOM
DOFF# = RND# - 40
DOFF# = RND(81) - 40
RETURN
```
@@ -1501,7 +1495,7 @@ This is the shape of the whole file:
LABEL SETUP the geometry from Step 2
the declaration block from Step 3
the brick faces from Step 5
SEED# = TI#
RND(n) seeds itself from the host clock
the ceiling from Step 9
GOSUB MKSPR Step 4
GOSUB SNDPROBE Step 14
@@ -1576,10 +1570,7 @@ BB# = 0
RX# = 0
N# = 0
MROW# = 0
RMAX# = 2
RND# = 0
SND# = 0
SEED# = 0
P$ = ""
H$ = ""
S$ = ""

View File

@@ -118,12 +118,6 @@ typedef struct akbasic_Runtime
{
akbasic_SourceLine source[AKBASIC_MAX_SOURCE_LINES];
/* Scratch owned by this runtime for RENUMBER and its target prescan. */
int16_t renumber_map[AKBASIC_MAX_SOURCE_LINES];
uint8_t renumber_visited[AKBASIC_MAX_SOURCE_LINES];
akbasic_SourceLine renumber_line;
char renumber_discard[AKBASIC_MAX_LINE_LENGTH * 2];
/* Pools. Nothing here is malloc'd; everything is drawn from and returned. */
akbasic_Environment environments[AKBASIC_MAX_ENVIRONMENTS];
akbasic_Variable variables[AKBASIC_MAX_VARIABLES];
@@ -258,6 +252,11 @@ typedef struct akbasic_Runtime
*/
int64_t timems;
/* RND's lazy seed state. The flag distinguishes an unseeded run from a
* legitimate LCG state of zero. */
int64_t rndseed;
bool rndseeded;
/*
* Set by a branch that has decided the remaining statements on its line
* belong to the arm it did not take, and cleared at the top of every line.

View File

@@ -72,7 +72,7 @@ struct akbasic_TargetWalk
* rewritten: `GOTO 9999` in a program with no line 9999 is already broken, and
* inventing a destination for it would hide that.
*/
static int64_t mapped(const int16_t *map, int64_t line)
static int64_t mapped(const int64_t *map, int64_t line)
{
if ( line < 0 || line >= AKBASIC_MAX_SOURCE_LINES ) {
return line;
@@ -306,7 +306,7 @@ static akerr_ErrorContext *rewrite_line(akbasic_TargetWalk *walk, const char *co
static akerr_ErrorContext *visit_renumber(akbasic_TargetWalk *walk, int64_t target, char *dest, size_t len)
{
PREPARE_ERROR(errctx);
const int16_t *map = (const int16_t *)walk->self;
const int64_t *map = (const int64_t *)walk->self;
int written = 0;
PASS(errctx, aksl_snprintf(&written, dest, len, "%" PRId64, mapped(map, target)));
@@ -316,7 +316,8 @@ static akerr_ErrorContext *visit_renumber(akbasic_TargetWalk *walk, int64_t targ
akerr_ErrorContext *akbasic_renumber(akbasic_Runtime *obj, int64_t newstart, int64_t increment, int64_t oldstart)
{
PREPARE_ERROR(errctx);
int16_t *map = obj == NULL ? NULL : obj->renumber_map;
static int64_t map[AKBASIC_MAX_SOURCE_LINES];
static akbasic_SourceLine rewritten[AKBASIC_MAX_SOURCE_LINES];
akbasic_TargetWalk walk = { map, visit_renumber };
int64_t next = newstart;
int64_t i = 0;
@@ -355,8 +356,10 @@ akerr_ErrorContext *akbasic_renumber(akbasic_Runtime *obj, int64_t newstart, int
next += increment;
}
PASS(errctx, aksl_memset(obj->renumber_visited, 0, sizeof(obj->renumber_visited)));
PASS(errctx, aksl_memset(rewritten, 0, sizeof(rewritten)));
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
int64_t target = 0;
if ( obj->source[i].code[0] == '\0' ) {
continue;
}
@@ -364,62 +367,20 @@ akerr_ErrorContext *akbasic_renumber(akbasic_Runtime *obj, int64_t newstart, int
* Every line is rewritten, not just the moved ones: a line before
* `oldstart` can branch into the region that moved.
*/
target = mapped(map, i);
PASS(errctx, rewrite_line(&walk, obj->source[i].code,
obj->renumber_line.code, sizeof(obj->renumber_line.code)));
obj->renumber_line.lineno = i;
rewritten[target].code, sizeof(rewritten[target].code)));
rewritten[target].lineno = target;
/*
* Every line comes out numbered, whether or not it went in that way.
* Asking for numbers is what RENUMBER is, and a program that has been
* through it can be branched into by number -- which is the whole point
* of running it over source that arrived without any.
*/
obj->renumber_line.numbered = true;
PASS(errctx, aksl_memcpy(&obj->source[i], &obj->renumber_line,
sizeof(obj->source[i])));
rewritten[target].numbered = true;
}
/* Move the already-rewritten lines in place. The map is a partial
* permutation: a chain ends at an empty slot, while a cycle closes back
* on its starting line. A single displaced line is sufficient for both. */
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
int64_t current = i;
akbasic_SourceLine displaced;
akbasic_SourceLine next_line;
if ( map[i] < 0 || obj->renumber_visited[i] ) {
continue;
}
PASS(errctx, aksl_memcpy(&displaced, &obj->source[i], sizeof(displaced)));
for ( ;; ) {
int64_t destination = map[current];
obj->renumber_visited[current] = 1;
if ( destination == i ) {
displaced.lineno = destination;
PASS(errctx, aksl_memcpy(&obj->source[destination], &displaced,
sizeof(displaced)));
break;
}
if ( map[destination] < 0 ) {
displaced.lineno = destination;
PASS(errctx, aksl_memcpy(&obj->source[destination], &displaced,
sizeof(displaced)));
PASS(errctx, aksl_memset(&obj->source[current], 0,
sizeof(obj->source[current])));
break;
}
PASS(errctx, aksl_memcpy(&next_line, &obj->source[destination],
sizeof(displaced)));
displaced.lineno = destination;
PASS(errctx, aksl_memcpy(&obj->source[destination], &displaced,
sizeof(obj->renumber_line)));
PASS(errctx, aksl_memset(&obj->source[current], 0,
sizeof(obj->source[current])));
PASS(errctx, aksl_memcpy(&displaced, &next_line,
sizeof(displaced)));
current = destination;
}
}
PASS(errctx, aksl_memcpy(obj->source, rewritten, sizeof(obj->source)));
SUCCEED_RETURN(errctx);
}
@@ -474,6 +435,7 @@ akerr_ErrorContext *akbasic_runtime_check_targets(akbasic_Runtime *obj)
* step(). Nothing is read back out of it -- the walk needs somewhere to put
* the text it would have written, and this is it.
*/
static char discard[AKBASIC_MAX_LINE_LENGTH * 2];
CheckState state = { NULL, 0 };
akbasic_TargetWalk walk = { &state, visit_check };
int64_t entry = 0;
@@ -501,8 +463,7 @@ akerr_ErrorContext *akbasic_runtime_check_targets(akbasic_Runtime *obj)
* the whole point of setting it.
*/
obj->environment->lineno = i;
PASS(errctx, rewrite_line(&walk, obj->source[i].code,
obj->renumber_discard, sizeof(obj->renumber_discard)));
PASS(errctx, rewrite_line(&walk, obj->source[i].code, discard, sizeof(discard)));
}
/* Nothing was refused, so leave the cursor as the caller had it. */
obj->environment->lineno = entry;

View File

@@ -183,6 +183,69 @@ akerr_ErrorContext *akbasic_fn_chr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_fn_asc(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;
const unsigned char *text = NULL;
int64_t codepoint = 0;
(void)lval; (void)rval;
PASS(errctx, first_arg(obj, expr, "ASC", NULL, &arg, &out));
FAIL_NONZERO_RETURN(errctx, (arg->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"ASC expected a string");
FAIL_ZERO_RETURN(errctx, (arg->stringval[0] != '\0'), AKBASIC_ERR_BOUNDS,
"ASC expected a non-empty string");
/* Decode the first UTF-8 code point, the inverse of CHR's encoder. */
text = (const unsigned char *)arg->stringval;
if ( text[0] < 0x80 ) {
codepoint = text[0];
} else if ( (text[0] & 0xE0) == 0xC0 ) {
codepoint = ((int64_t)(text[0] & 0x1F) << 6) |
(text[1] & 0x3F);
} else if ( (text[0] & 0xF0) == 0xE0 ) {
codepoint = ((int64_t)(text[0] & 0x0F) << 12) |
((int64_t)(text[1] & 0x3F) << 6) |
(text[2] & 0x3F);
} else {
codepoint = ((int64_t)(text[0] & 0x07) << 18) |
((int64_t)(text[1] & 0x3F) << 12) |
((int64_t)(text[2] & 0x3F) << 6) |
(text[3] & 0x3F);
}
out->valuetype = AKBASIC_TYPE_INTEGER;
out->intval = codepoint;
*dest = out;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_fn_rnd(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;
const int64_t modulus = 2147483648;
(void)lval; (void)rval;
PASS(errctx, first_arg(obj, expr, "RND", NULL, &arg, &out));
FAIL_NONZERO_RETURN(errctx, (arg->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
"RND expected an integer");
FAIL_ZERO_RETURN(errctx, (arg->intval > 0), AKBASIC_ERR_VALUE,
"RND count %" PRId64 " must be positive", arg->intval);
if ( !obj->rndseeded ) {
obj->rndseed = obj->timems % modulus;
obj->rndseeded = true;
}
obj->rndseed = (obj->rndseed * 1103515245 + 12345) % modulus;
out->valuetype = AKBASIC_TYPE_INTEGER;
out->intval = (obj->rndseed / 65536) % arg->intval;
*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);

View File

@@ -37,6 +37,7 @@ static const akbasic_Verb VERBS[] = {
{ "ABS", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_abs },
{ "AND", AKBASIC_TOK_AND, -1, NULL, NULL },
{ "APPEND", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_append },
{ "ASC", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_asc },
{ "ATN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_atn },
{ "AUTO", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_auto },
{ "BACKUP", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_backup },
@@ -146,6 +147,7 @@ static const akbasic_Verb VERBS[] = {
{ "RGR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rgr },
{ "RIGHT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_right },
{ "RMENU", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rmenu },
{ "RND", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rnd },
{ "RSPCOLOR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rspcolor },
{ "RSPHIT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rsphit },
{ "RSPPOS", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rsppos },

View File

@@ -140,6 +140,7 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_stop(struct akbasic_Runtime *obj,
/* 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_asc(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);
@@ -154,6 +155,7 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_peek(struct akbasic_Runtime *obj,
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_rnd(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);

View File

@@ -0,0 +1,3 @@
10 PRINT "97 : " + ASC("a")
20 PRINT "65 : " + ASC("A")
30 PRINT "64 : " + ASC("@")

View File

@@ -0,0 +1,3 @@
97 : 97
65 : 65
64 : 64

View File

@@ -162,6 +162,26 @@ int main(void)
expect_int("A# = INSTR(\"HELLO\", \"LL\")", 2);
expect_int("A# = INSTR(\"HELLO\", \"ZZ\")", -1);
/* RND auto-seeds from host time and follows the documented LCG. */
HARNESS_RUNTIME.rndseeded = false;
TEST_REQUIRE_OK(akbasic_runtime_settime(&HARNESS_RUNTIME, 12345));
expect_int("A# = RND(6)", 0);
expect_int("A# = RND(6)", 4);
expect_int("A# = RND(6)", 1);
expect_int("A# = RND(6)", 0);
expect_int("A# = RND(6)", 1);
expect_int("A# = RND(1)", 0);
TEST_REQUIRE_STATUS(eval_line("A# = RND(0)", &out), AKBASIC_ERR_VALUE);
TEST_REQUIRE_STATUS(eval_line("A# = RND(-1)", &out), AKBASIC_ERR_VALUE);
TEST_REQUIRE_STATUS(eval_line("A# = RND(\"x\")", &out), AKBASIC_ERR_TYPE);
/* ASC is the inverse of CHR for ASCII and non-ASCII code points. */
expect_int("A# = ASC(CHR(97))", 97);
expect_int("A# = ASC(\"A\")", 65);
expect_int("A# = ASC(CHR(8364))", 8364);
TEST_REQUIRE_STATUS(eval_line("A# = ASC(\"\")", &out), AKBASIC_ERR_BOUNDS);
TEST_REQUIRE_STATUS(eval_line("A# = ASC(65)", &out), AKBASIC_ERR_TYPE);
/* 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),