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