3, Tcl - rextester

Language: Layout:

#tclsh 8.6

#proc dec2bin int {
#    set binRep [binary format c $int]
#    binary scan $binRep B* binStr
#    return $binStr
#}

#proc dec2bin i {
# set res {} 
#    while {$i>0} {
#        set res [expr {$i%2}]$res
#       set i [expr {$i/2}]
#    }
#    if {$res == {}} {set res 0}
#    return $res
#}

proc dec2bin {num} {

puts $num
set b {}

for {set i 0} {$num > 0} {incr $i} {

set a [expr $num % 2]
set num [expr $num / 2]
lappend b $a
}
#puts $b
set x [lreverse $b]
set bin_no [join $x ""]
return $bin_no

}

set v1 3
set v2 10
set a [expr abs($v1)]
puts $a
if { $v1 == $a } {
set M [ dec2bin $a ]
puts $M
set b [split $M ""]
puts $b
set B {}
foreach x $b {
lappend B "[expr !$x]"
}
set m [dec2bin [expr [join 0b$B ""] + 0b0001]]
puts [join $B ""]
puts $m
set E {}
puts e$E
set u [llength [split $m ""]]
puts $u
while { $u != 4} {
lappend E 0
set u [expr $u + 1]
}
lappend E $m
puts [join $E ""]
} else {
 set M 0b[ dec2bin $a ]
set m 0b[ dec2bin $v1 ]
}
#puts $M
#puts $m

set q "[ dec2bin $v2 ]"
puts q$q

set A 0b00000000
set n 4

set s {}
set AQ {}
#while {$n != 0} {
set q0 [lindex [split $q ""] 7 ]
puts $q0
lappend s $q0
puts $s
set q1 [lindex [split $q ""] 6 ]
puts $q1
lappend s $q1
puts $s
set Q [join $s ""]
puts $Q
if { $Q == 01 } {
set A [dec2bin [expr $A + $M]]
puts $A
lappend AQ $A
puts $AQ
lappend AQ $q
set Y [join $AQ ""]
puts $Y
set Z [expr $Y << 1]
puts $Z
}

#set n [expr $n -1]
#}

[ + ] Show input
Absolute running time: 0.18 sec, cpu time: 0.02 sec, memory peak: 5 Mb, absolute service time: 0,34 sec