\ FFT.ASM - Fast Fourier Transform assembly support words. \ \ KFFT V1.1 (C)Copyright 1989, Jerry Kallaus. All rights reserved. \ May be freely redistributed for non-commercial use (FREEWARE). \ These words assume that registors A0,A1,D0,D1,D2,D3 are trashable. INCLUDE? ASSEMBLER JU:ASM ALSO assembler ANEW TASK-fft.asm DECIMAL auto_scale_fft? .IF false .ELSE true .THEN ( avoid confussion with ) CONSTANT not_auto_scale_fft? ( assembler NOT ) \ -------------------- MACROS ------------------------ : BPL$+4 $ 6A02 w, ; ( Needed to preclude assembler from filling in ) ( branch address in conditionally assembled code ) : ASRM ( dreg nbits -- , gen code to shift right with asl, swap, ext ) 16 - negate # dup dup dn asl dn swap dn ext ; : ASRM.FFT ( dreg -- ) 14 ASRM ; auto_scale_fft? .IF : TRACKHI ( dreg -- , track highest bit of abs set and OR into 7dr ) dup dup dn tst bpl$+4 dn neg dn 7dr dn or ; immediate .ELSE : TRACKHI drop ; immediate .THEN ( Code bracketed by following two words will be deleted if flag is true. ) ( Note that the bracketed code may not contain branch instructions as ) ( the assembler will come back and stuff branch address into code that ) ( isn't there - inother words, into the code that overlayed deleted code. ) VARIABLE save-here : MARK.CODE ( -- ) here save-here ! ; immediate : ?DELETE.CODE ( flag -- ) IF save-here @ here - allot THEN ; immediate \ ---------------------------------------------------------- CODE 2** ( n -- 2**n ) 1 # 0dr DN MOVEQ tos DN 0dr DN ASL 0dr DN tos DN MOVE BOTH END-CODE CODE 2CELL+ ( n -- n+8 ) 8 # TOS DN ADDQ BOTH END-CODE CODE 2CELL- ( n -- n-8 ) 8 # TOS DN SUBQ BOTH END-CODE CODE 2CELLS ( n -- 8*n ) 3 # TOS DN ASL BOTH END-CODE CODE 4DUP ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 n2 n3 n4 ) DSP AN 0ar AN MOVE 0ar A@+ 1dr 2dr 3dr MOVEM TOS DN DSP -A@ MOVE 1dr 2dr 3dr DSP -A@ MOVEM BOTH END-CODE CODE Z@ ( addr -- real imag ) ORG TOS 0 AN+R+B DSP -A@ MOVE ORG TOS 4 AN+R+B TOS DN MOVE BOTH END-CODE CODE Z! ( real imag addr -- ) DSP A@+ ORG TOS 4 AN+R+B MOVE DSP A@+ ORG TOS 0 AN+R+B MOVE DSP A@+ TOS DN MOVE BOTH END-CODE CODE Z+ ( r1 i1 r2 i2 -- r1+r2 i1+i2 ) DSP A@+ 0dr 1dr 2dr MOVEM 0dr DN 2dr DN ADD 1dr DN TOS DN ADD 2dr DN DSP -A@ MOVE BOTH END-CODE CODE Z- ( r1 i1 r2 i2 -- r1-r2 i1-i2 ) DSP A@+ 0dr 1dr 2dr MOVEM 0dr DN 2dr DN SUB 1dr DN TOS DN SUB TOS DN NEG 2dr DN DSP -A@ MOVE BOTH END-CODE CODE Z* ( a b c d -- ac-bd ad+bc ) ( complex multiply, fixed point scaled 2**14 ) DSP A@+ 1dr 2dr 3dr MOVEM \ a b c d 3dr DN 0dr DN MOVE \ a 3 2 1 7 1dr DN 0dr DN MULS \ ac 2dr DN 1dr DN MULS \ bc TOS DN 2dr DN MULS \ bd 2dr DN 0dr DN SUB \ ac-bd 0dr ASRM.FFT 0dr DN DSP -A@ MOVE 3dr DN TOS DN MULS \ ad 1dr DN TOS DN ADD \ ad+bc TOS ASRM.FFT both END-CODE CODE ZNEGATE ( a b -- -a -b ) TOS DN NEG DSP A@ 0dr DN MOVE 0dr DN NEG 0dr DN DSP A@ MOVE BOTH END-CODE CODE Z/2 1 # TOS DN ASR DSP A@ 0dr DN MOVE 1 # 0dr DN ASR 0dr DN DSP A@ MOVE BOTH END-CODE CODE Z/2**N ( a b n -- a/2**n b/2**n , arith rshift a and b by n ) DSP A@+ 0dr 1dr MOVEM TOS DN 0dr DN ASR TOS DN 1dr DN ASR 0dr DN TOS DN MOVE 1dr DN DSP -A@ MOVE BOTH END-CODE CODE NSBITS ( value -- number of significant abs bits plus 1 sign bit ) TOS DN TST 9 BYTE BEQ 1 BYTE BGT TOS DN NOT 1 BYTE BGT 1 # TOS DN MOVEQ 9 BYTE BRA 1 BR: 33 # 0dr DN MOVEQ 2 BR: 1 # TOS DN ASL 2 0dr DN word DBLT 0dr DN TOS DN MOVE 9 BR: BOTH END-CODE CODE OR.ABS.ARRAY ( addr ncells -- or'd-magnitude-bits-of-array ) DSP A@+ 0ar AN MOVE ORG AN 0ar AN ADDA 0 # 0dr DN MOVEQ TOS DN 2dr DN MOVE ( 64k counter ) 2dr DN SWAP 3 BYTE BRA 1 BR: 0ar A@+ 0dr DN MOVE 2 BYTE BPL 0dr DN NOT 2 BR: 0dr DN 1dr DN OR 3 BR: 1 TOS DN WORD DBRA 1 2dr DN WORD DBRA 1dr DN TOS DN MOVE BOTH END-CODE ( Arithmetic shift array of n-cells by n-bits. ) ( Left for n-bits positive, right for n-bits neg.) CODE ASHIFT.ARRAY ( array-addr n-cells n-bits -- ) 4dr DN RP -A@ MOVE 5dr DN RP -A@ MOVE DSP A@+ 4dr DN MOVE ( n ) 8 BLE 4dr DN 1ar AN MOVE 2 # 4dr DN LSR DSP A@+ 0dr DN MOVE ORG 0dr 0 AN+R+B 0ar AN LEA ( addr ) 16 # 5dr DN MOVEQ TOS DN TST 9 BEQ 4 BGT TOS DN NEG 1 # 4dr DN SUBQ 2 BYTE BMI 1 BR: 0ar A@+ 0dr 1dr 2dr 3dr MOVEM 7dr DN 0dr DN ASR 7dr DN 1dr DN ASR 7dr DN 2dr DN ASR 7dr DN 3dr DN ASR 0dr 1dr 2dr 3dr 0ar -A@ MOVEM 5dr DN 0ar AN ADDA 1 4dr DN WORD DBRA 2 BR: 1ar AN 4dr DN MOVE 3 # 0dr DN MOVEQ 0dr DN 4dr DN AND 9 BYTE BEQ 1 # 4dr DN SUBQ 3 BR: 0ar A@ 0dr DN MOVE 7dr DN 0dr DN ASR 0dr DN 0ar A@+ MOVE 3 4dr DN WORD DBRA 9 BYTE BRA 4 BR: 1 # 4dr DN SUBQ ( start of left shift code ) 6 BYTE BMI 5 BR: 0ar A@+ 0dr 1dr 2dr 3dr MOVEM 7dr DN 0dr DN ASL 7dr DN 1dr DN ASL 7dr DN 2dr DN ASL 7dr DN 3dr DN ASL 0dr 1dr 2dr 3dr 0ar -A@ MOVEM 5dr DN 0ar AN ADDA 5 4dr DN WORD DBRA 6 BR: 1ar AN 4dr DN MOVE 3 # 0dr DN MOVEQ 0dr DN 4dr DN AND 9 BYTE BEQ 1 # 4dr DN SUBQ 7 BR: 0ar A@ 0dr DN MOVE 7dr DN 0dr DN ASL 0dr DN 0ar A@+ MOVE 7 4dr DN WORD DBRA 9 BYTE BRA 8 BR: 4 # DSP AN WORD ADDA ( pop data-addr off of stack ) 9 BR: RP A@+ 5dr DN MOVE RP A@+ 4dr DN MOVE DSP A@+ TOS DN MOVE END-CODE CODE STATS.ARRAY ( array-addr n -- max min sumlo 0 ) DSP A@+ 0ar AN MOVE ( 0 added for compatability with new ) ORG AN 0ar AN ADDA ( version with double precision sum ) TOS DN 0dr DN MOVE 0 # TOS DN MOVEQ ( init sum to 0 ) $ 80000000 # 2dr DN MOVE ( init max to -inf ) $ 3fffffff # 3dr DN MOVE ( init min to +inf ) 1 # 0dr DN SUBQ 9 BLT 1 BR: 0ar A@+ 1dr DN MOVE 1dr DN TOS DN ADD ( sum ) 1dr DN 2dr DN CMP 2 BYTE BGE 1dr DN 2dr DN MOVE ( max ) 2 BR: 1dr DN 3dr DN CMP 3 BYTE BLE 1dr DN 3dr DN MOVE ( min ) 3 BR: 1 0dr DN WORD DBRA 9 BR: 2dr DN DSP -A@ MOVE 3dr DN DSP -A@ MOVE tos DN DSP -A@ MOVE 0 # TOS DN MOVEQ END-CODE CODE QUICK.REVERSAL ( array-data reversal-map-of-swap-pairs ) 3ar AN RP -A@ MOVE ( save regs on return stack ) 5ar AN RP -A@ MOVE ORG TOS 0 AN+R+B 0ar AN LEA ( r ) DSP A@+ 1ar AN MOVE ORG AN 1ar AN ADDA ( a ) 0ar A@+ TOS DN MOVE ( i ) MARK 3 0ar A@+ 0dr DN MOVE ( next j ) 1ar TOS 0 AN+R+B 3ar AN LEA ( abs i ) 1ar 0dr 0 AN+R+B 5ar AN LEA ( abs j ) 3ar A@ 1dr DN MOVE ( swap cmplx a[i] with a[j] ) 5ar A@ 2dr DN MOVE 1dr DN 5ar A@+ MOVE 2dr DN 3ar A@+ MOVE 3ar A@ 1dr DN MOVE 5ar A@ 2dr DN MOVE 1dr DN 5ar A@ MOVE 2dr DN 3ar A@ MOVE 0ar A@+ TOS DN MOVE ( next i ) 3 BNE ( zero terminator in swap map ) DSP A@+ TOS DN MOVE ( cache TOS ) RP A@+ 5ar AN MOVE ( restore regs ) rp A@+ 3ar AN MOVE BOTH END-CODE \ inner-loop register usage \ i a n ss le le1 ui ur \ 0dr 1 2 3 4 5 6 7 0ar 1 2 3 4 5 6 7 \ i air aii ur-i ur+i ss ur le1 ai aip an ur ui \ high le CODE INNER.LOOP ( u le ss n a i le1 -- ) 4dr 5dr 6dr 2ar 3ar 5ar RP -A@ MOVEM ( save regs on return stack ) DSP A@+ 0dr 1dr 2dr 5dr 6dr 3ar 5ar MOVEM ORG 1dr 0 AN+R+B 0ar AN LEA ( a ) 0ar 2dr 0 AN+R+B 2ar AN LEA ( an ) 0dr DN 0ar AN ADDA ( ai ) 0ar 7dr 0 AN+R+B 1ar AN LEA ( aip ) 0 # 7dr DN MOVEQ ( hi - abs all output or'd in 7dr ) 5ar AN 3dr DN MOVE ( ur ) 5ar AN 4dr DN MOVE 3ar AN 3dr DN SUB ( ur-ui ) 3ar AN 4dr DN ADD ( ur+ui ) 4 # 6dr DN SUBQ 6dr DN 3ar AN MOVE ( le ) 1 BR: 1ar A@ 1dr DN MOVE ( a[ip] ) 1ar 4 An+W 2dr DN MOVE 5dr DN 1dr DN ASR ( scale down ) 5dr DN 2dr DN ASR 1dr DN 0dr DN MOVE 2dr DN 0dr DN SUB ( c-d ) 5ar AN 6dr DN MOVE ( ur ) 6dr DN 0dr DN MULS ( z ) 3dr DN 2dr DN MULS ( fd ) 0dr DN 2dr DN ADD ( fd+z ) 4dr DN 1dr DN MULS ( gc ) 0dr DN 1dr DN SUB ( gc-z ) 1dr ASRM.FFT ( scale down cmplx * result ) 2dr ASRM.FFT 0ar A@ 0dr DN MOVE ( a[i] real ) 5dr DN 0dr DN ASR ( scale down ) 0dr DN 6dr DN MOVE 2dr DN 6dr DN SUB ( a[i]-t ) 6dr DN 1ar A@+ MOVE ( a[ip] ) 6dr TRACKHI 2dr DN 0dr DN ADD ( a[i]+t ) 0dr DN 0ar A@+ MOVE ( a[i] ) 0dr TRACKHI 0ar A@ 0dr DN MOVE ( a[i] imag ) 5dr DN 0dr DN ASR ( scale down ) 0dr DN 6dr DN MOVE 1dr DN 6dr DN SUB ( a[i]-t ) 6dr DN 1ar A@ MOVE ( a[ip] ) 6dr TRACKHI 1dr DN 0dr DN ADD ( a[i]+t ) 0dr DN 0ar A@ MOVE ( a[i] ) 0dr TRACKHI 3ar AN 1ar AN ADDA 3ar AN 0ar AN ADDA 2ar AN 0ar AN CMP 1 BLT RP A@+ 4dr 5dr 6dr 2ar 3ar 5ar MOVEM END-CODE PREVIOUS