4.3BSD/usr/contrib/icon/src/lib/bitops.icn

#	BITOPS(2)
#
#	Logical operations on strings of 0s and 1s
#
#	Ralph E. Griswold
#
#	Last modified 4/27/83
#
#

#  convert integer i to bit string
#
procedure bitstring(i)
   local b, h
   if i < 0 then {
      h := 1
      i := -(i + 1)
      }
   else h := 0
   b := ""
   while i ~= 0 do {
      b := abs(i % 2) || b
      i /:= 2
      }
   b := right(b,32,"0")
   if h = 1 then b := neg(b)
   return b
end

#  logical "and" of b1 and b2
#
procedure and(b1,b2)
   return map(bsum(b1,b2),"12","01")
end


#  arithmetic sum of b1 and b2 (used by other procedures)
#
procedure bsum(b1,b2)
   static segment
   initial segment := 10
   if *b1 > *b2 then b1 :=: b2
   b1 := right(b1,*b2,"0")
   if *b1 <= segment then return b1 + b2
   return b1[1+:segment] + b2[1+:segment] ||
      bsum(b1[segment + 1:0],b2[segment + 1:0])
end

#  convert bitstring b to integer
#
procedure decimal(b)
   return integer("2r" || b)
end

#  exclusive "or" of b1 and b2
#
procedure exor(b1,b2)
   return map(bsum(b1,b2),"2","0")
end

#  negation (complement) of b
#
procedure neg(b)
   return map(b,"01","10")
end

#  logical "or" of b1 and b2
#
procedure or(b1,b2)
   return map(bsum(b1,b2),"2","1")
end

procedure xstop(x)
   stop("Run-time error 205 in bitstring_
      \nvalue out of range\noffending value: ",
      image(x))
end