goapple2/source/applesoft/S.EB72

181 lines
7.4 KiB
Plaintext
Raw Normal View History

2014-05-10 00:59:16 +00:00
1010 *--------------------------------
1020 * ROUND FAC USING EXTENSION BYTE
1030 *--------------------------------
1040 ROUND.FAC
1050 LDA FAC
1060 BEQ RTS.14 FAC = 0, RETURN
1070 ASL FAC.EXTENSION IS FAC.EXTENSION >= 128?
1080 BCC RTS.14 NO, FINISHED
1090 *--------------------------------
1100 * INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY
1110 *--------------------------------
1120 INCREMENT.MANTISSA
1130 JSR INCREMENT.FAC.MANTISSA YES, INCREMENT FAC
1140 BNE RTS.14 HIGH BYTE HAS BITS, FINISHED
1150 JMP NORMALIZE.FAC.6 HI-BYTE=0, SO SHIFT LEFT
1160 *--------------------------------
1170 * TEST FAC FOR ZERO AND SIGN
1180 *
1190 * FAC > 0, RETURN +1
1200 * FAC = 0, RETURN 0
1210 * FAC < 0, RETURN -1
1220 *--------------------------------
1230 SIGN LDA FAC CHECK SIGN OF FAC AND
1240 BEQ RTS.15 RETURN -1,0,1 IN A-REG
1250 *--------------------------------
1260 SIGN1 LDA FAC.SIGN
1270 *--------------------------------
1280 SIGN2 ROL MSBIT TO CARRY
1290 LDA #$FF -1
1300 BCS RTS.15 MSBIT = 1
1310 LDA #1 +1
1320 RTS.15 RTS
1330 *--------------------------------
1340 * "SGN" FUNCTION
1350 *--------------------------------
1360 SGN JSR SIGN CONVERT FAC TO -1,0,1
1370 *--------------------------------
1380 * CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127
1390 *--------------------------------
1400 FLOAT STA FAC+1 PUT IN HIGH BYTE OF MANTISSA
1410 LDA #0 CLEAR 2ND BYTE OF MANTISSA
1420 STA FAC+2
1430 LDX #$88 USE EXPONENT 2^9
1440 *--------------------------------
1450 * FLOAT UNSIGNED VALUE IN FAC+1,2
1460 * (X) = EXPONENT
1470 *--------------------------------
1480 FLOAT.1
1490 LDA FAC+1 MSBIT=0, SET CARRY; =1, CLEAR CARRY
1500 EOR #$FF
1510 ROL
1520 *--------------------------------
1530 * FLOAT UNSIGNED VALUE IN FAC+1,2
1540 * (X) = EXPONENT
1550 * C=0 TO MAKE VALUE NEGATIVE
1560 * C=1 TO MAKE VALUE POSITIVE
1570 *--------------------------------
1580 FLOAT.2
1590 LDA #0 CLEAR LOWER 16-BITS OF MANTISSA
1600 STA FAC+4
1610 STA FAC+3
1620 STX FAC STORE EXPONENT
1630 STA FAC.EXTENSION CLEAR EXTENSION
1640 STA FAC.SIGN MAKE SIGN POSITIVE
1650 JMP NORMALIZE.FAC.1 IF C=0, WILL NEGATE FAC
1660 *--------------------------------
1670 * "ABS" FUNCTION
1680 *--------------------------------
1690 ABS LSR FAC.SIGN CHANGE SIGN TO +
1700 RTS
1710 *--------------------------------
1720 * COMPARE FAC WITH PACKED # AT (Y,A)
1730 * RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC
1740 *--------------------------------
1750 FCOMP STA DEST USE DEST FOR PNTR
1760 *--------------------------------
1770 * SPECIAL ENTRY FROM "NEXT" PROCESSOR
1780 * "DEST" ALREADY SET UP
1790 *--------------------------------
1800 FCOMP2 STY DEST+1
1810 LDY #0 GET EXPONENT OF COMPARAND
1820 LDA (DEST),Y
1830 INY POINT AT NEXT BYTE
1840 TAX EXPONENT TO X-REG
1850 BEQ SIGN IF COMPARAND=0, "SIGN" COMPARES FAC
1860 LDA (DEST),Y GET HI-BYTE OF MANTISSA
1870 EOR FAC.SIGN COMPARE WITH FAC SIGN
1880 BMI SIGN1 DIFFERENT SIGNS, "SIGN" GIVES ANSWER
1890 CPX FAC SAME SIGN, SO COMPARE EXPONENTS
1900 BNE .1 DIFFERENT, SO SUFFICIENT TEST
1910 LDA (DEST),Y SAME EXPONENT, COMPARE MANTISSA
1920 ORA #$80 SET INVISIBLE NORMALIZED BIT
1930 CMP FAC+1
1940 BNE .1 NOT SAME, SO SUFFICIENT
1950 INY SAME, COMPARE MORE MANTISSA
1960 LDA (DEST),Y
1970 CMP FAC+2
1980 BNE .1 NOT SAME, SO SUFFICIENT
1990 INY SAME, COMPARE MORE MANTISSA
2000 LDA (DEST),Y
2010 CMP FAC+3
2020 BNE .1 NOT SAME, SO SUFFICIENT
2030 INY SAME, COMPARE REST OF MANTISSA
2040 LDA #$7F ARTIFICIAL EXTENSION BYTE FOR COMPARAND
2050 CMP FAC.EXTENSION
2060 LDA (DEST),Y
2070 SBC FAC+4
2080 BEQ RTS.16 NUMBERS ARE EQUAL, RETURN (A)=0
2090 .1 LDA FAC.SIGN NUMBERS ARE DIFFERENT
2100 BCC .2 FAC IS LARGER MAGNITUDE
2110 EOR #$FF FAC IS SMALLER MAGNITUDE
2120 * <<< NOTE THAT ABOVE THREE LINES CAN BE SHORTENED: >>>
2130 * <<< .1 ROR PUT CARRY INTO SIGN BIT >>>
2140 * <<< EOR FAC.SIGN TOGGLE WITH SIGN OF FAC >>>
2150 .2 JMP SIGN2 CONVERT +1 OR -1
2160 *--------------------------------
2170 * QUICK INTEGER FUNCTION
2180 *
2190 * CONVERTS FP VALUE IN FAC TO INTEGER VALUE
2200 * IN FAC+1...FAC+4, BY SHIFTING RIGHT WITH SIGN
2210 * EXTENSION UNTIL FRACTIONAL BITS ARE OUT.
2220 *
2230 * THIS SUBROUTINE ASSUMES THE EXPONENT < 32.
2240 *--------------------------------
2250 QINT LDA FAC LOOK AT FAC EXPONENT
2260 BEQ QINT.3 FAC=0, SO FINISHED
2270 SEC GET -(NUMBER OF FRACTIONAL BITS)
2280 SBC #$A0 IN A-REG FOR SHIFT COUNT
2290 BIT FAC.SIGN CHECK SIGN OF FAC
2300 BPL .1 POSITIVE, CONTINUE
2310 TAX NEGATIVE, SO COMPLEMENT MANTISSA
2320 LDA #$FF AND SET SIGN EXTENSION FOR SHIFT
2330 STA SHIFT.SIGN.EXT
2340 JSR COMPLEMENT.FAC.MANTISSA
2350 TXA RESTORE BIT COUNT TO A-REG
2360 .1 LDX #FAC POINT SHIFT SUBROUTINE AT FAC
2370 CMP #$F9 MORE THAN 7 BITS TO SHIFT?
2380 BPL QINT.2 NO, SHORT SHIFT
2390 JSR SHIFT.RIGHT YES, USE GENERAL ROUTINE
2400 STY SHIFT.SIGN.EXT Y=0, CLEAR SIGN EXTENSION
2410 RTS.16 RTS
2420 *--------------------------------
2430 QINT.2 TAY SAVE SHIFT COUNT
2440 LDA FAC.SIGN GET SIGN BIT
2450 AND #$80
2460 LSR FAC+1 START RIGHT SHIFT
2470 ORA FAC+1 AND MERGE WITH SIGN
2480 STA FAC+1
2490 JSR SHIFT.RIGHT.4 JUMP INTO MIDDLE OF SHIFTER
2500 STY SHIFT.SIGN.EXT Y=0, CLEAR SIGN EXTENSION
2510 RTS
2520 *--------------------------------
2530 * "INT" FUNCTION
2540 *
2550 * USES QINT TO CONVERT (FAC) TO INTEGER FORM,
2560 * AND THEN REFLOATS THE INTEGER.
2570 * <<< A FASTER APPROACH WOULD SIMPLY CLEAR >>>
2580 * <<< THE FRACTIONAL BITS BY ZEROING THEM >>>
2590 *--------------------------------
2600 INT LDA FAC CHECK IF EXPONENT < 32
2610 CMP #$A0 BECAUSE IF > 31 THERE IS NO FRACTION
2620 BCS RTS.17 NO FRACTION, WE ARE FINISHED
2630 JSR QINT USE GENERAL INTEGER CONVERSION
2640 STY FAC.EXTENSION Y=0, CLEAR EXTENSION
2650 LDA FAC.SIGN GET SIGN OF VALUE
2660 STY FAC.SIGN Y=0, CLEAR SIGN
2670 EOR #$80 TOGGLE ACTUAL SIGN
2680 ROL AND SAVE IN CARRY
2690 LDA #$A0 SET EXPONENT TO 32
2700 STA FAC BECAUSE 4-BYTE INTEGER NOW
2710 LDA FAC+4 SAVE LOW 8-BITS OF INTEGER FORM
2720 STA CHARAC FOR EXP AND POWER
2730 JMP NORMALIZE.FAC.1 NORMALIZE TO FINISH CONVERSION
2740 *--------------------------------
2750 QINT.3 STA FAC+1 FAC=0, SO CLEAR ALL 4 BYTES FOR
2760 STA FAC+2 INTEGER VERSION
2770 STA FAC+3
2780 STA FAC+4
2790 TAY Y=0 TOO
2800 RTS.17 RTS