File: F4FFT.MC of Tape: Various/ETH/eth11-3
(Source file text)
.TITLE THE FAST FOURIER TRANSFORM SUBROUTINE(FFT) ;LABORATORY SUBROUTINES ;DEC-11 ;FILE F4FFT.MAC ;FILE ID F4FFT.1 .CSECT F4FFT ; COPYRIGHT (C) 1976 BY ; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ; ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ; ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ; ; ; ;LDP SOFTWARE DEVELOPMENT GROUP SEPTEMBER, 1977. .SBTTL CONDITIONALS, GLOBALS AND MACROS ;CONDITIONAL ASSEMBLY PARAMETERS ; DEFINE PARAMETERS BY REMOVING FIRST ";" IN LINE WHICH ; PRECEEDS THE APPROPRIATE PARAMETER. ;EIS=1 ;EAE=1 ;F.MAXN=1024. .IFDF EAE DIV=177300 AC=DIV+2 MQ=AC+2 MUL=MQ+2 EAESR=MUL+3 .ENDC ;CONDITIONAL ASSEMBLY PARAMETER DESCRIPTIONS ;EIS "EIS" SHOULD BE DEFINED IF EIS(KE11-E) HARDWARE IS AVAILABLE ; ON THE SYSTEM WHERE THIS SOFTWARE IS TO BE USED. IF NOT DEFINED, ; SUBROUTINES WHICH MIMIC THE REQUIRED FUNCTIONS OF THIS HARDWARE ; ARE ASSEMBLED AND SUBSTITUTED. ; ;EAE "EAE" SHOULD BE DEFINED IF EIS HARDWARE IS NOT AVAILABLE BUT ; THE EAE IS. ; NOTE: IF EAE HARDWARE IS AVAILABLE AND IS TO BE USED, THE ; DEFAULT ADDRESSES ASSOCIATED WITH THE DEVICE ARE USED. ; IF YOUR "EAE" IS NOT INSTALLED AT THE NORMAL LOCATIONS ; THE DEFAULT ADDRESSES OF THE STATUS WORDS SHOULD BE ; MODIFIED TO REFLECT THIS DESCREPENCY BY REDEFINING "DIV" ; BY EDITING THIS FILE AND SETTING IT EQUAL TO THE STARTING ; ADDRESS OF THE STATUS WORDS ASSOCIATED WITH THE "EAE". ;GLOBALS ; -INTERNAL .GLOBL FFT,$F.R .IF NDF,EIS .IF NDF,EAE .GLOBL $F.MUL NON=1 .ENDC .ENDC .IIF NDF,F.MAXN,F.MAXN=1024. ;MAXIMUM NUMBER OF POINTS ; THIS SUBROUTINE CAN PROCESS F.HMXN= F.MAXN/2 ;F.HMXN=HALF MAXN .IF DF EAE F.PROD= AC F.MPLI= MQ F.MCND= MUL F.SHFT= MUL+10 .ENDC ;MPYCNT IS AN OPTIMIZATION VARIABLE FOR PROCESSORS WITHOUT ;HARDWARE MULTIPLY. IT MAY BE LEGALLY DEFINED AS ONE OF ;THE FOLLOWING OCTAL VALUES: 1, 2, 4, 10, OR 20. TO MINIMIZE ;STOREAGE REQUIREMENTS, SET MPYCNT=20 TO MAXIMIZE SPEED, ;SET MPYCNT=1. SEE THE MULTIPLY SUBROUTINE FOR MORE DETAILS. .IIF NDF,MPYCNT,MPYCNT=1 ;MAXIMUM SPEED ;REGISTER DEFINITIONS R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ;MACROS ; -INTERNAL .IF EQ,F.MAXN-1024. MFLAG= 1 .MACRO TBL,A,B,C,D,E,F,G,H .WORD A .ENDM .ENDC .IF EQ,F.MAXN-2048. MFLAG= 1 .MACRO TBL,A,B,C,D,E,F,G,H .WORD A,E .ENDM .ENDC .IF EQ,F.MAXN-4096. MFLAG= 1 .MACRO TBL,A,B,C,D,E,F,G,H .WORD A,C,E,G .ENDM .ENDC .IF EQ,F.MAXN-8192. MFLAG= 1 .MACRO TBL,A,B,C,D,E,F,G,H .WORD A,B,C,D,E,F,G,H .ENDM .ENDC .IF NDF,MFLAG .ERROR F.MAXN;F.MAXN MUST BE 1024, 2048, 4096, OR 8192 .ENDC .SBTTL FFT CALLING SEQUENCE ;CALLING SEQUENCE FOR FORTRAN: ; CALL FFT(IERROR,N,IREAL,IIMAG,INVERS,ISCALE) ;WHERE: ; IERROR IS AN INTEGER VALUE RETURNED BY THE SUBROUTINE TO ; INDICATE A POSSIBLE ERROR CONDITION. ; = 0 => NO ERRORS ; = 1 => N IS LESS THAN OR EQUAL TO 8 ; = 2 => N IS GREATER THAN F.MAXN(ASSEMBLY PARAMETER) ; = 3 => N IS NOT A POWER OF 2 ; < 0 => NUMBER OF ARGUMENTS IS WRONG OR AN ARGUMENT IS ; DEFAULTED. ; !!!NOTE:!!! ; IF THIS ARGUMENT IS OMITTED A FATAL ERROR WILL OCCUR ; AS AN M-TRAP OR IN FORTRAN ERR 62 ; N IS AN INTEGER VALUE SPECIFYING THE LENGTH OF THE ARRAYS TO ; BE TRANSFORMED. THE VALUE OF N MUST BE GREATER THAN OR EQUAL ; TO 8 BUT LESS THAN OR EQUAL TO "F.MAXN", A CONDITIONAL ; ASSEMBLY PARAMETER. N MUST ALSO BE A POWER OF 2, I.E. N=2**??. ; IREAL IS AN INTEGER ARRAY CONTAINING THE REAL PART OF THE ; COMPLEX ARRAY TO BE TRANSFORMED. ; IIMAG IS AN INTEGER ARRAY CONTAINING THE IMAGINARY PART OF THE ; COMPLEX ARRAY TO BE TRANSFORMED. ; INVERS IS AN INTEGER WHOSE VALUE SIGNALS THE DIRECTION OF THE ; TRANSFORM TO BE EVALUATED. ; = 0 => PERFORM A FORWARD FOURIER TRANSFORM ; = 1 => PERFORM AN INVERSE FOURIER TRANSFORM ; ISCALE IS AN INTEGER VALUE RETURNED BY THE SUBROUTINE INDICATING ; THE NUMBER OF TIMES THE DATA WAS HALVED IN ORDER TO AVOID ; AN OVERFLOW CONDITION IN INTEGER ARITHMETIC. THUS THE ; RESULTS SHOULD BE MULTIPLIED BY 2**ISCALE IN ORDER TO GET ; THE ACTUAL RESULTS. .SBTTL FFT INITALIZATION ;ERROR IN PARAMETERS ARGERR: COM R0 ;MAKE R0 NEGATIVE FOR ARGUMENT ERROR F.ERR: INC R0 ;INDICATE ERROR(DOESN'T AFFECT ARGERR) JMP F.EXIT FFT: MOVB (R5),R1 ;GET ARGUMENT COUNT BNE SOME ;IF ANY ARGUMENTS, BRANCH ;!!NOTE INTENTIONAL TRAP ON MISSING ARGS !! TRAPER: MOV R0,1 ;IF NONE, OR IERROR MISSING, TRAP OUT ; SOME: TST (R5)+ ;SKIP # OF ARGMENTS COUNT MOV R5,R3 ;GET ADDRESS OF LIST OF ARG ADRESSES CMP #-1,(R3)+ ;CHECK FOR IERROR PRESENT BEQ TRAPER ;IF NOT TRAP OUT MOV (R5)+,F.EROR ;RECORD ERROR ADDRESS MOV #5,R0 ;MAKE SURE WE TEST ONLY LAST 5 ARGS CMP R1,#6 ;CHECK ON CORRECT # OF ARGUMENTS BLT ARGERR ;IF NOT ENOUGH, GO REPORT ERROR ADD #12,R3 ;POINT TO END OF LIST 1$: CMP #-1,-(R3) ;GET FOR DEFAULTED ARGUMENT BEQ ARGERR ;IF DEFAULTED, ERROR DEC R0 ;DECREMENT ARGUMENT COUNT BNE 1$ ; LOOP TILL ALL ARGS CHECKED MOV @(R5)+,R3 ;R3 = # OF POINTS MOV R3,F.N ;STASH IT MOV (R5)+,F.REP ;PTR OF REAL ARRAY MOV (R5)+,F.IMP ;PRT OF IMAG ARRAY MOV @(R5)+,F.INV ;0 FOR FORWARD, 1 FOR INVERSE MOV (R5)+,F.SCLF ;PTR TO SCALE FACTOR ;TEST FOR LEGAL VALUE OF N TST R3 ;TEST N BLE F.ERR INC R0 ;SET ERROR FOR N TOO BIG CMP #F.MAXN,R3 ;N GT MAX VALUE? BLT F.ERR ;JMP IF ERROR INC R0 ;SET ERROR FOR N NOT A POWER OF 2 MOV R3,R1 ;CALCULATE POWER OF 2 & CLR R4 ;TEST N. COMPUTE R IN XR4 F.IN2: ROR R1 BCS F.IN3 INC R4 BR F.IN2 F.IN3: BNE F.ERR ;JMP IF N NOT PWR OF 2 CLR R0 ;SET ERROR FOR N TOO SMALL-LESS THAN 8 SUB #2,R4 ;ADJUST R FOR MAIN LOOP BLE F.ERR ;JMP IF N LT 8 MOV R4,(PC)+ ;STASH R $F.R: 0 ;(LOG N)-2 ;CALCULATE INCREMENT FOR THE TRIG TABLE CLR R1 MOV #F.MAXN/2,R2 F.IN4: ASR R2 INC R1 CMP R4,R1 BGT F.IN4 MOV R2,(PC)+ ;TRIG TABLE INCREMENT F.HH: 0 CLR @(PC)+ ;INITIALIZE SCALE FACTOR F.SCLF: 0 .SBTTL FFT MAIN LOOP PROCESSING F.MAIN: MOV #1,(PC)+ ;1 SUBGROUP IN FIRST COLUMN F.LL: 0 ;# OF SUBGROUPS WITHIN COLUMN ASL R3 ;XR3 CONTAINS N. ADDRESSES ;GO BY 2'S MOV R3,(PC)+ ;M IS POINTER TO NEXT SUBGP F.M: 0 MOV #F.ORT1-F.NXTI,F.ORTN ;SET UP RETURN FROM OFLOW RTN MOV R4,(PC)+ ;XR4 CONTAINS R. START MAIN F.L: 0 ;LOOP:(LOG N)-2 TIMES MOV PC,R0 ;ADDR OF F.REF1 TO R0 ADD #F.TRIG-.,R0 ;COMPUTE ADDR OF F.TRIG MOV R0,(PC)+ ;SAVE IT FOR TABLE LOOK-UP F.TRGP: 0 BR F.SKP8 F.OFL2: TST (SP)+ ;CLEAR STACK F.OFL4: TST (SP)+ JMP F.OFL F.SKP8: F.NXTC: MOV F.M,(PC)+ ;OFFSET OF NEXT SUBGROUP F.ORG: 0 ;ORGIN OF EACH SUBGROUP ASR F.M ;M=M/2 CLR (PC)+ ;POINTER TO TOP HALF SUBGROUP F.A1: 0 MOV F.M,(PC)+ ;POINTER TO BOTTOM HALF SUBGROUP F.A2: 0 MOV F.LL,(PC)+ ;NUMBER OF SUBGROUPS PER COL F.K: 0 F.NXTS: CLR (PC)+ ;START NEXT SUBGROUP F.H: 0 ;POWER OF W CLR (PC)+ ;J IS ADRS INDEX - STEP BY 2'S F.J: 0 MOV F.A1,R2 ;SET UP SUBGP HALF ADDRESSES MOV R2,R4 ADD (PC)+,R2 ;R2 POINTS TO 1ST HALF REAL F.REP: 0 ADD (PC)+,R4 ;R4 POINTS TO 1ST HALF IMAG F.IMP: 0 MOV F.A2,R3 ; " MOV R3,R5 ADD F.REP,R3 ;R3 POINTS TO 2ND HALF REAL ADD F.IMP,R5 ;R5 POINTS TO 2ND HALF IMAG F.SBGP: F.ORT1: MOV @R2,R0 ;GET 1ST HALF, REAL MOV @R4,R1 ;GET 1ST HALF, IMAG MOV R0,-(SP) ;TEMP ADD @R3,(SP) ;DON'T ADD DIRECTLY, SINCE YOU BVS F.OFL4 ;DON'T WANT TO ALTER THE DATA MOV R1,-(SP) ;TEMP ADD @R5,(SP) ;BEFORE CHECKING FOR OVERFLOW BVS F.OFL2 SUB @R3,R0 ;FORM SR-TR BVS F.OFL2 SUB @R5,R1 ;FORM SI-TI BVS F.OFL2 MOV R2,-(SP) ;SAVE REGISTERS 2-5 MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) MOV F.TRGP,R4 ;ADDR OF TRIG TBLE TO XR4 MOV R4,R5 CMP F.H,#F.HMXN ;LOOK UP SINE AND COSINE BLE F.HOP1 ;(2 BYTES = 1 WORD) SUB F.H,R4 ;H GT 512 MOV F.MAXN(R4),R3 ;SINE ADD F.H,R5 MOV -F.HMXN(R5),R2 ;COSINE NEG R2 ;NEGATE COSINE BR F.HOP2 F.HOP1: ADD F.H,R4 ;H LE 512 MOV (R4),R3 ;SINE SUB F.H,R5 MOV F.HMXN(R5),R2 ;COSINE F.HOP2: TST (PC)+ F.INV: 0 BEQ F.HOP3 ;NO, SKIP NEG R3 ;YES, NEGATE SINE .SBTTL FFT EAE CONDITIONAL CODE F.HOP3: .IF DF,EAE MOV #F.PROD,R5 MOV #F.MPLI,R4 MOV R2,(R4)+ ;FORM 2ND HALF SUBGROUP ENTRY MOV R0,(R4) INC @#F.SHFT MOV @R5,F.TRT MOV R3,-(R4) MOV R1,@#F.MCND INC @#F.SHFT ADD @R5,F.TRT BVS F.OFLO MOV R2,(R4)+ MOV R1,(R4) INC @#F.SHFT MOV @R5,R1 MOV R3,-(R4) MOV R0,@#F.MCND INC @#F.SHFT SUB @R5,R1 BVS F.OFLO .ENDC .SBTTL FFT EIS CONDITIONAL CODE .IF DF,EIS MOV R2,R4 ;FORM 2ND HALF SUBGROUP ENTRY MUL R0,R4 ASHC #1,R4 ;LONG ARITHMATIC SHIFT LEFT 1 MOV R4,F.TRT MOV R3,R4 MUL R1,R4 ASHC #1,R4 ADD R4,F.TRT BVS F.OFLO MOV R2,R4 MUL R1,R4 ASHC #1,R4 MOV R4,R1 MOV R3,R4 MUL R0,R4 ASHC #1,R4 SUB R4,R1 BVS F.OFLO .ENDC .SBTTL FFT NON CONDITIONAL CODE .IF DF,NON MOV R3,-(SP) ;PUT SIN & COS ON THE STACK MOV R2,-(SP) MOV R2,R5 ;FORM 2ND HALF SUBGROUP ENTRY MOV R0,R4 JSR PC,$F.MUL MOV R3,F.TRT MOV 2(SP),R5 MOV R1,R4 JSR PC,$F.MUL ADD R3,F.TRT BVS F.OFLO MOV (SP)+,R5 MOV R1,R4 JSR PC,$F.MUL MOV R3,R1 MOV (SP)+,R5 MOV R0,R4 JSR PC,$F.MUL SUB R3,R1 BVS F.OFLR .ENDC .SBTTL FFT END-OF-MAIN-LOOP CODE MOV (SP)+,R5 ;RESTORE REGISTERS MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,(R4)+ ;INSERT TRANSFORMED POINTS MOV (SP)+,(R2)+ ; " MOV (PC)+,(R3)+ ; " F.TRT: 0 ;TEMPORARY MOV R1,(R5)+ ;INSERT TRANFORMED PTS ADD F.HH,F.H ;INCREMENT POWER OF W ADD #2,F.J ;INC POINTER W/IN SUBGROUP CMP F.M,F.J BLE F.SKP4 ;CONTINUE XFORM OF THE SUBGROUP JMP F.SBGP ; " F.SKP4: ADD F.ORG,F.A1 ;INIT FOR NEXT SUBGROUP ADD F.ORG,F.A2 DEC F.K BLE F.SKP5 ;GO DO NEXT SUBGROUP JMP F.NXTS ; " F.SKP5: ASL F.LL ;#SUBGPS IS DOUBLE FOR NEXT COL ASL F.HH ;LOC. IN TRIG TBL IS DOUBLE TOO DEC F.L BLE F.SKP1 ;GO DO NEXT COLUMN JMP F.NXTC ; " F.OFLO: .IF DF NON CMP (SP)+,(SP)+ ;CLEAR STACK .ENDC F.OFLR: MOV (SP)+,R5 ;RESTORE REGISTERS MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 CMP (SP)+,(SP)+ ;CLEAR STACK JMP F.OFL ;JUMP TO OVERFLOW ROUTINE .SBTTL FFT FIRST SPECIAL LOOP ;DONE WITH (LOG N)-2 COLUMNS ;NOW DO 2 SPECIAL LOOPS ;FIRST SPECIAL LOOP F.SKP1: MOV (PC)+,-(SP) ;K=N/4 F.N: 0 ASR (SP) MOV (SP),-(SP) ASR (SP) MOV F.REP,R2 ;R2 KEEPS TRACK OF CURRENT FOUR REAL MOV F.IMP,R3 ;R3 KEEPS TRACK OF CURRENT FOUR IMAG F.SPL1: MOV #F.ORT2-F.NXTI,F.ORTN ;SET UP OVERFLOW ROUTINE F.ORT2: MOV @R2,R0 MOV @R3,R1 MOV R0,R4 MOV R1,R5 ADD 4(R2),R0 ;REAL PART OF FIRST HALF BVS F.OFL1 ADD 4(R3),R1 ;IMAG PART OF FIRST HALF BVS F.OFL1 SUB 4(R2),R4 ;1ST POINT IN 2ND HALF OF SBGP BVS F.OFL1 SUB 4(R3),R5 BVS F.OFL1 MOV R0,(R2)+ ;STORE THE POINTS MOV R1,(R3)+ MOV R4,2(R2) MOV R5,2(R3) MOV #F.ORT4-F.NXTI,F.ORTN ;SET UP OVERFLOW ROUTINE F.ORT4: MOV (R2),R0 ;DO 2ND POINTS IN SUBGROUP MOV (R3),R1 MOV R0,R4 MOV R1,R5 ADD 4(R2),R0 BVS F.OFL1 ADD 4(R3),R1 BVS F.OFL1 SUB 4(R3),R5 ;REAL PART BVS F.OFL1 NEG R4 ADD 4(R2),R4 ;IMAGINARY PART BVS F.OFL1 TST F.INV BEQ F.SP11 ;NO, SKIP NEG R5 ;YES, NEGATE BOTTOM POINT NEG R4 ; " F.SP11: MOV R0,(R2)+ ;STORE THE POINTS MOV R1,(R3)+ CMP (R2)+,(R3)+ ;INCREMENT POINTERS MOV R5,(R2)+ MOV R4,(R3)+ DEC (SP) BGT F.SPL1 TST (SP)+ ;CLEAR STACK ;END OF FIRST SPECIAL LOOP .SBTTL FFT SECOND SPECIAL LOOP ;SECOND SPECIAL LOOP BR F.SKP3 F.OFL1: JMP F.OFL F.SKP3: MOV F.REP,R2 MOV F.IMP,R3 MOV #F.ORT3-F.NXTI,F.ORTN ;SET UP OVERFLOW RETURN F.SPL2: F.ORT3: MOV @R2,R0 MOV @R3,R1 MOV R0,R4 MOV R1,R5 ADD 2(R2),R0 BVS F.OFL1 ADD 2(R3),R1 BVS F.OFL1 SUB 2(R2),R4 BVS F.OFL1 SUB 2(R3),R5 BVS F.OFL1 MOV R0,(R2)+ MOV R1,(R3)+ MOV R4,(R2)+ MOV R5,(R3)+ DEC @SP BNE F.SPL2 TST (SP)+ ;CLEAR STACK ;END OF SECOND SPECIAL LOOP .SBTTL FFT BIT REVERSAL ;DO BIT REVERSAL MOV #1,R2 MOV F.N,R5 ;ROUTINE TO REVERSE R+2 BITS F.REVS: MOV R2,R4 ;TEMPORARY ADD R5,R4 ;SET MARKER CLR R3 ;R3 HOLDS REVERSED BITS ASR R4 F.REV1: ROL R3 ;REVERSE THE BITS ASR R4 ; " BNE F.REV1 ; " CMP R3,R2 BLE F.NSCR ASL R2 ASL R3 MOV F.REP,R0 ;SWAP REAL VALUES MOV R0,R1 ADD R2,R0 ADD R3,R1 MOV @R0,R4 MOV @R1,@R0 MOV R4,@R1 MOV F.IMP,R0 ;SWAP IMAG VALUES MOV R0,R1 ADD R2,R0 ADD R3,R1 MOV @R0,R4 MOV @R1,@R0 MOV R4,@R1 ASR R2 F.NSCR: INC R2 CMP R5,R2 BGT F.REVS ;ALL DONE - RETURN TO CALLER CLR R0 ;CLEAR ERROR FLAG F.EXIT: MOV R0,@(PC)+ ;RETURN ERROR F.EROR: 0 RTS PC .SBTTL FFT OVERFLOW SCALING ROUTINE ;OVERFLOW ROUTINE F.OFL: MOV R5,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV F.N,R5 ASR R5 ;DO 4 COMPLEX POINTS AT A TIME TO ASR R5 ;REDUCE LOOP OVERHEAD MOV F.REP,R2 MOV F.IMP,R3 F.OFLP: .REPT 4 ASR (R2)+ ASR (R3)+ .ENDR DEC R5 BNE F.OFLP MOV (SP)+,R3 MOV (SP)+,R2 INC @F.SCLF MOV PC,R5 ;SET R5 TO F.NXTI F.NXTI: ADD (PC)+,R5 ;COMPUTE RESTART ADDRESS (RTN) F.ORTN: 0 ;CONTAINS "RTN-F.NXTI" WHERE RTN ;IS THE RESTART LOCATION RTS R5 ;RESTORES R5 AND XFERS TO RTN .SBTTL FFT SOFTWARE MULTIPLY SUBROUTINE ;MULTIPLY SUBROUTINE FOR FFT .IF DF,NON $F.MUL: CLR R3 ;CLEAR PRODUCT SIGN TST R4 BPL F.MUL1 ;JUMP IF MULTIPLIER PLUS INC R3 ;NOTE MINUS NEG R4 ;MAKE PLUS F.MUL1: TST R5 BPL F.MUL2 ;JUMP IF MULTIPLICAND PLUS INC R3 ;NOTE MINUS NEG R5 ;MAKE PLUS F.MUL2: MOV R3,(PC)+ ;SAVE SIGN OF PRODUCT F.MULS: 0 CLR R3 ;CLEAR HIGH ORDER PRODUCT .IF NE,MPYCNT-1 ;NO LOOPING IF MPYCNT=1 MOV #MPYCNT,R2 ;SET LOOP COUNT F.MUL3: ROR R3 ;SHIFT PRODUCT .ENDC ROR R4 ;SHIFT MULTIPLIER BCC .+4 ;JUMP IF MULTIPLIER BIT ZERO ADD R5,R3 ;ADD IN MULTIPLICAND .REPT <20/MPYCNT>-1 ROR R3 ;SHIFT PRODUCT ROR R4 ;SHIFT MULTIPLIER BCC .+4 ;JUMP IF MULTIPLIER BIT ZERO ADD R5,R3 ;ADD IN MULTIPLICAND .ENDR .IF NE,MPYCNT-1 ;NO LOOPING IF MPYCNT=1 DEC R2 ;DECREMENT LOOP CNT BNE F.MUL3 ;JUMP IF MORE TO GO .ENDC ROR F.MULS ;GET SIGN BCC F.MUL5 ;JUMP IF ANSWER IS PLUS NEG R4 ;NEGATE LOW ORDER OF PRODUCT ADC R3 ;DO A DOUBLE PRECISION NEGATE NEG R3 F.MUL5: RTS PC .ENDC .SBTTL FFT SINE/COSINE TABLE ;SINE/COSINE TABLE F.TRIG: TBL 00000,00031,00062,00113,00145,00176,00227,00260 TBL 00311,00342,00373,00424,00456,00507,00540,00571 TBL 00622,00653,00704,00736,00767,01020,01051,01102 TBL 01133,01164,01215,01247,01300,01331,01362,01413 TBL 01444,01475,01526,01560,01611,01642,01673,01724 TBL 01755,02006,02037,02071,02122,02153,02204,02235 TBL 02266,02317,02350,02401,02433,02464,02515,02546 TBL 02577,02630,02661,02712,02743,02775,03026,03057 TBL 03110,03141,03172,03223,03254,03305,03336,03370 TBL 03421,03452,03503,03534,03565,03616,03647,03700 TBL 03731,03762,04014,04045,04076,04127,04160,04211 TBL 04242,04273,04324,04355,04406,04437,04470,04521 TBL 04553,04604,04635,04666,04717,04750,05001,05032 TBL 05063,05114,05145,05176,05227,05260,05311,05342 TBL 05373,05424,05455,05507,05540,05571,05622,05653 TBL 05704,05735,05766,06017,06050,06101,06132,06163 TBL 06214,06245,06276,06327,06360,06411,06442,06473 TBL 06524,06555,06606,06637,06670,06721,06752,07003 TBL 07034,07065,07116,07147,07200,07231,07262,07313 TBL 07344,07374,07425,07456,07507,07540,07571,07622 TBL 07653,07704,07735,07766,10017,10050,10101,10132 TBL 10163,10214,10244,10275,10326,10357,10410,10441 TBL 10472,10523,10554,10605,10636,10666,10717,10750 TBL 11001,11032,11063,11114,11145,11175,11226,11257 TBL 11310,11341,11372,11423,11453,11504,11535,11566 TBL 11617,11650,11701,11731,11762,12013,12044,12075 TBL 12125,12156,12207,12240,12271,12321,12352,12403 TBL 12434,12465,12515,12546,12577,12630,12661,12711 TBL 12742,12773,13024,13054,13105,13136,13167,13217 TBL 13250,13301,13332,13362,13413,13444,13474,13525 TBL 13556,13607,13637,13670,13721,13751,14002,14033 TBL 14063,14114,14145,14175,14226,14257,14307,14340 TBL 14371,14421,14452,14503,14533,14564,14615,14645 TBL 14676,14726,14757,15010,15040,15071,15121,15152 TBL 15203,15233,15264,15314,15345,15376,15426,15457 TBL 15507,15540,15570,15621,15651,15702,15732,15763 TBL 16014,16044,16075,16125,16156,16206,16237,16267 TBL 16320,16350,16401,16431,16461,16512,16542,16573 TBL 16623,16654,16704,16735,16765,17016,17046,17076 TBL 17127,17157,17210,17240,17270,17321,17351,17402 TBL 17432,17462,17513,17543,17573,17624,17654,17705 TBL 17735,17765,20016,20046,20076,20127,20157,20207 TBL 20237,20270,20320,20350,20401,20431,20461,20511 TBL 20542,20572,20622,20652,20703,20733,20763,21013 TBL 21044,21074,21124,21154,21204,21235,21265,21315 TBL 21345,21375,21426,21456,21506,21536,21566,21616 TBL 21647,21677,21727,21757,22007,22037,22067,22117 TBL 22147,22200,22230,22260,22310,22340,22370,22420 TBL 22450,22500,22530,22560,22610,22640,22670,22720 TBL 22750,23000,23030,23060,23110,23140,23170,23220 TBL 23250,23300,23330,23360,23410,23440,23470,23520 TBL 23550,23600,23627,23657,23707,23737,23767,24017 TBL 24047,24077,24126,24156,24206,24236,24266,24316 TBL 24345,24375,24425,24455,24505,24534,24564,24614 TBL 24644,24674,24723,24753,25003,25033,25062,25112 TBL 25142,25171,25221,25251,25301,25330,25360,25410 TBL 25437,25467,25517,25546,25576,25625,25655,25705 TBL 25734,25764,26014,26043,26073,26122,26152,26201 TBL 26231,26261,26310,26340,26367,26417,26446,26476 TBL 26525,26555,26604,26634,26663,26713,26742,26772 TBL 27021,27050,27100,27127,27157,27206,27236,27265 TBL 27314,27344,27373,27423,27452,27501,27531,27560 TBL 27607,27637,27666,27715,27745,27774,30023,30052 TBL 30102,30131,30160,30210,30237,30266,30315,30345 TBL 30374,30423,30452,30501,30531,30560,30607,30636 TBL 30665,30714,30744,30773,31022,31051,31100,31127 TBL 31156,31205,31235,31264,31313,31342,31371,31420 TBL 31447,31476,31525,31554,31603,31632,31661,31710 TBL 31737,31766,32015,32044,32073,32122,32151,32200 TBL 32227,32255,32304,32333,32362,32411,32440,32467 TBL 32516,32544,32573,32622,32651,32700,32727,32755 TBL 33004,33033,33062,33110,33137,33166,33215,33243 TBL 33272,33321,33350,33376,33425,33454,33502,33531 TBL 33560,33606,33635,33664,33712,33741,33767,34016 TBL 34045,34073,34122,34150,34177,34225,34254,34302 TBL 34331,34360,34406,34435,34463,34511,34540,34566 TBL 34615,34643,34672,34720,34747,34775,35023,35052 TBL 35100,35127,35155,35203,35232,35260,35306,35335 TBL 35363,35411,35440,35466,35514,35542,35571,35617 TBL 35645,35673,35722,35750,35776,36024,36052,36101 TBL 36127,36155,36203,36231,36257,36305,36334,36362 TBL 36410,36436,36464,36512,36540,36566,36614,36642 TBL 36670,36716,36744,36772,37020,37046,37074,37122 TBL 37150,37176,37224,37252,37300,37326,37354,37401 TBL 37427,37455,37503,37531,37557,37605,37632,37660 TBL 37706,37734,37761,40007,40035,40063,40110,40136 TBL 40164,40212,40237,40265,40313,40340,40366,40414 TBL 40441,40467,40515,40542,40570,40615,40643,40671 TBL 40716,40744,40771,41017,41044,41072,41117,41145 TBL 41172,41220,41245,41273,41320,41346,41373,41420 TBL 41446,41473,41521,41546,41573,41621,41646,41673 TBL 41721,41746,41773,42021,42046,42073,42120,42146 TBL 42173,42220,42245,42272,42320,42345,42372,42417 TBL 42444,42471,42517,42544,42571,42616,42643,42670 TBL 42715,42742,42767,43014,43041,43066,43113,43140 TBL 43165,43212,43237,43264,43311,43336,43363,43410 TBL 43435,43462,43507,43534,43560,43605,43632,43657 TBL 43704,43731,43755,44002,44027,44054,44100,44125 TBL 44152,44177,44223,44250,44275,44321,44346,44373 TBL 44417,44444,44471,44515,44542,44566,44613,44640 TBL 44664,44711,44735,44762,45006,45033,45057,45104 TBL 45130,45155,45201,45225,45252,45276,45323,45347 TBL 45373,45420,45444,45470,45515,45541,45565,45612 TBL 45636,45662,45707,45733,45757,46003,46027,46054 TBL 46100,46124,46150,46174,46221,46245,46271,46315 TBL 46341,46365,46411,46435,46461,46505,46531,46555 TBL 46601,46625,46651,46675,46721,46745,46771,47015 TBL 47041,47065,47111,47135,47161,47204,47230,47254 TBL 47300,47324,47350,47373,47417,47443,47467,47512 TBL 47536,47562,47605,47631,47655,47700,47724,47750 TBL 47773,50017,50043,50066,50112,50135,50161,50204 TBL 50230,50254,50277,50323,50346,50371,50415,50440 TBL 50464,50507,50533,50556,50601,50625,50650,50673 TBL 50717,50742,50765,51011,51034,51057,51103,51126 TBL 51151,51174,51220,51243,51266,51311,51334,51357 TBL 51403,51426,51451,51474,51517,51542,51565,51610 TBL 51633,51656,51701,51724,51747,51772,52015,52040 TBL 52063,52106,52131,52154,52177,52221,52244,52267 TBL 52312,52335,52360,52402,52425,52450,52473,52516 TBL 52540,52563,52606,52630,52653,52676,52720,52743 TBL 52766,53010,53033,53055,53100,53123,53145,53170 TBL 53212,53235,53257,53302,53324,53347,53371,53414 TBL 53436,53460,53503,53525,53547,53572,53614,53637 TBL 53661,53703,53725,53750,53772,54014,54036,54061 TBL 54103,54125,54147,54171,54214,54236,54260,54302 TBL 54324,54346,54370,54412,54434,54456,54500,54522 TBL 54544,54566,54610,54632,54654,54676,54720,54742 TBL 54764,55006,55030,55051,55073,55115,55137,55161 TBL 55202,55224,55246,55270,55311,55333,55355,55377 TBL 55420,55442,55464,55505,55527,55550,55572,55614 TBL 55635,55657,55700,55722,55743,55765,56006,56030 TBL 56051,56072,56114,56135,56157,56200,56221,56243 TBL 56264,56305,56327,56350,56371,56413,56434,56455 TBL 56476,56520,56541,56562,56603,56624,56645,56667 TBL 56710,56731,56752,56773,57014,57035,57056,57077 TBL 57120,57141,57162,57203,57224,57245,57266,57307 TBL 57327,57350,57371,57412,57433,57454,57474,57515 TBL 57536,57557,57600,57620,57641,57662,57702,57723 TBL 57744,57764,60005,60026,60046,60067,60107,60130 TBL 60150,60171,60211,60232,60252,60273,60313,60334 TBL 60354,60375,60415,60435,60456,60476,60516,60537 TBL 60557,60577,60620,60640,60660,60700,60721,60741 TBL 60761,61001,61021,61041,61062,61102,61122,61142 TBL 61162,61202,61222,61242,61262,61302,61322,61342 TBL 61362,61402,61422,61442,61462,61502,61521,61541 TBL 61561,61601,61621,61640,61660,61700,61720,61737 TBL 61757,61777,62017,62036,62056,62076,62115,62135 TBL 62154,62174,62213,62233,62253,62272,62312,62331 TBL 62351,62370,62407,62427,62446,62466,62505,62524 TBL 62544,62563,62602,62622,62641,62660,62700,62717 TBL 62736,62755,62774,63014,63033,63052,63071,63110 TBL 63127,63146,63165,63204,63223,63243,63262,63301 TBL 63320,63336,63355,63374,63413,63432,63451,63470 TBL 63507,63526,63544,63563,63602,63621,63640,63656 TBL 63675,63714,63732,63751,63770,64006,64025,64044 TBL 64062,64101,64120,64136,64155,64173,64212,64230 TBL 64247,64265,64304,64322,64340,64357,64375,64414 TBL 64432,64450,64467,64505,64523,64541,64560,64576 TBL 64614,64632,64651,64667,64705,64723,64741,64757 TBL 64775,65013,65032,65050,65066,65104,65122,65140 TBL 65156,65174,65211,65227,65245,65263,65301,65317 TBL 65335,65353,65370,65406,65424,65442,65460,65475 TBL 65513,65531,65546,65564,65602,65617,65635,65652 TBL 65670,65706,65723,65741,65756,65774,66011,66027 TBL 66044,66062,66077,66114,66132,66147,66165,66202 TBL 66217,66235,66252,66267,66304,66322,66337,66354 TBL 66371,66406,66424,66441,66456,66473,66510,66525 TBL 66542,66557,66574,66611,66626,66643,66660,66675 TBL 66712,66727,66744,66761,66776,67012,67027,67044 TBL 67061,67076,67112,67127,67144,67161,67175,67212 TBL 67227,67243,67260,67275,67311,67326,67342,67357 TBL 67373,67410,67424,67441,67455,67472,67506,67523 TBL 67537,67553,67570,67604,67620,67635,67651,67665 TBL 67702,67716,67732,67746,67762,67777,70013,70027 TBL 70043,70057,70073,70107,70123,70137,70153,70167 TBL 70203,70217,70233,70247,70263,70277,70313,70327 TBL 70343,70357,70372,70406,70422,70436,70452,70465 TBL 70501,70515,70530,70544,70560,70573,70607,70623 TBL 70636,70652,70665,70701,70714,70730,70743,70757 TBL 70772,71006,71021,71034,71050,71063,71077,71112 TBL 71125,71140,71154,71167,71202,71215,71231,71244 TBL 71257,71272,71305,71320,71334,71347,71362,71375 TBL 71410,71423,71436,71451,71464,71477,71512,71525 TBL 71537,71552,71565,71600,71613,71626,71640,71653 TBL 71666,71701,71713,71726,71741,71753,71766,72001 TBL 72013,72026,72041,72053,72066,72100,72113,72125 TBL 72140,72152,72165,72177,72211,72224,72236,72250 TBL 72263,72275,72307,72322,72334,72346,72360,72373 TBL 72405,72417,72431,72443,72455,72470,72502,72514 TBL 72526,72540,72552,72564,72576,72610,72622,72634 TBL 72646,72657,72671,72703,72715,72727,72741,72752 TBL 72764,72776,73010,73021,73033,73045,73056,73070 TBL 73102,73113,73125,73136,73150,73162,73173,73205 TBL 73216,73230,73241,73252,73264,73275,73307,73320 TBL 73331,73343,73354,73365,73376,73410,73421,73432 TBL 73443,73455,73466,73477,73510,73521,73532,73543 TBL 73554,73565,73576,73607,73620,73631,73642,73653 TBL 73664,73675,73706,73717,73730,73740,73751,73762 TBL 73773,74003,74014,74025,74036,74046,74057,74070 TBL 74100,74111,74121,74132,74143,74153,74164,74174 TBL 74205,74215,74225,74236,74246,74257,74267,74277 TBL 74310,74320,74330,74341,74351,74361,74371,74401 TBL 74412,74422,74432,74442,74452,74462,74472,74502 TBL 74512,74523,74533,74542,74552,74562,74572,74602 TBL 74612,74622,74632,74642,74652,74661,74671,74701 TBL 74711,74720,74730,74740,74747,74757,74767,74776 TBL 75006,75016,75025,75035,75044,75054,75063,75073 TBL 75102,75111,75121,75130,75140,75147,75156,75166 TBL 75175,75204,75214,75223,75232,75241,75250,75260 TBL 75267,75276,75305,75314,75323,75332,75341,75350 TBL 75357,75366,75375,75404,75413,75422,75431,75440 TBL 75447,75456,75464,75473,75502,75511,75520,75526 TBL 75535,75544,75552,75561,75570,75576,75605,75613 TBL 75622,75631,75637,75646,75654,75663,75671,75677 TBL 75706,75714,75723,75731,75737,75746,75754,75762 TBL 75771,75777,76005,76013,76021,76030,76036,76044 TBL 76052,76060,76066,76074,76102,76110,76116,76124 TBL 76132,76140,76146,76154,76162,76170,76176,76203 TBL 76211,76217,76225,76233,76240,76246,76254,76261 TBL 76267,76275,76302,76310,76316,76323,76331,76336 TBL 76344,76351,76357,76364,76372,76377,76405,76412 TBL 76417,76425,76432,76437,76445,76452,76457,76464 TBL 76472,76477,76504,76511,76516,76523,76530,76535 TBL 76543,76550,76555,76562,76567,76574,76601,76605 TBL 76612,76617,76624,76631,76636,76643,76647,76654 TBL 76661,76666,76672,76677,76704,76711,76715,76722 TBL 76726,76733,76740,76744,76751,76755,76762,76766 TBL 76773,76777,77003,77010,77014,77021,77025,77031 TBL 77036,77042,77046,77052,77057,77063,77067,77073 TBL 77077,77103,77110,77114,77120,77124,77130,77134 TBL 77140,77144,77150,77154,77160,77164,77170,77173 TBL 77177,77203,77207,77213,77216,77222,77226,77232 TBL 77235,77241,77245,77250,77254,77260,77263,77267 TBL 77272,77276,77301,77305,77310,77314,77317,77323 TBL 77326,77331,77335,77340,77343,77347,77352,77355 TBL 77360,77364,77367,77372,77375,77400,77403,77406 TBL 77412,77415,77420,77423,77426,77431,77434,77437 TBL 77442,77444,77447,77452,77455,77460,77463,77466 TBL 77470,77473,77476,77501,77503,77506,77511,77513 TBL 77516,77520,77523,77526,77530,77533,77535,77540 TBL 77542,77545,77547,77552,77554,77556,77561,77563 TBL 77565,77570,77572,77574,77576,77601,77603,77605 TBL 77607,77611,77613,77616,77620,77622,77624,77626 TBL 77630,77632,77634,77636,77640,77642,77643,77645 TBL 77647,77651,77653,77655,77656,77660,77662,77664 TBL 77665,77667,77671,77672,77674,77676,77677,77701 TBL 77702,77704,77705,77707,77710,77712,77713,77715 TBL 77716,77717,77721,77722,77723,77725,77726,77727 TBL 77731,77732,77733,77734,77735,77736,77740,77741 TBL 77742,77743,77744,77745,77746,77747,77750,77751 TBL 77752,77753,77754,77754,77755,77756,77757,77760 TBL 77761,77761,77762,77763,77764,77764,77765,77766 TBL 77766,77767,77767,77770,77770,77771,77771,77772 TBL 77772,77773,77773,77774,77774,77775,77775,77775 TBL 77776,77776,77776,77776,77777,77777,77777,77777 TBL 77777,77777,77777,77777,77777,77777,77777,77777 .WORD 77777 .END