Google
 

Trailing-Edge - PDP-10 Archives - BB-BL69A-SB_1984 - fp.mic
There are 5 other files named fp.mic in the archive. Click here to see a list.
.TOC	"SINGLE FLOATING ADD & SUB -- FAD, FADR, FSB, FSBR"

	.DCODE
.IFNOT/FPLONG
130:	EA,	J/UUO		;UFA
	EA,	J/UUO		;DFN
.ENDIF/FPLONG

140:	R,	FL-AC,	B0/0,	J/FAD
	R,		B0/0,	J/FPNO
	RW,	FL-MEM,	B0/0,	J/FAD
	RW,	FL-BOTH,B0/0,	J/FAD

	R,	FL-AC,		J/FADR
	I,	FL-AC,	B0/0,	J/FADRI
	RW,	FL-MEM,		J/FADR
	RW,	FL-BOTH,	J/FADR

150:	R,	FL-AC,	B0/1,	J/FSB
	R,		B0/1,	J/FPNO
	RW,	FL-MEM,	B0/1,	J/FSB
	RW,	FL-BOTH,B0/1,	J/FSB

	R,	FL-AC,		J/FSBR
	I,	FL-AC,	B0/1,	J/FSBRI
	RW,	FL-MEM,		J/FSBR
	RW,	FL-BOTH,	J/FSBR
	.UCODE

.IFNOT/FPLONG
=0****00**00
FAD:
FSB:	SR_#,#/1,B DISP,J/FADR		;FLAG NO ROUND, GO FAD/FSB
FMP:	SR_#,#/1,J/FMPR
FDV:	SR_#,#/1,J/FDVR
FPNO:	AR_BR,J/UUO
=
.IF/FPLONG
=0****00***0
FAD:
FSB:	SR_#,#/1,B DISP,J/FADR		;FLAG TRUNCATE MODE, GO FAD
FADL:
FSBL:	SR_#,#/2,B DISP,J/FADR		;FLAG LONG MODE
.ENDIF/FPLONG
=
=0****00*010
FADRI:
FSBRI:	AR_AR SWAP,B DISP
FADR:	FE_EXP,EXP_SIGN,SC/SCAD,
		ARX_0S,J/FAS
=111
FSBR:	FE_EXP,SC/SCAD,EXP_SIGN,ARX_0S
=	AR_-AR,J/FAS			;NEGATE SUBTRAHEND
;FIND OPERAND WITH LARGER EXP, LEAVING IT IN BR,
; AND ITS EXP-1 IN FE.  THE SMALLER OPERAND IS LEFT IN AR,
; SHIFTED RIGHT BY THE DIFFERENCE BETWEEN THE EXPONENTS -1

FAS:	BR/AR,BRX/ARX,AR_AC0		;SAVE MEM OP IN BR, GET AC
	SC_EXP-SC,EXP_SIGN,SKP SCAD0	;FIND LARGER OPERAND
=0	FE_FE+SC,BR/AR,AR_BR*2,J/FAS1	;AC EXP .GE. MEM
	MQ_AR,SC_#+SC,#/37.,		;MEM OP LARGER, SHIFT AC OP
		SKP SCAD0,J/FAS2	;COMPUTE SHIFT AMOUNT

FAS1:	MQ_AR,SC_#-SC,#/36.,SKP SCAD0	;CHECK SHIFT AMOUNT
=0
FAS2:	MQ_SHIFT,ARX/MQ,AR_SIGN,J/FAS3	;LOW TO MQ, READY TO GET HI
	AR_SIGN,ARX_AR,			;HERE IF EXP DIFF .GT. 36
		SC_#+SC,#/36.,SKP SCAD0	; .GT. 72?
=0	ARX_SHIFT,MQ_0.M,FE_FE+1,J/FAS5
	ARX_AR,MQ_0.M,FE_FE+1,J/FAS5	;SHIFTED CLEAR OUT

FAS3:	AR_SHIFT,ARL/SH,ARX/MQ,
		MQ_0.M,FE_FE+1		;READY TO ADD

FAS5:	AR_(AR+2BR)*.25,ARX/ADX*.25,	;HERE FOR ADD OR SUB
		NORM,J/SNORM
.TOC	"SINGLE FLOATING MULTIPLY -- FMP, FMPR"

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

	R,	FL-AC,	J/FMPR
	I,	FL-AC,	J/FMPRI
	RW,	FL-MEM,	J/FMPR
	RW,	FL-BOTH,J/FMPR
	.UCODE
.IF/FPLONG
=0****00***0
FMP:	SR_#,#/1,J/FMPR			;FLAG TRUNCATE MODE
FMPL:	SR_#,#/2,J/FMPR			;LONG MODE
=
.ENDIF/FPLONG
=0****00***0
FMPRI:	AR_AR SWAP
FMPR:	SC_EXP,EXP_SIGN,ARX_0S		;PREPARE M'IER FRACTION

=	MQ_AR,AR_AC0,FE_#,#/-14.	;M'IER TO MQ, GET M'CAND
=01*	SC_EXP+SC,EXP_SIGN,		;SEPARATE M'CAND FRACTION FROM EXP
		CALL.S,J/MULSUB		;AND BEGIN MULTIPLY
=11*	FE_#+SC,#/-200,NORM AR,J/SNORM
=
.TOC	"SINGLE FLOATING DIVIDE -- FDV, FDVR"

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

	R,	FL-AC,	J/FDVR
	I,	FL-AC,	J/FDVRI
	RW,	FL-MEM,	J/FDVR
	RW,	FL-BOTH,J/FDVR
	.UCODE
.IF/FPLONG
=0****00***0
FDVL:	FE_EXP-1,EXP_SIGN,ARX+MQ_0.S,J/FDVL1
FDV:	SR_#,#/1,J/FDVR			;FLAG TRUNCATE MODE
=
.ENDIF/FPLONG
=0****00***0
FDVRI:	AR_AR SWAP
FDVR:	SC_EXP+1,EXP_SIGN,ARX+MQ_0.S	;SETUP DIVISOR
=
=000	BR/AR,BRX/ARX,			;DIVISOR TO BR, CLR BRX
		AR_AC0,FE_#,#/27.,	;GET DIVIDEND, STEP COUNT
		SKP AD0,CALL,J/FDVCHK

=10	SKP BR0,CALL,J/DIV-		;OK, BEGIN DIVISION
	SET FL NO DIV,J/IFNOP		;NO DIVIDE, SORRY

;RETURN HERE WITH QUOTIENT IN ARX.  WE TOOK 29 DIVIDE STEPS, TO
; GUARANTEE HAVING A ROUNDING BIT EVEN IF THE FIRST STEP GENERATES
; A QUOTIENT BIT OF ZERO.  THEREFORE, THE MSB OF QUOTIENT IS EITHER
; IN BIT 7 OR 8, AND NORM WILL FIND IT IN ONE STEP.

=110	AR_ARX,FE_FE+#,#/2,		;NEGATIVE QUOTIENT
		SKP BR EQ,J/FDVNEG	;CHECK FOR MORE QUO TO COME
	AR_ARX*.25,ARX_ARX*.25,NORM,	;JUNK IS 36 BITS AWAY FROM MSB
		FE_FE+#,#/2,J/SNORM	;POS QUOTIENT, NORMALIZE
=
;HERE IF QUOTIENT SHOULD BE NEGATIVE, WITH POSITIVE FORM IN
; AR AND ARX.  SKIP IF REMAINDER (IN BR) IS ZERO.  IN THIS CASE,
; WE CLEAR ARX, BECAUSE AR CONTAINS THE ENTIRE QUOTIENT.
; IF, HOWEVER, THE REMAINDER IS NOT ZERO, WE INFER
; THAT AN INFINITE PRECISION DIVISION WOULD GENERATE MORE ONES
; IN THE QUOTIENT.  IF THAT IS THE CASE, WE LEAVE ARX WITH THE
; QUOTIENT, SO THE NEGATION PROCESS WILL WORK CORRECTLY TO RETURN
; THE HIGH ORDER PART OF THE INFINITE-PRECISION NEGATIVE QUOTIENT.
=0
FDVNEG:	SET SR1,AR_AR*.25 LONG,NORM,J/SNORM
	ARX_0S,J/FDVNEG			;REMAINDER WENT TO ZERO
;HERE FOR FDVL

.IF/FPLONG

;FDVL:	FE_EXP-1,EXP_SIGN,CLR ARX+MQ
=000
FDVL1:	AR_AC1,BR_AR LONG,		;SAVE DIVISOR IN BR LONG
		SC_#,#/9.,CALL		;READY TO SHIFT LOW DIVIDEND
	ARX_SHIFT,AR_AC0,		;DIVIDEND IN PLACE
		SC_FE,FE_#,#/24.,	;EXP TO SC, STEP COUNT TO FE
		SKP AD0,J/FDVCHK	;GO CHECK FOR NO DIVIDE
=010	CALL,SKP BR0,J/FDVL2		;GO BEGIN DIVIDE
	SET FL NO DIV,J/IFNOP		;CAN'T DIVIDE, ABORT

=110	AR_AC0,SR_#,#/5,		;NEG QUO, FLAG TRUNCATE MODE
		SR DISP,J/FDVL4		; WAS IT 26 OR 27 STEPS?
	AR_AC0,SR_#,#/1,		;POS QUO
		SR DISP,J/FDVL4
=


;COME HERE TO START THE DIVISION.  ON THE FIRST STEP, WE CHECK
; TO SEE WHETHER A 1 HAS BEEN GENERATED IN THE QUOTIENT.  IF SO,
; 26 ADDITIONAL STEPS WILL GENERATE THE FULL 27 SIGNIFICANT BITS
; OF THE QUOTIENT.  IF NOT, 27 STEPS ARE REQUIRED.

=0
FDVL2:	DIVIDE,AR_2(AR-BR),ARX/ADX*2,J/FDVL3	;FIRST DIVIDE STEP
	DIVIDE,AR_2(AR+BR),ARX/ADX*2		; DOES IT GENERATE A 1?
=00
FDVL3:	DISP/DIV,MQ/MQ*2,		;NO, TAKE AN EXTRA DIVIDE STEP
		AR_2(AR+BR),ARX/ADX*2,J/DIVLP	; WITHOUT COUNTING FE
	SR_1,SC_#+SC,#/1,J/DIV-		;YES, 27 STEPS WILL NORMALIZE QUO
	DISP/DIV,MQ/MQ*2,AR_2(AR-BR),ARX/ADX*2,J/DIVLP
	SR_1,SC_#+SC,#/1,J/DIV+
;WE COME HERE AFTER DOING THE DIVISION, EITHER 26 OR 27 STEPS
; AS REQUIRED TO GENERATE A NORMALIZED QUOTIENT FROM NORMALIZED
; OPERANDS.  NOW FIGURE OUT WHAT EXPONENT THE REMAINDER SHOULD HAVE.

=0
FDVL4:	SC_EXP-#,#/27.,			;DIVIDEND EXP-27
		AR_BR,SKP AR0,J/FDVL6	;GET REMAINDER, TEST D'END SIGN
	SC_EXP-#,#/26.,			;D'END EXP-26
		AR_BR,SKP AR0

;HERE WITH REMAINDER IN AR, ITS EXP IN SC
; SKIP IF D'END (AND THEREFORE REM) NEGATIVE.

=0
FDVL6:	EXP_SC,BYTE DISP,		;TEST FOR UNDERFLOW
		SKP AR EQ,J/FDVL7	; OR REM =0
	AR_-BR,SKP CRY0,		;NEGATE REM, CHECK =0
		GEN SC,BYTE DISP	; AND LOOK FOR EXP UFLO
=110	EXP_-SC-1,J/FDVL7		;ONE'S COMPLEMENT EXP
	AR_0S				;REM =0 OR EXP UFLO
=110
FDVL7:	AC1_AR,ARX+MQ_0.M,		;SAVE REMAINDER
		AR_MQ,ARL/AD,J/SNR2	;GO NORMALIZE QUOTIENT
	AR_0S,J/FDVL7
.ENDIF/FPLONG


;SUBR TO CHECK FOR FLOATING NO DIVIDE
; ENTER WITH SKP ON DIVIDEND SIGN, IN AR LONG, WITH
; DIVISOR EXP IN SC, DIVISOR IN BR

=0
FDVCHK:	SC_EXP-SC,EXP_SIGN,SKP BR0,J/FDVCK1
	AR_-AR LONG,J/FDVCHK		;GET POSITIVE DIVIDEND
=0
FDVCK1:	GEN AR-2BR,SKP CRY0,		;TEST FOR NO DIVIDE
		SC_#+SC,#/177,RETURN2	;AND CORRECT EXP
	GEN AR+2BR,SKP CRY0,		;SAME TEST, NEG DIVISOR
		SC_#+SC,#/177,RETURN2	;AND SAME EXP CORRECTION
.TOC	"UFA, DFN, FSC, IBP"
;ENTER WITH (E) IN AR
.IF/FPLONG
	.DCODE
130:	R,		J/UFA
	RPW,		J/DFN
	.UCODE
=0****00***0
DFN:	FE_AR0-8,AR0-8_#,#/0,		;SAVE LOW EXP, CLR SO CAN 
		ARX_0S,J/DFN1		; DETECT FRACTION = 0
UFA:	FE_EXP,SC/SCAD,EXP_SIGN,ARX_0S
=
=000	BR_AR LONG,AR_AC0,CALL,J/EXPD
=100	ARX_AR,AR_SIGN,ARL/AD,		;READY TO UNNORMALIZE SMALLER OP
		CALL.M,J/SHIFT
	AR_SIGN,ARX/AD			;LOST SMALLER OP, USE ITS SIGN
	AR_AR+BR,SKP AD NE,		;IS RESULT SIGNIFICANT?
		SC_FE,I FETCH
=
=0	AC1_AR,J/FINI			;NO, CLEAR RESULT AC
	SKP EXP NE,BR/AR		;IS RIGHT SHIFT REQ'D?
=0	SKP AR0,FETCH WAIT,J/UFA4	;NO, IS RESULT NEG?
	AR_BR*.5,GEN FE-#,#/377,SKP SCAD NE,FETCH WAIT
=0	FE_-1,SET FLOV
	FE_FE+1,SC/SCAD,SKP AR0
=0
UFA4:	AR0-8_SC,J/STAC1		;POS, PUT IN EXP STRAIGHT
	AR0-8_-SC-1,J/STAC1		;NEG, USE COMPLEMENT OF EXP


DFN1:	AR_-AR,SKP CRY0			; LOW FRACTION =0?
=0	AR0-8_FE,STORE,			;STORE LOW WORD BACK TO MEM
		ARX_AC0 COMP,J/STMAC	; GET COMPLEMENTED HIGH WORD
	AR0-8_FE,STORE,			;LOW WORD WAS ZERO, INSTALL EXP
		ARX_-AC0,J/STMAC	; GET NEGATED HIGH WORD
.ENDIF/FPLONG
	.DCODE
132:	I,	FL-AC,	J/FSC
	R,	B/6,	J/IBP		;ADJBP IF AC .NE. 0
	.UCODE
=0****00***0
.IF/ADJBP
.IF/OWGBP
IBP:	SKP PC SEC0,J/IBP0		;[251] CAN IT BE A OWGBP ?
.IFNOT/OWGBP
IBP:	SKP AC#0,J/IBP1			;IS IT IBP, OR ADJBP?
.ENDIF/OWGBP
.IFNOT/ADJBP
IBP:	J/IBP2
.ENDIF/ADJBP


;FSC
;ENTER WITH E IN AR
=0****00****
FSC:	SC_EA,ARX+MQ_0.M,
		AR_AC0,ARL/AD
=	FE_EXP+SC,EXP_SIGN,J/SNR2	;NORMALIZE SCALED RESULT

.IF/OWGBP
=0
IBP0:	SC_P-#,#/45,SKP SCAD0,J/IBP3	;TREAT THIS AS A OWGBP ?
	SKP AC#0,J/IBP1			;IS IT IBP, OR ADJBP?
=0
IBP3:	BR/AR,SKP AC#0,J/GIBP		;YES, CHECK FOR ADJBP
	SKP AC#0,J/IBP1			;NO, TREAT AS BEFORE, ADJBP?
.ENDIF/OWGBP
.TOC	"FIX, FIXR, FLTR, EXTEND"

	.DCODE
122:	R,		J/FIX		;UNROUNDED
	R,		J/EXTEND	;EXTENDED INSTRUCTION SET

126:	R,		J/FIXR		;ROUNDED
	R,	FL-AC,	J/FLTR
	.UCODE
;FLTR
;ENTER WITH (E) IN AR
=0****00***0
FLTR:	FE_#,#/277,ARX_AR,SKP AR0,	;BINARY POINT TO RIGHT OF ARX
		AR_SIGN,J/SNORM		; SIGN EXTENDED.  GO NORMALIZE

;FIX AND FIXR
;ENTER WITH (E) IN AR
;	FIX AND FIXR DIFFER ONLY IN THE ROUNDING CRITERION:
;FIXR ADDS 1 TO THE INTEGER PART IF THE FRACTION PART IS ONE-HALF
;OR GREATER.  FIX DROPS THE FRACTION PART OF POSITIVE NUMBERS, BUT ADDS
;1 TO THE INTEGER PART OF NEGATIVE NUMBERS IF THE FRACTION PART IS NOT
;ALL ZERO.
;	THIS IS IMPLEMENTED BY CHOOSING A FRACTION (THE ROUNDING
;CONSTANT) TO ADD TO THE INPUT, SUCH THAT A CARRY WILL OCCUR INTO THE
;INTEGER PART UNDER THE APPROPRIATE CONDITIONS.  FOR FIXR, THE ROUNDING
;CONSTANT IS EXACTLY ONE-HALF.  FOR FIX, IT IS ZERO ON POSITIVE INPUT,
;OR THE LARGEST POSSIBLE FRACTION (ALL 1S) ON NEGATIVE INPUT.

=0****00****
FIXR:	FE_EXP-#,#/244,SKP SCAD0,	;GET BINARY POINT POSITION
		ARX_1B1,J/FIX1		;GET ROUNDING CONSTANT
=
=0****00***0
FIX:	FE_EXP-#,#/244,SKP SCAD0,	;GET BINARY POINT POSITION
		ARX_AR SIGN,J/FIX1	;SET ROUNDING CONSTANT, GO FIX

.IF/EXTEND
.IFNOT/XADDR
.IF/MODEL.B				;[246]
EXTEND:	FE_#+AR0-8,#/-32,SKP SCAD0,	;VALID EXTENDED OPERATION?
		ARX_AR,AR_BRX,J/EXT1	; OPR TO ARX, AC TO AR
.IFNOT/MODEL.B
EXTEND:	FE_#+AR0-8,#/-20,SKP SCAD0,	;[246] VALID EXTENDED OPERATION?
		ARX_AR,AR_BRX,J/EXT1	;[246] OPR TO ARX, AC TO AR
.ENDIF/MODEL.B				;[246]
.IF/XADDR
EXTEND:	SC_#+AR0-8,#/-32,SKP SCAD0,	;VALID EXTENDED OPERATION?
		ARX_AR,AR_BR,J/EXTF1	; OPR TO ARX, AC TO AR
.ENDIF/XADDR
.IFNOT/EXTEND
EXTEND:	AR_BR,J/UUO
.ENDIF/EXTEND
=
;HERE FOR FIX.  CONVERT FLOATING TO INTEGER

=0
FIX1:	SET AROV,J/IFNOP		;CAN'T DO IT, GIVE UP
	BR/AR,CLR AR,ARX_ARX*2		;ROUNDING CONSTANT READY IN ARX
	BR_AR LONG,AR_BR,CLR ARX,	;MANTISSA TO AR LONG
		SC_#,#/9.		;READY TO SHIFT OFF EXPONENT
	ARX_SHIFT,AR_SIGN,		;MANTISSA LEFT ALIGNED IN ARX
		SC_FE+#,#/36.,SKP SCAD0	;ANY INTEGER BITS?
=0	MQ_SHIFT,			;YES, PUT THEM IN MQ
		AR_ARX (ADX),CLR ARX,	;SHIFT MANTISSA LEFT 36 PLACES
		I FETCH,J/FIX2		;AND PREFETCH NEXT
	AR_0S,I FETCH,J/STORAC		;ALL SIGNIFICANCE LOST
FIX2:	ARX_SHIFT,AR_MQ			;INTEGER IN AR, FRACTION IN ARX
	AR_AR+BR,AD LONG,J/STAC		;ROUND AND STORE
.TOC	"SINGLE PRECISION FLOATING NORMALIZATION"

;HERE TO NORMALIZE SINGLE PRECISION RESULTS
;SR2-3 TELL HOW TO STORE RESULTS:
;XX00 ... ROUND, SINGLE PRECISION
;XX01 ... TRUNCATE, SINGLE PRECISION
;XX10 ... LONG MODE (IMPLIES TRUNCATION)
;IN ADDITION, THIS CODE SETS SR 1 IF ANSWER IS NEGATIVE, SO X1YZ
; CORRESPONDS TO X0YZ EXCEPT THAT THE RESULT MUST BE NEGATED.

;DISPATCH TO SNORM WITH "DISP/NORM,AR/AD*.25"
; THUS THE 8 POSSIBILITIES ARE:
;SNORM		AD=0	AR=0	EITHER ANSWER IS ZERO, OR MSB IS IN ARX
;SNORM+1	AD0	AR NEG	RESULT IS NEG.  MAKE POS, TRY AGAIN
;SNORM+2	AD1-6	AR3-8	MSB TOO FAR LEFT, SHIFT RIGHT & RETRY
;SNORM+3	AD7	AR9	RESULT IS CORRECTLY NORMALIZED
;SNORM+4	AD8	AR10	SHIFT LEFT ONCE FOR NORMALIZATION
;SNORM+5	AD9	AR11	SHIFT LEFT 2 PLACES
;SNORM+6	AD10	AR12	SHIFT LEFT THRICE
;SNORM+7	AD11-35	AR13-35	SHIFT LEFT A LOT, TRY AGAIN

=000
SNORM:	AR_ARX,ARL/SH,SKP ARX NE,	;AR IS ZERO, GET ARX
		ARX_0.M,J/SNZERO
	NORM -AR,SET SR1,J/SNORM	;REMEMBER NEGATIVE, GO POSITIVE
SNR2:	AR_AR*.25 LONG,FE_FE+#,#/2,	;SHIFT RIGHT,
		NORM,J/SNORM		;TRY AGAIN
	SR DISP,J/SROUND		;AD7 -> AR9, IS ROUND REQ'D?
	AR_AR*2 LONG,FE_FE-1,		;AD8 -> AR10, ONCE LEFT AND DONE
		SR DISP,J/SROUND
	AR_AR*4 LONG,FE_FE-#,#/2,	;AD9 -> AR11
		SR DISP,J/SROUND
	AR_AR*8 LONG,FE_FE-#,#/3,	;AD10 -> AR12
		SR DISP,J/SROUND
.IFNOT/SNORM.OPT
	SKP AR NE,INH CRY18,SC_#,#/7	;LOOK FOR AR13-17
=0	SC_#,#/13.			;LH IS 0.  SHIFT FARTHER
	MQ_SHIFT,AR_ARX (ADX),CLR ARX,	;HIGH TO MQ, GET READY FOR LOW
		FE_FE-SC		; ADJUST EXPONENT
	ARX_SHIFT,AR_MQ,J/SNR2		;FRACTION REPOSITIONED. GO AGAIN
;HERE IS THE FASTER VERSION OF LONG NORMALIZATION SHIFTS,
; WHICH TAKES FOUR WORDS MORE BUT IS A BIT QUICKER IN THE
; INTERMEDIATE NORMALIZATION CASES.

.IF/SNORM.OPT
	ADA EN/0S,ADB/AR*4,AD/ANDCA,	;GENERATE AR*4
		AR/AD*2,ARX/ADX*2,	; AR_AR*8 LONG
		SC_#,#/12.,		;READY TO SHIFT FARTHER
		GEN CRY18,SKP CRY0	; TEST AR0-19 FOR ZERO

=0	AR_AR*8 LONG,BR_AR LONG,	;IT WAS IN AR13-19
		FE_FE-#,#/6,NORM,J/SN1	; NOW IN AR10-16, AD8-14
	MQ_SHIFT,AR_ARX (ADX),		;13-19=0, SHIFT TO TRY 20-35
		CLR ARX,SC_#,#/10.
	ARX_SHIFT,AR_MQ*.25,		;REPOSITION FRACTION IN AR LONG
		FE_FE-#,#/13.,		;COMPENSATE EXPONENT
		NORM,J/SNORM
=100
SN1:	AR_BR*2 LONG,FE_FE+#,#/2,	;MSB IN AD8, SO IN BR10
		SR DISP,J/SROUND
	AR_BR*4 LONG,FE_FE+1,		;MSB IN AD9, THUS IN BR11
		SR DISP,J/SROUND
	SR DISP,J/SROUND		;AD10 -> AR9, A LUCKY GUESS
	AR_AR*8 LONG,BR_AR LONG,	;TRY SHIFTING 3 MORE
		FE_FE-#,#/3,NORM,J/SN1
.ENDIF/SNORM.OPT
;HERE WHEN AD ENTIRELY ZERO ON NORMALIZE ATTEMPT.  SKIP IF ARX
; IS NOT ZERO, HAVING COPIED IT TO AR (IE, LEFT SHIFT 36 PLACES).
; OTHERWISE, THE ENTIRE RESULT IS ZERO, SO WE STORE THAT.
=0
SNZERO:	CLR FE,AR+ARX+MQ_0.M,		;RESULT = 0
		SR DISP,J/SRND5
	AR_AR*.25 LONG,FE_FE-#,#/34.,	;HAVE MOVED LEFT 36, GO RIGHT 2
		NORM,J/SNORM		;AND TRY THAT


;WE GET HERE WITH A NORMALIZED POSITIVE FRACTION IN AR'ARX,
; THE CORRECTED EXPONENT IN FE, AND SR INDICATES THE PROPER SIGN
; FOR THE RESULT AND WHETHER THE ANSWER SHOULD BE ROUNDED,
; TRUNCATED, OR LONG.

.IF/FPLONG
=100
.IFNOT/FPLONG
=1*0
.ENDIF/FPLONG
SROUND:	BR_AR LONG,AR_0S,J/SRND2	;PREPARE TO ROUND BY ADDING THE
					; PART OF THE FRACTION WE WILL
					; DISCARD (CARRY IF ARX0)
	BR_AR LONG,CLR AR,ARX_1S,	;TRUNCATE MODE
		SR DISP,J/STRNC		; HANDLING DEPENDS ON SIGN
.IF/FPLONG
	BR_AR LONG,CLR AR,ARX_1S,	;LONG MODE
		SC_#,#/9.
=	ARX_SHIFT,SR DISP		;MASK = 0,,000777 TO ARX
=01*
	BR_AR LONG,AR_BR LONG,J/SRND4	;POS, TRUNCATE BY ANDING
	AR_AR+BR,ARX/ADX,BR_AR LONG,	;NEG, MUST DIDDLE
		NORM,J/SRND3		; NORM FORCES LONG ARITH
.ENDIF/FPLONG
;HERE TO PERFORM ROUNDING OR TRUNCATION OF SINGLE-PRECISION RESULTS,
; AND CHECK FOR CARRY INTO EXPONENT FIELD REQUIRING RENORMALIZATION

=0*1
STRNC:	AR_BR,CLR ARX,J/SRND4		;POS TRUNCATE, GO STUFF IN EXP
SRND2:	AR_AR+BR,NORM,CLR ARX		;NORM FORCES LONG ARITH
					; SO THIS ADDS ARX TO BR'BRX
=1*0
SRND3:	AR_AR*.5,FE_FE+1		;RENORMALIZE
SRND4:	EXP_FE TST,SR DISP,		;STUFF EXP, CHECK NEG OR LONG
		ARX_ARX*BRX,AD/ANDCB	;CLEAR TRUNCATED FRACTION

;HERE TO STORE RESULT AS A FUNCTION OF SINGLE OR LONG PRECISION
; AND POSITIVE OR NEGATIVE...
.IF/FPLONG
=001
.IFNOT/FPLONG
=0*1
.ENDIF/FPLONG
SRND5:	SR_0,B WRITE,J/ST6		;POS & NOT LONG
.IF/FPLONG
SLNG3:	AC0_AR,AR_0S,SC_#,#/27.,J/SLNG4	;STORE HIGH PART OF LONG ANS
.ENDIF/FPLONG
	AR_-AR,SR_0,B WRITE,J/ST6	;NEG & NOT LONG
.IF/FPLONG
	AR_-AR LONG,J/SLNG3		;LONG NEG, MAKE IT SO

SLNG4:	AR_SHIFT,I FETCH
	AR0-8_FE-SC,BYTE DISP,		;TEST FOR EXP UNDERFLOW
		SKP AR EQ		; OR LOW WORD ZERO

=110
.ENDIF/FPLONG
STRAC1:	SR_0,J/STAC1			;PUT AWAY LOW WORD OF LONG RESULT
.IF/FPLONG
	AR_0S,SR_0,J/STAC1		;CLEAR LOW WORD IN AC1
.ENDIF/FPLONG
.TOC	"DOUBLE FLOATING ARITHMETIC -- DFAD, DFSB, DFMP, DFDV"

	.DCODE
110:	R,	B/0,	J/DFLOAT	;DFAD
	R,	B/2,	J/DFLOAT	;DFSB
	R,	B/4,	J/DFLOAT	;DFMP
	R,	B/6,	J/DFLOAT	;DFDV
	.UCODE

=0****00**0*
DFLOAT:	FE_EXP,EXP_SIGN,SC/SCAD,MQ_0.S,
		VMA_VMA+1,LOAD ARX,
		CALL.S,J/XFERW		;GET LOW WORD
	ARX_ARX*2,B DISP		;LOW BIT 0 IGNORED
=
=00*
DFAS:	BR_AR LONG,AR_AC1*2,J/DFAS1	;MEM OP READY, GET AC OP

	AR_-AR LONG,J/DFAS		;DFSB, NEGATE AND ADD

.IF/MODEL.B
	BR_AR LONG,GEN ARX,SKP AD NE,	;[241]HERE FOR DOUBLE FLT MUL
		FE_#,#/-18.,J/DFMP	;[241]BEGIN TEST FOR STICKY BIT
.IFNOT/MODEL.B
	AR_AC1,BR_AR LONG,		;HERE FOR DBL FLOATING MUL
		FE_#,#/-18.,J/DFMP
.ENDIF/MODEL.B

	GEN AR*AC0,AD/XOR,SKP AD0,	;DFDV.  WILL QUO BE NEG?
		BR_AR LONG,		;SAVE D'SOR IN BR, BRX
		SC_FE-1,J/DFDV
;HERE FOR DFAD AND DFSB
; MEM OPERAND IS IN BR (NEGATED IF DFSB)
; FE AND SC HAVE ITS EXPONENT

=0*0
DFAS1:	ARX_AR,AR_AC0,CALL,J/EXPD	;AC OPERAND IN PLACE
=1*0
DFAS2:	ARX_AR,AR_SIGN,			;GET SHIFTED HIGH WORD
		GEN #+SC,#/-36.,	;IS ANY SHIFT REQUIRED?
		SKP SCAD0,J/DFAS3
	ARX_AR,AR_SIGN,			;DIFF IS > 36
		SC_#+SC,#/36.,SKP SCAD0	;CHECK FOR >72
.IF/MODEL.B
=0	AC0_AR,MQ_SHIFT,AR_ARX (ADX),
		ARX/MQ,J/DFAS6		;[241]36 < DIFF < 72
.IFNOT/MODEL.B
=0	AC0_AR,MQ_SHIFT,AR_ARX (ADX),
		ARX/MQ,J/DFAS4		;36 < DIFF < 72
.ENDIF/MODEL.B
	AR_BR,ARL/AD,ARX_BRX,		;DIFF >72
		MQ_0.M,J/DNTRY		;NORMALIZE LARGER OP
=0
DFAS3:	AR_ARX,ARL/SH,ARX/MQ,		;NO SHIFT REQUIRED
		MQ_0.M,J/DFAS5
	AR_SHIFT			;BEGIN SHIFTING SMALLER OP
	AC0_AR,AR_ARX,ARX/MQ		;HI PART TO AC
	MQ_SHIFT,AR_ARX (ADX),		;MID PART TO MQ
		CLR ARX			;SHIFT ZEROS IN FROM RIGHT
DFAS4:	MQ_SHIFT,ARX/MQ,AR_AC0		;ALL PIECES NOW IN PLACE
DFAS5:	AR_AR+BR,ARX/ADX,SC_#,#/4,	;HERE WHEN OPERANDS ALIGNED
		NORM,J/DNORM		;ADD, AND NORMALIZE RESULT
.IF/MODEL.B
DFAS6:	MQ_SHIFT,AR_MQ			;[241]GET H,L, PUT S,H IN AR
	AC1_AR,AR_ARX,ARX_0S		;[241]STORE S,H
	ARX_AC1,AR_SHIFT		;[241]GET L,0, GET S,H BACK
	GEN AR,SKP AD NE		;[241]TEST FOR 0'S,
=0	CLR SR3,AR_AC0,J/DFAS5		;[241]DO 2'S COMP, ALL IN PLACE
	SET SR3,AR_AC0,J/DFAS5		;[241]DO 1'S COMP, ALL IN PLACE
.ENDIF/MODEL.B

;SUBROUTINE TO CHOOSE OPERAND WITH SMALLER EXPONENT, AND
; PREPARE FOR SHIFTING IT.
; ENTER WITH ONE OPERAND FRACTION IN BR, ITS EXPONENT IN FE & SC,
; THE OTHER OP IN AR WITH ITS EXPONENT IN AR0-8
; RETURN THE LARGER EXPONENT IN FE, AND 36-(MAGNITUDE OF DIFFERENCE)
; IN SC.  RETURN 4 IF SC POSITIVE, 5 IF NEGATIVE.

EXPD:	SC_EXP-SC,EXP_SIGN,SKP SCAD0	;COMPARE MAGNITUDES
=0	AR_BR,ARX_BRX,BR/AR,BRX/ARX,	;AC OP IS LARGER MAGNITUDE
		FE_FE+SC,J/EXPD1	;ITS EXP TO FE
	MQ_ARX,SC_#+SC,#/36.,		;CHECK FOR EXP DIFF > 36
		SKP SCAD0,RETURN4
EXPD1:	MQ_ARX,SC_#-SC,#/36.,		;AC EXP .GE. MEM
		SKP SCAD0,RETURN4	;SHIFT MEM OP
;DFMP
; DO TESTS FOR STICKY BITS FIRST THEN
; GET HERE WITH MEM OPERAND (M'CAND) IN BR!BRX
; AR HAS (AC1), LOW HALF OF M'IER

.IF/MODEL.B
=0
DFMP:	AR_AC1,J/DFMP1			;NO STICKY BIT
	AR_AC1,SKP AD NE		;GET AC LOW AND TEST
=0	J/DFMP1				;NO STICKY BIT
	SET SR3				;WORRY ABOUT IT IN NORM
=00*
DFMP1:	MQ_AR,AR_0S,ARX_0S,		;SETUP LOW M'IER
		SC_#+SC,#/-200,		;CORRECT EXPONENT
		CALL,J/MULREE		;MULTIPLY BY THE LOW PART
.IFNOT/MODEL.B
=00*
DFMP:	MQ_AR,AR_0S,ARX_0S,		;SETUP LOW M'IER
		SC_#+SC,#/-200,		;CORRECT EXPONENT
		CALL,J/MULREE		;MULTIPLY BY THE LOW PART
.ENDIF/MODEL.B
=10*	AR_AR+BR LONG			;OOPS, LOW SIGN WAS SET
	MQ_AR,AR_AC0,FE_#,#/-14.	;READY TO CONTINUE WITH HIGH PART

;HERE TO USE HIGH MULTIPLIER

	SC_EXP+SC,EXP_SIGN.M,		;EXTRACT EXP FROM HIGH WORD
		SKP AR0			;CHECK FOR NEG M'IER
=010
DFMP2:	MQ_AR,AR_MQ,CALL,J/MULREE	;GO BACK IN FOR HIGH PART
	EXP_1,J/DFMP2			;OOPS, NEG, MOVE SIGN TO BIT 8
=110
DNTRY:	SC_#,#/4,GEN AR,NORM,J/DNORM	;NORMALIZE THE ANSWER
=

;DFDV
; GET HERE WITH DIVISOR IN BR!BRX, ITS EXP-1 IN SC
; SKIP IF D'SOR AND D'END SIGNS DIFFER

=000
DFDV:	AR_AC1*2,CALL,J/DFDV1		;GET LOW D'END, GO START DIVIDE
.IF/MODEL.B
	SET SR2,AR_AC1*2,CALL,J/DFDV1	;NOTE NEG QUO
.IFNOT/MODEL.B
	SR_1,AR_AC1*2,CALL,J/DFDV1	;NOTE NEG QUO
.ENDIF/MODEL.B

=011	AC1_AR,AR_MQ,ARL/AD,FE_FE+1,	;HERE FROM DDVSUB. NEW STEP CNT
		MQ_0.M,CALL.M,J/DIV+	; SAVE HIGH QUO, RESUME
=101	AC1_AR,AR_MQ,ARL/AD,FE_FE+1,
		MQ_0.M,CALL.M,J/DIV-

=111	AR_AC1,ARX/MQ,SC_#,#/4,		;POSITIVE QUOTIENT TO AR LONG
		NORM,J/DNORM		;NORMALIZE AND ROUND

=00
DFDV1:	ARX_AR,AR_AC0,SKP AD0,		;TEST DIVIDEND SIGN
		FE_#,#/26.,		;SETUP COUNT FOR HIGH QUO
		CALL,J/FDVCHK		;GO CHECK DIVIDABILITY
=10	SKP BR0,J/DDVSUB		;BEGIN DIVISION (RETURN ABOVE)
	SET FL NO DIV,J/IFNOP		;ABORT THE DIVISION
.TOC	"DOUBLE PRECISION NORMALIZATION"

=000
DNORM:	SKP ARX+MQ NE,SC_#,#/35.,J/DNZERO	;AR=0
.IF/MODEL.B
	BR/AR,BRX/ARX,AR_MQ COMP,	;RESULT NEG, MAKE POS
		SET SR2,J/DNNEG		;[241]FLAG NEGATIVE
.IFNOT/MODEL.B
	BR/AR,BRX/ARX,AR_MQ COMP,	;RESULT NEG, MAKE POS
		SR_1,J/DNNEG		;FLAG NEGATIVE
.ENDIF/MODEL.B
	AR_AR*.25 LONG,MQ_MQ*.25,
		FE_FE+#,#/4,J/DNHI	;MSB IN AR 1-6
	AR_AR*.25 LONG,
		FE_FE+#,#/2,J/DROUND	;MSB IN AR7
	AR_AR*.5 LONG,FE_FE+1		;MSB IN AR8
DROUND:	AR_AR+1,ARX/ADX,NORM,		;MSB IS AR9, RIGHT ON
		SC_#,#/35.,J/DRND1
	(AR+ARX+MQ)*2,FE_FE-1,J/DROUND	;MSB IN AR10
	AR_SHIFT,FE_FE-SC		;SOMEWHERE IN AR 11-35

DNSHFT:	BR/AR,AR_ARX,ARX/MQ		;SHIFT THE WHOLE THING
	MQ_SHIFT,AR_ARX (ADX),CLR ARX
	MQ_SHIFT,ARX/MQ,AR_BR,SC_#,#/10.,
		NORM,J/DNORM		;GIVE IT ANOTHER GO

.IF/MODEL.B
DNNEG:	SR DISP				;[241]TEST FOR 1'S COMP
=1110	AR_AR+1,SKP CRY0,J/DNNEG1	;[241]COMPLETE NEGATION OF MQ
	MQ_AR,AR_BR COMP,ARX_BRX COMP,
		NORM,J/DNORM		;NORMALIZE THE POS FORM
=0
DNNEG1:	MQ_AR,AR_BR COMP,ARX_BRX COMP,
		NORM,J/DNORM		;NORMALIZE THE POS FORM
	MQ_AR,AR_-BR,ARX/ADX,NORM,J/DNORM
.IFNOT/MODEL.B
DNNEG:	AR_AR+1,SKP CRY0		;COMPLETE NEGATION OF MQ
=0	MQ_AR,AR_BR COMP,ARX_BRX COMP,
		NORM,J/DNORM		;NORMALIZE THE POS FORM
	MQ_AR,AR_-BR,ARX/ADX,NORM,J/DNORM
.ENDIF/MODEL.B

DNHI:	(AR+ARX+MQ)*.25,J/DNTRY		;GO TRY AGAIN

=0
DNZERO:	SR_0,AR_0S,ARX_0S,J/DBLST	;RESULT = 0, STORE THAT
	AR_SHIFT,FE_FE-SC,J/DNSHFT	;NOT ZERO, SHIFT AND TRY AGAIN

=110
DRND1:	AR_AR*.5 LONG,FE_FE+1		;ROUNDING BLEW THE NORM, GO RIGHT
	EXP_FE TST,SR DISP,CLR MQ,	;STUFF EXP IN, CHECK RESULT SIGN
		BRX/ARX,ARX_1		;READY IF NEGATION NECESSARY

.IF/MODEL.B
=1101					;[241]
.IFNOT/MODEL.B
=0
.ENDIF/MODEL.B
	AC0_AR,AR_SHIFT,ARX_BRX,	;STORE HIGH WORD, READY LOW
		I FETCH,J/STD1
.IF/XADDR
	ARX_ARX*BRX,AD/ANDCA,SR_0,	;CLEAR ROUNDING BIT
		J/CDBLST
.IFNOT/XADDR
	ARX_ARX*BRX,AD/ANDCA,SR_0	;CLEAR ROUNDING BIT
	AR_-AR LONG,J/DBLST		;NEGATE RESULT AND STORE
.ENDIF/XADDR