ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:08 2020 Source File: \s2esqr.asm 1 | *************************************************** S2H00010 2 | * * S2H00020 3 | * SUBROUTINE NAME- * S2H00030 4 | * FULL NAME- EXTENDED PRECISION FLOATING- * S2H00040 5 | * POINT SQUARE ROOT FUNCTION. * S2H00050 6 | * CODE NAME- ESQR/ESQRT * S2H00060 7 | * PURPOSE- THIS SUBPROGRAM COMPUTES THE SQUARE * S2H00070 8 | * ROOT OF AN EXTENDED PRECISION FLOATING- * S2H00080 9 | * POINT NUMBER. * S2H00090 10 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* S2H00100 11 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * S2H00110 12 | * SUBROUTINE LIBRARY MANUAL. * S2H00120 13 | * SPECIAL FEATURES- N/A * S2H00130 14 | * ADDITIONAL INFORMATION- * S2H00140 15 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * S2H00150 16 | * SUBROUTINE LIBRARY MANUAL * S2H00160 17 | * * S2H00170 18 | *************************************************** S2H00180 CALL ESQR -V1. 20 | EPR S2H00200 21 | ENT ESQR S2H00210 22 | ENT ESQRT STANDARD FORTRAN NAME S2H00220 0000 0000 23 | ESQRT DC 0 FORTRAN ENTRY S2H00230 0001 051C*58D7 24 | LIBF EGETP GET PARAMETER S2H00240 0002 0000 25 | ESQR DC 0 USER ENTRY S2H00250 0003 692D 26 | STX 1 XR1+1 SAVE XR1 S2H00260 0004 C37E 27 | LD 3 126 S2H00270 0005 4C98 0002R 28 | BSC I ESQR,+- SQRT(0.0)=0.0 S2H00280 0007 4C10 000FR 29 | BSC L NNEG,- BR IF PTV S2H00290 0009 C02E 30 | LD SQREF SET SQRT ERROR FLAG S2H00300 000A EB7C 31 | OR 3 124 IF X NEGATIVE. S2H00310 000B D37C 32 | STO 3 124 USE ABSOLUTE VALUE. S2H00320 000C 10A0 33 | SLT 32 S2H00330 000D 9B7E 34 | SD 3 126 S2H00340 000E DB7E 35 | STD 3 126 S2H00350 36 | * S2H00360 37 | *COMPUTE EXPONENT AND INPUT TO ITERATION ROUTINE S2H00370 38 | * S2H00380 000F C37D 39 | NNEG LD 3 125 S2H00390 0010 8026 40 | A Q+2 ADD 129 TO EXPONENT S2H00400 0011 1881 41 | SRT 1 DIVIDE BY TWO S2H00410 0012 D021 42 | STO BLC SAVE EXPONENT OF RESULT S2H00420 0013 1010 43 | SLA 16 S2H00430 0014 1081 44 | SLT 1 GET LAST BIT OF EXPONENT+1 S2H00440 0015 6100 45 | LDX 1 0 IA.ZERO,SET XR1=ZERO S2H00450 0016 4820 46 | BSC Z S2H00460 0017 6103 47 | LDX 1 3 IF ONE,SET XR1=3. S2H00470 0018 801D 48 | A Q+1 SET UP EXPONENT FOR S2H00480 0019 D37D 49 | STO 3 125 MANTISSA S2H00490 001A 058A*3580 50 | LIBF ESTO STORE RANGED ARGUMENT S2H00500 001B 0039R 51 | DC F S2H00510 001C 0551*7A27 52 | LIBF EMPYX P1=A*X+B S2H00520 001D 003FR 53 | DC A S2H00530 001E 0504*4127 54 | LIBF EADDX S2H00540 001F 0045R 55 | DC B S2H00550 56 | * S2H00560 57 | *USE NEWTON ITERATION TO GET SQUARE ROOT-- S2H00570 58 | * P(I+1)=(P(I)+F/P(I))/2 S2H00580 59 | * S2H00590 0020 6103 60 | LDX 1 3 SET NEWTON ITERATION COUNT. S2H00600 0021 058A*3580 61 | LOOP LIBF ESTO STORE LAST APPROXIMATION S2H00610 0022 003CR 62 | DC PN S2H00620 0023 054C*4000 63 | LIBF ELD GET ARGUMENT S2H00630 0024 0039R 64 | DC F S2H00640 0025 0510*9940 65 | LIBF EDIV DIVIDE BY PRIOR S2H00650 0026 003CR 66 | DC PN APPROXIMATION. S2H00660 0027 0504*4100 67 | LIBF EADD ADD PRIOR APPROXIMATION S2H00670 0028 003CR 68 | DC PN S2H00680 0029 C37D 69 | LD 3 125 DECR EXPONENT BY ONE- S2H00690 002A 900A 70 | S Q (EFFECTIVELY DIVIDES BY 2) S2H00700 002B D37D 71 | STO 3 125 S2H00710 002C 71FF 72 | MDX 1 -1 DECR CTR FOR RET S2H00720 002D 70F3 73 | MDX LOOP S2H00730 002E C005 74 | LD BLC GET PROPER EXPONENT FOR S2H00740 002F D37D 75 | STO 3 125 SQUARE ROOT. S2H00750 0030 6500 0000 76 | XR1 LDX L1 *-* RESTORE XR1 S2H00760 0032 4C80 0002R 77 | BSC I ESQR EXIT S2H00770 78 | * S2H00780 79 | *CONSTANTS AREA S2H00790 80 | * S2H00800 0034 0000 81 | BLC DC 0 RESULT EXPONENT. S2H00810 0035 0001 82 | Q DC 1 SINGLE WORD ONE S2H00820 0036 007F 83 | DC 127 EXPONENT SCALING CONSTANTS S2H00830 0037 0081 84 | DC 129 2 S2H00840 0038 0004 85 | SQREF DC /4 BIT 13--SQUARE ROOT ERROR S2H00850 0039 0000 0000 0000 86 | F XFLC RANGED ARGUMENT. S2H00860 003C 0000 0000 0000 87 | PN XFLC NEWTON ITERATION RESULT. S2H00870 003F 0080 7000 0000 88 | A XFLC 0.875 F BETWEEN 0.25 AND 0.5 S2H00880 0042 0080 4A00 0000 89 | XFLC 0.578125 F BETWEEN 0.50 AND 1.0 S2H00890 0045 007F 4754 4BB2 90 | B XFLC 0.27863 F BETWEEN 0.25 AND 0.5 S2H00900 0048 007F 6C00 0000 91 | XFLC 0.421875 F BETWEEN 0.50 AND 1.0 S2H00910 004B 92 | END S2H00920 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced A 003FR 88 53 B 0045R 90 55 BLC 0034R 81 42 74 ESQR 0002R 25 28 77 ESQRT 0000R 23 F 0039R 86 51 64 LOOP 0021R 61 73 NNEG 000FR 39 29 PN 003CR 87 62 66 68 Q 0035R 82 40 48 70 SQREF 0038R 85 30 XR1 0030R 76 26