
 1000  *SAVE BCD.MAGIC
 1010  *--------------------------------
 1020  CROUT  .EQ $FD8E
 1030  PRBYTE .EQ $FDDA
 1040  COUT   .EQ $FDED
 1050  *--------------------------------
 1060  VALUE  .EQ 0
 1070  *--------------------------------
 1080  T
 1090         LDA #0       FOR VALUE = 0 TO $FF
 1100  .1     STA VALUE
 1110         LDA #" "
 1120         JSR COUT
 1130         LDA VALUE
 1140         JSR PRBYTE
 1150  *--------------------------------
 1160         JSR IS.BCD.VALUE.DIVISIBLE.BY.FOUR
 1170         BEQ .2       ...YES
 1180         LDA #" "     ...NO
 1190         .HS 2C
 1200  .2     LDA #"*"
 1210         JSR COUT
 1220  *--------------------------------
 1230         LDA #" "     SEPARATE ITEMS IN CHART
 1240         JSR COUT
 1250         LDA VALUE    NEW LINE AFTER TEN VALUES
 1260         AND #$0F
 1270         CMP #9
 1280         BNE .3
 1290         JSR CROUT
 1300  *---NEXT VALUE-------------------
 1310  .3     SED          MUST DO ARITHMETIC
 1320         LDA VALUE       IN DECIMAL MODE
 1330         CLC
 1340         ADC #1
 1350         CLD          BACK TO BINARY
 1360         BCC .1       ...UNTIL WRAP-AROUND
 1370         RTS
 1380  *--------------------------------
 1390  IS.BCD.VALUE.DIVISIBLE.BY.FOUR
 1400         LDA VALUE    RETURN .EQ. STATUS IF YES
 1410         AND #$13            .NE. STATUS IF NOT
 1420         BEQ .1
 1430         EOR #$12
 1440  .1     RTS
 1450  *--------------------------------
 1460  DIVIDE.BCD.VALUE.BY.FOUR
 1470         LDA VALUE
 1480         JSR DIVIDE.BCD.VALUE.BY.TWO
 1490  DIVIDE.BCD.VALUE.BY.TWO
 1500         PHA
 1510         AND #$10
 1520         BEQ .1
 1530         PLA
 1540         SBC #6
 1550         LSR
 1560         RTS
 1570  .1     PLA
 1580         LSR
 1590         RTS
 1600  *--------------------------------
 1610  SHORTER.DIV.BY.TWO
 1620         LSR
 1630         TAX
 1640         AND #8
 1650         BEQ .1
 1660         DEX
 1670         DEX
 1680         DEX
 1690  .1     TXA
 1700         RTS
 1710  *--------------------------------
 1720  D
 1730         LDA #0       FOR VALUE = 0 TO $FF
 1740  .1     STA VALUE
 1750         LDA #" "
 1760         JSR COUT
 1770         LDA VALUE
 1780         JSR PRBYTE
 1790         LDA #"."
 1800         JSR COUT
 1810  *--------------------------------
 1820         JSR DIVIDE.BCD.VALUE.BY.FOUR
 1830         JSR PRBYTE
 1840  *--------------------------------
 1850         LDA #" "     SEPARATE ITEMS IN CHART
 1860         JSR COUT
 1870         LDA VALUE    NEW LINE AFTER TEN VALUES
 1880         AND #$0F
 1890         CMP #9
 1900         BNE .3
 1910         JSR CROUT
 1920  *---NEXT VALUE-------------------
 1930  .3     SED          MUST DO ARITHMETIC
 1940         LDA VALUE       IN DECIMAL MODE
 1950         CLC
 1960         ADC #1
 1970         CLD          BACK TO BINARY
 1980         BCC .1       ...UNTIL WRAP-AROUND
 1990         RTS

