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