Directory of image this file is from
This file as a plain text file
*20 /FFTS-REAL /THIS IS A PROGRAM FOR CALCULATING THE /FAST FOURIER TRANSFORMATION OF N REAL /TIME SAMPLES WHICH ARE STORED ON DIAL /OR DATA TAPE OR DISK /TO BE RUN ON A PDP-12 COMPUTER EQUIPPED/WITH THE FOLLOWING MINIMUM HARDWARE: / 1) ASR 33 OR ASR 35 TELETYPE / 2) 8 K OF CORE MEMORY / 3) VR12 CRT DISPLAY / /COPYRIGHT 1970, DIGITAL EQUIPMENT CORPORATION / MAYNARD, MASS, 01754 /TRANSFORM ALGORITHM /WRITTEN BY JAMES ROTHMAN -- AUGUST, 1968 QARFSH=1053 QAINIT=1000 XRTAB=0 XITAB=2000 SINTAB=7347 CDF1=6211 CDF0=6201 PMODE /PAGE ZERO *3 /TABLE PARAMETERS N, 0 /NUMBER OF POINTS IN COMPUTAION DIVIDED BY 2 NU, 0 /POWER OF TWO OF POINTS IN COMPUTATION (N=2^NU) MINUS 1 L, 0 /INDEX TO SHOW WHAT ARRAY IS BEING CONSTRUCTED S, 0 /GIVES SPACING BETWEEN NODE PAIRS IN THE LTH ARRAY. F, 0 /USED FOR SCALING NODE POSITION TO GET NUMBER IN NODES. *20 NOVER4, 0 /STORAGE FOR N/4 MAXNU, BIGSNU /LARGEST TABLE SIZE (POWER OF 2) MNOVR2, 0 /STORAGE FOR -N/2 /INDEXING VARIABLES QR, 0 /POINTER TO REAL PART OF X(Q) QI, 0 /POINTER TO IMAG, PART OF X(Q) PR, 0 /POINTER TO REAL PART OF X(P) PI, 0 /POINTER TO IMAG, PART OF X(P) Q, 0 /NUMERICAL INDEX Q(=0,1,...N-1) P, 0 /NUMBERICAL INDEX P(=0,1,...N-1) K, 0 /NUMBER IN THE NODE BEING OPERATED ON /LOOP DELIMITERS C, 0 /INTERRUPTS COMPUTATION OF LTH ARRAY EVERY S PASSES /DATA VARIABLES ADD2, 0 /USED BY SUBROUTINE ADDR AS DATA (ADDEND) TEMPR, 0 /TEMPORARY STORAGE REGISTER FOR REAL PARTS SINE, 0 /TEMP. STORAGE FOR SIN (S*PI*K/N) COSINE, 0 /TEMP. STORAGE FOR COS (2*PI*K/N) GR, 0 /REAL PART OF PRODUCT (W^K)*X(P), TEMP STORAGE GI, 0 /IMAG. PART OF (W^K)*X(P). TEMP STORAGE /SUBROUTINE CALL LIST ADDER, ADDR /ADD C(AC) TO C(ADD2) AND SCALE RIGHT ONE IF NECESSARY. SORT, SORTX /BIT INVERTED BUFFER SORTED INVERT, INVRT /WORD IN AC OF NU BITS IS BIT INVERTED MULT, MULTIP GETRIG, TRIGET /FETCH SIN AND COS OF 2*PI*C(AC)/N DOFFT, FFT /DO FFT OF THE INPUT BUFFER DOIFFT, IFFT /DO INVERSE OF BUFFER SINLOC, SINTAB XRLOC, XRTAB /INPUT BUFFER AND TABLE OF ARRAYS XLOCDF, XITAB-XRTAB /DIFF IN ADDR OF REAL & IMAG PART TABLES /PSEUDO FLOATING POINT FORMAT FLAGS SCAL, 0 /PSEUDO EXPONENT OF FOURIER COEFFICIENTS SHFLAG, 1 /IF =1, ADD WITH SHIFT; IF=0, ADD WITHOUT SHIFT SHFCHK, 0 /INDICATES IF ALL XS IN AN ITERATION ARE <.5 /POINTERS TO SINE TABLE LOOK-UP SHIFTS SHIFT1, SHFT1 /THE NUMBER 10-NU MUST BE PLACED SHIFT2, SHFT2 /IN EACH OF THESE LOCATIONS SHIFT3, SHFT3 /POINTERS TO INSTRUCTION "FLAG" LOCATIONS WORD, 0 WORDP, 0 FLIPCT, 0 / RBUILD, BUILD RESETC, SETC RECHK, CHKPT M4000, -4000 M1, -1 M12, -12 M10, -10 GRET10, 6160 LESS10, 4060 M4, -4 PDPMAG, DPMAG M11, -11 M5, -5 C6000, 6000 M215, -215 M321, -321 M353, -353 M340, -340 M261, -261 M400, -400 C1777, 1777 YSHFT, 0 XCURHI, 0 XCURLO, 0 CORVAL, 0 YCUR, 0 COUNT, 0 KIDORA, IDORA KRDORA, RDORA PSHOWT, SHOWIT PRFRSH, RFRSH PFDV7, FDV+7 PMVDIS, MOVDIS PLEFTX, LEFTX PMRLMG, MVRLMG PMVPTS, MOVPTS CMPFLG, 0 MINPTS, 0 PRELFG, REALFG PIFTFG, IFTFLG PREAD, 7774 PWRITE, 7775 KYSCAL, YSCAL C1000, 1000 C2000, 2000 M1K, 6777 /-1000 1,S COMP DPSQ, 0 /D.P. SQUARE 0 LMODE LDF4, LDF 4 SCR4, SCR 4 CCLR, CLR PMODE EJECT /THIS SUBROUTINE TAKES THE INVERSE FFT (IFFT) OF THE DATA IN THE BUFFER. /IT IS ASSUMED THAT THIS DATA IS STORED SEQUENTIAL ORDER. /THE RESULTS ARE STORED IN BIT INVERTED ORDER. /THE ALGORITHM USED IS AS FOLLOWS: / THE NORMAL TRANSFORM IS PERFORMED, EXCEPT: / ON FETCHING THE VALUE FOR IM[W^K], WHICH IS / THE SIN(2*PI*K/N), THIS SIN VALUE IS NEGATED. / /THE REASONING FOR THIS IS AS FOLLOWS: / A WEIGHTING FACTOR OF W^8-K) IS USED IN THE IFFT / AND SINCE W^K AND W^(-K) ARE THE SAME EXCEPT THAT / THEIR IMAGINARY PARTS HAVE OPPOSITE SIGNS, IT FOLLOWS / THAT IM]W^K] SHOULD BE REPLACED BY -IM[W^K]. IFFT, 0 CLA CLL TAD CCIA /NEGATE IM[W^K], GET CIA INSTRUCTION DCA I SGNADJ /AND PUT AT LOCATION ADJSN JMS I DOFFT /DU FFT CDF0 TAD CNOP /RE-INSTATE NOP AT ADJSGN FOR FFT. DCA I SGNADJ CDF1 JMP I IFFT /EXIT SGNADJ, ADJSGN /POINTER TO SIGN ADJUST INSTRUCTION CCIA, CIA CNOP, NOP EJECT *400 /COMPUTATION OF FIRST COMPLEX ARRAY FROM INPUT DATA /NUMBER OF INPUT POINTS IN "N" .LOG(2)(N)IN"NU". FOR DETAILS OF ALGORITHM, SEE FLOWCHART FFT, 0 CLA IAC CLL DCA L /L<=1 DCA SCAL /INITIALIZE FLOATING POINT FORMAT IAC DCA SHFLAG DCA SHFCHK TAD N CLL RTR /INITIALIZE PROGRAM CONSTANTS DCA NOVER4 TAD NU CIA TAD MAXNU DCA I SHIFT1 TAD I SHIFT1 DCA I SHIFT2 TAD I SHIFT2 DCA I SHIFT3 TAD N CLL RAR DCA S /S<=N/2 IS SPACING OF NODE PAIRS IN FIRST ARRAY TAD S CIA DCA MNOVR2 CMA /AC<=-1 TAD S /AC<=[N/2-1]*2 TAD XRLOC /BEGINNING OF TABLE OF REAL PARTS. DCA QR /Q<=N/2-1, QR POINTS TO WORD IN MEMORY, WHILE Q IS ACTUAL INDEX TAD NU CIA IAC DCA F /F<=1-NU (=L-NU SINCE L=1) LOOP1, TAD QR /QR=XRLOC+Q AT ALL TIMES. TAD S DCA PR /P<=Q+N/2 TAD QR /XLOCDF=XILOC-XRLOC (XILOC=BEGIN, OF IMAG PARTS TABLE) TAD XLOCDF /QR+XLOCDF=(S+XRLOC)+(XILOC-XRLOC)=XILOC+S=QI DCA QI /QI=XILOC+Q AT ALL TIMES, QI POINTS TO IMAG. PART OF X(Q) TAD PR TAD XLOCDF /COMPUTE COMPLEX OPERATIONS X(P)<=X(Q)-X(P) AND X(Q)<=X(Q)+X(P) DCA PI /BY REAL AND IMAGINARY PARTS. CDF1 TAD I QI /IM(X(Q)) (IM () MEANS IMAGINARY PART) DCA ADD2 /MAKE IT ADDEND, DO IMAG. PARTS FIRST TAD I PI /IM(X(P)) JMS I ADDER /FORM ADDITION IM[X(P)+X(Q)]=IM[X(P)]+IM[X(Q)] AND SCALE RIGHT DCA TEMPR /FOR SCALING, THEN STORE. TAD I QI /FORM DIFFERENCE IM[X(Q)-X(P)]=IM[X(Q)]-IM[X(P)] DCA ADD2 TAD I PI CIA JMS I ADDER DCA I PI /PUT AWAY AT IM[X(P)] TAD TEMPR /GET IM[X(P)+X(Q)] DCA I QI /PUT AT IM[X(Q)], IMAGINARY PARTS DONE, TAD I QR /ADD REAL PARTS NEXT DCA ADD2 TAD I PR /RE=REAL PART JMS I ADDER /FORM RE[X(P)+X(Q)]=RE[X(P)]+RE[X(Q)] (DIVIDED BY 2) DCA TEMPR /STORE TAD I QR /GET RE[X(Q)] DCA ADD2 TAD I PR /RE=REAL PART CIA JMS I ADDER /FORM RE[X(Q)-(P)] (DIVIDED BY 2) DCA I PR /PUT AT RE[X(P)] TAD TEMPR /GET RE[X(Q)+X(P)] DCA I QR /PUT AT RE[X(Q)],REAL PARTS DONE TAD XRLOC /Q=QR-XRLOC CIA TAD QR /AC IS Q SPA SNA CLA /IS Q>0? (IE THE WHOLE ARRAY HAS NOT BEEN COVERED) JMP CHKPT /NO, Q=0, DONE WITH FIRST ARRAY, MOVE ON TO OTHERS CMA /YES, Q<=Q-1, MOVE UP THIS ARRAY TAD QR /OR EQUIVALENTLY, QR<=QR-1 DCA QR JMP LOOP1 /DO NEXT NODE PAIR CHKPT, TAD L /L GIVES THE NUMBER OF THE VERTICAL ARRAY JUST BUILT CIA TAD NU /IS L=NU? (IE HAS THE LAST ARRAY BEEN COMPUTED?) SNA CLA JMP I FFT /YES, DONE, RESULTS STORED IN BIT REVERSED ORDER TAD SHFCHK /GET SCALE FACTOR AND ADJUST FOR PROPER DCA SHFLAG /ADDITION ON NEXT ITERATION TAD SHFCHK SNA CLA ISZ SCAL DCA SHFCHK ISZ L /L<=L+1, MOVE ON TO NEXT ARRAY TAD S /S GIVES SPACING BETWEEN NODE PAIRS, WHICH IS N/2^L CLL RAR /DIVIDE BY 2 AND PUT BACK, SO THAT ON THE LTH PASS THROUGH DCA S /S WILL=N/2^L, THE SPACING. ISZ F /F<=F+1, ON LTH PASS, F WILL BE F=L-NU, THE SCALE FACTOR FOR K. NOP /NOP FOR WHEN F=-1 TO PREVENT ERROR DUE TO SKIP CMA /AC<=-1 TAD N TAD XRLOC DCA PR /P<=N-1, PR POINTS TO RE[X(P=N-1)] SETC, CLA IAC DCA C /C<=1, C BREAKS BUILD LOOP EVERY S ITERATIONS BUILD, TAD PR /SO AS TO AVOID RECOMPUTATION TAD XLOCDF DCA PI TAD XRLOC /PR=XRLOC+P CIA TAD PR DCA P /ACTUAL INDEX IS P:(0,1,,,,,N-1) TAD F /BUILD ARRAY, F=L-NU, SHIFT "P"-F PLACES RIGHT (=NU-L) SNA /SHIFT ZERO PLACES? JMP NOROT /YES, LEAVE ALONE CMA /F COMPLEMENTED IS -F-(1)=-(F+1)=PLACES TO BE SHIFTED-1 DCA SHIFCT /CONTAINS-F-1 TAD P /GET NODE INDEX LSR /SHIFT P RIGHT SHIFCT+1=-F-1+1=-F=NU-L PLACES SHIFCT, HLT /STORAGE FOR SHIFT COUNT. SKP /AC<=INTEGER PART [P*2^F] NOROT, TAD P /NO ROTATION, JUST GET P=P*2^0 JMS I INVERT /INVERT BIT ORDER AND PUT IN K (NUMBER IN PTH NODE) TAD MNOVR2 /SUBTRACT N/2 TO GET NUMBER IN Q (=K) (PS NODE PAIR.) JMS I GETRIG /GET REAL AND IMAGINARY PARTS OF W+K. ADJSGN, NOP /SET TO CIA FOR DOING IFFT, NOP FOR FFT. DCA SINE /SIN(2*PI*K/N)=-IM[W^K], COS IN REGISTER COSINE. TAD I PR /FORM (W^K)*X(P)-A COMPLEX MULTIPLICATION JMS I MULT /DO REAL PART FIRST=RE[X(P)]*COSINE+IM[X(P)]*SINE COSINE /AC=RE[X(P)]*COSINE=RE[X(P)]*RE[W^K] DCA ADD2 /SAVE FOR ADDITION LATER TAD I PI /GET IM[X(P)] JMS I MULT SINE /AC=IM[X(P)]*SINE=-IM[W^K]*IM[X(P)] TAD ADD2 /AC=RE[W^K]*RE[X(P)]-IM[W^K]*IM[X(P)]=RE[X(P)=W^K] DCA GR /STORE AT GR /DO IMAG, PART NEXT=IM[X(P)]*COSINE-RE[X(P)]*SINE=IM[X(P)]*RE[W^K]+RE[X(P)]*IM[W^K] TAD I PI JMS I MULT /AC=IM[X(P)] COSINE /AC=IM[X(P)]*COSINE=IM[(P)]*RE[W^K] DCA ADD2 /STORE FOR LATER ADDITION TAD I PR /AC=RE[X(P)] JMS I MULT SINE /AC=RE[X(P)]*SINE=-RE[X(P)]*IM[W^K] CIA /AC=RE[X(P)]M*IM[W^K] TAD ADD2 /AC=IM[X(P)]*RE[W^K]+RE[X(P)]*IM[W^K]=IM[X(P)*W^K] DCA GI /STORE AT GI, SO GI=IM[X(P)*W^K] AND GR=RE[X(P)*W^K] G=GR+I*GI TAD S /LOCATE P NODE PAIR Q, LOCATED S=N/(2^L) UP ARRAY CIA /SO SET Q=P-S=INDEX OF NODE PAIR TAD PR /LOCATE X(Q) IN MEMORY BY FIXING POINTERS QR AND QI DCA QR /TO QS REAL AND IMAG PARTS RESPECTIVELY TAD QR TAD XLOCDF DCA QI TAD I QR /DO THE COMPLEX OPERATIONS: X(P)<=X(Q)-G;X(Q)<=X(Q)+G DCA ADD2 /FIRST DO REAL PART OF X(P), GET RE[X(Q)] AND STORE TAD GR /GET RE[G] CIA JMS I ADDER /SUBTRACT THEM, DCA I PR /RE[X(P)]<=RE[X(Q)]-RE[G] TAD I QI /COMPUTE IMAG, PART OF X(P), GET IM[X(Q)] DCA ADD2 /AND STORE TAD GI /GET IM[G] CIA JMS I ADDER /AND SUBTRACT THEM. DCA I PI /IM[X(P)]<=IM[X(Q)]-IM[G],X(P) IS NOW DONE. TAD I QR /NEXT COMPUTE X(Q), FIRST REAL PART DCA ADD2 /GET RE[G] AND STORE TAD GR /GET RE[G] AND ADD TO FORM JMS I ADDER /RE[X(Q)]+RE[G]. DCA I QR /RE[X(Q)]<=RE[X(Q)]+RE[G] TAD I QI /NOW COMPUTE IMAG PART OF X(Q), GET IM[X(Q)] DCA ADD2 /AND STORE TAD GI /GET IM[G] AND ADD TO FORM JMS I ADDER /IM[X(Q)]+IM[G] DCA I QI /IM[X(Q)]<=IM[X(Q)]+IM[G], THE NEW NODE PAIR IS COMPUTED. CMA /MOVE UP ARRAY TO NEXT NODE, SET AC=-1 TAD P /TO FORM -1 DCA P /P<=P-1 CMA TAD PR /DO THE SAME FOR POINTER PR DCA PR TAD C /CHECK ON SPACING, IS A NODE WHICH HAS ALREADY BEEN COMPUTED CIA /ABOUT TO BE RE-DONE, OR EQUIVALENTLY. TAD S /IS C=S? SZA CLA /YES. JMP CNOTS /NO, DO NEXT NODE PAIR TAD P /YES, BUT ARE WE AT THE TOP OF THE ARRAY? CMA /OR, IS S=P+1? (P COMPLEMENTED=-P-1=-(P+1) TAD S SNA CLA JMP I RECHK /YES, DONE WITH THIS ARRAY, DO NEXT ONE. TAD S /NO, MOVE PAST AREA THAT HAS AREADY BEEN DONE, OR SET P TO P-S. CIA /BY CHANGING THE POINTER TO RE[X(P)] TAD PR DCA PR JMP I RESETC /REINITIALIZE C TO 1 SINCE AN UNUSED AREA HAS BEEN ENTERED. CNOTS, ISZ C /C<=C+1, ANOTHER NODE PAIR HAS BEEN HANDLED. JMP I RBUILD /DO NEXT NODE PAIR IN THIS AREA. SORTX, 0 /SUBROUTINE THAT CMA /SORTS OUT TRANSFORMS BY TAD N /BIT INVERSION OF ADDRESS. DCA Q /Q<=N-1, START FROM BOTTOM OF BUFFER REVERS, TAD Q /P<=BIT INVERTED Q JMS I INVERT /BIT INVERSION ROUTINE DCA P TAD P /FORM Q-P CIA TAD Q SPA SNA CLA /IS P<Q? JMP SWAPED /NO, HAVE ALREADY DONE THIS PAIR TAD P /YES, SWAP ORDER TAD XRLOC /FIRST SET UP SUBSCRIPT POINTERS FOR X(P) AND X(Q). DCA PR TAD Q TAD XRLOC DCA QR TAD PR TAD XLOCDF DCA PI TAD QR TAD XLOCDF DCA QI /EXCHANGE: X(P)<=X(Q) AND X(Q)<=X(P) TAD I PR /EXCHANGE REAL PARTS, GET RE[X(P)] DCA TEMPR /STORE IT. TAD I QR /GET RE[X(Q)] DCA I PR /MAKE IT RE[X(P)] TAD TEMPR /GET RE[X(P)] DCA I QR /MAKE IT RE[X(Q)] TAD I PI /EXCHANGE IMAGINARY PARTS, GET IM[X(P)] DCA TEMPR /STORE IT. TAD I QI /GET IM[X(Q)] DCA I PI /MAKE IT IM[X(P)] TAD TEMPR /GET IM[X(P)] DCA I QI /MAKE IT IM[X(Q)] SWAPED, TAD Q /IS Q=0?, IE; ARE WE AT THE TOP OF THE ARRAY SZA CLA JMP .+3 CDF0 JMP I SORTX /YES, DONE EXIT CMA /NO, Q<=Q-1, IE; MOVE UP THE ARRAY TAD Q DCA Q JMP REVERS /GO BACK AND CONTINUE EJECT *1000 /SIGNED S.P. MULTIPLY, USING THE EAE /ENTRY: AC=MULTIPLIER, C(CALL+1)=ADDR OF MULTIPLICAND, EXIT*AC=PRODUCT, /AN 11 BIT SIGNED BINARY FRAC MULTIP, 0 /AC=ARG1 (MULTIPLIER) CLL /ARG1>0? SPA CMA CML IAC /NO-MAKE POS-SET L=1 TO SHOW IT WAS NEG MQL /LOAD INTO MQ CDF0 TAD I MULTIP /GET ADDR OF MULTIPLICAND DCA ARG2 /STORE TAD I ARG2 /AND RETRIEVE MULTIPLICAND ITSELF. ISZ MULTIP /(FOR EXIT AT CALL+2) SPA /ARG2>0? CMA CML IAC /NO, MAKE POSITIVE, CHANGE LINK, SINCE-1+-1=1 AND -1+1=-1 DCA ARG2 /PUT AWAY AT ARG2 RAR /SIGN IN LINK, PUT INTO AC11 AND DCA SIGN /PUT AWAY AT SIGN (=1 IF -; =0 IF +) MUY /DO MULTIPLICATION ARG2, HLT /ARGUMENT 2 (MULTIPLICAND) SHL /NORMALIZE BINARY POINT. 0 DCA ARG2 /SAVE HIGH ORDER, NOW ROUND OFF. TAD SIGN SHL /SET AC11=MQ0,AC0-10=0 0 TAD ARG2 SPA CLA CLL CMA RAR NOP SZL /POSITIVE SIGN? CMA IAC /NO, NEGATE CDF1 JMP I MULTIP /EXIT, SIGNED RESULT IN AC. SIGN, 0 /BIT INVERSION ROUTINE /ENTRY: AC=WORD TO BE INVERTED; EXIT:AC=RESULT /NU CONTAINS THE NUME OF BITS IN THE WORD INVRT, 0 DCA WORD /GET WORD TO BE INVERTED DCA WORDP /ZERO OBJECT REGISTER TAD NU /GET NUMBER OF BITS TO BE CIA /INVERTED AND USE TO LIMIT THE DCA FLIPCT /EXTENT OF LOOP FLIP, TAD WORD /PULL OUT RIGHTMOST BIT OF WORD CLL RAR /RT MOST BIT NOW IN AC DCA WORD /(PUT BACK SO A NEW BIT IS OPERATED ON EACH TIME) TAD WORDP /AND PUSH INTO WORDP FROM LEFT RAL DCA WORDP ISZ FLIPCT /ALL BITS DONE? JMP FLIP /NO, DO NEXT BIT TAD WORDP /YES, PICK UP RESULT JMP I INVRT /AND EXIT EJECT /THIS SUBROUTINE FETCHES THE VALUES OF SIN(2*PI*C(AC)/N) /AND OF COS(2*PI*C(AC)/N) FOR C(AC) < N/2+1 /ENTRY: AC=INDEX OF LOOP UP /EXIT : COS(2*PI*C(AC)/N) STORED AT "COSINE" AND / AC=VALUE OF SIN(2*PI*C(AC)/N). TRIGET, 0 CDF0 DCA K /STORE C(AC) AT K. MQL /CLEAR MQ TAD K /FORM N/4-K. CLL CIA TAD NOVER4 DCA NO4MIK SZL /IS N/4-K<0? JMP QUAD1 /NO, FIRST QUADRANT ANGLE. QUAD2, TAD NO4MIK /2ND QUADRANT, GET -COS AT K-N/4. CIA LSR /MAKE CORRECTIVE RIGHT SHIFT ON INDEX. 0 SHL /FIND ON SINE TABLE FOR 2^MAXNU BY MULTIPLYING SHFT1, HLT /INDEX BY 2^(MAXNU-NU), WHICH IS STORED HERE. TAD SINLOC /LOCATE IT IN MEMORY. DCA INDEX TAD I INDEX CIA /2ND QUADRANT COS IS NEGATIVE. DCA COSINE TAD NO4MIK /GET SIN AT N/2-K TAD NOVER4 JMP SINRET QUAD1, TAD NO4MIK /GET COS AT N/4-K, LSR 0 SHL SHFT2, HLT TAD SINLOC DCA INDEX TAD I INDEX DCA COSINE TAD K /GET SIN AT K. SINRET, LSR 0 SHL SHFT3, HLT TAD SINLOC DCA INDEX TAD I INDEX /AC=SINVALUE. CDF1 JMP I TRIGET NO4MIK, 0 /STORAGE FOR N/4-K INDEX, 0 /POINTER TO SINE TABLE /THIS ROUTINE PERFORMS A SINGLE PRECISION ADD WITH ROUNDING EACH ARGUMENT IS /SHIFTED RIGHT ONCE TO PREVENT OVERFLOW OF BINARY POINT (IF NECESSARY) /AND THEN CHECKED TO SEE IF IT CAN BE NORMALIZED AFTER ADDITION /ENTRY: AC=ADDEND,C(ADD2)=AUGEND /EXIT : -AC=RESULT, DIVIDED BY TWO IF NECESSARY. ADDR, 0 DCA ADD1 TAD SHFLAG /SHOULD ADD BE DONE WITH SHIFT? SNA CLA JMP ADDWOS /NO, DO ADD WITH OUT SHIFT TAD ADD1 /YES, GET ADDEND ASR /DO 1 SIGNED RIGHT SHIFT 0 /MQ0=LOW ORDER (LO) OF ADD1 DCA ADD1 TAD ADD2 ASR /MQ0=LO(ADD2) 0 /MQ(1)=LO(ADD(1)) DCA ADD2 MQA /GET MQ RAL /L<=LO(ADD2); AC0<=LO(ADD1) CMA CML /COMPLEMENT BOTH. SMA SNL CLA /IF BOTH WERE=1 (NEITHER=0), INTRODUCE A CARRY. IAC ADDWOS, TAD ADD1 /DO THE ADDITION. TAD ADD2 DCA XSUM /STORE THE RESULT TAD XSUM /CHECK TO SEE IF ALREADY NORMALIZED. SPA /IS IT POSITIVE? CIA /MAKE IT POSITIVE. RAL /GET BIT 1, WAS NORMALIZED IF =1 SMA CLA JMP NOTNOR /NOT NORMALIZED, LEAVE SHFCHK ALONE. IAC DCA SHFCHK /SET SHFCHK=1 NOTNOR, TAD XSUM JMP I ADDR /AND EXIT ADD1, 0 /ADDEND STORAGE XSUM, 0 /TEMP STORAGE FOR SUM EJECT /DEFINITIONS FOR EAE DVI=7407 NMI=7411 SHL=7413 ASR=7415 LSR=7417 MQL=7421 MUY=7405 MQA=7501 CAM=7621 SCA=7441 SCL=7403 /ASSEMBLY PARAMETERS BIGSNU=12 /LARGEST TRANSFORMATION HAS DIMENSION 2^10. EJECT /MOVING WINDOW DISPLAY SUBROUTINE PMODE PAGE IDORA, 0 /GET BOUNDS CLA CLL ACDF0, CDF 0 TAD I IDORA /DATA BUFFER DCA I KMNFLD /15 BIT ISZ IDORA /LOWER BOUND TAD I IDORA /AT P+1, P+2 DCA I KMNADR /MINFLD,MINADR ISZ IDORA TAD I IDORA /UPPER BOUND DCA I KMXFLD /AT P+3, P+4 ISZ IDORA IAC /RDORA USES TAD I IDORA /MAX+1 DCA I KMXADR RAL TAD I KMXFLD DCA I KMXFLD ISZ IDORA TAD I IDORA /Y SHIFT DCA YSHFT ISZ IDORA TAD I IDORA /Y SCALE DCA I KYSCAL TAD I KMNFLD /INITIALIZE DCA I KBUFHI /WINDOW TAD I KMNADR /STARTING ADDR DCA I KBUFLO JMP I IDORA /RTN TO SCR N KMNFLD, MINFLD KMNADR, MINADR KMXFLD, MAXFLD KMXADR, MAXADR KBUFHI, BUFHI KBUFLO, BUFLO P401, 401 DSCLOC, TAD P401 /DSC X,Y COORD DCA VCOORD TAD XCURHI /FIELD JMS DSCWD TAD XCURLO /ADDRESS JMS DSCWD TAD CORVAL /CONTENTS OF JMS DSCWD /CURSR CORE LOC TAD YCUR /Y COORD OF TAD P401 JMS DSCWD /CURSOR POINT RTNCDF, 0 /RESTORE USER /DATA FLD JMP I RDORA /RTN DSCWD, 0 /DSC C(AC) LINC LMODE STC TEMP /SAVE VALUE STC XCORD /CHAN 1 SFA /VC FOR FULL ROL I 5 /SIZE IS -40 LDA I /-20 FOR HALF -20 LZE /FULL CHARS ? ROL 1 /NO VC-40 ADM I /UPDATE VC VCOORD, 0 DSCLOP, LDA I TEMP, 0 ROL 3 /1 DIGIT STA /AT A TIME TEMP /UPDATE BCL I /LOW 3 BITS 7770 /ONLY ROL 1 /*2 AND REL ADA I /TO GRID TAB TAB&1777 STC 2 ADD VCOORD DSC 2 DSC I 2 XSK I 1 /MAKE GAP XSK I 1 /BETWEEN CHARS SRO I /DSC 4 CHARS ? 3567 JMP DSCLOP /NO CONT PDP PMODE CLA CLL JMP I DSCWD /RTN TAB, 4536 /60,0 3651 2101 /61,1 0177 4523 /62,2 2151 4122 /63,3 2651 2414 /64,4 0477 5172 /65,5 0651 1506 /66,6 4225 4443 /67,7 6050 RDORA, 0 CLA CLL /SAVE USER DF RDF TAD ACDF0 DCA RTNCDF LINC LMODE CSAM, CURSAM /CURSOR SCR 1 /9 BITS COVERS PDP /SCOPE PMODE /MAKE RANGE TAD P401 /-1 TO -1000 CIA CLL LINC LMODE STC CURCNT&1777 WSAM, WINSAM /WINDOW MOVDIS, 0 /SCR 4 OR CLR SET I XCORD LEFTX, 0 /LEFT COORD OF DISPLAY JMP CONT&1777 FREE, FRESAM SCR 1 PDP PMODE DCA YCUR TAD YCUR LINC 6000 /JMP 0 PAGE CONT, 2 CCDF0, CDF 0 DCA DBLLO /PUT KNOB VAL TAD DBLLO /IN DAC SPA CLA /PROPAGATE SIGN CMA /BIT HI ORD DCA DBLHI JMS DADD TAD DBLLO /UPDATE WIN ADDR DCA BUFLO TAD DBLHI DCA BUFHI /MUST CHK /WINDOW SA /WITH BOUNDS /TO MAINTAIN /BUFFER RING JMS BOUND /LOWER BOUND MINFLD, 1 MINADR, 0 SMA CLA /LOW END WRAP? JMP CHKHI /NO TAD MAXFLD /RESET TO DCA BUFHI /UPPER BOUND TAD MAXADR WRAP, DCA BUFLO JMS DADD /CORRECT WRAP TAD DBLLO /CORRECTED DCA BUFLO /WINDOW SA TAD DBLHI DCA BUFHI SETFLD, TAD BUFLO /SET DISPLAY DCA BUFPTR /ARGS TAD MINPTS DCA COUNT TAD BUFHI DCA BOUND JMS SETDF NXTPNT, TAD I BUFPTR TAD YSHFT /OFF SET LINC LMODE YSCAL, SCR 1 /SCALE FACTOR DIS I XCORD PDP PMODE ISZ CURCNT /READY TO DIS /CURSOR ? CURRTN, SKP CLA /NO JMP CURDIS ISZ ENDLO /CHK FOR HI JMP OKEND /END WRAP ISZ ENDHI JMP OKEND TAD MINADR /RESET TO DCA BUFPTR /LOWER BOUND TAD MINFLD DCA BOUND JMP NXTDF OKEND, ISZ BUFPTR /CHK FOR FIELD /BOUNDARY JMP OKFLD /ITS OK ISZ BOUND /SET NXT FLD NXTDF, JMS SETDF OKFLD, ISZ COUNT /512 PNTS ? JMP NXTPNT /NO JMP I .+1 /DSC READ OUT DSCLOC CHKHI, JMS BOUND /CHK UPR BOUND MAXFLD, 2 MAXADR, 0 M70, SPA CLA /HI WRAP ? JMP SETFLD TAD MINFLD /YES DCA BUFHI /RESET TO TAD MINADR /LOWER BOUND JMP WRAP /DOUBLE PRECISION ADD /(DBLHI,DBLLO)+(BUFHI,BUFLO) /RESULT IN (DBLHI,DBLLO) /(BUFHI,BUFLO)=INITIAL SCOPE ADDRESS DADD, 0 CLA CLL TAD DBLLO TAD BUFLO DCA DBLLO RAL TAD DBLHI TAD BUFHI DCA DBLHI JMP I DADD /ADD -UPPER OR -LOWER BOUND /TO (BUFHI,BUFLO) /BOUND IS AT P+1,P+2 OF CALL BOUND, 0 TAD I BOUND /2S COM OF ARG CMA CLL /TO DAC DCA DBLHI ISZ BOUND TAD I BOUND CIA SZL ISZ DBLHI M1000, NOP DCA DBLLO JMS DADD TAD DBLHI DCA ENDHI /DAC HOLDS -NUM TAD DBLLO /TO END OF BUF DCA ENDLO /NO MATTER FOR /LOW END WRAP TAD DBLHI /TO CHK FOR ISZ BOUND /UPON RTN JMP I BOUND SETDF, 0 /SET 8 FIELD TAD BOUND /REL TO BOUND CLL RTL RAL TAD CCDF0 DCA .+1 DBLLO, 0 JMP I SETDF CURDIS, DCA YCUR /DISP CURSOR TAD BOUND /SAVE X,Y DCA XCURHI /COORDINATES TAD BUFPTR DCA XCURLO TAD I BUFPTR DCA CORVAL TAD M70 DCA DBLLO TAD YCUR CURLOP, LINC LMODE SNS I 5 JMP FREE /FREE CURSOR DIS XCORD PDP PMODE ISZ DBLLO JMP CURLOP JMP CURRTN CURCNT, 0 /THESE 5 GUYS MAY BE PAGE 0 BUFHI, 1 BUFLO, 0 ENDLO, 0 ENDHI, 0 DBLHI=SETDF BUFPTR=DADD XCORD=1 LMODE CURSAM=SAM 1 /CURSOR KNOB WINSAM=SAM 0 /WINDOW KNOB FRESAM=SAM 5 /FREE CURSOR SCALE=SCR SC12BU=SCR 3 /SCALE FACTOR /12 BIT UNSIGNED OF12BU=4000 /Y OFFSET FOR /12 BIT UNSIGNED CHAIN "FFTC-2"