Created
May 21, 2022 09:18
-
-
Save DavidHarper/ba20799c6b72d6131f263316d53723fb to your computer and use it in GitHub Desktop.
VM/370 assembler code to convert VM/370 64-bit float to IEEE 64-bit float
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| * Name: IBM2IEEE ASSEMBLE IBM00010 | |
| * IBM00020 | |
| * Author: David Harper, University of Liverpool Computer Lab IBM00030 | |
| * Email: [REDACTED] IBM00040 | |
| * Date: 24 April 1989 IBM00050 | |
| * IBM00060 | |
| * Purpose: To convert IBM Dfloat data to IEEE IBM00070 | |
| * IBM00080 | |
| * Linkage convention: Waterloo C IBM00090 | |
| * IBM00100 | |
| * IBM00110 | |
| * C specification: IBM00120 | |
| * IBM00130 | |
| * void ibm2ieee(dble *dptr, int nwords) IBM00140 | |
| * IBM00150 | |
| * IBM00160 | |
| * Converts 'nwords' double-precision (REAL*8) numbers in IBM00170 | |
| * array 'dptr' from IBM format to IEEE format. IBM00180 | |
| * IBM00190 | |
| * NOTE the conversion is done in situ. The original data IBM00200 | |
| * is overwritten and lost. Any attempt to do arithmetic IBM00210 | |
| * after conversion will lead to incorrect results ! IBM00220 | |
| * IBM00230 | |
| * IBM00240 | |
| USING IBM2IEEE,R11 IBM00250 | |
| ENTRY IBM2IEEE IBM00260 | |
| IBM2IEEE EQU * IBM00270 | |
| STM R1,R9,8(R12) Save registers IBM00280 | |
| LM R2,R3,0(R12) Load parameters IBM00290 | |
| LA R1,SHFTABLE IBM00300 | |
| * IBM00310 | |
| $ICVT LM R4,R5,0(R2) IBM00320 | |
| LR R6,R4 IBM00330 | |
| OR R6,R5 Is it 0.0D0 ? IBM00340 | |
| BZ NEXTDBL Yes, no work to do ! IBM00350 | |
| * IBM00360 | |
| LR R6,R4 High word of Dfloat IBM00370 | |
| N R6,EXPTMASK Mask out exponent IBM00380 | |
| SRL R6,24 Shift to do arithmetic IBM00390 | |
| SH R6,IBMBIAS Subtract bias IBM00400 | |
| SLL R6,2 Convert to binary exponent IBM00410 | |
| AH R6,IEEEBIAS Add new bias IBM00420 | |
| * IBM00430 | |
| LR R7,R4 High word again IBM00440 | |
| N R7,MANTMASK Mask out mantissa IBM00450 | |
| LR R8,R7 Make a copy to play with IBM00460 | |
| SRL R8,20 Isolate top 4 bits IBM00470 | |
| SLL R8,1 Make offset in table IBM00480 | |
| LH R8,0(R1,R8) Get the required shift IBM00490 | |
| AR R6,R8 Normalise exponent IBM00500 | |
| SLL R6,20 Shift into place IBM00510 | |
| N R4,SIGNMASK Isolate sign bit IBM00520 | |
| OR R4,R6 Merge sign and exponent IBM00530 | |
| * IBM00540 | |
| * At this stage: IBM00550 | |
| * IBM00560 | |
| * R4 = IEEE sign and exponent IBM00570 | |
| * R5 = low 32 bits of IBM mantissa IBM00580 | |
| * R7 = high 24 bits of IBM mantissa IBM00590 | |
| * R8 = shift required to put IBM mantissa in correct place IBM00600 | |
| * i.e. with the most significant bit at position 23 IBM00610 | |
| * (counting in IBM style, from the left beginning at 0) IBM00620 | |
| * IBM00630 | |
| LTR R8,R8 Is shift = 0 ? IBM00640 | |
| BZ NOSHIFT Yes, no shift required IBM00650 | |
| * IBM00660 | |
| LA R9,32 IBM00670 | |
| SR R9,R8 32 - shift IBM00680 | |
| LR R6,R7 High 24 bits of mantissa IBM00690 | |
| SLL R6,0(R9) Isolate bits to carry over IBM00700 | |
| * to low word of new mantissa IBM00710 | |
| SRL R5,0(R8) Shift low mantissa IBM00720 | |
| SRL R7,0(R8) Shift high mantissa IBM00730 | |
| OR R5,R6 Insert bits from hi mant. IBM00740 | |
| * IBM00750 | |
| NOSHIFT EQU * IBM00760 | |
| N R7,IEEEMANT Remove integer bit of mant. IBM00770 | |
| OR R4,R7 Merge mant. with sgn+expt IBM00780 | |
| STM R4,R5,0(R2) IBM00790 | |
| * IBM00800 | |
| NEXTDBL LA R2,8(R2) Addr. of next one to do IBM00810 | |
| * IBM00820 | |
| BCT R3,$ICVT Any more to convert ? IBM00830 | |
| * IBM00840 | |
| LM R1,R9,8(R12) Restore registers IBM00850 | |
| BR R13 Return IBM00860 | |
| * IBM00870 | |
| * Data area IBM00880 | |
| * IBM00890 | |
| DS 0F IBM00900 | |
| EXPTMASK DC XL4'7F000000' IBM00910 | |
| MANTMASK DC XL4'00FFFFFF' IBM00920 | |
| SIGNMASK DC XL4'80000000' IBM00930 | |
| IEEEMANT DC XL4'000FFFFF' IBM00940 | |
| * IBM00950 | |
| IBMBIAS DC XL2'0040' IBM00960 | |
| IEEEBIAS DC XL2'03FB' Actually, this is (bias-4) IBM00970 | |
| * IBM00980 | |
| SHFTABLE DC XL8'0000000000010001' IBM00990 | |
| DC XL8'0002000200020002' IBM01000 | |
| DC XL8'0003000300030003' IBM01010 | |
| DC XL8'0003000300030003' IBM01020 | |
| * IBM01030 | |
| REGEQU IBM01040 | |
| END |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment