Working for neg, Tcl

Working for neg

#tclsh 8.6

set v1 -10.25
set v2 2

proc sign i {
set g [expr abs($i)]
if { $g == $i } {
set s "+"
return $s
} else {
set s "-"
return $s
}
}

set sign1 [ sign $v1 ]
set sign2 [ sign $v2 ]
#puts $sign1
#puts $sign2

proc dec2bin i {
set B [expr int($i) ]
set A [expr abs($i) ]
set C [expr {$i - $A}]

set C [expr {abs($C)}]

puts "$C ----1"
set result {}
set result1 {}

while {$B > 0} {

set result [ expr { $B % 2 } ]$result
set B [expr {$B/2}]
}
while {$C<1} {

set result1 [expr {$C*2}]
puts "$result1 "
set D [expr {int ($result1) }]

puts "$D"

set E [expr {$result1 - $D}]

puts "$E"
set C $E

lappend list $D
set llen [llength $list]
puts "$llen - - - 5"
#puts "$list "

if {$C==0} {
break
}
}
return "$result . $list"
}

set fn1 [dec2bin $v1]
set bf1 [ join $fn1 ""]
puts $bf1

#set fn2 [dec2bin $v2]
#set bf2 [ join $fn2 ""]
#puts $bf2

proc exp i {
set a [split $i "."]
#puts $a
set b [llength [split [lindex $a 1] ""]]
return $b
}

set v1e [exp $bf1] 
set v2e [exp $bf2]
#puts $v1e
#puts $v2e
set EXP [expr $v1e + $v2e]
#puts $EXP

proc man i {
set a [split $i "."]
return [join $a ""]
}

set v1m 0b[man $bf1]
set v2m 0b[man $bf2]
#set man1 0b$v1m
#set man2 0b$v2m
#puts $v1m
#puts $v2m

set sum 0b0
while { $v2m != 0b0 } {
set sum [expr $sum + $v1m]
set v2m [expr $v2m - 1]
}
#puts $sum

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
}

set mul [dec2bin $sum]
#puts $mul

if { $EXP != 0 } {
set z [split $mul ""] 
#puts $z
set y [expr [llength $z] - $EXP]
#puts $y

set x [linsert $z $y "."]
#puts $x
set mxb [join $x ""]
#puts $mxb
set w [lindex [ split $mxb "."] 0]
#puts $w
if { [ expr $w & 1] == 0 } {
#puts even
} else {
#puts odd
}
} else {
#puts $mul
set w [lindex [ split $mul "."] 0]
#puts $w
if { [ expr $w & 1] == 0 } {
#puts even
} else {
#puts odd
}
}


run \| edit \| history \| help	0