Execute SNUSP/Tcl

Execute SNUSP/Tcl is an implementation of SNUSP. Other implementations of SNUSP.

Execute SNUSP/Tcl is part of RCSNUSP. You may find other members of RCSNUSP at Category:RCSNUSP.

This is an interpreter for SNUSP. Appears to work with correct SNUSP programs...

Core SNUSP

<lang tcl>package require Tcl 8.5

1. Basic I/O to read the program data and get ready for execution

set f [open [lindex $argv 0]] set data [read $f] close $f fconfigure stdout -buffering none

1. How to access the program

set pc {0 0} set lineNum 0 foreach line [split $data \n] {

   set idx [string first \$ $line]
   if {$idx >= 0} {

set pc [list $lineNum $idx]

   }
   lappend program [split $line ""]
   incr lineNum

} set move {0 1} proc Move {} {

   global pc move
   lset pc 0 [expr {[lindex $pc 0] + [lindex $move 0]}]
   lset pc 1 [expr {[lindex $pc 1] + [lindex $move 1]}]

} proc Char {} {

   global program pc
   set c [lindex $program $pc]
   if {$c eq ""} {

return -code break

   }
   return $c

}

1. An unbounded linear datastore

set data 0 set dptr 0 proc Get {} {

   global data dptr
   if {$dptr < 0} {
       puts stderr "program error; data pointer too low"
       return -code break
   }
   while {$dptr >= [llength $data]} {

lappend data 0

   }
   lindex $data $dptr

} proc Set val {

   global data dptr
   if {$dptr < 0} {
       puts stderr "program error; data pointer too low"
       return -code break
   }
   while {$dptr >= [llength $data]} {

lappend data 0

   }
   lset data $dptr $val

}

1. The main interpreter loop; $last is used for tracking whether
2. to terminate output with a newline

set last 10 while 1 {

   switch -- [Char] {

"/" {set move "[expr -[lindex $move 1]] [expr -[lindex $move 0]]"} "\\" {set move [lreverse $move]} "?" {if ![Get] Move} "!" {Move} ">" {incr dptr} "<" {incr dptr -1} "+" {Set [expr [Get]+1]} "-" {Set [expr [Get]-1]} "." {puts -nonewline [format %c [set last [Get]]]} "," {Set [read stdin 1]}

   }
   Move

} if {$last != 10} {puts ""}</lang>

Modular SNUSP

<lang tcl>package require Tcl 8.5

1. Basic I/O to read the program data and get ready for execution

set f [open [lindex $argv 0]] set data [read $f] close $f fconfigure stdout -buffering none

1. How to access the program

set pc {0 0} set lineNum 0 foreach line [split $data \n] {

   set idx [string first \$ $line]
   if {$idx >= 0} {

set pc [list $lineNum $idx]

   }
   lappend program [split $line ""]
   incr lineNum

} set move {0 1} proc Move {} {

   global pc move
   lset pc 0 [expr {[lindex $pc 0] + [lindex $move 0]}]
   lset pc 1 [expr {[lindex $pc 1] + [lindex $move 1]}]

} proc Char {} {

   global program pc
   set c [lindex $program $pc]
   if {$c eq ""} {

return -code break

   }
   return $c

}

1. An unbounded linear datastore

set data 0 set dptr 0 proc Get {} {

   global data dptr
   if {$dptr < 0} {
       puts stderr "program error; data pointer too low"
       return -code break
   }
   while {$dptr >= [llength $data]} {

lappend data 0

   }
   lindex $data $dptr

} proc Set val {

   global data dptr
   if {$dptr < 0} {
       puts stderr "program error; data pointer too low"
       return -code break
   }
   while {$dptr >= [llength $data]} {

lappend data 0

   }
   lset data $dptr $val

}

1. An unbounded stack

set stack {} proc Push {} {

   global stack pc move
   set save $pc
   Move
   lappend stack [list $pc $move]
   set pc $save

} proc Pop {} {

   global stack pc move
   if {[llength $stack] == 0} {

return -code break

   }
   lassign [lindex $stack end] pc move
   set stack [lrange $stack 0 end-1]

}

1. The main interpreter loop; $last is used for tracking whether
2. to terminate output with a newline

set last 10 while 1 {

   switch -- [Char] {

"/" {set move "[expr -[lindex $move 1]] [expr -[lindex $move 0]]"} "\\" {set move [lreverse $move]} "?" {if ![Get] Move} "!" {Move} ">" {incr dptr} "<" {incr dptr -1} "+" {Set [expr [Get]+1]} "-" {Set [expr [Get]-1]} "." {puts -nonewline [format %c [set last [Get]]]} "," {Set [read stdin 1]} "@" {Push} "#" {Pop}

   }
   Move

} if {$last != 10} {puts ""}</lang>

Bloated SNUSP

<lang tcl>package require Tcl 8.5

1. Basic I/O to read the program data and get ready for execution

set f [open [lindex $argv 0]] set data [read $f] close $f fconfigure stdin -blocking 0 fconfigure stdout -buffering none

1. How to access the program

set pc {0 0} set lineNum 0 foreach line [split $data \n] {

   set idx [string first \$ $line]
   if {$idx >= 0} {

set pc [list $lineNum $idx]

   }
   lappend program [split $line ""]
   incr lineNum

} set move {0 1}

set threads {} set threadID 0 proc Move {} {

   global pc move
   lset pc 0 [expr {[lindex $pc 0] + [lindex $move 0]}]
   lset pc 1 [expr {[lindex $pc 1] + [lindex $move 1]}]

} proc ReflectMotion dir {

   global move
   set move "[expr $dir*[lindex $move 1]] [expr $dir*[lindex $move 0]]"

} proc Char {} {

   global program pc threads t
   set c [lindex $program $pc]
   if {$c eq ""} {

dict unset threads $t return -code continue

   }
   return $c

}

1. An unbounded quarter-plane datastore

set data 0 set dptr {0 0} proc Get {} {

   global data dptr
   lindex $data $dptr

} proc Set val {

   global data dptr
   lset data $dptr $val

} proc MovePtr dir {

   global dptr data
   lassign $dptr y x
   switch $dir {

left {lset dptr 1 [expr $x-1]} right {lset dptr 1 [expr $x+1]} up {lset dptr 0 [expr $y-1]} down {lset dptr 0 [expr $y+1]}

   }
   lassign $dptr y x
   if {$x < 0 || $y < 0} {

puts stderr "program error; data pointer off top or left ($x,$y)" exit

   }
   while {[llength $data] <= $y} {

lappend data [lrepeat [expr $x+1] 0]

   }
   if {[llength [lindex $data $y]] <= $x} {

set e [lindex $data $y] lset data $y [concat $e [lrepeat [expr $x+1-[llength $e]] 0]]

   }

}

1. An unbounded stack

set stack {} proc Push {} {

   global stack pc move
   set save $pc
   Move
   lappend stack [list $pc $move]
   set pc $save

} proc Pop {} {

   global stack pc move t threads
   if {[llength $stack] == 0} {

dict unset threads $t return -code continue

   }
   lassign [lindex $stack end] pc move
   set stack [lrange $stack 0 end-1]

}

dict set threads [incr threadID] [dict create \

   pc $pc move $move stack $stack dptr $dptr]

1. The main interpreter loop; $last is used for tracking whether to terminate
2. output with a newline

set last 10 while {[dict size $threads]} {

   foreach t [dict keys $threads] {

dict with threads $t { switch -- [Char] { "/" {ReflectMotion -1} "\\" {ReflectMotion 1} "?" {if ![Get] Move} "!" {Move} ">" {MovePtr right} "<" {MovePtr left} "+" {Set [expr [Get]+1]} "-" {Set [expr [Get]-1]} "." {puts -nonewline [format %c [set last [Get]]]} "," { set c [read stdin 1] if {$c eq ""} continue Set [scan $c %c] } "@" {Push} "#" {Pop} ":" {MovePtr up} ";" {MovePtr down} "%" {Set [expr int((1+[Get]) * rand())]} "&" { Move dict set threads [incr threadID] [dict create \ pc $pc move $move stack {} dptr $dptr] } } Move }

   }

} if {$last != 10} {puts ""}</lang>

Test Code

Samples of Bloated SNUSP

This prints out a random number of random length:

$!/+++++++++%++++++++++++++++++++++++++++++++++++++++++++++++.!/-\
  \====================================<#!?%+++++++++++++++>===\?/

This (from the esolangs wiki) prints exclamation marks until you press a key:

                    /==.==<==\
                    |        |
     /+++++++++++==&\==>===?!/==<<==#
     \+++++++++++\  |
$==>==+++++++++++/  \==>==,==#