{File name:  <CoPilot>DLion>CedarFPT.mc
Last edited by Fiala:  2-Jul-86 16:17:42 
 Description: IEEE 32-bit floating point arithmetic code for Cedar
Created by H. Sturgis, major rewrite by E. Fiala.

Copyright (C) 1983, 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.
}

{Issues remaining:
	Bugs
		Is the trap parameter incorrect?
	Consider using R registers for some U variables.
	Implement square root.
	Implement different rounding modes, infinities, etc.
	Optional trap on denormalized result.
	Don't trap on infinity arguments or result except when overflow occurs.
	Faster handling of 0 arguments.
	Possible argument reversal for FSC.
	Most negative integer for FIXI and most negative long integer for FIX shouldn't trap.
	Implement FCOMP without calling Unpack2.
	The choice of where arguments are in FADD at unNormed is bad; improve this or use subr to save 6 mi in arg setup.
}

{Misc opcode dispatch was:
@MISC:	Xbus _ ibHigh, XDisp,						c1, opcode[364'b];
	Rx _ ib, XDisp, push, DISP4[MiscHigh, 8],			c2;
}
	STK _ TOS, pop, DISP4[MiscFpt],					c3, at[1, 10, MiscHigh];


{**************************************************************************
Sticky register exchange operation
**************************************************************************}
@aFSticky:
	T _ uStickyReg,							c1, at[ 9, 10, MiscFpt];
	uStickyReg _ TOS,						c2;
	TOS _ T,							c3;
	
	PC _ PC + 1, GOTO[IBDispOnly],					c1;


{**************************************************************************
UPNorm calling sequence:
	L2 _ 0/1, Q _ LowHalf,						c1;
	T _ T LRot8, CALL[UPNorm],					c2;

nominal entry:	
  T =		high fraction
  Q =		low fraction
  Rx =		exponent

Rx is decremented by 1 and <T..Q> is left-=shifted by 1 until the sign bit of T = 1.
Timing: 1 cycle + 3 cycles/norm-step.
This procedure is called by Unpack1/2 when the number is denormalized.
**************************************************************************}
UPNorm:	T _ DLShift1(T or TT), SE _ 1, GOTO[UPNorm1],			c3;
UPNormLoop:
	T _ DLShift1(T or TT), SE _ 1, CANCELBR[$]			c3;
UPNorm1:
	[] _ T, NegBr,							c1;
	Rx _ Rx - 1, L2Disp, BRANCH[UPNormLoop, $],			c2;
	Rx _ Rx + 1, BRANCH[UP1NormF, UP2NormF],			c3;



{**************************************************************************
FptExpSignFix calling sequence:
	L0 _ 0/1,							c1;
	CALL[UPNorm],							c2;
This procedure is called from FDiv and FMul to do exponent and sign fixing at entry.
**************************************************************************}
FptExpSignFix:
	T _ T + TT,							c1;
	uExp1 _ T,							c2;
	TT _ uSign1,							c3;
	Q _ uSign2, L0Disp,						c1;
	uSign1 _ TT xor Q, BRANCH[FMulD, FDivD],			c2;



{**************************************************************************
Unpack1 calling sequence:
	L0 _ unpack.foo,						c1;
	TT _ LRot1 TOS, CALL[Unpack1],					c2;

nominal entry:	
  TOS =		| arg1H	|	arg1H: [0..0]=s1, [1..8]=exp1, [9..15]=fract1a
					
  STK =		| arg1H	|
	-->	| arg1L	|	arg1L:  [0..7]=fract1b, [8..15]=fract1c

returns:	
  TOS =		| arg1H	|
					
  STK =		| arg1H	|
	-->	| arg1L	|	
  
  uSign1:	[0..0]=s1, [1..15]=0
  uExp1, Rx:	[0..7]=0, [8..15]=exp1
  uHighHalf1:	[0..0]=1, [1..7]=fract1a, [8..15]=fract1b (if exp1 = 0 then [0..0] = 0)
  uLowHalf1:	[0..7]=fract1c, [8..15]=0	

L1: L1.OneArgFPTrap

NOTE: On exit., IF <x0, x1, ...> = <uHighHalf1, uLowHalf1> THEN value = (-1)^uSign1 * 2^(uExp1-127) * <x0 . x1 x2 x3 ...>
	i.e. <uSign1, uExp1, uHighHalf1, uLowHalf1> is in proper format for immediate repacking.

NOTE: Unpack2 enters at Unpack1X.
Timing: 14 cycles in normal case, longer for denormalized argument, trap on infinite, or not-a-number argument.
**************************************************************************}
Unpack1: 	
       	Q _ 377'b, L1 _ L1.OneArgFPTrap,				c3;
Unpack1X:
	Rx _ TT and 1, {the sign bit}					c1;
  	uSign1 _ Rx,							c2;
	Rx _ (TT LRot8) and Q, {exponent},				c3;

	T _ STK, fXpop, fZpop, push, {stack underflow?}			c1;
	TT _ (T LRot8 ) and Q, {low 8 bits of high word}		c2;
	T _ (T LRot8) or Q, {low word or 377'b}				c3;

	uExp1 _ Rx, ZeroBr,						c1;
	uLowHalf1 _ T xor Q, NZeroBr, BRANCH[$, UP1ZeroE1],		c2;
	[] _ Rx xor Q, ZeroBr, CANCELBR[$],				c3;

	T _ TOS or 200'b, BRANCH[$, UP1HighExp],			c1;
UP1ZeroE3:
	T _ T and Q, BRANCH[$, UP1Denorm], 				c2;
	T _ T LRot8, L0Disp,						c3;
	uHighHalf1 _ T or TT, RET[UnpackRets],				c1;
	
UP1ZeroE1: {Exponent = 0}
	T _ TOS and 177'b, BRANCH[$, UP1Denorm1],			c3;

	[] _ T or TT, NZeroBr, GOTO[UP1ZeroE3],				c1;

{FMP and FDIV require normalized significands because of assumptions about which
result bits are significant, but for FADD and FSUB, normalizing the denormalized
argument is counter-productive.  I chose to accept slower FADD and FSUB in this
unusual case rather than slowing down the ordinary cases for FMP and FDIV.  Also,
this code could accelerate the shift when the high byte is entirely 0 and when
the high word is entirely 0.}

UP1Denorm: {Exponent = low significand word = 0, high significand word # 0}
	{noop}								c3;
UP1Denorm1: {Exponent = 0, low significand # 0, high significand unknown}
	Q _ uLowHalf1, L2 _ 0,						c1;
	T _ T LRot8, CALL[UPNorm],					c2;

UP1NormF:
	uExp1 _ Rx,							c1;
	uHighHalf1 _ T,							c2;
	uLowHalf1 _ Q, L0Disp,						c3;
	RET[UnpackRets],						c1;
	
UP1HighExp: {Exponent = 377'b}
	GOTO[FPTrapsC3],						c2;


{**************************************************************************
Unpack2 calling sequence:
	L0 _ unpack.foo,						c1;
	TT _ LRot1 TOS, CALL[Unpack2],					c2;

nominal entry:	
  TOS =		| arg2H	|	arg2H: [0..0]=s2, [1..8]=exp2, [9..15]=fract2a
					
  STK =		| arg2H	|
	-->	| arg2L	|	arg2L:  [0..7]=fract2b, [8..15]=fract2c	
  		| arg1H	|	arg1H: [0..0]=s1, [1..8]=exp1, [9..15]=fract1a
		| arg1L	|	arg2L:  [0..7]=fract1b, [8..15]=fract1c

returns:	
   STK =	| arg2H	|
	    	| arg2L	|
  		| arg1H	|	
	 -->	| arg1L	|		
  
  uSign2:	[0..0]=s1, [1..15]=0
  uExp2:	[0..7]=0, [8..15]=exp2
  uHighHalf2:	[0..0]=1, [1..7]=fract2a, [8..15]=fract2b (if exp2 = 0 then [0..0] = 0)
  uLowHalf2:	[0..7]=fract2c, [8..15]=0		
  
  uSign1:	[0..0]=s1, [1..15]=0
  uExp1:	[0..7]=0, [8..15]=exp1
  uHighHalf1:	[0..0]=1, [1..7]=fract1a, [8..15]=fract1b (if exp1 = 0 then [0..0] = 0)
  uLowHalf1:	[0..7]=fract1c, [8..15]=0	

On Exit:
	IF <x0, x1, ...> = <uHighHalf1, uLowHalf1> THEN value1 = (-1)^uSign1 * 2^(uExp1-127) * <x0 . x1 x2 x3 ...>
	IF <x0, x1, ...> = <uHighHalf2, uLowHalf2> THEN value2 = (-1)^uSign2 * 2^(uExp2-127) * <x0 . x1 x2 x3 ...>
i.e. <uSign1, uExp1, uHighHalf1, uLowHalf1> is in proper format for immediate repacking, as is <uSign2, uExp2, uHighHalf2, uLowHalf2>

Timing: 29 cycles if no trap, traps for denormalized, infinite, or not-a-number arguments.		
**************************************************************************}
Unpack2:	
	Q _ 377'b, L1 _ L1.OnePt5ArgFPTrap,				c3;

	Rx _ TT and 1, {the sign bit},					c1;
	uSign2 _ Rx,							c2;
  	Rx _ (TT LRot8) and Q, {exponent},				c3;

	T _ STK, pop, {stack underflow?}, 				c1;
	TT _ (T LRot8 ) and Q, {low half of high word}			c2;
	T _ (T LRot8) or Q, {low word or 377'b},			c3;
	
	uExp2 _ Rx, ZeroBr, {test for zero exponent}			c1;
	uLowHalf2 _ T xor Q, NZeroBr, BRANCH[$, UP2ZeroE1], {Test for low half = 0}	c2;
	[] _ Rx xor Q,  ZeroBr, CANCELBR[$],				c3;

	T _ TOS or 200'b {implicit leading 1 bit of significand}, BRANCH[$, UP2HighExp],	c1;
UP2ZeroE3:
	T _ T and Q, BRANCH[$, UP2Denorm],				c2;
	T _ T LRot8, L1 _ L1.TwoArgFPTrap,				c3;

	uHighHalf2 _ T or TT,						c1;
UP2NormDone:
	TOS _ STK, pop, {stack underflow?},				c2;
	TT _ LRot1 TOS, GOTO[Unpack1X],					c3;
	
UP2ZeroE1: {Exponent = 0}
	T _ TOS and 177'b, BRANCH[$, UP2Denorm1], {leading significand bit = 0, but sign may = 1}	c3;
{Low half = 0; test components of high half for 0 meaning number is exactly 0}
	[] _ T or TT, NZeroBr, GOTO[UP2ZeroE3],				c1;
	
UP2Denorm: {Exponent = 0, high word of significand # 0}
	{noop}								c3;
UP2Denorm1: {Exponent = 0, low word of significand # 0}
	Q _ uLowHalf2, L1 _ L1.TwoArgFPTrap,				c1;
	T _ T LRot8, L2 _ 1, CALL[UPNorm],				c2;

UP2NormF:
	uExp2 _ Rx,							c1;
	uHighHalf2 _ T,							c2;
	uLowHalf2 _ Q,							c3;
	Q _ 377'b, GOTO[UP2NormDone],					c1;

UP2HighExp:
	GOTO[FPTrapsC3],						c2;


{**************************************************************************
Denormalization code

Enter with  T..~Q holding the 32-bit quantity, L0 prepared for return, TT holding right-shift count.

Contents of TT is destroyed.
Denormalized result is in T, Q; Q[15] is a sticky bit.
**************************************************************************}
DeNormC1:								c1;
DeNormC2:								c2;
DeNormC3:
	TT _ -TT-1,							c3;
DeNormA:
	TT _ TT+1, NZeroBr,						c1;
	[] _ Q and 1, ZeroBr, BRANCH[DeNormA1, $],			c2;
	T _ DRShift1 T, SE _ 0, BRANCH[DeNormA, DeNormB],		c3;

DeNormA1: {sticky bit is 0}
	Q _ ~Q, L0Disp, CANCELBR[$],					c3;

	RET[DeNormRets],						c1;

{sticky bit will be 1}
DeNormB:
	TT _ TT+1, NZeroBr,						c1;
	BRANCH[DeNormB1, $],						c2;
	T _ DRShift1 T, SE _ 0, GOTO[DeNormB],				c3;

DeNormB1: {sticky bit is 1}
	Q _ ~Q, L0Disp,							c3;

	Q _ Q or 1, RET[DeNormRets],					c1;


{**************************************************************************
Rounding code (rounds to nearest, to an even low-order significand bit on exactly half way)

Enter with
	L0 prepared for return.
	uStickyBit # 0 if low-order 1's in the result have been shifted into insignificance
	exponent in TT and significand in T..Q

If inexact result, trap or set bit in uStickyReg, depending on trap enable bit in uStickyReg.
**************************************************************************}
Round:	Rx _ 377'b, BRANCH[$, RoundB],					c1;
RoundC:	[] _ Q and Rx, ZeroBr, GOTO[RoundD],				c2;
RoundB:	Q _ Q or 1, GOTO[RoundD],					c2;

RoundD:	Rx _ 177'b, L0Disp, BRANCH[Inexact, $],				c3;
	RET[RoundRets],							c1; {Exact, no rounding}
	
{Use TOS as a temporary here; it will eventually be restored.}
Inexact:
	TOS _ uStickyReg, NegBr, CANCELBR[$, 0F],			c1;
	TOS _ TOS or 1, BRANCH[$, InexactTrap],				c2;
{Round to nearest}
	Q _ Q + Rx + 1, CarryBr,					c3;

	[] _ Q and Rx, ZeroBr, BRANCH[$, Inexact1],			c1;
	Rx _ LShift1 200'b, SE _ 0, BRANCH[RoundExit2, $]		c2; 
{Round to an even value if exactly half way between two values.}
	Q _ Q and ~ Rx {Q[7] _ 0}, L0Disp,				c3;
RoundExit:
	uStickyReg _ TOS, RET[RoundRets],				c1;

{Roundoff carried across word boundary.}
Inexact1:
	T _ T + 1, CarryBr, {overflowBr since T[0]=1} CANCELBR[$],	c2;
{The value is already even if a carry into the next word occurs, so no round-to-even test is needed.}
	uStickyReg _ TOS, L0Disp, BRANCH[RoundExit2A, $],		c3;
	TT _ TT + 1 {roundoff overflowed, adjust exponent}, RET[RoundRets],	c1;

RoundExit2:
	uStickyReg _ TOS, L0Disp,					c3;
RoundExit2A:
	RET[RoundRets],							c1;

InexactTrap:
	GOTO[FPTrapsC1],						c3;
	

{**************************************************************************
Repack entry:	
  TOS =		|  ~	|
					
  STK =		| arg1H	|
	-->	| arg1L	|

L1 holds the link for a possible FPTrap jump on overflow or underflow.
uSign1 holds 	[0..14]=0, [15..15]=sign result
uExp1 holds	[0..15]=expResult, excess 127, possibly negative
	(if x0, x1, ... are the bits of <uHighHalf1,uLowHalf1>, then the represented
	value (exclusive of sign) is <x0. x1 x2 ...>*2^(uExp1-127))

<uHighHalf1,uLowHalf1> holding upper 32 bits of significand part of result, may
contain leading zeros.  uStickyBit is non zero if any bits to right of
<uHighHalf1, uLowHalf1> are non-zero.

exits with:	
  TOS =		|result1H	|
					
  STK =		|  ~	|
	-->	|result1L	|	
  
Issues concerning the following algorithm are discussed in my notebook [Sturgis] for
28June82 page 3,  2 July page 6, and 7 July page 7.
Watch out for rounding issues on ZeroResult.
In the following, nominal value is the result uncorrected for roundoff.
Nominal value = (-1)^uSign1 * <uHighHalf1[0] . uHighHalf1[1] ... > * 2^(uExp1-127).
**************************************************************************}
RePackC2:
	{delay}								c2;
RePackC3:
	{delay}								c3;
RePackC1:
	T _ uHighHalf1, ZeroBr,						c1;
	TT _ uExp1, BRANCH[$, HighFracZero],				c2;
{nominal value = (-1)^uSign1 * <T[0].T[1] ... Q[0] ...> * 2^(uExp1-127)}
	Q _ uLowHalf1,							c3;
LowFracNZ:
	TT _ TT - 2, 							c1;
	[] _ TT, NegBr,							c2;

{nominal value = (-1)^uSign1 * <T[0].T[1] ... > * 2^(TT+2-127)}
NormLoop:
	[] _ T, NegBr, BRANCH[$, LowExp],				c3;
	TT _ TT - 1, NegBr, BRANCH[$, Normed],				c1;
	T _ DLShift1 T, SE _ 1, BRANCH[NormLoop, SmallNumberC3],	c2;

{Non-0 results arrive here only on a FADD or FSUB subtraction of nearly equal arguments;
with normalized non-0 arguments, FMP, FDIV, FSQRT, etc. results require only 0 or 1
normalization steps.}
HighFracZero:
	T _ uLowHalf1, ZeroBr,						c3;
	TOS _ 0, BRANCH[$, ZeroToNorm],					c1;
	Q _ 0,								c2;
	TT _ TT - 16'd, GOTO[LowFracNZ],				c3;

{at LowExp: nominal value = (-1)^(uSign1) * <T[0].T[1]. ...> * 2^(TT+2-127) and TT < 0}
{we will shift right one bit, and add 1 to TT, until TT = -1, then go to SmallNumber}
{NOTE: maybe control should not arrive here when uExp1=1?}
LowExp:	Rx _ 25'd, CANCELBR[$],		       				c1;
	[] _ TT + Rx, NegBr,						c2;
	Q _ ~Q {to allow for complementing on right shifts}, BRANCH[$, VeryLowExp],	c3;
	TT _ -TT-1, L0 _ L0.rePack1, CALL[DeNormC2],			c1;

{At VeryLowExp, rounding to nearest cannot produce any significant bits, but significand is non-zero}
VeryLowExp:
	GOTO[FPTrapsC2],						c1;

{nominal value = (-1)^(uSign1) * <T[0].T[1]. ...> * 2^(TT+2-127) and TT = -1, therefore
nominal significand = T[1]...Q[7], and nominal exponent = 1 if T[0] = 1, else 0.  I.e.,
nominal exponent = T[0].}

{Upon entry from LowExp, TT is garbage, but above facts hold true}

{Note: The following code would be used without a denormalized number trap, and further; even
with a denormalized result trap, a denormalized number which rounds up to a normalized number
goes through this code.  Exit from the following has nominal exponent in TT.  Also a 1 bit in
T[0], so that subsequent rounding will cause a carry overflow if rounding carries into T[0].}
SmallNumberC3:
	{delay}								c3;
SmallNumberC1:
	{delay}								c1;
SmallNumberC2:
	TT _ RRot1 1,							c2, at[L0.rePack1,10, DeNormRets];
	TT _ LRot1 (TT and T), {TT _ nominal exponent = T[0]}		c3;
	Rx _ RRot1 1,							c1;
	T _ T or Rx, {T[0] _ 1}, L0 _ L0.rePack2, GOTO[Normed1],	c2;

{nominal value = (-1)^(uSign1) * <T[0].T[1]. ...> * 2^(TT+3-127) and T[0] = 1, therefore
nominal exponent = TT+3, and nominal significand = T[1]...Q[7].  Also entered from SmallNumber,
arranged so that nominal significand = <T[1]...>, T[0] = 1, and nominal exponent = TT+3.}

Normed:	L0 _ L0.rePack2, TT _ TT + 3, CANCELBR[$],			c2;

Normed1:
	[] _ uStickyBit, NZeroBr, CALL[Round],				c3;

{now check for overflow and underflow}
	Rx _ 377'b,							c2, at[L0.rePack2, 10, RoundRets];
	[] _ Rx - TT - 1, NegBr, {branches if TT >= 377'b}		c3;
	[] _ TT, ZeroBr, BRANCH[$, FPTrapsC2], {overflow}		c1;
	TT _ TT LRot8, BRANCH[finalPack, FPTrapsC3], {underflow}	c2;

ZeroToNorm:
	TT _ 0,								c2;
	STK _ TOS {low word of result}, GOTO[finalPack1],		c3;

{result sign = uSign1, result exp = TT, result significand = <T[1]...Q[7]>, T[0] = 1}
finalPack:
	Q _ Q and ~377'b, {bottom 8 bits of final result}		c3;

	Rx _ T and 377'b, {next 8 bits of final result}			c1;
	Rx _ Q or Rx,							c2;
	Rx _ Rx LRot8,							c3;

	STK _ Rx, {low word of result}					c1;
	TOS _ T LRot8,							c2;
	TOS _ TOS and 177'b, {high 8 significand bits with the leading 1 stripped}	c3;

finalPack1:
	TT _ RRot1(TT or uSign1), {sign bit and 8-bit exponent}		c1;
	TOS _ TOS or TT, IBDisp,					c2;
	PC _ PC + 1, DISPNI[OpTable],					c3;
	

{**************************************************************************
Traps
**************************************************************************}
FPTrapsC3:
	CANCELBR[FPTrapsC1],						c3;

FPTrapsC1:
	CANCELBR[FPTrapsC2],						c1;
FPTrapsC2:
	T _ uib, L1Disp, CANCELBR[$],					c2;
	T _ T + 377'b + 1 {alpha + 400'b}, push, RET[FPTraps],		c3;

OneArgFPTrap:
	{noop}								c1, at[L1.OneArgFPTrap, 10, FPTraps];
	GOTO[OneArgFPTrapA],						c2;

OnePt5ArgFPTrap:
	GOTO[OnePt5ArgFPTrapA],						c1, at[L1.OnePt5ArgFPTrap, 10, FPTraps];
	
TwoArgFPTrap:
	push,								c1, at[L1.TwoArgFPTrap, 10, FPTraps];
OnePt5ArgFPTrapA:
	push,								c2;
OneArgFPTrapA:
	TOS _ STK, pop,							c3;
	GOTO[UnimpOpcode] {In CedarMisc.mc},				c1;


{FPTrapsC1:
	CANCELBR[FPTrapsC2],						c1;
FPTrapsC2:
	CANCELBR[FPTrapsC3],						c2;
FPTrapsC3:
	T _ uib, L1Disp, CANCELBR[$],					c3;
	T _ T + 377'b + 1 {alpha + 400'b}, push, RET[FPTraps],		c1;

OneArgFPTrap:
	{noop}								c2, at[L1.OneArgFPTrap, 10, FPTraps];
	GOTO[OneArgFPTrapA],						c3;

OnePt5ArgFPTrap:
	GOTO[OnePt5ArgFPTrapA],						c2, at[L1.OnePt5ArgFPTrap, 10, FPTraps];
	
TwoArgFPTrap:
	push,								c2, at[L1.TwoArgFPTrap, 10, FPTraps];
OnePt5ArgFPTrapA:
	push,								c3;
OneArgFPTrapA:
	TOS _ STK, pop,	GOTO[UnimpOpcode] {In CedarMisc.mc},		c1;}


{**************************************************************************
Multiply entry:	
  TOS =		| arg2H	|
					
  STK =		| arg2H	|
	-->	| arg2L	|
	      	| arg1H	|
	      	| arg1L	|	

returns:	
  TOS =		| prodH	|
					
  STK =		|  ~	|
	-->	| prodL	|	

After unpacking, sum four partial products to form a 48-bit product
	LowHalf1*LowHalf2		  | B | A |
	HighHalf1*LowHalf2	     | EE | C |
	LowHalf1*HighHalf2	     | FF | D |
	HighHalf1*HighHalf2	| HH | GG |
where EE, FF, GG, and HH are 16-bit parts and A, B, C, and D are 8-bit parts.  The
A and B+C+D results are put in uStickyBit, but the carry out of B+C+D must be propagated
upward since it might affect rounding.

Timing from @aFMUL to RePack = Unpack2 + 119 cycles.
**************************************************************************}
@aFMUL:
	uib _ Rx, L0 _ L0.mult1,					c1, at[2, 10, MiscFpt];
	TT _ LRot1 TOS, CALL[Unpack2],					c2;
	
{First, add exponents and xor signs.  Note: in the case of 1*1, the result significand
will have first sign bit at x1, thus the result exponent must be 128 so that subsequent
normalization will reduce exponent to 127, the correct value for 1.  This is obtained
by adding exponents and subtracting 126.}
	TT _ uExp2, L0 _ 0,						c2, at[L0.mult1, 10, UnpackRets];
	T _ Rx - 126'd, CALL[FptExpSignFix],				c3;

FMulD:	T _ uLowHalf1,							c3;
	T _ T LRot8,							c1;
	uLowHalf1 _ Q _ T,						c2;
	T _ uLowHalf2,							c3;
	T _ T LRot8,							c1;
	uLowHalf2 _ Rx _ T, L0 _ L0.mult2,				c2;
{The most significant bit of this first 8x8 multiply is 8 bits less significant than the least}
{significant bit of the overall product, but it can add 1 to the carry into the high 32 product bits}
{which, in turn, can affect rounding, so it seems this multiply must be done.}   
	T _ 0, CALL[FM8] {uLowHalf1 * uLowHalf2},			c3;

	uStickyBit _ Q {A' in left-half, 0 in right-half}		c3, at[L0.mult2, 10, FptMultLoopRets];
{at this point, the left-half of uStickyBit # 0 iff A # 0, and T contains B}
{now compute T + uHighHalf1*uLowHalf2, which is <E..B+C>}
	Q _ uLowHalf2 {already right-justified}, L0 _ L0.mult3,		c1;
	Rx _ uHighHalf1, CALL[FM8] {uLowHalf2 * uHighHalf1},		c2;

	TOS _ T, {save E + carry out of B+C}				c2, at[L0.mult3, 10, FptMultLoopRets];
	T _ ~Q LRot8,							c3;
	T _ T and 377'b, {B+C}						c1;
{now compute T + uLowHalf1*uHighHalf2, which is <F..B+C+D>}
	Q _ uLowHalf1 {already rotated}, L0 _ L0.mult4,			c2;
	Rx _ uHighHalf2, CALL[FM8] {uLowHalf1 * uHighHalf2},		c3;

	TT _ uStickyBit and Q {(A'..0)&((B+C+D)'..0)},			c3, at[L0.mult4, 10, FptMultLoopRets];
	TT _ TT or 377'b {((A or (B+C+D))..0)')},			c1;
{now compute T (=F + carries of B+C+D) + uLowHalf2(=E) + uHighHalf1*uHighHalf2 = <H, E+F+G>}
	Rx _ uHighHalf2,						c2;
	T _ T + TOS {E+carry}, CarryBr, L0 _ L0.mult5,			c3;
	Q _ uHighHalf1, BRANCH[mull0, mull1],				c1;
mull1:	TOS _ 1 {Save carry = 1}, CALL[FM8],				c2;
mull0:	TOS _ 0 {Save carry = 0}, CALL[FM8],				c2;

	uStickyBit _ ~TT, L0 _ L0.mult6, CALL[FM8] {Extend to 16 bits},	c2, at[L0.mult5, 10, FptMultLoopRets];

	T _ T + TOS, {include the carry}				c2, at[L0.mult6, 10, FptMultLoopRets];
	uHighHalf1 _ T,							c3;
	uLowHalf1 _ ~Q, GOTO[RePackC2],					c1;

{**************************************************************************
Compute T + (Rx * Q), where the right-most 8 bits in Q are the multiplier, and the 16 bits in
Rx are the multiplicand.  Call twice with a 16-bit multiplier in Q for a 16x16 product.

Timing: 17 cycles

Returns via L0:
	high 16 bits of product is in T
	low 8 bits of product is complimented in top 8 bits of Q
	bottom 8 bits of Q holds whatever was in the top 8 bits of Q initially
****************************************************************************}
FM8:	[] _ Q and 1, NZeroBr,						c*;
	[] _ Q and 2, NZeroBr, BRANCH[FM8A, FM8B],			c*;
FM8A:	T _ DARShift1(T + 0), BRANCH[FM7A, FM7B],			c*;
FM8B:	T _ DARShift1(T + Rx), BRANCH[FM7A, FM7B],			c*;
FM7A:	T _ DARShift1(T + 0), GOTO[FM6],				c*;
FM7B:	T _ DARShift1(T + Rx), GOTO[FM6],				c*;

FM6:	[] _ Q and 1, NZeroBr,						c*;
	[] _ Q and 2, NZeroBr, BRANCH[FM6A, FM6B],			c*;
FM6A:	T _ DARShift1(T + 0), BRANCH[FM5A, FM5B],			c*;
FM6B:	T _ DARShift1(T + Rx), BRANCH[FM5A, FM5B],			c*;
FM5A:	T _ DARShift1(T + 0), GOTO[FM4],				c*;
FM5B:	T _ DARShift1(T + Rx), GOTO[FM4],				c*;

FM4:	[] _ Q and 1, NZeroBr,						c*;
	[] _ Q and 2, NZeroBr, BRANCH[FM4A, FM4B],			c*;
FM4A:	T _ DARShift1(T + 0), BRANCH[FM3A, FM3B],			c*;
FM4B:	T _ DARShift1(T + Rx), BRANCH[FM3A, FM3B],			c*;
FM3A:	T _ DARShift1(T + 0), GOTO[FM2],				c*;
FM3B:	T _ DARShift1(T + Rx), GOTO[FM2],				c*;

FM2:	[] _ Q and 1, NZeroBr,						c*;
	[] _ Q and 2, NZeroBr, BRANCH[FM2A, FM2B],			c*;
FM2A:	T _ DARShift1(T + 0), BRANCH[FM1A, FM1B],			c*;
FM2B:	T _ DARShift1(T + Rx), BRANCH[FM1A, FM1B],			c*;
FM1A:	L0Disp,								c*;
	T _ DARShift1(T + 0), RET[FptMultLoopRets],			c*;
FM1B:	L0Disp,								c*;
	T _ DARShift1(T + Rx), RET[FptMultLoopRets],			c*;

{This old code is more compact but slower.
	TT holds bit count-1 (n-1) of multiplier (n must be at least 2)
		i.e. for an 8 bit multiplier, enter with 7 in TT
FMLpC1:	[] _ Q and 1, NZeroBr,						c*;
	TT _ TT - 1, ZeroBr, BRANCH[FMLp0, FMLp1],			c*;

FMLp0:	T _ DARShift1(T+0), BRANCH[FMLpC1, FMLpEnd],			c*;
FMLp1:	T _ DARShift1(T+Rx), BRANCH[FMLpC1, FMLpEnd],			c*;

FMLpEnd:
	[] _ Q and 1, NZeroBr,						c*;
	L0Disp, BRANCH[$, FMLpEnd1],					c*;
	T _ DARShift1(T+0), RET[FptMultLoopRets],			c*;
FMLpEnd1:
	T _ DARShift1(T+Rx), RET[FptMultLoopRets],			c*;}


{**************************************************************************
Division entry:	
  TOS =		| arg2H	|
					
  STK =		| arg2H	| (divisor)
	-->	| arg2L	|
	      	| arg1H	| (dividend)
	      	| arg1L	|	

returns:	
  TOS =		|  divH	|
					
  STK =		|  ~	|
	-->	|  divL	|	
**************************************************************************}
@aFDiv:	uib _ Rx, L0 _ L0.div1,						c1, at[3, 10, MiscFpt];
	TT _ LRot1 TOS, CALL[Unpack2],					c2;
	
	TT _ ~uExp2, L0 _ 1,						c2, at[L0.div1, 10, UnpackRets];
	T _ Rx + 128'd {re bias exponent}, CALL[FptExpSignFix],		c3;
FDivD:	uDivCount _ divCount, {save a non temporary R reg}		c3;

{now load the operands, right shifted by 1 bit to allow room to shift left during the
divide loop, also test for zero divisor}
	divisorHigh _ uHighHalf2, ZeroBr,				c1;
	Q _ uLowHalf2, ZeroBr, BRANCH[FptDivB, FptDivA],		c2;

FptDivA:
	Q _ ~Q, BRANCH[$, FptDivZero],					c3;
	divisorHigh _ DRShift1 divisorHigh, SE _ 0, GOTO[FptDivC],	c1;

FptDivB:
	Q _ ~Q, CANCELBR[$],						c3;
	divisorHigh _ DRShift1 divisorHigh, SE _ 0, GOTO[FptDivC],	c1;

FptDivC:
	divisorLow _ ~Q,						c2;
	T _ uHighHalf1,							c3;

	Q _ ~ uLowHalf1,						c1;
	T _ DRShift1 T, SE _ 0,						c2;
	Q _ ~Q, L0 _ L0.div2,						c3;

{As per Ed Tafts Dorado code, we will do a total of 26 iterations, 24 for quotient bits,
+ 2 guard bits.  They are done by first doing 16 iterations, then 10 iterations}
	divCount _ 16'd, CALL[FDVSubr],					c1;

	uHighHalf1 _ divResult,						c2, at[L0.div2, 10, FptDivLoopRets];

	T _ DLShift1 T, SE _ 1, {puts a 0 into Q.15} L0 _ L0.div3, {remainder did not get its last left shift} c3;
	divCount _ 10'd, CALL[FDVSubr],					c1;

{left-justify divResult by shifting it left 6 positions}
	divResult _ divResult  LRot4,					c2, at[L0.div3, 10, FptDivLoopRets];
	divResult _ LShift1(divResult), SE _ 0,				c3;
	divResult _ LShift1(divResult), SE _ 0,				c1;
	uLowHalf1 _ divResult,						c2;
	divCount _ uDivCount, {restore a non temporary R reg}		c3;
	Q _ T or Q,							c1;
	uStickyBit _ Q, GOTO[RePackC3],					c2;

{divide by zero}
FptDivZero:
	divCount _ uDivCount, {restore a non temporary R reg}, GOTO[FPTrapsC2],	c1;


{**************************************************************************
Divide loop
	dividend in <T,Q>
	divisor in <divisorHigh, divisorLow>
	bit count - 1 in divCount
	return point in L0

	accumulates bits in divResult
	<T,Q> will hold the remainder
Timing = 5 * number of iterations + 1 (+3 if must add back)
***************************************************************************}
FDVSubr:
	divResult _ 0, GOTO[FDVSubA],					c*;

FDVSub:	divResult _ LShift1 (divResult), SE _ 1,			c*;
FDVSubA:
	Q _ Q-divisorLow, CarryBr,					c*;
	divCount _ divCount-1, ZeroBr, BRANCH[FDVSub1, $],		c*;
	T _ T-divisorHigh, CarryBr, BRANCH[FDVLoop1a, FDVExit1],	c*;
FDVSub1:
	T _ T-divisorHigh-1, CarryBr, BRANCH[FDVLoop1a, FDVExit1],	c*;
FDVLoop1a:
	T _ DLShift1 T, SE _ 1, BRANCH[FDVAdd, FDVSub],			c*;

FDVExit1:
	L0Disp, BRANCH[FDVAddExit, FDVSubExit],				c*;

FDVSubExit:
	divResult _ LShift1 (divResult), SE _ 1, RET[FptDivLoopRets],	c*;
	
FDVAdd:	divResult _ LShift1 (divResult), SE _ 0,			c*;
	Q _ Q+divisorLow, CarryBr,					c*;
	divCount _ divCount-1, ZeroBr, BRANCH[$, FDVAdd1],		c*;
	T _ T+divisorHigh, CarryBr, BRANCH[FDVLoop1a, FDVExit1],	c*;
FDVAdd1:
	T _ T+divisorHigh+1, CarryBr, BRANCH[FDVLoop1a, FDVExit1],	c*;

FDVAddExit:
	divResult _ LShift1(divResult), SE _ 0, CANCELBR[$, 0F],	c*;
	Q _ Q + divisorLow, CarryBr,					c*;

	L0Disp, BRANCH[FDVAX0, $],					c*;	
	T _ T + divisorHigh + 1, RET[FptDivLoopRets],			c*;	
FDVAX0:	T _ T + divisorHigh, RET[FptDivLoopRets],			c*;
 

{**************************************************************************
Subtract entry:	
  TOS =		| arg2H	|
					
  STK =		| arg2H	|
	-->	| arg2L	|
	      	| arg1H	|
	      	| arg1L	|	

returns:	
  TOS =		|  difH	|
					
  STK =		|  ~	|
	-->	|  difL	|	
**************************************************************************}
@aFSUB:
	T _ RRot1 1,							c1, at[1, 10, MiscFpt];
	TOS _ TOS xor T, {Complement sign bit}				c2;
	{noop} GOTO[FSub1],						c3;


{**************************************************************************
Add entry:	
  TOS =		| arg2H	|
					
  STK =		| arg2H	|
	-->	| arg2L	|
	      	| arg1H	|
	      	| arg1L	|	

Returns:	
  TOS =		|  sumH	|
					
  STK =		|  ~	|
	-->	|  sumL	|	
**************************************************************************}
@aFADD:
FSub1:	uib _ Rx, L0 _ L0.add1,						c1, at[0, 10, MiscFpt];
	TT _ LRot1 TOS, CALL[Unpack2],					c2;
	
	TT _ uExp2,							c2, at[L0.add1, 10, UnpackRets];
	TT _ Rx - TT, NegBr,						c3;

	[] _ TT, ZeroBr, BRANCH[unNorm2, unNorm1], 			c1;

{Exp2 > Exp1, so we have to shift significand of arg1 to the right, TT has negative of  shift count}
unNorm1:
	TT _ -TT, CANCELBR[$],						c2;
	Rx _ uExp2,							c3;
	uExp1 _ Rx,							c1;
	T _ uSign1,							c2;
	Q _ uSign2,							c3;
	uSign1 _ Q,							c1;
	uSign2 _ T,							c2;
	Q _ uLowHalf1,							c3;
	T _ uHighHalf1, GOTO[unNorm],					c1;

{Exp1 >= Exp2, so we may have to shift fract part of arg2, TT has shift count}
unNorm2:
	Q _ uHighHalf1, BRANCH[$, unNormNeither],			c2;
	T _ uHighHalf2,							c3;
	uHighHalf2 _ Q,							c1;
	Rx _ uLowHalf1,							c2;
	Q _ uLowHalf2,							c3;
	uLowHalf2 _ Rx, GOTO[unNorm],					c1;

unNormNeither:
	T _ uSign1,							c3;
	Q _ uSign2,							c1;
	uSign1 _ Q,							c2;
	uSign2 _ T,							c3;
	Q _ uLowHalf1,							c1;
	T _ uHighHalf1, GOTO[unNormedC3],				c2;

{The significand of the argument with smaller exponent is in <T, Q>; the amount of shift is
in TT, uSign1 contains sign of argument with larger exponent (the nominal sign), uExp1
contains nominal exponent, uSign2 contains other sign}

{The significand of the argument with the higher exponent is in <uHighHalf2, uLowhalf2>}
unNorm:	Rx _ 20'b, L0 _ L0.add1,					c2;
	TT _ TT-Rx,  NegBr,						c3;
	[] _ TT- Rx , NegBr, BRANCH[$, unNormLt20],			c1;
	[] _ T or Q, NZeroBr, BRANCH[$, unNormLt40],			c2;
{total shift >= 40'b bits}
	T _ 0, BRANCH[unNormZ, unNormNZ],				c3;

unNormZ:
	Q _ 0, GOTO[unNormedC2],					c1;
unNormNZ:
	Q _ 1, GOTO[unNormedC2],					c1;

{40'b > total indicated shift >= 20'b, TT holds "indicated shift - 20'b"}
unNormLt40:
	[]  _ Q, NZeroBr, CANCELBR[$],					c3;
	Rx _ T or 1, BRANCH[$, unNormLt40B],				c1;
	Q _ ~T , GOTO[unNormLt40C],					c2;
unNormLt40B:
	Q _ ~Rx, GOTO[unNormLt40C],					c2;
unNormLt40C:
	T _ 0, CALL[DeNormC1],						c3;

{20'b > total indicated shift , TT holds "indicated shift -20'b", Rx contains 20'b}
unNormLt20:
	TT _ TT+Rx, CANCELBR[$],					c2;
	Q _ ~Q, CALL[DeNormC1],						c3;
	
{T,Q holds the shifted version of the arg with the small exponent, <uHighHalf2, uLowHalf2>
the other arg, uSign1 the sign of the arg in <uHighHalf2, uLowHalf2> (the nominal sign),
uExp1 the nominal exponent, uSign2 the other sign)}
unNormedC3: {delay}							c3;

unNormedC1: {delay}							c1;
unNormedC2:
	TT _ uSign1,							c2, at[L0.add1, 10, DeNormRets];
	[] _ uSign2 xor TT, NZeroBr,					c3;
	TT _ uLowHalf2, BRANCH[addUnNormed, subUnNormed],		c1;

{equal signs, so add}
addUnNormed:
	Q _ TT + Q, CarryBr,						c2;
	TT _ uHighHalf2, BRANCH[addUnNormedA, addUnNormedB],		c3;
addUnNormedA:
	T _ TT + T, CarryBr, GOTO[addUnNormedC],			c1;
addUnNormedB:
	T _ TT + T + 1, CarryBr, GOTO[addUnNormedC],			c1;
addUnNormedC:
	[] _ Q and 1, NZeroBr, BRANCH[$, addUnNormedD],			c2;
{If this result is 0, then both arguments are 0 and have the same sign, so the 0 result
should have the common sign of the two arguments.  In all other cases, a +0 result is required.}
	uLowHalf1 _ Q, CANCELBR[unNormedB], 				c3;

{addition overflowed, so have to shift right and adjust exponents}
addUnNormedD:
	Q _ ~Q, BRANCH[addUnNormedE, addUnNormedF],			c3;
addUnNormedE: {Q _ Q or 0} GOTO[addUnNormedG],				c1;
addUnNormedF: Q _ Q and ~2, {Q _ Q or 2} GOTO[addUnNormedG],		c1;
addUnNormedG:
	T _ DRShift1 T, SE _ 1, 					c2;
	Rx _ uExp1,							c3;
	Rx _ Rx + 1, 							c1;
	uExp1 _ Rx,							c2;
	uLowHalf1 _ ~Q {This result cannot be 0}, GOTO[unNormedB],	c3;

{Unequal signs, so subtract shifted significand}
{CarryBr seems to take on a subtraction if there is no borrow}
subUnNormed:
	Q _ TT-Q, CarryBr,						c2;
	TT _ uHighHalf2, BRANCH[subUnNormedB, subUnNormedA],		c3;
subUnNormedA:
	T _ TT-T, CarryBr, GOTO[subUnNormedC],				c1;
subUnNormedB:
	T _ TT-T-1, CarryBr, GOTO[subUnNormedC],			c1;
subUnNormedC:
	TT _ 0 - Q, CarryBr, BRANCH[subUnNormedD, $],			c2;
	uLowHalf1 _ Q, ZeroBr, CANCELBR[unNormedB],			c3;

{Subtraction overflowed, so use the opposite sign and negate the fraction.}
subUnNormedD:
	Rx _ uSign2, BRANCH[subUnNormedD1, subUnNormedD0],		c3;
subUnNormedD1: T _ 0 - T - 1, GOTO[subUnNormedE],			c1;
subUnNormedD0: T _ 0 - T, GOTO[subUnNormedE],				c1;
subUnNormedE:
	uSign1 _ Rx,							c2;
	uLowHalf1 _ TT,							c3;
unNormedB:
	uHighHalf1 _ T, NZeroBr, BRANCH[$, unNormedC],			c1;
	uStickyBit _ 0, CANCELBR[RePackC3],				c2;
	
unNormedC:
	uStickyBit _ 0, BRANCH[$, RePackC3],				c2;
{A positive sign is required on 0 result with argument signs different.}
	uSign1 _ 0, GOTO[RePackC1],					c3;


{**************************************************************************
Fix and Round to CARDINAL
**************************************************************************}
@aFixC:	uib _ Rx, L0 _ L0.round5, GOTO[FixC1],				c1, at[08, 10, MiscFpt];
@aRoundC:
	uib _ Rx, L0 _ L0.round5,					c1, at[0D, 10, MiscFpt];
FixC1:	TT _ LRot1 TOS, CALL[Unpack1],					c2;

	TT _ Rx - 143'd {exponent - 127 - 16},				c2, at[L0.round5, 10, UnpackRets];
FixRndI1:
	[] _ TT, NegBr,							c3;
{RoundI and FixI would need a branch on Rx = 0 here if special code is written to
handle the largest negative integer.}
	TT _ Rx - 126'd, BRANCH[$, FixRndI2],				c1;
	GOTO[FPTrapsC3] {too big},					c2;

FixRndI2:
	GOTO[Round1],							c2;


{**************************************************************************
Fix and Round to INTEGER.  Largest negative integer also traps.
**************************************************************************}
@aFixI:	uib _ Rx, L0 _ L0.round4, GOTO[FixI1],				c1, at[07, 10, MiscFpt];
@aRoundI:
	uib _ Rx, L0 _ L0.round4,					c1, at[0C, 10, MiscFpt];
FixI1:	TT _ LRot1 TOS, CALL[Unpack1],					c2;

	TT _ Rx - 142'd {exponent - 127 - 15}, GOTO[FixRndI1],		c2, at[L0.round4, 10, UnpackRets];


{**************************************************************************
Fix and Round to LONG INTEGER.  Largest negative LONG INTEGER also traps.
**************************************************************************}
@aFix:	uib _ Rx, L0 _ L0.round1, GOTO[Fix1],				c1, at[05, 10, MiscFpt];
@aRound:
	uib _ Rx, L0 _ L0.round1,					c1, at[0B, 10, MiscFpt];
Fix1:	TT _ LRot1 TOS, CALL[Unpack1],					c2;

{Exponent is in Rx}
	TT _ Rx - 126'd,						c2, at[L0.round1, 10, UnpackRets];
Round1:	Q _ ~ uLowHalf1,						c3;

	[] _ TT, NegBr, L0 _ L0.round2,					c1;
	TT _ Rx - 150'd, BRANCH[$, RoundLIA],				c2;
	[] _ TT, NegBr, 						c3;

	TT _ Rx - 158'd, BRANCH[$, RoundLIB],				c1;
	[]_ TT, NegBr, L0 _ L0.round3,					c2;
	TT _ - TT, BRANCH[$, RoundLIC],					c3;

	GOTO[FPTrapsC2] {too big},					c1;

{too small, won't even round to zero, but have to check for inexact trap and inexact result}
RoundLIA:
	TT _ 25'd,							c3;
	T _ uHighHalf1, CALL[DeNormC2],					c1;

{shift right 150'd - exp., round, and do a final 8 bit right shift}
RoundLIB:
	TT _ 150'd - Rx,						c2;
	T _ uHighHalf1, CALL[DeNormC1],					c3;

{no rounding needed; right shift by 158'd - exp.}
RoundLIC:
	T _ uHighHalf1, CALL[DeNormC2], 				c1;

	Xbus _ uib, XDisp, {L0 _ L0.round2,} 				c2, at[L0.round2, 10, DeNormRets];
	Rx _ 377'b, DISP4[FixVsRound],					c3;

	[] _ Q and Rx, ZeroBr, CALL[Fix],				c1, at[05, 10, FixVsRound];
	[] _ Q and Rx, ZeroBr, CALL[Fix],				c1, at[07, 10, FixVsRound];
	[] _ Q and Rx, ZeroBr, CALL[Fix],				c1, at[08, 10, FixVsRound];
	CALL[RoundC],							c1, at[0B, 10, FixVsRound];
	CALL[RoundC],							c1, at[0C, 10, FixVsRound];
	CALL[RoundC],							c1, at[0D, 10, FixVsRound];

	TT _ Q and ~377'b,						c2, at[L0.round2, 10, RoundRets];
	T _ T LRot8,							c3;
	Q _ T and ~377'b,						c1;
	T _ T and 377'b,						c2;
	TT _ TT LRot8,							c3;
	Q _ TT or Q,							c1;
	Xbus _ uib, XDisp,						c2, at[L0.round3, 10, DeNormRets];
	DISP4[RoundFixTargets],						c3;


{**************************************************************************
Round/fix to long integer exits
**************************************************************************}
	TT _ uSign1, NZeroBr, GOTO[TargetLI],				c1, at[05, 10, RoundFixTargets];
	TT _ uSign1, NZeroBr, GOTO[TargetLI],				c1, at[0B, 10, RoundFixTargets];

TargetLI:
	PC _ PC + 1, BRANCH[RoundLIFc, $],				c2;
{negative result}
	Q _ 0-Q, CarryBr,						c3;
	STK _ Q, BRANCH[$, RoundLIFb],					c1;
	TOS _ 0 - T - 1, IBDisp, GOTO[DISPNIonly] {In Refill.mc},	c2;
RoundLIFb:
	TOS _ 0 - T, IBDisp, GOTO[DISPNIonly] {In Refill.mc},		c2;

RoundLIFc:
	STK _ Q,							c3;
	TOS _ T, GOTO[IBDispOnly] {In Refill.mc},			c1;


{**************************************************************************
Round/fix to cardinal exits
**************************************************************************}
	[] _ T, NZeroBr, GOTO[TargetC],					c1, at[08, 10, RoundFixTargets];
	[] _ T, NZeroBr, GOTO[TargetC],					c1, at[0D, 10, RoundFixTargets];

TargetC:
	TT _ uSign1, NZeroBr, pop, BRANCH[$, LargeCardTrap],		c2;
TargetC1:
	TOS _ Q, BRANCH[$, NegCard],					c3;
	PC _ PC + 1, GOTO[IBDispOnly] {In Refill.mc},			c1;

NegCardTrap:
LargeCardTrap:
	push, CANCELBR[FPTrapsC1],					c3;

{out of range, unless exact 0}
NegCard:
	[] _ Q, NZeroBr,						c1;
	BRANCH[TargetC1, NegCardTrap],					c2;


{**************************************************************************
Round/fix to integer exits
**************************************************************************}
	[] _ Q, NegBr, GOTO[TargetI],					c1, at[07, 10, RoundFixTargets];
	[] _ Q, NegBr, GOTO[TargetI],					c1, at[0C, 10, RoundFixTargets];

TargetI:
	TT _ uSign1, pop, NZeroBr, BRANCH[$, IntLarge],			c2;
	PC _ PC + 1, BRANCH[$, IntNeg],					c3;

	TOS _ Q, GOTO[IBDispOnly] {In Refill.mc},			c1;

IntNeg:	TOS _ 0-Q, GOTO[IBDispOnly] {In Refill.mc},			c1;

{most negative integer also traps}
IntLarge: push, CANCELBR[FPTrapsC1],					c3;


{**************************************************************************
Fix subroutine
**************************************************************************}
Fix:	TOS _ uStickyReg, NegBr, BRANCH[FixInexact, $],			c2;
FixD:	L0Disp, CANCELBR[$],						c3;
	RET[RoundRets],							c1;

{In following we use TOS, which will eventually be restored.  Set the Inexact bit in
uStickyReg and test the Inexact trap enable.}
FixInexact:
	TOS _ TOS or 1, L0Disp, BRANCH[$, FixInexactTrap],		c3;
	uStickyReg _ TOS, RET[RoundRets],				c1;

FixInexactTrap:
	CANCELBR[FPTrapsC2, 0F],					c1;


{**************************************************************************
Compare entry:	
  TOS =		| arg2H	|
					
  STK =		| arg2H	|
	-->	| arg2L	|
	      	| arg1H	|
	      	| arg1L	|	

returns:	
  TOS =		|  comp	|	1 if arg1 > arg2, 0 if arg1 = arg2, or -1 if arg1 < arg2
					
  STK =	-->	|  ~	|
**************************************************************************}
@aFComp:
{	uib _ Rx, L1 _ L1.x,						c1;
	T _ RRot1(~377'b),						c2;
	Rx _ TOS and T, pop,						c3;

	[] _ Rx xor T, ZeroBr,						c1;
	Rx _ STK, BRANCH[$, FCompTrap1],				c2;
	Rx _ Rx and T,							c3;

	[] _ Rx xor T, ZeroBr,						c1;
	T _ STK, push, BRANCH[$, FCompTrap2],				c2;
	T _ T - TOS, CarryBr,						c3;

	[] _ T, ZeroBr, BRANCH[CmpHigh2Big, $],				c1;
	BRANCH[CmpHigh1Big, $],						c2;
High 16 bits are equal; resolve the comparison with a cardinal comparison of the low 16 bits

TOS > T or arg2H > arg1H unless only the numbers are +0 and -0
CmpHigh2Big:
	TOS _ 1, IBDisp,						c2;
	PC _ PC + 1, DISPNI[OpTable],					c3;
	
FCompTrap1: Arg2 = infinity or NotANumber
	push, GOTO[FPTrapsC1],						c3;

FCompTrap2: Arg1 = infinity or NotANumber
	GOTO[FPTrapsC1],						c3;
}
	uib _ Rx, L0 _ L0.comp1,					c1, at[4, 10, MiscFpt];
	TT _ LRot1 TOS, CALL[Unpack2],					c2;
	
	TT _ uSign1, pop,						c2, at[L0.comp1, 10, UnpackRets];
	[] _ TT xor uSign2, NZeroBr,					c3;

	TT _ uExp2, BRANCH[$, cmpNeSigns],				c1;
	TT _ TT - Rx {Rx = Exp1 from Unpack}, NegBr,			c2;
	[] _ TT, ZeroBr, BRANCH[$, CmpAbs1High3],			c3;

	TT _ uHighHalf2, BRANCH[CmpAbs2High1, $],			c1;
	T _ uHighHalf1,							c2;
{TT - T for two cardinals produces Carry when TT >= T, no carry otherwise}
	TT _ TT - T, CarryBr,						c3;

	[] _ TT, ZeroBr, BRANCH[CmpAbs1High1, $],			c1;
	TT _ uLowHalf1, BRANCH[CmpAbs2High2, $],			c2;
	T _ uLowHalf2,							c3;

	T _ T - TT, CarryBr,						c1;
	[] _ T, ZeroBr, BRANCH[CmpAbs1High2, $],			c2;
cmpZTest:
	TOS _ 0, BRANCH[CmpAbs2High3, $],				c3;
	PC _ PC + 1, GOTO[IBDispOnly],					c1;

{Unequal signs decide the comparison unless both significands are 0; significand = 0 implies exponent = 0.}
cmpNeSigns:
	T _ uHighHalf1,							c2;
	T _ uHighHalf2 or T,						c3;

	T _ uLowHalf2 or T,						c1;
	[] _ uLowHalf1 or T, ZeroBr, GOTO[cmpZTest],			c2;
		      
{CarryBr=FALSE implies A-B # 0, so a TRUE branch condition is impossible here}
CmpAbs1High1: {uHighHalf2 < uHighHalf1 decides}
	CANCELBR[$, 0], 						c2;
CmpAbs1High2: {uLowHalf2 < uLowHalf1 decides}
	CANCELBR[$, 0],							c3;
CmpAbs1High3: {Exp2 < Exp1 decides}
	[] _ uSign2, NZeroBr, CANCELBR[CmpNEa, 0],			c1;

CmpAbs2High1: {Exp2 > Exp1 decides}
	{noop}					 			c2;
CmpAbs2High2: {uHighHalf2 > uHighHalf1 decides}
	{noop}								c3;
{next inst also covers unequal sign case}
CmpAbs2High3: {uLowHalf2 > uLowHalf1 decides}
	[] _ uSign2, ZeroBr, GOTO[CmpNEa],				c1;

CmpNEa:	PC _ PC + 1, IBDisp, BRANCH[Cmp1High, Cmp2High],		c2;

Cmp1High: {arg1 > arg2}
	TOS _ 1, DISPNI[OpTable],					c3;
Cmp2High: {arg2 > arg1}
	TOS _ ~ TOS xor TOS {TOS _ -1}, DISPNI[OpTable],		c3;	


{**************************************************************************
Float a long integer

	TOS contains high order 16 bits
	STK contains low order 16 bits
**************************************************************************}
@aFloat:
	uib _ Rx,							c1, at[6, 10, MiscFpt];
	Q _ STK, fXpop, fZpop, push, {stack underflow?}			c2;
	Rx _ 158'd, L1 _ L1.OneArgFPTrap, {31'd + 127'd}		c3;

	uStickyBit _ TT _ 0, {in case it is positive}			c1;
	T _ TOS, NegBr,							c2;
	uExp1 _ Rx, BRANCH[floatPos, $],				c3;

{note: following handles most negative number correctly by happenstance}
	Q _ 0-Q, CarryBr,						c1;
	TT _ 1, BRANCH[$, floatNeg2],					c2;
	T _ 0-T-1, GOTO[floatPos],					c3;
floatNeg2: T _ 0-T, GOTO[floatPos],					c3;

floatPos:	uSign1 _ TT,						c1;
	uLowHalf1 _ Q,							c2;
	uHighHalf1 _ T, GOTO[RePackC1],					c3;


{**************************************************************************
scale a floating point number

	TOS contains integer scale
	STK and next in stack contain the floating point number
**************************************************************************}
@aFScale:
	uib _ Rx, L0 _ L0.FScale1,					c1, at[0F, 10, MiscFpt];
	uHighHalf2 _ TOS, {save away the integer}			c2;
	TOS _ STK, pop,							c3;

	Q _ 377'b, L1 _ L1.OnePt5ArgFPTrap,				c1;
	TT _ LRot1 TOS,							c2;
	CALL[Unpack1X],							c3;

	T _ uHighHalf2, {the integer}					c2, at[L0.FScale1, 10, UnpackRets];
	T _ Rx + T,							c3;

	uExp1 _ T, GOTO[RePackC2],					c1;


{**************************************************************************
Undefined Floating point operations
**************************************************************************}
	T _ Rx + 377'b + 1, GOTO[UnimpOpcode] {In CedarMisc},		c1, at[0A, 10, MiscFpt];
	T _ Rx + 377'b + 1, GOTO[UnimpOpcode] {In CedarMisc},		c1, at[0E, 10, MiscFpt];


{**************************************************************************
November 1, 1982  3:23 PM: CedarFpt, CedarFptMul, CedarFptDiv, CedarFptAdd,
CedarFptMiscA, CedarFptMiscB all combined together and called CedarFptAll.

RTE: 17-Nov-82 17:49:20: FScale did not check for hugh scale factors, leading
uncaught overflow and underflow, since the exponent wrapped around into legal range.

RTE: 17-Nov-82 18:25:46: got one of the two tests backwards.

RTE: 18-Nov-82  9:56:20: coded FScale and Float without setting L1 up for trap exits.
Therefore random jumps occured during traps.  Had to code up a new form of trap exit
to handle FScale, since it has 3 words worth of argument, rather than 2 or 4.

RTE: 18-Nov-82 12:19:04: still got the tests backwords in FScale!!.
RTE: 18-Nov-82 12:44:28: FScale must not generate a fault on Zero argument, even if
high scale factor.  Sovle this by setting result exponent dileberatly out of range,
either high or low depending on sign of scale factor, then going to repack.

RTE: 18-Nov-82 15:56:17: Round/Fix to Cardinal was cutting off one exponent too early.
Also removed the useless case of possible most negative integer.

RTE: 15-Sep-83 16:47:38: TwoArgFPTrap had a push,push in one cycle, needed to be in
separate cycles.  evidently these traps have never taken in the Cedar world before,
and in my old test code run in the Tajo world, I did not know how to check that the
stack was ok at trap time.

6 June 1985 Fiala: Fixed bug in denormalized first arg for Unpack2.  

27-Jun-85 22:10:58 Fiala: Bummed 139'd mi; expended 16'd mi to speed up FMUL by 42 cycles;
expended 3 mi to speed up normalization of results with the high significand = 0 by about
50 cycles; expended 3 mi to speed up the common case of all the Fix and Round opcodes by
25 cycles.

12-Jul-85 14:19:06 Fiala: Expended 19'd mi to handle denormalized arguments in Unpack.

12-Jul-85 16:53:48 Fiala: Changed name from XCedarFptAll.mc to CedarFpt.mc.

17-Jul-85 16:23:28 Fiala: Changed cardinal comparison (CarryBr) to integer (NegBr) for
exponents in FCOMP (denormalized args get negative exponents).

11-Jun-86 12:06:37 Fiala: Moved definitions to CedarDefs.dfn

 2-Jul-86 16:18:00 Fiala: Bummed 4 mi by inserting UPNorm subroutine; bummed 1 mi at jump
to LowFracNZ; bummed 5 mi by extracting common exponent and sign fixing code from FMul and
FDiv into a subroutine.  NOTE: version prior to these edits is on OldCedarFpt.mc.
}