[Richard Suchenwirth] 2000-08-21 - So here we are, with one of the best programming languages in the world, and what do we do but try to emulate one of the worst? It's just the thought "Everything's possible with [Tcl], even the impossible", some nostalgia (you get the kicks only if you really worked/played with [BASIC] in the 19[[78]]0's), and the sheer fun of programming. I start with a small subset of the language, but arithmetic assignment, GOTO (see [Goto in Tcl]), ON..GOTO, FOR/NEXT, GOSUB/RETURN, IF and PRINT are there already.. Consider this call basic { 100 J=1:K=1 110 GOSUB 300 120 PRINT I,J;K 130 IF I<5 GOTO 110: REM DONE 135 for a=100 to J+103 137 print a 140 next a 150 END 300 REM---------- slight increment 310 I=I+J: K=K*2 320 RETURN } giving these results: 1 1 2 2 1 4 3 1 8 4 1 16 5 1 32 100 101 102 103 104 by using the following "compiler" (it produces Tcl code for a state machine) proc basic {script} { # old BASIC had 26 numeric variables.. foreach i {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} { set $i 0 } set states "" set Stack [list Error:Stack] foreach line [split [string toupper $script] \n] { if [regexp { *([0-9]+) +(.+)} $line -> label rest] { set outline "" foreach stmt [split $rest :] { set step 1 if [regexp { ?('|REM)} $stmt] { break ;# no statements to be expected after comment } elseif [regexp {PRINT +(.+)} $stmt -> what] { regsub -all ", *" $what "\t" what regsub -all "; *" $what " " what regsub -all {([A-Z])} $what {$\1} what append outline "puts \"$what\"; " } elseif [regexp {FOR +([A-Z]) *= *(.+) TO (.+)( STEP (.+))?} \ $stmt -> looper from to - step] { regsub -all {([A-Z])} $from {$\1} from regsub -all {([A-Z])} $to {$\1} to set here -[intgen] set step 1 ;# to start with set next($looper) "incr $looper $step; if {\$$looper<=$to} {goto $here}" append outline "set $looper $from\}\n$here \{" } elseif [regexp {NEXT (.+)} $stmt -> id] { append outline $next($id) unset next($id) } elseif [regexp {IF +([^ ]+) +(THEN|GOTO) +([0-9]+)}\ $stmt -> cond - goto] { regsub -all {([A-Z])} $cond {$\1} cond append outline "if {$cond} {goto $goto}; " } elseif [regexp {ON (.+) GOTO +(.+)} $stmt -> cond labels] { regsub -all {([A-Z])} $cond {$\1} cond append outline "goto \[lindex \{- [split $labels ,]\} \[expr $cond\]\]; " } elseif [regexp {GO *TO ([0-9]+)} $stmt -> id] { append outline "goto $id; " } elseif [regexp {GO *SUB ([0-9]+)} $stmt -> id] { set here -[intgen] append outline "lpush Stack $here; goto $id\}\n$here \{ " } elseif [regexp {RETURN} $stmt] { append outline "goto \[lpop Stack\]; " } elseif [regexp { *END} $stmt] { append outline "break; " } elseif [regexp {([A-Z])=(.+)} $stmt -> lhs rhs] { regsub -all {([A-Z])} $rhs {$\1} rhs append outline "set $lhs \[expr $rhs\]; " } } append states "$label {$outline}\n" } } states $states } The output of ''basic'', what is fed into ''states'', is a mix of Basic labels and Tcl code, and looks like this: 100 {set J [expr 1]; set K [expr 1]; } 110 {lpush Stack -1; goto 300} -1 { } 120 {puts "$I $J $K"; } 130 {if {$I<5} {goto 110}; } 135 {set A 100} -2 {} 137 {puts "$A"; } 140 {incr A 1; if {$A<=$J+103} {goto -2}} 150 {break; } 300 {} 310 {set I [expr $I+$J]; set K [expr $K*2]; } 320 {goto [lpop Stack]; } and here is the little state machine that processes this: proc states body { proc goto {id} {uplevel set goto $id; return -code continue} uplevel set goto [lindex $body 0] set tmp [lindex $body 0] foreach {cmd label} [lrange $body 1 end] { if {$label==""} {set label default} lappend tmp "$cmd; goto [list $label]" $label } lappend tmp break ;# to match last "default" label uplevel while 1 "{switch -- \$goto [list $tmp]}" rename goto "" } See [Retrocomputing] for a matching old-fashioned display... [RPN in Tcl] for a first shot at a FORTH-like Reverse Polish Notation interpreter. ---- Here are some helper procs: ''lpush'' and ''lpop'' to make a stack, ''intgen'' to generate unique integers, which (with prefixed minus) serve as generated labels in FOR and GOSUB constructs (they cannot collide with real line numbers, since these are positive ;-): proc lpush {_list what} { upvar $_list L if ![info exists L] {set L {}} set L [concat [list $what] $L] } proc lpop {_list} { upvar $_list L if ![info exists L] {return ""} set t [lindex $L 0] set L [lrange $L 1 end] return $t } proc intgen {{seed 0}} { set self [lindex [info level 0] 0] proc $self "{seed [incr seed]}" [info body $self] set seed } ;# RS ------ [RFox] This is nice stuff. A little nitpick however; the original basic allowed variables that were letter digit pairs e.g A, A0, A1...A9... Z9. I don't recall if the original Dartmouth BASIC had string variables or not (A$, A1$...etc). While we're on BASIC. The name of the language is actually an acronym. Anyone here besides me remember what it stood for? [SEH] Beginners All-purpose Symbolic Instruction Code. ---- [KPV] Just an historic note. BASIC was invented in the 1964 at Dartmouth College by John Kemeny and Thomas Kurtz. By the time I was there (1980-85), the language, now called BASIC 7, had evolved into a very nice structured language with both advanced matrix operations and very excellent graphics capabilities (part of which I wrote). In many ways, BASIC 7 graphics was/is superior to tk, especially with its built-in chart and 3-D drawing routines. Unfortunately, the BASIC known (and denigrated) by most of the world has a different ancestry. In the mid-70's Paul Allen, Bill Gates and Monte Davidoff created a version for ''Altair 8800 microcomputer''. It was an extremely bare-bones version implementating only a few of the language's features. They then ported it to many other platforms, most notably the Apple ]][[ (my first programming language) and the IBM-PC. It was these versions, with its heavy reliance on line numbers and goto's which became widely popular--and widely derogated as promoting bad programming practices. ---- [Category Language]