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