Re: Neolithic Tiny Basic
Posted: Sun Mar 02, 2025 9:53 am
Right, that's improved for/next in a number of ways:
Neil
- renamed some variables for clarity
- removed an unneeded variable, which reduces stack use
- changed the comparison to an equality, which solves the odd issues I was seeing when the index crossed zero
- autoincrement the 'to' value, which allows the equality above to work correctly: 'for q = 10 to 10' runs once, as expected; 'for q = 1 to 10' runs ten times with q ranging from 1 to 10, as expected.
Code: Select all
for:
to_val set 1 ; local variables on stack
name set 2 ; only one byte but allocate two
next_where set 3
where set 4
; int16_t to_val; // to
; char name; // and which variable is the counter?
; char * next_where; // the address of that line
phx
tsx
phx
phx ; to_val
phx
phx ; name
phx
phx ; next_where
; // as always, we start pointing at the do token, so need to go back
; where -= 4;
sec
sbc #4
bcs for_01
dey ; where = where - 4
for_01:
phy
pha
; where = find_next_line(where);
; next_where = where;
jsr find_next_line
STAZXLO where
STAZXLO next_where
tya
STAZXHI where
STAZXHI next_where
; GetChar();
jsr getchar
; SkipWhite();
jsr skipwhite
; if (!isalpha (Look))
lda look
jsr isalpha
bcs for_1
; {
; // not a variable?
; where = NULL;
lda #0
STAZXLO where
STAZXHI where
; //Expected("variable");
; err = ERR_SYNTAX;
lda #ERR_SYNTAX
sta err
jmp for_99
; }
; else
for_1:
; {
; // one of the 26 signed integer variables
; name = GetName ();
jsr getname
; name = name - 'A';
sec
sbc #'A'
asl a ; a <- 0, b <- 2, etc
STAZXLO name ; save index to var
; SkipWhite();
jsr skipwhite
; Match (EQUAL);
lda #EQUAL
jsr match
; vars[name] = Expression(); // the start value
jsr expression
phy
LDYZXLO name ; the name index
sta vars,y
pla
sta vars+1,y
; SkipWhite();
jsr skipwhite
; Match (TO);
lda #TO
jsr match
; to_val = Expression() + 1; // the end value
jsr expression
clc
adc #1
bcc for_11
iny
for_11:
STAZXLO to_val
tya
STAZXHI to_val
for_20:
; do
; {
; // recursively execute lines until 'next'
; while (NULL != where)
LDAZXLO where
ORAZXHI where
beq for_22 ; finished if zero
; {
for_21:
; where = execute(where);
pla
ply
jsr execute
phy
pha
; if (ERR_NONE != err)
lda err
; break;
bne for_30
; }
bra for_20
for_22:
; where = next_where;
LDAZXLO next_where
STAZXLO where
LDAZXHI next_where
STAZXHI where
; vars[name]++; // normal step value
LDYZXLO name
clc
lda vars,y
adc #1
sta vars,y
lda vars+1,y
adc #0
sta vars+1,y
; }
; while ((vars[name] != to_val) && (ERR_NONE == err));
lda err
bne for_30 ; quit if there was an error
lda vars,y
CMPZXLO to_val
bne for_20 ; low byte not equal, do more
lda vars+1,y
CMPZXHI to_val ; else test high byte
bne for_20
for_30:
; where = find_pair (next_where, FOR);
lda #FOR
sta fmt_pair
lda #NEXT
sta fmt_match
pla
ply
jsr find_matching_token
; where = find_next_line(where);
jsr find_next_line
phy
pha
; }
for_99:
; return where;
pla
ply ; get where
plx
plx ; discard next_where
plx
plx ; discard for_name
plx
plx ; discard to_val
plx ; restore caller stack frame
rts;}
though it's ENDWHILE internally). While/wend loops zero or more times.
)