
 1000  *SAVE S.DP18 MULTIPLY
 1010  *--------------------------------
 1020  * DAC = ARG * DAC
 1030  *--------------------------------
 1040  DMULT  LDA DAC.EXPONENT  IF DAC=0, EXIT
 1050         BEQ .3
 1060         LDA ARG.EXPONENT  IF ARG=0, SET DAC=0 AND EXIT
 1070         BEQ .4
 1080  *---CLEAR RESULT REGISTER--------
 1090         LDA #0
 1100         LDY #19
 1110  .1     STA MAC,Y
 1120         DEY
 1130         BPL .1
 1140  *---FORM PRODUCT OF FRACTIONS----
 1150         JSR MULTIPLY.BY.LOW.DIGITS
 1160         JSR SHIFT.MAC.RIGHT.ONE
 1170         JSR SHIFT.DAC.RIGHT.ONE
 1180         JSR MULTIPLY.BY.LOW.DIGITS
 1190  *---ADD THE EXPONENTS------------
 1200         LDA DAC.EXPONENT
 1210         CLC
 1220         ADC ARG.EXPONENT
 1230         CMP #$C0     CHECK FOR OVERFLOW
 1240         BCS .5       ...OVERFLOW
 1250         SBC #$3F     ADJUST OFFSET
 1260         BMI .4       ...UNDERFLOW
 1270         STA DAC.EXPONENT
 1280  *---FORM SIGN OF PRODUCT---------
 1290         LDA DAC.SIGN
 1300         EOR ARG.SIGN
 1310         STA DAC.SIGN
 1320  *---MOVE MAC TO DAC--------------
 1330         LDY #9
 1340  .2     LDA MAC,Y
 1350         STA DAC.HI,Y
 1360         DEY
 1370         BPL .2
 1380  *---NORMALIZE DAC----------------
 1390         JSR NORMALIZE.DAC
 1400         LDA MAC      IF LEADING DIGIT=0,
 1410         AND #$F0     THEN GET ANOTHER DIGIT
 1420         BNE .3
 1430         LDA MAC+10
 1440         LSR
 1450         LSR
 1460         LSR
 1470         LSR
 1480         ORA DAC.HI+9
 1490         STA DAC.HI+9
 1500  .3     RTS
 1510  .4     LDA #0
 1520         STA DAC.SIGN
 1530         STA DAC.EXPONENT
 1540         RTS
 1550  .5     JMP AS.OVRFLW
 1560  *--------------------------------
 1570  *      MULTIPLY BY EVERY OTHER DIGIT
 1580  *--------------------------------
 1590  MULTIPLY.BY.LOW.DIGITS
 1600         SED          DECIMAL MODE
 1610         LDX #9
 1620         LDY #19
 1630  .1     LDA DAC.HI,X
 1640         AND #$0F     ISOLATE NYBBLE
 1650         BEQ .2       0, SO NEXT DIGIT
 1660         JSR MULTIPLY.ARG.BY.N
 1670  .2     DEY          NEXT MAC POSITION
 1680         DEX          NEXT DAC DIGIT
 1690         BPL .1       DO NEXT DIGIT
 1700         CLD          BINARY MODE
 1710         RTS          DONE
 1720  *--------------------------------
 1730  MULTIPLY.ARG.BY.N
 1740         STA DIGIT    N = 1...9
 1750         STY TEMP     SAVE Y
 1760         STX TEMP+1   SAVE X
 1770  .1     LDX #9       INDEX INTO ARG
 1780         CLC
 1790  .2     LDA ARG.HI,X
 1800         ADC MAC,Y    ADD IT
 1810         STA MAC,Y
 1820         DEY          NEXT MAC
 1830         DEX          NEXT ARG
 1840         BPL .2       NEXT DIGIT
 1850         BCC .4       NO CARRY
 1860  .3     LDA #0       PROPAGATE CARRY
 1870         ADC MAC,Y
 1880         STA MAC,Y
 1890         DEY
 1900         BCS .3       MORE CARRY
 1910  .4     LDY TEMP     GET POSITION IN MAC
 1920  .5     DEC DIGIT    NEXT DIGIT
 1930         BNE .1
 1940         LDX TEMP+1
 1950         RTS          DONE
 1960  *--------------------------------
 1970  SHIFT.MAC.RIGHT.ONE
 1980         LDY #4       4 BITS RIGHT
 1990  .0     LDX #1       20 BYTES
 2000         LSR MAC
 2010  .1     ROR MAC,X
 2020         INX          NEXT BYTE
 2030         PHP
 2040         CPX #20
 2050         BCS .2       NO MORE BYTES
 2060         PLP
 2070         JMP .1
 2080  .2     PLP
 2090         DEY          NEXT BIT
 2100         BNE .0
 2110         RTS
 2120  *--------------------------------

