* * Acoustic Ranging program containing M-sequence based output waveform * generator and a cross correlator based on a Fast Fourier Transform * for a Hewlett Packard HP 21MX minicomputer * - written by phillip <p.musumeci@ieee.org> (masters degree) * * - This program provided a basic acoustic sonar system with digitally * generated transmit sequences, cross correlation facilities to detect * significant return signals (and associated distance to reflectors * causing maximum peak echos) implemented via FFT/iFFT calls, and * direct control of the receiver gain; * * - The target machine was an HP 21MX minicomputer with (by memory) the * optional floating point */+- maths instructions present but no * scientific functions like trig (so the code includes some trig * support). An interesting aspect of the instruction set was that * subroutine return addresses were stored in the memory location at the * start of the subroutine so that an indirect jump via this (known) * memory location made possible a return to just after the call at any * (unknown) location i.e. subroutines without the use of a stack, and * note the NOP instruction at the start of subroutines which is over- * written with the return address; * * - The IO involved TTL logic and a high speed 8bit ADC that was controlled * via a MC6840 pulse/timer chip and MC6821 parallel IO chip hanging off * an 8bit buss, and a DAC and storage CRO was used to provide graphical * output; * * - It gets interesting near string "Signal processing section" e.g. FFT in * assembly with sine tables (an implementation of a sine function using * half/quarter/8th/16th/… approximation), a square root function, etc. * ASMB,A,B,L,T ORG 100B * Program ESS26.MXA * 6840 Timer capability * DMA capability * FFT capability * Port 10 : bit15 activates the 7475's on the D/A board * bit14 activates the 7475 on the RX2 board * bit 13 triggers the CRO when plotting correlograms * bit12 is the RX2 receive enable (arbitrary) * Check the end of the XF routine to choose between * execution speed and typed output. CNST1 EQU 256 B1,S1&Z1 length = 512 8bit numbers CNST2 EQU 2048 CARA? length = 512 complex numbers JSB INITL Determine 8bit mem addresses and other constants JMP OPS NB DEC 512 Number of points in the complex array N DEC 9 = log to base 2 of (NB) * The length of buffers B1 and S1 is found with %% symbols OPS JSB PAPWS Reset the TTY width counter JSB START Print '*' and spaces JSB COMIN Get the next command string LDB INPS2 Load start add of input buf for LBT instruction JSB GET2 Extract first 2 ascii chars from the input buf * Command identification section CPA TY TYpe ? JMP TYX CPA PU PUnch ? (PTP) JMP PUX CPA RE REad ? (PTP) JMP REX CPA RG JMP RGX Adjust the RX (2a) gain CPA TW Set TTY Width ? JMP TTYW CPA EF JMP EFX Flip the echo inhibit bit in TESTB CPA CL Clear all arrays ? JMP CLEAR CPA TM JMP TMXI,I Enter the MC6840 service routine CPA SP JSB SPX Perform signal processing CPA XC JMP XCXI,I Enter the cross correlation test routine CPA XF JMP XFXI,I Enter the fast XC routine CPA XE JMP XEXI,I Prepare the TX side of the fast XC CPA TX JMP TXX Test transmit routine using D/A CPA RP JMP RPX Perform test read of port10 CPA FT JMP FTXI,I FFT test routine CPA SPAC2 JMP OPS No command was entered , return to top SZA,RSS JMP OPS A sub was called since A = 0 *** End of command word comparisons OPS1 LDB ER1S Load start add of err message JSB ASCT Output the error message JSB CRLF JMP OPS Return to start of inputing sequence * Command character table FT ASC 1,FT XC ASC 1,XC XF ASC 1,XF XE ASC 1,XE TX ASC 1,TX RP ASC 1,RP SP ASC 1,SP TY ASC 1,TY PU ASC 1,PU RE ASC 1,RE CL ASC 1,CL TW ASC 1,TW RG ASC 1,RG EF ASC 1,EF TM ASC 1,TM SPAC2 ASC 1, ER1S DEF ER1 * START NOP LDA DOT JSB AOUT LDA SPACE JSB AOUT JMP START,I * EFX TBS NECHO TESTB This routine flips the echo control bit in TESTB JMP EFX1 SBS NECHO TESTB JMP OPS EFX1 CBS NECHO TESTB JMP OPS NECHO OCT 2 TTYW INB This section sets the TTY width JSB ASCBN STA PAPW JMP OPS Return for next command * * PAPWS NOP Reset the TTY width counter LDA PAPW CMA,INA STA WIDTH Set maximum width reg for TTY JMP PAPWS,I PAPW DEC 50 * * This routine adjusts the RX gain RGX INB BIT14 activates the 7475 on the RX2 board JSB GET2 STA ARGX LDA CD1 STA DARGX INB JSB ASCBN SZA STA DARGX CLB LDA ARGX CPA UP LDB M1 Shall increase gain CPA DN LDB CD1 Shall decrease gain SZB,RSS JMP RGX2 Shall type out the gain only LDA 01 MPY DARGX Determine the new gain-value-select increment SSB,RSS JMP RGX1 SBS SIGN 00 RGX1 ADA RXPT LDB 00 SSA CLB Set RXPT up to 0 ADA M8 SSA,RSS LDB CD8 Set RXPT down to 8 STB RXPT Reset the gain value CBX Store for indexed addressing LAX RXDAT Get gain value AND RMASK Remove type-out bits , obtain 4 data bits IOR BIT14 Set the gain-load bit high JSB OUT10 AND BITS8 JSB OUT10 Deactivate the gain-load line RGX2 LDX RXPT LAX RXDAT Load the gain LDB RMASK CMB Obtain mask for typing out the gain AND 01 STA ARGX Store the gain TBS NECHO TESTB JMP RGX3 LDB RGMS JSB ASCT 'RX GAIN = ' RGX3 LDA ARGX JSB INT16 Type out the gain value JMP OPS ARGX BSS 1 Stores A, the new gain value DARGX BSS 1 Stores the gain adjust [1-8] UP ASC 1,UP DN ASC 1,DN RGMS DEF RGM RMASK OCT 170000 RXPT OCT 4 Pointer to the RXDAT array (0<=RXPT>=8) * ************************************************** * * Global pointers and constants * SIGN OCT 100000 Mask used to set a sign bit TESTB BSS 1 General purpose test word * Bit 1 used in subroutine BAI * Bit 2 used in routine EFX * Bit 3 used to speed up XC routine WIDTH BSS 1 EXT OCT 60 MINUS ASC 1,!- #### Extra character present ,cannot use compare tests ## BELL OCT 7 STAR ASC 1,?* #### DOT ASC 1,,. #### PNTR DEF BNASC R1TS DEF ERNAM RWXS DEF RWXM XCXI DEF XCORT XFXI DEF XFX XEXI DEF XEX TMXI DEF TMX FFTI DEF FFT IFFTI DEF INFFT FTXI DEF FTX SORTI DEF SORT PWRI DEF POWER SQRTI DEF SQRT Useful for indirect addressing of SQRT CRT OCT 15 <CR> DELET OCT 177 DELETE SPACE OCT 40 DCRA1 DEF CARA1 Start address of complex array 1 DCRA2 DEF CARA2 Start address of complex array 2 DCRA3 DEF CARA3 Start address of complex array 3 CD0 OCT 0 OCTal for a 0 CD1 OCT 1 CD2 OCT 2 CD3 OCT 3 CD4 OCT 4 CD5 OCT 5 CD6 OCT 6 CD8 DEC 8 CD9 DEC 9 CD10 DEC 10 CD15 DEC 15 CD16 DEC 16 CD20 DEC 20 CD30 DEC 30 CD32 DEC 32 CD55 DEC 55 CD64 DEC 64 CD60 DEC 60 CD128 DEC 128 CD250 DEC 250 CD255 DEC 255 CD256 DEC 256 CD512 DEC 512 CD1E4 DEC 1000 BITS7 OCT 177 Mask for 7 bits BITS8 OCT 377 Mask to get 8bits BIT3 OCT 4 Speed up XC routine mask BIT13 OCT 020000 BIT14 OCT 040000 BIT15 OCT 100000 Mask to get the 15th bit D1024 DEC 1024 D1023 DEC 1023 M1 OCT -1 M2 OCT -2 M4 DEC -4 M8 DEC -8 M12 DEC -12 M60 OCT -60 M256 DEC -256 M1024 DEC -1024 C1 BSS 1 C2 BSS 1 ************************************************** COMIN NOP This subroutine inputs ascii into INP CM0 LDA SPACE Load a ' ' LDB INPS2 Load buffer INP start add CM1 SBT Store ' 's in the buffer INP CPB INPF2 JMP CM2 JMP CM1 CM2 CLE E reg is used to indicate if DELETe is used CLA LDB INPS2 Load first address for the SBT command CM3 JSB AIN Input 1 ascii char into the A reg CPA CONTU JMP CUX CPA CONTC JMP CCX OTB 01B CPA DELET Is it a DELETe? JMP RUBT Yes , go to RUBT SEZ,RSS If E is 1 , type a '\' and clear E JMP CM5 JSB BSLSH CLE CM5 JSB AOUT Output the A reg CPA CRT Is it a <CR> JMP CM4 Yes , end of inputing into the input buffer CPA ALT Similar to above JMP COMIN,I CPA CONTI JMP COMIN,I Ascii is inputed without a CR SBT No , store A according to B CPB INPF2 Is the input buffer full ? RSS Yes , stop inputing JMP CM3 No , return to start of inputing sequence CM4 JSB LFEED JMP COMIN,I CUX LDA UP6 JSB AOUT LDA UU JSB AOUT JSB CRLF JMP CM0 CCX LDA UP6 JSB AOUT LDA CC JSB AOUT JSB CRLF JMP OPS CONTC OCT 3 CC ASC 1,C CONTU OCT 25 CONTI OCT 11 ALT OCT 175 UU ASC 1,U UP6 ASC 1,^ * RUBT SEZ If E = 1 , jump to RUBT1 JMP RUBT1 CCE Set E to 1 , start of a deletion sequence JSB BSLSH Output a '\' RUBT1 CPB INPS2 This prevents mem addressing at less than INP2 JMP CM3 ADB M1 Decrement the memory address register (E remains set) LBT Load A reg according to B ADB M1 Decrement the mem add since LBT incremented it OTB 01B JSB AOUT Output A JMP CM3 Return for next char input * *********** * * This routine clears most regs CLEAR JSB INITL Reset various counters and registers CLB LDX B1L Load length of array LDA B1S Load start add JSB CARAY Clear it LDX S1L LDA S1S JSB CARAY LDX Z1L LDA Z1S JSB CARAY LDA NB CLE ELA ELA CAX LDB 00 Put the length of the complex arrays in X & B LDA DCRA1 JSB CARAY LDX 01 LDA DCRA2 JSB CARAY LDX 01 LDA DCRA3 JSB CARAY JSB CLEAN OTA 01B JMP OPS CARAY NOP Array clearer STA PTCRY Load pointer reg CLA CRY1 STA PTCRY,I Store a 0 ISZ PTCRY Increment the pointer DSX Finished ? JMP CRY1 No , continue JMP CARAY,I Yes , return PTCRY BSS 1 * CLEAN NOP CLA CLB CLO CLE CAX CAY JMP CLEAN,I * *********** * GET2 NOP This subroutine loads A with 2 8bit words according to B LBT ALF Move A left 8 places ALF STA AGET2 Store A LBT Load the next 8bit word IOR AGET2 Combine both 8bit words JMP GET2,I AGET2 BSS 1 * *********** * INITL NOP This subroutine determines 8bit addresses from 16bit address LDX CD8 This is the number of constants that have to be doubled LDB INITA INIT1 LDA 1,I Load the 16bit address INB Increment the Pointer CLE ELA Get the 8bit address STA 1,I Store it INB Increment the pointer DSX JMP INIT1 *** Extra constants are computed here JSB VOUTZ Set output TX V = 0 JSB CLEAN JMP INITL,I INITA DEF INPF VOUTZ NOP This routine sets Vout = 0 LDA CD128 IOR BIT15 JSB OUT10 AND BITS8 JSB OUT10 JMP VOUTZ,I * This table consists of 16bit addresses * followed by the location for the 8bit address INPF DEF INP+49 INPF2 BSS 1 INPS DEF INP INPS2 BSS 1 Z1S DEF Z1 Z1S2 BSS 1 Z1L DEC 256 %%LENGTH%% 16bit words Z1L2 BSS 1 S1S DEF S1 S1S2 BSS 1 B1S DEF B1 B1S2 BSS 1 B1L DEC 256 %%LENGTH%% 16bit words B1L2 BSS 1 S1L DEC 256 %%LENGTH%% 16bit words S1L2 BSS 1 * *********** * ASCT NOP This subroutine outputs ascii buffers CLE ELB Convert to an 8bit add ASCT1 LBT Load an 8bit character CPA EOT JMP ASCT,I JSB AOUT Type it JMP ASCT1 Continue to loop until EOT is encountered EOT OCT 4 End of tx character * *********** * TYX NOP TY command interpretation section TYX0 LBT Load an 8bit word CPA SPACE Is it a SPACE ? JMP TYX1 Yes , go to TYX1 and get buffer name JMP TYX0 No , keep looking TYX1 JSB GET2 Get the next 2 ascii characters CPA ASCB1 Does the name equal 'B1' JMP B1TYP Yes , output it CPA ASCS1 Is the name 'S1' JMP S1TYP Yes , output it CPA ASCZ1 Is the name 'Z1' JMP Z1TYP *** Entry point for other buffer io tests JSB NAMER No , output an error message JMP OPS Return for the next command string Z1TYP LDB Z1S2 LDA Z1L2 JMP TY1 Go and type it S1TYP LDB S1S2 LDA S1L2 JMP TY1 B1TYP LDB B1S2 Load the start add LDA B1L2 Load the buffer length TY1 CMA,INA Set up an up counter STA TYPU LDA CD60 Reset the TTY width control reg STA PAPW JSB PAPWS TY2 LBT Load an 8bit word JSB INT8 Output the 8bit number ISZ TYPU Finished ? JMP TY2 No , continue JMP OPS Yes , return for the next command string ASCZ1 ASC 1,Z1 ASCB1 ASC 1,B1 ASCS1 ASC 1,S1 TYPU BSS 1 Up counetr * *********** * PUX NOP PU command interpretation section LBT Load an 8bit word CPA SPACE Is it a 'SPACE' JMP PUX1 Yes , go to PUX1 and get buffer name JMP PUX Keep searching PUX1 JSB GET2 Get the next 2 ascii characters CPA ASCB1 Is the name 'B1' JMP B1PUN Yes , punch it CPA ASCS1 Is the name 'S1' JMP S1PUN Yes , output it CPA ASCZ1 Is the name 'Z1' JMP Z1PUN Go and punch it *** Entry point for other buffer name tests JSB NAMER Output an error message JMP OPS Z1PUN LDB Z1S2 LDA Z1L2 JMP PUX3 S1PUN LDB S1S2 Load the 8bit start add LDA S1L2 Load the 8bit length JMP PUX3 B1PUN LDB B1S2 Load the 8bit start add LDA B1L2 Load the 8bit length PUX3 JSB PUNCH JMP OPS * PUNCH NOP File punched in IMAGE CMA,INA STA TYPU JSB HEDER Punch a tape header LDA PSTRT JSB APUN Punch start character PUN2 LBT Load an 8bit number JSB APUN Punch A ALF ALF IOR 1 OTA 01B Display flashes data punched out and the add ISZ TYPU Finished ? JMP PUN2 No , continue punching JSB ENDER Punch end of file CLA OTA 01B JMP PUNCH,I PFIN BSS 1 PSTRT OCT 125 Punch start character * APUN NOP *++ JSB CTTY Put the port in a Write mode (not used with REMEX)++ OTA 13B Punch it ++13++ STC 13B,C ++13++ SFS 13B ++13++ JMP *-1 JMP APUN,I * HEDER NOP Punch a header on ptp STX XHEDR STA AHEDR LDY CD4 HED0 LDX CD10 CLA OTA 01B JSB PNSOM LDX CD10 CMA OTA 01B JSB PNSOM DSY JMP HED0 LDX CD32 CLA OTA 01B JSB PNSOM LDA AHEDR LDX XHEDR JMP HEDER,I AHEDR BSS 1 XHEDR BSS 1 * ENDER NOP LDX CD20 CLA JSB PNSOM LDA PTEND LDX CD5 JSB PNSOM LDX CD60 Now push the PT out CLA JSB PNSOM LDA BELL JSB AOUT CLA OTA 01B JMP ENDER,I PTEND OCT 232 * PNSOM NOP (assumes X = num of its , punches A ) PNSO1 JSB APUN DSX JMP PNSO1 JMP PNSOM,I * *********** * REX NOP RE command interpretation section LBT Load an 8bit word CPA SPACE is it a space ? JMP REX1 Yes , go to REX1 and get buffer add JMP REX Keep searching REX1 JSB GET2 Get the next 2 ascii characters CPA ASCB1 Is the name 'B1' ? JMP B1RED Yes , go and read it CPA ASCS1 Is the name 'S1' ? JMP S1RED Yes , go and read it CPA ASCZ1 Is the name 'Z1' JMP Z1RED Go and read it *** Entry point for other buffer io tests JSB NAMER Output an error message JMP OPS Z1RED LDB Z1L LDA Z1L2 STA INPTL JMP REX2 S1RED LDA S1L CLE ELA Reset S1L2 to the maximum value STA S1L2 Reset to actual value if data read in (later) STA INPTL Store the buffer size (mem over write check) INB Determine start add of ASCII number JSB ASCBN CPA CD0 LDA INPTL Number = 0 ; Read whole buffer STA TOTIN Store number of reads (TOTIN # 0) LDB S1S Get S1's add JMP REX2 B1RED LDB B1S Get B1's add LDA B1L2 STA INPTL Store the buffer size (mem over write check) REX2 CLE ELB Convert a 16bit add to an 8bit add CLA STA NS1 Clear Numbers Read counter JSB PTRGO Go to start of data ,ignore 1st number ISZ INPTL Increment to the SBT fin add REX4 LDA TOTIN Have all numbers been read in ? CMA,INA ADA NS1 CPA CD0 JMP REX12 Yes , reading is finished JSB APTIN Read in the next number SBT Store it LDA NS1 INA OTA 01B Display counts data read in CPA INPTL Is the buffer full ? JMP REX16 Yes , go an, go and type error message STA NS1 No , increment NR counter JMP REX4 REX16 LDB RM16S JSB ASCT 'Buffer limit reached , values read in : ' JMP REX20 REX12 LDB RM12S JSB ASCT 'Read successful , values read in : ' REX20 LDA NS1 STA S1L2 Store the actual number of values read in JSB INT16 Output the number of data values read in JSB CRLF JMP OPS RM12S DEF RM16+1 RM16S DEF RM16 NS1 BSS 1 Number of values READ into S1 INPTL BSS 1 The max allowable to be read in TOTIN BSS 1 The number of reads desired * APTIN NOP *++ LDA TMIN Put the port in a read mode (not used for REMEX)++ *++ OTA 12B STC 14B,C ++14++ SFS 14B ++14++ JMP *-1 LIA 14B Load in a number ++14++ JMP APTIN,I * PTRGO NOP PT1 JSB APTIN non0=TX start (PUNCHED TAPE/IMAGE) CPA CD0 (WRITTEN FORTRAN MODE='IMAGE') JMP PT1 JMP PTRGO,I The first non0 number is ignored * *********** * OUT10 NOP Output routine for port 10 OTA 10B STC 10B,C JMP OUT10,I * *********** * IN10 NOP Input routine for port10 STC 10B,C SFS 10B JMP *-1 LIA 10B JMP IN10,I * *********** * NAMER NOP This subroutine outputs an error LDB R1TS message for unrecognised buffer names JSB ASCT Output the error message JSB CRLF JMP NAMER,I * *********** * AIN NOP This subroutine inputs 1 ascii character LDA TMIN OTA 12B Put the port in a read mode STC 12B,C SFS 12B JMP *-1 LIA 12B Load in an ascii character AND BITS7 Keep 1 ascii character only (Right justified) ISZ WIDTH Increment the width counter JMP AIN,I JSB CRLF JMP AIN,I TMIN OCT 140000 * *********** * AOUT NOP Output subroutine for 1 character JSB CTTY Set tty to tty mode AND BITS7 JSB ATYPE Output it ISZ WIDTH JMP AOUT,I Width limit not reached yet , return JSB CRLF Width limit reached , CRLF JMP AOUT,I Return * CTTY NOP This subroutine puts the port in write mode STA ACTTY Store A LDA TMOUT Load control word out OTA 12B Output it LDA ACTTY Restore A JMP CTTY,I Return ACTTY BSS 1 TMOUT OCT 120000 * ATYPE NOP OTA 12B STC 12B,C SFS 12B JMP *-1 JMP ATYPE,I * CRLF NOP This subroutine outputs a <CR> and a <LF> STA ACRLF Store A JSB CTTY LDA CRT Load a <CR> and output it JSB ATYPE CRLF1 JSB CTTY LDA LF Load a <LF> and output it JSB ATYPE JSB PAPWS Reset the TTY paper width up counter LDA ACRLF Restore A JMP CRLF,I ACRLF BSS 1 LF OCT 12 LFEED NOP This subroutine outputs a <LF> STA ACRLF LDA LFEED Load the return add STA CRLF Store the return add JMP CRLF1 Enter the sub above * BSLSH NOP This subroutine outputs a '\' STA ABSLH LDA BSSH JSB AOUT LDA ABSLH JMP BSLSH,I ABSLH BSS 1 BSSH ASC 1,\ * * Ascii number in base TEN to binary * number conversion routine (integers only) * ASCBN NOP No counter limit is made on the number of ascii CLA characters per number . >5 will cause overflow . STA AACB1 Clear AACB1 ASBN1 LBT Load an ascii character CPA SPACE Finished ? JMP ASBN2 Yes , go to finish of subroutine ADA M60 no , subtract the offset to give a binary number STA AACB2 Start multiplication process LDA AACB1 STB BACB1 MPY CD10 Multiply by DEC 10 ADA AACB2 STA AACB1 LDB BACB1 JMP ASBN1 Go and get next ascii character ASBN2 LDA AACB1 Recall number CLO JMP ASCBN,I BACB1 BSS 1 AACB1 BSS 1 AACB2 BSS 1 * *** 8bit integer type routine (num = A reg) * INT8 NOP DST ABINT JSB BAI Turn A reg into ASCII LDB CD3 Type the 4 RHJ chars JSB IOEXT JMP INT8,I * *** 16bit integer type routine (num = A reg) * INT16 NOP DST ABINT JSB BAI Turn A reg into ASCII CLB,INB Type the 8 RHJ chars JSB IOEXT JMP INT16,I * *** Subroutine useful for INT8 and INT16 * IOEXT NOP ADB PNTR Set up the ASCT start address JSB ASCT Output the ASCII DLD ABINT JMP IOEXT,I ABINT BSS 2 * *** Integer binary (A) to ASCII routine * BAI NOP Assumes the sign bit is bit15 STY YBAI Store Y,B STB BBAI LDB PNTR ADB CD5 Check symbol [0]a CLE ELB INB Determine the end add (RHJ) for the ASCII buffer STA ABAI Store the number LDA EOT SBT Store an EOT for subroutine ASCT ADB M2 Decrement B by 1 (overall) LDA ABAI Restore the number in A STB PNTR2 CLE ELA E = 1 if A < 0 RAR Return A to a + number CBS CD1 TESTB Clear bit0 of TESTB SEZ,RSS JMP BAI0 A > 0 therefore go to BAI0 CLE Restore E IOR BIT15 Restore bit15 of A CMA,INA Make A +ve SBS CD1 TESTB Set bit 0 of TESTB if A < 0 BAI0 LDY CD10 BAI1 CLB Number is only in the B reg DIV CD10 Start the DIV by DEC 10 process ADB EXT Convert B into ASCII STA ABAI Store A LDA 1 Copy B into A LDB PNTR2 Load the add for SBT SBT LDA ABAI Restore A ADB M2 Decrement PNTR2 by 2 STB PNTR2 Store next ASCII add SZA,RSS If A = 0 , go to BAI2 JMP BAI2 Fill up the rest of the ASCII buffer DSY Finished ? JMP BAI1 No , continue JMP BAI4 Yes , go to end BAI2 LDA SPACE TBS CD1 TESTB LDA MINUS Load a '-' if original A < 0 SBT CBS CD1 TESTB Clear the -ve sign bit ADB M2 Decrement the ASCII buffer pointer by 2 DSY Finished ? JMP BAI2 BAI4 LDY YBAI Restore Y,B LDB BBAI JMP BAI,I PNTR2 BSS 1 YBAI BSS 1 ABAI BSS 1 BBAI BSS 1 * *********** * SPX NOP Signal processing section LDB S1S [B1] = FFT( [S1] ) or [B1] = INFFT( FFT( [S1] ) ) CLE ELB STB C1 C1 points to buffer S1 (8 bit wide buffer) LDA DCRA1 STA C2 C2 points to buffer CARA1 (4 * 16 bits / number) LDX NB Load the number of pointers in the FFT SPX1 LBT Load S1 byte and increment pointer [B] STB C1 Store pointer CLB FLT DST C2,I Store FLOAT(S1) for the real component ISZ C2 ISZ C2 CLA Store a 0.0 for the imaginary component CLB DST C2,I ISZ C2 ISZ C2 LDB C1 Load S1 pointer DSX JMP SPX1 LDA DCRA1 Set up the FFT input parameters LDB NB JSB FFTI,I Calculate the Fourier Transform LDA DCRA1 Set up input data for optional ++ LDB NB inverse FFT processing ++ SPXX NOP Position for the JSB INFFT statement ++ *[1] LDA DCRA1 Let Imag(CARA1) = ABS( [CARA1] ) *[1] STA C2 *[1] LDX NB *[1]SPX2 DLD C2,I *[1] FMP 0 *[1] DST SPXA *[1] ISZ C2 *[1] ISZ C2 *[1] DLD C2,I *[1] FMP 0 *[1] FAD SPXA *[1] JSB SQRTI,I *[1] DST C2,I Store the magnitude in the Imaginary location *[1] ISZ C2 *[1] ISZ C2 *[1] DSX *[1] JMP SPX2 *[1] LDA DCRA1 Find the maximum of CARA1@C2,I and store C2 in C1 *[1] ADA CD2 The magnitude is stored in the imaginary locations *[1] STA C2 C2 points to the array *[1] STA C1 C1 points to the maximum *[1] LDX NB *[1]SPX3 DLD C2,I [AB]=number *[1] FSB C1,I [AB]=number-big *[1] SSA *[1] JMP SPX4 Answer is > 0 ; do not update maximum pointer *[1] LDA C2 *[1] STA C1 Update pointer(max) *[1]SPX4 LDA C2 *[1] ADA CD4 *[1] STA C2 Increment C2 pointer by 4 *[1] DSX *[1] JMP SPX3 Continue looping *[1]* *[1] LDA CD250 Prepare multiplication scaling facter *[1] CLB *[1] FLT *[1] FDV C1,I *[1] DST SPXA Store the scaling facter *[1] LDA B1S Store the FFT (Magnitude) in buffer B1 *[1] CLE *[1] ELA *[1] STA C1 C1 now points to the 8bit B1 array *[1] LDA DCRA1 *[1] ADA CD2 *[1] STA C2 C2 points to Imag(CARA1) [in fact , Mag(CARA1)] *[1] LDX NB *[1]SPX5 DLD C2,I *[1] FMP SPXA *[1] FIX *[1] LDB C1 *[1] SBT Store it *[1] STB C1 Store the auto-incremented pointer *[1] LDB C2 Increment the CARA1 pointer by 4 *[1] ADB CD4 *[1] STB C2 *[1] DSX *[1] JMP SPX5 * Shortened code LDA DCRA1 LDB DCRA1 LDX NB JSB PWRI,I [CARA1] = ABS( [CARA1] ) LDA DCRA1 LDX NB JSB SORTI,I Obtain the maximum value LDA DCRA1 LDB B1S LDX NB LDY CD250 JSB RIFIX Scale it and IFIX it * End of S C CLA JMP SPX,I Return *[1]SPXA BSS 2 * * This routine IFIXs a real array into an 8bit scaled array * A = Floating point array address * B = 8bit array's 16bit address * X = number of samples * Y = maximum 8bit value * (Assumes that the floating point max is SMAX) RIFIX NOP STA P1 CLE ELB STB P2 CYA CLB FLT FDV SMAX DST P3 Store the scaling factor for typing RFX1 DLD P1,I Load a real value ISZ P1 Increment the pointer ISZ P1 FMP P3 Scale it FIX LDB P2 SBT Store the 8bit scaled value and increment the pointer STB P2 DSX JMP RFX1 JMP RIFIX,I P1 BSS 1 Pointer P2 BSS 1 Pointer P3 BSS 2 Temporary floating number storage * * This routine floats an 8bit integer array *into a complex floating point array. * B = address of the 8bit array * A = address of the complex array * X = the number of values ICFLT NOP STA CFT1 CLE ELB Get the 8bit address CFLT1 LBT STB CFT2 Store the 8bit address CLB FLT DST CFT1,I Store the real part ISZ CFT1 ISZ CFT1 CLA CLB DST CFT1,I Store the zero imaginary part ISZ CFT1 ISZ CFT1 LDB CFT2 Restore the 8bit address in B DSX JMP CFLT1 JMP ICFLT,I CFT1 BSS 1 CFT2 BSS 1 * TXX LDX CD4 D/A TX test routine TXX0 LDB S1S CLE ELB LDY CD512 TXX1 LBT IOR BIT15 JSB OUT10 DSY JMP TXX1 DSX JMP TXX0 JSB VOUTZ Reset Vout = 0 JMP OPS Return to the op sys * RPX LDX CD512 A/D read test routine LDB Z1S CLE ELB RPX1 JSB IN10 SBT OTA 01B DSX JMP RPX1 JMP OPS * *********** * ORG 2000B * TMX NOP This routine accesses the MC6840 PTM registers INB TMX1 LBT B points to an ascii command array CPA SASCI A='S' ? JMP TMX15 Go and read the status register CPA HASCI A='H' ? JMP TMX62 Put into preset/hold mode CPA GASCI A='G' ? JMP TMX64 Put into operate mode CPA CASCI A='C' ? JMP TMX18 Command format OK CPA LASCI A='L' ? RSS Command format OK JMP TMX9 No recognisable command present TMX18 STA TMCL Store C or L LBT Load registor ID AND CD3 CPA CD0 LDA CD2 If ID=0 , set it = 2 STA TMRID Store the register ID number 1,2,or 3 LBT CPA ASCDD A proper command contains a ':' here RSS JMP TMX3 Read and output the specified register LBT CPA SPACE JMP TMX3 Read and output the specified register CPA UP6 JMP TMX3 Read and output the specified register JSB ASCHX Convert ascii 8bits number to 4bit binary ALF STA TMXM8 Store the MS4bits temporarily LBT JSB ASCHX IOR TMXM8 STA TMXM8 Store the MS8bits LDA TMCL CPA CASCI JMP TMX5 2*4bits required for a control register LBT Now get the next 2*4bits JSB ASCHX ALF STA TMXL8 Temporarily store the next MS4bits LBT JSB ASCHX IOR TMXL8 STA TMXL8 Store the LS8bits LDA TMXM8 IOR RS1 Set the MSB address lines IOR TMWR Set the write enable line JSB OUT11 Output it LDA TMRID ALF,ALF RAL,RAL Obtain RS2 and RS1 IOR RS0 Set the RS0 line IOR TMWR IOR TMXL8 Set the data lines JSB OUT11 JSB SLASH TMX6 LDA TMRID ALF,ALF RAL,RAL JSB OUT11 JSB IN11 Input the MSB of the specified register STA TMXM8 LDA RS2 Load the LSB read address lines JSB OUT11 JSB IN11 Input the LSB of the specified register STA TMXL8 TMX7 LDA TMXM8 Type out 4*4bit numbers JSB RAR4 JSB HXASC JSB AOUT LDA TMXM8 JSB HXASC JSB AOUT LDA TMXL8 TMX75 JSB RAR4 JSB HXASC JSB AOUT LDA TMXL8 JSB HXASC JSB AOUT TMX9 CLA JSB OUT11 Put the MC6840 control lines low LDA SHARP JSB AOUT JSB COMIN Enter new command string LDB INPS2 JMP TMX1 Return to top of routine SHARP ASC 1,# * TMX5 LDA TMRID Load CR pointer (1-3) CPA CD2 JMP TMX55 Shall only write CR2 RAR We now have CR2b0 JSB C1OR3 TMX55 LDA TMRID ADA M1 CAX LDA TMXM8 Get the new data bits SAX CR1 Store them LDB TMRID CPB CD2 IOR RS0 Set RS0 if accessing CR2 IOR TMWR JSB OUT11 JSB SLASH JMP TMX35 Go and type out CR? * C1OR3 NOP This subroutine sets CR20=bit0 of A AND CD1 A0=1;access CR3 CPA CD1 A0=0,access CR1 JMP C1R31 Clear the 0-bit in CR2 SBS CD1 CR2 Set the 0-bit in CR2 C1R32 LDA CR2 Output the modified CR2 IOR TMWR IOR RS0 JSB OUT11 Set CR2 so that either CR1 or CR3 is accessed JMP C1OR3,I C1R31 CBS CD1 CR2 Clear CR20 to access CR3 JMP C1R32 * TMX3 LDA TMCL CPA LASCI JMP TMX6 Go and output an L register TMX35 LDA TMRID Load relative+1 address ADA M1 CAX LAX CR1 AND BITS8 STA TMXL8 JMP TMX75 * TMX15 LDA RS0 This routine updates TSTAT and types it JSB OUT11 JSB IN11 STA TSTAT STA TMXL8 JMP TMX75 * TMX62 CLA JSB C1OR3 Access CR1 SBS CD1 CR1 Preset MC6840 and hold TMX63 LDA CR1 IOR TMWR JSB OUT11 JMP TMX9 TMX64 CLA JSB C1OR3 Access CR1 CBS CD1 CR1 Operate MC6840 JMP TMX63 * SLASH NOP STA ASLAS LDA SLSH JSB AOUT LDA ASLAS NOP JMP SLASH,I ASLAS BSS 1 SLSH ASC 1,/ * RAR4 NOP This routine is the opposite of ALF RAR RAR RAR RAR JMP RAR4,I ASCHX NOP This routine converts ASCII 0-F into 4bit binary AND BITS7 Obtain ascii only TBS LWASC 00 ADA NO7 Subtract 7 since number > 9 ADA MO60 AND BITS4 Ensure 4bits only JMP ASCHX,I HXASC NOP This routine converts 4bit binary into ASCII 0-F AND BITS4 Obtain the 4 binary bits CPA CD9 JMP HXAS1 CPA CD8 JMP HXAS1 TBS CD8 00 ADA PO7 Add 7 since number > 9 HXAS1 ADA PO60 JMP HXASC,I * OUT11 NOP Output routine for port 11 OTA 11B STC 11B,C NOP NOP JMP OUT11,I * IN11 NOP This routine reads port 11B STC 11B,C JMP *+1,I DEF PAUSE CONT NOP LIA 11B Load in 8bits of data JMP IN11,I * TMRID OCT 2 Register 1,2,or 3 ASCDD OCT 72 ':' LWASC OCT 100 ASCII indicator bit PO60 OCT 60 MO60 OCT -60 PO7 OCT 7 NO7 OCT -7 TMXM8 BSS 1 Stores the most significant 8 bits TMXL8 BSS 1 Stores the least significant 8 bits TMCL BSS 1 RS0 OCT 1000 RS0,also READ STATUS reg control word RS1 OCT 2000 Write MSB control word RS2 OCT 3000 Read LSB control word TMWR OCT 400 Write enable control word TSTAT BSS 1 Stores the STATUS registor (8bits) SASCI OCT 123 'S' CASCI OCT 103 'C' LASCI OCT 114 'L' HASCI OCT 110 'H' GASCI OCT 107 'G' CR1 BSS 1 (CR1+0) CR2 BSS 1 (CR1+1) CR3 BSS 1 (CR1+2) BITS4 OCT 17 A 4bit mask *** SQRT subroutine * SQRT NOP DST DST1 Store the number DLD FD1 DST DST3 Set initial guess to 1.0 LDA M12 Do 12 iterations ( more or less arbitrary ) STA CSQRT SQRT1 DLD DST1 FDV DST3 FAD DST3 FDV FD2 DST DST3 Store new guess = (num/old guess + new guess)/2 ISZ CSQRT JMP SQRT1 JMP SQRT,I CSQRT BSS 1 DST1 BSS 2 DST2 BSS 2 DST3 BSS 2 FD1 DEC 1.0 FD2 DEC 2.0 * *** * * Subroutine to calculate the FFT of an array *with A = start address of complex array & B = number of samples * The FFT is calculated INPLACE FNB BSS 2 Store Float(NB) here U BSS 4 T BSS 4 DT DEF T DU DEF U DUP2 DEF U+2 ND2 BSS 1 TWO DEC 2 NM1 BSS 1 J BSS 1 L BSS 1 K BSS 1 M BSS 1 FFTK1 BSS 1 Store the transform direction constant here FONE DEC 1.0 FTWO DEC 2.0 ME BSS 1 LPK BSS 1 ********** * * Complex Arithmetic Routines * CPTR1 BSS 1 CPTR2 BSS 1 CPTR3 BSS 1 CAD NOP Complex add routine [CPTR3,I]=[CPTR1,I]+[CPTR2,I] DLD CPTR1,I Add real parts FAD CPTR2,I DST CPTR3,I ISZ CPTR1 Increment 3 pointers ISZ CPTR1 ISZ CPTR2 ISZ CPTR2 ISZ CPTR3 ISZ CPTR3 DLD CPTR1,I Add imaginary parts FAD CPTR2,I DST CPTR3,I JMP CAD,I * CSB NOP Complex subtract routine [CPTR3,I]=[CPTR1,I]-[CPTR2,I] DLD CPTR1,I Subtract real parts FSB CPTR2,I DST CPTR3,I ISZ CPTR1 Increment 3 pointers ISZ CPTR1 ISZ CPTR2 ISZ CPTR2 ISZ CPTR3 ISZ CPTR3 DLD CPTR1,I Subtract imaginary parts FSB CPTR2,I DST CPTR3,I JMP CSB,I * CMP NOP Complex multiply routine [CPTR3,I]=[CPTR1,I]*[CPTR2,I] DLD CPTR1,I Multiply real parts FMP CPTR2,I DST TEMP1 ISZ CPTR1 ISZ CPTR1 ISZ CPTR2 ISZ CPTR2 CLA CLB Load 0.0 FSB CPTR1,I FMP CPTR2,I Multiply the imaginary parts and negate FAD TEMP1 DST TEMP2 Form the final real part of the product LDA CPTR2 ADA M2 STA CPTR2 DLD CPTR1,I FMP CPTR2,I DST TEMP1 Store Imag(1)*Real(2) LDA CPTR1 ADA M2 STA CPTR1 ISZ CPTR2 ISZ CPTR2 DLD CPTR1,I FMP CPTR2,I Form Imag(2)*Real(1) FAD TEMP1 DST TEMP1 Temporarily store the imaginary product DLD TEMP2 Recall the Real product DST CPTR3,I Store it ISZ CPTR3 ISZ CPTR3 DLD TEMP1 DST CPTR3,I Store the final imaginary product JMP CMP,I TEMP1 BSS 2 TEMP2 BSS 2 * GETW NOP Calculates W=CMPLX(COS(PI/K),-SIN(PI/K)) LDA M using tables of COS() and -SIN() CLE ELA ADA DCOST STA C1 DLD C1,I Load COS(PI/K) DST DW,I Store in the real part of W LDA M (Use M , not K as in the FORTRAN Program. Check the COS and SIN tables.) CLE ELA ( 2**M=K ) ADA DSINT STA C1 LDA FFTK1 [A] = FFT direction value CPA M1 JMP GETW1 Transform is the inverse DLD C1,I GETW2 DST DWP2,I Store in the imaginary part of W JMP GETW,I GETW1 CLA CLB FSB C1,I JMP GETW2 DSINT DEF SINT-2 This value is used when accessing SIN values SINT DEC 0.0 -Sin(PI/1) DEC -1.0 -Sin(PI/2) DEC -0.707107 -Sin(PI/4) DEC -0.382683 -Sin(PI/8) DEC -0.195090 -Sin(PI/16) DEC -0.980171E-01 -Sin(PI/32) DEC -0.490677E-01 -Sin(PI/64) DEC -0.245412E-01 -Sin(PI/128) DEC -0.122715E-01 -Sin(PI/256) DEC -0.613588E-02 -Sin(PI/512) DCOST DEF COST-2 COS tables access pointer COST DEC -1.0 Cos(PI/1) DEC 0.0 Cos(PI/2) DEC 0.707107 Cos(PI/4) DEC 0.923880 Cos(PI/8) DEC 0.980785 Cos(PI/16) DEC 0.995185 Cos(PI/32) DEC 0.998795 Cos(PI/64) DEC 0.999699 Cos(PI/128) DEC 0.999925 Cos(PI/256) DEC 0.999981 Cos(PI/512) W BSS 4 DW DEF W DWP2 DEF W+2 ********** STRAN NOP Service routine for FFT & INFFT STA ASTRT Store the complex array start address STB NFFT Store the number of samples ADA M4 STA ASTM4 Store a useful addressing constant JMP STRAN,I ASTRT BSS 1 ASTM4 BSS 1 NFFT BSS 1 ********** INFFT NOP Inverse FFT JSB STRAN Set up a few constants CLB LDA M1 STA FFTK1 Set up the -1 <- transform constant LDA INFFT STA FFT Set up the subroutine return address JMP FFT0 Enter the FFT subroutine ********** FFT NOP Subroutine FFT JSB STRAN Set up a few constants CLB LDA CD1 STA FFTK1 Set up the +1 -> transform constant TBS BIT3 TESTB If the speed-up bit is set, JMP FFT0 Do not divide samples by NB. CLB Divide all the input values by the number of samples LDA NFFT FLT DST FNB Set up FNB LDA NFFT (DO LOOP 1) Divide all elements by number of samples CLE ELA There are 2*NFFT double word elements in a complex array CMA,INA STA C2 Set up the UP counter to 0 for the LOOP LDA ASTRT STA C1 L1S DLD C1,I A(J)=A(J)/FNB LOOP 1 start FDV FNB DST C1,I ISZ C1 ISZ C1 L1F ISZ C2 LOOP 1 finish JMP L1S * Entry point for routine INFFT FFT0 LDA NFFT ND2=NFFT/2 CLE ERA STA ND2 LDA NFFT NM1=NFFT-1 ADA M1 STA NM1 CLA J=1 INA STA J * CLA STA L L4S ISZ L Loop 4 start L=1,NM1 (Loop 4 tests at the end) LDA J If(L.GE.J) Goto2 CMA,INA ADA L [A]=L-J SSA,RSS JMP LABL2 Jump if L>=J LDA J Note:2 memory locations/floating number CLE ELA ELA use 2*J,2*L ADA ASTM4 STA C1 C1 points to A(J) LDA L CLE ELA ELA ADA ASTM4 STA C2 C2 points to A(L) DLD C1,I Swap real parts of A(J) and A(L) using T DST T DLD C2,I DST C1,I DLD T DST C2,I ISZ C1 Increment the pointers to the imaginary parts ISZ C1 ISZ C2 ISZ C2 DLD C1,I Swap imaginary parts of A(J) and A(L) using T DST T DLD C2,I DST C1,I DLD T DST C2,I LABL2 LDA ND2 K=ND2 STA K LABL3 LDA J If(K.GE.J) Goto4 CMA,INA ADA K [A]=K-J SSA,RSS Jump to 4 if [A]>=0 ; K>=J JMP LABL4 Jump ij K>=J LDA K J=J-K CMA,INA ADA J STA J LDA K K=K/2 CLE ERA STA K JMP LABL3 Goto3 LABL4 LDA J J=J+K End of LOOP 4 ADA K STA J LDA NM1 Take care of the end of DO LOOP 4 L=1,NM1 CMA,INA ADA L SZA JMP L4S L#NM1 ; return to the top of the LOOP * Calculate the FFT according to figure 12.5 CLA STA M L6SA ISZ M Start of DO LOOP 6 (a) M=1,N DLD FONE U=CMPLX(1.0,0.0) DST DU,I CLA Load a 0.0 into AB CLB DST DUP2,I LDX M ME=2* (Shall perform RAL s)*M CLA INA FFT3 RAL Multiply by 2 DSX JMP FFT3 STA ME CLE ERA K=ME/2 STA K JSB GETW W is selected from tables of SIN & COS CLA STA J L6SB ISZ J Start of DO LOOP 6 (b) J=1,K (Loop 6(b) tests at it's end) LDA ME Set initial L to J-ME CMA,INA ADA J STA L L5S LDA L DO LOOP 5 L=J,NFFT,ME (Loop 5 tests at it's end) ADA ME STA L LDA L LPK=L+K ADA K STA LPK CLE ELA ELA ADA ASTM4 STA C2 C2 points to A(LPK) STA CPTR1 CPTR1 points to A(LPK) LDA L CLE ELA ELA ADA ASTM4 STA C1 C1 points to A(L) LDA DU T=A(LPK)*U STA CPTR2 LDA DT STA CPTR3 JSB CMP LDA C1 A(LPK)=A(L)-T STA CPTR1 LDA DT STA CPTR2 LDA C2 STA CPTR3 JSB CSB LDA C1 A(L)=A(L)+T STA CPTR1 STA CPTR3 LDA DT STA CPTR2 JSB CAD L5F LDA NFFT Load LOOP 5 counter limit CMA,INA ADA L [A] = L-NFFT SSA Get out of LOOP if (NFFT-L)<0 JMP L5S L6FB LDA DU U=U*W STA CPTR3 STA CPTR1 LDA DW STA CPTR2 JSB CMP LDA J Check DO LOOP 6(b) counter CMA,INA ADA K SZA JMP L6SB J#K then jump to top of DO LOOP L6FA LDA M Check DO LOOP 6(a) counter CMA,INA ADA N SZA JMP L6SA Keep DOing until M=N CLA CLB CAX JMP FFT,I * * *Cross correlation group of routines *Set up the timer1 latch *Data in the A register *Uses the B register T1SET NOP LDB 00 Temp store A > B ALF,ALF AND BITS8 Obtain the leftmost 8 bits IOR RS1 IOR TMWR JSB OUT11 LDA 01 Restore A AND BITS8 Obtain the rightmost 8 bits IOR RS1 IOR RS0 IOR TMWR JSB OUT11 JMP T1SET,I * *Transmit routine * B register = the number of samples * X register = the buffer start address TAS NOP LDA TACW1 OTA 6B Output a control word initialising DCPC1 TA1 CLC 2B CXA IOR TACW2 OTA 2B Output a DCPC1 transmit control word TA2 STC 2B CMB,INB OTB 2B TA3 STC 10B,C This is the start STC 6B,C SFS 6B JMP *-1 Wait until the data has been transferred JMP TAS,I TACW1 OCT 120010 ???? Check these values before use TACW2 OCT 100000 ???? * *Timer 2 set routine * Data in the A register * Uses the B register T2SET NOP LDB 00 ALF,ALF AND BITS8 IOR RS1 IOR TMWR JSB OUT11 Output the MS8bits LDA 01 AND BITS8 IOR RS0 IOR RS2 IOR TMWR JSB OUT11 Output the LS8bits JMP T2SET,I * *Receive routine * B register = Number of samples * X register = buffer start address RAS NOP LDA RACW1 OTA 6B RA1 CLC 2B CXA IOR RACW2 OTA 2B RA2 STC 2B CMB,INB OTB 2B RA3 STC 10B,C Start of looping STC 6B,C SFS 6B JMP *-1 JMP RAS,I RACW1 OCT 120010 ???? Check these values before use RACW2 OCT 100000 ???? * *Conjugate and Cross multiply * A = array1 address * B = array2 address * X = output array address * Y = number of points CXM NOP STA CXMP1 STB CXMP2 STX CXMP3 INB INB STB CXMP4 This is the Imag(array2) pointer CXM1 CLA CLB FSB CXMP4,I DST CXMP4,I Conjugate LDA CXMP1 STA CPTR1 LDA CXMP2 STA CPTR2 LDA CXMP3 STA CPTR3 JSB CMP Multiply LDX CD4 LDB DCXMP CXM2 LDA 01,I ADA CD4 STA 01,I Increment 4 pointers by 4 INB DSX JMP CXM2 DSY JMP CXM1 JMP CXM,I DCXMP DEF CXMP1 CXMP1 BSS 1 CXMP2 BSS 1 CXMP3 BSS 1 CXMP4 BSS 1 * * Cross multiply routine * A = array1 address * B = array2 address * X = output array address * Y = number of points XM NOP STA CXMP1 STB CXMP2 STX CXMP3 XM1 LDA CXMP1 STA CPTR1 LDA CXMP2 STA CPTR2 LDA CXMP3 STA CPTR3 JSB CMP Multiply LDX CD3 LDB DCXMP XM2 LDA 01,I ADA CD4 STA 01,I Increment 3 pointers by 4 INB DSX JMP XM2 DSY JMP XM1 JMP XM,I * *Sort routine to find the maximum of a floating real array * A = Address of the start of the buffer * X = Number of samples * SMAX = the final maximum * SRT3 = address of SMAX SORT NOP STA SRT1 STA SRT3 Let SRT3 be the address of BIG DLD SRT1,I DST SMAX Let SMAX be BIG ISZ SRT1 ISZ SRT1 DSX SORT1 DLD SRT1,I [AB] = number FSB SMAX [AB] = number - BIG SSA JMP SORT2 Jump if BIG > number DLD SRT1,I DST SMAX Reset BIG LDA SRT1 STA SRT3 SORT2 ISZ SRT1 ISZ SRT1 DSX JMP SORT1 JMP SORT,I SMAX BSS 2 SRT1 BSS 1 SRT3 BSS 1 * * Main control routine XCORT NOP Cross correlation routine 1 LDA DCRA1 Complex Float array S1 >> array CARA1 LDB S1S LDX NB JSB ICFLT LDA DCRA1 Take the FFT of array CARA1 LDB NB JSB FFT LDA DCRA2 Complex Float array B1 >> array CARA2 LDB B1S LDX NB JSB ICFLT LDA DCRA2 Take the FFT of array CARA2 LDB NB JSB FFT LDA DCRA1 array CARA3 = array CARA1 * CONJUGATE array CARA2 LDB DCRA2 LDX DCRA3 LDY NB JSB CXM LDA DCRA3 Take the inverse FFT of array CARA3 LDB NB JSB INFFT LDA DCRA3 Calculate the power of CARA3 into array CARA2 LDB DCRA2 LDX NB JSB POWER XCRT2 LDA DCRA2 Sort out the maximum value of the Correlogram LDX NB JSB SORT LDA DCRA2 IFIX and scale the power into 8bit array Z1 LDB Z1S LDY CD250 LDX NB JSB RIFIX LDA BIT13 Trigger the CRO when plotting the XCORR JSB OUT10 CLA JSB OUT10 LDB Z1S CLE ELB LDY NB XCRT4 LBT JSB OUT10 DSY JMP XCRT4 JSB VOUTZ JMP OPS Return to the operating system * XFX NOP Fast XC routine SBS BIT3 TESTB Set the fast FFT control bit LDA DCRA2 Complex Float array B1 >> array CARA2 LDB B1S LDX NB JSB ICFLT LDA DCRA2 Take the FFT of array CARA2 LDB NB JSB FFT LDA DCRA1 array CARA3 = CONJ( array CARA1 ) * array CARA2 LDB DCRA2 LDX DCRA3 LDY NB JSB XM LDA DCRA3 Take the inverse FFT of array CARA3 LDB NB JSB INFFT LDA DCRA3 Calculate the "power of CARA3 into array CARA2 LDB DCRA2 LDX NB JSB PWR2 CBS BIT3 TESTB Clear the fast FFT control bit JMP OPS JMP XCRT2 * * This routine takes the FFT of S1 and stores its * complex conjugate in array 1 . XEX NOP LDA DCRA1 Complex Float array S1 >> array CARA1 LDB S1S LDX NB JSB ICFLT LDA DCRA1 Take the FFT of array CARA1 LDB NB JSB FFT LDA DCRA1 Complex conjugate the FFT of the tx signal INA INA STA CXMP1 LDX NB XEX1 CLA CLB FSB CXMP1,I DST CXMP1,I LDA CXMP1 ADA CD4 Increment the imaginary part pointer STA CXMP1 DSX JMP XEX1 JMP OPS * * This routine calculates the power of a complex vector * A = address of the input complex floating array * B = address of the output real floating array * X = the number of values POWER NOP STA P1 STB P2 PWR1 DLD P1,I Load a real number FMP 0 Square it DST P3 Temporarily store it ISZ P1 ISZ P1 DLD P1,I FMP 0 Square the imaginary part FAD P3 Add both the squared parts of the number together PWR0 JSB SQRT Obtain the square root DST P2,I ISZ P1 ISZ P1 ISZ P2 ISZ P2 DSX JMP PWR1 JMP POWER,I * PWR2 NOP This routine calculates the square LDY PWR20 of the power of an array STY PWR0 Remove the JSB SQRT JSB POWER LDA PWR21 STA PWR0 Restore the JSB SQRT JMP PWR2,I PWR20 NOP PWR21 JSB SQRT * * FFT test routine * B1 = INFFT ( FFT ( S1 ) ) FTX LDA FTXX STA SPXX Write a JSB INFFT into routine SPX JSB SPX Perform signal processing with inverse FFT CLA ( Perform both forward and inverse transforms ) STA SPXX Rewrite a NOP into SPX JMP OPS Return to operating system FTXX JSB IFFTI,I * *[0]MISC1 LIA 01B *[0] CLB *[0] FLT *[0] JSB SQRT *[0] FIX *[0] OTA 01B *[0] HLT *[0] JMP MISC1 *[0]* *[0]MISC2 LDA ZZ1 *[0] LDX ZZ2 *[0] JSB SORT *[0] HLT *[0] JMP MISC2 *[0]ZZ1 BSS 1 *[0]ZZ2 BSS 1 *[0]ZZ3 BSS 1 *[0]* *[0]MISC3 STB ZZ3 *[0] LIA 01B *[0] CLB *[0] FLT *[0] DST ZZ3,I *[0] ISZ ZZ3 *[0] ISZ ZZ3 *[0] HLT *[0] JMP MISC3+1 *[0]* *[0]MISC4 LIA 01B *[0] STA ZZ3 *[0] DLD ZZ3,I *[0] FIX *[0] ISZ ZZ3 *[0] ISZ ZZ3 *[0] HLT *[0] JMP MISC4+2 *[0]* **************************************************** * ORG 4000B * RXDAT OCT 143720 The control and value data for routine RGX OCT 151750 OCT 170764 OCT 040310 OCT 050144 OCT 070062 OCT 000024 OCT 010012 OCT 030005 * BNASC BSS 6 INP BSS 50 TTXM ASC 3,TX T = OCT 2000 EOT value for ASCT FFXM ASC 4,FUND F = OCT 2000 EOT value for ASCT RGM ASC 5,RX GAIN = OCT 2000 EOT value for ASCT RWXM ASC 6,TX-RX D T = OCT 2000 EOT value for ASCT ER1 ASC 13,? COMMAND NOT RECOGNISED OCT 2000 EOT value for ASCT RM16 ASC 9,? VALUES READ IN : OCT 2000 EOT value for ASCT ERNAM ASC 14,? BUFFER NAME NOT RECOGNISED OCT 2000 EOT value for ASCT * PAUSE BSS 20 20 NOPs JMP *+1,I DEF CONT S1 BSS CNST1 Output signal buffer B1 BSS CNST1 Return signal buffer Z1 BSS CNST1 Miscellaneous signal buffer CARA1 BSS CNST2 (Cnst2/4) complex long array CARA2 BSS CNST2 (Cnst2/4) complex long array CARA3 BSS CNST2 (Cnst2/4) complex long array BOTOM OCT 125252 PTC1 DEF APTIN PTC2 DEF APUN PTC3 JSB PTC1,I JSB PTC2,I JMP PTC3 END
Acoustic ranging with M-sequence TX and FFT-based cross correlator
This is part of an acoustic ranging system ("sonar") used in sugar cane harvester automation experiments.
Subscribe to:
Posts (Atom)
No comments:
Post a Comment