initial upload
This commit is contained in:
Luxferre
@@ -0,0 +1,59 @@
|
||||
# Luxferre's Truly Tiny BASIC (LTTB) implementations
|
||||
|
||||
## About
|
||||
|
||||
Luxferre's Truly Tiny BASIC (henceforth LTTB) is a lean dialect of the BASIC programming language, originally based upon the [Dennis Allison's design notes for Tiny BASIC](http://www.ittybittycomputers.com/IttyBitty/TinyBasic/DDJ1/Design.html) with some improvements inspired by [Tom Pittman's](http://www.ittybittycomputers.com/IttyBitty/TinyBasic/TBuserMan.htm) 6800 Tiny BASIC variant. Just like the original Tiny BASIC designs, LTTB aims for maximum portability and minimum implementation complexity.
|
||||
|
||||
## Specification
|
||||
|
||||
The LTTB specification expands upon the original Design Notes in the following manner:
|
||||
|
||||
- Line numbers from 1 to 32767 are supported.
|
||||
- A special pseudo-variable `$` is introduced, which holds a random number from 0 to 9999.
|
||||
- Any invalid statement (including `REM`) can be used for comments.
|
||||
- No command can be abbreviated inside `IF` statements.
|
||||
- `LET` and `THEN` keywords are optional.
|
||||
- `IF` statements also allow inserting line numbers after `THEN`, making it possible to write self-modifying programs.
|
||||
- The `NEW` command is synonym to `CLEAR`.
|
||||
- The `BYE` command can be used to exit the interpreter.
|
||||
- In the environments that support file systems or some kind of external file I/O, the `LOAD` command can be used to load BASIC programs into memory, and the `SAVE` command can be used to save BASIC programs from memory.
|
||||
|
||||
See the [manual](lttb-manual.md) for more details on every supported command and the [examples](examples/) directory for working examples.
|
||||
|
||||
## Implementations
|
||||
|
||||
Here are all currently known implementations of LTTB:
|
||||
|
||||
* [Jim Tcl port](./lttb.tcl)
|
||||
|
||||
## FAQ
|
||||
|
||||
Please read the [manual](lttb-manual.md) first, your question is most likely covered there. If not, here are some more questions and answers.
|
||||
|
||||
### Why make another Tiny BASIC clone in 2026?
|
||||
|
||||
Because it's a 1) great benchmark for any languages I'm currently mastering, 2) way to run vintage software and games, 3) nice practice for classic, hand-crafted coding.
|
||||
|
||||
Besides, the goal is not just to make one implementation and call it a day, but to port it to as many host languages and platforms as possible. I'd even say that eventually the implementations themselves may become more of a byproduct and the main value will reside in the design docs crystallized in the process.
|
||||
|
||||
### Which TB dialects is LTTB compatible with?
|
||||
|
||||
In general, you should be able to run anything compatible with:
|
||||
|
||||
* the original [Design Notes](http://www.ittybittycomputers.com/IttyBitty/TinyBasic/DDJ1/Design.html) by Dennis Allison;
|
||||
* the original Tom Pittman's 6800TB (if the program doesn't have any `USR` or `RND` calls and has proper spacing between the command and the rest of the statement);
|
||||
* the [Damian Gareth Walker's implementation](http://tinybasic.cyningstan.org.uk/), provided all program lines are properly numbered (because that implementation uses auto–numbering when loading the programs).
|
||||
|
||||
### Will there be any TBX (Tiny BASIC Extended) or PATB (Palo Alto Tiny BASIC) compatibility?
|
||||
|
||||
No way.
|
||||
|
||||
### But are the existing implementations really tiny?
|
||||
|
||||
I think 300 SLOC of Jim Tcl for the entire interpreter (including the banner etc) is pretty tiny. Other implementations are also projected to be within this ballpark.
|
||||
|
||||
## Credits
|
||||
|
||||
Inspired by the great works of Dennis Allison and Tom Pittman.
|
||||
|
||||
All LTTB implementations in this repo were created by Luxferre in 2026 and released into the public domain with no warranties.
|
||||
@@ -0,0 +1,48 @@
|
||||
REM
|
||||
REM --- Tiny BASIC Interpreter and Compiler Project
|
||||
REM --- Lunar Lander Demonstration Game
|
||||
REM
|
||||
REM --- Released as Public Domain by Damian Gareth Walker 2019
|
||||
REM --- Created: 15-Aug-2019
|
||||
REM
|
||||
|
||||
REM --- Variables:
|
||||
REM A: altitude
|
||||
REM B: fuel to burn this turn
|
||||
REM F: fuel remaining
|
||||
REM T: time elapsed
|
||||
REM V: velocity this turn
|
||||
REM W: velocity next turn
|
||||
|
||||
REM --- Initialise the Program
|
||||
50 LET A=1000
|
||||
51 LET B=0
|
||||
52 LET F=150
|
||||
53 LET V=50
|
||||
54 LET T=0
|
||||
|
||||
REM --- Main Loop
|
||||
100 PRINT "Time:",T," Alt:",A," Velocity:",V," Fuel:",F," Thrust:",B
|
||||
111 IF F>30 THEN PRINT "Thrust (0-30)?"
|
||||
112 IF F<31 THEN PRINT "Thrust (0-",F,")?"
|
||||
113 INPUT B
|
||||
114 IF B>=0 THEN IF B<=30 THEN IF B<=F THEN GOTO 120
|
||||
115 GOTO 111
|
||||
120 LET W=V-B+5
|
||||
121 LET F=F-B
|
||||
122 LET A=A-(V+W)/2
|
||||
123 LET V=W
|
||||
124 LET T=T+1
|
||||
125 IF A>0 THEN GOTO 100
|
||||
|
||||
REM --- End of Game
|
||||
126 IF V<5 THEN GOTO 140
|
||||
127 PRINT "You crashed!"
|
||||
130 GOTO 160
|
||||
140 IF A<0 THEN GOTO 150
|
||||
141 PRINT "Perfect landing!"
|
||||
142 GOTO 160
|
||||
150 PRINT "Touchdown."
|
||||
160 IF A<0 THEN LET A=0
|
||||
165 PRINT "Time:",T," Alt:",A," Velocity:",V," Fuel:",F
|
||||
170 END
|
||||
@@ -0,0 +1,75 @@
|
||||
REM
|
||||
REM --- Tiny BASIC Interpreter and Compiler Project
|
||||
REM --- Mugwump Demonstration Game
|
||||
REM
|
||||
REM --- Released as Public Domain by Damian Gareth Walker 2019
|
||||
REM --- Created: 13-Aug-2019
|
||||
REM
|
||||
|
||||
REM --- Variables
|
||||
REM C: axis diff between player guess and mugwump position
|
||||
REM D: distance between player guess and mugwump position
|
||||
REM G: mugwump column
|
||||
REM H: mugwump row
|
||||
REM M: moves taken
|
||||
REM R: random number generator seed
|
||||
REM X: player guess column
|
||||
REM Y: player guess row
|
||||
|
||||
REM --- Initialise the random number generator
|
||||
1 PRINT "Think of a number."
|
||||
2 INPUT R
|
||||
3 IF R<0 THEN LET R=0
|
||||
4 IF R>4095 THEN LET R=4095
|
||||
|
||||
REM --- Initialise the game
|
||||
5 GOSUB 200
|
||||
6 LET G=R-(R/10*10)
|
||||
6 GOSUB 200
|
||||
7 LET H=R-(R/10*10)
|
||||
8 LET M=0
|
||||
|
||||
REM --- Input player guess
|
||||
10 PRINT "Where is the mugwump? Enter column then row."
|
||||
11 INPUT X,Y
|
||||
12 IF X>=0 THEN IF X<=9 THEN IF Y>=0 THEN IF Y<=9 THEN GOTO 20
|
||||
13 PRINT "That location is off the grid!"
|
||||
14 GOTO 10
|
||||
|
||||
REM --- Process player guess
|
||||
20 LET M=M+1
|
||||
21 PRINT "The mugwump is..."
|
||||
22 LET D=0
|
||||
23 LET C=G-X
|
||||
24 GOSUB 60
|
||||
25 LET C=H-Y
|
||||
26 GOSUB 60
|
||||
27 IF D=0 THEN GOTO 40
|
||||
28 PRINT "...",D," cells away."
|
||||
29 IF M>10 THEN GOTO 50
|
||||
30 PRINT "You have taken ",M," turns so far."
|
||||
35 GOTO 10
|
||||
|
||||
REM --- Player has won
|
||||
40 PRINT "...RIGHT HERE!"
|
||||
45 PRINT "You took ",M," turns to find it."
|
||||
47 END
|
||||
|
||||
REM --- Player has lost
|
||||
50 PRINT "You have taken too long over this. You lose!"
|
||||
END
|
||||
|
||||
REM --- Helper subroutine to calculate distance from player to mugwump
|
||||
REM Inputs: C - difference in rows or columns
|
||||
REM D - running total distance
|
||||
REM Output: D - running total distance, updated
|
||||
60 IF C<0 THEN LET C=-C
|
||||
65 LET D=D+C
|
||||
70 RETURN
|
||||
|
||||
REM --- Random number generator
|
||||
REM Input: R - current seed
|
||||
REM Outputs: R - updated seed
|
||||
200 LET R=5*R+35
|
||||
210 LET R=R-R/4096*4096
|
||||
220 RETURN
|
||||
@@ -0,0 +1,14 @@
|
||||
10 print "number";
|
||||
20 input x
|
||||
30 g=x/2
|
||||
40 if x>=16 THEN g=x/4
|
||||
50 if x>=64 g=x/8
|
||||
60 if x>=256 g=x/16
|
||||
70 if x>=4096 g=x/64
|
||||
80 if x>=16384 g=x/128
|
||||
90 p=g
|
||||
100 g=(g+x/g)/2
|
||||
110 if g-p>1 goto 90
|
||||
120 if p-g>1 goto 90
|
||||
130 print "square root is ";g
|
||||
140 end
|
||||
+163
@@ -0,0 +1,163 @@
|
||||
# Luxferre's Truly Tiny BASIC specification and user manual
|
||||
|
||||
Luxferre's Truly Tiny BASIC (henceforth LTTB) is a lean dialect of the BASIC programming language, originally based upon the [Dennis Allison's design notes for Tiny BASIC](http://www.ittybittycomputers.com/IttyBitty/TinyBasic/DDJ1/Design.html) with some improvements inspired by [Tom Pittman's](http://www.ittybittycomputers.com/IttyBitty/TinyBasic/TBuserMan.htm) 6800 Tiny BASIC variant. Just like the original Tiny BASIC designs, LTTB aims for maximum portability and minimum implementation complexity.
|
||||
|
||||
## General features
|
||||
|
||||
* 16-bit signed integers (from -32768 to 32767) as the only data type
|
||||
* String literals (only allowed in the `PRINT` statements, usually auto-uppercased)
|
||||
* 26 single-letter variables available (`A` to `Z`)
|
||||
* A special pseudo-variable `$` holding a random number from 0 to 9999
|
||||
* Line numbering from 1 to 32767
|
||||
* Unbounded subroutine call stack
|
||||
* Supported commands: `LET`, `IF ... THEN`, `INPUT`, `PRINT`, `GOTO`, `GOSUB`, `RETURN`, `END`, `LIST`, `CLEAR` (synonym `NEW`), `RUN`, `LOAD`, `SAVE`, `BYE`
|
||||
* Any invalid command is ignored, so it still is possible to use e.g. `REM` for comments
|
||||
* Allowed operations within expressions: `+`, `-`, `*`, `/`, parentheses `()`
|
||||
* Allowed relational operators with `IF` statements: `=`, `<>` (synonym `><`), `>`, `>=`, `<`, `<=`
|
||||
|
||||
## The interpreter
|
||||
|
||||
Just like any other Tiny BASIC variant, LTTB provides a full interactive programming environment. Whenever the `> ` prompt appears, you can type in **statements** and, depending on whether or not they begin with line numbers, they are either stored into the interpreter's **working memory** or get executed directly.
|
||||
|
||||
Some commands (`LIST`, `CLEAR`/`NEW`, `RUN`, `LOAD`, `SAVE`, `BYE`) are only available to the user in the interactive session and not from within a loaded BASIC program.
|
||||
|
||||
## Expressions
|
||||
|
||||
Expressions in LTTB are any valid mathematical formulas that only use the allowed operations mentioned above, integer numbers in the allowed range (-32768 to 32767) and single-letter uppercase variable names (`A` to `Z`). LTTB fully supports arithmetic precedence rules (e.g. `2 + 2 * 2` will evaluate to 6) and unlimited parentheses nesting.
|
||||
|
||||
Division is a special case in LTTB. First, all division is integer, so the results get truncated (**not rounded**) to their whole part. E.g. both `37/3` and `38/3` will evaluate to 12. Second, division by zero is left undefined, and its handling is fully left up to the implementation: it can just return zero, emit a runtime error or do something else.
|
||||
|
||||
Similarly to other Tiny BASIC implementations, LTTB does not support a dedicated modulo operator but it can easily be simulated thanks to the properties of division being integer only. E.g. X % 37 can be rewritten as `X - X/37*37` in LTTB.
|
||||
|
||||
In case the evaluation result is outside the allowed range, it is automatically converted to this range (by taking it modulo 65536 and then subtracting 32768 if the modulo is over 32767) after every evaluation.
|
||||
|
||||
## Statements
|
||||
|
||||
A **statement** in LTTB is a standalone execution unit. It usually corresponds to a single program line, with the exception of using it inside an `IF` statement (see below).
|
||||
|
||||
A statement consists of an optional line number, a command and the arguments that command expects, including expressions, variables or other statements.
|
||||
|
||||
If a statement is entered with a line number, the corresponding command with its arguments is written into the working memory under that number. Otherwise, it gets executed directly as soon as it's entered.
|
||||
|
||||
## Comments
|
||||
|
||||
In LTTB, any invalid command, including `REM`, can start a comment.
|
||||
|
||||
## Core commands
|
||||
|
||||
The following commands are the core of LTTB.
|
||||
|
||||
### `(LET )[var]=[expr]`
|
||||
|
||||
Evaluates the expression `[expr]` and assigns the result to the variable `[var]`. `LET` is the only core command keyword that can be omitted in LTTB, because `[var]=` is enough to detect the assignment statement.
|
||||
|
||||
Examples: `let x=10`, `y = RND(1000)+8`
|
||||
|
||||
### `IF [expr1] [relop] [expr2] THEN [stmt]`
|
||||
|
||||
Execute a statement `[stmt]` if the relation denoted by `relop` holds between `[expr1]` and `[expr2]`. Unlike most other TB implementations, `THEN` is mandatory in LTTB.
|
||||
|
||||
Examples: `IF A > B THEN LET C = A-B`, `IF X<1000 THEN GOTO 400`
|
||||
|
||||
Non-standard extension: if the `[stmt]` statement starts with a line number, LTTB doesn't execute it immediately but instead overwrites the original line with the number it starts with. This allows writing self-modifying programs in LTTB.
|
||||
|
||||
### `GOTO [expr]`
|
||||
|
||||
Direct jump. Evaluates `[expr]` to a line number and continues execution of the program from that line number. If the computed line number is outside the valid range (1 to 32767), the program halts.
|
||||
|
||||
Because `GOTO` accepts any valid expressions and not just numbers, indirect jumps are possible.
|
||||
|
||||
Unlike the original Tiny BASIC implementations, `GOTO` with a nonexistent line number does not emit a runtime error, as the instruction pointer just advances to the closest existing one. If there are no more lines left after this number in the working memory, the program will halt as well.
|
||||
|
||||
### `GOSUB [expr]`
|
||||
|
||||
Subroutine call. Pushes the current position onto the call stack, then does `GOTO [expr]`.
|
||||
|
||||
### `RETURN`
|
||||
|
||||
Return from a subroutine. Pops the position `pos` from the call stack, then does `GOTO pos+1`.
|
||||
|
||||
### `INPUT [var](, [var2]...)`
|
||||
|
||||
Get the values of one or more variables from the standard input. Before saving, each input value is evaluated as an expression. When inputting several values at once, the only **required** expression separator is a comma.
|
||||
|
||||
### `PRINT ("string"|[expr])(,;)("string"|[expr])(,;)...`
|
||||
|
||||
Print literal string(s) or expression value(s) to the standard output. Then, print a newline character, **unless** the `PRINT` statement ends with a comma or a semicolon.
|
||||
|
||||
Unless inside a quoted string, every comma in the statement prints a tabulation character (TAB, `\t`, ASCII 9) or its equivalent on the target system, and every semicolon does not print anything and only serves as a joiner between the print list items.
|
||||
|
||||
All non-quoted whitespace is naturally squashed.
|
||||
|
||||
Depending on the implementation, string literals may or may not be automatically uppercased.
|
||||
|
||||
If an opening quote is detected but there's no closing quote, then the rest of the statement is treated like a string literal.
|
||||
|
||||
Example: `PRINT "X + Y IS "; X+Y ;" BUT A - B IS:", A-B` will output the first result within the sentence but the second result tabulated away.
|
||||
|
||||
### `END`
|
||||
|
||||
Halt the program, reset its instruction pointer and clear its call stack.
|
||||
|
||||
Unlike the original Tiny BASIC implementations, the `END` statement is optional in LTTB programs, in a sense that its absence doesn't emit any runtime error, but its presence still makes program execution much more efficient.
|
||||
|
||||
## Interactive commands
|
||||
|
||||
The following commands only make sense in an interactive session and will only work from there. However, `LIST` will also work from within a program source anyway.
|
||||
|
||||
### `LIST`
|
||||
|
||||
Output a listing of the program currently loaded in working memory. Line ranges are not supported.
|
||||
|
||||
### `RUN`
|
||||
|
||||
Set the instruction pointer to 1 and run the program currently loaded in working memory.
|
||||
|
||||
### `CLEAR` / `NEW`
|
||||
|
||||
Erase all the working, stack and variable memory areas.
|
||||
|
||||
### `LOAD`
|
||||
|
||||
Clear all existing memory contents and then load a program from external storage into the working memory. The program is entered line by line and processed exactly as if it had been typed into the interpreter.
|
||||
|
||||
This command takes no parameters by design. Depending on the implementation, it may:
|
||||
|
||||
* prompt the user to type a file path;
|
||||
* show an "Open file..." dialog box;
|
||||
* activate cassette input;
|
||||
* etc.
|
||||
|
||||
In case no way of loading from external storage is supported, the interpreter must notify the user that this command is not implemented.
|
||||
|
||||
### `SAVE`
|
||||
|
||||
Save a program from the working memory into external storage.
|
||||
|
||||
This command takes no parameters by design. Depending on the implementation, it may:
|
||||
|
||||
* prompt the user to type a file path;
|
||||
* show a "Save file..." dialog box;
|
||||
* activate cassette output;
|
||||
* etc.
|
||||
|
||||
In case no way of saving to external storage is supported, the interpreter must notify the user that this command is not implemented.
|
||||
|
||||
### `BYE`
|
||||
|
||||
Exit the interpreter, or restart it if exiting is not supported.
|
||||
|
||||
## Error messages
|
||||
|
||||
The interpreter should emit runtime errors in these cases:
|
||||
|
||||
* unknown commands in statements;
|
||||
* unmatched parentheses in expressions;
|
||||
* call stack underflow (e.g. `RETURN` with no prior `GOSUB`);
|
||||
* division by zero (optional).
|
||||
|
||||
## Additional features not covered by the specification but sometimes implemented
|
||||
|
||||
* Besides the `LOAD` command, if an interpreter is CLI-based, it should also support pre-`LOAD`-ing a single program from the file passed as a command line argument.
|
||||
* In order to be able to be used in a scripting fashion, some CLI implementations may also support autorunning the programs (and then auto-exiting the interpreter) in case they were preloaded from a file via a command line argument.
|
||||
* In general, all program lines `LOAD`-ed from a file must be numbered, otherwise they will be executed directly upon loading. However, an implementation may provide a feature, an option or a separate utility to auto-number lines loaded from existing .bas files. This would allow to enhance compatibility with the programs written for some other Tiny BASIC implementations, like [this one](http://tinybasic.cyningstan.org.uk/), without altering the source code manually.
|
||||
@@ -0,0 +1,344 @@
|
||||
#!/usr/bin/env jimsh
|
||||
# Luxferre's Truly Tiny BASIC (Jim Tcl implementation)
|
||||
# Based upon the original Tiny BASIC Design Notes by Dennis Allison
|
||||
# Created in 2026 by Luxferre, released into the public domain
|
||||
|
||||
set lttb_keywords {EN GO IF IN LE PR RE}
|
||||
lassign {{} {} {} 0} progmem callstack vars ip
|
||||
loop i 65 91 {set vars([format {%c} $i]) 0}
|
||||
|
||||
# Input line parser (single-pass)
|
||||
proc lttb_proginput {rawline} {
|
||||
set rawline [string trim $rawline]
|
||||
if {[string length $rawline] > 0} {
|
||||
lassign {0 0} lno i
|
||||
set l [string length $rawline]
|
||||
loop i $l {
|
||||
set c [string index $rawline $i]
|
||||
if {[string is space $c] || [string is digit $c]} {
|
||||
if {[string is digit $c]} {set lno $($lno * 10 + int($c))}
|
||||
} else {break}
|
||||
}
|
||||
set linebody [string toupper [string range $rawline $i end]]
|
||||
# populate program memory or execute directly
|
||||
if {$lno > 0} {
|
||||
global progmem
|
||||
dict set progmem $lno $linebody
|
||||
} else {lttb_exec $linebody}
|
||||
}
|
||||
}
|
||||
|
||||
# Main line interpreter
|
||||
proc lttb_exec {pline} {
|
||||
global lttb_keywords
|
||||
set kw [string range [lttb_stripspace $pline] 0 1]
|
||||
if {[string index $kw 1] eq {=}} {
|
||||
set kw LE
|
||||
set pline [string cat {LE } $pline]
|
||||
}
|
||||
set bi [string first { } $pline]
|
||||
set body [string trim [string range $pline $bi end]]
|
||||
if {$kw in $lttb_keywords} {
|
||||
if {$kw eq {GO} && [string index $pline 2] eq {S}} {
|
||||
lttb_GOS $body
|
||||
} else {lttb_$kw $body}
|
||||
}
|
||||
}
|
||||
|
||||
# Integer number normalizer (for TB-valid signed 16-bit range)
|
||||
proc lttb_norm {num} {
|
||||
set num $(int($num))
|
||||
if {($num > 32767) || ($num < -32768)} {
|
||||
set num $($num % 65536)
|
||||
if {$num > 32767} {incr num -65536}
|
||||
}
|
||||
return $num
|
||||
}
|
||||
|
||||
# Whitespace remover
|
||||
proc lttb_stripspace {s} {return [regsub -all -- {\s} $s ""]}
|
||||
|
||||
# List pop helper
|
||||
proc _lpop {list_var} {
|
||||
upvar $list_var l
|
||||
if {[llength $l] == 0} {return 0}
|
||||
set val [lindex $l end]
|
||||
set l [lreplace $l end end]
|
||||
return $val
|
||||
}
|
||||
|
||||
# Tiny BASIC expression evaluator (two-pass)
|
||||
proc lttb_eval {lttb_ex} {
|
||||
# pre-checks
|
||||
set lttb_ex [string trim $lttb_ex]
|
||||
if {$lttb_ex eq {}} {return 0}
|
||||
if {[string is digit $lttb_ex]} {return [lttb_norm $(int($lttb_ex))]}
|
||||
# pass 1: variable and parentheses substitution
|
||||
global vars
|
||||
lassign {{(((} {}} pre_ex prevc
|
||||
foreach c [split $lttb_ex {}] {
|
||||
set outc {}
|
||||
if {[string is digit $c]} {set outc $c}
|
||||
if {[string is upper $c]} {set outc $vars($c)}
|
||||
if {$c eq "$"} {set outc [rand 0 10000]}
|
||||
if {$c eq "("} {set outc {(((}}
|
||||
if {$c eq ")"} {set outc {)))}}
|
||||
if {$c eq "*" || $c eq "/"} {set outc [string cat {)} $c {(}]}
|
||||
if {$c eq "+" || $c eq "-"} {
|
||||
if {$prevc in {{} ( + -}} {
|
||||
set outc [string cat 0 $c]
|
||||
} else {set outc [string cat {))} $c {((}] }
|
||||
}
|
||||
append pre_ex $outc
|
||||
set prevc $c
|
||||
}
|
||||
append pre_ex {)))}
|
||||
# pass 2: two-stack LTR evaluator
|
||||
local proc eval_helper {vsvar osvar} {
|
||||
upvar $vsvar valstack
|
||||
upvar $osvar opstack
|
||||
set res 0
|
||||
set op [_lpop opstack]
|
||||
set v2 [_lpop valstack]
|
||||
set v1 [_lpop valstack]
|
||||
switch -exact -- $op {
|
||||
"+" { set res $($v1 + $v2) }
|
||||
"-" { set res $($v1 - $v2) }
|
||||
"*" { set res $($v1 * $v2) }
|
||||
"/" { if {$v2 != 0} {set res $(int($v1 / $v2))} }
|
||||
default { error "Unknown operator: $op" }
|
||||
}
|
||||
lappend valstack [lttb_norm $res]
|
||||
}
|
||||
lassign {{} {} {}} valbuf valstack opstack
|
||||
set precmap {+ 1 - 1 * 2 / 2}
|
||||
foreach c [split $pre_ex {}] {
|
||||
if {[string is space $c]} {continue}
|
||||
if {[string is digit $c]} {
|
||||
append valbuf $c
|
||||
} else {
|
||||
if {[string length $valbuf] > 0} {
|
||||
lappend valstack $(int($valbuf))
|
||||
set valbuf {}
|
||||
}
|
||||
if {$c eq {(}} {
|
||||
lappend opstack $c
|
||||
} elseif {$c eq {)}} {
|
||||
while {[llength $opstack] > 0 && [lindex $opstack end] ne "("} {
|
||||
eval_helper valstack opstack
|
||||
}
|
||||
if {[lindex $opstack end] eq "("} {_lpop opstack}
|
||||
} elseif {$c in {+ - * /}} {
|
||||
set prec $precmap($c)
|
||||
while {[llength $opstack] > 0} {
|
||||
set top_op [lindex $opstack end]
|
||||
if {$top_op eq "("} { break }
|
||||
if {$precmap($top_op) >= $prec} {
|
||||
eval_helper valstack opstack
|
||||
} else { break }
|
||||
}
|
||||
lappend opstack $c
|
||||
}
|
||||
}
|
||||
}
|
||||
while {[llength $opstack] > 0} {eval_helper valstack opstack}
|
||||
set res [lindex $valstack 0]
|
||||
if {$res eq {}} {set res 0}
|
||||
return $res
|
||||
}
|
||||
|
||||
# Tiny BASIC routines implementing various commands
|
||||
|
||||
proc lttb_LE {stmt} {
|
||||
global vars
|
||||
lassign [split $stmt =] vname ex
|
||||
set vname [string index [string trim $vname] 0]
|
||||
set vars($vname) [lttb_eval $ex]
|
||||
}
|
||||
|
||||
proc lttb_IF {stmt} {
|
||||
lassign {-1 -1 {} 0} thenpos restpos relop istrue
|
||||
regexp -indices -- {[>=<][>=<]*} $stmt rores
|
||||
lassign $rores ropos roend
|
||||
set relop [string range $stmt $ropos $roend]
|
||||
set expr1 [string range $stmt 0 $($ropos-1)]
|
||||
set rest [string range $stmt $($roend + 1) end]
|
||||
foreach kw {THEN LET {=} RETURN GOSUB INPUT PRINT GOTO END IF} {
|
||||
set thenpos [string first $kw $rest]
|
||||
if {$thenpos > -1} {
|
||||
if {$kw eq {=}} {incr thenpos -1}
|
||||
set restpos $thenpos
|
||||
if {$kw eq {THEN}} {incr restpos 4}
|
||||
break
|
||||
}
|
||||
}
|
||||
set expr2 [string range $rest 0 $($thenpos - 1)]
|
||||
set exdif $([lttb_eval $expr1] - [lttb_eval $expr2])
|
||||
switch -exact -- $relop {
|
||||
{=} {set istrue $($exdif == 0)}
|
||||
{><} - {<>} {set istrue $($exdif != 0)}
|
||||
{>} {set istrue $($exdif > 0)}
|
||||
{<} {set istrue $($exdif < 0)}
|
||||
{>=} {set istrue $($exdif >= 0)}
|
||||
{<=} {set istrue $($exdif <= 0)}
|
||||
}
|
||||
if {$istrue} {lttb_proginput [string range $rest $restpos end]}
|
||||
}
|
||||
|
||||
proc lttb_GO {stmt} {
|
||||
global ip
|
||||
set ip $([lttb_eval $stmt] - 1)
|
||||
}
|
||||
|
||||
proc lttb_GOS {stmt} {
|
||||
global ip callstack
|
||||
lappend callstack $ip
|
||||
set ip $([lttb_eval $stmt] - 1)
|
||||
}
|
||||
|
||||
proc lttb_RE {stmt} {
|
||||
global ip callstack
|
||||
set ip [_lpop callstack]
|
||||
}
|
||||
|
||||
proc lttb_IN {stmt} {
|
||||
global vars
|
||||
set varlist [split [lttb_stripspace $stmt] ,]
|
||||
set vlen [llength $varlist]
|
||||
puts -nonewline {? }
|
||||
stdout flush
|
||||
set inputbuf [string toupper [string trim [stdin gets]]]
|
||||
set inputlist [lmap s [split [lttb_stripspace $inputbuf] ,] {
|
||||
lttb_eval $s
|
||||
}]
|
||||
loop i 0 $vlen {
|
||||
set vname [string index [lindex $varlist $i] 0]
|
||||
set vars($vname) [lindex $inputlist $i]
|
||||
}
|
||||
}
|
||||
|
||||
proc lttb_PR {stmt} {
|
||||
lassign {0 {} {}} quoting printlist item
|
||||
# Build the printlist
|
||||
foreach c [split $stmt {}] {
|
||||
if {$c eq {"}} {
|
||||
set quoting $(1 - $quoting)
|
||||
append item $c
|
||||
} elseif {$quoting} {
|
||||
append item $c
|
||||
} elseif {$c in {; ,}} {
|
||||
if {[string length $item] > 0} {
|
||||
lappend printlist $item
|
||||
set item {}
|
||||
}
|
||||
lappend printlist $c
|
||||
} elseif {[string is graph $c]} {
|
||||
append item $c
|
||||
}
|
||||
}
|
||||
if {[string length $item] > 0} {lappend printlist $item}
|
||||
# Iterate over the printlist
|
||||
foreach item $printlist {
|
||||
if {[string index $item 0] eq {"}} {
|
||||
puts -nonewline [string trim $item {"}]
|
||||
} elseif {$item eq {,}} {
|
||||
puts -nonewline "\t"
|
||||
} elseif {$item ne {;}} {
|
||||
puts -nonewline [lttb_eval $item]
|
||||
}
|
||||
}
|
||||
if {$item ni {; ,}} {puts {}}
|
||||
stdout flush
|
||||
}
|
||||
|
||||
proc lttb_EN {stmt} {
|
||||
global ip callstack
|
||||
lassign {-1 {}} ip callstack
|
||||
}
|
||||
|
||||
# Interactive-only routines start here
|
||||
|
||||
proc ext_LIST {} {
|
||||
global progmem
|
||||
loop i 1 32768 {
|
||||
if {[dict exists $progmem $i]} {
|
||||
puts [format "%d\t%s" $i $progmem($i)]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc ext_RUN {} {
|
||||
global progmem ip
|
||||
set ip 1
|
||||
while {$ip > 0 && $ip < 32768} {
|
||||
if {[dict exists $progmem $ip]} {lttb_exec $progmem($ip)}
|
||||
incr ip
|
||||
}
|
||||
}
|
||||
|
||||
proc ext_CLEAR {} {
|
||||
global progmem callstack vars ip
|
||||
lassign {{} {} {} 0} progmem callstack vars ip
|
||||
loop i 65 91 {set vars([format {%c} $i]) 0}
|
||||
}
|
||||
|
||||
proc ext_LOAD {fname} {
|
||||
if {$fname eq {}} {
|
||||
puts -nonewline "File name? "
|
||||
stdout flush
|
||||
stdin gets fname
|
||||
}
|
||||
if {[file exists $fname]} {
|
||||
ext_CLEAR
|
||||
set fh [open $fname r]
|
||||
while {![eof $fh]} {
|
||||
$fh gets progline
|
||||
set progline [string trim $progline]
|
||||
if {$progline ne {}} {lttb_proginput $progline}
|
||||
}
|
||||
$fh close
|
||||
puts [format {Loaded %s} $fname]
|
||||
} else {puts {Given file doesn't exist, skipping!}}
|
||||
}
|
||||
|
||||
proc ext_SAVE {} {
|
||||
global progmem
|
||||
puts -nonewline "File name? "
|
||||
stdout flush
|
||||
stdin gets fname
|
||||
set fh [open $fname w]
|
||||
loop i 1 32768 {
|
||||
if {[dict exists $progmem $i]} {
|
||||
$fh puts [format {%d %s} $i $progmem($i)]
|
||||
}
|
||||
}
|
||||
$fh flush
|
||||
$fh close
|
||||
puts [format {Saved %s} $fname]
|
||||
}
|
||||
|
||||
# Interpreter entry point
|
||||
|
||||
puts {----------------------------
|
||||
Luxferre's Truly Tiny BASIC
|
||||
Jim Tcl Edition
|
||||
@Copyleft 2026
|
||||
All wrongs reserved
|
||||
----------------------------}
|
||||
|
||||
if {$argc > 0} {ext_LOAD [lindex $argv 0]} else {ext_CLEAR}
|
||||
|
||||
while {1} {
|
||||
puts -nonewline {> }
|
||||
stdout flush
|
||||
set cmd [string toupper [string trim [stdin gets]]]
|
||||
switch -exact -- $cmd {
|
||||
BYE {puts "Bye!"; break}
|
||||
RUN {ext_RUN; continue}
|
||||
LIST {ext_LIST; continue}
|
||||
NEW - CLEAR {ext_CLEAR; continue}
|
||||
LOAD {ext_LOAD {}; continue}
|
||||
SAVE {ext_SAVE; continue}
|
||||
default {lttb_proginput $cmd}
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user