.TITLE FPCONV, PDP/IBM FLOATING POINT CONVERSION PACKAGE .IDENT /V001B/ .MCALL RETURN .PSECT FPCONV ; ; WRITTEN BY CHARLES COSNER, NASA/GSFC CODE 933 ; ; THIS VERSION CORRECTS AN ERROR IN TIBMFS AND TIBMFD, WHICH HAD ; CHECKED THE WRONG BIT IN THE FPP STATUS WORD FOR THE TRUNCATE ; MODE. 15-MAR-78 R. TURKELSON, NASA/GSFC CODE 626 ; ; TPDPFS CONVERTS AN IBM SINGLE-PRECISION FLOATING-POINT CONSTANT ; TO A PDP SINGLE-PRECISION FLOATING-POINT CONSTANT. ; ; TPDPFS HAS ONE OR TWO ARGUMENTS: ; IN -- THE FIRST, OR ONLY, ARGUMENT SPECIFIES THE IBM CONSTANT ; OUT -- IF PRESENT, THE SECOND ARGUMENT SPECIFIES THE OUTPUT ; PDP CONSTANT. IF OMITTED, THE OUTPUT IS RETURNED AS A ; FUNCTION VALUE. ; TPDPFS:: ; COMPUTE MANTISSA MOV 2(R5),R3 ; INPUT ARGUMENT ADDRESS MOV @R3,R0 ; * FETCH IBM SINGLE-PRECISSION MOV 2(R3),R1 ; * FLOATING-POINT CONSTANT ASHC #8.,R0 ; SHIFT OFF SIGN AND EXPONENT BEQ 50$ ; CONSTANT IS ZERO ; COMPUTE EXPONENT MOVB 1(R3),R2 ; FETCH EXPONENT BYTE BIC #177600,R2 ; MASK OUT SIGN AND EXTENSION ASL R2 ; * CONVERT IBM EXPONENT (EXCESS 64.) ASL R2 ; * TO PDP EXPONENT (EXCESS 128.) SUB #128.,R2 ; * (EX-64.)*4+128. = EX*4-128. BLE 20$ ; EXPONENT UNDERFLOW -- SET TO ZERO ; NORMALIZE MANTISSA 10$: ASHC #1,R0 ; SHIFT OFF MOST SIGNIFICANT BIT BCS 30$ ; IF BIT IS ONE, NORMALIZATION COMPLETE SOB R2,10$ ; DECREMENT EXPONENT AND LOOP ; UNDERFLOW ON FALL THROUGH ; ZERO FLOATING-POINT CONSTANT 20$: CLR R0 ; * SET CONSTANT CLR R1 ; * TO ZERO BR 50$ ; GO TO CHECK ROUTINE TYPE ; RECONSTITUTE PDP FLOATING-POINT CONSTANT 30$: CMP R2,#255. ; DOES EXPONENT EXCEED 255.? BLE 40$ ; NO TRAP 128.+72. ; * YES, INDICATE OVERFLOW BR 20$ ; * AND ZERO THE CONSTANT 40$: ASHC #-9.,R0 ; SHIFT MANTISSA TO PROPER POSITION BIC #177600,R0 ; CLEAR EXPONENT AND SIGN BITS ASH #7,R2 ; SHIFT EXPONENT TO PROPER POSITION ADD R2,R0 ; JOIN EXPONENT AND MANTISSA BIT #100000,@R3 ; IS CONSTANT NEGATIVE? BEQ 50$ ; NO BIS #100000,R0 ; YES, SET SIGN BIT ; CHECK FOR FUNCTION VS. SUBROUTINE RETURN 50$: CMPB @R5,#1 ; DOES ROUTINE HAVE JUST ONE ARGUMENT? BEQ 60$ ; YES, IT IS A FUNCTION CALL MOV 4(R5),R2 ; * MOV R0,(R2)+ ; * NO, RETURN A SUBROUTINE ARGUMENT MOV R1,@R2 ; * ; EXIT THE ROUTINE 60$: RETURN .PAGE ; ; TPDPFD CONVERTS AN IBM DOUBLE-PRECISION FLOATING-POINT CONSTANT ; TO A PDP DOUBLE-PRECISION FLOATING-POINT CONSTANT. ; ; TPDPFD HAS ONE OR TWO ARGUMENTS: ; IN -- THE FIRST, OR ONLY, ARGUMENT SPECIFIES THE IBM CONSTANT ; OUT -- IF PRESENT, THE SECOND ARGUMENT SPECIFIES THE OUTPUT ; PDP CONSTANT. IF OMITTED, THE OUTPUT IS RETURNED AS A ; FUNCTION VALUE. ; TPDPFD:: ; COMPUTE MANTISSA MOV 2(R5),R4 ; INPUT ARGUMENT ADDRESS MOV (R4)+,R0 ; * MOV (R4)+,R1 ; * FETCH IBM DOUBLE-PRECISION MOV (R4)+,R2 ; * FLOATING-POINT CONSTANT MOV @R4,R3 ; * MOV #8.,R4 ; * 10$: ROL R3 ; * SHIFT OFF SIGN ROL R2 ; * ROL R1 ; * AND EXPONENT ROL R0 ; * SOB R4,10$ ; * BIC #377,R3 ; * TST R0 ; * BNE 20$ ; * TST R1 ; * BNE 20$ ; * CHECK FOR TST R2 ; * ZERO MANTISSA BNE 20$ ; * TST R3 ; * BEQ 80$ ; * ; COMPUTE EXPONENT 20$: MOV @2(R5),R4 ; FETCH EXPONENT WORD BIC #100377,R4 ; MASK OUT SIGN AND MANTISSA ASH #-6,R4 ; * CONVERT IBM EXPONENT (EXCESS 64.) ; * TO PDP EXPONENT (EXCESS 128.) SUB #128.,R4 ; * (EX-64.)*4+128. = EX*4 - 128. BLE 40$ ; EXPONENT UNDERFLOW -- SET TO ZERO ; NORMALIZE EXPONENT CLC ; * 30$: ROL R3 ; * ROL R2 ; * SHIFT OFF MOST SIGNIFICANT BIT ROL R1 ; * ROL R0 ; * BCS 50$ ; IF BIT IS ONE, NORMALIZATION COMPLETE SOB R4,30$ ; DECREMENT EXPONENT AND LOOP ; UNDERFLOW ON FALL THROUGH ; ZERO FLOATING-POINT CONSTANT 40$: CLR R0 ; * CLR R1 ; * SET CONSTANT CLR R2 ; * TO ZERO CLR R3 ; * BR 80$ ; GO TO CHECK ROUTINE TYPE ; RECONSTITUTE PDP FLOATING-POINT CONSTANT 50$: CMP R4,#255. ; DOES EXPONENT EXCEED 255.? BLE 60$ ; NO TRAP 128.+72. ; * YES, INDICATE OVERFLOW BR 40$ ; * AND ZERO THE CONSTANT 60$: ASH #7,R4 ; SHIFT EXPONENT TO PROPER POSITION MOV R4,-(SP) ; SAVE EXPONENT MOV #9.,R4 ; * CLC ; * 70$: ROR R0 ; * ROR R1 ; * SHIFT MANTISSA TO PROPER POSITION ROR R2 ; * ROR R3 ; * SOB R4,70$ ; * ADD (SP)+,R0 ; JOIN EXPONENT AND MANTISSA BIT #100000,@2(R5) ; IS CONSTANT NEGATIVE? BEQ 80$ ; NO BIS #100000,R0 ; YES, SET SIGN BIT ; CHECK FOR FUNCTION VS. SUBROUTINE RETURN 80$: CMPB @R5,#1 ; DOES ROUTINE HAVE JUST ONE ARGUMENT? BEQ 90$ ; YES, IT IS A FUNCTION CALL MOV 4(R5),R4 ; * MOV R0,(R4)+ ; * MOV R1,(R4)+ ; * NO, RETURN A SUBROUTINE ARGUMENT MOV R2,(R4)+ ; * MOV R3,@R4 ; * ; EXIT THE ROUTINE 90$: RETURN .PAGE ; ; TIBMFS CONVERTS A PDP SINGLE-PRECISION FLOATING-POINT CONSTANT ; TO AN IBM SINGLE-PRECISION FLOATING-POINT CONSTANT ; ; TIBMFS HAS TWO ARGUMENTS: ; IN -- THIS ARGUMENT PROVIDES THE PDP CONSTANT ; OUT -- THIS ARGUMENT WILL CONTAIN THE IBM CONSTANT ; TIBMFS:: ; COMPUTE MANTISSA MOV 2(R5),R3 ; INPUT ARGUMENT ADDRESS MOV @R3,R0 ; * FETCH THE PDP SINGLE-PRECISION MOV 2(R3),R1 ; * FLOATING-POINT CONSTANT ASHC #9.,R0 ; SHIFT OFF SIGN AND EXPONENT ; COMPUTE EXPONENT MOV @R3,R2 ; FETCH EXPONENT WORD ASH #-7,R2 ; SHIFT OFF MANTISSA BIC #177400,R2 ; MASK OUT SIGN AND EXTENSION BEQ 50$ ; ZERO EXPONENT -- ZERO CONSTANT ; CONVERT EXPONENT FROM PDP TO IBM REPRESENTATION SEC ; SET C FOR INSERTING MOST SIGNIFICANT ; BIT 10$: ROR R0 ; * RIGHT SHIFT ROR R1 ; * MANTISSA BIT #3,R2 ; IS EXPONENT A MULTIPLE OF FOUR? BEQ 20$ ; YES INC R2 ; * NO, INCREMENT EXPONENT BR 10$ ; * AND SHIFT MANTISSA AGAIN 20$: ASR R2 ; * CONVERT PDP EXPONENT (EXCESS 128.) ASR R2 ; * TO IBM EXPONENT (EXCESS 64.) ADD #32.,R2 ; * (EX-128.)/4+64. = EX/4+32. ; TRUNCATE OR ROUND MANTISSA ACCORDING TO FPP MODE STFPS -(SP) ; GET FPP STATUS BIT #40,(SP)+ ; IS TRUNCATE MODE SELECTED? BNE 30$ ; YES ADD #200,R1 ; * ADD ROUND ADC R0 ; * TO 25TH BIT BCC 30$ ; NO CARRY FROM MOST SIGNIFICANT WORD MOV #10000,R0 ; CARRY IMPLIES THAT MANTISSA SHOULD ; BE .1 (HEX) INC R2 ; INCREMENT EXPONENT FOR EFFECTIVE SHIFT ; RECONSTITUTE IBM FLOATING-POINT CONSTANT 30$: ASHC #-8.,R0 ; SHIFT MANTISSA TO PROPER POSITION BIC #177400,R0 ; CLEAR UPPER BITS ASH #8.,R2 ; SHIFT EXPONENT TO PROPER POSITION ADD R2,R0 ; JOIN EXPONENT TO MANTISSA BIT #100000,@R3 ; IS CONSTANT SIGN NEGATIVE? BEQ 40$ ; NO BIS #100000,R0 ; YES, SET SIGN BIT ; RETURN CONSTANT 40$: MOV 4(R5),R3 ; OUTPUT ARGUMENT ADDRESS MOV R0,(R3)+ ; * OUTPUT MOV R1,@R3 ; * CONSTANT ; EXIT FROM ROUTINE RETURN ; ZERO CONSTANT 50$: CLR R0 ; * SET CONSTANT CLR R1 ; * TO ZERO BR 40$ ; GO TO RETURN CONSTANT .PAGE ; ; TIBMFD CONVERTS A PDP DOUBLE-PRECISION FLOATING-POINT CONSTANT ; TO AN IBM DOUBLE-PRECISION FLOATING-POINT CONSTANT ; ; TIBMFD HAS TWO ARGUMENTS: ; IN -- THIS ARGUMENT PROVIDES THE PDP CONSTANT ; OUT -- THIS ARGUMENT WILL CONTAIN THE IBM CONSTANT ; TIBMFD:: ; COMPUTE MANTISSA MOV 2(R5),R4 ; INPUT ARGUMENT ADDRESS MOV (R4)+,R0 ; * MOV (R4)+,R1 ; * FETCH THE PDP DOUBLE-PRECISION MOV (R4)+,R2 ; * FLOATING-POINT CONSTANT MOV @R4,R3 ; * MOV #9.,R4 ; * 10$: ROL R3 ; * ROL R2 ; * SHIFT OFF SIGN AND EXPONENT ROL R1 ; * ROL R0 ; * SOB R4,10$ ; * BIC #777,R3 ; * ; COMPUTE EXPONENT MOV @2(R5),R4 ; FETCH EXPONENT WORD ASH #-7,R4 ; SHIFT OFF MANTISSA BIC #177400,R4 ; MASK OUT SIGN AND EXTENSION BEQ 70$ ; ZERO EXPONENT -- ZERO CONSTANT ; CONVERT EXPONENT FROM PDP TO IBM REPRESENTATION SEC ; SET C FOR INSERTING ; MOST SIGNIFICANT BIT 20$: ROR R0 ; * ROR R1 ; * RIGHT SHIFT ROR R2 ; * MANTISSA ROR R3 ; * BIT #3,R4 ; IS EXPONENT A MULTIPLE OF FOUR? BEQ 30$ ; YES INC R4 ; * NO, INCREMENT EXPONENT BR 20$ ; * AND SHIFT MANTISSA AGAIN 30$: ASR R4 ; * CONVERT PDP EXPONENT (EXCESS 128.) ASR R4 ; * TO IBM EXPONENT (EXCESS 64.) ADD #32.,R4 ; * (EX-128.)/4+64. = EX/4+32. ; TRUNCATE OR ROUND MANTISSA ACCORDING TO FPP MODE STFPS -(SP) ; GET FPP STATUS BIT #40,(SP)+ ; IS TRUNCATE MODE SELECTED? BNE 40$ ; YES ADD #200,R3 ; * ADC R2 ; * ADD ROUND ADC R1 ; * TO 57TH BIT ADC R0 ; * BCC 40$ ; NO CARRY FROM MOST SIGNIFICANT WORD MOV #10000,R0 ; CARRY IMPLIES THAT MANTISSA ; SHOULD BE .1 (HEX) INC R4 ; INCREMENT EXPONENT FOR EFFECTIVE SHIFT ; RECONSTITUTE IBM FLOATING-POINT CONSTANT 40$: ASH #8.,R4 ; SHIFT EXPONENT TO PROPER POSITION MOV R4,-(SP) ; SAVE EXPONENT MOV #8.,R4 ; * 50$: ROR R0 ; * ROR R1 ; * SHIFT MANTISSA TO ROR R2 ; * PROPER POSITION ROR R3 ; * SOB R4,50$ ; * BIC #177400,R0 ; CLEAR UPPER BITS ADD (SP)+,R0 ; JOIN EXPONENT TO MANTISSA BIT #100000,@2(R5) ; IS CONSTANT SIGN NEGATIVE? BEQ 60$ ; NO, BIS #100000,R0 ; YES, SET SIGN BIT ; RETURN CONSTANT 60$: MOV 4(R5),R4 ; OUTPUT ARGUMENT ADDRESS MOV R0,(R4)+ ; * MOV R1,(R4)+ ; * OUTPUT MOV R2,(R4)+ ; * CONSTANT MOV R3,@R4 ; * ; EXIT THE ROUTINE RETURN ; ZERO CONSTANT 70$: CLR R0 ; * CLR R1 ; * ZERO CLR R2 ; * CONSTANT CLR R3 ; * BR 60$ ; RETURN CONSTANT .PAGE ; ; TRCRND SETS OR RESETS THE FLOATING-POINT TRUNCATION MODE SWITCH IN ; THE FLOATING-POINT UNIT STATUS REGISTER. ; ; TRCRND HAS ONE ARGUMENT: ; ARG -- 0, RESET FOR ROUNDING ; NON-ZERO, SET FOR TRUNCATION ; TRCRND:: ; DETERMINE ROUNDING VS. TRUNCATION MOV @2(R5),R0 ; LOAD ARGUMENT BEQ 5$ ; IF ZERO, RESET FOR ROUNDING MOV #FT,R0 ; IF NON-ZERO, SET FOR TRUNCATION 5$: ; SET/RESET THE MODE SWITCH STFPS R1 ; GET THE STATUS REGISTER BIC #FT,R1 ; RESET MODE SWITCH BIS R0,R1 ; SET SWITCH IF APPROPRIATE LDFPS R1 ; PUT THE STATUS REGISTER ; EXIT THE ROUTINE RETURN ; FLOATING TRUNCATE MODE SWITCH FT = 40 .END