ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:08 2020 Source File: \s2eexp.asm 1 | *************************************************** S2D00010 2 | * * S2D00020 3 | * SUBROUTINE NAME- * S2D00030 4 | * FULL NAME- EXTENDED PRECISION FLOATING- * S2D00040 5 | * POINT EXPONENTIAL FUNCTION. * S2D00050 6 | * CODE NAME- EXPN/EEXP * S2D00060 7 | * PURPOSE- THIS SUBROUTINE COMPUTES THE EXPONENT* S2D00070 8 | * IAL OF AN EXTENDED PRECISION FLOATING-POINT* S2D00080 9 | * NUMBER. * S2D00090 10 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* S2D00100 11 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * S2D00110 12 | * SUBROUTINE LIBRARY MANUAL. * S2D00120 13 | * SPECIAL FEATURES- N/A * S2D00130 14 | * ADDITIONAL INFORMATION- * S2D00140 15 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * S2D00150 16 | * SUBROUTINE LIBRARY MANUAL * S2D00160 17 | * OTHER- A PERIOD FOLLOWED BY B, APPEARING TO* S2D00170 18 | * THE RIGHT OF COMMENT, INDICATES THAT THE* S2D00180 19 | * NUMBER FOLLOWING IS THE BINARY POINT OF * S2D00190 20 | * THE NUMBER PRESENTLY IN THE ACCUMULATOR.* S2D00200 21 | * LET C REFER TO THE TRUE EXPONENT OF THE * S2D00210 22 | * INPUT ARGUMENT. * S2D00220 23 | * * S2D00230 24 | *************************************************** S2D00240 CALL EEXP -V1. 26 | EPR S2D00260 27 | ENT EEXP STANDARD FORTRAN NAME S2D00270 28 | ENT EXPN S2D00280 0000 0000 29 | EEXP DC 0 FORTRAN ENTRY S2D00290 0001 051C*58D7 30 | LIBF EGETP GET PARAMETER S2D00300 0002 0000 31 | EXPN DC 0 USER ENTRY S2D00310 0003 2872 32 | STS EXPS SAVE STATUS S2D00320 0004 6974 33 | STX 1 XR1+1 SAVE XR1 S2D00330 0005 6A75 34 | STX 2 XR2+1 SAVE XR2 S2D00340 0006 C839 35 | LDD LOG2E GET LOG2E .B1 S2D00350 0007 2750*4000 36 | LIBF XMD MPY BY (FAC). .B1+C S2D00360 0008 DB7E 37 | STD 3 126 STORE Y*LOG2E IN FAC.B1+C S2D00370 0009 C37D 38 | LD 3 125 GET Y EXPONENT S2D00380 000A 9043 39 | S X SUB 128+14. C-14 S2D00390 000B 4C30 0086R 40 | BSC L OVFL,Z- BR IF Y EXPONENT TOO BIG S2D00400 000D 8041 41 | A X+1 SCALE Y EXPONENT BY 3. C+3 S2D00410 000E D003 42 | STO BUF1+1 KEEP SCALED EXPONENT S2D00420 000F 4C28 0022R 43 | BSC L SRT,+Z BR IF EXPONENT LT -3 S2D00430 0011 6500 0000 44 | BUF1 LDX L1 *-* Y EXPONENT+3 IN XR1 .C-3 S2D00440 0013 C37E 45 | LD 3 126 GET Y*LOG2E .B1+C S2D00450 0014 1891 46 | SRTR SRT 17 MOVE TO EXT .B18+C S2D00460 0015 1180 47 | SLT 1 SHIFT OF EXPONENT+3 .B15 S2D00470 0016 8039 48 | A X+2 ADD IN EXCESS S2D00480 0017 D37D 49 | STO 3 125 SET THE EXPONENT OF 2=N S2D00490 0018 1010 50 | SLA 16 CLEAR ACCUMULATOR S2D00500 0019 1082 51 | SLT 2 2 BITS USED AS INDR S2D00510 001A 1001 52 | SLA 1 MPY D BY 2 S2D00520 001B D04F 53 | STO D+1 S2D00530 001C CB7E 54 | LDD 3 126 GET Y*LOG2E .B1+C S2D00540 001D 1180 55 | SLT 1 CORRECT FOR EXPONENT.B-2 S2D00550 001E E032 56 | AND X+3 MAKE SIGN PTV S2D00560 001F 9032 57 | S X+4 SUB 1/8 S2D00570 0020 D82B 58 | STD Z STORE REMAINING FRACTION S2D00580 0021 7033 59 | MDX EXP2 S2D00590 0022 1010 60 | SRT SLA 16 CLEAR ACCUMULATOR S2D00600 0023 90EE 61 | S BUF1+1 REVERSE EXPONENT SIGN.-C-3 S2D00610 0024 D001 62 | STO *+1 STORE PTV EXPONENT IN XR1 S2D00620 0025 6500 0000 63 | LDX L1 *-* PTV EXPONENT IN XR1 .C S2D00630 0027 902C 64 | S C32 CHECK SIZE OF EXPONENT S2D00640 0028 4810 65 | BSC - BR IF IN RANGE S2D00650 0029 6120 66 | LDX 1 32 TOO BIG,SET XR1 TO 32 S2D00660 002A CB7E 67 | LDD 3 126 GET Y*LOG2E .B1+C S2D00670 002B 4828 68 | BSC +Z BR IF NOT NEG S2D00680 002C 9807 69 | SD ONE IF NEG,DECR EXPONENT BY 1 S2D00690 002D 1980 70 | SRT 1 CORRECT FOR EXPONENT.B-2 S2D00700 002E 4828 71 | BSC +Z BR IF NOT NEG S2D00710 002F 8804 72 | AD ONE IF NEG,RESTORE 1 S2D00720 0030 DB7E 73 | STD 3 126 MODIFIED Y*LOG2E IN FAC S2D00730 0031 6100 74 | LDX 1 0 XR1=ZERO S2D00740 0032 70E1 75 | MDX SRTR GO TO GET N,D,Z S2D00750 0034 0000 0001 76 | ONE DEC 1 FLT PT ONE S2D00760 0036 7FFF FFFF 77 | HELP DEC 1.999999999999B1 OVERFLOW CON S2D00770 0038 45CA E0F2 78 | M8TAB DEC 1.090507732725258B1 1/8 S2D00780 003A 52FF 6B55 79 | DEC 1.296839554851010B1 3/8 S2D00790 003C 62B3 9509 80 | DEC 1.542210825807941B1 5/8 S2D00800 003E 7560 6374 81 | DEC 1.834008086509342B1 7/8 S2D00810 0040 5C55 1D95 82 | LOG2E DEC 1.442695041288963B1 S2D00820 0042 58B9 0BFC 83 | A1 DEC 0.6931471806663105B0 CONSTANTS S2D00830 0044 7AFE F748 84 | A2 DEC 2.402264858011591E-1B-2 FOR S2D00840 0046 71AC 22EC 85 | A3 DEC 5.550410540590362E-2B-4 APPROXIMATION S2D00850 0048 4ED2 4042 86 | A4 DEC 9.621739874741388E-3B-6 POLYNOMIAL. S2D00860 004A 5768 FF25 87 | A5 DEC 1.333772937497065E-3B-9 S2D00870 004C 0000 0000 88 | Z DEC 0 STORE REMAINDER FRACTION S2D00880 004E 008E 89 | X DC 128+14 CHK SIZE OF EXPONENT S2D00890 004F 0011 90 | DC 14+3 SCALE EXPONENT S2D00900 0050 0081 91 | DC 129 SCALE EXPONENT S2D00910 0051 7FFF 92 | DC /7FFF CHANGE SIGN TO PTV S2D00920 0052 4000 93 | DC /4000 CON OF 1/8 S2D00930 0053 3A98 94 | DC 15000 S2D00940 0054 0020 95 | C32 DC 32 S2D00950 96 | * S2D00960 97 | *USE POLYNOMIAL APPROXIMATION TO CALC 2**Z S2D00970 98 | * S2D00980 0055 C8F6 99 | EXP2 LDD Z GET Z INTO FAC .B-2 S2D00990 0056 DB7E 100 | STD 3 126 S2D01000 0057 C8F2 101 | LDD A5 A5 INTO ACC AND EXT .B-9 S2D01010 0058 2750*4000 102 | LIBF XMD A5*Z .B-11 S2D01020 0059 6105 103 | LDX 1 5 XR1=5 FOR SHIFT S2D01030 005A 4023 104 | BSI SRTM SHIFT RT 5 TO ADD A4 .B-6 S2D01040 005B 88EC 105 | AD A4 A4+A5*Z .B-6 S2D01050 005C 2750*4000 106 | LIBF XMD Z*(A4+A5*Z) .B-8 S2D01060 005D 6104 107 | LDX 1 4 XR1=4 FOR SHIFT S2D01070 005E 401F 108 | BSI SRTM SHIFT RT 4 TO ADD A3 .B-4 S2D01080 005F 88E6 109 | AD A3 A3+(ACC AND EXT) .B-4 S2D01090 0060 2750*4000 110 | LIBF XMD MPY BY Z .B-6 S2D01100 0061 6104 111 | LDX 1 4 XR1=4 FOR SHIFT S2D01110 0062 401B 112 | BSI SRTM SHIFT RT 4 TO ADD A2 .B-2 S2D01120 0063 88E0 113 | AD A2 .B-2 S2D01130 0064 2750*4000 114 | LIBF XMD MPY BY Z .B-4 S2D01140 0065 6104 115 | LDX 1 4 XR1=4 FOR SHIFT S2D01150 0066 4017 116 | BSI SRTM SHIFT RT 4 TO ADD A1 .B0 S2D01160 0067 88DA 117 | AD A1 .B0 S2D01170 0068 2750*4000 118 | LIBF XMD MPY BY Z .B-2 S2D01180 0069 DB7E 119 | STD 3 126 SAVE RESULT IN FAC S2D01190 120 | * S2D01200 121 | *GET 2**D AND MULTIPLY TIMES 2**Z S2D01210 122 | * S2D01220 006A 6600 0000 123 | D LDX L2 *-* PUT REFERENCE NO. IN XR2 S2D01230 006C CE00 0038R 124 | LDD L2 M8TAB GET 2**D .B1 S2D01240 006E 2750*4000 125 | LIBF XMD MPY BY 2**Z .B-1 S2D01250 006F 6102 126 | LDX 1 2 XR2=2 FOR SHIFT S2D01260 0070 400D 127 | BSI SRTM SHIFT RT 2 TO ADD .B1 S2D01270 0071 8E00 0038R 128 | AD L2 M8TAB ADD ON A0 TERM .B1 S2D01280 0073 4801 129 | BSC O BR IF NO OVFLO S2D01290 0074 C8C1 130 | LDD HELP OVFL DUE TO ROUND ERROR. S2D01300 0075 DB7E 131 | STD 3 126 STORE FINAL RESULT S2D01310 0076 2000 132 | EXPS LDS *-* RESTORE STATUS S2D01320 0077 0605*90C0 133 | LIBF FARC CHECK FAC RANGE S2D01330 0078 6500 0000 134 | XR1 LDX L1 *-* RESTORE XR1 S2D01340 007A 6600 0000 135 | XR2 LDX L2 *-* RESTORE XR2 S2D01350 007C 4C80 0002R 136 | BSC I EXPN S2D01360 007E 0000 137 | SRTM DC 0 SHIFT RIGHT ROUTINE. S2D01370 007F 4828 138 | BSC +Z CONVERT - NUMBER S2D01380 0080 98B3 139 | SD ONE TO ONES COMP.(SHIFTABLE) S2D01390 0081 1980 140 | SRT 1 SHIFT S2D01400 0082 4828 141 | BSC +Z RE-CONVERT S2D01410 0083 88B0 142 | AD ONE S2D01420 0084 4C80 007ER 143 | BSC I SRTM S2D01430 0086 C37E 144 | OVFL LD 3 126 IF ARGUMENT IS MUCH TOO S2D01440 0087 D37D 145 | STO 3 125 FAR OUT OF RANGE, SET S2D01450 0088 1801 146 | SRA 1 FAC TO FORCE PROPER S2D01460 0089 D37E 147 | STO 3 126 ACTION IN FARC. S2D01470 008A 70EB 148 | MDX EXPS S2D01480 008B 149 | END S2D01490 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced A1 0042R 83 117 A2 0044R 84 113 A3 0046R 85 109 A4 0048R 86 105 A5 004AR 87 101 BUF1 0011R 44 42 61 C32 0054R 95 64 D 006AR 123 53 EEXP 0000R 29 EXP2 0055R 99 59 EXPN 0002R 31 136 EXPS 0076R 132 32 148 HELP 0036R 77 130 LOG2E 0040R 82 35 M8TAB 0038R 78 124 128 ONE 0034R 76 69 72 139 142 OVFL 0086R 144 40 SRT 0022R 60 43 SRTM 007ER 137 104 108 112 116 127 143 SRTR 0014R 46 75 X 004ER 89 39 41 48 56 57 XR1 0078R 134 33 XR2 007AR 135 34 Z 004CR 88 58 99