$JOB LSD TEST JOB $EXECUTE FORTRAN $BLOCK BCD,0084 *ID 006 064122133000 5932 2R0300 D*91204400RRSMITH 5932 20145164 * XEQ * FORTRAN C TEST DRIVER TEST0001 DIMENSION SAVE(8),AL(40,41),AR(40,41),AINVL(40,40),AINVR(40,40) TEST0002 COMMON SAVE TEST0003 1000 FORMAT(I6) TEST0004 1001 FORMAT (7F16.8) TEST0005 1002 FORMAT(54H ISING IS 1 - SINGULAR MATRIX INCLUDED IN INPUT MATRIX )TEST0006 108 READ INPUT TAPE 5, 1000, N TEST0007 IF(N) 200, 200, 201 TEST0008 C DEFINE AL AND AR TEST0009 201 M = N +1 TEST0010 ISWTCH = 1 TEST0011 DO 100 I = 1,N TEST0012 EN = N + 1 - I TEST0013 DO 100 J = 1,N TEST0014 IF (J - I) 101, 101, 102 TEST0015 102 EN = EN - 1.0 TEST0016 101 AL(I,J) = EN TEST0017 100 AR(I,J) = EN TEST0018 C END DEFINITION OF AL AND AR. OUTPUT AL AND AR TO VERIFY DEFINITION. TEST0019 C AT THIS POINT ONE MIGHT ALSO INCLUDE CHECK THAT AL(I,J) LSS OR EQ TEST0020 C AR(I,J). THIS MUST BE TRUE BY DEFINITION OF INTERVAL ARITHMETIC. TEST0021 C TEST0022 DO 109 I = 1,N TEST0023 109 WRITE OUTPUT TAPE 6, 1001, ((AL(I,J),AR(I,J)), J = 1,N) TEST0024 C TEST0025 C FIND INVERSE OF AI = (AL,AR) TEST0026 DO 103 I = 1,N TEST0027 DO 104 K = 1,N TEST0028 AL(K,M) = 0.0 TEST0029 104 AR(K,M) = 0.0 TEST0030 AL(I,M) = 1.0 TEST0031 AR(I,M) = 1.0 TEST0032 CALL LSD (AL,AR,N,ISWTCH,ISING) TEST0033 IF(ISING) 105, 106, 105 TEST0034 106 ISWTCH = 2 TEST0035 C BOUNDS FOR THE INVERSE OF AI FOUND IN AINVL (LEFT END PTS.) AND TEST0036 C AND AINVR (RIGHT END PTS.) TEST0037 DO 107 J = 1,N TEST0038 AINVL(J,I) = AL(J,M) TEST0039 107 AINVR(J,I) = AR(J,M) TEST0040 103 CONTINUE TEST0041 C OUTPUT INVERSE MATRIX TEST0042 DO 110 I = 1,N TEST0043 110 WRITE OUTPUT TAPE 6, 1001, ((AINVL(I,J),AINVR(I,J)),J = 1,N) TEST0044 GO TO 108 TEST0045 C ERROR TEST0046 105 WRITE OUTPUT TAPE 6, 1002 TEST0047 200 CALL EXIT TEST0048 END TEST0049 * FORTRAN SUBROUTINE LSD (AL,AR,N,ISWTCH,ISING) LSD00001 DIMENSION AL(40,41),AR(40,41), A(40,41), EXL(40),EXR(40) LSD00002 COMMON C4,C3,C2,C1,U4,U3,U2,U1 LSD00003 100 FORMAT(66H ERROR FLAG ISING IS SET IN HINT ROUTINE WHICH IS USED BLSD00004 1Y LSD ) LSD00005 101 FORMAT (47H ISWTCH IS NOT POSITIVE. ERROR IN CALLING LSD ) LSD00006 102 FORMAT(55H ERROR FLAG ISING IS SET IN CRISIM WHICH IS USED BY LSD)LSD00007 M = N + 1 LSD00008 IF(ISWTCH - 1) 22, 20, 21 LSD00009 C ERROR FLAG LSD00010 22 WRITE OUTPUT TAPE 6, 101 LSD00011 GO TO 50 LSD00012 20 DO 1 I = 1,N LSD00013 DO 1 J = 1,N LSD00014 1 A(I,J) = (AL(I,J) + AR(I,J)) / 2.0 LSD00015 CALL HINT (A,N,ISING) LSD00016 IF(ISING) 2,3,2 LSD00017 C ERROR FLAG LSD00018 2 WRITE OUTPUT TAPE 6, 100 LSD00019 GO TO 50 LSD00020 C MULT B X A LSD00021 3 DO 10 I = 1,N LSD00022 DO 11 J = 1,N LSD00023 TMP1 = 0.0 LSD00024 TMP2 = 0.0 LSD00025 TMP3 = 0.0 LSD00026 TMP4 = 0.0 LSD00027 DO 12 K = 1,N LSD00028 C1 = A(J,K) LSD00029 C3 = C1 LSD00030 U1 = AL(K,I) LSD00031 U3 = AR(K,I) LSD00032 CALL RMULT LSD00033 U1 = TMP1 LSD00034 U2 = TMP2 LSD00035 U3 = TMP3 LSD00036 U4 = TMP4 LSD00037 CALL DADD LSD00038 TMP1 = C1 LSD00039 TMP2 = C2 LSD00040 TMP3 = C3 LSD00041 12 TMP4 = C4 LSD00042 CALL ACDTOS LSD00043 EXL(J) = C1 LSD00044 11 EXR(J) = C3 LSD00045 DO 13 J = 1,N LSD00046 AL(J,I) = EXL(J) LSD00047 13 AR(J,I) = EXR(J) LSD00048 10 CONTINUE LSD00049 C MULT B X RIGHT HAND SIDE LSD00050 21 DO 14 I = 1,N LSD00051 TMP1 = 0.0 LSD00052 TMP2 = 0.0 LSD00053 TMP3 = 0.0 LSD00054 TMP4 = 0.0 LSD00055 DO 15 K = 1,N LSD00056 C1 = A(I,K) LSD00057 C3 = C1 LSD00058 U1 = AL(K,M) LSD00059 U3 = AR(K,M) LSD00060 CALL RMULT LSD00061 U1 = TMP1 LSD00062 U2 = TMP2 LSD00063 U3 = TMP3 LSD00064 U4 = TMP4 LSD00065 CALL DADD LSD00066 TMP1 = C1 LSD00067 TMP2 = C2 LSD00068 TMP3 = C3 LSD00069 15 TMP4 = C4 LSD00070 CALL ACDTOS LSD00071 EXL(I) = C1 LSD00072 14 EXR(I) = C3 LSD00073 DO 16 J = 1,N LSD00074 AL(J,M) = EXL(J) LSD00075 16 AR(J,M) = EXR(J) LSD00076 CALL CRISIM (AL,AR,N,ISWTCH,ISING) LSD00077 IF (ISING) 23,50,23 LSD00078 C ERROR FLAG LSD00079 23 WRITE OUTPUT TAPE 6,102 LSD00080 50 RETURN LSD00081 END LSD00082 * FORTRAN SUBROUTINE CRISIM (AL,AR,L,ISWTCH,ISING) CRIS0001 C CRISIM IS BASICALLY A = LU DECOMPOSITION CRIS0002 DIMENSION AL(40,41), AR(40,41), EL(40),IPIVOT(40) CRIS0003 COMMON C4, C3, C2, C1, U4,U3,U2,U1 CRIS0004 1000 FORMAT( 42H ISWTCH IS NOT POSITIVE IN CRISIM - ERROR ) CRIS0005 IF(ISWTCH - 1) 22,20,16 CRIS0006 C ERROR FLAG CRIS0007 22 WRITE OUTPUT TAPE 6, 1000 CRIS0008 GO TO 19 CRIS0009 20 ISING = 0 CRIS0010 DO 30 I = 1,L CRIS0011 30 IPIVOT(I) = I CRIS0012 M=L CRIS0013 N=M+1 CRIS0014 I1=1 CRIS0015 1 I3=I1 CRIS0016 SUM = MIN1F(ABSF(AL(I1,I1)),ABSF(AR(I1,I1))) CRIS0017 DO 3 I=I1,M CRIS0018 TEMP = MIN1F(ABSF(AL(I,I1)),ABSF(AR(I,I1))) CRIS0019 IF(SUM - TEMP) 2, 3, 3 CRIS0020 2 I3=I CRIS0021 SUM = TEMP CRIS0022 3 CONTINUE CRIS0023 IF (I3-I1) 4,6,4 CRIS0024 4 DO 5 J=1,N CRIS0025 SUM = AL(I1,J) CRIS0026 AL(I1,J) = AL(I3,J) CRIS0027 AL(I3,J) = SUM CRIS0028 SUM = AR(I1,J) CRIS0029 AR(I1,J) = AR(I3,J) CRIS0030 5 AR(I3,J) = SUM CRIS0031 IPIVOT(I1) = I3 CRIS0032 6 I3=I1+1 CRIS0033 IF(CNTZRF(AL(I1,I1), AR(I1,I1)))7, 15, 7 CRIS0034 7 U1 = (AL(I1,I1) + AR(I1,I1)) / 2.0 CRIS0035 CALL EXTRCT CRIS0036 C THIS IS DIAGIONAL OF L I.E. L(I1,I1) CRIS0037 EL(I1) = U1 CRIS0038 C1 = AL(I1,I1) CRIS0039 C3 = AR(I1,I1) CRIS0040 U3 = U1 CRIS0041 IF (U1) 104, 15, 104 CRIS0042 104 CALL DIV CRIS0043 AL(I1,I1) = C1 CRIS0044 AR(I1,I1) = C3 CRIS0045 DO 8 I=I3,M CRIS0046 U1 = AL(I1,I1) CRIS0047 U3 = AR(I1,I1) CRIS0048 C1 = AL(I, I1) CRIS0049 C3 = AR(I,I1) CRIS0050 110 CALL DIV CRIS0051 AL(I,I1) = C1 CRIS0052 8 AR(I,I1) = C3 CRIS0053 9 J2=I1-1 CRIS0054 I3=I1+1 CRIS0055 IF (J2) 10,101, 10 CRIS0056 C NOTE THIS LOOP CHANGES RT HND SIDE CRIS0057 10 DO 100 J = I3, N CRIS0058 TMP1 = AL(I1, J) CRIS0059 TMP2 = 0.0 CRIS0060 TMP3 = AR(I1, J) CRIS0061 TMP4 = 0.0 CRIS0062 DO 11 I=1,J2 CRIS0063 C1 = - AR(I1,I) CRIS0064 C3 = -AL(I1,I) CRIS0065 U1 = AL(I,J) CRIS0066 U3 = AR(I,J) CRIS0067 CALL RMULT CRIS0068 U1 = TMP1 CRIS0069 U2 = TMP2 CRIS0070 U3 = TMP3 CRIS0071 U4 = TMP4 CRIS0072 CALL DADD CRIS0073 TMP1 = C1 CRIS0074 TMP2 = C2 CRIS0075 TMP3 = C3 CRIS0076 11 TMP4 = C4 CRIS0077 CALL ACDTOS CRIS0078 U1 = EL(I1) CRIS0079 U3 = EL(I1) CRIS0080 CALL DIV CRIS0081 AL(I1,J) = C1 CRIS0082 100 AR(I1,J) = C3 CRIS0083 IF (I1-M) 12,14,12 CRIS0084 12 J2=I1 CRIS0085 I1=I1+1 CRIS0086 DO 111 I= I1, M CRIS0087 TMP1 = AL(I,I1) CRIS0088 TMP2 = 0.0 CRIS0089 TMP3 = AR(I,I1) CRIS0090 TMP4 = 0.0 CRIS0091 DO 13 J=1,J2 CRIS0092 C1 = -AR(I,J) CRIS0093 C3 = -AL(I,J) CRIS0094 U1 = AL(J,I1) CRIS0095 U3 = AR(J,I1) CRIS0096 CALL RMULT CRIS0097 U1 = TMP1 CRIS0098 U2 = TMP2 CRIS0099 U3 = TMP3 CRIS0100 U4 = TMP4 CRIS0101 CALL DADD CRIS0102 TMP1 = C1 CRIS0103 TMP2 = C2 CRIS0104 TMP3 = C3 CRIS0105 13 TMP4 = C4 CRIS0106 CALL ACDTOS CRIS0107 AL(I,I1) = C1 CRIS0108 111 AR(I,I1) = C3 CRIS0109 IF(I1 - M) 1, 103, 1 CRIS0110 14 IF(CNTZRF(AL(M,M),AR(M,M))) 35, 15, 35 CRIS0111 15 ISING=1 CRIS0112 GO TO 19 CRIS0113 C BACKSOLVE USING U TRIANGLE CRIS0114 35 DO 18 I = 1,M CRIS0115 J2=M-I CRIS0116 I3=J2+1 CRIS0117 C1 = AL(I3,N) CRIS0118 C3 = AR(I3,N) CRIS0119 U1 = AL(I3,I3) CRIS0120 U3 = AR(I3,I3) CRIS0121 CALL DIV CRIS0122 AL(I3,N) = C1 CRIS0123 AR(I3,N) = C3 CRIS0124 IF (J2) 17,19,17 CRIS0125 17 DO 18 J=1,J2 CRIS0126 C1 = -AR(I3,N) CRIS0127 C3 = -AL(I3,N) CRIS0128 U1 = AL(J,I3) CRIS0129 U3 = AR(J,I3) CRIS0130 CALL MULT CRIS0131 U1 = AL(J,N) CRIS0132 U3 = AR(J,N) CRIS0133 CALL ADD CRIS0134 AL(J,N) = C1 CRIS0135 18 AR(J,N) = C3 CRIS0136 19 RETURN CRIS0137 101 DO 102 I = 2,N CRIS0138 C1 = AL(1,I) CRIS0139 C3 = AR(1,I) CRIS0140 U1 = EL(1) CRIS0141 U3 = EL(1) CRIS0142 CALL DIV CRIS0143 AL(1,I) = C1 CRIS0144 102 AR(1,I) = C3 CRIS0145 GO TO 12 CRIS0146 103 U1 = (AL(I1,I1) + AR(I1,I1)) / 2.0 CRIS0147 CALL EXTRCT CRIS0148 EL(I1) = U1 CRIS0149 C1 = AL(I1,I1) CRIS0150 C3 = AR(I1,I1) CRIS0151 U3 = U1 CRIS0152 CALL DIV CRIS0153 AL(I1,I1) = C1 CRIS0154 AR(I1,I1) = C3 CRIS0155 GO TO 9 CRIS0156 C MUST DO INTERCHANGES AND PROCESSING WITH L FOR ISWT = 2 CRIS0157 16 DO 31 K = 1,M CRIS0158 I = IPIVOT(K) CRIS0159 C DO INTERCHANGES CRIS0160 TMP1 = AL(I,N) CRIS0161 TMP2 = AR(I,N) CRIS0162 AL(I,N) = AL(K,N) CRIS0163 AR(I,N) = AR(K,N) CRIS0164 AL(K,N) = TMP1 CRIS0165 AR(K,N) = TMP2 CRIS0166 J2 = K - 1 CRIS0167 I3 = K +1 CRIS0168 IF(J2) 32, 33, 32 CRIS0169 32 TMP1 = AL( K,N) CRIS0170 TMP2 = 0.0 CRIS0171 TMP3 = AR( K,N) CRIS0172 TMP4 = 0.0 CRIS0173 DO 34 I = 1,J2 CRIS0174 C1 = -AR( K,I) CRIS0175 C3 = -AL( K,I) CRIS0176 U1 = AL(I,N) CRIS0177 U3 = AR(I,N) CRIS0178 CALL RMULT CRIS0179 U1 = TMP1 CRIS0180 U2 = TMP2 CRIS0181 U3 = TMP3 CRIS0182 U4 = TMP4 CRIS0183 CALL DADD CRIS0184 TMP1 = C1 CRIS0185 TMP2 = C2 CRIS0186 TMP3 = C3 CRIS0187 34 TMP4 = C4 CRIS0188 CALL ACDTOS CRIS0189 U1 = EL(K) CRIS0190 U3 = U1 CRIS0191 CALL DIV CRIS0192 AL(K,N) = C1 CRIS0193 AR(K,N) = C3 CRIS0194 GO TO 31 CRIS0195 33 C1 = AL(1,N) CRIS0196 C3 = AR(1,N) CRIS0197 U1 = EL(1) CRIS0198 U3 = EL(1) CRIS0199 CALL DIV CRIS0200 AL(1,N) = C1 CRIS0201 AR(1,N) = C3 CRIS0202 31 CONTINUE CRIS0203 GO TO 35 CRIS0204 END CRIS0205 * FORTRAN HINT0000 C MATRIX INVERSION SUBROUTINE UPDATED JULY 1964 HINT0010 SUBROUTINE HINT (A,IMAX,ISING) HINT0020 DIMENSION A(40,40),IN(40),TEMP(40) HINT0030 ISING=0 HINT0040 N=IMAX HINT0050 IMAXO=N-1 HINT0060 I1=1 HINT0070 10 I3=I1 HINT0080 IN(I1)=0 HINT0090 SUM=ABSF(A(I1,I1)) HINT0100 DO 20 I=I1,N HINT0110 IF (SUM-ABSF(A(I,I1))) 15,20,20 HINT0120 15 I3=I HINT0130 IN(I1)=I HINT0140 SUM=ABSF(A(I,I1)) HINT0150 20 CONTINUE HINT0160 IF (I3-I1) 25,35,25 HINT0170 25 DO 30 J=1,N HINT0180 SUM=A(I1,J) HINT0190 A(I1,J)=A(I3,J) HINT0200 30 A(I3,J)=SUM HINT0210 35 I3=I1+1 HINT0220 IF (A(I1,I1)) 40,160,40 HINT0230 40 DO 45 I=I3,N HINT0240 45 A(I,I1)=A(I,I1)/A(I1,I1) HINT0250 J2=I1-1 HINT0260 IF (J2) 50,60,50 HINT0270 50 DO 55 J=I3,N HINT0280 DO 55 I=1,J2 HINT0290 55 A(I1,J)=A(I1,J)-A(I1,I)*A(I,J) HINT0300 60 J2=I1 HINT0310 I1=I1+1 HINT0320 DO 65 I=I1,N HINT0330 DO 65 J=1,J2 HINT0340 65 A(I,I1)=A(I,I1)-A(I,J)*A(J,I1) HINT0350 IF (I1-N) 10,70,10 HINT0360 70 IF (A(N,N)) 75,160,75 HINT0370 75 DO 90 JP=1,N HINT0380 J=N+1-JP HINT0390 A(J,J)=1.0/A(J,J) HINT0400 IF (J-1) 80,95,80 HINT0410 80 DO 90 IP=2,J HINT0420 I=J+1-IP HINT0430 IPO=I+1 HINT0440 SUM=0. HINT0450 DO 85 L=IPO,J HINT0460 85 SUM=SUM-A(I,L)*A(L,J) HINT0470 90 A(I,J)=SUM/A(I,I) HINT0480 95 DO 115 J=1,IMAXO HINT0490 JPO=J+1 HINT0500 DO 115 I=JPO,N HINT0510 SUM=0. HINT0520 IMO=I-1 HINT0530 DO 110 L=J,IMO HINT0540 IF (L-J) 100,105,100 HINT0550 100 SUM=SUM-A(I,L)*A(L,J) HINT0560 GO TO 110 HINT0570 105 SUM=SUM-A(I,L) HINT0580 110 CONTINUE HINT0590 115 A(I,J)=SUM HINT0600 DO 140 I=1,N HINT0610 DO 135 J=1,N HINT0620 TEMP(J)=0.0 HINT0630 DO 130 K=I,N HINT0640 IF (K-J) 130,125,120 HINT0650 120 TEMP(J)=TEMP(J)+A(I,K)*A(K,J) HINT0660 GO TO 130 HINT0670 125 TEMP(J)=TEMP(J)+A(I,K) HINT0680 130 CONTINUE HINT0690 135 CONTINUE HINT0700 DO 140 J=1,N HINT0710 140 A(I,J)=TEMP(J) HINT0720 DO 155 I=2,N HINT0730 M=N+1-I HINT0740 IF (IN(M)) 145,155,145 HINT0750 145 ISS=IN(M) HINT0760 DO 150 L=1,N HINT0770 SUM=A(L,ISS) HINT0780 A(L,ISS)=A(L,M) HINT0790 150 A(L,M)=SUM HINT0800 155 CONTINUE HINT0810 GO TO 165 HINT0820 160 ISING=1 HINT0830 165 RETURN HINT0840 END HINT0850 * FAP ENTRY EXTRCT EXTR0001 COMMON 6 EXTR0002 U2 COMMON 1 EXTR0003 U1 COMMON 1 EXTR0004 EXTRCT PXD 0,0 EXTR0005 LDQ U1 EXTR0006 LLS 8 EXTR0007 SSP EXTR0008 ADM NORM1 EXTR0009 ARS 1 EXTR0010 LRS 8 EXTR0011 STQ U2 EXTR0012 CAL U1 EXTR0013 ADM NORM2 EXTR0014 SBM U2 EXTR0015 SLW U1 EXTR0016 TRA 1,4 EXTR0017 NORM1 OCT 000000000200 EXTR0018 NORM2 OCT 201400000000 EXTR0019 END EXTR0020 * FAP ENTRY CNTZR CNTZ0001 COMMON 5 CNTZ0002 U3 COMMON 1 CNTZ0003 U2 COMMON 1 CNTZ0004 U1 COMMON 1 CNTZ0005 CNTZR STQ U1 CNTZ0006 TNZ *+2 CNTZ0007 TRA 1,4 CNTZ0008 TMI *+6 CNTZ0009 CLA U1 CNTZ0010 TNZ *+2 CNTZ0011 TRA 1,4 CNTZ0012 TMI ERR CNTZ0013 TRA 1,4 CNTZ0014 CLA U1 CNTZ0015 TMI 1,4 CNTZ0016 ERR PXD 0,0 CNTZ0017 TRA 1,4 CNTZ0018 END CNTZ0019 * FAP ENTRY ADD ADRM0001 ENTRY RMULT ADRM0002 X EQU 4 ADRM0003 ADD NZT OPER RANGE ADD ADRM0004 ZET OPERP ADRM0005 TRA *+2 ADRM0006 TRA 1,X ADRM0007 NZT ACC TEST FOR ZERO ACCUMULATOR ADRM0008 ZET ACCP ADRM0009 TRA *+6 ADRM0010 CLA OPER IF ACC IS ZERO,LOAD ACC ADRM0011 STO ACC WITH OPERAND AND EXIT W/O ADD ADRM0012 CLA OPERP ADRM0013 STO ACCP ADRM0014 TRA 1,X ADRM0015 CLA ACC STO ACCUMULATOR IN TEMP ACC ADRM0016 STO TAC ADRM0017 CLA ACCP ADRM0018 STO TAC+1 ADRM0019 FAD OPERP ADRM0020 STO ACCP ADRM0021 LLS 8 ADRM0022 STQ REM+1 ADRM0023 ZET REM+1 ADRM0024 TRA BLIP ADRM0025 CLA TAC+1 ADRM0026 STO KAR ADRM0027 CLA MASK ADRM0028 ANS KAR ADRM0029 ANA OPERP ADRM0030 SUB KAR ADRM0031 SSP ADRM0032 CAS KMX ADRM0033 TRA *+3 ADRM0034 TRA BLIP ADRM0035 TRA BLIP ADRM0036 ZET TAC+1 ADRM0037 NZT OPERP ADRM0038 TRA BLIP ADRM0039 CLA ONE ADRM0040 STO REM+1 ADRM0041 BLIP CLA ACC ADRM0042 FAD OPER ADRM0043 STO ACC ADRM0044 LLS 8 ADRM0045 STQ REM ADRM0046 APE1 ZET REM IF LOWER SUM ZERO,CHECK FOR OVER- ADRM0047 TRA ROUND ENTER ROUND SUBROUTINE ADRM0048 CLA TAC ADRM0049 STO KAR ADRM0050 CLA MASK ADRM0051 ANS KAR ADRM0052 ANA OPER ADRM0053 SUB KAR ADRM0054 SSP ADRM0055 CAS KMX ADRM0056 TRA *+3 ADRM0057 TRA ROUND ADRM0058 TRA ROUND ADRM0059 ZET TAC ADRM0060 NZT OPER ADRM0061 TRA ROUND ADRM0062 CLA ONE ADRM0063 STO REM ADRM0064 ROUND NZT ACCP ADRM0065 STZ ACCP ADRM0066 CLA ACC ADRM0067 TNZ *+2 ADRM0068 SSP ADRM0069 TMI LEXX TRA TO CHECK IF BOTH EXTEND ADRM0070 TRA RIT EXTEND RIT ONLY ADRM0071 LEXX CLA ACCP ADRM0072 TMI LEF ADRM0073 TRA BOTH ADRM0074 KMX OCT 064000000000 MAX SHIFT COUNT ADRM0075 KAR PZE ADRM0076 EJECT ADRM0077 RIT NZT REM+1 ADRM0078 TRA 1,X ADRM0079 CAL ACCP ADRM0080 ANA MASK ADRM0081 ADD ONE ADRM0082 FAD ACCP ADRM0083 STO ACCP ADRM0084 TRA 1,X ADRM0085 BOTH NZT REM+1 ADRM0086 TRA LEF ADRM0087 CAL ACCP ADRM0088 ANA MASK ADRM0089 ADD ONE ADRM0090 FAD ACCP ADRM0091 STO ACCP ADRM0092 LEF NZT REM ADRM0093 TRA 1,X ADRM0094 CAL ACC ADRM0095 ANA MASK ADRM0096 ADD ONE ADRM0097 SSM ADRM0098 FAD ACC ADRM0099 STO ACC ADRM0100 TRA 1,X ADRM0101 MASK OCT 377000000000 ADRM0102 ONE OCT 1 ADRM0103 EJECT ADRM0104 RMULT CLA ACCP ADRM0105 TNZ *+3 ADRM0106 NZT ACC ADRM0107 TRA *+7 ADRM0108 CLA OPER ADRM0109 TNZ NOZ ADRM0110 CLA OPERP ADRM0111 TNZ NOZ ADRM0112 STO ACC ADRM0113 STO ACCP ADRM0114 STZ ACC+1 ADRM0115 STZ ACCP+1 ADRM0116 TRA 1,X ADRM0117 NOZ CLA ACCP ADRM0118 STO TAC+1 ADRM0119 CLA ACC ADRM0120 STO TAC ADRM0121 TMI K3 BEGIN SIGN DISCRIMINATIONS ADRM0122 CLA OPER A1+ NOW TEST A2 SIGN ADRM0123 TMI K1 ADRM0124 LDQ ACC ADRM0125 FMP OPER A1*A2 ADRM0126 STO ACC ADRM0127 STQ ACC+1 ADRM0128 LDQ ACCP ADRM0129 FMP OPERP ADRM0130 STO ACCP ADRM0131 STQ ACCP+1 ADRM0132 TRA 1,X ADRM0133 K1 CLA OPERP ADRM0134 TMI K2 B2 + OR - ADRM0135 XCA ADRM0136 FMP ACCP ADRM0137 STO ACCP ADRM0138 STQ ACCP+1 ADRM0139 LDQ OPER ADRM0140 FMP TAC+1 ADRM0141 STO ACC ADRM0142 STQ ACC+1 ADRM0143 TRA 1,X ADRM0144 K2 XCA ADRM0145 FMP ACC B2*A1 ADRM0146 STO ACCP ADRM0147 STQ ACCP+1 ADRM0148 LDQ TAC+1 LOAD B1 ADRM0149 FMP OPER A2*B1 ADRM0150 STO ACC ADRM0151 STQ ACC+1 ADRM0152 TRA 1,X ADRM0153 K3 CLA OPER A2 + OR - ADRM0154 TMI K5 ADRM0155 CLA TAC+1 B1 SIGN ADRM0156 TMI K4 ADRM0157 XCA ADRM0158 FMP OPERP ADRM0159 STO ACCP ADRM0160 STQ ACCP+1 ADRM0161 LDQ TAC ADRM0162 FMP OPERP ADRM0163 STO ACC ADRM0164 STQ ACC+1 ADRM0165 TRA 1,X ADRM0166 K4 XCA ADRM0167 FMP OPER A2*B1 ADRM0168 STO ACCP ADRM0169 STQ ACCP+1 ADRM0170 LDQ OPERP ADRM0171 FMP ACC B2*A1 ADRM0172 STO ACC ADRM0173 STQ ACC+1 ADRM0174 TRA 1,X ADRM0175 K5 CLA OPERP ADRM0176 TPL K7 ADRM0177 CLA TAC+1 TEST B1 ADRM0178 TMI K6 ADRM0179 LDQ OPER ADRM0180 FMP TAC A2*A1 ADRM0181 STO ACCP ADRM0182 STQ ACCP+1 ADRM0183 LDQ OPER A2*B1 ADRM0184 FMP TAC+1 ADRM0185 STO ACC ADRM0186 STQ ACC+1 ADRM0187 TRA 1,X ADRM0188 K6 XCA ADRM0189 FMP OPERP ADRM0190 STO ACC ADRM0191 STQ ACC+1 ADRM0192 LDQ TAC ADRM0193 FMP OPER A1*A2 ADRM0194 STO ACCP ADRM0195 STQ ACCP+1 ADRM0196 TRA 1,X ADRM0197 K7 CLA TAC+1 TEST B1 ADRM0198 TPL K8 ADRM0199 LDQ TAC ADRM0200 FMP OPERP ADRM0201 STO ACC ADRM0202 STQ ACC+1 ADRM0203 LDQ TAC ADRM0204 FMP OPER A1*A2 ADRM0205 STO ACCP ADRM0206 STQ ACCP+1 ADRM0207 TRA 1,X ADRM0208 K8 LDQ TAC ADRM0209 FMP OPER A1XA2 ADRM0210 STO ACCP ADRM0211 STQ ACCP+1 ADRM0212 LDQ TAC+1 B1XB2 ADRM0213 FMP OPERP ADRM0214 CAS ACCP ADRM0215 TRA FIX1 ADRM0216 TRA FIX2 ADRM0217 BBMAX LDQ TAC ADRM0218 FMP OPERP ADRM0219 STO ACC ADRM0220 STQ ACC+1 ADRM0221 LDQ TAC+1 ADRM0222 FMP OPER A2XB1 ADRM0223 CAS ACC SELECT MIN ADRM0224 TRA 1,X ADRM0225 TRA FIX4 ADRM0226 FIX5 STO ACC ADRM0227 STQ ACC+1 ADRM0228 TRA 1,X ADRM0229 FIX4 XCA ADRM0230 CAS ACC+1 ADRM0231 TRA 1,X ADRM0232 TRA 1,X ADRM0233 XCA ADRM0234 TRA FIX5 ADRM0235 XCA ADRM0236 FIX1 STO ACCP ADRM0237 STQ ACCP+1 ADRM0238 TRA BBMAX ADRM0239 FIX2 XCA ADRM0240 CAS ACCP+1 ADRM0241 TRA FIX1-1 ADRM0242 TRA BBMAX ADRM0243 TRA BBMAX ADRM0244 REM BSS 2 ADRM0245 TAC BSS 2 ADRM0246 COMMON 1 ADRM0247 ACCP COMMON 2 ADRM0248 ACC COMMON 2 ADRM0249 OPERP COMMON 2 ADRM0250 OPER COMMON 2 ADRM0251 END ADRM0252 * FAP ENTRY DADD DADD0001 X EQU 4 DADD0002 DADD NZT AC DADD0003 TRA SUBL DADD0004 CLA OP DADD0005 TZE UPPER DADD0006 TPL POP DADD0007 DLD AC DADD0008 TPL DIFFL DADD0009 DFAD OP DADD0010 FINL DST AC DADD0011 ANA MSK DADD0012 LDQ WON DADD0013 DFAM AC DADD0014 SSM DADD0015 DST AC DADD0016 TRA UPPER DADD0017 SUBU DLD OPP DADD0018 DST ACP DADD0019 TRA 1,X DADD0020 SUBL DLD OP DADD0021 DST AC DADD0022 TRA UPPER DADD0023 POP DLD AC DADD0024 TPL EASY DADD0025 DIFFL DUFA OP DADD0026 TZE SUBL+1 DADD0027 TMI FINL DADD0028 DST AC DADD0029 ANA MSK DADD0030 LDQ WON DADD0031 SSM DADD0032 DFAD AC DADD0033 DST AC DADD0034 UPPER NZT ACP DADD0035 TRA SUBU DADD0036 DLD OPP DADD0037 TZE 1,X DADD0038 TPL POPU DADD0039 DLD ACP DADD0040 TPL DIFFU DADD0041 DFAD OPP DADD0042 ZOUT DST ACP DADD0043 TRA 1,X DADD0044 POPU DLD ACP DADD0045 TPL EASY+3 DADD0046 DIFFU DUFA OPP DADD0047 TNZ EASY+4 DADD0048 DST ACP DADD0049 TRA 1,X DADD0050 EASY DFAD OP DADD0051 DST AC DADD0052 DLD ACP DADD0053 DFAD OPP DADD0054 DST ACP DADD0055 ANA MSK DADD0056 LDQ WON DADD0057 DFAD ACP DADD0058 DST ACP DADD0059 TRA 1,X DADD0060 ACPL COMMON 1 DADD0061 ACP COMMON 1 DADD0062 ACL COMMON 1 DADD0063 AC COMMON 1 DADD0064 OPPL COMMON 1 DADD0065 OPP COMMON 1 DADD0066 OPL COMMON 1 DADD0067 OP COMMON 1 DADD0068 MSK OCT 377000000000 DADD0069 WON OCT 1 DADD0070 END DADD0071 * FAP ENTRY DMULT DMUL0001 X EQU 4 DMUL0002 DMULT CLA OPER DOUBLE PRECISION INTERVAL MULTIPLY DMUL0003 TMI NPPO TO NOT PLUS PLUS OPER DMUL0004 DLD ACC OPER IS ++ DMUL0005 TPL PPPP ++,++ TRANSFER DMUL0006 DUFM OPER+2 ++,-QUESTIONMARK DMUL0007 DST ACC DMUL0008 TZE *+6 DMUL0009 ANA MSK DMUL0010 LDQ WON DMUL0011 DFAM ACC DMUL0012 SSM CANT ASSUME LOW ORDER SIGN UNLESS LRS 0 DMUL0013 DST ACC DMUL0014 DLD ACC+2 DMUL0015 TMI PPMM TO ++,-- DMUL0016 DUFM OPER+2 DMUL0017 DST ACC+2 ++,-+ DMUL0018 TZE 1,X DMUL0019 HEXT ANA MSK HIGH END EXTENSION DMUL0020 LDQ WON DMUL0021 DFAM ACC+2 DMUL0022 DST ACC+2 DMUL0023 TRA 1,X DONE ++,-+ DMUL0024 PPMM DFMP OPER DMUL0025 DST ACC+2 DMUL0026 TRA 1,X DONE ++,-- DMUL0027 NPPO DLD ACC DMUL0028 DST TAC DMUL0029 TMI MQMQ TO -Q,-Q DMUL0030 DLD ACC+2 -Q,++ DMUL0031 DUFM OPER DMUL0032 DST ACC DMUL0033 TZE *+6 DMUL0034 ANA MSK DMUL0035 LDQ WON DMUL0036 DFAM ACC DMUL0037 SSM LOW END SIGN NOT SET DMUL0038 DST ACC DMUL0039 DLD OPER+2 DMUL0040 TMI MMPP DMUL0041 DFMP ACC+2 -+,++ DMUL0042 DST ACC+2 DMUL0043 TNZ HEXT DMUL0044 TRA 1,X DONE -+,++ DMUL0045 MMPP CLA TAC DMUL0046 LDQ TAC+1 DMUL0047 DFMP OPER+2 DMUL0048 DST ACC+2 DMUL0049 TRA 1,X DONE --,++ DMUL0050 MQMQ DLD ACC+2 -Q,-Q DMUL0051 TPL MQMP TO -Q,-+ DMUL0052 DLD OPER+2 -Q,-- DMUL0053 TMI MMMM TO --,-- DMUL0054 DUFM ACC -+,-- DMUL0055 DST ACC DMUL0056 TZE *+6 DMUL0057 ANA MSK DMUL0058 LDQ WON DMUL0059 DFAM ACC DMUL0060 SSM LOW END SIGN NOT SET DMUL0061 DST ACC DMUL0062 CLA TAC DMUL0063 LDQ TAC+1 DMUL0064 DUFM OPER DMUL0065 DST ACC+2 DMUL0066 TNZ HEXT DMUL0067 TRA 1,X DONE -+,-- DMUL0068 MQMP DLD OPER+2 -',-+ DMUL0069 TPL MPMP TO -+,-+ DMUL0070 DLD ACC+2 --,-+ DMUL0071 DUFM OPER DMUL0072 DST ACC DMUL0073 TZE *+6 DMUL0074 ANA MSK DMUL0075 LDQ WON DMUL0076 DFAM ACC DMUL0077 SSM LOW END SIGN NOT SET DMUL0078 DST ACC DMUL0079 CLA TAC DMUL0080 LDQ TAC+1 DMUL0081 DUFM OPER DMUL0082 DST ACC+2 DMUL0083 TNZ HEXT DMUL0084 TRA 1,X DONE --,-+ DMUL0085 PPPP DFMP OPER ++,++ DMUL0086 DST ACC DMUL0087 DLD ACC+2 DMUL0088 DUFM OPER+2 DMUL0089 DST ACC+2 DMUL0090 TNZ HEXT DMUL0091 TRA 1,X DONE ++,++ DMUL0092 MMMM DFMP ACC+2 --,-- DMUL0093 DST ACC DMUL0094 CLA TAC DMUL0095 LDQ TAC+1 DMUL0096 DUFM OPER DMUL0097 DST ACC+2 DMUL0098 TNZ HEXT DMUL0099 TRA 1,X DONE --,-- DMUL0100 MPMP DFMP ACC -+,-+ THE MESSY ONE DMUL0101 DST ACC ACC IN TAC DMUL0102 DLD ACC+2 DMUL0103 DFMP OPER DMUL0104 CAS ACC BOTH NEGATIVE DMUL0105 TRA GOTIT THE ONE STORED IS USED DMUL0106 TRA TRYLO CHECK LOW ORDER PARTS DMUL0107 DST ACC USE THE FRESH ONE DMUL0108 TZE HIEND DMUL0109 EXTLO ANA MSK DMUL0110 LDQ TWO DMUL0111 DFAM ACC DMUL0112 SSM LOW ORDER SIGN NOT SET DMUL0113 DST ACC DMUL0114 HIEND DLD ACC+2 DMUL0115 DFMP OPER+2 DMUL0116 DST ACC+2 DMUL0117 CLA TAC DMUL0118 LDQ TAC+1 DMUL0119 DFMP OPER DMUL0120 CAS ACC+2 BOTH POSITIVE DMUL0121 TRA USEIT USE NEW ONE DMUL0122 TRA TRYHI TRY LOW ENDS DMUL0123 XXX DLD ACC+2 OLD ONE WAS OK DMUL0124 TZE 1,X DMUL0125 HEXT2 ANA MSK DMUL0126 LDQ TWO DMUL0127 DFAM ACC+2 DMUL0128 DST ACC+2 DMUL0129 TRA 1,X DMUL0130 GOTIT DLD ACC DMUL0131 TNZ EXTLO DMUL0132 TRA HIEND DMUL0133 USEIT DST ACC+2 IMBED SOMEPLACE ELSE DMUL0134 TNZ HEXT2 DMUL0135 TRA 1,X DMUL0136 TRYLO STO MPTMP LOW END SIGNS COMPUTED WHEN YOU GET HERE DMUL0137 CLA ACC+1 DMUL0138 TLQ *+4 DMUL0139 DLD ACC DMUL0140 TNZ EXTLO DMUL0141 TRA HIEND DMUL0142 CLA MPTMP DMUL0143 DST ACC DMUL0144 TNZ EXTLO DMUL0145 TRA HIEND DMUL0146 TRYHI STO MPTMP DMUL0147 CLA ACC+3 DMUL0148 TLQ XXX DMUL0149 CLA MPTMP DMUL0150 DST ACC+2 DMUL0151 TNZ HEXT2 DMUL0152 TRA 1,X DRINK UP AND GO HOME DMUL0153 BLIP PZE DMUL0154 TAC BSS 2 DMUL0155 MPTMP BSS 1 DMUL0156 SPACE DMUL0157 SPACE DMUL0158 MSK OCT 377000000000 DMUL0159 BIT9 OCT 400000000 DMUL0160 WON OCT 1 DMUL0161 TWO OCT 2 DMUL0162 COMMON 3 DMUL0163 ACC COMMON 4 DMUL0164 OPER COMMON 1 DMUL0165 END DMUL0166 * FAP IA000010 ENTRY SUB IAPK0001 ENTRY MULT IAPK0002 ENTRY DIV IAPK0003 ENTRY ABS IAPK0004 ENTRY INV IAPK0005 ENTRY SQR IAPK0006 ENTRY PANIC IAPK0007 X EQU 4 IAPK0008 J TAPENO A3 IAPK0009 ROUND NZT ACC2 IAPK0010 STZ ACC2 IAPK0011 CLA ACC IAPK0012 TNZ *+2 IAPK0013 SSP IAPK0014 TMI LEXX TRA TO CHECK IF BOTH EXTEND IAPK0015 TRA RIT EXTEND RIT ONLY IAPK0016 LEXX CLA ACC2 IAPK0017 TMI LEF IAPK0018 TRA BOTH IAPK0019 KMX OCT 064000000000 MAX SHIFT COUNT IAPK0020 KAR PZE IAPK0021 EJECT IAPK0022 SUB NZT OPER RANGE SUBTRACT IAPK0023 ZET OPER2 IAPK0024 TRA *+2 IAPK0025 TRA 1,X IAPK0026 NZT ACC IAPK0027 ZET ACC2 IAPK0028 TRA *+6 IAPK0029 CLS OPER IF ACC IS ZERO,LOAD THE NEG OF IAPK0030 STO ACC2 IAPK0031 CLS OPER2 IAPK0032 STO ACC IAPK0033 TRA 1,X IAPK0034 CLA ACC IAPK0035 STO TAC IAPK0036 CLA ACC2 IAPK0037 STO TAC+1 IAPK0038 FSB OPER IAPK0039 STO ACC2 IAPK0040 LLS 8 IAPK0041 STQ REM+1 IAPK0042 ZET REM+1 IAPK0043 TRA SIP IAPK0044 CLA TAC+1 IAPK0045 STO KAR IAPK0046 CLA MASK IAPK0047 ANS KAR IAPK0048 ANA OPER IAPK0049 SUB KAR IAPK0050 SSP IAPK0051 CAS KMX IAPK0052 TRA *+3 IAPK0053 TRA SIP IAPK0054 TRA SIP IAPK0055 ZET TAC+1 IAPK0056 NZT OPER IAPK0057 TRA SIP IAPK0058 CLA ONE IAPK0059 STO REM+1 IAPK0060 SIP CLA ACC IAPK0061 FSB OPER2 DO THE SUBTRACTION IAPK0062 STO ACC IAPK0063 LLS 8 IAPK0064 STQ REM IAPK0065 SPE1 ZET REM CHECK FOR OVERSHIFT ON ZERO MQ IAPK0066 TRA ROUND IAPK0067 CLA TAC IAPK0068 STO KAR IAPK0069 CLA MASK IAPK0070 ANS KAR IAPK0071 ANA OPER2 IAPK0072 SUB KAR IAPK0073 SSP IAPK0074 CAS KMX IAPK0075 TRA *+3 IAPK0076 TRA ROUND IAPK0077 TRA ROUND IAPK0078 ZET TAC TEST FOR ONE NUMBER BEING 0 IAPK0079 NZT OPER2 IAPK0080 TRA ROUND IAPK0081 CLA ONE IAPK0082 STO REM IAPK0083 TRA ROUND IAPK0084 EJECT IAPK0085 DIV CLA ACC RANGE DIVIDE IAPK0086 STO TAC (A1,B1)/(A2,B2) IAPK0087 CLA ACC2 IAPK0088 STO TAC+1 IAPK0089 CLA OPER CHECK SIGN A2 AND ZERO CHECK IAPK0090 TZE HALT HALT ON UNDEFINED IAPK0091 TMI KAS46 A2- CASES-4,5,6 IAPK0092 CLA ACC TEST SIGN A1 CASES 1,2,3 IAPK0093 TMI CASE23 IAPK0094 TZE *+3 A1,B1 POSITIVE - SKIP DIV IF ZERO IAPK0095 FDH OPER2 CASE 1, A1 + A1/B2 IAPK0096 STQ ACC NO ROUND IAPK0097 ALS 8 IAPK0098 STO REM IAPK0099 CLA ACC2 IAPK0100 TZE *+3 ZERO CHK ON B1 IAPK0101 FDH OPER B1/A2 IAPK0102 STQ ACC2 IAPK0103 ALS 8 IAPK0104 STO REM+1 IAPK0105 TRA RIT EXTEND RT END IAPK0106 CASE23 CLA ACC2 CASE2 A1 - TEST B1 IAPK0107 TMI CASE2 IAPK0108 TZE *+3 CASE 3 B1 + IAPK0109 FDH OPER B1/A1 IAPK0110 STQ ACC2 IAPK0111 ALS 8 IAPK0112 STO REM+1 IAPK0113 CLA ACC IAPK0114 TZE *+3 IAPK0115 FDH OPER A1/A2 IAPK0116 STQ ACC IAPK0117 ALS 8 IAPK0118 STO REM IAPK0119 TRA BOTH EXTEND BOTH ENDS IAPK0120 CASE2 TZE *+3 B1 - IAPK0121 FDH OPER2 B1/B2 IAPK0122 STQ ACC2 IAPK0123 ALS 8 IAPK0124 STO REM+1 IAPK0125 CLA ACC IAPK0126 TZE *+3 IAPK0127 FDH OPER A1/A2 IAPK0128 STQ ACC IAPK0129 ALS 8 IAPK0130 STO REM IAPK0131 TRA RIT EXTEND RIGHT END IAPK0132 KAS46 CLA OPER2 CASES 4, 5, 6 IAPK0133 TZE HALT IAPK0134 TPL HALT IAPK0135 CLA ACC TEST SIGN A1 IAPK0136 TMI CASE56 IAPK0137 TZE *+3 CASE 4 A1 B1 POSITIVE IAPK0138 FDH OPER IAPK0139 STQ ACC2 A1/A2 IAPK0140 ALS 8 IAPK0141 STO REM+1 IAPK0142 CLA TAC+1 IAPK0143 TZE *+3 IAPK0144 FDH OPER2 IAPK0145 STQ ACC IAPK0146 ALS 8 IAPK0147 STO REM IAPK0148 TRA LEF EXTEND LEFT END IAPK0149 CASE56 CLA ACC2 CASES 5 AND 6 TEST B1 IAPK0150 TMI CASE5 IAPK0151 TZE *+3 CASE6 IAPK0152 FDH OPER2 B1/B2 IAPK0153 STQ ACC IAPK0154 ALS 8 IAPK0155 STO REM IAPK0156 CLA TAC IAPK0157 TZE *+3 IAPK0158 FDH OPER2 A1/B2 IAPK0159 STQ ACC2 IAPK0160 ALS 8 IAPK0161 STO REM+1 IAPK0162 TRA BOTH EXTEND BOTH ENDS IAPK0163 CASE5 TZE *+3 IAPK0164 FDH OPER B1/A2 IAPK0165 STQ ACC IAPK0166 ALS 8 IAPK0167 STO REM IAPK0168 CLA TAC IAPK0169 TZE *+3 IAPK0170 FDH OPER2 IAPK0171 STQ ACC2 IAPK0172 ALS 8 IAPK0173 STO REM+1 IAPK0174 TRA RIT EXTEND RI END IAPK0175 EJECT IAPK0176 MULT CLA ACC2 RANGE MULT IAPK0177 TNZ *+3 IAPK0178 NZT ACC IAPK0179 TRA 1,X IAPK0180 CLA OPER IAPK0181 TNZ NOZ IAPK0182 CLA OPER2 IAPK0183 TNZ NOZ IAPK0184 STO ACC IAPK0185 STO ACC2 IAPK0186 TRA 1,X IAPK0187 NOZ CLA ACC2 IAPK0188 STO TAC+1 IAPK0189 CLA ACC IAPK0190 STO TAC IAPK0191 TMI K3 BEGIN SIGN DISCRIMINATIONS IAPK0192 CLA OPER A1+ NOW TEST A2 SIGN IAPK0193 TMI K1 IAPK0194 LDQ ACC IAPK0195 FMP OPER A1*A2 IAPK0196 STO ACC IAPK0197 LLS 8 IAPK0198 STQ REM STORE LOWER QUO IAPK0199 LDQ ACC2 IAPK0200 FMP OPER2 B1*B2 IAPK0201 STO ACC2 IAPK0202 LLS 8 IAPK0203 STQ REM+1 IAPK0204 CLA TAC+1 B1 ZERO IAPK0205 TZE 1,X IAPK0206 CLA OPER2 B2 ZERO IAPK0207 TZE 1,X IAPK0208 TRA RIT EXTEND RIGHT IAPK0209 K1 CLA OPER2 A1+ B2- TEST SIGN B2 IAPK0210 TMI K2 B2 + OR - IAPK0211 XCA IAPK0212 FMP ACC2 B1*B2 IAPK0213 STO ACC2 IAPK0214 LLS 8 IAPK0215 STQ REM+1 IAPK0216 LDQ OPER IAPK0217 FMP TAC+1 IAPK0218 STO ACC IAPK0219 LLS 8 IAPK0220 STQ REM SAVE ROUNDOFF CHECK IAPK0221 CLA TAC+1 IAPK0222 TZE 1,X IAPK0223 CLA OPER2 IAPK0224 TZE LEF LEFT EXTEND IAPK0225 TRA BOTH BOTH EXTEND IAPK0226 K2 XCA IAPK0227 FMP ACC B2*A1 IAPK0228 STO ACC2 IAPK0229 LLS 8 IAPK0230 STQ REM+1 IAPK0231 LDQ TAC+1 LOAD B1 IAPK0232 FMP OPER A2*B1 IAPK0233 STO ACC IAPK0234 LLS 8 IAPK0235 STQ REM IAPK0236 CLA TAC IAPK0237 TZE 1,X IAPK0238 TRA LEF EXTEND LEFT END IAPK0239 K3 CLA OPER A2 + OR - IAPK0240 TMI K5 IAPK0241 CLA TAC+1 B1 SIGN IAPK0242 TMI K4 IAPK0243 XCA IAPK0244 FMP OPER2 B1*B2 IAPK0245 STO ACC2 IAPK0246 LLS 8 IAPK0247 STQ REM+1 IAPK0248 LDQ TAC IAPK0249 FMP OPER2 A1*B2 IAPK0250 STO ACC IAPK0251 LLS 8 IAPK0252 STQ REM IAPK0253 CLA OPER2 B2 ZERO IAPK0254 TZE 1,X IAPK0255 CLA TAC+1 B1 ZERO IAPK0256 TZE LEF YES SO EXTEND LEFT END ONLY IAPK0257 TRA BOTH NO SO EXTEND BOTH ENDS IAPK0258 K4 XCA IAPK0259 FMP OPER A2*B1 IAPK0260 STO ACC2 IAPK0261 LLS 8 IAPK0262 STQ REM+1 IAPK0263 LDQ OPER2 IAPK0264 FMP ACC B2*A1 IAPK0265 STO ACC IAPK0266 LLS 8 IAPK0267 STQ REM IAPK0268 CLA OPER2 IAPK0269 TZE 1,X IAPK0270 TRA LEF EXTEND LEFT END ONLY IAPK0271 K5 CLA OPER2 TEST B2 SIGN IAPK0272 TPL K7 IAPK0273 CLA TAC+1 TEST B1 IAPK0274 TMI K6 IAPK0275 LDQ OPER IAPK0276 FMP TAC A2*A1 IAPK0277 STO ACC2 IAPK0278 LLS 8 IAPK0279 STQ REM+1 IAPK0280 LDQ OPER A2*B1 IAPK0281 FMP TAC+1 IAPK0282 STO ACC IAPK0283 LLS 8 IAPK0284 STQ REM IAPK0285 CLA TAC+1 IAPK0286 TZE RIT EXTEND RIGHT END IAPK0287 TRA BOTH EXTEND BOTH ENDS IAPK0288 K6 XCA IAPK0289 FMP OPER2 B1*B2 IAPK0290 STO ACC IAPK0291 LLS 8 IAPK0292 STQ REM IAPK0293 LDQ TAC IAPK0294 FMP OPER A1*A2 IAPK0295 STO ACC2 IAPK0296 LLS 8 IAPK0297 STQ REM+1 IAPK0298 TRA RIT EXTEND RIGHT ENDPOINT IAPK0299 K7 CLA TAC+1 TEST B1 IAPK0300 TPL K8 IAPK0301 LDQ TAC IAPK0302 FMP OPER2 A1*B2 IAPK0303 STO ACC IAPK0304 LLS 8 IAPK0305 STQ REM IAPK0306 LDQ TAC IAPK0307 FMP OPER A1*A2 IAPK0308 STO ACC2 IAPK0309 LLS 8 IAPK0310 STQ REM+1 IAPK0311 CLA OPER IAPK0312 TZE RIT EXTEND RIGHT END IAPK0313 TRA BOTH EXTEND BOTH ENDS IAPK0314 K8 LDQ TAC IAPK0315 FMP OPER A1XA2 IAPK0316 STO ACC2 IAPK0317 LLS 8 IAPK0318 STQ REM+1 IAPK0319 LDQ TAC+1 B1XB2 IAPK0320 FMP OPER2 IAPK0321 CAS ACC2 IAPK0322 TRA FIX1 IAPK0323 TRA FIX2 IAPK0324 TRA BBMAX+2 IAPK0325 FIX1 STO ACC2 IAPK0326 BBMAX LLS 8 IAPK0327 STQ REM+1 IAPK0328 LDQ TAC IAPK0329 FMP OPER2 A1XB2 IAPK0330 STO ACC IAPK0331 LLS 8 IAPK0332 STQ REM IAPK0333 LDQ TAC+1 IAPK0334 FMP OPER A2XB1 IAPK0335 CAS ACC SELECT MIN IAPK0336 TRA BOTH EXTEND BOTH IAPK0337 TRA FIX3 IAPK0338 STO ACC IAPK0339 FIX4 LLS 8 IAPK0340 STQ REM IAPK0341 TRA BOTH EXTEND BOTH IAPK0342 FIX2 ZET REM+1 IAPK0343 TRA BBMAX+2 IAPK0344 TRA BBMAX IAPK0345 FIX3 ZET REM IAPK0346 TRA BOTH IAPK0347 TRA FIX4 IAPK0348 EJECT IAPK0349 RIT NZT REM+1 IAPK0350 TRA 1,X IAPK0351 CAL ACC2 IAPK0352 ANA MASK IAPK0353 ADD ONE IAPK0354 FAD ACC2 IAPK0355 STO ACC2 IAPK0356 TRA 1,X IAPK0357 BOTH NZT REM+1 IAPK0358 TRA LEF IAPK0359 CAL ACC2 IAPK0360 ANA MASK IAPK0361 ADD ONE IAPK0362 FAD ACC2 IAPK0363 STO ACC2 IAPK0364 LEF NZT REM IAPK0365 TRA 1,X IAPK0366 CAL ACC IAPK0367 ANA MASK IAPK0368 ADD ONE IAPK0369 SSM IAPK0370 FAD ACC IAPK0371 STO ACC IAPK0372 TRA 1,X IAPK0373 ONE OCT 1 IAPK0374 MASK OCT 377000000000 IAPK0375 REM BSS 2 IAPK0376 TAC BSS 2 IAPK0377 ACC3 COMMON 1 IAPK0378 ACC2 COMMON 1 IAPK0379 ACC1 COMMON 1 IAPK0380 ACC COMMON 1 IAPK0381 OPER3 COMMON 1 IAPK0382 OPER2 COMMON 1 IAPK0383 OPER1 COMMON 1 IAPK0384 OPER COMMON 1 IAPK0385 EJECT IAPK0386 ABS CLA OPER INTERVAL ARITHMETIC ABSOLUTE VALUE IAPK0387 LDQ OPER2 IAPK0388 TPL PP INITIAL OPER -FINAL ACC - CYCLES IAPK0389 TQP MP IAPK0390 SSP OOPS MAKE THAT 14 CYCLES IAPK0391 LRS 0 IAPK0392 STQ ACC -- (-4,-2) = (2,4) 11 IAPK0393 QLOW STO ACC2 IAPK0394 TRA 1,X (-4,+2) = (0,4) 14 IAPK0395 MP SSP -+ IAPK0396 STZ ACC (-2,+4) = (0,4) 14 IAPK0397 TLQ QLOW IAPK0398 STQ ACC2 (+2,+4) = (2,4) 10 IAPK0399 TRA 1,X IAPK0400 PP STO ACC ++ IAPK0401 STQ ACC2 IAPK0402 TRA 1,X RETURN IAPK0403 EJECT IAPK0404 INV NZT OPER INTERVAL ARITHMETIC INVERSE PROGRAM IAPK0405 TRA TILT IAPK0406 NZT OPER2 (1,1)/(A,B) = (1/B,1/A) IAPK0407 TRA TILT IAPK0408 CLA WON IAPK0409 FDH OPER2 BOTH CASES, -- AND ++ ,CROSS IAPK0410 STQ ACC IAPK0411 ALS 8 ABOUT 36 CYCLES USED HERE IAPK0412 STO REM IAPK0413 CLA WON IAPK0414 FDH OPER IAPK0415 STQ ACC2 IAPK0416 ALS 8 IAPK0417 STO REM+1 IAPK0418 CLA ACC IAPK0419 TLQ TILT INPUT SPANS ZERO - PUNT IAPK0420 TPL RIT IAPK0421 TRA LEF EXTEND IAPK0422 WON DEC 1. IAPK0423 EJECT IAPK0424 SQR LDQ OPER2 IAPK0425 TQP NMM NOT MINUS MINUS IAPK0426 FMP OPER2 IAPK0427 STO ACC INTERVAL ARITHMETIC SQUARE PROG IAPK0428 LDQ OPER IAPK0429 SWS FMP OPER CONSERVES INTERVAL WIDTH OVER IAPK0430 STO ACC2 MULT WHEN INTERVAL SPANS IAPK0431 LLS 8 ZERO IAPK0432 STQ REM+1 IAPK0433 CLA OPER IAPK0434 TNZ RIT IAPK0435 TRA 1,X PUNT IAPK0436 NMM CLA OPER IAPK0437 TMI DIF IAPK0438 FMP OPER2 PLUS PLUS IAPK0439 STO ACC2 IAPK0440 LLS 8 CASE CYCLE TIME IAPK0441 STQ REM+1 IAPK0442 LDQ OPER (-4,-2) 21 IAPK0443 FMP OPER (-4,+2) 25 IAPK0444 STO ACC (-2,+4) 23 IAPK0445 CLA OPER2 (+2,+4) 24 IAPK0446 TNZ RIT IAPK0447 TRA 1,X IAPK0448 DIF STZ ACC SIGNS ARE DIFFERENT IAPK0449 SSP MAKE BOTH PLUS IAPK0450 CAS OPER2 IAPK0451 XCA SWITCH - OPER GREATER IAPK0452 TRA SWS SAME SO DOSNT MATTER IAPK0453 FMP OPER2 OKAY AS IS IAPK0454 STO ACC2 IAPK0455 LLS 8 IAPK0456 STQ REM+1 IAPK0457 CLA OPER2 IAPK0458 TNZ RIT IAPK0459 TRA 1,X EXIT STAGE RIGHT IAPK0460 EJECT IAPK0461 PANIC TPL MFALT IAPK0462 CAL SBCI IAPK0463 SLW PTTT IAPK0464 TRA HIT IAPK0465 TILT CAL IBCI IAPK0466 SLW PTTT IAPK0467 TRA HIT PANIC OUTPUT SECTION IAPK0468 MFALT CAL MBCI IAPK0469 SLW PTTT IAPK0470 TRA HIT IAPK0471 HALT CAL DBCI IAPK0472 SLW PTTT IAPK0473 HIT PCA 0,X IAPK0474 LRS 15 IAPK0475 SXA *+5,4 IAPK0476 AXT 5,4 IAPK0477 ALS 3 IAPK0478 LLS 3 IAPK0479 TIX *-2,4,1 IAPK0480 AXT **,4 IAPK0481 SLW ERPT+6 IAPK0482 WTDJ IAPK0483 RCHJ IO1 IAPK0484 PFLT WTDJ IAPK0485 RCHJ IO2 IAPK0486 TRA $DUMP IAPK0487 SBCI BCI 1,SUBINT IAPK0488 MBCI BCI 1,MEET IAPK0489 DBCI BCI 1,DIVIDE IAPK0490 IBCI BCI 1,INVERS IAPK0491 ERPT BCI 7, ERROR HAS OCCURRED AT LOCATION IAPK0492 BCI 6, RANGE INSTR. BEING EXECUTED IS IAPK0493 PTTT PZE IAPK0494 IO1 IORT ERPT,,7 IAPK0495 IO2 IORT ERPT+7,,7 IAPK0496 END IAPK0497 * FAP ENTRY ACDTOS ACDT0001 DD COMMON 1 ACDT0002 DC COMMON 1 ACDT0003 DB COMMON 1 ACDT0004 DA COMMON 1 ACDT0005 ACDTOS LDQ DA ACDT0006 TQP *+8 ACDT0007 CLA DB ACDT0008 ALS 10 ACDT0009 TZE *+5 ACDT0010 XCA ACDT0011 LDQ *-3 ACDT0012 FRN ACDT0013 XCA ACDT0014 STQ DA ACDT0015 LDQ DC ACDT0016 TQP *+2 ACDT0017 TRA *+8 ACDT0018 CLA DD ACDT0019 ALS 10 ACDT0020 TZE *+5 ACDT0021 XCA ACDT0022 LDQ *-3 ACDT0023 FRN ACDT0024 XCA ACDT0025 STQ DC ACDT0026 TRA 1,4 ACDT0027 END ACDT0028 * FAP ENTRY RNDU1 RNDU0001 COMMON 7 RNDU0002 U1 COMMON 1 RNDU0003 RNDU1 CLA U1 RNDU0004 LDQ =O400000000 RNDU0005 FRN RNDU0006 STO U1 RNDU0007 TRA 1,4 RNDU0008 END RNDU0009 * DATA 5 10 0 ~ $IBSYS $STOP