Artifact 77e5fef28c2a31ca10e81a09d4d0b8c5a4fe60cc
File langs/basic.rx part of check-in [16fc87401f] - add a minimal BASIC dialect by crc on 2011-06-03 01:46:17. [annotate]
( RxBASIC ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( This is a minimalistic BASIC compiler. It's written in Retro and runs on )
( Ngaro virtual machine. )
( )
( The implemenation was first described on the Corpse blog in post #98: )
( http://rx-core.org/dev/corpse/article/98 )
( )
( There are string variables and numeric variables. Twenty six of each, named )
( A$ - Z$ for the string variables and A# to Z# for the integer variables. )
( )
( Valid Syntax Forms: )
( 0000 CLS )
( 0000 PRINT <variable>[type] )
( 0000 PRINT "string" )
( 0000 INPUT <variable>[type] )
( 0000 GOTO <line> )
( 0000 LET <variable>[type] = value )
( 0000 IF <variable>[type] <cond> <variable>[type] THEN <statement> )
( 0000 END )
( 0000 RUN )
( )
( With regards to the implementation, line numbers are required. We have an )
( array of 4k lines. Each element points to a subroutine. So RxBASIC will )
( compile each line as a separate subroutine. RUN will cycle through each )
( the array, executing the subroutine for each line. )
( )
( All commands and variables must be UPPERCASE. )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Todo: )
( - Handle additional LET forms )
( - Add REM for comments )
( - Add GOSUB and RETURN [still use line numbers] )
( - Allow for return to Retro ? )
( - Allow for return to RxBASIC rather than shutting down the VM )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2011, Charles Childers. Use under the ISC License )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
create lines
4096 allot
create svars
27 allot
create nvars
27 allot
: setCurrentLine ( "- )
here getToken toNumber lines + ! ;
: handleKeyword ( "- ) ;
: basic ( - )
repeat cr setCurrentLine handleKeyword again ;
( Helper Functions ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: # ( n- ) 1 , , ;
: getVariable ( "-af )
getc dup putc 'a - getc dup putc '$ = [ svars + -1 ] [ nvars + 0 ] if ;
( RxBASIC Commands ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: do_cls ( - )
&clear , &;; do ;
: do_print ( "- )
getc dup putc
dup '" = [ drop '" accept tib keepString # &puts , ]
[ 'A - getc dup putc '$ = [ svars + # &@ , &puts , ]
[ nvars + # &@ , &putn , ] if ] if
&;; do ;
{{
: readString ( "-$ ) remapping [ remapping off 10 accept tib ] preserve ;
---reveal---
: do_input ( "- )
getVariable [ &readString , &keepString ]
[ &getToken , &toNumber ] if , # &! , &;; do ;
}}
: do_goto ( "- )
8 , getToken toNumber lines + , &;; do ;
: do_let ( - )
getVariable getToken drop
[ getc putc '" accept tib keepString ]
[ getToken toNumber ] if
2# &! , &;; do ;
{{
: ifString
# &@ , getToken getVariable drop # &@ ,
&compare , "<>" compare [ ¬ , ] ifTrue ;
: ifNumber
# &@ , getToken getVariable drop # &@ ,
find drop @d->xt , ;
---reveal---
: do_if ( - )
getVariable
&ifString &ifNumber if getToken drop 25 , &drop , handleKeyword &;; do ;
}}
: do_end ( - )
&bye , &;; do ;
: do_run ( - )
cr lines repeat @+ [ 0; do ] do again ;
( Patch the handleKeyword stub to process the RxBASIC commands ~~~~~~~~~~~~~~ )
: dispatch ( "- )
getToken
[ "CLS" compare ] [ drop do_cls ] when
[ "PRINT" compare ] [ drop do_print ] when
[ "INPUT" compare ] [ drop do_input ] when
[ "GOTO" compare ] [ drop do_goto ] when
[ "LET" compare ] [ drop do_let ] when
[ "IF" compare ] [ drop do_if ] when
[ "END" compare ] [ drop do_end ] when
[ "RUN" compare ] [ drop do_run ] when
drop ;
&dispatch is handleKeyword
basic
0001 CLS
0002 PRINT "Your Name? "
0003 LET A$ = "crcx"
0004 INPUT B$
0005 IF A$ = B$ THEN PRINT "match\n"
0006 IF A$ <> B$ THEN PRINT "no match\n"
0007 END
4000 RUN