Directory of image this file is from
This file as a plain text file
*20 EJECT LMODE SEGMNT 2 *20 LDF 7 /BOOTSTRAP IN DIAL MS I/O ROUTINES RDC 6322 RDC 7323 LDF 3 IFDIAL, LDA I /INPUT FROM DIAL TAPE? QUES1+2000 LIF 2 JMP ASK LDH ANSWER+6000 SAE I 31 SKP JMP UNTFIL /DIAL SAE I 16 JMP IFDIAL /ERROR JMP DATTAP /DATA /ASK FOR UNIT NO + FILE NAME UNTFIL, JMP ASK2 JMP .-1 /ASK AGAIN LIF 1 LDA I FDV+2000 JMP 20 /SEARCH INDEX SKP /CANT FIND IT JMP MOVINP LIF 2 LDA I /DISPLAY ERROR MSG MSG1+2000 JMP ASK JMP UNTFIL /ASK AGAIN DATTAP, JMP ASK3 JMP DATTAP /ERROR-ASK AGAIN MOVINP, JMP FDV2RW /MOVE INPUT PARAMETERS TO R/W LIST PTS, LDF 3 LIF 2 LDA I /ASK FOR NO OF PTS QUES4+2000 JMP ASK SET I 1 ANSWER+2000 LDA I /INPUT IS DECIMAL 12 STC MPLIER LDA I -71 STC UPLEGL LDA I /1024 PTS MAX 2000 JMP CONV JMP PTS /ERROR LDF 0 STA N+2000 LDF 3 COM STC TEMP1 SRO I TEMP1, 0 SKP JMP PTS /BIT 11=1 NOT POWER OF 2 SET I 2 -13 ROTAT, SRO /COUNT NO OF BITS SET TEMP1 JMP .+3 ADA I 1 XSK I 2 JMP ROTAT ADA I -1 COM AZE JMP PTS />1-NOT POWER OF 2 STC 2 /CLEAR ROT1, SRO /DETERMINE POWER OF 2 TEMP1 SKP JMP STAMU XSK I 2 JMP ROT1 STAMU, LDA 2 LDF 0 STA NU+2000 ADA I -1 APO JMP PTS /POWER<2 LDA /COMPUTE NO OF OUTPUT BLKS N+2000 /NO OF PTS ROL 1 /*2 JMP NUMBKS /CONVERT TO BLKS STA FDV+2007 /NO OF BLKS FOR REAL & IMAG STA RWPARM+2003 LDH ANSWER+2003 SAE I 22 JMP IFCOM STA /REAL-SET FLAG REALFG+2000 LDF 0 LDA N+2000 /COMPUTE INPUT BLKS JMP NUMBKS STA RWPARM+2003 JMP CKEND IFCOM, SAE I 3 JMP PTS /ERROR CLR /COMPLEX-CLEAR FLAG STA REALFG+2000 CKEND, LDA /WILL INPUT RUN OFF END OF TAPE RWPARM+2002 ADA RWPARM+2003 ADA I -1000 APO I JMP PTS /YES PDP PMODE CLA TAD N /ADD 1 BLK FOR SCALE FACTOR IF 400 WORDS OR MORE CLL RAL /NO OF OUTPUT WRDS = NO OF PTS*2 TAD M400 SMA CLA ISZ I PFDV7 LINC LMODE IFFFT, LDA I /DO FFT OR JUST DISPLAY? QUES11+2000 JMP ASK LDH ANSWER+6000 SAE I 4 JMP .+4 STA I /NOT=0 JUST DISPLAY DISFLG, 0 JMP FIF SAE I 6 JMP IFFFT /ERROR CLR STC DISFLG /=0 WILL DO TRANSFORM OR INVERSE FIF, LDH ANSWER+6001 SAE I 24 JMP IFI CLR STC IFTFLG /DO FFT JMP IFDISP IFI, SAE I 11 JMP IFFFT STC IFTFLG /DO IFFT IFDISP, ADD DISFLG AZE I JMP OUTQES JMP FDV2RW /MOVE OUTPUT PARAMETERS TO R/W LIF 3 /JUST DISPLAY JMP DISPLY /GET OUTPUT INFO OUTQES, LDA I QUES5+2000 JMP ASK /PUT ON DIAL TAPE? LDH ANSWER+6000 SAE I 31 SKP JMP OUTUNT SAE I 16 JMP OUTQES JMP ONDAT /NO OUTUNT, JMP ASK2 /ASK FOR UNIT NO & FILE NAME JMP OUTUNT /ERROR LIF 1 LDA I /ENTER IN INDEX FDV+2000 JMP 22 JMP SAMNAM /NAME ALREADY USED JMP NOSPAC /NO SPACE RDDATA, PDP /CLEAR DATA BUFFER PMODE CLA CMA TAD XRLOC DCA 10 TAD M4000 DCA 11 CDF1 DCA I 10 ISZ 11 JMP .-2 CDF0 CIF 10 /READ IN DATA JMS I PREAD RWPARM CDF0 CLA TAD I PRELFG /REAL OR COMPLEX SZA CLA JMP PROC /REAL CMA /MOVE IMAG PARTS TO 2000 TAD N /OLD ADDR = NO OF PTS DCA 10 TAD C1777 /NEW ADDR = 2000 DCA 11 TAD N CIA DCA TEMPR /CTR DCA CMPFLG /DONT COMPLEMENT JMS I PMVPTS /MOVE THEM JMP PROC IFTFLG, 0 /0=FFT NON0=IFFT PROC, DCA I PRELFG /OUTPUT WILL BE COMPLEX REGARDLESS OF INPUT TAD IFTFLG /DO IFFT? SNA CLA JMP FT /NO IFT, JMS I DOIFFT SKP FT, JMS I DOFFT JMS I SORT /PUT IN SEQUENTIAL ORDER STSCAL, TAD SCAL CDF1 DCA TEMPR /SAVE TAD N CLL RAL DCA COSINE /NO OF PTS*2 TAD TEMPR DCA I COSINE /STORE SCALE FACTOR AFTER DATA NOWSTR, CDF0 TAD C1777 /OLD ADDR = 2000 DCA 10 CMA /NEW ADDR = NO OF PTS TAD N DCA 11 TAD N CIA DCA TEMPR /CTR DCA CMPFLG /DONT COMPLEMENT JMS I PMVPTS /PACK IMAG PARTS BEHIND REAL LINC LMODE JMP FDV2RW PDP PMODE CIF 10 /WRITE OUT DATA JMS I PWRITE RWPARM LINC LMODE LIF 3 JMP DISPLY NOSPAC, LIF 2 LDA I MSG2+2000 JMP ASK JMP OUTQES /ASK OUTPUT QUESTIONS AGAIN SAMNAM, LIF 2 LDA I /NAME ALREADY EXISTS QUES6+2000 /REPLACE WITH NEW FILE? JMP ASK LDH ANSWER+6000 SAE I 31 SKP JMP REPL SAE I 16 JMP SAMNAM JMP OUTUNT /NO-ASK FOR NAME AGAIN REPL, LIF 1 JMP 24 JMP NOSPAC JMP RDDATA ONDAT, LIF 2 JMP ASK3 /ASK FOR UNIT/BLK NO JMP ONDAT /ERROR LDA FDV+2006 /BLK NO ADA FDV+2007 /NO OF BLKS ADA I -1000 APO I JMP NOSPAC /NOT ENOUGH BLKS LEFT JMP RDDATA /MOVE FDV PARAMETERS TO R-W LIST FDV2RW, LDA FDV+2000 STA RWPARM+2000 LDA FDV+2006 STA RWPARM+2002 LDA FDV+2007 STA RWPARM+2003 JMP 0 /CONVERT WORDS TO BLOCKS NUMBKS, STC TEMP1 ADD 0 STC NUMBKX ADD TEMP1 LDF 3 SET I 1 1 ADA I -400 APO JMP .+3 XSK I 1 JMP .-5 LDA 1 NUMBKX, 0 /ASK FOR UNIT NUMBER & FILE NAME /CONV & STORE UNIT NUMBER /MOVE FILE NAME TO ENTER, LOOKUP PARAMETER LIST /STORE UNIT THRU B3 ASK2, LDA 0 STC ASK2X LIF 2 JMP OCTL /CHANGE PARAMETERS TO HANDLE OCTAL NUMBERS LDA I QUES2+2000 JMP ASK /PT TO UNIT NO-1H SET I 1 ANSWER+2000 LDA I /MAX VALUE 17 JMP CONV JMP ASK2X /ERROR STA /STORE UNIT FDV+2000 /MOVE FILE NAME FROM ANSWER BUFFER TO LOOKUP, ENTER PARAMETER LIST SET I 1 ANSWER+6001 SET I 2 FDV+6000 /LEFT HALF 1ST OF FDV+1 SET I 3 -10 /8 CHARS LDH I 1 /IF 1ST CHAR OF NAME AZE I /=00, NO NAME WAS JMP ASK2X /ENTERED-ERROR SKP INFILE, LDH I 1 AZE /FILL TO 8 CHARS WITH 77 JMP .+3 LDH I 7700 STH I 2 XSK I 3 JMP INFILE LDA I /RETURN CALL+2 1 ADM .+1 ASK2X, 0 /ASK FOR UNIT NUMBER + BLK NO AND CONVERT /STORE UNIT THRU B7 /" BLK NO " B10 ASK3, LDA 0 STC ASK3X LIF 2 LDA I QUES3+2000 JMP ASK SET I 1 /ADDR-1H OF 1ST CHAR - UNIT ANSWER+2000 JMP OCTL /CHANGE PARAMETERS TO HANDLE OCTAL LDA I /MAX VALUE 17 JMP CONV JMP ASK3X /ERROR STA FDV+2000 SET I 1 ANSWER+6001 LDA I /MAX VALUE FOR BLK NO 777 JMP CONV JMP ASK3X STA FDV+2006 LDA I /EXIT CALL+2 1 ADM .+1 ASK3X, 0 /CONVERT NUMBER IN ANSWER BUFFER TO BINARY /ENTER WITH MAX LEGAL VALUE IN AC /IF LEGAL - EXIT CALL+2 WITH VALUE IN AC CONV, COM STC TEMP2 /COMPLEMENT MAX VALUE STC TEMP1 ADD 0 /RETURN ADDR STC CONVER NXTCHR, LDH I 1 /GET A CHAR AZE I JMP ERRCHK ADA I 7720 /-60 -2 /S COMP APO JMP CHKEND /<60 MAYBE TERMINATING CHAR LDH 1 /CK UPPER LIMIT ADA I UPLEGL, -67 /UPPER LIM=7 OR 9 APO JMP MULPLY /0-9 -0K CHKEND, LDH 1 /<9 MAYBE TERMINATING CHAR SAE I 34 SKP JMP ERRCHK SAE I 74 JMP CONVER /ILLEGAL CHAR ERRCHK, LDA /=34 OR 74 - NUMBER COMPLETED TEMP1 ADA /ERROR CHECK SIZE TEMP2 APO I JMP CONVER /TOO LARGE LDA I /OK STEP EXIT 1 ADM .+3 LDA /EXIT WITH VALUE IN AC TEMP1 CONVER, 0 TEMP2, 0 / MULPLY, LDA /VALUE SO FAR TEMP1 MUL I MPLIER, 10 STC TEMP1 LDH 1 /+ THIS VALUE BCL I 7760 ADM TEMP1 JMP NXTCHR / /CHANGE PARAMETERS SO CONV & MULPLY WILL HANDLE OCTAL NUMBERS OCTL, LDA I 10 STC MPLIER LDA I -67 STC UPLEGL JMP 0 / /DISPLAY QUESTIONS ASK, STC QUESNO /ADDR OF TEXT ADD 0 STC ASKX IOB PMODE RIB LMODE SCR 3 BCL I 7740 ADA I LIF 0 STC ASKX-1 JMP QAINIT /DISPLAY QUESNO, 0 ANSWER+2000 JMP QARFSH /WAIT FOR ANSWERS 0 ASKX, 0 EJECT SEGMNT 3 LMODE *1 DISPLY, PDP PMODE CLA TAD N CLL RAR DCA GR /NO OF PTS/2 TAD GR CIA DCA ADD2 /-NO OF PTS/2 TAD C2000 DCA LOADDR /LOWER ADDR OF DISPLAY TAD C1777 TAD N DCA UPADDR /UPPER ADDR OF DISPLAY CIF 10 /READ IN DATA JMS I PREAD RWPARM LINC LMODE DISPL1, LDA I /WHICH DISPLAY QUES13+2000 LIF 2 JMP ASK LDH ANSWER+6000 AZE JMP .+3 LIF 2 JMP IFDIAL /LINE FEED PDP PMODE WCHDIS, TAD M11 SNA JMP DPIMAG /IMAG TAD M4 SNA JMP I PDPMAG /MAGNITUDE TAD M5 SNA JMP DPREAL /REAL TAD M1 SNA CLA JMP I PDPSCL /SCALE FACTOR DISPER, LINC /ERROR LMODE JMP DISPL1 REALFG, 0 PMODE PDPSCL, DPSCAL DPIMAG, TAD REALFG SZA CLA JMP DISPER /NO IMAG PARTS TO DISPLAY TAD I PIFTFG /IF TRANSFORM WAS DONE, SWAP HALVES SZA CLA JMP NOSWPI /INVERSE WAS DONE CMA TAD N DCA 10 /OLD LOW ADDR OF 1ST 1/2 = NO OF PTS TAD GR /NEW LOW ADDR OF 1ST 1/2 = 2000 + NO OF PTS/2 TAD C1777 DCA 11 TAD ADD2 DCA TEMPR /MOVE 1/2 OF PTS CLA IAC DCA CMPFLG /COMPLEMENT VALUES JMS I PMVPTS /MOVE THEM CMA /OLD ADDR OF 2ND 1/2 = 3/2 NO OF PTS TAD GR TAD N DCA 10 TAD C1777 /NEW ADDR OF 2ND 1/2 = 2000 DCA 11 TAD ADD2 DCA TEMPR /1/2 OF PTS JMS I PMVPTS /MOVE THEM - 1ST 1/2 IS NOW 2ND 1/2; 2ND 1/2 IS NOW 1ST 1/2 JMP PREPAR NOSWPI, TAD N /LOW ADDR OF IMAG = NO OF PTS DCA LOADDR CMA /HIGH ADDR = 2*NO OF PTS-1 TAD N TAD N DCA UPADDR JMP PREPAR DPREAL, TAD I PIFTFG /IF TRANSFORM WAS DONE, SWAP HALVES SZA CLA JMP NOSWPR JMS I PMRLMG /SWAP JMP PREPAR NOSWPR, DCA LOADDR /LOW ADDR OF REAL CMA TAD N DCA UPADDR /HIGH ADDR = NO OF PTS-1 PREPAR, TAD ADD2 /NO OF PTS <1000? CLL RAL TAD C1000 SPA SNA JMP GQ1000 CLL RAR /YES IAC /CENTER DISPLAY TAD M1K DCA I PLEFTX /1000-(1000-NO OF PTS/2) 1,S COMP TAD CCLR DCA I PMVDIS TAD ADD2 /WIDTH OF DISPLAY CLL RAL /NO OF PTS DCA MINPTS JMP SHOWIT GQ1000, CLA TAD M1K /LEFT JUSTIFY DISPLAY DCA I PLEFTX /-1000 1,S COMP TAD I PLEFTX /WIDTH OF DISPLAY IAC DCA MINPTS TAD SCR4 /MOVE DISPLAY DCA I PMVDIS JMP SHOWIT /DISPLAY DATA REDPLY, LINC LMODE JMP DISPLY PMODE SHOWIT, JMS I KIDORA 1 /LOW ADDR FIELD LOADDR, 0 / " " " 1 /HIGH " " UPADDR, 0 / " " 0 /Y OFFSET LMODE SIZE, SCR 3 /SCALE PMODE RFRSH, JMS I KRDORA /REFRESH UNTIL LF IS HIT KSF JMP .-2 KRB TAD M215 SNA CLA JMP REDPLY KRB TAD M261 SNA CLA JMP LARGER KRB TAD M321 SNA CLA JMP SMALLR JMP I PRFRSH SMALLR, TAD I KYSCAL TAD M353 SPA CLA ISZ I KYSCAL JMP I PRFRSH LARGER, TAD I KYSCAL TAD M340 SPA SNA CLA JMP I PRFRSH CMA TAD I KYSCAL DCA I KYSCAL JMP I PRFRSH /DISPLAY SCALE FACTOR DPSCAL, TAD I PRELFG SZA CLA JMP I PDSPER /JUST REAL MEANS I DIDNT MAKE FILE - NO SCALE FACTOR TAD N CLL RAL DCA TEMPR /ADDR = NO OF PTS*2 CDF1 TAD I TEMPR TAD M11 SMA SZA CLA JMP GR9 />9 TAD LESS10 TAD I TEMPR /SPACE + ASCII SCALE FACTOR JMP SHOSCL GR9, TAD M12 TAD I TEMPR TAD GRET10 /10+SCALE FACTOR-10 SHOSCL, CDF0 DCA DPMAG-2 /STORE IN DISPLAY PARAMETERS LINC LMODE LDA I SCLFAC+2000 LIF 2 JMP ASK /DISPLAY IT JMP DISPLY SCLFAC, TEXT Z F \Z PMODE /COMPUTE MAGNITUDE DPMAG, TAD I PRELFG SZA CLA JMP I PDSPER CMA TAD N DCA 10 /LOW ADDR OF IMAG = NO OF PTS TAD C1777 DCA 11 /MOVE TO 2000 TAD N CIA DCA TEMPR /CTR DCA CMPFLG /DONT COMPLEMENT VALUES JMS I PMVPTS /MOVE IMAG TO 2000 DCA COSINE /ADDR OF 1ST REAL TAD C1777 /ADDR-1 OF IMAG PARTS DCA 11 TAD C6000 /FRAC MULT DCA RELPTR TAD C6000 DCA IMGPTR TAD ADD2 CLL RAL DCA TEMPR /-NO OF PTS CDF1 NXTMAG, TAD I COSINE /REAL PART LINC LMODE LDF 4 /FIELD OF REAL MUL /MULT BY ITSELF RELPTR, 0 SCR I 3 /1 BECAUSE PROD IS SHIFTED LEFT 1, 2 BECAUSE MAX VALUE WILL OVERFLOW - TAKE OUT 2 SQUARED PDP PMODE DCA DPSQ+1 /SAVE D.P. SQ MQA DCA DPSQ TAD I 11 /IMAG PART LINC LMODE LDF 5 /FIELD OF IMAG MUL IMGPTR, 0 SCR I 3 /SAME REASON AS REAL PDP PMODE DCA SINE /SAVE H.O. CLL MQA /L.O. OF IMAG TAD DPSQ /L.O. OF REAL DCA DPSQ RAL /OVERFLOW IF ANY TAD SINE /H.O. OF IMAG TAD DPSQ+1 /H.O. OF REAL DCA DPSQ+1 JMS I PSQRT /TAKE SQ RT DCA I COSINE /STORE IN PLACE OF REAL ISZ COSINE /STEP REAL PTR ISZ IMGPTR / " IMAG ADDR - ON LAST PT OF 1024 PTS WILL SKIP ISZ RELPTR /STEP REAL ADDR ISZ TEMPR /STEP CTR JMP NXTMAG LINC LMODE LDF 3 PDP PMODE TAD I PIFTFG /IF TRANSFORM WAS DONE, SWAP HALVES SZA CLA JMP I PNSWPR JMS I PMRLMG JMP I PPREPR /DISPLAY MAG / PPREPR, PREPAR PDSPER, DISPER PSQRT, SQRT PNSWPR, NOSWPR EJECT LMODE /LOOKUP, ENTER PARAMETER LIST FDV, 0 /UNIT 0 0 /FILE NAME - 8 CHAR 0 0 0 2 /BINARY 0 /BLK NO 0 /NO OF BLKS / RWPARM, 0000 /UNIT 0020 /BUFFER ADDR 0 /BLK NO 0 /NO OF BLKS / LMODE /QUESTIONS QUES1, TEXT Z SINGLE PRECISION FFT F INPUT ON F DIAL UNIT? Y/N<1\Z QUES2, TEXT Z FUNIT NUMBER<2 FFILE NAME <8\Z QUES3, TEXT Z F UNIT NUMBER<2 F BLK NUMBER <3\Z QUES4, TEXT Z FHOW MANY PTS?<4 (4-1024 BY POWERS OF 2) FREAL OR FCOMPLEX? R/C<1\Z QUES5, TEXT Z F OUTPUT ON F DIAL UNIT? Y/N<1\Z QUES6, TEXT Z F REPLACE? Y/N<1\Z QUES11, TEXT Z FFFT OR DISPLAY? F/D<1 FTRANSFORM OR FINVERSE? T/I<1\Z QUES13, TEXT Z FWHICH DISPLAY?<1 R(EAL) I(MAGINARY) M(AGNITUDE) S(CALE FACTOR) LINE FEED(RESTART)\Z /MESSAGES MSG1, TEXT Z F CANNOT FIND HIT RETURN TO CONT\Z MSG2, TEXT Z F NO SPACE HIT RETURN TO CONT\Z / ANSWER, 0 *.+6 EJECT PMODE /SQUARE ROOT SQRT, 0 DCA ROOT /CLR ROOT TAD DPSQ /IF SQ IS 0, EXIT SZA CLA JMP NOT0 TAD DPSQ+1 SNA CLA JMP I SQRT NOT0, TAD DPSQ+1 /1ST APPROX OF ROOT CLL RAR /DIVIDE BY 2 TAD C2000 /+1/2 DCA ROOT SQRT2, TAD DPSQ /SUM OF SQUARES MQL TAD DPSQ+1 CLL DVI /DIVIDE BY ROOT APPROX ROOT, 0 SZL JMP SQRT1 /OVERFLOW CLA MQA /QUOTIENT TO AC TAD ROOT /ADD APPROX TO QUOTIENT IAC CLL RAR /DIVIDE BY 2 DCA SINE /SAVE TAD ROOT /SUBTRACT OLD ROOT FROM NEW ONE CIA TAD SINE SNA CLA JMP SQRT1 /=0 TAD SINE DCA ROOT /NEW ROOT JMP SQRT2 SQRT1, TAD ROOT JMP I SQRT EJECT PMODE /MOVE PTS FROM ONE AREA TO ANOTHER /10 = OLD BUFFER /11 = NEW " /IF CMPFLG=1, COMPLEMENT VALUE MOVPTS, 0 CDF1 NXTPT, TAD CMPFLG CLL RAR /TO LK TAD I 10 SZL CIA DCA I 11 ISZ TEMPR JMP NXTPT CDF0 JMP I MOVPTS /MOVE REAL OR MAGNITUDE VALUES /FROM 0 TO 2000 /AND SWAP HALVES /DO NOT COMPLEMENT MVRLMG, 0 CMA /OLD ADDR OF 1ST 1/2 = 0 DCA 10 TAD GR /NEW ADDR OF 1ST 1/2 = 2000 + 1/2 NO OF PTS TAD C1777 DCA 11 TAD ADD2 DCA TEMPR /MOVE 1/2 NO OF PTS DCA CMPFLG /DONT COMPLEMENT JMS I PMVPTS /MOVE THEM CMA /OLD ADDR OF 2ND 1/2 = 1/2 NO OF PTS TAD GR DCA 10 TAD C1777 /NEW ADDR OF 2ND 1/2 = 2000 DCA 11 TAD ADD2 DCA TEMPR /1/2 NO OF PTS JMS I PMVPTS /MOVE THEM JMP I MVRLMG EJECT