1 /DAFFT -AN OVERLAY TO DAQUAN MS FOR FFT ON AVERAGED DATA. 2 / 3 /DEC-8E-ADAFA-A-LA 4 / 5 /COPYRIGHT 1972 6 /DIGITAL EQUIPMENT CORPORATION 7 /MAYNARD MASSACHUSETTS 01754 8 / 9 /DAFFT OVERLAY FOR PS-8,CONTAINS FFT 10 /FILE DAFFT.3 11 /THIS IS A SET OF OVERLAYS FOR DAQUAN WHICH WILL 12 /CREATE DAFFT--DAQUAN+FFT ALA ROTHMAN: 13 14 /INCLUDED ARE ROUTINES TO CREATE POWER SPECTRUM, 15 /DO HANNING SMOOTHING, AND RETAIN DATA IN A THIRD ARRAY. 16 17 /DAFFT REQUIRES ADVANCED LAB 8/E WITH KE8/E (EAE). 18 /LOAD DAQUAN(E) BINARY, FFTS-C INTO FIELD 1, THEN THESE OVERLAYS. 19 /PUNCH FIELD 0, 0-7577 & FIELD 1, 0-1577. 20 21 FIXMRI CALL= 4400 22 SETM2= 7344 23 SET3= 7325 24 MQA= 7501 25 CDF= 6201 26 CIF= 6202 27 LSR= 7417 28 NPTS= 70 29 NMI= 7411 30 SCA= 7441 31 TEM3= 134 32 HEDIT1= 4430 33 GETNO= 4422 34 BLOCK= 140 35 YIND= 11 36 ZIND= 12 37 CNTR= 126 38 DISPLAY=5466 39 TEMP= 131 40 MQL= 7421 41 MUY= 7405 42 SHL= 7413 43 CLRR= 3540 44 SMOT11= 3025 45 ASR= 7415 46 BEGDIS= 222 47 AUTO= 13 48 INITAR= 4425 49 QUERY= 32 50 SPINIT= 3014 51 TEMFP= 150 52 FTEM1= 142 53 FIXT= 4421 54 FLOUT= 4406 55 CRLFD= 4427 56 FLOAT= 4420 57 DP= 57 58 SCPINT= 230 59 M13= 363 60 K1000= 124 61 TEMP1= 132 62 FIELD 0 63 /UPDATE COMMAND TABLE 64 *2103 65 002103 0523 SMCHK 66 *2132 67 002132 6654 -1124 /IT: INVERSE TRANSFORM 68 002133 0407 DIFT0 69 *2156 70 002156 7154 -624 /FT: FOURIER TRANSFORM 71 002157 0403 DFT0 72 002160 5761 -2017 /PO-WER SPECTRUM 73 002161 0437 POWR 74 002162 4554 -3224 /ZT: ZERO IMAG ARRAY AND DO FFT 75 002163 0400 ZAPIT 76 002164 5470 -2310 /SH-IFT ARRAY TO OR FROM STORAGE BUFFER 77 002165 0476 SAVE 78 002166 6072 -1706 /OF-FSET FOR FFT DISPLAY. 79 002167 0547 SETOFF 80 002170 0000 0 /END TABLE 81 *1321 82 001321 4403 CALL STPTS /SET UP FFT PTS & POWER OF 2 83 *3 84 000003 0412 STPTS, STPT 85 000004 0432 RSTPT, RSTPTS 86 *76 87 000076 1577 1577 /ARRAY BASE-1 88 000077 2000 2000 /AND OFFSET 89 *4011 90 004011 4404 CALL RSTPT 91 /NEW TEXT OVERLAYS SQUEEZE 92 *3716 93 003716 1054 HDS, TEXT /H,3,11(0,1,2):/ 003717 6354 003720 6161 003721 5060 003722 5461 003723 5462 003724 5172 003725 0000 94 003726 0601 HDPR, TEXT /FACTOR=/ 003727 0324 003730 1722 003731 7500 95 003732 2301 HDSA, TEXT /SAVE?/ 003733 2605 003734 7700 96 /ROUTINE TO PRINT FFT SCALE FACTOR IN AC 97 003735 4420 TRET, FLOAT 98 003736 4430 HEDIT1 99 003737 3726 HDPR 100 003740 7325 SET3 /3 DIGIT INTEGER 101 003741 3057 DCA DP 102 003742 4406 FLOUT 103 003743 5466 DISPLAY 104 *200 /CANCLE MOVING PAGE 7600 FIELD 1. 105 000200 7200 7200 106 *2242 107 002242 7200 7200 108 *2451 109 002451 7000 7000 110 *2525 111 002525 7200 7200 112 *3747 113 003747 7000 7000 114 *2223 115 002223 7200 7200 116 *2504 117 002504 7000 7000 118 *2535 119 002535 7000 7000 120 121 *2552 /INSERT SWBA'S INTO THE PROPER PLACES IN DAQUAN 122 002552 7447 7447 /SWBA 123 *602 124 000602 7447 7447 /SWBA 125 *766 126 000766 7447 7447 /SWBA 127 /FIELD 1 DISPATCHER & NEW CODE WILL OVERLAY 'MODIFY' FUNCTION. 128 *400 /TO 554 IS OPEN 129 000400 2140 ZAPIT, ISZ BLOCK /CLEAR BUFFER 2 130 000401 4606 CALL ZAP 131 000402 3140 DCA BLOCK 132 000403 6213 DFT0, CDF CIF 10 /DO FFT 133 000404 5605 JMP I .+1 134 000405 0200 DFT 135 000406 3540 ZAP, CLRR 136 137 000407 6213 DIFT0, CDF CIF 10 /DO INVERSE FFT 138 000410 5611 JMP I .+1 139 000411 0203 DIFT 140 141 000412 0000 STPT, 0 /SUB TO SET UP NO. PTS. AND POWER. 142 000413 3070 DCA NPTS /OF 2 FOR FFT IN FIELD 1 143 000414 1070 TAD NPTS 144 000415 7411 NMI 145 000416 7641 CLA SCA 146 000417 7041 CIA 147 000420 1227 TAD KP12 148 000421 6211 CDF 10 149 000422 3630 DCA I PW2 /IS POWER OF 2 150 000423 1070 TAD NPTS 151 000424 3631 DCA I PTS1 /AND NO. PT. 152 000425 6201 CDF 0 153 000426 5612 JMP I STPT 154 000427 0012 KP12, 12 155 000430 0004 PW2, 4 156 000431 0003 PTS1, 3 157 158 /SUB. SIMILAR TO AVERAGER 159 000432 0000 RSTPTS, 0 160 000433 4212 JMS STPT 161 000434 1070 TAD NPTS 162 000435 3134 DCA TEM3 163 000436 5632 JMP I RSTPTS 164 165 /COMPUTE POWER SPECTRUM 166 000437 4430 POWR, HEDIT1 /FACTOR= 167 000440 3726 HDPR 168 000441 4422 GETNO /GET SCALE DOWN FACTOR 169 000442 4421 FIXT 170 000443 1262 TAD M1 171 000444 3273 DCA PSH /AS A SHIFT COUNTER 172 000445 3140 DCA BLOCK 173 000446 4661 CALL SINT /INIT POINTERS,ETC. 174 000447 1411 PLP, TAD I YIND /GET REAL,SQUARE IT 175 000450 4263 JMS PMUL 176 000451 3131 DCA TEMP 177 000452 1413 TAD I AUTO /GET IMAG.,SQUARE IT 178 000453 4263 JMS PMUL 179 000454 1131 TAD TEMP 180 000455 3412 DCA I ZIND /STORE SUM 181 000456 2126 ISZ CNTR 182 000457 5247 JMP PLP 183 000460 5466 DISPLAY 184 000461 3014 SINT, SPINIT 185 000462 7777 M1, -1 186 187 /SUB. TO SQUARE AC AND SCALE IT DOWN 188 000463 0000 PMUL, 0 189 000464 7510 SPA 190 000465 7041 CIA 191 000466 3271 DCA MPD /ABS. VALUE 192 000467 1271 TAD MPD 193 000470 7425 MQL MUY 194 000471 0000 MPD, 0 195 000472 7417 LSR 196 000473 0000 PSH, 0 /SET BEFORE ENTRY 197 000474 7701 CLA MQA 198 000475 5663 JMP I PMUL 199 200 /ROUTINE TO SAVE OR RESTORE DATA FROM 3RD ARRAY 201 000476 4430 SAVE, HEDIT1 /SAVE? 202 000477 3732 HDSA 203 000500 3140 DCA BLOCK /SET UP POINTERS,ETC 204 000501 4425 INITAR 205 000502 1322 TAD AR3 206 000503 3013 DCA AUTO 207 000504 4432 CALL QUERY /GET ANSWER,0=YES,1=NO 208 000505 6211 CDF 10 209 000506 7650 SNA CLA 210 000507 5315 JMP SVE /SAVE CHANNEL 211 000510 1413 TAD I AUTO 212 000511 3411 DCA I YIND /GET STORAGE ARRAY INTO CHANNEL 1 213 000512 2126 ISZ CNTR 214 000513 5310 JMP .-3 215 000514 5466 DISPLAY 216 217 000515 1411 SVE, TAD I YIND /PUT CHANNEL 1 INTO STORAGE ARRAY 218 000516 3413 DCA I AUTO 219 000517 2126 ISZ CNTR 220 000520 5315 JMP .-3 221 000521 5466 DISPLAY 222 000522 5577 AR3, 5577 /BASE OF STORAGE ARRAY-1 223 /NEW SMOOTHING ROUTINE. 224 000523 4430 SMCHK, HEDIT1 /H,3,11(0,1,2): 225 000524 3716 HDS 226 000525 4422 GETNO /GET CODE 227 000526 4421 FIXT 228 000527 7450 SNA 229 000530 5343 JMP SHAN /DO HANNING FILTER 230 000531 7110 CLL RAR 231 000532 7640 SZA CLA 232 000533 5741 JMP I SHAV /DO 11 PT. 233 000534 1342 TAD CNP /DO 3 PT 234 000535 6213 CDF CIF 10 /SET INSTRUCTION AND DO IT 235 000536 3746 DCA I INS1 236 000537 5740 JMP I .+1 237 000540 0215 RLSM 238 239 000541 3025 SHAV, SMOT11 240 000542 7000 CNP, NOP 241 242 000543 6213 SHAN, CDF CIF 10 /EXIT TO HANNING FILTER 243 000544 5745 JMP I .+1 244 000545 0211 HNSM 245 000546 0247 INS1, INST 246 000547 1167 SETOFF, TAD FTOFST /SET DISPLAY OFFSET. 247 000550 7650 SNA CLA 248 000551 1124 TAD K1000 249 000552 3167 DCA FTOFST 250 000553 5466 DISPLAY 251 252 *SCPINT+4 253 000234 5364 JMP M13+1 254 255 *M13+1 256 000364 1167 TAD FTOFST 257 000365 3132 DCA TEMP1 258 000366 5235 JMP SCPINT+5 259 260 *167 261 000167 0000 FTOFST, 0 262 263 /PREVENT BOX CAR INTEGRATION. 264 *4233 265 004233 3000 DCA 0 266 *4251 267 004251 1000 TAD 0 268 FIELD 1 269 *200 270 010200 4311 DFT, JMS MIDSET /0 MEAN THE DATA AND DO FFT 271 010201 4443 CALL DOFFT 272 010202 7410 SKP 273 274 010203 4444 DIFT, CALL DOIFFT /DO INVERSE FFT 275 010204 4437 CALL SORT /DO BIT INVERT STORAGE 276 010205 1050 TAD SCALE 277 010206 6203 CDF CIF 0 278 010207 5610 JMP I .+1 /PRINT SCALE FACTOR 279 010210 3735 TRET 280 281 010211 1275 HNSM, TAD CIAC /DO HANNING SMOOTH 282 010212 3247 DCA INST /SET INSTRUCTION 283 010213 1047 TAD XLOCDF /SET AC TO HANN IMAG. 284 010214 4221 JMS HANM 285 010215 4221 RLSM, JMS HANM /THEN REALS 286 010216 6203 CDF CIF 0 287 010217 5620 JMP I .+1 288 010220 0222 BEGDIS /EXIT 289 290 /SUB TO DO HANNING OR 3 PTS FILTER 291 010221 0000 HANM, 0 292 010222 4277 JMS PSTR /SET UP POINTERS 293 010223 7447 7447 /SWBA 294 010224 2272 ISZ CNT 295 010225 1413 TAD I 13 /DIVIDE Y(I) BY 2 296 010226 7415 ASR 297 010227 0000 0 298 010230 3274 DCA TMPX 299 010231 1413 TAD I 13 /DIVIDE Y(I+1) BY 4 300 010232 7415 ASR 301 010233 0000 0 302 010234 3270 DCA TMPY 303 010235 1270 TAD TMPY 304 010236 5250 JMP INST+1 305 010237 1413 SMGO, TAD I 13 306 010240 7415 ASR 307 010241 0000 0 308 010242 3270 DCA TMPY 309 010243 1270 TAD TMPY 310 010244 7415 ASR 311 010245 0000 0 312 010246 1273 TAD TMP 313 010247 7041 INST, CIA 314 010250 1274 TAD TMPX 315 010251 3414 DCA I 14 316 010252 1274 TAD TMPX 317 010253 7415 ASR 318 010254 0000 0 319 010255 3273 DCA TMP 320 010256 2272 ISZ CNT 321 010257 7410 SKP 322 010260 5264 JMP .+4 323 010261 1270 TAD TMPY 324 010262 3274 DCA TMPX 325 010263 5237 JMP SMGO 326 010264 1274 TAD TMPX 327 010265 1270 TAD TMPY 328 010266 3414 DCA I 14 329 010267 5621 JMP I HANM 330 010270 0000 TMPY, 0 331 010271 7777 MM1, -1 332 010272 0000 CNT, 0 333 010273 0000 TMP, 0 334 010274 0000 TMPX, 0 335 010275 7041 CIAC, CIA 336 010276 1577 RTP, XRTAB-1 /POINTER TO REAL ARRAY-1 337 010277 0000 PSTR, 0 338 010300 1276 TAD RTP 339 010301 3013 DCA 13 /POINTER TO REALS 340 010302 1003 TAD N 341 010303 7041 CIA 342 010304 3272 DCA CNT /PT COUNT 343 010305 1013 TAD 13 344 010306 3014 DCA 14 /14=13 345 010307 3273 DCA TMP 346 010310 5677 JMP I PSTR 347 348 /SUB TO FIND MEAN AND SUBTRACT IT FROM ARRAY 349 /TO GET ZERO MEAN DATA WITH 350 /NO DC OFFSET IN FFT 351 010311 0000 MIDSET, 0 352 010312 4277 JMS PSTR 353 010313 3274 DCA TMPX 354 010314 7100 ML1, CLL 355 010315 1413 TAD I 13 356 010316 7500 SMA 357 010317 5325 JMP ML1A 358 010320 1274 TAD TMPX /ADD WHEN Y IS + 359 010321 3274 DCA TMPX 360 010322 7004 RAL 361 010323 1271 TAD MM1 362 010324 5330 JMP ML1B 363 010325 1274 ML1A, TAD TMPX /ADD WHEN Y IS - 364 010326 3274 DCA TMPX 365 010327 7004 RAL 366 010330 1273 ML1B, TAD TMP /TMP IS HI ORDER,TMPX IS LOW 367 010331 3273 DCA TMP 368 010332 2272 ISZ CNT 369 010333 5314 JMP ML1 370 010334 7240 STA /HAVE SUM, SET A SHIFT COUNT 371 010335 1004 TAD NU /TO GET AVERAGE 372 010336 3343 DCA MSH 373 010337 1274 TAD TMPX 374 010340 7421 MQL 375 010341 1273 TAD TMP 376 010342 7415 ASR 377 010343 0000 MSH, 0 378 010344 7701 CLA MQA 379 010345 7041 CIA 380 010346 3274 DCA TMPX /IS - MEAN VALUE OF DATA 381 010347 4277 JMS PSTR 382 010350 1413 ML2, TAD I 13 /UPDATE ARRAY 383 010351 1274 TAD TMPX 384 010352 3414 DCA I 14 385 010353 2272 ISZ CNT 386 010354 5350 JMP ML2 387 010355 5711 JMP I MIDSET 388 389 /FFTS-COMPLEX : (VERSION D) 390 / 391 /THIS IS A SUBROUTINE FOR CALCULATING THE FAST FOURIER 392 /TRANSFORMATION OF A SEQUENCE OF N COMPLEX TIME SAMPLES 393 /WHICH ARE STORED IN MEMORY. IT IS FOR USE WITH A 4K 394 /PDP-8 OR PDP-8/I COMPUTER EQUIPPED WITH AN ASR33 TELETYPE AND AN 395 /EXTENDED ARITHMETIC ELEMENT OPTION AS MINIMUM HARDWARE. 396 /BY JAMES ROTHMAN -- AUGUST, 1968 397 398 /PAGE ZERO 399 *3 400 /TABLE PARAMETERS 401 010003 0000 N, 0 /NUMBER OF POINTS IN COMPUTATION 402 010004 0000 NU, 0 /POWER OF TWO OF POINTS IN COMPUTATION (N=2^NU) 403 010005 0000 L, 0 /INDEX TO SHOW WHAT ARRAY IS BEING CONSTRUCTED 404 010006 0000 S, 0 /GIVES SPACING BETWEEN NODE PAIRS IN THE LTH ARRAY. 405 010007 0000 F, 0 /USED FOR SCALING NODE POSITION TO GET NUMBERS IN NODES. 406 010010 0000 NOVER4, 0 /STORAGE FOR N/4. 407 010011 0012 MAXNU, BIGSNU /LARGEST TABLE SIZE (POWER OF 2) 408 010012 0000 MNOVR2, 0 /STORAGE FOR -N/2 409 *20 410 /INDEXING VARIABLES 411 010020 0000 QR, 0 /POINTER TO REAL PART OF X(Q) 412 010021 0000 QI, 0 /POINTER TO IMAG. PART OF X(Q) 413 010022 0000 PR, 0 /POINTER TO REAL PART OF X(P) 414 010023 0000 PI, 0 /POINTER TO IMAG. PART OF X(P) 415 010024 0000 Q, 0 /NUMERICAL INDEX Q(=0,1,...,N-1) 416 010025 0000 P, 0 /NUMERICAL INDEX P(=0,1,...,N-1) 417 010026 0000 K, 0 /NUMBER IN THE NODE BEING OPERATED ON. 418 /LOOP DELIMITERS 419 010027 0000 C, 0 /INTERRUPTS COMPUTATION OF LTH ARRAY EVERY S PASSES 420 /DATA VARIABLES 421 010030 0000 ADD2, 0 /USED BY SUBROUTINE ADDR AS DATA (ADDEND) 422 010031 0000 TEMPR, 0 /TEMPORARY STORAGE REGISTER FOR REAL PARTS 423 010032 0000 SINE, 0 /TEMP. STORAGE FOR SIN(2*PI*K/N) 424 010033 0000 COSINE, 0 /TEMP. STORAGE FOR COS(2*PI*K/N) 425 010034 0000 GR, 0 /REAL PART OF PRODUCT (W^K)*X(P). TEMP STORAGE 426 010035 0000 GI, 0 /IMAG. PART OF (W^K)*X(P). TEMP STORAGE 427 /SUBROUTINE CALL LIST 428 010036 1134 ADDER, ADDR /ADD C(AC) TO C(ADD2) AND SCALE RIGHT ONE 429 010037 0703 SORT, SORTX /BIT INVERTED BUFFER SORTED. 430 010040 1036 INVERT, INVRT /WORD IN AC OF NU BITS IS BIT INVERTED 431 010041 1000 MULT, MULTIP /SINGLE PRECISION SIGNED MULTIPLY AC=ARG1;C(CALL+1)=ADD OF ARG2 432 010042 1061 GETRIG, TRIGET /FETCH SIN AND COS OF 2*PI*C(AC)/N. 433 010043 0400 DOFFT, FFT /DO FFT OF THE INPUT BUFFER 434 010044 0756 DOIFFT, IFFT /DO INVERSE OF BUFFER 435 /DATA TABLES 436 010045 1175 SINLOC, SINTAB /TABLE OF SIN(2*PI*I/N) FOR I=0,1,2,...,N-1 437 010046 1600 XRLOC, XRTAB /INPUT BUFFER AND TABLE OF ARRAYS (REAL PARTS) 438 010047 2000 XLOCDF, XITAB-XRTAB /DIFFERENCE IN ADDRESS OF REAL AND IMAG PART TABLES 439 /PSEUDO FLOATING POINT FORMAT FLAGS. 440 010050 0000 SCALE, 0 /PSEUDO EXPONENT OF FOURIER COEFFICIENTS. 441 010051 0001 SHFLAG, 1 /IF =1,ADD WITH SHIFT; IF=0,ADD WITH OUT SHIFT. 442 010052 0000 SHFCHK, 0 /INDICATES IF ALL X'S IN AN ITERATION ARE <.5 443 /POINTERS TO SINE TABLE LOOK-UP SHIFTS 444 010053 1077 SHIFT1, SHFT1 /THE NUMBER 10-NU MUST BE PLACED 445 010054 1114 SHIFT2, SHFT2 /IN EACH OF THESE LOCATIONS. 446 010055 1125 SHIFT3, SHFT3 447 448 *400 449 /COMPUTATION OF FIRST COMPLEX ARRAY FROM INPUT DATA 450 /NUMBER OF INPUT POINTS IN "N" .LOG(2)(N)IN"NU". FOR DETAILS OF ALGORITHM, SEE FLOWCHART 451 010400 0000 FFT, 0 452 010401 7301 CLA IAC CLL 453 010402 3005 DCA L /L<=1 454 010403 3050 DCA SCALE /INITIALIZE FLOATING POINT FORMAT 455 010404 7001 IAC 456 010405 3051 DCA SHFLAG 457 010406 3052 DCA SHFCHK 458 010407 1003 TAD N 459 010410 7112 CLL RTR /INITIALIZE PROGRAM CONSTANTS 460 010411 3010 DCA NOVER4 461 010412 1004 TAD NU 462 010413 7041 CIA 463 010414 1011 TAD MAXNU 464 010415 3453 DCA I SHIFT1 465 010416 1453 TAD I SHIFT1 466 010417 3454 DCA I SHIFT2 467 010420 1454 TAD I SHIFT2 468 010421 3455 DCA I SHIFT3 469 010422 1003 TAD N 470 010423 7110 CLL RAR 471 010424 3006 DCA S /S<=N/2 IS SPACING OF NODE PAIRS IN FIRST ARRAY 472 010425 1006 TAD S 473 010426 7041 CIA 474 010427 3012 DCA MNOVR2 475 010430 7040 CMA /AC<=-1 476 010431 1006 TAD S /AC<=N/2-1 477 010432 1046 TAD XRLOC /BEGINNING OF TABLE OF REAL PARTS. 478 010433 3020 DCA QR /Q<=N/2-1. QR POINTS TO WORD IN MEMORY, WHILE Q IS ACTUAL INDEX 479 010434 1004 TAD NU 480 010435 7041 CIA 481 010436 7001 IAC 482 010437 3007 DCA F /F<=1-NU (=L-NU SINCE L=1) 483 010440 1020 LOOP1, TAD QR /QR=XRLOC+Q AT ALL TIMES. 484 010441 1006 TAD S 485 010442 3022 DCA PR /P<=Q+N/2 486 010443 1020 TAD QR /XLOCDF=XILOC-XRLOC (XILOC=BEGIN. OF IMAG. PARTS TABLE) 487 010444 1047 TAD XLOCDF /QR+XLOCDF=(S+XRLOC)+(XILOC-XRLOC)=XILOC+S=QI 488 010445 3021 DCA QI /QI=XILOC+Q AT ALL TIMES. QI POINTS TO IMAG. PART OF X(Q) 489 010446 1022 TAD PR 490 010447 1047 TAD XLOCDF /COMPUTE COMPLEX OPERATIONS X(P)<=X(Q)-X(P) AND X(Q)<=X(Q)+X(P) 491 010450 3023 DCA PI /BY REAL AND IMAGINARY PARTS. 492 010451 1421 TAD I QI /IM(X(Q)) (IM () MEANS IMAGINARY PART) 493 010452 3030 DCA ADD2 /MAKE IT ADDEND. DO IMAG. PARTS FIRST 494 010453 1423 TAD I PI /IM(X(P)) 495 010454 4436 JMS I ADDER /FORM ADDITION IM[X(P)+X(Q)]=IM[X(P)]+IM[X(Q)] AND SCALE RIGHT 496 010455 3031 DCA TEMPR /FOR SCALING, THEN STORE. 497 010456 1421 TAD I QI /FORM DIFFERENCE IM[X(Q)-X(P)]=IM[X(Q)]-IM[X(P)] 498 010457 3030 DCA ADD2 499 010460 1423 TAD I PI 500 010461 7041 CIA 501 010462 4436 JMS I ADDER 502 010463 3423 DCA I PI /PUT AWAY AT IM[X(P)] 503 010464 1031 TAD TEMPR /GET IM[X(P)+X(Q)] 504 010465 3421 DCA I QI /PUT AT IM[X(Q)]. IMAGINARY PARTS DONE. 505 010466 1420 TAD I QR /ADD REAL PARTS NEXT 506 010467 3030 DCA ADD2 507 010470 1422 TAD I PR /RE=REAL PART 508 010471 4436 JMS I ADDER /FORM RE[X(P)+X(Q)]=RE[X(P)]+RE[X(Q)] (DIVIDED BY 2) 509 010472 3031 DCA TEMPR /STORE 510 010473 1420 TAD I QR /GET RE[X(Q)] 511 010474 3030 DCA ADD2 512 010475 1422 TAD I PR /AND RE[X(P)] 513 010476 7041 CIA 514 010477 4436 JMS I ADDER /FORM RE[X(Q)-X(P)] (DIVIDED BY 2) 515 010500 3422 DCA I PR /PUT AT RE[X(P)] 516 010501 1031 TAD TEMPR /GET RE[X(Q)+X(P)] 517 010502 3420 DCA I QR /PUT AT RE[X(Q)]. REAL PARTS DONE 518 010503 1046 TAD XRLOC /Q=QR-XRLOC 519 010504 7041 CIA 520 010505 1020 TAD QR /AC IS Q 521 010506 7750 SPA SNA CLA /IS Q>0? (IE-THE WHOLE ARRAY HAS NOT BEEN COVERED) 522 010507 5314 JMP CHKPT /NO. Q=0. DONE WITH FIRST ARRAY. MOVE ON TO OTHERS. 523 010510 7040 CMA /YES. Q<=Q-1. MOVE UP THIS ARRAY. 524 010511 1020 TAD QR /OR EQUIVALENTLY, QR<=QR-1 525 010512 3020 DCA QR 526 010513 5240 JMP LOOP1 /DO NEXT NODE PAIR 527 010514 1005 CHKPT, TAD L /L GIVES THE NUMBER OF THE VERTICAL ARRAY JUST BUILT 528 010515 7041 CIA 529 010516 1004 TAD NU /IS L=NU? (IE HAS THE LAST ARRAY BEEN COMPUTED?) 530 010517 7650 SNA CLA 531 010520 5600 JMP I FFT /YES. DONE. RESULTS STORED IN BIT REVERSED ORDER. 532 010521 1052 TAD SHFCHK /GET SCALE FACTOR AND ADJUST FOR PROPER 533 010522 3051 DCA SHFLAG /ADDITION ON NEXT ITERATION. 534 010523 1052 TAD SHFCHK 535 010524 7650 SNA CLA 536 010525 2050 ISZ SCALE 537 010526 3052 DCA SHFCHK 538 010527 2005 ISZ L /L<=L+1. MOVE ON TO NEXT ARRAY 539 010530 1006 TAD S /S GIVES SPACING BETWEEN NODE PAIRS, WHICH IS N/2^L 540 010531 7110 CLL RAR /DIVIDE BY 2 AND PUT BACK, SO THAT ON THE LTH PASS THROUGH 541 010532 3006 DCA S /S WILL=N/2^L, THE SPACING. 542 010533 2007 ISZ F /F<=F+1. ON LTH PASS, F WILL BE F=L-NU, THE SCALE FACTOR FOR K. 543 010534 7000 NOP /NOP FOR WHEN F=-1 TO PREVENT ERROR DUE TO SKIP 544 010535 7040 CMA /AC<=-1 545 010536 1003 TAD N 546 010537 1046 TAD XRLOC 547 010540 3022 DCA PR /P<=N-1. PR POINTS TO RE[X(P=N-1)] 548 010541 7201 SETC, CLA IAC 549 010542 3027 DCA C /C<=1. C BREAKS BUILD LOOP EVERY S ITERATIONS 550 010543 1022 BUILD, TAD PR /SO AS TO AVOID RE-COMPUTATION. 551 010544 1047 TAD XLOCDF 552 010545 3023 DCA PI 553 010546 1046 TAD XRLOC /PR=XRLOC+P 554 010547 7041 CIA 555 010550 1022 TAD PR 556 010551 3025 DCA P /ACTUAL INDEX IS P:(0,1,...,N-1) 557 010552 1007 TAD F /BUILD ARRAY. F=L-NU. SHIFT "P"-F PLACES RIGHT (=NU-L) 558 010553 7450 SNA /SHIFT ZERO PLACES? 559 010554 5363 JMP NOROT /YES. LEAVE ALONE 560 010555 7040 CMA /F COMPLEMENTED IS -F-1=-(F+1)=PLACES TO BE SHIFTED-1 561 010556 3361 DCA SHIFCT /CONTAINS -F-1 562 010557 1025 TAD P /GET NODE INDEX 563 010560 7417 LSR /SHIFT P RIGHT SHIFCT+1=-F-1+1=-F=NU-L PLACES 564 010561 7402 SHIFCT, HLT /STORAGE FOR SHIFT COUNT. 565 010562 7410 SKP /AC<=INTEGER PART [P*2^F] 566 010563 1025 NOROT, TAD P /NO ROTATION. JUST GET P=P*2^0 567 568 010564 4440 JMS I INVERT /INVERT BIT ORDER AND PUT IN K (NUMBER IN PTH NODE) 569 010565 1012 TAD MNOVR2 /SUBTRACT N/2 TO GET NUMBER IN Q (=K) (P'S NODE PAIR.) 570 010566 4442 JMS I GETRIG /GET REAL AND IMAGINARY PARTS OF W^K. 571 010567 7000 ADJSGN, NOP /SET TO CIA FOR DOING IFFT, NOP FOR FFT. 572 010570 3032 DCA SINE /SIN(2*PI*K/N)=-IM[W^K]. COS IN REGISTER COSINE. 573 010571 1422 TAD I PR /FORM (W^K)*X(P)-A COMPLEX MULTIPLICATION 574 010572 4441 JMS I MULT /DO REAL PART FIRST=RE[X(P)]*COSINE+IM[X(P)]*SINE 575 010573 0033 COSINE /AC=RE[X(P)]*COSINE=RE[X(P)]*RE[W^K] 576 010574 3030 DCA ADD2 /SAVE FOR ADDITION LATER 577 010575 1423 TAD I PI /GET IM[X(P)] 578 010576 4441 JMS I MULT 579 010577 0032 SINE /AC=IM[X(P)]*SINE=-IM[W^K]*IM[X(P)] 580 010600 1030 TAD ADD2 /AC=RE[W^K]*RE[X(P)]-IM[W^K]*IM[X(P)]=RE[X(P)*W^K] 581 010601 3034 DCA GR /STORE AT GR 582 583 /DO IMAG. PART NEXT=IM[X(P)]*COSINE-RE[X(P)]*SINE=IM[X(P)]*RE[W^K]+RE[X(P)]*IM[W^K] 584 585 010602 1423 TAD I PI 586 010603 4441 JMS I MULT /AC=IM[X(P)] 587 010604 0033 COSINE /AC=IM[X(P)]*COSINE=IM[X(P)]*RE[W^K] 588 010605 3030 DCA ADD2 /STORE FOR LATER ADDITION 589 010606 1422 TAD I PR /AC=RE[X(P)] 590 010607 4441 JMS I MULT 591 010610 0032 SINE /AC=RE[X(P)]*SINE=-RE[X(P)]*IM[W^K] 592 010611 7041 CIA /AC=RE[X(P)]*IM[W^K] 593 010612 1030 TAD ADD2 /AC=IM[X(P)]*RE[W^K]+RE[X(P)]*IM[W^K]=IM[X(P)*W^K] 594 010613 3035 DCA GI /STORE AT GI. SO GI=IM[X(P)*W^K] AND GR=RE[X(P)*W^K] G=GR+I*GI. 595 010614 1006 TAD S /LOCATE P'S NODE PAIR Q. LOCATED S=N/(2^L) UP ARRAY. 596 010615 7041 CIA /SO SET Q=P-S=INDEX OF NODE PAIR 597 010616 1022 TAD PR /LOCATE X(Q) IN MEMORY BY FIXING POINTERS QR AND QI 598 010617 3020 DCA QR /TO Q'S REAL AND IMAG. PARTS, RESPECTIVELY 599 010620 1020 TAD QR 600 010621 1047 TAD XLOCDF 601 010622 3021 DCA QI 602 010623 1420 TAD I QR /DO THE COMPLEX OPERATIONS: X(P)<=X(Q)-G;X(Q)<=X(Q)+G 603 010624 3030 DCA ADD2 /FIRST DO REAL PART OF X(P). GET RE[X(Q)] AND STORE 604 010625 1034 TAD GR /GET RE[G] 605 010626 7041 CIA 606 010627 4436 JMS I ADDER /SUBTRACT THEM. 607 010630 3422 DCA I PR /RE[X(P)]<=RE[X(Q)]-RE[G] 608 010631 1421 TAD I QI /COMPUTE IMAG. PART OF X(P). GET IM[X(Q)] 609 010632 3030 DCA ADD2 /AND STORE 610 010633 1035 TAD GI /GET IM[G] 611 010634 7041 CIA 612 010635 4436 JMS I ADDER /AND SUBTRACT THEM. 613 010636 3423 DCA I PI /IM[X(P)]<=IM[X(Q)]-IM[G]. X(P) IS NOW DONE. 614 010637 1420 TAD I QR /NEXT COMPUTE X(Q). FIRST REAL PART 615 010640 3030 DCA ADD2 /GET RE[X(Q)] AND STORE 616 010641 1034 TAD GR /GET RE[G] AND ADD TO FORM 617 010642 4436 JMS I ADDER /RE[X(Q)]+RE[G]. 618 010643 3420 DCA I QR /RE[X(Q)]<=RE[X(Q)]+RE[G]. 619 010644 1421 TAD I QI /NOW COMPUTE IMAG PART OF X(Q). GET IM[X(Q)] 620 010645 3030 DCA ADD2 /AND STORE 621 010646 1035 TAD GI /GET IM[G] AND ADD TO FORM 622 010647 4436 JMS I ADDER /IM[X(Q)]+IM[G] 623 010650 3421 DCA I QI /IM[X(Q)]<=IM[X(Q)]+IM[G]. THE NEW NODE PAIR IS COMPUTED. 624 010651 7040 CMA /MOVE UP ARRAY TO NEXT NODE. SET AC=-1 625 010652 1025 TAD P /TO FORM P-1 626 010653 3025 DCA P /P<=P-1 627 010654 7040 CMA 628 010655 1022 TAD PR /DO THE SAME FOR POINTER PR 629 010656 3022 DCA PR 630 010657 1027 TAD C /CHECK ON SPACING. IS A NODE WHICH HAS ALREADY BEEN COMPUTED 631 010660 7041 CIA /ABOUT TO BE RE-DONE, OR EQUIVALENTLY, 632 010661 1006 TAD S /IS C=S? 633 010662 7640 SZA CLA /YES. 634 010663 5276 JMP CNOTS /NO. DO NEXT NODE PAIR 635 010664 1025 TAD P /YES. BUT ARE WE AT THE TOP OF THE ARRAY? 636 010665 7040 CMA /OR, IS S=P+1? (P COMPLEMENTED=-P-1=-(P+1) 637 010666 1006 TAD S 638 010667 7650 SNA CLA 639 010670 5702 JMP I RECHK /YES. DONE WITH THIS ARRAY. DO NEXT ONE. 640 010671 1006 TAD S /NO. MOVE PAST AREA THAT HAS ALREADY BEEN DONE, OR SET P TO P-S. 641 010672 7041 CIA /BY CHANGING THE POINTER TO RE[X(P)] 642 010673 1022 TAD PR 643 010674 3022 DCA PR 644 010675 5701 JMP I RESETC /REINITIALIZE C TO 1 SINCE AN UNUSED AREA HAS BEEN ENTERED. 645 646 010676 2027 CNOTS, ISZ C /C<=C+1. ANOTHER NODE PAIR HAS BEEN HANDLED. 647 010677 5700 JMP I RBUILD /DO NEXT NODE PAIR IN THIS AREA. 648 010700 0543 RBUILD, BUILD /POINTERS TO RETURN LOCATIONS. 649 010701 0541 RESETC, SETC /WHICH ARE LOCATED ON 650 010702 0514 RECHK, CHKPT /ANOTHER PAGE. 651 010703 0000 SORTX, 0 /SUBROUTINE THAT 652 010704 7040 CMA /SORTS OUT TRANSFORMS BY 653 010705 1003 TAD N /BIT INVERSION OF ADDRESS. 654 010706 3024 DCA Q /Q<=N-1. START FROM BOTTOM OF BUFFER 655 010707 1024 REVERS, TAD Q /P<=BIT INVERTED Q 656 010710 4440 JMS I INVERT /BIT INVERSION ROUTINE 657 010711 3025 DCA P 658 010712 1025 TAD P /FORM Q-P 659 010713 7041 CIA 660 010714 1024 TAD Q 661 010715 7750 SPA SNA CLA /IS P0? 730 011003 7061 CMA CML IAC /NO. MAKE POSITIVE. SET LINK=1 TO SHOW IT WAS NEGATIVE. 731 011004 7421 MQL /LOAD INTO MQ 732 011005 1600 TAD I MULTIP /GET ADDRESS OF MULTIPLICAND 733 011006 3217 DCA ARG2 /STORE 734 011007 1617 TAD I ARG2 /AND RETRIEVE MULTIPLICAND ITSELF. 735 011010 2200 ISZ MULTIP /(FOR EXIT AT CALL+2) 736 011011 7510 SPA /ARG2>0? 737 011012 7061 CMA CML IAC /NO. MAKE POSITIVE. CHANGE LINK,SINCE-1+-1=1 AND -1+1=-1 738 011013 3217 DCA ARG2 /PUT AWAY AT ARG2 739 011014 7004 RAL /SIGN IN LINK. PUT INTO AC11 AND 740 011015 3235 DCA SIGN /PUT AWAY AT SIGN (= 1 IF -; =0 IF +) 741 011016 7405 MUY /DO MULTIPLICATION 742 011017 7402 ARG2, HLT /ARGUMENT 2 (MULTIPLICAND) 743 011020 7413 SHL /NORMALIZE BINARY POINT. 744 011021 0000 0 745 011022 3217 DCA ARG2 /SAVE HIGH ORDER. NOW ROUND OFF. 746 011023 7413 SHL /SET AC11=MQ0,AC0-10=0 747 011024 0000 0 748 011025 7421 MQL 749 011026 1235 TAD SIGN /RESTORE PROPER SIGN 750 011027 7110 CLL RAR /PUT SIGN IN LINK 751 011030 1217 TAD ARG2 /BRING BACK RESULT 752 011031 7501 MQA /RESULT=(HIGH ORDER) .OR. (BIT 0 OF LOW ORDER) 753 011032 7430 SZL /POSITIVE SIGN? 754 011033 7041 CMA IAC /NO. NEGATE 755 011034 5600 JMP I MULTIP /EXIT. SIGNED RESULT IN AC. 756 011035 0000 SIGN, 0 757 758 759 760 761 762 /BIT INVERSION ROUTINE 763 /ENTRY: AC=WORD TO BE INVERTED; EXIT:AC=RESULT 764 /NU CONTAINS THE NUMBER OF BITS IN THE WORD 765 011036 0000 INVRT, 0 766 011037 3256 DCA WORD /GET WORD TO BE INVERTED 767 011040 3257 DCA WORDP /ZERO OBJECT REGISTER 768 011041 1004 TAD NU /GET NUMBER OF BITS TO BE 769 011042 7041 CIA /INVERTED AND USE TO LIMIT THE 770 011043 3260 DCA FLIPCT /EXTENT OF LOOP 771 011044 1256 FLIP, TAD WORD /PULL OUT RIGHTMOST BIT OF WORD 772 011045 7110 CLL RAR /(RIGHT MOST BIT NOW IN LINK) 773 011046 3256 DCA WORD /(PUT BACK SO A NEW BIT IS OPERATED ON EACH TIME) 774 011047 1257 TAD WORDP /AND PUSH INTO WORDP FROM LEFT 775 011050 7004 RAL 776 011051 3257 DCA WORDP 777 011052 2260 ISZ FLIPCT /ALL BITS DONE? 778 011053 5244 JMP FLIP /NO. DO NEXT BIT 779 011054 1257 TAD WORDP /YES. PICK UP RESULT 780 011055 5636 JMP I INVRT /AND EXIT 781 011056 0000 WORD, 0 782 011057 0000 WORDP, 0 783 011060 0000 FLIPCT, 0 784 785 /THIS SUBROUTINE FETCHES THE VALUES OF SIN(2*PI*C(AC)/N) 786 /AND OF COS(2*PI*C(AC)/N) FOR C(AC) < N/2+1 787 /ENTRY: AC=INDEX OF LOOK UP 788 /EXIT : COS(2*PI*C(AC)/N) STORED AT "COSINE" AND 789 / AC=VALUE OF SIN(2*PI*C(AC)/N). 790 791 011061 0000 TRIGET, 0 792 011062 3026 DCA K /STORE C(AC) AT K. 793 011063 7421 MQL /CLEAR MQ 794 011064 1026 TAD K /FORM N/4-K. 795 011065 7141 CLL CIA 796 011066 1010 TAD NOVER4 797 011067 3332 DCA NO4MIK 798 011070 7430 SZL /IS N/4-K<0? 799 011071 5310 JMP QUAD1 /NO. FIRST QUADRANT ANGLE. 800 011072 1332 QUAD2, TAD NO4MIK /2ND QUADRANT. GET -COS AT K-N/4. 801 011073 7041 CIA 802 011074 7417 LSR /MAKE CORRECTIVE RIGHT SHIFT ON INDEX. 803 011075 0000 0 804 011076 7413 SHL /FIND ON SINE TABLE FOR 2^MAXNU BY MULTIPLYING 805 011077 7402 SHFT1, HLT /INDEX BY 2^(MAXNU-NU), WHICH IS STORED HERE. 806 011100 1045 TAD SINLOC /LOCATE IT IN MEMORY. 807 011101 3333 DCA INDEX 808 011102 1733 TAD I INDEX 809 011103 7041 CIA /2ND QUADRANT COS IS NEGATIVE. 810 011104 3033 DCA COSINE 811 011105 1332 TAD NO4MIK /GET SIN AT N/2-K 812 011106 1010 TAD NOVER4 813 011107 5322 JMP SINRET 814 815 011110 1332 QUAD1, TAD NO4MIK /GET COS AT N/4-K. 816 011111 7417 LSR 817 011112 0000 0 818 011113 7413 SHL 819 011114 7402 SHFT2, HLT 820 011115 1045 TAD SINLOC 821 011116 3333 DCA INDEX 822 011117 1733 TAD I INDEX 823 011120 3033 DCA COSINE 824 011121 1026 TAD K /GET SIN AT K. 825 011122 7417 SINRET, LSR 826 011123 0000 0 827 011124 7413 SHL 828 011125 7402 SHFT3, HLT 829 011126 1045 TAD SINLOC 830 011127 3333 DCA INDEX 831 011130 1733 TAD I INDEX /AC= SIN VALUE. 832 011131 5661 JMP I TRIGET 833 834 011132 0000 NO4MIK, 0 /STORAGE FOR N/4-K 835 011133 0000 INDEX, 0 /POINTER TO SINE TABLE 836 837 838 /THIS ROUTINE PERFORMS A SINGLE PRECISION ADD WITH ROUNDING. EACH ARGUMENT IS 839 /SHIFTED RIGHT ONCE TO PREVENT OVERFLOW OF BINARY POINT (IF NECESSARY) 840 /AND THEN CHECKED TO SEE IF IT CAN BE NORMALIZED AFTER ADDITION 841 /ENTRY: AC=ADDEND,C(ADD2)=AUGEND 842 /EXIT : AC=RESULT, DIVIDED BY TWO IF NECESSARY. 843 844 011134 0000 ADDR, 0 845 011135 3373 DCA ADD1 846 011136 1051 TAD SHFLAG /SHOULD ADD BE DONE WITH SHIFT? 847 011137 7650 SNA CLA 848 011140 5356 JMP ADDWOS /NO. DO ADD WITH OUT SHIFT 849 011141 1373 TAD ADD1 /YES. GET ADDEND 850 011142 7415 ASR /DO 1 SIGNED RIGHT SHIFT 851 011143 0000 0 /MQ0=LOW ORDER (LO) OF ADD1 852 011144 3373 DCA ADD1 853 011145 1030 TAD ADD2 854 011146 7415 ASR /MQ0=LO(ADD2) 855 011147 0000 0 /MQ1=LO(ADD1) 856 011150 3030 DCA ADD2 857 011151 7501 MQA /GET MQ 858 011152 7004 RAL /L<=LO(ADD2); AC0<=LO(ADD1) 859 011153 7060 CMA CML /COMPLEMENT BOTH. 860 011154 7720 SMA SNL CLA /IF BOTH WERE=1 (NEITHER=0), INTRODUCE A CARRY. 861 011155 7001 IAC 862 011156 1373 ADDWOS, TAD ADD1 /DO THE ADDITION. 863 011157 1030 TAD ADD2 864 011160 3374 DCA XSUM /STORE THE RESULT 865 011161 1374 TAD XSUM /CHECK TO SEE IF ALREADY NORMALIZED. 866 011162 7510 SPA /IS IT POSITIVE? 867 011163 7041 CIA /MAKE IT POSITIVE. 868 011164 7004 RAL /GET BIT 1. WAS NORMALIZED IF =1 869 011165 7700 SMA CLA 870 011166 5371 JMP NOTNOR /NOT NORMALIZED. LEAVE SHFCHK ALONE. 871 011167 7001 IAC 872 011170 3052 DCA SHFCHK /SET SHFCHK=1 873 011171 1374 NOTNOR, TAD XSUM 874 011172 5734 JMP I ADDR /AND EXIT 875 876 011173 0000 ADD1, 0 /ADDEND STORAGE. 877 011174 0000 XSUM, 0 /TEMPORARY STORAGE FOR SUM. 878 879 880 881 /TABLE OF VALUES OF SIN (2*3.14159*I/1024) FOR I FROM 882 /0 TO 256 INCLUSIVE. 883 884 011175 0000 SINTAB, 0000 885 011176 0015 0015 886 011177 0031 0031 887 011200 0046 0046 888 011201 0062 0062 889 011202 0077 0077 890 011203 0113 0113 891 011204 0130 0130 892 011205 0144 0144 893 011206 0161 0161 894 011207 0176 0176 895 011210 0212 0212 896 011211 0227 0227 897 011212 0243 0243 898 011213 0260 0260 899 011214 0274 0274 900 011215 0311 0311 901 011216 0325 0325 902 011217 0342 0342 903 011220 0356 0356 904 011221 0373 0373 905 011222 0407 0407 906 011223 0424 0424 907 011224 0440 0440 908 011225 0455 0455 909 011226 0471 0471 910 011227 0505 0505 911 011230 0522 0522 912 011231 0536 0536 913 011232 0553 0553 914 011233 0567 0567 915 011234 0603 0603 916 011235 0620 0620 917 011236 0634 0634 918 011237 0650 0650 919 011240 0664 0664 920 011241 0701 0701 921 011242 0715 0715 922 011243 0731 0731 923 011244 0745 0745 924 011245 0762 0762 925 011246 0776 0776 926 011247 1012 1012 927 011250 1026 1026 928 011251 1042 1042 929 011252 1056 1056 930 011253 1072 1072 931 011254 1106 1106 932 011255 1123 1123 933 011256 1137 1137 934 011257 1153 1153 935 011260 1166 1166 936 011261 1202 1202 937 011262 1216 1216 938 011263 1232 1232 939 011264 1246 1246 940 011265 1262 1262 941 011266 1276 1276 942 011267 1312 1312 943 011270 1325 1325 944 011271 1341 1341 945 011272 1355 1355 946 011273 1370 1370 947 011274 1404 1404 948 011275 1420 1420 949 011276 1433 1433 950 011277 1447 1447 951 011300 1462 1462 952 011301 1476 1476 953 011302 1511 1511 954 011303 1525 1525 955 011304 1540 1540 956 011305 1554 1554 957 011306 1567 1567 958 011307 1602 1602 959 011310 1616 1616 960 011311 1631 1631 961 011312 1644 1644 962 011313 1657 1657 963 011314 1672 1672 964 011315 1705 1705 965 011316 1720 1720 966 011317 1734 1734 967 011320 1747 1747 968 011321 1761 1761 969 011322 1774 1774 970 011323 2007 2007 971 011324 2022 2022 972 011325 2035 2035 973 011326 2050 2050 974 011327 2062 2062 975 011330 2075 2075 976 011331 2110 2110 977 011332 2122 2122 978 011333 2135 2135 979 011334 2147 2147 980 011335 2162 2162 981 011336 2174 2174 982 011337 2207 2207 983 011340 2221 2221 984 011341 2233 2233 985 011342 2246 2246 986 011343 2260 2260 987 011344 2272 2272 988 011345 2304 2304 989 011346 2316 2316 990 011347 2330 2330 991 011350 2342 2342 992 011351 2354 2354 993 011352 2366 2366 994 011353 2400 2400 995 011354 2411 2411 996 011355 2423 2423 997 011356 2435 2435 998 011357 2447 2447 999 011360 2460 2460 1000 011361 2472 2472 1001 011362 2503 2503 1002 011363 2515 2515 1003 011364 2526 2526 1004 011365 2537 2537 1005 011366 2551 2551 1006 011367 2562 2562 1007 011370 2573 2573 1008 011371 2604 2604 1009 011372 2615 2615 1010 011373 2626 2626 1011 011374 2637 2637 1012 011375 2650 2650 1013 011376 2661 2661 1014 011377 2672 2672 1015 011400 2703 2703 1016 011401 2713 2713 1017 011402 2724 2724 1018 011403 2734 2734 1019 011404 2745 2745 1020 011405 2755 2755 1021 011406 2766 2766 1022 011407 2776 2776 1023 011410 3007 3007 1024 011411 3017 3017 1025 011412 3027 3027 1026 011413 3037 3037 1027 011414 3047 3047 1028 011415 3057 3057 1029 011416 3067 3067 1030 011417 3077 3077 1031 011420 3107 3107 1032 011421 3117 3117 1033 011422 3126 3126 1034 011423 3136 3136 1035 011424 3145 3145 1036 011425 3155 3155 1037 011426 3164 3164 1038 011427 3174 3174 1039 011430 3203 3203 1040 011431 3212 3212 1041 011432 3222 3222 1042 011433 3231 3231 1043 011434 3240 3240 1044 011435 3247 3247 1045 011436 3256 3256 1046 011437 3265 3265 1047 011440 3274 3274 1048 011441 3302 3302 1049 011442 3311 3311 1050 011443 3320 3320 1051 011444 3326 3326 1052 011445 3335 3335 1053 011446 3343 3343 1054 011447 3351 3351 1055 011450 3360 3360 1056 011451 3366 3366 1057 011452 3374 3374 1058 011453 3402 3402 1059 011454 3410 3410 1060 011455 3416 3416 1061 011456 3424 3424 1062 011457 3432 3432 1063 011460 3440 3440 1064 011461 3445 3445 1065 011462 3453 3453 1066 011463 3460 3460 1067 011464 3466 3466 1068 011465 3473 3473 1069 011466 3501 3501 1070 011467 3506 3506 1071 011470 3513 3513 1072 011471 3520 3520 1073 011472 3525 3525 1074 011473 3532 3532 1075 011474 3537 3537 1076 011475 3544 3544 1077 011476 3551 3551 1078 011477 3556 3556 1079 011500 3562 3562 1080 011501 3567 3567 1081 011502 3573 3573 1082 011503 3600 3600 1083 011504 3604 3604 1084 011505 3610 3610 1085 011506 3614 3614 1086 011507 3621 3621 1087 011510 3625 3625 1088 011511 3631 3631 1089 011512 3635 3635 1090 011513 3640 3640 1091 011514 3644 3644 1092 011515 3650 3650 1093 011516 3653 3653 1094 011517 3657 3657 1095 011520 3662 3662 1096 011521 3666 3666 1097 011522 3671 3671 1098 011523 3674 3674 1099 011524 3700 3700 1100 011525 3703 3703 1101 011526 3706 3706 1102 011527 3711 3711 1103 011530 3713 3713 1104 011531 3716 3716 1105 011532 3721 3721 1106 011533 3724 3724 1107 011534 3726 3726 1108 011535 3731 3731 1109 011536 3733 3733 1110 011537 3735 3735 1111 011540 3740 3740 1112 011541 3742 3742 1113 011542 3744 3744 1114 011543 3746 3746 1115 011544 3750 3750 1116 011545 3752 3752 1117 011546 3754 3754 1118 011547 3755 3755 1119 011550 3757 3757 1120 011551 3761 3761 1121 011552 3762 3762 1122 011553 3764 3764 1123 011554 3765 3765 1124 011555 3766 3766 1125 011556 3767 3767 1126 011557 3770 3770 1127 011560 3771 3771 1128 011561 3772 3772 1129 011562 3773 3773 1130 011563 3774 3774 1131 011564 3775 3775 1132 011565 3776 3776 1133 011566 3776 3776 1134 011567 3777 3777 1135 011570 3777 3777 1136 011571 3777 3777 1137 011572 3777 3777 1138 011573 3777 3777 1139 011574 3777 3777 1140 011575 3777 3777 1141 1142 1143 *1600 1144 1145 011600 0000 XRTAB, 0 /DATA BUFFER FOR REAL PARTS 1146 1147 *XRTAB+2000 1148 1149 013600 0000 XITAB, 0 /DATA BUFFER FOR IMAGINARY PARTS 1150 1151 DATAHI=XITAB+2000 /FIRST LOCATION AVAILABLE FOR PROGRAMMING 1152 1153 1154 1155 1156 /DEFINITIONS FOR EAE 1157 DVI=7407 1158 NMI=7411 1159 SHL=7413 1160 ASR=7415 1161 LSR=7417 1162 MQL=7421 1163 MUY=7405 1164 MQA=7501 1165 CAM=7621 1166 SCA=7441 1167 SCL=7403 1168 1169 /ASSEMBLY PARAMETERS 1170 BIGSNU=12 /LARGEST TABLE HAS DIMENSION 2^10. 1171 1172 1173 1174 1175 /FOLLOWING IS PATCH TO CORRECT BUT IN FFTS-C: 1176 *1014 1177 011014 7010 RAR 1178 011015 3235 DCA SIGN 1179 011016 7405 MUY 1180 011017 7402 ARG2, HLT 1181 011020 7413 SHL 1182 011021 0000 0 1183 011022 3217 DCA ARG2 1184 011023 1235 TAD SIGN 1185 011024 7413 SHL 1186 011025 0000 0 1187 011026 1217 TAD ARG2 1188 011027 7510 SPA 1189 011030 7350 CLL STA RAR 1190 011031 7000 NOP 1191 011032 7430 SZL 1192 011033 7041 CIA 1193 011034 5600 JMP I MULTIP 1194 011035 0000 SIGN, 0 1195 1196 $ ADD1 1173 ADD2 0030 ADDER 0036 ADDR 1134 ADDWOS 1156 ADJSGN 0567 AR3 0522 ARG2 1017 AUTO 0013 BEGDIS 0222 BIGSNU 0012 BLOCK 0140 BUILD 0543 C 0027 CALL 14400 CAM 7621 unreferenced CCIA 0767 CHKPT 0514 CIAC 0275 CLRR 3540 CNOP 0770 CNOTS 0676 CNP 0542 CNT 0272 CNTR 0126 COSINE 0033 CRLFD 4427 unreferenced DATAHI 5600 unreferenced DFT 0200 DFT0 0403 DIFT 0203 DIFT0 0407 DISPLA 5466 DOFFT 0043 DOIFFT 0044 DP 0057 F 0007 FFT 0400 FIXT 4421 FLIP 1044 FLIPCT 1060 FLOAT 4420 FLOUT 4406 FTEM1 0142 unreferenced FTOFST 0167 GETNO 4422 GETRIG 0042 GI 0035 GR 0034 HANM 0221 HDPR 3726 HDS 3716 HDSA 3732 HEDIT1 4430 HNSM 0211 IFFT 0756 INDEX 1133 INITAR 4425 INS1 0546 INST 0247 INVERT 0040 INVRT 1036 K 0026 K1000 0124 KP12 0427 L 0005 LOOP1 0440 M1 0462 M13 0363 MAXNU 0011 MIDSET 0311 ML1 0314 ML1A 0325 ML1B 0330 ML2 0350 MM1 0271 MNOVR2 0012 MPD 0471 MSH 0343 MULT 0041 MULTIP 1000 N 0003 NO4MIK 1132 NOROT 0563 NOTNOR 1171 NOVER4 0010 NPTS 0070 NU 0004 P 0025 PI 0023 PLP 0447 PMUL 0463 POWR 0437 PR 0022 PSH 0473 PSTR 0277 PTS1 0431 PW2 0430 Q 0024 QI 0021 QR 0020 QUAD1 1110 QUAD2 1072 unreferenced QUERY 0032 RBUILD 0700 RECHK 0702 RESETC 0701 REVERS 0707 RLSM 0215 RSTPT 0004 RSTPTS 0432 RTP 0276 S 0006 SAVE 0476 SCALE 0050 SCPINT 0230 SET3 7325 SETC 0541 SETM2 7344 unreferenced SETOFF 0547 SGNADJ 0766 SHAN 0543 SHAV 0541 SHFCHK 0052 SHFLAG 0051 SHFT1 1077 SHFT2 1114 SHFT3 1125 SHIFCT 0561 SHIFT1 0053 SHIFT2 0054 SHIFT3 0055 SIGN 1035 SINE 0032 SINLOC 0045 SINRET 1122 SINT 0461 SINTAB 1175 SMCHK 0523 SMGO 0237 SMOT11 3025 SORT 0037 SORTX 0703 SPINIT 3014 STPT 0412 STPTS 0003 SVE 0515 SWAPED 0747 TEM3 0134 TEMFP 0150 unreferenced TEMP 0131 TEMP1 0132 TEMPR 0031 TMP 0273 TMPX 0274 TMPY 0270 TRET 3735 TRIGET 1061 WORD 1056 WORDP 1057 XITAB 3600 XLOCDF 0047 XRLOC 0046 XRTAB 1600 XSUM 1174 YIND 0011 ZAP 0406 ZAPIT 0400 ZIND 0012