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