.TITLE	MTH_X530FP Converts 530 floating point to VAX REAL*4
	.IDENT	/V01.00/

;++X530FP.MAR
;
; Facility:
;	Fermilab Accelerator Control System - ACNET
;
; Abstract:
;	Contains a routine which will convert a Xerox 530 48-bit
;	floating point value to a VAX REAL*4 floating point number.
;	As an option, the 530 value will be byte-swapped before
;	conversion.
;
; Environment:
;	Called in user mode from a FORTRAN/PASCAL routine (usually).
;	In FERMILIB.OLB object library.
;
;--
;
; Modification History:
;
; Author: Glenn C. Johnson		Creation date: 21-Sep-83
;
; V01.00  21-Sep-83	GCJ	Created
;
	.PAGE
	.SUBTITLE	Declarations

;
; Include Files:
;
;	NONE
;
; Library Macros:
;
;	NONE
;
; Local Macros:
;
;	NONE
;
; Equated Symbols:
;
;	NONE
;
; Program section for code
;
	.PSECT	_LIB_CODE,PIC,USR,CON,REL,LCL,SHR,EXE,NOWRT,RD
	.DEFAULT	DISPLACEMENT,BYTE
	.PAGE
	.SUBTITLE	MTH_X530FP Convert X530 Floating Point Number

;+ MTH_X530FP
; Converts a Xerox 530 48-bit floating point value to VAX REAL*4
; format, and returns the result to the outer (caller) procedure.
;
; number.wf.v = MTH_X530FP( x530.rv.r, flag.rbu.r, ierr.ww.r )
;
;  number	Converted floating-point number (REAL*4)
;
;  x530		6-byte array containing Xerox floating point value.
;		The first two bytes contain the most significant part
;		of the mantissa.  The middle two bytes contain the
;		least significant part of the mantissa.  The last two
;		bytes contain the binary exponent.  Passed by reference.
;
;  flag		A logical flag which controls byte-swapping.  If TRUE,
;		each of the 3 X530 words will be byte-swapped before
;		conversion.  Passed by reference.
;
;  ierr		A 2-byte return code (passed by reference):
;		 0	Successful conversion.
;		+1	Underflow.  The Xerox value contained an exponent
;			which was too small. The function returns zero.
;		+2	Lost precision. The Xerox mantissa contains 7 more
;			bits than the VAX mantissa. One or more of these
;			bits were non-zero and discarded.  This warning
;			can generally be ignored.
;		-1	Overflow.  The Xerox value contained an exponent
;			which was too big. The function returns +/-.17E+39.
;		-2	Un-normalized value. The Xerox value is probably
;			corrupted.  Try inverting the swap flag argument.
;			The function returns zero.
;-
;+0MTH_X530FP
;
; Functional Description:
;	Converts a Xerox 530 48-bit floating point value to VAX REAL*4
;	format, and returns the result to the outer (caller) procedure.
;
; Calling Sequence:
;	number.wf.v = MTH_X530FP( x530.rv.r, flag.rbu.r, ierr.ww.r )
;
; Input Parameters:
;	x530 -	6-byte array containing Xerox floating point value.
;		The first two bytes contain the most significant part
;		of the mantissa.  The middle two bytes contain the
;		least significant part of the mantissa.  The last two
;		bytes contain the binary exponent.  Passed by reference.
;	flag -	A logical flag which controls byte-swapping.  If TRUE,
;		each of the 3 X530 words will be byte-swapped before
;		conversion.  Passed by reference.
;
; Implicit Inputs:
;	NONE
;
; Output Parameters:
;	number - Converted floating-point number (REAL*4)
;	ierr -	A 2-byte return code (passed by reference):
;		 0	Successful conversion.
;		+1	Underflow.  The Xerox value contained an exponent
;			which was too small. The function returns zero.
;		+2	Lost precision. The Xerox mantissa contains 7 more
;			bits than the VAX mantissa. One or more of these
;			bits were non-zero and discarded.  This warning
;			can generally be ignored.
;		-1	Overflow.  The Xerox value contained an exponent
;			which was too big. The function returns +/-.17E+39.
;		-2	Un-normalized value. The Xerox value is probably
;			corrupted.  Try inverting the swap flag argument.
;			The function returns zero.
;
; Implicit Outputs:
;	NONE
;
; Condition Codes:
;	NONE
;
; Side Effects:
;	NONE
;
;-
	.PAGE
	.ENTRY	MTH_X530FP,^M<R2>
	MOVL	4(AP),R0	;GET ADDRESS OF X530 VALUE (6 BYTES)
	MOVL	(R0),R1		;GET X530 MANTISSA
	ROTL	#16,R1,R1	;SWAP WORDS OF MANTISSA
	MOVW	4(R0),R2	;GET X530 EXPONENT
	BITB	#1,@8(AP)	;TEST SWAP-BYTES FLAG
	BEQL	10$		;BRANCH IF FALSE

	ROTL	#8,R1,R0	;SWAP BYTES IN MANTISSA
	ROTL	#-8,R1,R1
	BICL2	#^XFF00FF,R0
	BICL2	#^XFF00FF00,R1
	BISL2	R0,R1
	ROTL	#8,R2,R0	;SWAP BYTES IN EXPONENT
	ROTL	#-8,R2,R2
	BICL2	#^XFF00FF,R0
	BICL2	#^XFF00FF00,R2
	BISL2	R0,R2

10$:	CLRL	R0		;CLEAR RESULT
	TSTL	R1		;ZERO MANTISSA?
	BEQL	30$		;IF ZERO, CHECK FOR TRUE ZERO.
	ADDW2	#128,R2		;BIAS EXPONENT
	BLEQ	37$		;CHECK FOR EXPONENT OUT OF RANGE
	BITW	#^XFF00,R2	;MORE CHECKS
	BNEQ	39$
	INSV	R2,#7,#8,R0	;STORE THE 8-BIT BIASED EXPONENT

	CLRL	R2		;LET R2 CONTAIN THE RETURN CODE
	TSTL	R1		;TEST SIGN OF MANTISSA
	BGEQ	20$		;BRANCH IF POSITIVE
	BISL2	#^X8000,R0	;NEGATIVE - SET SIGN BIT
	MNEGL	R1,R1		;MAKE POSITIVE MANTISSA
20$:	BBC	#30,R1,31$	;ENSURE MANTISSA NORMALIZED
	BITL	#^X7F,R1	;SEE IF LOW-ORDER BITS SET
	BEQL	24$
	MOVW	#2,R2		;YES, DECLARE LOST PRECISION
24$:	ROTL	#-7,R1,R1	;PREPARE TO STORE MANTISSA
	INSV	R1,#16,#16,R0	;LOW-ORDER 16 BITS
	ROTL	#-16,R1,R1
	INSV	R1,#0,#7,R0	;HIGH-ORDER 7 BITS

26$:	MOVW	R2,@12(AP)	;RETURN CODE
	RET			;DONE
	.PAGE
;
; ZERO MANTISSA.  CHECK FOR TRUE ZERO.
;
30$:	TSTW	R2		;TEST EXPONENT
	BEQL	26$		;MUST BE ZERO
;
; UN-NORMALIZED MANTISSA
;
31$:	MOVW	#-2,R2		;ERROR CODE

32$:	CLRL	R0		;RETURN ZERO VALUE
	BRB	26$
;
; ILLEGAL EXPONENT.  CHECK FOR OVERFLOW OR UNDERFLOW.
;
37$:	BVS	39$
	MOVW	#1,R2		;UNDERFLOW
	BRB	32$		;RETURN ZERO

39$:	MOVW	#-1,R2		;OVERFLOW
	MOVL	#^XFFFF7FFF,R0	;A BIG POSITIVE NUMBER
	TSTL	R1		;CHECK SIGN OF MANTISSA
	BGEQ	26$
	BISL2	#^X8000,R0	;NEGATIVE - SET SIGN BIT
	BRB	26$

	.END