NORM%IONAACAD.BITNET@CUNYVM.CUNY.EDU (Norman Walsh) (03/11/91)
The following directory provides routines for displaying and converting
binary numbers and performing 2's complement arithmatic. The following
entry points are provided through a custom menu:
BDISP - displays the binary number in level 1 of the stack in binary,
octal, hexidecimal, and decimal form. It's basically a mod
of BDISP from the manual.
CONV - converts the number in level 1 of the stack to or from binary
form.
DEC/HEX/
OCT/BIN - select math base.
\->2C - convert number to 2's complement
2C\-> - convert number from 2's complement
2C+ - add 2's complement numbers
2C- - subtract 2's complement numbers
2C* - multiply 2's complement numbers
2C/ - integer division of 2's complement numbers.
The routines are sensitive to the current word size. If you attempt to
convert a number that is outside the current range of 2's complement numbers,
the converted binary will be tagged "CF". This is similar to setting the
carry flag if a math operation exceeds the range of the destination.
If you find these routines useful, please let me know.
ndw
%%HP: T(3)A(D)F(.);
DIR
CST { BDISP CONV
DEC HEX BIN OCT {
"\->2C" \->TC } { "2C\->"
TC\-> } { "2C+" TCS }
{ "2C-" TCM } {
"2C*" TCP } { "2C/"
TCD } { "WS4"
\<< 4 STWS
\>> } { "WS8"
\<< 8 STWS
\>> } { "WS16"
\<< 16 STWS
\>> } { "WS32"
\<< 32 STWS
\>> } { "WS64"
\<< 64 STWS
\>> } RCWS }
BDISP
\<<
IF DUP TYPE
10 \=/
THEN CONV
END DUP DUP
DUP BIN 8 ZPAD
CLLCD 1 DISP HEX 4
ZPAD 2 DISP OCT 3
ZPAD 3 DISP DEC 1
ZPAD 5 DISP 0
FREEZE
\>>
CONV
\<<
IF DUP TYPE
10 ==
THEN B\->R
ELSE R\->B
END
\>>
NEG2C
\<<
IF 2 RCWS 1 -
^ R\->B AND # 0d \=/
THEN 1
ELSE 0
END
\>>
OK
\<<
IF DUP TYPE 0
==
THEN
IF DUP FP 0
==
THEN 1
ELSE 0
END
ELSE 0
END
IF NOT 2 PICK
TYPE 10 \=/ AND
THEN 0
ELSE 1
END
\>>
TCD
\<< TC\-> SWAP TC\->
SWAP / IP \->TC
\>>
TCM
\<< TC\-> SWAP TC\->
SWAP - \->TC
\>>
TCP
\<< TC\-> SWAP TC\->
* \->TC
\>>
TCS
\<< TC\-> SWAP TC\->
+ \->TC
\>>
TC\->
\<<
IF DUP TYPE
12 ==
THEN DTAG
END
IF DUP TYPE
10 ==
THEN
IF DUP
NEG2C
THEN NOT
B\->R 1 + NEG
ELSE B\->R
END
END
\>>
ZPAD
\<< \-> len
\<<
IF DUP TYPE
10 \=/
THEN CONV
END \->STR
DUP SIZE 3 SWAP 1 -
SUB DUP SIZE len +
1 - len / IP len *
'len' STO
WHILE DUP
SIZE len <
REPEAT "0"
SWAP +
END # 0d
\->STR 4 4 SUB + PAD
\>>
\>>
\->TC
\<< 0 \-> tag
\<<
IF DUP TYPE
10 ==
THEN B\->R
END
IF OK
THEN
IF DUP
DUP TYPE 0 == SWAP
ABS 2 RCWS 1 - ^ 1
- > AND
THEN 1
'tag' STO
END
IF DUP 0
<
THEN NEG
1 - R\->B NOT
ELSE R\->B
END
END
IF tag
THEN "CF"
\->TAG
END
\>>
\>>
END
***END OF POSTING***