Google
 

Trailing-Edge - PDP-10 Archives - ksu2_130 - flt.mic
There is 1 other file named flt.mic in the archive. Click here to see a list.
.TOC	"FLOATING POINT -- FAD, FSB"

	.DCODE
140:	FL-R,	FL-AC,		J/FAD
142:	FL-RW,	FL-MEM,		J/FAD
	FL-RW,	FL-BOTH,	J/FAD
	FL-R,	FL-AC, ROUND,	J/FAD
	FL-I,	FL-AC, ROUND,	J/FAD
	FL-RW,	FL-MEM, ROUND,	J/FAD
	FL-RW,	FL-BOTH, ROUND,	J/FAD

150:	FL-R,	FL-AC,		J/FSB
152:	FL-RW,	FL-MEM,		J/FSB
	FL-RW,	FL-BOTH,	J/FSB
	FL-R,	FL-AC, ROUND,	J/FSB
	FL-I,	FL-AC, ROUND,	J/FSB
	FL-RW,	FL-MEM, ROUND,	J/FSB
	FL-RW,	FL-BOTH, ROUND,	J/FSB
	.UCODE

;BOTH FAD & FSB ARE ENTERED WITH THE MEMORY OPERAND IN AR
; SIGN SMEARED. THE EXPONENT IN BOTH SC AND FE.
1576:
FSB:	[AR]_-[AR]		;MAKE MEMOP NEGATIVE

1577:
FAD:	[BR]_AC, SC_SC-EXP-1, 3T, SCAD DISP
=0*
FAS1:	READ [BR], SKIP DP0, J/FAS2	;BR .LE. AR
	[ARX]_[AR]		;SWAP AR AND BR
	[AR]_[BR], SC_EXP
	[BR]_[ARX], SC_SC-FE-1	;NUMBER OF SHIFT STEPS
	READ [AR], FE_EXP, 2T, SKIP DP0
=0	[AR]_+SIGN, J/FAS3
	[AR]_-SIGN, J/FAS3

=0	;SIGN SMEAR BR AND UNNORMALIZE
FAS2:	[BR]_+SIGN, J/FAS3
	[BR]_-SIGN, J/FAS3

FAS3:	Q_0, STEP SC
=0
FAS4:	[BR]_[BR]*.5 LONG, STEP SC, ASHC, J/FAS4
	[AR]_[AR]+[BR], NORM DISP, J/SNORM
.TOC	"FLAOTING POINT -- FMP"

	.DCODE
160:	FL-R,	FL-AC,		J/FMP
162:	FL-RW,	FL-MEM,		J/FMP
	FL-RW,	FL-BOTH,	J/FMP

	FL-R,	FL-AC, ROUND,	J/FMP
	FL-I,	FL-AC, ROUND,	J/FMP
	FL-RW,	FL-MEM, ROUND,	J/FMP
	FL-RW,	FL-BOTH, ROUND,	J/FMP
	.UCODE

1570:
FMP:	[BRX]_AC,		;GET AC
	FE_SC+EXP, 3T,		;EXPONENT OF ANSWER
	SKIP DP0		;GET READY TO SMEAR SIGN
=0	[BRX]_+SIGN, J/FMP1	;POSITIVE
	[BRX]_-SIGN, J/FMP1	;NEGATIVE
FMP1:	Q_[AR], SC_27.		;GET MEMORY OPERAND
=01*	[BRX]_[BRX]*.5 LONG,	;SHIFT RIGHT
	CALL [MULSUB]		;MULTIPLY
	Q_Q.AND.#, #/777000,	;WE ONLY COMPUTED
	HOLD LEFT		; 27 BITS
	[AR]_[ARX], FE_FE+2	;SET SHIFT PATHS
	[AR]_[AR]*.5 LONG,	;SHIFT OVER
	FE_FE-200,		;ADJUST EXPONENT
	NORM DISP, J/SNORM	;NORMALIZE & EXIT
.TOC	"FLOATING POINT -- FDV"

	.DCODE
170:	FL-R,	FL-AC,		J/FDV
172:	FL-RW,	FL-MEM,		J/FDV
	FL-RW,	FL-BOTH,	J/FDV

	FL-R,	FL-AC, ROUND,	J/FDV
	FL-I,	FL-AC, ROUND,	J/FDV
	FL-RW,	FL-MEM, ROUND,	J/FDV
	FL-RW,	FL-BOTH, ROUND,	J/FDV
	.UCODE


1574:
FDV:	[BR]_[AR], SKIP AD.EQ.0, AC	;COPY DIVSOR SEE IF 0
=0
	[AR]_AC, FE_SC-EXP, SKIP DP0,	;GET AC & COMPUTE NEW
		J/FDV0			; EXPONENT
	FL NO DIVIDE			;DIVIDE BY ZERO
=0
FDV0:	[AR]_+SIGN, J/FDV1
	[AR]_-SIGN, J/FDV2
FDV1:	[ARX]_[AR],FE_-FE+200,J/FDV3	;COMPUTE 2*DVND
FDV2:	[ARX]_-[AR],FE_-FE+200,J/FDV3	;ABSOLUTE VALUE
FDV3:	[BRX]_[BR]*2, SKIP DP0	;ABSOLUTE VALUE
=0
FDV4:	[ARX]-[BRX], SKIP CRY0, 3T, J/FDV5	;FLOATING NO DIV?
	[BRX]_-[BR]*2, J/FDV4		;FORCE ABSOLUTE VALUE
=0
FDV5:	[BRX]_[BRX]*.5, J/FDV6		;SHIFT BACK ARX
	FL NO DIVIDE			;UNNORMALIZED INPUT
=0
FDV6:	[AR]_[AR]*2,			;DO NOT DROP A BIT
	CALL [SBRL]			;AT FDV7+1
	[BRX]-[ARX], SKIP AD.LE.0	;IS ANSWER .LE. 1?
=00100
FDV7:	Q_0, SC_27., CALL [DIVSGN]	;DIVIDE
=00101	[AR]_[AR]*.5, FE_FE+1, J/FDV7	;SCALE DV'END
=01100
FDV8:	[AR]_Q*.5, J/FDV9		;PUT ANSWER IN AR
=01101	READ [AR], SKIP AD.EQ.0,	;-VE ANSWER, LOOK AT RMDR
	CALL [SETSN]			; SEE HOW TO NEGATE
=01110	READ [AR], SKIP AD.EQ.0,	;-VE ANSWER, LOOK AT RMDR
	CALL [SETSN]			; SEE HOW TO NEGATE
=01111	[AR]_Q*.5, J/FDV9		;PUT ANSWER IN AR
=11111	[AR]_-Q*.5, J/FDV9		;ZERO RMDR

FDV9:	Q_0, J/SNORM0			;GO NORMALIZE
.TOC	"FLOATING POINT -- FLTR, FSC"

	.DCODE
127:	R,	FL-AC,ROUND,	J/FLTR
132:	I,	FL-AC,		J/FSC
	.UCODE

1616:
FLTR:	[AR].AND.#, #/777000, 3T, SKIP ADL.EQ.0 ;SMALL POS NUMBER?
=0	[BR]_-[AR], SKIP DP0, 3T, J/FLTR1	;NO--SEE IF MINUS
	Q_0, FE_S#, S#/233, J/SNORM0	;FITS IN 27 BITS
=0
FLTR1:	[BR].AND.#, #/777000, 3T,
		SKIP ADL.EQ.0, J/FLTR1A	;SMALL NEGATIVE NUMBER
	Q_0, FE_S#, S#/244, J/FLTR2	;LARGE POS NUMBER
=0
FLTR1A:	Q_0, FE_S#, S#/244, J/FLTR2	;BIG NUMBER
	Q_0, FE_S#, S#/233, J/SNORM0	;FITS IN 27 BITS
;AT THIS POINT WE KNOW THE NUMBER TAKES MORE THAN 27 BITS. WE JUST
; SHIFT 8 PLACES RIGHT AND NORMALIZE. WE COULD BE MORE CLEVER BUT
; THIS IS THE RARE CASE ANYWAY.
FLTR2:	[AR]_[AR]*.5 LONG, ASHC, SC_6	;SHOVE OVER TO THE RIGHT
=0
FLTR3:	[AR]_[AR]*.5 LONG, ASHC, 	;SHIFT RIGHT 9 PLACES
		STEP SC, J/FLTR3	; SO IT WILL FIT
SNORM0:	READ [AR], NORM DISP, J/SNORM	;NORMALIZE ANSWER


1621:
FSC:	READ [AR], SC_SHIFT
	Q_0, AC				;DON'T SHIFT IN JUNK
	[AR]_AC, FE_SC+EXP, SKIP DP0	;SIGN SMEAR
=0	[AR]_+SIGN, J/SNORM0
	[AR]_-SIGN, J/SNORM0
.TOC	"FLOATING POINT -- FIX AND FIXR"

	.DCODE
122:	FL-R,	FL-AC,		J/FIX
126:	FL-R,	FL-AC,ROUND,	J/FIX
	.UCODE

1626:
FIX:	Q_0, SCAD/A+B, SCADA/S#,	;CLEAR Q, SEE IF
		S#/1534, SCADB/FE, 3T,	; ANSWER FITS IN
		SCAD DISP		; 35 BITS.
=0*	SET AROV, J/NIDISP		;TOO BIG
	SC_FE+S#, S#/1544, 3T, SCAD DISP ;NEED TO MOVE LEFT?
=0*	STEP SC, J/FIXL
	SC_S#-FE, S#/232		;NUMBER OF PLACES TO SHIFT
					; RIGHT
	STEP SC				;ALREADY THERE
=0
FIXR:	[AR]_[AR]*.5 LONG, ASHC,	;SHIFT BINARY POINT
		STEP SC, J/FIXR		; TO BIT 35.5
	[BR]_[ONE]*.5, B DISP, J/FIXX	;WHICH KIND OF FIX?

=0
FIXL:	[AR]_[AR]*2, STEP SC, J/FIXL	;SHIFT LEFT
	AC_[AR], NEXT INST		;WE ARE NOW DONE

=0*11
FIXX:	READ [AR], SKIP DP0, J/FIXT	;FIX--SEE IF MINUS
FIXX1:	[AR]_[AR]+[BR], FL-EXIT		;FIXR--ROUND UP
=0
FIXT:	AC_[AR], NEXT INST		;FIX & +, TRUNCATE
	READ Q, SKIP AD.EQ.0		;NEGATIVE--ANY FRACTION?
=0	[AR]_[AR]+1, FL-EXIT		;YES--ROUND UP
	[BR]_.NOT.[MASK],		;MAYBE--GENERATE .75
	J/FIXX1				;ROUND UP IF BIT 36 OR
					; 37 SET
.TOC	"FLOATING POINT -- SINGLE PRECISION NORMALIZE"

;NORMALIZE DISPATCH IS A 9-WAY DISPATCH. THE HARDWARE LOOKS AT
; 4 SIGNALS: DP=0, DP BIT 8, DP BIT 9, DP BIT -2. THE 9 CASES
; ARE:

;	DP=0	DP08	DP09	DP00	ACTION TO TAKE
;	0	0	0	0	SHIFT LEFT
;
;	0	0	0	1	NEGATE AND RETRY
;
;	0	0	1	0	ALL DONE
;
;	0	0	1	1	NEGATE AND RETRY
;
;	0	1	0	0	SHIFT RIGHT
;
;	0	1	0	1	NEGATE AND RETRY
;
;	0	1	1	0	SHIFT RIGHT
;
;	0	1	1	1	NEGATE AND RETRY
;
;	1	-	-	-	LOOK AT Q BITS

;ENTER HERE WITH UNNORMALIZED NUMBER IN AR!Q. FE HOLDS THE NEW
; EXPONENT. CALL WITH NORM DISP
=0000		;9-WAY DISPATCH
SNORM:	[AR]_[AR]*2 LONG, DIV, FE_FE-1, NORM DISP, J/SNORM
	Q_-Q, SKIP CRY0, 3T, J/SNNEG
	READ [AR], NORM DISP, CALL [SROUND]
	Q_-Q, SKIP CRY0, 3T, J/SNNEG
	[AR]_[AR]*.5, FE_FE+1, CALL [SROUND]
	Q_-Q, SKIP CRY0, 3T, J/SNNEG
	[AR]_[AR]*.5, FE_FE+1, CALL [SROUND]
	Q_-Q, SKIP CRY0, 3T, J/SNNEG
	READ Q, SKIP AD.EQ.0, J/SNORM1
=1110	[AR]_EXP, J/FLEX
=
=0
SNORM1:	[AR]_[AR]*2 LONG, DIV, FE_FE-1, NORM DISP, J/SNORM
FLEX:	FL-EXIT
=0
SNNEG:	[AR]_.NOT.[AR], NORM DISP, J/SNNORM ;NEGATE HIGH WORD
					; (NO CARRY)
	[AR]_-[AR], NORM DISP, J/SNNORM	;NEGATE HIGH WORD (W/CARRY)
=0000
SNNORM:	[AR]_[AR]*2 LONG, DIV, FE_FE-1, NORM DISP, J/SNNORM
=0010	READ [AR], NORM DISP, CALL [SROUND]
=0100	[AR]_[AR]*.5, FE_FE+1, CALL [SROUND]
=0110	[AR]_[AR]*.5, FE_FE+1, CALL [SROUND]
=1000	[AR]_[AR]*2 LONG, DIV, FE_FE-1, NORM DISP, J/SNNORM
=1110	[AR]_EXP, B DISP
=
=0111	TL [FLG], FLG.SN/1, J/SNNOT
	[AR]_[AR].AND.[MASK],	;CLEAR ANY LEFT OVER BITS
	J/SNNOT1
=0
SNNOT:	[AR]_.NOT.[AR], J/SNNOT2
	READ Q, SKIP AD.EQ.0
=0	[AR]_.NOT.[AR], J/SNNOT2
SNNOT1:	[AR]_-[AR], J/SNNOT2	;NORMAL NEGATE AND EXIT
SNNOT2:	[FLG]_0, FL-EXIT



.TOC	"FLOATING POINT -- ROUND ANSWER"

=*01*
SROUND:	[BR]_[ONE]*.5, B DISP, J/SRND1
	[AR]_[AR]*.5, FE_FE+1, J/SROUND ;WE WENT TOO FAR
=0111
SRND1:	RETURN [16]			;NOT ROUNDING INSTRUCTION
	[AR]_[AR]+[BR], NORM DISP
=*01*	RETURN [16]
	[AR]_[AR]*.5, FE_FE+1, RETURN [16]
.TOC	"FLOATING POINT -- DFAD, DFSB"

	.DCODE
110:	DBL FL-R,		J/DFAD
111:	DBL FL-R,		J/DFSB
	.UCODE

;ENTER FROM A-READ CODE WITH:
;FE/	EXP
;SC/	EXP
;AR/	C(E) SHIFT RIGHT 2 PLACES
;ARX/	C(E+1) SHIFTED RIGHT 1 PLACE
1635:
DFSB:	[ARX]_-[ARX]		;NEGATE LOW WORD
	[AR]_-[AR]-.25, MULTI PREC/1
1637:
DFAD:	[BRX]_(AC[1].AND.[MAG])*.5, 3T ;GET LOW WORD
	[BR]_AC*.5, 3T,		;GET AC AND START TO SHIFT
	SC_SC-EXP-1,		;NUMBER OF PLACES TO SHIFT
	SKIP DP0		;SEE WHAT SIGN
=0	[BR]_+SIGN*.5, 3T,	;SIGN SMEAR
	AC, SKIP/SC, J/DFAS1	;SEE WHICH IS BIGGER
	[BR]_-SIGN*.5, 3T,	;SIGN SMEAR
	AC, SKIP/SC, J/DFAS1	;SEE WHICH IS BIGGER
=0
DFAS1:	Q_[BRX],		;AR IS BIGGER
	J/DFAS2			;ADJUST BR!Q
	[T0]_AC,		;BR IS BIGGER OR EQUAL
	SC_EXP, 2T, J/DFAS3	;SET SC TO THAT EXPONENT
;HERE IF AR!ARX IS GREATER THAN BR!BRX
=0
DFAS2:	[T0]_[BR], CALL [DFADJ]	;ADJUST BR!Q
	[BR]_[T0]		;PUT ANSWER BACK
	Q_Q+[ARX], J/DFAS5	;ADD LOW WORDS

;HERE IS BR!BRX IF GREATER THAN OR EQUAL TO AR!ARX
DFAS3:	Q_[ARX],		;SETUP TO SHIFT AR!ARX
	SC_SC-FE-1		;COMPUTE # OF PLACES
	READ [T0], FE_EXP	;EXPONENT OF ANSWER
=0	[T0]_[AR], CALL [DFADJ]	;ADJUST AR!Q
	[AR]_[T0]		;PUT ANSWER BACK
	Q_Q+[BRX], J/DFAS5	;ADD LOW WORDS

;BIT DIDDLE TO GET THE ANSWER (INCLUDING 2 GUARD BITS) INTO
; AR!Q
DFAS5:	[AR]_([AR]+[BR])*.5 LONG, ;ADD HIGH WORDS
	MULTI PREC/1, ASHC	;INJECT SAVED CRY2
	[AR]_[AR]*2 LONG,	;SHIFT BACK LEFT
	ASHC, MUL DISP		;SEE IF WE LOST A 1
=1011
DFAS6:	[T1]_[T1].AND.NOT.[MASK], J/DFAS7
	Q_Q+.25, J/DFAS6
DFAS7:	[AR]_[AR]*2 LONG, ASHC,	;PUT IN GUARD BITS
	FE_FE-1
	[AR]_[AR]*2 LONG, ASHC,
	FE_FE-1
	Q_[T1].OR.Q, HOLD LEFT, J/DNORM0
;SUBROUTINE TO ADJUST NUMBER IN T0!Q
;RETURNS 1 WITH
;	T0!Q ADJUSTED
;	FLG.SN=1 IF WE SHIFTED OUT ANY 1 BITS (STICKY BIT)
;	T1 HAS Q TWO STEPS PRIOR TO BEING DONE
DFADJ	"STEP SC, ASHC, MUL DISP"

=0**11
DFADJ:	[T0]_[T0]*2 LONG, DIV,	;MOVE EVERYTHING 2 PLACES
	CALL [CLRSN]
	[T0]_[T0]*2 LONG, DIV
	[T0]_[T0]*2 LONG, DIV
	[T0]_[T0]*.5 LONG, ASHC, ;SHIFT AT LEAST 1 PLACE
	STEP SC
=1010
DFADJ1:	[T0]_[T0]*.5 LONG,	;UNNORMALIZE T0!Q
	DFADJ, J/DFADJ1		;LOOP TILL DONE
DFADJ2:	[T1]_Q,			;SAVE GUARD BITS
	MUL DISP, J/DFADJ5	;LOOK AT LAST BIT
	[FLG]_[FLG].OR.#, FLG.SN/1, HOLD RIGHT, J/DFADJ3
	[FLG]_[FLG].OR.#, FLG.SN/1, HOLD RIGHT, J/DFADJ4

=0
DFADJ3:	[T0]_[T0]*.5 LONG, ASHC, STEP SC, J/DFADJ3
DFADJ4:	[T1]_Q			;SAVE 2 GUARD BITS
=1011
DFADJ5:	[T0]_[T0]*.5 LONG, ASHC, J/DFADJ6
	[FLG]_[FLG].OR.#, FLG.SN/1, HOLD RIGHT, J/DFADJ5
DFADJ6:	[T0]_[T0]*.5 LONG, ASHC, RETURN [1]
.TOC	"FLOATING POINT -- DFMP"

	.DCODE
112:	DBL FL-R,	DAC,	J/DFMP
	.UCODE

;SAME ENTRY CONDITIONS AS DFAD/DFSB
1631:
DFMP:	Q_[ARX], SC_6		;SHIFT MEM OP 8 PLACES
=0
DFMP1:	[AR]_[AR]*2 LONG, ASHC,	;SHIFT
	STEP SC, J/DFMP1
	Q_Q*.5
	Q_Q.AND.#, #/077777, HOLD RIGHT
	[BR]_Q			;COPY LOW WORD
;
; BRX * BR ==> C(E+1) * C(AC+1)
;
	[BRX]_(AC[1].AND.[MAG])*.5 ;GET LOW AC
=0**	[BRX]_[BRX]*.5, SC_35., CALL [MULSB1]
;
; BRX * Q ==> C(E) * C(AC+1)
;
	Q_[AR], SC_35. 		;GO MULT NEXT HUNK
=0**	CALL [MULTIPLY]
	[T0]_[ARX]		;SAVE PRODUCT
	[ARX]_Q*.5, SC_FE	;PUT IN NEXT STEP
;
; BRX * BR ==> C(AC) * C(E+1)
;
	[BRX]_AC*.5,		;PREPARE TO DO HIGH HALF
	FE_SC+EXP,		;EXPONENT ON ANSWER
	SKIP DP0, 3T
=0	[BRX]_+SIGN*.5, 3T, J/DFMP2
	[BRX]_-SIGN*.5, 3T
=0**
DFMP2:	Q_[BR], SC_35., CALL [MULTIPLY]	;GO MULTIPLY
	[T1]_Q			;SAVE FOR ROUNDING
	[ARX]_[ARX]+[T0]	;PREPARE FOR LAST MUL
;
; BRX * Q ==> C(AC) * C(E)
;
=0**	Q_[AR], SC_35., 	;DO THE LAST MULTIPLY
	CALL [MULTIPLY]		; ..
;OK, WE NOW HAVE THE PRODUCT IN ARX!Q!T1. ALL WE NEED TO DO
; IS SOME BIT DIDDLES TO GET EVERYTHING IN THE RIGHT PLACE
	[AR]_[ARX]*.5 LONG,	;SHIFT THE ANSWER
	FE_FE+S#, S#/1576	;CORRECT EXPONENT
=0**11	READ [T1], SKIP AD.EQ.0, ;SEE IF LOW ORDER 1
	CALL [SETSN]		; BITS AROUND SOMEPLACE
	[AR]_[AR]*2 LONG, ASHC	;SHIFT LEFT
	[BR]_[ONE]*.5		;PLACE TO INSTERT BITS
	TL [T1], #/200000	;ANYTHING TO INJECT?
=0	Q_Q+[BR]		;YES--PUT IT IN
	[AR]_[AR]*2 LONG, ASHC	;MAKE ROOM FOR MORE
	TL [T1], #/100000	;ANOTHER BIT NEEDED
=0	Q_Q+[BR]		;YES--PUT IN LAST BIT
DNORM0:	READ [AR], NORM DISP,	;SEE WHAT WE NEED TO DO
	FE_FE+S#, S#/2, J/DNORM	;ADJUST FOR INITIAL SHIFTS
.TOC	"FLOATING POINT -- DFDV"

	.DCODE
113:	DBL FL-R,	DAC,	J/DFDV
	.UCODE
1636:
DFDV:	[BRX]_[ARX]		;COPY OPERAND (COULD SAVE TIME
				; WITH SEPERATE A-READ FOR DFDV)
=1**10	[T1]_0, CALL [CLRSN]	;CLEAR FLAG
	[BR]_[AR], SKIP AD.LE.0, ;SEE IF POSITIVE
	AC[1]			;WARM UP RAM
=0
DFDV1:	[ARX]_(AC[1].AND.[MAG])*.5, ;POSITIVE--GET AC
	J/DFDV2			; AND CONTINUE BELOW
	[T1]_.NOT.[T1]		;DV'SOR NEGATIVE (OR ZERO)
	[BRX]_-[BRX]		;NEGATE LOW WORD
	AD/-B-.25, B/BR, DEST/AD, ;NEGATE HIGH WORD
	MULTI PREC/1, 3T,	;ADDING IN CRY02
	SKIP DP0, AC[1],	;SEE IF STILL NEGATIVE
	J/DFDV1			; ..
DFDV2:	[AR]_AC*.5,		;GET AC AND SHIFT
	FE_SC-EXP, 3T,		;COMPUTE NEW EXPONENT
	SKIP DP0		;SEE IF NEGATIVE
=0	[AR]_+SIGN*.5, 3T, J/DFDV3	;POSITIVE
	[T1]_.NOT.[T1]		;NEGATIVE OR ZERO
	[AR]_-SIGN*.5, 3T	;SIGN SMEAR
	Q_-[ARX]		;NEGATE OPERAND
	[AR]_(-[AR]-.25)*.5 LONG, ;NEGATE HIGH WORD
	MULTI PREC/1,		;USE SAVED CARRY
	ASHC, J/DFDV4		;CONTINUE BELOW
=0
DFDV3:	Q_[ARX],		;COPY OPERAND
	CALL [DDIVS]		;SHIFT OVER
DFDV4:	[AR]-[BR], 3T, SKIP DP0	;SEE IF OVERFLOW
=0	FL NO DIVIDE
	[ARX]_Q			;START DIVISION
=0*	Q_0, SC_26., CALL [DBLDIV]
	[T0]_Q, SC_35.
=0*	Q_Q.AND.NOT.[MAG],	;SEE IF ODD
	SKIP AD.EQ.0,		;SKIP IF EVEN
	CALL [DBLDIV]		;GO DIVIDE
	Q_Q*.5			;MOVE ANSWER OVER
=
	[T0]_[T0]*2 LONG, ASHC, ;DO FIRST NORM STEP
	MUL DISP		; SEE IF A 1 FELL OUT
=1011
DFDV4A:	READ [T1], SKIP DP0,	;SHOULD RESULT BE NEGATIVE
	FE_S#-FE, S#/202,	;CORRECT EXPONENT
	J/DFDV4B		;LOOK BELOW
	Q_Q+.25, J/DFDV4A	;PUT BACK THE BIT
=0
DFDV4B:	[AR]_[T0], NORM DISP, J/DNORM ;PLUS
	[AR]_[T0], NORM DISP, J/DNNORM ;MINUS
.TOC	"FLOATING POINT -- DOUBLE PRECISION NORMALIZE"

;NORMALIZE AR!Q
;DNORM0:	READ [AR], NORM DISP,	;SEE WHAT WE NEED TO DO
;	FE_FE+S#, S#/2, J/DNORM	;ADJUST FOR INITIAL SHIFTS
=0000
DNORM:	[AR]_[AR]*2 LONG,	;SHIFT LEFT
	FE_FE-1, ASHC,		;ADJUST EXPONENT
	NORM DISP, J/DNORM	;TRY AGAIN
	TL [FLG], FLG.SN/1, J/DNEG ;RESULT IS NEGATIVE
	READ [AR], NORM DISP,	;SEE IF WE WENT TOO FAR
	CALL [DROUND]		; AND ROUND ANSWER
	TL [FLG], FLG.SN/1, J/DNEG ;RESULT IS NEGATIVE
	[AR]_[AR]*.5 LONG, ASHC,
	FE_FE+1, CALL [DROUND]
	TL [FLG], FLG.SN/1, J/DNEG ;RESULT IS NEGATIVE
	[AR]_[AR]*.5 LONG, ASHC,
	FE_FE+1, CALL [DROUND]
	TL [FLG], FLG.SN/1, J/DNEG ;RESULT IS NEGATIVE
	Q_[MAG].AND.Q,		;HIGH WORD IS ZERO
	HOLD RIGHT, J/DNORM1	;GO TEST LOW WORD
=1110	[FLG]_0			;[122] CLEAR FLAG WORD
=
	AC[1]_[ARX].AND.[MAG],	;STORE LOW WORD
	J/STAC			;GO DO HIGH WORD


DNORM1:	READ Q, SKIP AD.EQ.0	;TEST LOW WORD
=0	[AR]_[AR]*2 LONG, 	;LOW WORD IS NON-ZERO
	FE_FE-1, ASHC,		;ADJUST EXPONENT
	NORM DISP, J/DNORM	;KEEP LOOKING
	AC[1]_[AR], J/STAC	;WHOLE ANSWER IS ZERO
;HERE TO NORMALIZE NEGATIVE D.P. RESULTS
=0
DNEG:	Q_.NOT.Q, J/DNEG1	;ONES COMP
	Q_-Q, SKIP CRY2, J/DNEG2
DNEG1:	[FLG]_0
=0
DNEG2:	[AR]_.NOT.[AR],		;NO CARRY
	NORM DISP, J/DNNORM	;GO NORMALIZE
	[AR]_-[AR],		;CARRY
	NORM DISP, J/DNNORM	;NORMALIZE

=000*
DNNORM:	[AR]_[AR]*2 LONG,	;SHIFT 1 PLACE
	FE_FE-1, ASHC,		;ADJUST EXPONENT
	NORM DISP, J/DNNORM	;LOOP TILL DONE
=001*	READ [AR], NORM DISP,	;SEE IF WE WENT TOO FAR
	CALL [DROUND]		; AND ROUND ANSWER
=010*	[AR]_[AR]*.5 LONG, ASHC,
	FE_FE+1, CALL [DROUND]
=011*	[AR]_[AR]*.5 LONG, ASHC,
	FE_FE+1, CALL [DROUND]
=100*	Q_[MAG].AND.Q,		;HIGH WORD IS ZERO
	HOLD RIGHT, J/DNNRM1	;GO TEST LOW WORD
=111*	[ARX]_[ARX].AND.[MASK]	;REMOVE ROUNDING BIT
=
=00	[ARX]_[ARX].AND.[MAG],	;ALSO CLEAR SIGN
	CALL [CHKSN]		;ONES COMP?
=10	[ARX]_[ARX].XOR.[MAG],	;YES--ONES COMP
	J/DNN1			;CONTINUE BELOW
=11	[ARX]_-[ARX], 3T,	;NEGATE RESULT
	SKIP CRY1, J/DNN2
=
DNN1:	[FLG]_0			;CLEAR FLAG
=0
DNN2:	AC_.NOT.[AR], J/DNORM2
	AC_-[AR], 3T
DNORM2:	AC[1]_[ARX].AND.[MAG],	;STORE LOW WORD
	NEXT INST		;ALL DONE

DNNRM1:	READ Q, SKIP AD.EQ.0	;TEST LOW WORD
=0	[AR]_[AR]*2 LONG, 	;LOW WORD IS NON-ZERO
	FE_FE-1, ASHC,		;ADJUST EXPONENT
	NORM DISP, J/DNNORM	;KEEP LOOKING
	AC[1]_[AR], J/STAC	;WHOLE ANSWER IS ZERO
CHKSN:	TL [FLG], FLG.SN/1, RETURN [2]

;SUBROUTINE TO SET/CLEAR FLG.SN
;CALL WITH:
;	CALL [SETSN], SKIP IF WE SHOULD CLEAR
;RETURNS 23
=0
SETSN:	[FLG]_[FLG].OR.#, FLG.SN/1, HOLD RIGHT, RETURN [23]
CLRSN:	[FLG]_[FLG].AND.NOT.#, FLG.SN/1, HOLD RIGHT, RETURN [23]


;SUBROUTINE TO ROUND A FLOATING POINT NUMBER
;CALL WITH:
;	NUMBER IN AR!Q AND NORM DISP
;RETURNS 16 WITH ROUNDED NUMBER IN AR!ARX
;
=*01*
DROUND:	[ARX]_(Q+1)*.5,		;ROUND AND SHIFT
	SKIP CRY2,		;SEE IF OVERFLOW
	J/DRND1			;COMPLETE ROUNDING
	[AR]_[AR]*.5 LONG,	;WE WENT TOO FAR
	FE_FE+1, ASHC, J/DROUND	;SHIFT BACK AND ROUND
=*010
DRND1:	[AR]_EXP, RETURN [16]	;NO OVERFLOW
=011	[AR]_[AR]+.25,		;ADD CARRY (BITS 36 AND 37
				; ARE COPIES OF Q BITS)
	NORM DISP,		;SEE IF OVERFLOW
	J/DRND1		; ..
=110	[AR]_[AR]*.5,		;SHIFT RIGHT
	FE_FE+1,		;KEEP EXP RIGHT
	J/DRND1		;ALL SET NOW
=