Hex nach BCD wandeln

Der Trick hier ist, eine BCD-Zahl durch fortwährende Multiplikation mit 2 (in BCD-Arithmetik) zu erzeugen, die dem Wert der ebenfalls fortwährend mit 2 multiplizierten Binärzahl entspricht.

: bcd2* ( bcd1 -- bcd2 )
  dup $88888888 and 2/ dup 2/ or swap 2* swap + \ forward carry correction
  dup $88888888 and over $44444444 and 2 pick $22222222 \ BCD correction
  and 2* or 2* and 2/ dup 2/ or + ;
 
: hex>bcd ( u -- bcd )
  0 8 cells 0 DO  bcd2* over 0< - swap 2* swap  LOOP  nip ;
 
12345678 hex>bcd hex. $12345678
98765432 hex>bcd hex. $98765432