NAM MATH OPT O,NOG ORG $1000 SPC 1 * IN THE FOLLOWING SUBROUTINES INVOLVING TWO * OPERANDS,THE FIRST OPERAND IS AT LOCATIONS 03 TO * 07 IN THE FOLLOWING FORMAT: * LOCATION 03 M.S.BYTE OF MANTISSA * 04 MIDDLE BYTE OF MANTISSA * 05 L.S.BYTE OF MANTISSA * 06 EXPONENT * 07 SIGN OF MANTISSA * THE ADDRESS OF THE SECOND OPERAND IS SPECIFIED BY * THE INDEX REGISTER AS FOLLOWS: * 0,X M.S.BYTE OF MANTISSA * 1,X MIDDLE BYTE OF MANTISSA * 2,X L.S.BYTE OF MANTISSA * 3,X EXPONENT * 4,X SIGN OF MANTISSA * THE RESULT ALWAYS OVERWRITES THE FIRST OPERAND IN * LOCATIONS 03 TO 07 ; THE SECOND OPERAND REMAINS * UNALTERED SPC 1 FLAG EQU $07 SIGN OF FIRST OPERAND T1 EQU $08 TEMP. STORE FOR X REGISTER COUNT EQU $0A NUM EQU $0B FLAG1 EQU $0C ANS1 EQU $0F ANS2 EQU $13 S1 EQU $17 C1 EQU $1B SPC 1 * ADDITION ROUTINE. ADD * ---------------- * THE ADDEND,THE ADDRESS OF WHICH IS SPECIFIED BY * THE INDEX REGISTER,IS ADDED TO THE AUGEND IN * LOCATIONS 03 TO 07. SPC 1 ADD LDA A 4,X TEST SIGN OF ADDEND BPL ADDP IF SIGN IS NEGATIVE THEN JSR SUBP ...SUBTRACT ADDEND RTS ADDP STX T1 SAVE INDEX REGISTER JSR ADJEXP ADJUST EXPONENTS LDA A 03 ORA A 04 ORA A 05 BNE A1 TEST IF MANTISSA=0 CLR FLAG SET SIGN TO POSITIVE JSR GET RTS A1 LDA A FLAG TEST FLAG BEQ L1 JSR COMPL COMPLEMENT MANTISSA L1 JSR ADD1 ADD MANTISSAS BCS L2 CHECK IF OVERFLOW OCCURRED LDA A FLAG TEST SIGN BEQ OUT1 JSR COMPL COMPLEMENT MANTISSA JSR NORM NORMALISE RESULT BRA OUT1 L2 LDA A FLAG TEST SIGN BNE L3 SEC SHIFT IN A "1" ROR 0003 ROR 0004 ROR 0005 INC 0006 ADJUST EXPONENT OUT1 LDX T1 RESTORE INDEX REGISTER RTS L3 CLR FLAG SET SIGN TO POSITIVE JSR NORM NORMALISE RESULT BRA OUT1 SPC 1 * NORMALISATION ROUTINE NORM LDA A 03 CHECK IF NORMALISED BMI R2 LDA A #25 SET MAX.NUMBER OF SHIFTS L5 DEC A BEQ L4 DEC 0006 DECREMENT EXPONENT BVS ZERO CHECK FOR 2'S COMPL.OVERFLOW ASL 0005 SHIFT MANTISSA LEFT ROL 0004 ROL 0003 BPL L5 REPEAT IF NOT YET NORMALISED R2 RTS ZERO CLR A STA A 03 SET MANTISSA=0 STA A 04 STA A 05 L4 LDA A #$80 SET EXPONENT TO LARGEST STA A 06 ...NEGATIVE NUMBER ALLOWED CLR FLAG RTS SPC 1 * SUBTRACTION ROUTINE. SUBTR * ------------------- * THE SUBTRAHEND,THE ADDRESS OF WHICH IS SPECIFIED * BY THE INDEX REGISTER,IS SUBTRACTED FROM THE * MINUEND IN LOCATIONS 03 TO 07. SPC 1 SUBTR LDA A 4,X TEST SIGN OF SUBTRAHEND BPL SUBP IF SIGN IS NEGATIVE,THEN JSR ADDP ...ADD SUBTRAHEND RTS SUBP COM FLAG CHANGE SIGN JSR ADDP ADD ABS.VALUE OF SUBTRAHEND COM FLAG CHANGE SIGN OF RESULT RTS SPC 1 * SUBROUTINE 'ADJEXP' OPERATES ON THE SMALLER OF * THE TWO OPERANDS. ITS MANTISSA IS SHIFTED RIGHT * AND ITS EXPONENT INCREASED UNTIL IT IS EQUAL TO * THE EXPONENT OF THE LARGER OPERAND. ADJEXP LDA A 3,X EXPONENT OF ADDEND CMP A 06 EXPONENT OF AUGEND BEQ RET1 TEST FOR EQUAL EXPONENTS BLT RELOC (3,X)<(06) ADJ1 LSR 0003 SHIFT MANTISSA TO RIGHT AND ROR 0004 ...INCREASE EXPONENT ROR 0005 INC 0006 CMP A 06 BNE ADJ1 RET1 RTS SPC 1 * SUBROUTINE 'RELOC' IS REQUIRED IN CASE THE ADDEND * IS A CONSTANT IN ROM. IF ITS EXPONENT IS SMALLER * THAN THAT OF THE AUGEND,IT MUST BE TRANSFERRED TO * RAM SO THAT ITS MANTISSA CAN BE SHIFTED RIGHT AND * ITS EXPONENT INCREASED UNTIL IT EQUALS THE * EXPONENT OF THE AUGEND. RELOC LDA B 0,X COPY MANTISSA INTO 00,01,02 STA B 00 LDA B 1,X STA B 01 LDA B 2,X STA B 02 ADJ2 LSR 0000 SHIFT MANTISSA TO RIGHT AND ROR 0001 ...INCREASE EXPONENT ROR 0002 INC A A CONTAINS EXP.OF ADDEND CMP A 06 COMPARE WITH EXP.OF AUGEND BNE ADJ2 LDX #0000 LOAD X REG.WITH ADDR. RTS ...OF RELOCATED ADDEND. SPC 1 * SUBROUTINE 'COMPL' FORMS THE 2'S COMPLEMENT OF * THE 3-BYTE WORD IN LOCATIONS 03,04 AND 05 COMPL CLR A SUB A 05 STA A 05 LDA A #00 SBC A 04 STA A 04 LDA A #00 SBC A 03 STA A 03 RTS SPC 1 * SUBROUTINE 'ADD1' ADDS THE MANTISSA OF THE ADDEND * AT THE ADDRESS SPECIFIED BY THE INDEX REGISTER TO * THAT OF THE AUGEND IN LOCATIONS 03,04,05 AND * STORES THE RESULT IN 03,04,05 ADD1 LDA A 05 ADD A 2,X STA A 05 LDA A 04 ADC A 1,X STA A 04 LDA A 03 ADC A 0,X STA A 03 RTS SPC 1 * SUBROUTINE 'SUB1' SUBTRACTS THE MANTISSA OF THE * SUBTRAHEND AT THE ADDRESS SPECIFIED BY THE INDEX * REGISTER FROM THAT OF THE MINUEND IN LOCATIONS * 03,04,05 AND STORES THE RESULT IN 03,04,05 SUB1 LDA A 05 SUB A 2,X STA A 05 LDA A 04 SBC A 1,X STA A 04 LDA A 03 SBC A 0,X STA A 03 RTS SPC 1 * SUBROUTINE 'MOVE' TRANSFERS THE THREE BYTES AT * LOCATIONS 00,01,02 TO LOCATIONS 03,04,05 MOVE LDA A 00 STA A 03 LDA A 01 STA A 04 LDA A 02 STA A 05 RTS SPC 1 * MULTIPLICATION ROUTINE. MULT * ---------------------- * THE MULTIPLICAND AT LOCATIONS 03 TO 07 IS * MULTIPLIED BY THE MULTIPLIER,THE ADDRESS OF WHICH * IS SPECIFIED BY THE INDEX REGISTER. SPC 1 MULT LDA A 4,X TEST SIGN OF MULTIPLIER BPL MULTP COM FLAG CHANGE SIGN MULTP JSR ZTST TEST IF MULTIPLICAND=0 CLR B STA B 00 CLEAR 00,01,02 STA B 01 STA B 02 LDA B #24 B CONTAINS SHIFT COUNT LSR 0003 SHIFT MANTISSA OF MULTIPLICAND ROR 0004 ...TO RIGHT ONE BIT WITH ROR 0005 ...L.S.BIT INTO CARRY M1 BCC SHFT CARRY=1? LDA A 2,X YES: ADD MANTISSA OF ADD A 02 ...MULTIPLIER TO FORM PARTIAL STA A 02 ...RESULT. LDA A 1,X ADC A 01 STA A 01 LDA A 0,X ADC A 00 STA A 00 SHFT ROR 0000 NO: SHIFT MANTISSA OF PARTIAL ROR 0001 ...RESULT AND MULTIPLICAND ROR 0002 ...TO RIGHT ONE BIT. ROR 0003 ROR 0004 ROR 0005 DEC B CONTINUE UNTIL SHIFT COUNT=0 BNE M1 LDA A 3,X ADD A 06 ADD EXPONENTS BVS Z1 CHECK FOR 2'S COMPL.OVERFLOW STA A 06 LDA A 00 TEST IF RESULT IS NORMALISED BMI M2 ROL 0003 ROTATE LEFT TO NORMALISE ROL 0002 ROL 0001 ROL 0000 DEC 0006 BVS Z1 CHECK FOR 2'S COMPL.OVERFLOW M2 JSR MOVE TRANSFER MANTISSA OF RESULT LDA A 03 ...TO LOCATIONS 03,04,05 BEQ Z1 CHECK IF RESULT=0 RTS SPC 1 * SUBROUTINE 'ZTST' TESTS IF THE FIRST OPERAND=0 * IN WHICH CASE THE OPERATION (MULTIPLICATION, * DIVISION,OR SQUARE ROOT),IS BYPASSED AND THE * RESULT IS LEFT AS ZERO ZTST LDA A 03 BNE R1 INS INS R1 RTS SPC 1 Z1 JMP ZERO SPC 1 * DIVISION ROUTINE. DIV * ---------------- * THE DIVIDEND AT LOCATIONS 03 TO 07 IS DIVIDED BY * THE DIVISOR,THE ADDRESS OF WHICH IS SPECIFIED BY * THE INDEX REGISTER. SPC 1 DIV LDA A 4,X TEST SIGN OF DIVIDEND BPL DIVP COM FLAG CHANGE SIGN DIVP JSR ZTST TEST IF DIVIDEND=0 CLR B STA B 00 CLEAR 00,01,02 STA B 01 STA B 02 LDA B #25 B CONTAINS SHIFT COUNT COMP JSR SUB1 DIVIDEND>DIVISOR? BCC SHFT1 YES: SHIFT A"1"INTO QUOTIENT JSR ADD1 NO: ADD BACK DIVISOR AND CLC ...SHIFT A"0"INTO QUOTIENT BRA SHFT0 SHFT1 SEC SHFT0 ROL 0002 ROL 0001 ROL 0000 DEC B SHIFT COUNT=0? BEQ TC YES:DIV.OF MANTISSAS COMFLETE ASL 0005 NO:CONTINUE DIVISION ROL 0004 ROL 0003 BCC COMP CARRY SET?NO:COMPARE OPERANDS JSR SUB1 YES:SUBTRACT AND SHIFT A "1" BRA SHFT1 ...INTO QUOTIENT TC BCC SBEXP ROR 0000 ROR 0001 ROR 0002 INC 0006 SBEXP LDA A 06 SUB A 3,X SUBTRACT EXPONENTS BVS Z1 CHECK FOR 2'S COMPL.OVERFLOW STA A 06 JSR MOVE TRANSFER MANTISSA OF RESULT RTS ...TO LOCATIONS 03,04,05 SPC 1 * SUBROUTINE 'GET' TRANSFERS 4 BYTES OF DATA FROM * LOCATIONS SPECIFIED BY THE INDEX REGISTER,TO * LOCATIONS 03,04,05,06. GET LDA A 0,X STA A 03 LDA A 1,X STA A 04 LDA A 2,X STA A 05 LDA A 3,X STA A 06 RTS SPC 1 * SUBROUTINE 'SAVE' TRANSFERS 4 BYTES OF DATA * FROM LOCATIONS 03,04,05,06 TO LOCATIONS SPECIFIED * BY THE INDEX REGISTER. SAVE LDA A 03 STA A 0,X LDA A 04 STA A 1,X LDA A 05 STA A 2,X LDA A 06 STA A 3,X RTS SPC 1 * SQUARE ROOT ROUTINE. SQRT * ------------------- * THE SQUARE ROOT OF THE NUMBER IN LOACTIONS 03 TO * 06 IS COMPUTED USING THE NEWTON-RAPHSON ALGORITHM. * THE RESULT OVERWRITES THE INPUT IN 03,04,05,06. SPC 1 SQRT JSR ZTST TEST IF NUMBER=0 LDX #NUM STORE NUMBER JSR SAVE LDX #ANS1 JSR SAVE ASR ANS1+3 HALVE EXP.--INITIAL ESTIMATE SQ1 JSR DIVP CALCULATE NEXT ESTIMATE JSR ADDP DEC 0006 LDX #ANS2 ...AND STORE IN ANS2 JSR SAVE LDX #ANS1 JSR SUBP SUBTRACT PREVIOUS ESTIMATE CLR FLAG LDA B 06 LDX #ANS2 JSR GET CMP B #$EC COMPARE EXP.OF DIFF.BETW.TWO BGT ITER ...SUCCESSIVE ESTIMATES RTS CONTINUE ITERATION UNTIL THIS ITER LDX #ANS1 DIFF.IS SUFFICIENTLY SMALL JSR SAVE LDX #NUM JSR GET LDX #ANS2 BRA SQ1 SPC 1 * SINE ROUTINE. SIN * ------------ * THE SINE OF THE ANGLE (IN RADIANS) IN LOCATIONS 03 * TO 07 IS CALCULATED USING 6 TERMS OF THE TAYLOR * SERIES. THE RESULT OVERWRITES THE INPUT IN 03 -07 SPC 1 SIN LDA A FLAG STORE SIGN STA A FLAG1 CLR FLAG LDX #K2P SUBTRACT 2*PI REPEATEDLY SIN1 JSR SUBP ...UNTIL X<2*PI LDA A FLAG BEQ SIN1 JSR ADDP LDX #K90 DETERMINE IF X