• branch=trunk inherited from [dc67bca1f3]
• sym-trunk inherited from [dc67bca1f3]

Added langs/basic.rx version [77e5fef28c2a31ca]

@@ -0,0 +1,134 @@
+( 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 [ &not , ] 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