Directory of image this file is from
This file as a plain text file
/LAB8E ADVANCED AVERAGER MS-SECTION 3,CONFIDENCE LIMITS, /AND TREND CALCULATIONS. / /DEC-8E-AAA3A-A-LA / /COPYRIGHT 1972 /DIGITAL EQUIPMENT CORPORATION /MAYNARD, MASSACHUSETTS 01754 /
/FILE AD3.1 /SECTION III OF THE LAB8/E ADVANCED AVERAGER . /THIS IS PART 3 OF ADVANCED AVERAGER FOR DSK/DTA /OVERLAY FOR SEC.3 OF ADV.AVG. FOR PS8. *7553 OVRLAY, IOF CLA CLL CMA CLZE /DISABLE CLOCK CLA ADCL /AD DILC /DISPLAY DBDI /I/O CDF 10 TAD 7 /SAVE BLOCK ADD. FOR CHAIN,SINCE SEC4 /LOAD IN A NEW PAGE 0. DCA I KC7600 CDF 0 /CHAIN IN SEC. 4 DCA I KC7746 /0 PS8 JOB STATUS WORD. TAD I XXOV3A DCA XXOV3 CIF 10 JMS I CHAIN 6 XXOV3, 0 CHAIN, 7700 XXOV3A, PG0OV+1 PG0OV=5 KC7600, 7600 CLZE=6130 ADCL=6530 DILC=6050 DBEI=6501
/LAB-8 ADVANCED AVERAGER - SECTION 3 - [U63A.3] /COPYRIGHT, 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 /CONFIGURATION PARAMETERS DATA0=216 /1ST LOC AVAIL FOR DATA IN FIELD 0 /LIST ADDRESSES ADJLIS=23 /START OF JOB LIST-1 /SWEEP A LIST PARAMETERS SAMA=44 /-# OF POINTS (ASI) IN SWEEP A (EACH CHANNEL) ADBUFA=47 /LOCATION -1 FOR START OF ADC BUFFER -A
/FLOATING POINT ARITHMETIC [SU64A] FADD=JMS I 105 /FLOATING ADD FDIV=JMS I 106 /FLOATING DIVIDE FLOAT=JMS I 107 /FLOAT AC TO FAC FMUL=JMS I 110 /FLOATING MULTIPLY FIX=JMS I 111 /FIX FAC TO AC DFIX=JMS I 100 /DBL FIX FAC TO ARG /BASIC SUBROUTINES [SU63A] BRAN=JMS I 132 /BRANCH ACCORDING TO AC MATCH WITH LIST SHFT=JMS I 133 /DOUBLE PRECISION ARITHMETIC SHIFT DADD=JMS I 134 /DOUBLE PRECISION ADD /FLOATING POINT HANDLERS [SU64A] SAVE=JMS I 142 /SAVE FAC LOAD=JMS I 143 /LOAD FAC DCOM=JMS I 144 /DOUBLE PRECISION NEGATE NORM=JMS I 145 /NORMALIZE FAC /PAGE ZERO CONSTANTS K0004=112 K0003=113 K0002=114 KM0001=115 K0007=116 KM0027=117 K0377=120 KM0004=121 /TTY-LIST TTYLST=122 PROMRK=123 TXMRK=125 KCR=126 KM0043=127 /OCSORT OCSORT=130 K0040=130 MTXMRK=131
/TEMPORARY STORAGE REGISTERS 146-177 TEMP01=146 TEMP02=147 TEMP03=150 TEMP04=151 TEMP05=152 TEMP06=153 TEMP07=154 TEMP10=155 TEMP11=156 TEMP12=157 TEMP13=160 TEMP14=161 TEMP15=162 TEMP16=163 TEMP17=164 TEMP20=165 TEMP21=166 /TEMPORARY STORAGE AND MULTIPLE ACCUMULATORS ARITH0=167 TEMP22=167 ARITH1=170 TEMP23=170 ARITH2=171 TEMP24=171 ARITH3=172 TEMP25=172 ARITH4=173 TEMP26=173 ARITH5=174 TEMP27=174 /TEMPORARY STORAGE AND TTY-KBD BUFFERS KBDBUF=175 TEMP30=175 TTYBUF=176 TEMP31=176 TTYFLG=177 TEMP32=177
/IOT REFERENCES FOR THE LAB/8E / / /AD8-EA 10 BIT A/D CONVERTER / ADCL=6530 /CLEAR ALL ADLM=6531 /LOAD MPLXR ADST=6532 /START CONVERSION ADRB=6533 /READ AD BUFFER ADSR=6534 /SKIP ON AD DONE ADSK=6535 /SKIP ON TIMING ERROR ADLE=6536 /LOAD ENABLE REGISTER ADRS=6537 /READ STATUS REGISTER / /VC8-E POINT PLOT DISPLAY / DILC=6050 /CLEAR ALL DICD=6051 /CLEAR DONE FLAG DISD=6052 /SKIP ON DONE FLAG DILX=6053 /CLEAR DONE FLAG LOAD X DILY=6054 /CLEAR DONE FLAG LOAD Y DIXY=6055 /CLEAR DONE, INTENSIFY, SET DONE DILE=6056 /LOAD ENABLE CLEAR AC DIRE=6057 /ENABLE TO AC / /DK8-EP REAL TIME CLOCK / CLZE=6130 /ZERO TO ENABLE CLSK=6131 /SKP ON CLOCK FG CLOE=6132 /ONES TO ENABLE CLAB=6133 /AC TO CLK BUF AND COUNTER REGISTER CLEN=6134 /ENABLE TO AC CLSA=6135 /STATUS TO AC AND AC ONE'S CLEAR STATUS REG. CLBA=6136 /CLK BUF TO AC CLCA=6137 /CLK CNTR TO AC AND TO AC / /DB8-EA 12 CHANNEL DIGITAL I/O / DBDI=6500 /DISABLE INTERRUPT DBEI=6501 /ENABLE INTERRUPT DBSK=6502 /SKIP ON INPUT DBCI=6503 /CLEAR INPUT BITS WITH SET AC BIT DBRI=6504 /READ INPUT DBCO=6505 /CLEAR OUTPUT BITS WITH AC BITS DBSO=6506 /SET OUTPUT BITS WITH AC BITS DBRO=6507 /READ OUTPUT REGISTER /COMBINED OPERATES MTH=CLA CMA CLL RTL; MTW=CLA CMA CLL RAL TWO=CLA CLL CML RTL; TWOK=CLA CLL CML RTR /EXTENDED MEMORY CDF=6201; RDF=6214; RMF=6244
*6400 /2-PAGE FLOATING POINT PACKAGE [SU64AC] - REQUIRES [SU63A] /LOAD, SAVE, DCOM, NORM, FMUL, FIX, DFIX, FADD, FDIV, FLOAT /FLOATING POINT FORMAT / WORD1: EXPONENT (2'S COMPLEMENT) / WORD2: HI ORDER MANTISSA / WORD3: LO ORDER MANTISSA / /MANTISSA IS REPRESENTED IN 24 BIT, 2'S COMPLEMENT NOTATION /A FLOATING POINT IS STORED AS MANTISSA*2^ EXPONENT /ZERO IS ALWAYS STORED AS 0*2^0 /0.5 .LE. .ABS. MANTISSA .LT. 1.0 /FLOATING POINT ACCUMULATOR FAC=ARITH0 /FLOATING POINT OPERATOR FOP=ARITH3 /SUBROUTINE TO LOAD FLOATING ACCUMULATOR: LOAD /TEMPORARY STORAGE ALLOCATION LDPNT=17 LOADS, 0 CLL CML CLA CMA /CALL: LOAD TAD I LOADS / ADDRESS DCA LDPNT /GETS ADDRESS, ADDRESS+1, ADDRESS+2 TO FAC ISZ LOADS TAD I LDPNT /ORDER IN MEMORY IS ASSUMED TO BE: DCA FAC / WORD1 TAD I LDPNT DCA FAC+1 / WORD2 TAD I LDPNT DCA FAC+2 / WORD3 JMP I LOADS /SUBROUTINE TO SAVE FLOATING ACCUMULATOR: SAVE /TEMPORARY STORAGE ALLOCATION SVPNT=17 SAVES, 0 CLL CML CLA CMA /CALL: SAVE TAD I SAVES / ADDRESS DCA SVPNT ISZ SAVES /SAVES FAC IN ADDRESS, ADDRESS+1, ADDRESS+2 TAD FAC /ORDER: WORD1 DCA I SVPNT TAD FAC+1 /ORDER: WORD2 DCA I SVPNT TAD FAC+2 /ORDER: WORD3 DCA I SVPNT JMP I SAVES
/SUBROUTINE TO FORM NEGATIVE OF ARITH1-2: DCOM DCOMS, 0 CLL CLA TAD ARITH2 CMA IAC DCA ARITH2 /-ARITH2 TO ARITH2 TAD ARITH1 /CARRY IS IN LINK BIT CMA SZL /DO CARRY IAC DCA ARITH1 JMP I DCOMS /SUBROUTINE TO NORMALIZE MANTISSA IN FAC: NORM /MODIFIES ARITH 1-2 (NORHI,NORLO), TEMP01(IN SHFT), TEMP02(NORCNT) /LEAVES FAC MANTISSA NORMALIZED, /SIGN OF MANTISSA IN LINK BIT, EXPONENT IN AC /TEMPORARY STORAGE ALLOCATION NORCNT=TEMP02 /ARITHMETIC REGISTER ALLOCATION NORHI=FAC+1 NORLO=FAC+2 NORMS, 0 CLL CLA TAD KM0027 /-23(10) DCA NORCNT NORLV, TAD NORHI CLL RAL SMA SNL /TEST FOR L,AC0 JMP NORSH /0,0 - SHIFT IT CMA CML /1,1 TO 0,0 SPA SZL CLA /TEST FOR 1,1 JMP NOREX /0,1 OR 1,0 - DONE TAD NORHI /1,1 - TEST FOR 6000 AND K1777 SZA CLA JMP NORSH /NO - CONTINUE TAD NORLO /YES - TEST FOR 6000 0000 SNA CLA JMP NOREX /YES AND L HOLD 1 FOR - NORSH, CLL CLA IAC SHFT /1 LEFT ISZ NORCNT /23 TIMES? JMP NORLV /NO - LOOK AGAIN NOREX, CML /23 SHIFTS IS ENOUGH - OR DONE TAD NORCNT CMA IAC /L GETS COMPLEMENTED IF=0, NORM OF 0 LEAVES 0 IN L. JMP I NORMS /LOCAL CONSTANT K1777, +1777
/SUBROUTINE FOR FLOATING POINT MULTIPLICATION: FMUL /CALL: FMUL /ONE ARGUMENT / ARG ADDRESS /ARG IS THE OTHER / (RETURN) /AC=0, L UNSPECIFIED /MODIFIES ARITH0-5(FAC,FOP), TEMP01-12 /USES SUBROUTINES NORM,SHFT,DADD,DCOM,SAVE,LOAD /LEAVES RESULT IN FAC /TEMPORARY STORAGE ALLOCATION FMULP=TEMP10 /11 AND 12 FMULS, 0 TAD I FMULS JMS I GARGX /GET ARG AND FAC MAGNITUDE, SET SIGN ISZ FMULS /FIX UP RETURN ADDRESS SAVE FMULP DCA FOP+1 /CLEAR PRODUCT ACCUMULATION DCA FOP+2 MULOOP, LOAD /SHIFT MULTIPLIER TO TEST FMULP /WHETHER TO INCREASE PRODUCT IAC /(FIRST TIME THRU IS ZERO SO WE SHFT /SKIP IT) SAVE FMULP LOAD /DECREASE POSSIBLE PRODUCT FARG /INCREMENT BY A FACTOR OF 2 CLA CMA SHFT SAVE FARG TAD FMULP+1 /BIT 0 IS FLAG FOR INCREASING SPA CLA /PRODUCT ACCUMULATION DADD /BY CURRENT INCREMENT ISZ FCNTR /DO THIS 23 TIMES JMP MULOOP LOAD /NORMALIZE RESULT MANTISSA FOP JMS NORMS /ADJUST EXPONENT SNA JMP FMEXP /MANTISSA WAS ZERO TAD FMULP TAD FARG TAD KM0027 FMEXP, DCA FAC TAD FLSIGN /FIX SIGN OF RESULT SZA CLA DCOM JMP I FMULS /LOCAL CROSSPAGE GARGX, GARG
/THIS SUBROUTINE FIXES FAC TO AC: FIX FIXS, 0 TAD FAC /AC BIASES FIX SPA SNA /FIX OF FAC .LT. 1 GIVES 0 IN AC JMP FIXNG TAD KM14 SMA /FIX OF .ABS. FAC .GE. 2^11; EXITS 0 IN AC JMP FIXNG IAC SHFT TAD ARITH1 JMP I FIXS FIXNG, CLL CLA JMP I FIXS /LOCAL CONSTANT KM14, -0014 /SUBROUTINE TO FIX FAC TO DBL PREC IN FAC+1 AND FAC+2 DFIXL=TEMP01 DFIXS, 0 TAD FAC /AC BIASES FIX TAD KM0027 SHFT TAD I DFIXS /CALL+1 HOLDS ADDRESS OF HI ORDER FIX ISZ DFIXS DCA DFIXL TAD FAC+1 /STORE AT C(CALL+1) AND C(CALL+1)+1 DCA I DFIXL ISZ DFIXL TAD FAC+2 DCA I DFIXL JMP I DFIXS /EXIT TO CALL+2
*.-1 177+1 /PAGE 2 OF 2 PAGE FLOATING POINT PACKAGE [SU64A] /FADD, FDIV, FLOAT /SUBROUTINE TO FLOATING ADD TO FAC: FADD /CALL: FADD / ADDRESS /MODIFIES ARITH 0-5 (FAC,FOP), TEMP01(FADSHF),TEMP02-04(ADDEND), /TEMP05-07(AUGEND) /USES SUBROUTINES: NORM, SHFT, DADD, SAVE, LOAD /RESULT IN FAC (RE-NORMALIZED),AC=0,L=U /TEMPORARY STORAGE ALLOCATION: FADSHF=TEMP01 ADDEND=TEMP02 /03 AND 04 AUGEND=TEMP05 /06 AND 07 /ARITHMETIC REGISTER ALLOCATION BIGGER=FOP FADDS, 0 CLA CMA SHFT /PREPARE FOR POSSIBLE DADD OVERFLOW SAVE /LOSES LSB OF MANTISSA ADDEND TAD I FADDS /GET ARGUMENT ADDRESS DCA .+2 LOAD /ARGUMENT TO FAC 0 CLA CMA /SHIFT FOR POSSIBLE OVERFLOW ALSO SHFT SAVE /SUM HAS 23 BITS PRECISION AUGEND ISZ FADDS /SETUP FOR EXIT TAD ADDEND /COMPARE EXPONENTS CMA IAC /WHICH TO SHIFT (SMALLER ARGUMENT) TAD AUGEND /TO ALIGN BINARY POINTS SPA /EXP DIFFERENCE IN AC JMP FADADD /EXP OF AUGEND SMALLER CMA IAC /MAKE DIFFERENCE NEGATIVE DCA FADSHF /TO SHIFT RIGHT LOAD /AUGEND (OLD FAC) IS LARGER AUGEND SAVE BIGGER LOAD /PREPARE TO SHIFT ADDEND ADDEND JMP FADFIN
FADADD, DCA FADSHF /AUGEND (OLD FAC) IS SMALLER LOAD ADDEND SAVE /SAVE ADDEND AS LARGER ARGUMENT BIGGER LOAD /PREPARE TO SHIFT SMALLER ARG AUGEND FADFIN, TAD FADSHF SHFT /ALIGN ARGUMENTS DADD /ADD MANTISSAS LOAD /NORMALIZE RESULT FOP NORM SNA /0 IF MANISSAS ADDED TO 0 JMP FADEXP /ZERO SHOWN AS 0*2^0 TAD KM0026 /-22(10) TAD BIGGER /ADD +1 TO -21(10) TO LARGER EXP FADEXP, DCA FAC /SAVE AS NEW EXPONENT JMP I FADDS /LOCAL CONSTANT KM0026, -0026 /SUBROUTINE TO INITIALIZE COUNTERS AND SWITCHES USED IN FMUL AND FDIV FLSIGN=TEMP03 FCNTR=TEMP04 FARG=TEMP05 /06 AND 07 GARG, 0 DCA LOCARG /AC HOLDS LOCATION OF ARGUMENT TAD FAC+1 SMA CLA /SET FLSIGN WITH SIGN OF FAC CMA DCA FLSIGN ISZ FLSIGN /LEAVE FLSIGN=0 FOR +, 1 FOR - DCOM /GET .ABS. FAC SAVE FARG LOAD LOCARG, 0 TAD FAC+1 /GET SIGN OF ARGUMENT SPA CLA CLA CMA TAD FLSIGN /+OP+=+, -OP-=+, +OP-=-, -OP+=- DCA FLSIGN /FLSIGN = 0 FOR +, .NE. 0 FOR - TAD FAC+1 /GET .ABS. ARG SPA CLA DCOM /.LT. 0: GET COMPLEMENT AND SET L=0 TAD KM0027 /-23(10) DCA FCNTR JMP I GARG
/THIS SUBROUTINE FLOATS AC TO FAC: FLOAT FLOATS, 0 DCA FAC+1 TAD KM014 /SHIFT TO GET SIGN EXTENSION SHFT NORM DCA FAC /NORMALIZE JMP I FLOATS /LOCAL CONSTANT KM014, -0014 /SUBROUTINE TO FLOATING DIVIDE FAC BY ARGUMENT- FDIV /CALL: FDIV / ARG ADDRESS /ARG ADDRESS HOLD ARGUMENT / (RETURN) /AC=0, L UNSPECIFIED /MODIFIES ARITH0-5 (FAC,FOP), TEMP01-14, REMAINDER IN FOP /TEMPORARY STORAGE ALLOCATION DVSOR=TEMP10 /11 AND 12 QUO=TEMP05 /06 AND 07 FDIVS, 0 TAD I FDIVS /GET ADDRESS OF ARGUMENT ISZ FDIVS /EXIT TO CALL+2 JMS GARG /GET .ABS. FAC, .ABS. ARG, SIGN OF RESULT DCOM SAVE /ARG IS DIVISOR DVSOR LOAD /.ABS. FAC: DIVIDEND FARG SAVE FOP DCA FAC+1 /FAC WILL HOLD QUOTIENT DCA FAC+2 DVLOOP, IAC /QUO*2 SHFT SAVE QUO LOAD DVSOR /TRIAL SUBTRACTION DADD TAD FOP+1 /CHECK FOR - AS RESULT OF TRIAL SMA CLA JMP DVOK /POSITIVE, INCREASE QUOTIENT DCOM /NEGATIVE, REVERSE DADD DCOM SKP /BUT DON'T INCREASE QUOTIENT
DVOK, ISZ QUO+2 /MARK QUOTIENT CLA CMA /NEXT TIME REDUCE DIMINISHER SHFT SAVE DVSOR LOAD /MAKE READY TO MULTIPLY QUOTIENT QUO ISZ FCNTR /DO THIS 23 TIMES JMP DVLOOP /CONTINUE NORM /NORMALIZE MANTISSA SNA JMP DVEXP /0 MANTISSA IMPLIES ZERO - EXIT IMMEDIATELY TAD FOP /ADJUST EXPONENT TAD KM0026 CMA IAC TAD DVSOR CMA IAC DVEXP, DCA FAC TAD FLSIGN /ADJUST SIGN SZA CLA /FLSIGN=0 FOR POSITIVE QUOTIENT DCOM JMP I FDIVS
*7000 /THIS SECTION MOVES JLIST, RESETS DISPLAYS, CALCULATES S.D., TREND /REQUIRES [SU63A], [SU64A]; IS [U14MA] /MOVE JLIST FROM "LOCORE" TO "JOB0+7", ADJUST J1 AND DWORDS START, TAD ADJLIS /SETUP JOB LIST GET-POINTER DCA JGETP /AUTO-INDEX REGISTER JGETP=10 TAD ADBUFA /SETUP JOB LIST PUT-POINTER DCA JPUTP JPUTP=11 JMOVE, CLL CLA /"LOCORE" MUST BE .GE. 230 TAD I JGETP /GET J1 SNA JMP JARITH /J1=0, END OF LIST SPA /IF B-SWEEP, SET LINK=1 CML AND K4077 /J1 BITS 1-5 NOW SHOW SCALE FACTOR DCA I JPUTP /SET TO 0 SCALE TAD KM0004 /SETUP MOVE NEXT 4 WORDS AS IS DCA JPCNTR JPCNTR=TEMP01 TAD I JGETP /MOVE J2-J5 DCA I JPUTP /MAKING NO CHANGES ISZ JPCNTR JMP .-3 SZL /MODIFY DISPLAY WORDS (J6,J7) TAD K0005 /LINK=1 FOR B-SWEEEP TAD ADSAMA /GET ADDRESS HOLDING # OF DATA POINTS DCA JPCNTR TAD I JPCNTR /-# OF DATA POINTS FLOAT SAVE FSAM TAD KDSIZE /-AVAILABLE DISPLAY REGION (X) FLOAT FDIV /GET DISTANCE BETWEEN POINTS FSAM TAD K0007 /MOVE BINARY POINT LEFT 8 PLACES FIX /DELTAX(8): IPART(5), FPART(3) AND K7760 /D1: DELTAX(8), YS(4); YS=0 SNA /DELTAX .GE. 0000.0001(2) TAD K0020 DCA I JPUTP /J6 IS D1 ISZ JGETP /DON'T GET J6 TAD K1000 DCA I JPUTP /J7=D2: X0(6), Y0(6); X0=0, Y0=0 ISZ JGETP /DON'T GET J7 JMP JMOVE /GET NEXT JOB IN JLIST
/LOCAL CONSTANTS K0005, +0005 K1000, 1000 K0014, +0014 K0020, +0020 K4077, +4077 K7760, +7760 ADSAMA, SAMA /DISPLAY ALLOCATION PARAMETERS KDSIZE, -2000 /FROM X=0 TO X=777 AVAILABLE /SUBROUTINE PICKS UP 3 WORDS FROM DATA BLOCK AND FLOATS TFLOTS, 0 JMS I CDFX /SET DATA FIELD TAD I GETPNT /GET LO-ORDER WORD DCA TRIPSV TRIPSV=TEMP03 JMS DGETS /GETS MID AND HI-ORDER NORM /NORMALIZE HI-MID PARTS TAD K0014 /*2^12, THERE'S LO-ORDER TOO. DCA FAC SAVE FOP TAD TRIPSV /SETUP TO SHIFT LO ORDER DCA ARITH2 /FILLS ZEROES IN NORMALIZED HI-MID DCA ARITH1 TAD FAC /NORMALIZATION SHIFTED HI-MID TAD KM0027 /-(FAC-12-23) PLACES LEFT CMA IAC /LO HAS ALREADY BEEN SHIFTED 12 LEFT SHFT /SO SHIFT -(FAC-23) PLACES MORE DADD /AND ADD IN HI-MID PARTS LOAD FOP NORM /NORMALIZE HI-MID-LO SNA JMP .+3 /RESULT IS 0, SET EXPONENT=0 TAD KM0027 /-PLACES SHIFTED LEFT IN THIS NORMALIZATION TAD FAC /DECREASE EXPONENT BY THIS DCA FAC JMP I TFLOTS /SUBROUTINE TO PICKUP 2 WORDS FROM DATA AND PUT IN FAC DGETS, 0 JMS I CDFX /SETUP DATA FIELD TAD I GETPNT /GET LO-ORDER WORD (*) DCA ARITH2 /SAVE IN FAC+2 (*) TAD I GETPNT /GET HI-ORDER WORD (*) DCA ARITH1 /SAVE IN FAC+1 (*) CDF 0 /(*) JMP I DGETS
/SUBROUTINE TO SAVE FAC+1, +2 IN DATA BLOCK (HI,LO) DPUTS, 0 JMS I CDFX /SETUP DATA FIELD TAD ARITH1 /GET HI ORDER WORD (*) DCA I PUTPNT /SAVE (*) TAD ARITH2 /GET LOW ORDER WORD (*) DCA I PUTPNT /SAVE (*) CDF 0 /(*) JMP I DPUTS /LOCAL CROSSPAGE PASETX, PASET CDFX, CDFS CDXMX, CDXM DATA0X, DATA0 /CALCULATE M, C, AND 1000T; PACK C TO 2WDS, 1000T TO 1 /AUTO INDEX REGISTERS GETPNT=11 PUTPNT=12 JARITH, DCA I JPUTP /0 FOR EOL TAD JPUTP /JOB LIST ENDS HERE DCA I DATA0X /LOC-1 OF 1ST POINT AVAIL FOR DATA TAD ADBUFA /JOB LIST STARTS AT "JOB0+7" DCA JGETP JARGO, CDF 0 TAD I JGETP /GET NEXT JOB SNA CLA /IS J1=0? JMP I PASETX /YES, SET UP NEW PARAMS TAD I JGETP /NO, GET J2 DCA ARITH2 /J2: TYPE(4),SORT CODE(8) DCA ARITH1 /GET JOB TYPE# TAD K0004 /SHIFT TO 4 LO-ORDER OF SHFR SHFT TAD ARITH1 DCA TJTYPE TJTYPE=TEMP13 TAD I JGETP /J3: LINKAGE 1 DCA BLCNTR /-# OF DATA POINT IN BLK1 BLCNTR=TEMP14 TAD I JGETP /J4: LINKAGE 2 DCA I CDXMX /CDF FOR FIRST BLOCK TAD I JGETP /J5: LINKAGE3 DCA GETPNT /LOC-1 OF START FOR FIRST BLOCK ISZ JGETP /SKIP OVER J6 AND J7 ISZ JGETP TAD GETPNT /SET PUT-POINTER DCA PUTPNT JMS I CDFX /SET DATA FIELD TAD I GETPNT /GET # OF SWEEPS (*) DCA TN /(*) TN=TEMP01
TAD TN /(*) DCA I PUTPNT /AND PUT IT BACK (*) CDF 0 /(*) TAD TN /FLOAT # OF SWEEPS FLOAT SAVE /FN=# OF SWEEPS, N FN FADD /GET N-1 FM001K SAVE /N-1=# OF SWEEPS -1, FNM1 FNM1 /NM, NS, 1000T FOR EACH DATA POINT /U=SUM, V=SUM OF SQUARES, W=SUMS OF SQ. OF DIFF. JALOOP, JMS I DGETX /GET U (LO,HI) NORM /FLOAT IT DCA FAC SAVE /SAVE SUM FOR LATER CALCULATIONS FSUM FDIV /GET MEAN FN TAD K014 /SCALED UP BY 2^12 DFIX FAC+1 JMS I DPUTX /AND PUT IT BACK (HI,LO) CLA CMA /JOB TYPE=1? TAD TJTYPE SZA CLA JMP JASDEV /NO, CALCULATE NC JAREND, ISZ BLCNTR /YES, DONE WITH BLOCK? JMP JALOOP /NO, GET NEXT POINT JMS CDFS TAD I GETPNT /YES, RESET BLOCK COUNTER (*) DCA BLCNTR /(*) TAD BLCNTR /MOVE LINKAGE TO PUT-DATA (*) DCA I PUTPNT /(*) TAD BLCNTR /WAS COUNT FOR NEXT BLOCK=0? (*) SNA CLA /(*) JMP I JARGOX /YES, GET NEXT JOB (*) TAD I GETPNT /GET LINKAGE 2 (*) DCA CDXM /CDF FOR BLOCK (*) TAD CDXM /MOVE LINKAGE (*) DCA I PUTPNT /(*) TAD I GETPNT /GET LINKAGE 3 (*) DCA GETPNT /LOC-1 OF START NEXT BLOCK (*) TAD GETPNT /GET-POINTER SETUP (*) DCA I PUTPNT /MOVE LINKAGE (*) TAD GETPNT /RESET PUT-POINTER (*) DCA PUTPNT /(*) CDF 0 /(*) JMP JALOOP /GET NEXT POINT
/SUBROUTINE TO SET FIELD FOR CURRENT BLOCK CDFS, 0 CDXM, CDF JMP I CDFS /LOCAL CROSSPAGE DGETX, DGETS DPUTX, DPUTS TFLOTX, TFLOTS JARGOX, JARGO /LOCAL CONSTANT K014, 14 K0015, 15 /COMPUTE C=2[(V-U^2/N)/(N(N-1))]^0.5 JASDEV, LOAD FSUM FMUL /U^2 FSUM DCOM /-U^2 FDIV FN SAVE FSUM /FSUM=-U^2/N JMS I TFLOTX /GET V AND FLOAT IT FADD /V-U^2/N FSUM SAVE /FVAR=V-U^2/N FVAR /BLOCKS FSUM PATCH1, FDIV /REPLACE WITH SKP FOR S.D. FN FDIV /(S^2)/N=(V-U^2/N)/[N(N-1)] FNM1 TAD FAC+1 /PROTECT AGAINST TRYING TO SQRT A NEGATIVE SMA CLA JMP .+4 DCA FAC /IF -, MAKE 0 DCA FAC+1 DCA FAC+2 SAVE FNROOT /BLOCKS FSUMSQ TWOK /PLACE INITIAL GUESS FOR SQRT IN FAC DCA FAC+1 /MAKE MANTISSA=2000 0000 DCA FAC+2 TAD FAC /SET EXPONENT TO 1/2 ARGUMENT'S SPA /DO SIGN EXTENSION CML RAR DCA FAC
SQLOOP, SAVE /CURRENT GUESS IN FAC: Y(I) FTRIAL /FTRIAL=Y(N) LOAD /NEWTON CLAIMS THAT FOR Y=X^0.5, FNROOT /Y(I+1)=0.5[Y(I)+X/Y(I)], CONVERGES. FDIV /X/Y(I) FTRIAL FADD /Y(I)+X/Y(I) FTRIAL CLA CMA /[Y(I)+X/Y(I)]*0.5 TAD FAC DCA FAC SAVE /FNEXT=Y(I+1), NEXT GUESS FNEXT DCOM FADD /Y(I)-Y(I+1), THIS AND NEXT GUESS FTRIAL TAD FAC /EXPONENT OF DIFFERENCES IN GUESSES DCA TDIFF TDIFF=TEMP01 LOAD FNEXT CLA CMA /IF .ABS. DIFFERENCE .LT. 2, TAD TDIFF /THEN WE ARE DONE (NEWTON WAS RIGHT) SZA SMA CLA /EXPONENT .LE. 1 TO BE DONE JMP SQLOOP /NO, CONTINUE ITERATIONS PATCH2, TAD K0015 /2S/(N)^0.5 DFIX /DONE, GET DBL PREC. RESULT FAC+1 /LEAVE IN FAC+1, FAC+2 JMS I DPUTX /SAVE NS IN BUFFER MTW /WAS TREND REQUESTED TOO? TAD TJTYPE SNA CLA JMP JAREND /NO, GO TO NEXT DATA POINT ISZ GETPNT /YES, SKIP X(I-1) WORD JMS I TFLOTX /GET 1000T, FLOAT W FMUL /MULTIPLY BY 1000 F1000K /1000T=1000W/(V-U^2/N) FDIV /1000W/(V-U^2/N) FVAR CLA CMA FIX /1000T IS BETWEEN 0 AND 4000 CLL RAL SNA TAD KD2000 JMS I CDFY DCA I PUTPNT /SAVE 1000T IN BUFFER (*) CDF 0 /(*) JMP I JARENX /GET NEXT DATA POINT /LOCAL CROSS PAGE JARENX, JAREND CDFY, CDFS
/LOCAL CONSTANTS KD2000, 3720 /2000(10) /FLOATING CONSTANTS F1000K, 12 /1000(10) 3720 /2000(10) 0 FM001K, 1 6000 0 /FLOATING VARIABLES FSAM=. FN=FSAM FNM1=FN+3 FSUM=FNM1+3 FVAR=FSUM FNROOT=FSUM+3 FTRIAL=FNROOT+3 FNEXT=FTRIAL+3 *7442 PASET, TAD ADBUFA DCA I K0200 JMP OVRLAY K0200, 200 KC7746, 7746 $