ibm:ibm1130-lib:dmsr2v12:r2fsqr_lst
R2FSQR
| Table Of Contents |
|---|
|
- r2fsqr.lst
ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:07 2020 Source File: \r2fsqr.asm 1 | *************************************************** R2H00010 2 | * * R2H00020 3 | * SUBROUTINE NAME- * R2H00030 4 | * FULL NAME- STANDARD PRECISION FLOATING- * R2H00040 5 | * POINT SQUARE ROOT FUNCTION. * R2H00050 6 | * CODE NAME- FSQR/FSQRT * R2H00060 7 | * PURPOSE- THIS SUBPROGRAM COMPUTES THE SQUARE * R2H00070 8 | * ROOT OF A STANDARD PRECISION FLOATING-POINT* R2H00080 9 | * NUMBER. * R2H00090 10 | * METHOD-SEE IBM 1130 SUBROUTINE LIBRARY MANUAL.* R2H00100 11 | * CAPABILITIES AND LIMITATIONS- SEE IBM 1130 * R2H00110 12 | * SUBROUTINE LIBRARY MANUAL. * R2H00120 13 | * SPECIAL FEATURES- N/A * R2H00130 14 | * ADDITIONAL INFORMATION- * R2H00140 15 | * ESTIMATED EXECUTION TIME- SEE IBM 1130 * R2H00150 16 | * SUBROUTINE LIBRARY MANUAL * R2H00160 17 | * * R2H00170 18 | *************************************************** R2H00180 CALL FSQR -V1. 20 | SPR R2H00200 21 | ENT FSQR R2H00210 22 | ENT FSQRT STANDARD FORTRAN NAME R2H00220 23 | * R2H00230 24 | *CONSTANTS AND BUFFER AREA R2H00240 25 | * R2H00250 0000 0000 0000 26 | F DEC 0 RANGED ARGUMENT. R2H00260 0002 0000 0000 27 | PN DEC 0 NEWTON ITERATION RESULT. R2H00270 0004 7000 0080 28 | A DEC 0.875 F BETWEEN 0.25 AND 0.5 R2H00280 0006 4A00 0080 29 | DEC 0.578125 F BETWEEN 0.50 AND 1.0 R2H00290 0008 4754 4B7F 30 | B DEC 0.27863 F BETWEEN 0.25 AND 0.5 R2H00300 000A 6C00 007F 31 | DEC 0.421875 F BETWEEN 0.50 AND 1.0 R2H00310 32 | * R2H00320 33 | *ENTER AND OBTAIN ABSOLUTE VALUE OF ARGUMENT R2H00330 34 | * R2H00340 000C 0000 35 | FSQRT DC 0 FORTRAN ENTRY R2H00350 000D 061C*58D7 36 | LIBF FGETP GET PARAMETER R2H00360 000E 0000 37 | FSQR DC 0 USER ENTRY R2H00370 000F 692D 38 | STX 1 XR1+1 SAVE XR1 R2H00380 0010 C37E 39 | LD 3 126 GET ARGUMENT R2H00390 0011 4C98 000ER 40 | BSC I FSQR,+- SQRT(0.0)=0.0 R2H00400 0013 4C10 001BR 41 | BSC L EXP,- BR IF PTV TO GET EXPONENT R2H00410 0015 C02E 42 | LD SQREF SET SQUARE ROOT ERROR FLAG R2H00420 0016 EB7C 43 | OR 3 124 IF ARGUMENT IS NEG. R2H00430 0017 D37C 44 | STO 3 124 USE ABSOLUTE VALUE. R2H00440 0018 10A0 45 | SLT 32 R2H00450 0019 9B7E 46 | SD 3 126 GET ABSOLUTE VALUE AND PUT R2H00460 001A DB7E 47 | STD 3 126 INTO FAC. R2H00470 48 | * R2H00480 49 | *COMPUTE EXPONENT AND INPUT TO ITERATION ROUTINE R2H00490 50 | * R2H00500 001B C37D 51 | EXP LD 3 125 GET EXPONENT R2H00510 001C 8026 52 | A Q+2 DOUBLE THE EXCESS FOR R2H00520 001D 1881 53 | SRT 1 DIVISION BY 2. R2H00530 001E D021 54 | STO BLC STORE RESULT EXPONENT=B R2H00540 001F 1010 55 | SLA 16 GET LAST BIT OF EXPONENT R2H00550 0020 1081 56 | SLT 1 +1. R2H00560 0021 6100 57 | LDX 1 0 SET XR1 TO ZERO OR TWO R2H00570 0022 4820 58 | BSC Z ACCORDING AS F IS LT OR GT R2H00580 0023 6102 59 | LDX 1 2 0.5. XR1 POINTS TO PROPER R2H00590 60 | * INITIAL CONSTANTS R2H00600 0024 801D 61 | A Q+1 ADD IN EXCESS-1 TO GET R2H00610 0025 D37D 62 | STO 3 125 PROPER EXPONENT FOR F. R2H00620 0026 068A*3580 63 | LIBF FSTO SAVE F. R2H00630 0027 0000R 64 | DC F R2H00640 0028 0651*7A27 65 | LIBF FMPYX COMPUTE THE INITIAL R2H00650 0029 0004R 66 | DC A APPROXIMATION. XR1 POINTS R2H00660 002A 0604*4127 67 | LIBF FADDX TO PROPER A AND B. R2H00670 002B 0008R 68 | DC B P1=A*X+B R2H00680 69 | * R2H00690 70 | *PERFORM NEWTON ITERATION TWICE R2H00700 71 | * R2H00710 002C 6102 72 | LDX 1 2 SET NEWTON ITERATION COUNT. R2H00720 002D 068A*3580 73 | LOOP LIBF FSTO STORE PREV APPROXIMATION. R2H00730 002E 0002R 74 | DC PN R2H00740 002F 064C*4000 75 | LIBF FLD PUT IN X FACTOR. R2H00750 0030 0000R 76 | DC F R2H00760 0031 0610*9940 77 | LIBF FDIV PERFORM DIVISION. R2H00770 0032 0002R 78 | DC PN X/PN R2H00780 0033 0604*4100 79 | LIBF FADD ADD PN. R2H00790 0034 0002R 80 | DC PN X/PN + PN R2H00800 0035 C37D 81 | LD 3 125 DIVIDE BY 2 BY DECREMENTING R2H00810 0036 900A 82 | S Q EXPONENT BY ONE. R2H00820 0037 D37D 83 | STO 3 125 (X/PN+PN)/2 R2H00830 0038 71FF 84 | MDX 1 -1 DECR ITERATION COUNTER. R2H00840 0039 70F3 85 | MDX LOOP RETURN TO REPEAT LOOP. R2H00850 003A C005 86 | LD BLC GET RESULT EXPONENT R2H00860 003B D37D 87 | STO 3 125 AND PUT IN FAC. R2H00870 003C 6500 0000 88 | XR1 LDX L1 *-* RESTORE XR1 R2H00880 003E 4C80 000ER 89 | BSC I FSQR RETURN TO CALLER. R2H00890 90 | * R2H00900 91 | *CONSTANTS AND BUFFER AREA R2H00910 92 | * R2H00920 0040 0000 93 | BLC DC 0 RESULT EXPONENT. R2H00930 0041 0001 94 | Q DC 1 SINGLE WORD ONE R2H00940 0042 007F 95 | DC 127 CONSTANTS TO SET R2H00950 0043 0081 96 | DC 129 EXPONENT. R2H00960 0044 0004 97 | SQREF DC /4 BIT 13--ERROR FLAG. R2H00970 0045 98 | END R2H00980 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced A 0004R 28 66 B 0008R 30 68 BLC 0040R 93 54 86 EXP 001BR 51 41 F 0000R 26 64 76 FSQR 000ER 37 40 89 FSQRT 000CR 35 LOOP 002DR 73 85 PN 0002R 27 74 78 80 Q 0041R 94 52 61 82 SQREF 0044R 97 42 XR1 003CR 88 38
ibm/ibm1130-lib/dmsr2v12/r2fsqr_lst.txt · Last modified: 2023/08/06 13:34 by Site Administrator