* http://zarutian.cjb.net/ is my web page (seriusly out of date)
How the hell do you pronounce my nick? In four syllabels: Za-ru-ti-an
I am also active on wikipedia under the same nick. (Both the English one and the Icelandic one)
Stuff I am thinking about implementing/doing (DONT PUT PRESURE ON ME PLEASE!):
That might take a while because I have to dig the up from my old CRT iMac. (29.mars 2006) Which I still havent got around to do (14. oktober 2006)
=== scratchpad ===
package require Tcl 8.5
# Tcl 8.5 required because of usage of dict
proc run {} {
variable state
while {[dict get $state running]} {
switch -exact -- [string index [dict get $state code] [dict get $state index]] {
"\{" {
set item "\{"
set brace-level 1
dict incr state index +1
while {$brace-level > 0} {
set char [string index [dict get $state code] [dict get $state index]]
if {$char == "\\"} {
append item $char
dict incr state index +1
append item [string index [dict get $state code] [dict get $state index]]
} elseif {$char == "\{"} {
append item $char
incr brace-level +1
} elseif {$char == "\}"} {
append item $char
incr brace-level -1
} else {
append item $char
}
dict incr state index +1
}
dict append state stack [dict get $state stack-level] command $item
}
"\[" {
dict incr state stack-level +1
dict set state stack [dict get $state stack-level] start-index [dict get $state index]
}
"\]" {
set frame [dict get $state stack [dict get $state stack-level]]
dict unset state stack [dict get $state stack-level]
dict incr state stack-level -1
dict append state stack [dict get $state stack-level] command [execute $frame]
}
"\n" {
set frame [dict get $state stack [dict get $state stack-level]]
dict unset state stack [dict get $state stack-level]
execute $frame
}
default {
dict append state stack [dict get $state stack-level] command [string index [dict get $state code] [dict get $state index]]
}
}
dict incr state index +1
if {[dict get $state index] >= [string length [dict get $state code]]} { popReturnstack }
}
}
proc exacute {frame} {
variable state
dict incr state run_quota -1
if {[dict get state run_quota] == 1} {
dict set state running no
}
set command_name [lindex [dict get $frame command] 0]
if {[dict exists $state definitions $command_name]} {
if {[string equal "primitive" [dict get $state definitions $command_name type]]} {
return [apply [dict get $state definitions $command_name contents] $frame]
} elseif {[string equal "combined" [dict get $state definitions $command_name type]]} {
pushReturnstack
initFrame [list code [dict get $state definitions $command_name contents]]
}
} else {
if {[string equal $command_name "unknown"]} {
execute [list command [list error "unknown command not found"]]
} else {
execute [dict merge $frame [list command [list unknown [dict get $frame command]]]]
}
}
}
proc popReturnstack {} {
variable state
dict set state [dict merge $state [dict get $state returnStack]]
}
proc pushReturnstack {} {
variable state
dict set state returnStack $state
}
proc initFrame {presets} {
variable state
dict set state index -1
dict set state code {}
dict set state stack-level 0
dict set state stack 0 {}
dict set state [dict merge $state $presets]
}=== codeStart ===
proc textDelta {strA strB} {
# strA should always be longer than strB
if {[string length $strA] < [string length $strB]} {
set tmp $strA
set strA $strB
set strB $tmp
unset tmp
}
set indexA 0
set indexB 0
set theChange_text ""
set theChange_end undefined
set theChange_start undefined
while {$indexA < [string length $strA]} {
set charA [string index $strA $indexA]
set charB [string index $strB $indexB]
if {$charA == $charB} {
incr indexB
if {$theChange_start != "undefined"} {
set theChange_end $indexA
}
} else {
append theChange_text $charA
if {$theChange_start == "undefined"} {
set theChange_start $indexA
}
}
incr indexA
}
if {$theChange_end == "undefined"} { set theChange_end $theChange_start }
return [list $theChange_text $theChange_start $theChange_end]
}
proc namedArgs {} {
upvar args args
foreach {name value} $args {
upvar $name tmp
set tmp $value
}
}
if 0 { Zarutian: The following is deprecated. }
package ifneeded zarutian.memchan 1.0 {
package require rechan 1.0
namespace eval ::zarutian::memchan {}
proc ::zarutian::memchan::handler args {
log [info level 0]
set cmd [lindex $args 0]
set chan [lindex $args 1]
variable buffers
variable write_read
if {$cmd == "write"} {
if {[lsearch [array names write_read] $chan] == -1} {
error "$chan is only open for reading"
}
}
append buffers($write_read($chan)) [lindex $args 2]
return [string length [lindex $args 2]]
} elseif {$cmd == "read"} {
if {[lsearch [array names write_read] $chan] != -1} {
error "$chan is only open for writing"
}
set data [string range $buffers($chan) 0 [lindex $args 2]]
set buffers($chan) [string range $buffers($chan) [expr [lindex $args 2] +1] end]
return $data
} elseif {$cmd == "close"} {
if {[lsearch [array names write_read] [lindex $args 1]] != -1} {
close $write_read($chan)
unset buffers($write_read($chan))
unset write_read($chan)
}
}
}
proc ::zarutian::memchan::new {} {
log [info level 0]
variable write_read
set write [rechan ::zarutian::memchan::handler 4]
set read [rechan ::zarutian::memchan::handler 2]
set write_read($write) $read
return [list $write $read]
}
package provide zarutian.memchan 1.0
}
package ifneeded zarutian.demultiplexing 1.0 {
package require zarutian.memchan 1.0
namespace eval ::zarutian::demultiplexing {}
proc ::zarutian::demultiplexing::readChan {incoming_channel} {
variable channels
if {[eof $incoming_channel]} {
foreach item [array names channels] {
if {[string match "[set incoming_channel]_*" $item]} {
foreach chan [set channels($item)] {
close $chan
}
}
}
close $incoming_channel
return
}
fconfigure $incoming_channel -encoding unicode -blocking 1 -translation auto
gets $incoming_channel line
set cmd [lindex $line 0]
if {$cmd == "data"} {
set chanId [lindex $line 1]
set length [lindex $line 2]
fconfigure $incoming_channel -encoding binary -blocking 1 -translation binary
set data [read $incoming_channel $length]
foreach chan $channels("[set incoming_channel]_[set chanId]") {
puts $chan $data
}
return
} elseif {$cmd == "eof"} {
set chanId [lindex $line 1]
foreach chan $channels("[set incoming_channel]_[set chanId]") {
close $chan
}
return
} elseif {$cmd == "flush"} {
set chanId [lindex $line 1]
foreach chan $channels("[set incoming_channel]_[set chanId]") {
flush $chan
}
return
}
}
proc ::zarutian::demultiplexing::addChan {channel chanid {listenChannel {}}} {
variable channels
if {$listenChannel != {}} {
set write $listenChannel
set read $listenChannel
} else {
set temp [::zarutian::memchan::new]
set write [lindex $temp 0]
set read [lindex $temp 1]
}
lappend channels("[set channel]_[set chanid]") $write
return $read
}
proc ::zarutian::demultiplexing::setup {incoming_channel} {
fileevent $incoming_channel [list ::zarutian::demultiplexing::readChan $incoming_channel]
}
package provide zarutian.demultiplexing 1.0
}
package ifneeded zarutain.multiplexing 1.0 {
package require zarutian.memchan 1.0
namespace eval ::zarutian::multiplexing {}
proc ::zarutian::multiplexing::readChan {channel} {
variable outgoing_channelsId
variable outgoing_channelsMainChan
if {[eof $channel]} {
puts $outgoing_channelsMainChan($channel) "eof [set outgoing_channelsId($channel)]"
flush $outgoing_channelsMainChan($channel)
return
}
set rememberBlocking [fconfigure $channel -blocking]
set rememberTranslation [fconfigure $channel -translation]
fconfigure $channel -blocking 1 -translation binary
set data [read $channel]
set length [string bytelength $data]
fconfigure $channel -blocking $rememberBlocking -translation $rememberTranslation
puts $outgoing_channelsMainChan($channel) "data [set outgoing_channelsId($channel)] $length"
fconfigure $outgoing_channelsMainChan($channel) -encoding binary -translation binary
puts $outgoing_channelsMainChan($channel) $data
flush $outgoing_channelsMainChan($channel)
fconfigure $outgoing_channelsMainChan($channel) -encoding unicode -translation auto
return
}
proc ::zarutian::multiplexing::addChan {mainchannel chanId channel} {
variable outgoing_channelsId
set outgoing_channelsId($channel) $chanId
set outgoing_channelsMainChan($channel) $mainchannel
fileevent $channel readable [list ::zarutian::multiplexing::readChan $channel]
}
package provide zarutain.multiplexing 1.0
}
package ifneeded zarutain.leftShiftingRegister 1.0 {
package require rechan 1.0
namespace eval ::zarutian::leftShiftingRegister {}
proc ::zarutian::leftShiftingRegister::handler args {
variable states
variable polynominals
variable lengths
set cmd [lindex $args 0]
set instance [lindex $args 1]
if {$cmd == "write"} {
error "this chanel is only open for reading"
} elseif {$cmd == "close"} {
unset states($instance)
unset polynominals($instance)
unset lengths($instance)
} elseif {$cmd == "read"} {
set reqlength [expr [lindex $args 2] * 8]
set buffer $states($instance)
set polyA [lindex $polynominals($instance) 0]
set polyB [lindex $polynominals($instance) 1]
if {($polyA < 0) || ($polyB <0)} { error "a polynominal is under zero" }
if {($polyA > $lengths($instance)) || ($polyB > $lengths($instance))} {
error "a polynominal addresses out of bound for the register"
}
if {$polyA == $polyB} { error "the polynominals must not be same" }
for {} {$reqlength > 0} {incr reqlength -1} {
append buffer [XOR [string index $states($instance) $polyA] [string index $states($instance) $polyB]]
}
set states($instance) [string range $buffer end-[expr $lengths($instance) +1] end]
return [binary format B* $buffer)]
}
}
proc ::zarutian::leftShiftingRegister::XOR {a b} {
#IS: �etta er bara sanntafla.
#EN: This is just an truthtable.
if {$a && $b} {
return 0
} elseif {$a && (!$b)} {
return 1
} elseif {(!$a) && $b} {
return 1
} elseif {(!$a) && (!$b)} {
return 0
}
}
proc ::zarutian::leftShiftingRegister::new {startingState length polynominal} {
variable states
variable polynominals
variable lengths
set instance [rechan ::zarutian::leftShiftingRegister::handler 6]
if {[llength $polynominal] != 2} {
error "$polynomnial must be two positive numbers"
}
set states($instance) $startingState
set polynominals($instance) $polynominal
set lengths($instance) $length
return $instance
}
package provide zarutain.leftShiftingRegister 1.0}
package ifneeded zarutian.bitSelector 0.1 {
package require rechan 1.0
namespace eval ::zarutian::bitSelector {}
proc ::zarutain::bitSelector::handler args {
variable channelAs
variable channelSs
set cmd [lindex $args 0]
set chan [lindex $args 1]
if{$cmd == "read"} {
set reqlength [lindex $args 2]
set rememberChannelConfigurationA [fconfigure $channelAs($chan)]
set rememberChannelConfigurationB [fconfigure $channelSs($chan)]
fconfigure $channelAs($chan) -translation binary -encoding binary
fconfigure $channelSs($chan) -translation binary -encoding binary
set bufferS [read $channelSs($chan) $reqlength]
binary scan $bufferS B* bufferS
set bufferA ""
# �a� er �ruglega einhver villa h�r inn� -byrjun-
# hef �a� � tilfininguni a� �g �tti ekki a� nota gildi breytunar
# temp1 sem index � breytuna byte
for {set temp2 1} {$temp2 <= $reqlength} {incr temp2} {
binary scan [read $channelAs($chan) 1] byte
for {set temp1 1} {$temp1 <= 8} {incr temp1} {
set temp3 [expr ($temp2 * 8) + $temp1]
if {[string index $bufferS $temp3]} {
append bufferA [string index $byte $temp1]
}
}
}
# �a� er �ruglega einhver villa h�r inn� -lok-
fconfigure $channelAs($chan) [join $rememberChannelConfigurationA " "]
fconfigure $channelSs($chan) [join $rememberChannelConfigurationB " "]
return [binary format B* $bufferA]
} elseif {$cmd == "write"} {}
# lesa fyrsta af r�s S einn bita yfir � breytu x
# ef x er 1 �� lesa einn bita af r�s A yfir � breytu y
# b�ta y vi� buffer
}
proc ::zarutian::bitSelector::new {channelA channelS} {
# channelA is the victim
# channelS is the torturer
variable instances
if {[info exists instances("[set channelA]_[set channelS]")]} {
return $instances("[set channelA]_[set channelS]")
}
set instance [rechan ::zarutain::bitSelector::handler 6]
lappend instances $instance
variable channelAs
variable channelSs
set channelAs($instance) $channelA
set channelSs($instance) $channelS
return $instance
}
package provide zarutian.bitSelector 0.1}
comment {
other possible Tcl Core implementation thoughts
Basic datatypes:
floating points will be represented as a table containing something like this:
"type": "float" "base": <bytestring treated as an number> "exponent": <bytestring treated as an number>
}
package ifneeded zarutian.app.synchRemoteEval 0.1 {
proc getCallstack {} {
set calls [list]
set me [expr [info level] -1]
for {set i $me} {$i > 0} {incr i -1} {
lappend calls [info level $i]
}
return $calls
}
proc syncRemoteEval {channel} {
set calls [getCallstack]
set cmd [lindex $calls 2]
set d [info level]
if {$d > 2} {
set u2 [lindex $calls 3]
if {[lindex $u2 0] == "syncRemoteEval"} {
return
}
}
# info feedback prevention aka dont send back what we recived.
set ok 1
foreach call $calls {
if {[lindex $call 0] == "fileevent_for_synchRemoteEval"} { set ok 0; break }
}
if {$ok} { putsAndFlush $channel "callstack [list $calls]" }
set val {}
catch {set val [eval $cmd]} res
if {$res != $val} {
putsAndFlush $channel "error [list $res]"
} else {
putsAndFlush $channel "result [list $res]"
}
return -code return $res
}
proc fileevent_for_syncRemoteEval {chan} {
}
proc putsAndFlush {chan data} {
catch {
puts $chan $data
flush $chan
}
}
package provide zarutian.app.synchRemoteEval 0.1}
package ifneed zarutian.app.synchRemoteEvalVersionB 0.1 {
# same as above but using execution traces
package require Tcl 8.4
proc getCallstack {} {
set calls [list]
set me [expr [info level] -1]
for {set i $me} {$i > 0} {incr i -1} {
lappend calls [info level $i]
}
return $calls
}
proc was_called_anytime_by? {cmdname} {
set calls [lrange [getCallstack] 1 end]
foreach call $calls {
if {[lindex $call 0] == $cmdname} { return 1 }
}
return 0
}
proc sendToTheOtherEnd {data} {
global remoteEvalSynch_channel
catch {
fconfigure $channel -encoding unicode ; # make sure that the data on the channel is unicode encoded
puts $remoteEvalSynch_channel $data
flush $remoteEvalSynch_channel
}
}
proc remoteEvalSynchExecuteCallback args {
set cmd [lindex $args 0]
set op [lindex $args end]
if {$op == "enter"} {
if {![was_called_anytime_by? "remoteEvalSynchFileeventCallback"]} {
sendToTheOtherEnd "start-eval [list $cmd]"
# sendToTheOtherEnd "start-eval [list $cmd [getCallstack]]"
}
} elseif {$op == "leave"} {
set code [lindex $args 1]
set result [lindex $args 2]
sendToTheOtherEnd "result-update [list $cmd $code $result]"
# sendToTheOtherEnd "result-update [list $cmd $code $result [getCallstack]]"
}
}
proc remoteEvalSynchFileeventCallback {channel} {
global buffers
if {[eof $channel} {
# for the time being raise an error when channel is eofed by the other end
error "$channel eofed!"
}
fconfigure $channel -encoding unicode ; # make sure that the data on the channel is unicode encoded
append buffers($channel) [gets $channel]
if {[info complete $buffers($channel)} {
set event [lindex $buffers($channel) 0]
set data [lindex $buffers($channel) 1]
if {$event == "start-eval"} {
set cmd [lindex $data 0]
# set callstack [lindex $data 1]
catch {
eval $cmd
}
} elseif {$event == "result-update"} {
# what should I do with this?
# fyrst um sinn: check if code is error and error on it
set cmd [lindex $data 0]
set code [lindex $data 1]
set result [lindex $data 2]
# set callstack [lindex $data 3]
if {$code == "error"} { error "remote-error: $channel [list $cmd] [list $result ]"}
}
unset buffers($channel)
}
}
proc remoteEvalSynch {victim channel} {
# channel must be two way
fileevent $channel readable [list remoteEvalSynchFileeventCallback $channel]
trace add execution $victim {enter leave} remoteEvalSynchExecuteCallback
}
package provide zarutian.app.synchRemoteEvalVersionB 0.1}