Compare commits
3 Commits
16
...
ebec1f1621
| Author | SHA1 | Date | |
|---|---|---|---|
|
ebec1f1621
|
|||
| ec4a2c23d7 | |||
| 33cb2782ac |
@@ -9,7 +9,6 @@ so a call with the wrong number is a syntax error rather than a surprise.
|
|||||||
| Function | Args | Form | What it gives |
|
| Function | Args | Form | What it gives |
|
||||||
|---|---|---|---|
|
|---|---|---|---|
|
||||||
| `ABS` | 1 | `ABS(n)` | The absolute value of an integer or float. |
|
| `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. |
|
| `ATN` | 1 | `ATN(n)` | Arctangent, in radians. |
|
||||||
| `BUMP` | 1 | `BUMP(1)` | Which sprites have collided, as a bitmask. **Reading clears it.** |
|
| `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. |
|
| `CHR` | 1 | `CHR(n)` | The character for a Unicode code point, as a string. |
|
||||||
@@ -30,7 +29,6 @@ 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). |
|
| `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. |
|
| `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.** |
|
| `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. |
|
| `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. |
|
| `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. |
|
| `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. |
|
||||||
|
|||||||
@@ -380,8 +380,10 @@ no free, so anything drawn from it is spent for the life of the run — and scop
|
|||||||
returns a variable's *slot* without returning its storage. A scalar therefore does not
|
returns a variable's *slot* without returning its storage. A scalar therefore does not
|
||||||
draw from it at all: `akbasic_variable_init()` points a one-element non-`@` variable at
|
draw from it at all: `akbasic_variable_init()` points a one-element non-`@` variable at
|
||||||
its own `inlinevalue`, which is what makes a local, a `FOR` counter and a `DEF` parameter
|
its own `inlinevalue`, which is what makes a local, a `FOR` counter and a `DEF` parameter
|
||||||
free. Arrays and structures still spend, deliberately, because a pointer into a record is
|
free. A pointer parameter is also free: it owns only its one-slot reference, so its
|
||||||
allowed to outlive the scope that DIMmed it.
|
`inlinevalue` dies with the call while the target remains in the caller's storage. Arrays,
|
||||||
|
structures and by-value structure parameters still spend, deliberately, because a pointer
|
||||||
|
into a record is allowed to outlive the scope that DIMmed it.
|
||||||
[Chapter 13](13-differences.md) states the same budget from a BASIC programmer's side.
|
[Chapter 13](13-differences.md) states the same budget from a BASIC programmer's side.
|
||||||
|
|
||||||
The per-environment three are reset at the top of every line, which is what makes
|
The per-environment three are reset at the top of every line, which is what makes
|
||||||
|
|||||||
@@ -266,6 +266,13 @@ The function saw 99; the caller still has 5. To change a caller's record on purp
|
|||||||
a pointer — `DEF POKEIT(P@ AS PTR TO CRATE)` — and reach through it with `->`. Neither is
|
a pointer — `DEF POKEIT(P@ AS PTR TO CRATE)` — and reach through it with `->`. Neither is
|
||||||
a special rule: both fall out of the parameter being assigned like any other variable.
|
a special rule: both fall out of the parameter being assigned like any other variable.
|
||||||
|
|
||||||
|
A pointer parameter's own reference is kept in the call variable's inline slot, so repeated
|
||||||
|
calls do not spend the value pool. Its target remains the caller's structure. A by-value
|
||||||
|
structure parameter is different: its copied slots remain in the value pool because
|
||||||
|
`POINT Q@ AT B@` may retain a pointer to that copy after the function returns. Until escape
|
||||||
|
analysis can distinguish that case, **do not call a by-value structure-parameter function in
|
||||||
|
a loop**; bind a host global and rebind it per instance instead.
|
||||||
|
|
||||||
## What is checked, and what is not
|
## What is checked, and what is not
|
||||||
|
|
||||||
A field name is checked against the set the type declared, and the refusal lists the
|
A field name is checked against the set the type declared, and the refusal lists the
|
||||||
|
|||||||
@@ -1005,48 +1005,20 @@ IF NUDGE# = 1 THEN GOSUB UNSTICK
|
|||||||
LABEL UNSTICK
|
LABEL UNSTICK
|
||||||
NUDGE# = 0
|
NUDGE# = 0
|
||||||
STALL# = 0
|
STALL# = 0
|
||||||
BVX# = (RND(4) * 3) - 6
|
RMAX# = 4
|
||||||
|
GOSUB RANDOM
|
||||||
|
BVX# = (RND# * 3) - 6
|
||||||
IF BVX# = 0 THEN BVX# = 3
|
IF BVX# = 0 THEN BVX# = 3
|
||||||
RETURN
|
RETURN
|
||||||
```
|
```
|
||||||
|
|
||||||
### Random numbers are built in
|
### You have to write your own random numbers
|
||||||
|
|
||||||
There is no `INT`, `SQR` or `TIMER` in this dialect, but
|
**There is no `RND` in this dialect**, and no `INT`, `SQR`, `ASC` or `TIMER` either. A
|
||||||
`RND(n)` returns an integer from zero through `n - 1`. It seeds itself
|
linear congruential generator is nine tokens and does the job. Put the number of possible
|
||||||
from the host clock the first time it is called, so a program only needs the bound:
|
answers in `RMAX#` and read the result from `RND#`:
|
||||||
|
|
||||||
```basic
|
```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
|
SEED# = 12345
|
||||||
RMAX# = 6
|
RMAX# = 6
|
||||||
RND# = 0
|
RND# = 0
|
||||||
@@ -1063,11 +1035,43 @@ RND# = MOD((SEED# / 65536), RMAX#)
|
|||||||
RETURN
|
RETURN
|
||||||
```
|
```
|
||||||
|
|
||||||
The multiplication stays inside a 64-bit integer for any seed below 2147483648. The
|
```output
|
||||||
answer is taken from the middle bits because the low bits of a power-of-two modulus
|
ROLL 1
|
||||||
barely change from one call to the next. This used to be required; it is now built in.
|
ROLL 5
|
||||||
|
ROLL 2
|
||||||
|
ROLL 1
|
||||||
|
ROLL 2
|
||||||
|
```
|
||||||
|
|
||||||
</details>
|
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
|
||||||
|
```
|
||||||
|
|
||||||
`HELD#` is the flag Step 6's loop tests: while it is 1 the ball sits on the paddle, and
|
`HELD#` is the flag Step 6's loop tests: while it is 1 the ball sits on the paddle, and
|
||||||
`HOLDBAL` keeps it there:
|
`HOLDBAL` keeps it there:
|
||||||
@@ -1418,7 +1422,9 @@ PX# = PX# + D#
|
|||||||
RETURN
|
RETURN
|
||||||
|
|
||||||
LABEL DEMOAIM
|
LABEL DEMOAIM
|
||||||
DOFF# = RND(81) - 40
|
RMAX# = 81
|
||||||
|
GOSUB RANDOM
|
||||||
|
DOFF# = RND# - 40
|
||||||
RETURN
|
RETURN
|
||||||
```
|
```
|
||||||
|
|
||||||
@@ -1495,7 +1501,7 @@ This is the shape of the whole file:
|
|||||||
LABEL SETUP the geometry from Step 2
|
LABEL SETUP the geometry from Step 2
|
||||||
the declaration block from Step 3
|
the declaration block from Step 3
|
||||||
the brick faces from Step 5
|
the brick faces from Step 5
|
||||||
RND(n) seeds itself from the host clock
|
SEED# = TI#
|
||||||
the ceiling from Step 9
|
the ceiling from Step 9
|
||||||
GOSUB MKSPR Step 4
|
GOSUB MKSPR Step 4
|
||||||
GOSUB SNDPROBE Step 14
|
GOSUB SNDPROBE Step 14
|
||||||
@@ -1570,7 +1576,10 @@ BB# = 0
|
|||||||
RX# = 0
|
RX# = 0
|
||||||
N# = 0
|
N# = 0
|
||||||
MROW# = 0
|
MROW# = 0
|
||||||
|
RMAX# = 2
|
||||||
|
RND# = 0
|
||||||
SND# = 0
|
SND# = 0
|
||||||
|
SEED# = 0
|
||||||
P$ = ""
|
P$ = ""
|
||||||
H$ = ""
|
H$ = ""
|
||||||
S$ = ""
|
S$ = ""
|
||||||
|
|||||||
@@ -246,6 +246,16 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_collect_subscripts(akbasi
|
|||||||
*/
|
*/
|
||||||
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_create(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest);
|
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_create(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest);
|
||||||
|
|
||||||
|
/**
|
||||||
|
* @brief Create a variable slot without allocating value storage.
|
||||||
|
*
|
||||||
|
* Used when the caller knows the variable's representation before its first
|
||||||
|
* initialization, such as a structure parameter. The caller must initialize
|
||||||
|
* the variable before evaluating it.
|
||||||
|
*/
|
||||||
|
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_create_empty(akbasic_Environment *obj, const char *varname,
|
||||||
|
akbasic_Variable **dest);
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief Resolve a label to the line number it marks.
|
* @brief Resolve a label to the line number it marks.
|
||||||
* @param obj Scope to search; the parent chain is walked.
|
* @param obj Scope to search; the parent chain is walked.
|
||||||
|
|||||||
@@ -252,11 +252,6 @@ typedef struct akbasic_Runtime
|
|||||||
*/
|
*/
|
||||||
int64_t timems;
|
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
|
* 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.
|
* belong to the arm it did not take, and cleared at the top of every line.
|
||||||
|
|||||||
@@ -306,7 +306,23 @@ akerr_ErrorContext *akbasic_environment_get(akbasic_Environment *obj, const char
|
|||||||
SUCCEED_RETURN(errctx);
|
SUCCEED_RETURN(errctx);
|
||||||
}
|
}
|
||||||
|
|
||||||
akerr_ErrorContext *akbasic_environment_create(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest)
|
/**
|
||||||
|
* @brief Create a variable slot in the given scope, optionally allocating its storage.
|
||||||
|
*
|
||||||
|
* Shared by akbasic_environment_create() and akbasic_environment_create_empty(),
|
||||||
|
* which differ only in whether the new variable's value storage is initialized
|
||||||
|
* immediately or left for the caller to set up.
|
||||||
|
*
|
||||||
|
* @param obj Scope the variable is created in; only this scope is searched or
|
||||||
|
* written to, unlike akbasic_environment_get()'s walk up the parent chain.
|
||||||
|
* @param varname Name of the variable to create.
|
||||||
|
* @param dest Set to the created (or already-existing) variable.
|
||||||
|
* @param initialize When true, the variable's value storage is allocated from
|
||||||
|
* the runtime's value pool; when false, the caller must initialize it
|
||||||
|
* before the variable is evaluated.
|
||||||
|
*/
|
||||||
|
static akerr_ErrorContext *environment_create_named(akbasic_Environment *obj, const char *varname,
|
||||||
|
akbasic_Variable **dest, bool initialize)
|
||||||
{
|
{
|
||||||
PREPARE_ERROR(errctx);
|
PREPARE_ERROR(errctx);
|
||||||
akbasic_Variable *variable = NULL;
|
akbasic_Variable *variable = NULL;
|
||||||
@@ -340,12 +356,49 @@ akerr_ErrorContext *akbasic_environment_create(akbasic_Environment *obj, const c
|
|||||||
PASS(errctx, aksl_strcpy(variable->name, sizeof(variable->name), varname));
|
PASS(errctx, aksl_strcpy(variable->name, sizeof(variable->name), varname));
|
||||||
variable->valuetype = AKBASIC_TYPE_UNDEFINED;
|
variable->valuetype = AKBASIC_TYPE_UNDEFINED;
|
||||||
variable->mutable_ = true;
|
variable->mutable_ = true;
|
||||||
|
if ( initialize ) {
|
||||||
PASS(errctx, akbasic_variable_init(variable, &obj->runtime->valuepool, sizes, 1));
|
PASS(errctx, akbasic_variable_init(variable, &obj->runtime->valuepool, sizes, 1));
|
||||||
|
}
|
||||||
PASS(errctx, akbasic_symtab_set(&obj->variables, varname, variable, 0));
|
PASS(errctx, akbasic_symtab_set(&obj->variables, varname, variable, 0));
|
||||||
*dest = variable;
|
*dest = variable;
|
||||||
SUCCEED_RETURN(errctx);
|
SUCCEED_RETURN(errctx);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* @brief Find a variable in this scope, creating and initializing it if absent.
|
||||||
|
*
|
||||||
|
* @param obj The scope to search and, on a miss, to create in.
|
||||||
|
* @param varname Name including its type suffix.
|
||||||
|
* @param dest Output destination populated with the variable.
|
||||||
|
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||||
|
*/
|
||||||
|
akerr_ErrorContext *akbasic_environment_create(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest)
|
||||||
|
{
|
||||||
|
PREPARE_ERROR(errctx);
|
||||||
|
|
||||||
|
PASS(errctx, environment_create_named(obj, varname, dest, true));
|
||||||
|
SUCCEED_RETURN(errctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* @brief Find a variable in this scope, creating it without value storage if absent.
|
||||||
|
*
|
||||||
|
* The caller must initialize the variable before evaluating it.
|
||||||
|
*
|
||||||
|
* @param obj The scope to search and, on a miss, to create in.
|
||||||
|
* @param varname Name including its type suffix.
|
||||||
|
* @param dest Output destination populated with the variable.
|
||||||
|
* @return `NULL` on success, otherwise an error context owned by the caller.
|
||||||
|
*/
|
||||||
|
akerr_ErrorContext *akbasic_environment_create_empty(akbasic_Environment *obj, const char *varname,
|
||||||
|
akbasic_Variable **dest)
|
||||||
|
{
|
||||||
|
PREPARE_ERROR(errctx);
|
||||||
|
|
||||||
|
PASS(errctx, environment_create_named(obj, varname, dest, false));
|
||||||
|
SUCCEED_RETURN(errctx);
|
||||||
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Evaluate an lvalue's subscript list, if it has one, into `subscripts`. A bare
|
* 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
|
* identifier yields the single subscript {0}, which is how a scalar is addressed
|
||||||
|
|||||||
@@ -989,12 +989,13 @@ static akerr_ErrorContext *bind_structure_parameter(akbasic_Runtime *obj, akbasi
|
|||||||
obj->structtypes.types[typeindex].name,
|
obj->structtypes.types[typeindex].name,
|
||||||
obj->structtypes.types[argvalue->structtype].name);
|
obj->structtypes.types[argvalue->structtype].name);
|
||||||
|
|
||||||
PASS(errctx, akbasic_environment_create(callenv, param->identifier, &variable));
|
PASS(errctx, akbasic_environment_create_empty(callenv, param->identifier, &variable));
|
||||||
sizes[0] = (ispointer ? 1 : obj->structtypes.types[typeindex].slotcount);
|
sizes[0] = (ispointer ? 1 : obj->structtypes.types[typeindex].slotcount);
|
||||||
|
/* A pointer parameter's own reference cannot escape its call scope. */
|
||||||
|
variable->ispointer = ispointer;
|
||||||
PASS(errctx, akbasic_variable_init(variable, &obj->valuepool, sizes, 1));
|
PASS(errctx, akbasic_variable_init(variable, &obj->valuepool, sizes, 1));
|
||||||
variable->valuetype = AKBASIC_TYPE_STRUCT;
|
variable->valuetype = AKBASIC_TYPE_STRUCT;
|
||||||
variable->structtype = typeindex;
|
variable->structtype = typeindex;
|
||||||
variable->ispointer = ispointer;
|
|
||||||
|
|
||||||
if ( ispointer ) {
|
if ( ispointer ) {
|
||||||
PASS(errctx, akbasic_value_clone(argvalue, &variable->values[0]));
|
PASS(errctx, akbasic_value_clone(argvalue, &variable->values[0]));
|
||||||
|
|||||||
@@ -183,69 +183,6 @@ akerr_ErrorContext *akbasic_fn_chr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
|
|||||||
SUCCEED_RETURN(errctx);
|
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)
|
akerr_ErrorContext *akbasic_fn_hex(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
|
||||||
{
|
{
|
||||||
PREPARE_ERROR(errctx);
|
PREPARE_ERROR(errctx);
|
||||||
|
|||||||
@@ -99,18 +99,21 @@ akerr_ErrorContext *akbasic_variable_init(akbasic_Variable *obj, akbasic_ValuePo
|
|||||||
* the run was over, which a game loop reaches in half a minute. TODO.md
|
* the run was over, which a game loop reaches in half a minute. TODO.md
|
||||||
* section 6 item 30 has the whole reduction.
|
* section 6 item 30 has the whole reduction.
|
||||||
*
|
*
|
||||||
* **A `@` name is the one exclusion**, and it is the whole of it. A
|
* **A `@` name is the one exclusion**, except for a one-slot pointer
|
||||||
* structure or a pointer to one keeps pool storage because a pointer may
|
* parameter. A structure or a pointer variable keeps pool storage because
|
||||||
* outlive the scope that DIMmed it -- docs/16-structures.md says nothing is
|
* a pointer may outlive the scope that DIMmed it -- docs/16-structures.md
|
||||||
* reclaimed and akbasic_runtime_prev_environment() relies on it. The suffix
|
* says nothing is reclaimed and akbasic_runtime_prev_environment() relies
|
||||||
* is the right test rather than `structtype`, which the DIM path sets
|
* on it. A pointer parameter owns only its reference slot; the target is
|
||||||
|
* owned by the caller, so bind_structure_parameter() marks it before this
|
||||||
|
* call and lets that slot use inline storage. The suffix is the right test
|
||||||
|
* for every other case rather than `structtype`, which the DIM path sets
|
||||||
* *after* calling this.
|
* *after* calling this.
|
||||||
*
|
*
|
||||||
* Otherwise: reuse the existing slice when it is already big enough, which
|
* Otherwise: reuse the existing slice when it is already big enough, which
|
||||||
* makes a re-DIM to the same or a smaller size free; growing takes fresh
|
* makes a re-DIM to the same or a smaller size free; growing takes fresh
|
||||||
* slots and abandons the old ones, as documented on akbasic_ValuePool.
|
* slots and abandons the old ones, as documented on akbasic_ValuePool.
|
||||||
*/
|
*/
|
||||||
if ( totalsize == 1 && lastchar != '@' ) {
|
if ( totalsize == 1 && (lastchar != '@' || obj->ispointer) ) {
|
||||||
obj->values = &obj->inlinevalue;
|
obj->values = &obj->inlinevalue;
|
||||||
} else if ( obj->values == NULL || obj->valuecount < (int)totalsize ) {
|
} else if ( obj->values == NULL || obj->valuecount < (int)totalsize ) {
|
||||||
PASS(errctx, akbasic_valuepool_take(pool, (int)totalsize, &obj->values));
|
PASS(errctx, akbasic_valuepool_take(pool, (int)totalsize, &obj->values));
|
||||||
|
|||||||
@@ -37,7 +37,6 @@ static const akbasic_Verb VERBS[] = {
|
|||||||
{ "ABS", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_abs },
|
{ "ABS", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_abs },
|
||||||
{ "AND", AKBASIC_TOK_AND, -1, NULL, NULL },
|
{ "AND", AKBASIC_TOK_AND, -1, NULL, NULL },
|
||||||
{ "APPEND", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_append },
|
{ "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 },
|
{ "ATN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_atn },
|
||||||
{ "AUTO", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_auto },
|
{ "AUTO", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_auto },
|
||||||
{ "BACKUP", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_backup },
|
{ "BACKUP", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_backup },
|
||||||
@@ -147,7 +146,6 @@ static const akbasic_Verb VERBS[] = {
|
|||||||
{ "RGR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rgr },
|
{ "RGR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rgr },
|
||||||
{ "RIGHT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_right },
|
{ "RIGHT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_right },
|
||||||
{ "RMENU", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rmenu },
|
{ "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 },
|
{ "RSPCOLOR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rspcolor },
|
||||||
{ "RSPHIT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rsphit },
|
{ "RSPHIT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rsphit },
|
||||||
{ "RSPPOS", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rsppos },
|
{ "RSPPOS", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rsppos },
|
||||||
|
|||||||
@@ -140,7 +140,6 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_stop(struct akbasic_Runtime *obj,
|
|||||||
|
|
||||||
/* Function handlers -- src/runtime_functions.c */
|
/* 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_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_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_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_cos(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||||
@@ -155,7 +154,6 @@ 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_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_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_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_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_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_shl(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
|
||||||
|
|||||||
@@ -1,3 +0,0 @@
|
|||||||
10 PRINT "97 : " + ASC("a")
|
|
||||||
20 PRINT "65 : " + ASC("A")
|
|
||||||
30 PRINT "64 : " + ASC("@")
|
|
||||||
@@ -1,3 +0,0 @@
|
|||||||
97 : 97
|
|
||||||
65 : 65
|
|
||||||
64 : 64
|
|
||||||
@@ -162,26 +162,6 @@ int main(void)
|
|||||||
expect_int("A# = INSTR(\"HELLO\", \"LL\")", 2);
|
expect_int("A# = INSTR(\"HELLO\", \"LL\")", 2);
|
||||||
expect_int("A# = INSTR(\"HELLO\", \"ZZ\")", -1);
|
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. */
|
/* An unknown verb is diagnosed rather than silently ignored. */
|
||||||
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
|
||||||
TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, NULL, &out),
|
TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, NULL, &out),
|
||||||
|
|||||||
@@ -183,6 +183,33 @@ static void test_structure_parameters(void)
|
|||||||
harness_stop();
|
harness_stop();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* @brief Pointer parameters do not consume value-pool slots per call.
|
||||||
|
*
|
||||||
|
* The pointer's parameter variable owns only one reference to the caller's
|
||||||
|
* record, so that reference can live in the variable's inline slot. The target
|
||||||
|
* remains in the caller's storage. One pointer parameter and 8,000 calls make
|
||||||
|
* one leaked slot per call fail against the 4,096-slot value pool.
|
||||||
|
*/
|
||||||
|
static void test_pointer_parameters_do_not_leak_value_slots(void)
|
||||||
|
{
|
||||||
|
TEST_REQUIRE_OK(run_program_bounded("10 TYPE CRATE\n"
|
||||||
|
"20 W#\n"
|
||||||
|
"30 END TYPE\n"
|
||||||
|
"40 DIM A@ AS CRATE\n"
|
||||||
|
"50 DIM P@ AS PTR TO CRATE\n"
|
||||||
|
"60 POINT P@ AT A@\n"
|
||||||
|
"70 DEF POKEIT(P@ AS PTR TO CRATE)\n"
|
||||||
|
"80 P@->W# = P@->W# + 1\n"
|
||||||
|
"90 RETURN P@->W#\n"
|
||||||
|
"100 FOR I# = 1 TO 8000\n"
|
||||||
|
"110 R# = POKEIT(P@)\n"
|
||||||
|
"120 NEXT I#\n"
|
||||||
|
"130 PRINT A@.W#\n", 1000000));
|
||||||
|
TEST_REQUIRE_STR(HARNESS_OUTPUT, "8000\n");
|
||||||
|
harness_stop();
|
||||||
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief A structure parameter must name its type, and the type is checked.
|
* @brief A structure parameter must name its type, and the type is checked.
|
||||||
*
|
*
|
||||||
@@ -454,6 +481,7 @@ int main(void)
|
|||||||
test_runaway_recursion_is_diagnosed();
|
test_runaway_recursion_is_diagnosed();
|
||||||
test_single_expression_form();
|
test_single_expression_form();
|
||||||
test_structure_parameters();
|
test_structure_parameters();
|
||||||
|
test_pointer_parameters_do_not_leak_value_slots();
|
||||||
test_structure_parameter_types_are_checked();
|
test_structure_parameter_types_are_checked();
|
||||||
test_call_scopes_are_reclaimed();
|
test_call_scopes_are_reclaimed();
|
||||||
test_calls_do_not_leak_value_slots();
|
test_calls_do_not_leak_value_slots();
|
||||||
|
|||||||
Reference in New Issue
Block a user