*TITLER4TOI2 -- CONVERT IBM FP TO 16 BIT INTEGER 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *A AUTHOR BARBARA J. BUCK 00020000 *A DESIGNER PATTY JENNINGS 00030000 *A LANGUAGE ASSEMBLER 00040000 *A SYSTEM IBM 3033/MVS & 4341/CMS 00060000 *A WRITTEN 12-19-77 00070000 * REVISED 01-26-81 BY BJB. CONVERSION TO IBM. 00080000 * REVISED 08-25-81 BY REP. CHANGE NAME FROM USCIBM TO R4TOI2 00090000 * REVISED 07-06-82 BY HHL. CHANGED LA INSTR TO ADD 8 00091001 * REVISED MO-DA-YR BY PROGRAMMER FOR REASON. 00100000 *A 00110000 *A 00120000 *A CALL R4TOI2 (FPA, INA, KNT, ISHFT) 00140000 *A 00150000 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00180000 *A 00190000 *A IN FPA R4 FLOATING POINT INPUT ARRAY 00200000 *A OUT INA I2 16 BIT INTEGER OUTPUT ARRAY 00210000 *A IN KNT I4 NUMBER OF ELEMENTS IN ARRAYS 00220000 *A OUT ISHFT I4 SHIFT COUNT REQUIRED TO MAKE FLOATING 00230000 *A POINT NUMBERS FIT IN 16 BIT INTEGER 00240000 *A POSITIONS. NEGATIVE MEANS LEFT SHIFT, 00250000 *A POSITIVE MEANS RIGHT SHIFT. 00260000 *A 00270000 *A 00280000 *A CONVERT 32 BIT IBM FLOATING POINT VALUES TO 16 BIT 00310000 *A INTEGER VALUES AND RETURN SHIFT REQUIRED TO RESTORE 00320000 *A TO ORIGINAL VALUE. MOST SIGNIFICANT BIT OF MAXIMUM 00330000 *A ABSOLUTE VALUE IS PLACED IN BIT 1 OF RESULTING 00340000 *A INTEGER. ALL INPUT VALUES ARE ASSUMED TO BE NORMAL- 00350000 *A IZED. 00360000 *A 00370000 *A 00380000 EJECT 00390000 * 00400000 * REGISTER EQUATES 00410000 * ================ 00420000 * 00430000 * 00440000 * GENERAL PURPOSE REGISTERS 00450000 * 00460000 R0 EQU 0 SUBROUTINE COMMUNICATION 00470000 R1 EQU 1 ADDR OF PARAMETERS 00480000 R2 EQU 2 WORK REGISTER 00490000 R3 EQU 3 WORK REGISTER 00500000 R4 EQU 4 WORK REGISTER 00510000 R5 EQU 5 WORK REGISTER 00520000 R6 EQU 6 WORK REGISTER 00530000 R7 EQU 7 00540000 R8 EQU 8 00550000 R9 EQU 9 00560000 R10 EQU 10 00570000 R11 EQU 11 00580000 R12 EQU 12 BASE REGISTER 00590000 R13 EQU 13 SAVE AREA ADDRESS & BASE 00600000 R14 EQU 14 00610000 R15 EQU 15 00620000 * 00630000 * FLOATING POINT REGISTERS 00640000 * 00650000 FP0 EQU 0 00660000 FP2 EQU 2 00670000 FP4 EQU 4 00680000 FP6 EQU 6 00690000 EJECT 00700000 * 00710000 * SET UP REGISTER CHAINING & GET INPUT PARAMETERS 00720000 * =============================================== 00730000 * 00740000 R4TOI2 CSECT 00750000 USING *,R15 00760000 B 12(R15) 00770000 DC X'06',CL7'R4TOI2 ' 00780000 STM R14,R12,12(R13) SAVE REGISTERS 00790000 LA R12,SAVEAREA POINTER TO SAVE AREA 00800000 ST R12,8(R13) CHAIN SAVE AREA 00810000 ST R13,4(R12) 00820000 DROP R15 00830000 LR R13,R12 R13 POINTS TO NEW SAVE AREA 00840000 USING SAVEAREA,R13 00850000 B SAVEAREA+72 00860000 * 00870000 SAVEAREA DC 18F'0' SAVE AREA 00880000 * 00890000 * 00900000 * SAVE INPUT DATA 00910000 * 00920000 LM R2,R5,0(R1) INPUT ARGUMENT ADDRESSES 00930000 STM R2,R5,FPA 00940000 L R4,0(R4) NO. OF ELEMENTS IN ARRAY 00950000 SER FP4,FP4 CLEAR REGISTER 00960000 LOOP10 LE FP6,0(R2) LOOP TO FIND GREATEST ABSOLUTE 00970000 LPER FP6,FP6 VALUE. PUT RESULT IN R7 00980000 CER FP6,FP4 00990000 BNH LEND 01000000 LER FP4,FP6 01010000 LEND LA R2,4(R2) INCREMENT INPUT ADDRESS ARRAY 01020000 BCT R4,LOOP10 LOOP FOR ALL VALUES 01030000 * 01040000 STE FP4,MEM GREATEST ABSOLUTE VALUE 01050000 CE FP4,FZERO IF ARRAY=0, ZERO OUTPUT ARRAY 01060000 BE STORZ 01070000 * 01080000 * FIND SHIFT VALUE REQUIRED TO CONVERT 16 BIT INTEGER NUMBER. 01090000 * ALL ELEMENTS WILL BE SHIFTED IN RELATION TO THIS ELEMENT. 01100000 * 01110000 TM MEM+1,X'80' FIND LOCATION OF FIRST 01120000 BNO TEST2 NON-ZERO BIT IN MANTISSA 01130000 LA R7,0 AND PUT LOCATION FACTOR IN R7 01140000 B CONT1 01150000 TEST2 TM MEM+1,X'40' 01160000 BNO TEST3 01170000 LA R7,1 01180000 B CONT1 01190000 TEST3 TM MEM+1,X'20' 01200000 BNO REST 01210000 LA R7,2 01220000 B CONT1 01230000 REST LA R7,3 01240000 CONT1 SR R4,R4 FIND VALUE OF EXPONENT 01250000 IC R4,MEM 01260000 S R4,F64 01270000 SLA R4,2 CALCULATE SHIFT FACTOR & STORE 01280000 SR R4,R7 IN ISHFT. ALSO FIND FACTOR TO 01290000 LA R7,15 CALCULATE INDIVIDUAL ELEMENT 01300000 SR R7,R4 SHIFT AND PUT IN R7 01310000 LCR R1,R7 01320000 L R2,ISHFT 01330000 ST R1,0(R2) 01340000 A R7,F8 01350001 L R8,KNT NO. OF ELEMENTS IN FPA 01360000 L R8,0(R8) 01370000 L R3,FPA 01380000 L R2,INA 01390000 * 01400000 LOOP20 L R6,0(R3) PUT ARRAY ELEMENT IN MEM AND 01410000 ST R6,MEM TURN SIGN BIT OFF 01420000 NI MEM,X'7F' PUT ARRAY ELEMENT IN MEM AND 01430000 SR R5,R5 PUT EXPONENT IN R5 AND CALCU- 01440000 IC R5,MEM LATE SHIFT FACTOR. STORE IT 01450000 S R5,F64 IN R5 01460000 SLA R5,2 01470000 AR R5,R7 01480000 BM NSTOR IF SHIFT IS NEGATIVE => NSTOR 01490000 O R5,SLI BUILD SHIFT LEFT DOUBLE INST. 01500000 ST R5,LOOP30 TO SHIFT R5 THE CORRECT AMT. 01510000 ST R5,LOOP40 01520000 SR R4,R4 01530000 STCM R4,X'01',MEM 01540000 L R5,MEM 01550000 LTR R6,R6 POSITIVE OR NEGATIVE SHIFT? 01560000 BM LOOP40 01570000 * 01580000 CNOP 0,4 01590000 LOOP30 DC F'0' 01600000 B STOR 01610000 * 01620000 CNOP 0,4 01630000 LOOP40 DC F'0' 01640000 LCR R4,R4 NEGATE ELEMENT 01650000 STOR STH R4,0(R2) OUTPUT ARRAY 01660000 LA R2,2(R2) INCR. ARRAY ADDRESSES 01670000 LA R3,4(R3) 01680000 BCT R8,LOOP20 01690000 B RETURN 01700000 NSTOR SR R4,R4 01710000 B STOR 01720000 * 01730000 RETURN EQU * 01740000 L R13,SAVEAREA+4 RESTORE SAVE AREA POINTER 01750000 LM R14,R12,12(R13) RESTORE REGISTERS 01760000 BR R14 RETURN 01770000 SPACE 10 01780000 * 01790000 * THIS SECTION TAKES CARE OF EVENT WHERE ALL ELEMENTS OF FPA 01800000 * ARE ZERO. 01810000 * 01820000 STORZ LM R2,R3,INA ADDR. OF INA & KNT 01830000 ST R2,ADRSA 01840000 STCM R3,X'07',ADRSK+1 01850000 CNOP 0,4 01860000 BAL R1,*+16 CLEAR OUTPUT ARRAY 01870000 DC A(FZERO) 01880000 ADRSA DC F'0' 01890000 ADRSK DC X'80',AL3(0) 01900000 L R15,=V(INITAR) 01910000 BALR R14,R15 01920000 * 01930000 L R3,ISHFT 01940000 MVC 0(4,R3),FZERO 01950000 B RETURN 01960000 SPACE 10 01970000 * 01980000 * DATA AREA & CONSTANTS 01990000 * 02000000 DS 0F 02010000 FPA DC F'0' 02020000 INA DC F'0' 02030000 KNT DC F'0' 02040000 ISHFT DC F'0' 02050000 * 02060000 MEM DC F'0' 02070000 FZERO DC F'0' 02080000 F64 DC F'64' 02090000 F8 DC F'8' 02091001 * 02100000 SLI SLDA R4,0 02110000 * 02120000 LTORG 02130000 * 02140000 END 02150000