!  Conversion and bit utility library
!
!  a True BASIC, Inc. product.
!
!  Copyright (c) 1986 by True BASIC, Inc.
!  All rights reserved.
!

EXTERNAL

DEF convert$(number, base)
    LET number = round(number)
    IF number < 0 then
       LET number = -number
       LET sign$ = "-"
    END IF
    DO
       CALL divide (number, base, number, digit)
       LET digit = digit + 1
       LET c$ = "0123456789ABCDEF"[digit:digit] & c$
    LOOP while number <> 0
    LET convert$ = sign$ & c$
END DEF

DEF hex$(n)
    DECLARE FUNCTION convert$
    LET hex$ = convert$(n,16)
END DEF

DEF oct$(n)
    DECLARE FUNCTION convert$
    LET oct$ = convert$(n,8)
END DEF

DEF bin$(n)
    DECLARE FUNCTION convert$
    LET bin$ = convert$(n,2)
END DEF

DEF hexw$(n)
    LET n = round(n)
    FOR i = 1 to 4
        CALL divide (n, 16, n, digit)
        LET digit = digit + 1
        LET c$ = "0123456789ABCDEF"[digit:digit] & c$
    NEXT i
    LET hexw$ = c$
END DEF

DEF convert(s$)

    LET s$ = ucase$(s$)
    LET base = 10
    LET sign = 1

    LET c$ = s$[1:1]
    IF pos("-+",c$) > 0 then
       IF c$ = "-" then LET sign = -1
       LET s$[1:1] = ""
       LET c$ = s$[1:1]
    END IF

    LET d = pos("0&@%",c$)
    IF d > 0 then
       LET s$[1:1] = ""
       IF d = 4 THEN LET base = 2 ELSE LET base = 8
       LET c$ = s$[1:1]
    END IF

    LET i = 1
    LET d = pos("$HXOQ",c$)
    IF d = 0 then
       LET i = len(s$)
       LET d = pos("$HXOQB",s$[i:i])
    END IF
    IF d > 0 then
       LET base = 2*val("888441"[d:d])
       LET s$[i:i] = ""
    END IF

    LET digits$ = "0123456789ABCDEF"[1:base]

    FOR i = 1 to len(s$)
        LET d = pos(digits$,s$[i:i]) - 1
        IF d < 0 then CAUSE ERROR 4001
        LET value = value*base + d
    NEXT i

    LET convert = sign * value

END DEF

DEF and(a, b)
    LET m = 1
    LET b = int(b)
    DO
       CALL divide (a, 2, a, aa)
       CALL divide (b, 2, b, bb)
       LET r = r + m*aa*bb            ! multiply is like AND
       LET m = 2*m                    ! m = current bit position
       IF b = -1 then
          LET r = r + m*a             ! if negative, treat as two's complement
          EXIT DO
       END IF
    LOOP while b <> 0                 ! loop until all bits of B are used
    LET and = r
END DEF

DEF or(a, b)
    DECLARE DEF and
    LET or = a + b - and(a, b)
END DEF

DEF xor(a, b)
    DECLARE DEF and
    LET xor = a + b - 2*and(a, b)
END DEF