{File name: Vfpt.mc
  From File: CedarFPTAll.mc Created by H. Sturgis
Last Edit:
- 16-Jul-86 11:24:06 JPM: standardize opcode locations (to agree with Bank1Misc dispatches) and return path.
- 14-May-86 10:27:56 SCJ: made changes to build the total MesaDove with BitBlt and FPT by using a 8k control store, with the floating point microcode in the second bank
- 10-Feb-86  3:30:01 DEG: ???.
- 25-Jan-86  3:29:00 DEG: adding more floating point operations to Daybreak.
- 19-Jan-86  3:20:36 DEG: Add FADD and FSUB for Daybreak.
- 2-Oct-85 15:44:53 Rich: Correct double push in FPTraps.
-30-Aug-85 15:22:40 Rich: Change ← to ←.
  Last edited by Nunneley       29-Jul-83 15:16:41
  Last edited by Nunneley       5-Aug-83 10:03:36
  Last edited by Bruce          5-Aug-83 17:18:55
  Last edited by Nunneley       9-Aug-83  7:57:24
  Last edited by Nunneley       6-Oct-83  9:55:51 Klamath Version
}

{****************************************************************************
Some temporary assignments, while I get organized}

{{+}

RegDef[uSign1 	,U, 	27]; {rA = TT}
RegDef[uExp1		,U,	1D]; {rA = T}
RegDef[uHighHalf1	,U,	17]; {rA = T}
RegDef[uLowHalf1	,U,	19]; {rA = T}	
RegDef[uSign2	,U,	2A]; {rA = TT}
RegDef[uExp2		,U,	1E]; {rA = T}
RegDef[uHighHalf2	,U,	1B]; {rA = T}
RegDef[uLowHalf2	,U,	1C]; {rA = T}

RegDef[uStickyReg	,U,	24]; {** rA = TT} {part of processor state, [0] is non zero if fpt micro code should trap on inexact result, and [15] is non zero if there has been a non trapped inexact result}
RegDef[uStickyBit	,U,	25]; {rA = TT}

RegDef[uib		,U,	63]; {rA = Rx}

{return points for unpack routines}

Set[L0.mult1, 0];
Set[L0.mult2, 1];
Set[L0.mult3, 2];
Set[L0.mult4, 3];
Set[L0.mult5, 4];
Set[L0.add1, 5];
Set[L0.sub1, 6];
Set[L0.comp1, 7];
Set[L0.round1, 8];
Set[L0.round4, 9];
Set[L0.round5, 0A];
Set[L0.FScale1, 0B];
Set[L0.unpack1op, 0C];
{ return points for FixF routine for unpack opcode }
Set [L0.FixF0,0];
Set [L0.FixF1,1];

{denormopreturn points for denorm routine, DeNormRets}

Set[L0.add2, 1];
Set[L0.rePack1, 2];
Set[L0.div1, 3];
Set[L0.round2, 4];
{Set[L0.add1, 5]; same as above unpack ret, but occupies space in the DeNormRets}
Set[L0.round3, 6];
Set[L0.denormop, 7];

{+}}

{floating point trap args}

Set[L1.TwoArgFPTrap, 0];
Set[L1.OneArgFPTrap, 1];
Set[L1.OnePt5ArgFPTrap, 2];

Reserve[0F6F, 0FFF];	{Kernel}

{  COMMON SUBS  }


{******************************************************************************

Sticky register exchange operation

  must be in cedarfpt so that available to be used by test code during tests of any operation.

 ******************************************************************************}

@aFSticky:
	uib ← TT,					c1, at[9,10,ESC4n];
	T ← uStickyReg,						c2;
	uStickyReg ← TOS,					c3;

	TOS ← T,			GOTO[VFptIBDisp2],	c1;



{****************************************************************************
Unpack1 routine

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


at actual entry following is true:
Q = 377'b
TT = LRot1 arg1H
T = TT LRot8 and Q
L0 prepared for return


returns:	
							
  TOS =		| arg1H	|
					
  STK =		| arg1H	|
	      -->	| arg1L	|	
  
  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	

L1: L1.FpT1

NOTE: on exit., IF <x0, x1, ...> = <uHighHalf1, uLowHalf1> THEN value = (-1)↑uSign1 * s↑(uExp1-127) * <x0 . x1 x2 x3 ...>

	i.e. <uSign1, uExp1, uHighHalf1, uLowHalf1> is in proper format for immediate repacking.

NOTE: unpack2 comes in at UnPackX			

returns via:
	L0 in normal case
	with pending branch on zero argument
	else traps for other arguments				}

{following must be supplied by caller

	L0 ← unpack.foo,				c1;
	TT ← LRot1 TOS,  CALL[Unpack1],			c2;}

Unpack1: 	Q ← 377'b, L1 ← L1.FpT1,			c3;

Unpack1X:	Rx ← TT LRot8 and Q, {exponent},			c1;
	TT ← TT and 1, {the sign bit}				c2;
  	uExp1 ← Rx,  ZeroBr,				c3;


	[] ← Rx xor Q,  ZeroBr, BRANCH[$, UP1ZeroE1],		c1;
	uSign1 ← TT, BRANCH[$, UP1HighExp], 			c2;
	TT ← TOS or 200'b, {implicit leading 1 bit} GOTO[Unpack1A],		c3;
	
UP1ZeroE1:	uSign1 ← TT, CANCELBR[$],				c2;
	TT ← TOS and 177'b, {force leading bit to be 0}		c3;


			
Unpack1A:	T ← STK, fXpop, fZpop, push, {stack underflow?}		c1;
	T ← T LRot8,					c2;
	Q ← ~377'b,					c3;

	uLowHalf1 ← T and Q,				c1;
	T ← T and 377'b,				c2;
	TT ← (TT LRot8 ) and Q,				c3;

	[] ← Rx, ZeroBr, {test for zero exponent again}			c1;
	uHighHalf1 ← T or TT, BRANCH[UP1A, $],			c2;
	T ← T or TT,					c3;

	T ← T or uLowHalf1,				c1;
	[] ← T, NZeroBr,				c2;
UP1A:	L0Disp, BRANCH[$, UP1DeNorm],			c3;

	RET[UnpackRets],				c1;
UP1HighExp:
	GOTO[FPTrapsC1],				c3;

{UP1DeNorm:	CANCELBR[$, 0F],				c1;
	GOTO[FPTrapsC3],				c2;}
	
UP1DeNorm:
		CANCELBR[FPTrapsC2,0F],			c1;
	


{---------------------------------------------------------}

	
{**	UnPack2 routine

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


at actual entry following is true:
TT = LRot1 TOS
L0 prepared for return


returns:	
							
  TOS =		| arg2H	|
					
  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	

L1: FpT2			

returns via:
	L0 in normal case
	with pending branch on zero argument

	else traps for other arguments

On Exit:
	IF <x0, x1, ...> = <uHighHalf1, uLowHalf1> THEN value1 = (-1)↑uSign1 * s↑(uExp1-127) * <x0 . x1 x2 x3 ...>
	IF <x0, x1, ...> = <uHighHalf2, uLowHalf2> THEN value2 = (-1)↑uSign2 * s↑(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>

	following must be supplied by caller

	L0 ← unpack.foo,				c1;
	TT ← LRot1 TOS,  CALL[Unpack2],			c2; }

{---------------------------------------------------------}

Unpack2:	
	Q ← 377'b,					c3;

	Rx ← TT LRot8 and Q, {exponent},		c1;
	TT ← TT and 1, {the sign bit}			c2;
{	just in case high exp, stackP ok}
  	uExp2 ← Rx, ZeroBr, L1 ← L1.FpT1,		c3;

	[] ← Rx xor Q, ZeroBr,	BRANCH[$,UP2ZeroE1], 	c1;
	uSign2 ← TT,		BRANCH[$,UP2HighExp], 	c2;
{	implicit leading 1 bit}
	TT ← TOS or 200'b,	GOTO[Unpack2A],		c3;

UP2ZeroE1:
	uSign2 ← TT,		CANCELBR[$],		c2;
{	force leading bit to be 0}
	TT ← TOS and 177'b,				c3;

Unpack2A:
	T ← STK,fXpop,{stack underflow?}		c1;
	T ← T LRot8,L1 ← L1.FpT2,			c2;
	Q ← ~377'b,					c3;

	uLowHalf2 ← T and Q,				c1;
	T ← T and 377'b,				c2;
	TT ← (TT LRot8 ) and Q,				c3;

{	test for zero exponent again}
	[] ← Rx,ZeroBr,					c1;
	uHighHalf2 ← T or TT,	BRANCH[UP2A,$],		c2;
	T ← T or TT,					c3;
	
	T ← T or uLowHalf2,				c1;
	[] ← T,NZeroBr,					c2;
{	stack underflow?}
UP2A:	T ← STK,fXpop,		BRANCH[$,UP2DeNorm],	c3;

	TT ← LRot1 T,					c1;
	Q ← 377'b,push,					c2;
	TOS ← STK,pop,		GOTO[Unpack1X],		c3;

	
			
UP2HighExp:			GOTO[FPTrapsC1],	c3;

UP2DeNorm:			GOTO[FPTrapsC2],	c1;


{---------------------------------------------------------}

{*	De-normalization code

	enter with  T, ~Q holding the 32 bit quantity,   L0 prepared for return, 
	TT holding shift count

	(note that Q is complemnted!)

	contents of TT is destroyed

	De normalized 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: {stcky bit is 0}
	Q ← ~Q, L0Disp, CANCELBR[$],			c3;

	{RET[DeNormRets],				c1;}
	DISP3[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: {stcky bit is 1}
	Q ← ~Q, L0Disp,				c3;

	{Q ← Q or 1, RET[DeNormRets],				c1;}
	Q ← Q or 1, DISP3[DeNormRets],				c1;
	
{****************************************************************************

rounding code (rounds to nearest)

enter with
	L0 prepared for return.
	uSticky prepared
	data in T..Q

if inexact result, will generate trap, or set sticky register bit, depending on contents of sticky register.

****************************************************************************}


Round:
	[] ← uStickyBit, NZeroBr,			c2;
	Rx ← 377'b, BRANCH[RoundA, RoundB],		c3;

RoundA:				GOTO[RoundC],		c1;

RoundB:	Q ← Q or 1,		GOTO[RoundC],		c1;

RoundC:	[] ← Q and Rx, ZeroBr,				c2;
	Rx ← 200'b,		BRANCH[Inexact,RoundExit1],c3;

{in following we use TOS, which will eventually be restored}
Inexact:
	TOS ← uStickyReg,				c1;
	TOS ← TOS or 1, NegBr,				c2;
	uStickyReg ← TOS,	BRANCH[$, inexactTrap],	c3;

{now  we round to nearest}
	Q ← Q + Rx, CarryBr,				c1;
	Rx ← 177'b,		BRANCH[$, inexact1],	c2;
	[] ← Q and Rx, ZeroBr,				c3;

	Rx ← LShift1 200'b, SE ← 0, BRANCH[RoundExit2, $],c1; 
	Q ← Q and ~ Rx {Q[7] ← 0}, L0Disp, CANCELBR[RoundExit,0F],c2;

inexact1: {roundoff carried across word boundary}
	T ← T + 1, CarryBr, {overflowBr since T[0]=1} 	c3;

				BRANCH[RoundExit2A, $],	c1;
{roundoff overflowed, adjust exponent}
	TT ← TT + 1, L0Disp,	GOTO[RoundExit],	c2;

RoundExit2A:
	L0Disp,			GOTO[RoundExit],	c2;

RoundExit1: 	{delay}					c1;
RoundExit2:
	L0Disp,						c2;
RoundExit:			DISP3[RoundRets],		c3;


inexactTrap:
	GOTO[FPTrapsC2],				c1;





{********************************************************************************

Repack routine

entry:	
							
  TOS =		| arg1H	|
					
  STK =		|  ~	|
	      -->	| arg1L	|

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 fraction 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,				c1;
	Q ← uLowHalf1					c2;
	[] ← T or Q, ZeroBr,				c3;

{nominal value = (-1)↑uSign1 * <T[0].T[1] ... Q[0] ...> * 2↑(uExp1-127)}

	TT ← uExp1, BRANCH[$, ZeroToNorm],		c1;
	TT ← TT-2,					c2;
	[] ← TT, NegBr,					c3;

{nominal value = (-1)↑uSign1 * <T[0].T[1] ... > * 2↑(TT+2-127)}

NormLoop:
	[] ← T, NegBr,		BRANCH[$,LowExp],	c1;
	TT ← TT-1, NegBr,	BRANCH[$,Normed],	c2;
	T ← DLShift1 T, SE ← 1, BRANCH[NormLoop,SmallNumberC1],	c3;


{at Normed: nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+3-127) and T[0] = 1, therefore nominal exponent = TT+2, and nominal fraction = T[1]...Q[7]}

{at SmallNumber: nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+2-127) and TT = -1, therefore nominal fraction = T[1]...Q[7], and nominal exponent = 1 if T[0] = 1, else 0.  i.e. nominal exponent = T[0]}

{at LowExp: nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+2-127) and TT < 0}





{*********************}

{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 small number}
{NOTE: this code is very painful for an exponent of 1, maybe I should avoid ariving here under those conditions?}

LowExp:
	Rx ← 25'd,	CANCELBR[$],			c2;
	[] ← TT + Rx, NegBr,				c3;

	Rx ← 1,  BRANCH[$, VeryLowExp],			c1;
{to allow for complementing on right shifts}
	Q ← ~Q,						c2;
	TT ← -TT-1, L0 ← L0.rePack1,CALL[DeNormC1]	c3;





{*********************

At VeryLowExp, rounding to nearest can not produce any significant bits, however, fraction is known to be non zero, also Rx = 1.

The following is approx code if we did not trap on denormalized results:

VeryLowExp:
	Q ← 0,						c2;
	T ← 0,						c3;

	Rx ← 200'b,		GOTO[inexact],		c1;

*********************}

VeryLowExp:			GOTO[FPTrapsC3],	c2;





{*********************

nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+2-127) and TT = -1, therefore nominal fraction = 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: following code would be used if we did not trap on denormalized results, and further, even if we do trap un denormalized results, there is exactly one case that goes through this code that does not trap, namely, a number which when rounded rounds up to a non denormalized number.  SInce I wrote this code before understanding that I had to provide traps on denormalized results, I have decided to keepit..

exit from the following has nominal exponent-3 in TT. Also a 1 bit in T[0], so that subsequent rounding will cause a carry overflow if rounding carrys into T[0]

*********************}


SmallNumberC1: {delay}					c1;
SmallNumberC2: {delay}				c2, at[L0.rePack1,8,DeNormRets];
SmallNumberC3:
	TT ← RRot1 1,					c3;
	TT ← LRot1 (TT and T), {TT ← nominal exponent = T[0]}	c1;
	Rx ← RRot1 1,					c2;
	T ← T or Rx, {T[0] ← 1},			c3;

{normed wants TT to hold nominal exponent - 3}
	TT ← TT - 3,					c1;
				GOTO[Normed],		c2;





{*********************

nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+3-127) and T[0] = 1, therefore nominal exponent = TT+3, and nominal fraction = T[1]...Q[7]

also entered from SmallNumberSmallNumber, arranged so that nominalFraction = <T[1]...>, T[0] = 1, and nominal exponent = TT+3

*********************}


Normed:
	L0 ← L0.rePack2,	CANCELBR[$],		c3;

				CALL[Round],		c1;

{now  we check for overflow  and underflow}
	TT ← TT+3,				c1, at[L0.rePack2,8,RoundRets];
	Rx ← 376'b,					c2;
	[] ← Rx-TT, NegBr, {branches if TT >= 377'b}	c3;

	[] ← TT, ZeroBr,{overflow}BRANCH[$, FPTrapsC2], c1;
	{underflow}	BRANCH[finalPack,FPTrapsC3], 	c2;



ZeroToNorm:
	TT ← 0, GOTO[ZeroFractionC3],			c2;

RepackExact0:
	uStickyBit ← TT ← 0,	GOTO[ZeroFraction],	c3;


ZeroFractionC3: {delay}					c3;
ZeroFraction:
	T ← 0,						c1;
	Q ← 0,			GOTO[finalPack],	c2;




{result sign = uSign1, result exp = TT, result fraction = <T[1]...Q[7]>, T[0] = 1}

finalPack:
	Rx ← 377'b					c3;

	Q ← Q and ~Rx, {bottom 8 bits of final result}	c1;
	Rx ← T and Rx, {next 8 bits of final result}	c2;
	Rx ← Q or Rx,					c3;

	Rx ← Rx LRot8,					c1;
	STK ← Rx, {low word of result}			c2;
	TT ← TT LRot8,					c3;

	TT ← RRot1(TT or uSign1), {top 9 bits of final result}c1;
	T ← T LRot8,					c2;
	TOS ← T and 177'b,{next 7 bits of final result}	c3;

	TOS ← TOS or TT,	GOTO[VFptIBDisp2],	c1;

{---------------------------------------------------------}

{*	Traps:  Any operation that blows up comes here to be rejected and thus 
	processed by software.  }

{---------------------------------------------------------}


FPTrapsC3:						c3;

FPTrapsC1:						c1;
FPTrapsC2:
	push,L1Disp,		CANCELBR[$],		c2;
				DISP4[FPTraps],		c3;


FpT1:	TT ← uib,					c1,at[L1.FpT1,10,FPTraps];
				GOTO[FpT2B],		c2;

FpT1.5:	TT ← uib,		GOTO[FpT2A],		c1,at[L1.FpT1.5,10,FPTraps];

FpT2:	TT ← uib,push,					c1,at[L1.FpT2,10,FPTraps];
FpT2A:	push,						c2;
FpT2B:	TOS ← STK,pop,		GOTO[Bank1EscOpcodeTrap], c3;


{****************************************************************************

multiply code


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


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


}
{

This procedure calls unpack2 to break the arguments up into components
	Sign1 Exp1  HighHalf1  LowHalf1
	Sign2 Exp2  HighHalf2  LowHalf2

	where the high halves have 16 bits and the lowhalves have 8 bits

We compute four products to be added together to form a 48 bit product
									
LowHalf1*LowHalf2					|	        B	|        A	|
							
HighHalf1*LowHalf2			|  	E	|         C	|
				    			
LowHalf1*HighHalf2			|	F	|         D	|
						
HighHalf1*HighHalf2	|	H	|	G	|
								
48 bit product	|	Z	|	Y	|            X	|          W	|
	
********************************************************************************}


@aFMUL:
	{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack}	

	uib ← TT, L0 ← L0.mult1,			c1, at[2,10,ESC4n];
	TT ← LRot1 TOS,		CALL[Unpack2],		c2;


{*********************

The arguments are now unpacked, and a ZeroBr is pending if either are 0.

First we add the exponents and xor the signs.

NOTE: in the case of 1*1, the result fraction will have first sign bit at x1, thus the result exponent must be 128 so that subsequent  normalization will reduce exponet to 127, the correct value for 1.  This is obtained by adding exponents and subtracting 126.

*********************}


	T ← uExp1,	BRANCH[$,RepackExact0],	c2, at[L0.mult1,10,UnpackRets];
	TT ← uExp2,					c3;

	T ← T + TT,					c1;
	T ← T - 126'd, 					c2;
	uExp1 ← T,					c3;

	TT ← uSign1,					c1;
	Q ← uSign2,					c2;
	uSign1 ← TT xor Q,				c3;


{now compute uLowHalf1*uLowHalf2}

	T ← uLowHalf1,					c1;
	T ← T LRot8,					c2;
	uLowHalf1 ← Q ← T,				c3;

	T ← uLowHalf2,					c1;
	T ← T LRot8,					c2;
	uLowHalf2 ← Rx ← T,				c3;

	T ← 0, L0 ← L0.mult2,				c1;
	TT ← 7,			CALL[FptMultLoopC3],	c2;

	TT ← ~377'b,			c1, at[L0.mult2,10,FptMultLoopRets];
	Q ← ~Q,						c2;
	uStickyBit ← TT and Q, {A(=W)}			c3;

{at this point, uStickyBit is non zero iff A(=W) is non zero, and T contains B}

{now compute T+uHighHalf1*uLowHalf2, which is <E+carry,B+C+carry>}
	
	TT ← T,						c1;
	T ← uLowHalf2, {already rotated}		c2;
	Q ← T,						c3;

	T ← uHighHalf1, L0 ← L0.mult3,			c1;
	Rx ← T,						c2;
	T ← TT,						c3;

	TT ← 7,			CALL[FptMultLoopC2],	c1;

	uLowHalf2 ← T, {E+carry}	c1, at[L0.mult3,10,FptMultLoopRets];
	Rx ← ~Q,					c2;
	Rx ← Rx LRot8,					c3;

	TT ← Rx and 377'b, {B+C+Carry}			c1;

{now compute TT+uLowHalf1*uHighHalf2, which is <F+carry, B+C+D+carry>}
	T ← uLowHalf1, {already rotated}		c2;
	Q ← T,						c3;

	T ← uHighHalf2, L0 ← L0.mult4,			c1;
	Rx ← T,						c2;
	T ← TT,						c3;

	TT ← 7, CALL[FptMultLoopC2],			c1;

	uLowHalf1 ← T, {F+carry}	c1, at[L0.mult4,10,FptMultLoopRets];
	Rx ← ~Q,					c2;
	Rx ← Rx LRot8,					c3;

	TT ← Rx and 377'b, {B+C+D+Carry(=X)}		c1;
	T ← TT or uStickyBit, {T#0 iff X#0 or W#0}	c2;
	uStickyBit ← T,					c3;

{now compute uLowHalf1(=F+carry)+uLowHalf2(=E+carry)+uHighHalf1*uHighHalf2 = <H+carry, E+F+G+carry> = <Z,Y>}

	Q ← uHighHalf1,					c1;
	Rx ← uHighHalf2,				c2;
	T ← uLowHalf1, {F+carry}			c3;

	TT ← uLowHalf2, {E+carry}			c1;
	T ← T + TT, CarryBr, L0 ← L0.mult5,		c2;
	TT ← 15'd, BRANCH[mull0, mull1],		c3;
	
{uLowHalf1←-1, save the carry}
mull1:	uLowHalf1 ← ~T xor T,	CALL[FptMultLoopC2],	c1;

{save the carry}
mull0:	uLowHalf1 ← 0,		CALL[FptMultLoopC2],	c1;

	TT ← uLowHalf1,			c1, at[L0.mult5,10,FptMultLoopRets];
	T ← T-TT, {include the carry}			c2;
	uHighHalf1 ← T,	{Z}				c3;
	
	uLowHalf1 ← ~Q, {Y}	GOTO[RePackC2],		c1;





{********************************************************************************

fpt multiply loop

at entry:

	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
	Q holds multiplier, right adjusted
	T holds initial product
	Rx holds multiplicand

	can be called from any cycle, uses an integral number of clicks

at end:
	high 16 bits of product is in T
	low n bits of product is complimented in top n bits of Q

	(bottom 16-n bits of Q holds top 16-n bits of original multiplier)

	returns via L0

time: n clicks

********************************************************************************}


FptMultLoopC2:						c2;
FptMultLoopC3:						c3;

FptMultLoopC1:
	[] ← Q and 1, NZeroBr,				c1;
	TT ← TT-1, ZeroBr,	BRANCH[FptMultLoop0,FptMultLoop1],c2;

FptMultLoop0:
	T ← DARShift1(T+0),	BRANCH[FptMultLoopC1,FptMultLoopEnd],c3;

FptMultLoop1:
	T ← DARShift1(T+Rx),	BRANCH[FptMultLoopC1,FptMultLoopEnd],c3;

FptMultLoopEnd:
	[] ← Q and 1, NZeroBr,				c1;
	L0Disp,			BRANCH[FptMultLoopEnd0,FptMultLoopEnd1],c2;
FptMultLoopEnd0:
	T ← DARShift1(T+0),	DISP4[FptMultLoopRets],	c3;
FptMultLoopEnd1:
	T ← DARShift1(T+Rx),	DISP4[FptMultLoopRets],	c3;



{*********************

issues remaining:

divide by zero trap (now forces infinity)

one might be able to unrole the division loop

at the moment, the remainder is corrected after first sixteen subtractions, need not do so if one were more careful

adjust starting cycle of division loop?

move L0 disp earlier in loop exit sequence?


*********************}

{********************************************************************************

division code

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


returns:	
							
  TOS =		|  divH	|
					
  STK =		|  ~	|
	      -->	|  divL	|	
  


This procedure calls unpack2 to break the arguments up into components
	Sign1 Exp1  HighHalf1  LowHalf1
	Sign2 Exp2  HighHalf2  LowHalf2

	where the high halves have 16 bits and the lowhalves have 8 bits



********************************************************************************}


{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack}
@aFDIV:	uib ← TT, L0 ← L0.div1,				c1,at[3,10,ESC4n];
	TT ← LRot1 TOS,		CALL[Unpack2],		c2;

	{the arguments are now unpacked}

	T ← uExp1,				c2, at[L0.div1,10,UnpackRets];
	TT ← uExp2,					c3;

	T ← T - TT,					c1;
	T ← T + 127'd,  {re bias exponent}		c2;
	uExp1 ← T,					c3;

	TT ← uSign1,					c1;
	Q ← uSign2,					c2;
	uSign1 ← TT xor Q,				c3;

{Save a pair of non temporary R registers.}
	uDivCount ← divCount,				c1;
	uDivResult ← divResult,				c2;

{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,		c3;

	Q ← uLowHalf2, ZeroBr, BRANCH[FptDivB,FptDivA],	c1;

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

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

FptDivC:
	divisorLow ← ~Q,				c1;
	T ← uHighHalf1,					c2;
	Q ← ~ uLowHalf1,				c3;

	T ← DRShift1 T, SE ← 0,				c1;
	Q ← ~Q, L0 ← L0.div2,				c2;



{*********************

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[FptDivLoopC1],		c3;

	uHighHalf1 ← divResult,			c2, at[L0.div2,10,FptDivLoopRets];
{puts a 0 into Q.15} {remainder did not get its last left shift}
	T ← DLShift1 T, SE ← 1, L0 ← L0.div3,		c3;

	divCount ← 10'd,	CALL[FptDivLoopC2],	c1;
	divResult ← divResult  LRot4,		c2, at[L0.div3,10,FptDivLoopRets];
	[] ← T or Q, NZeroBr,				c3;

	divResult ← LShift1 (divResult), SE ← 0,BRANCH[FptDivD,FptDivE],c1;

{now we install the correct sticky bit}
FptDivD:
	divResult ← LShift1 (divResult), SE ← 0, GOTO[FptDivF], c2;
FptDivE:
	divResult ← LShift1 (divResult), SE ← 1, GOTO[FptDivF],	c2;
FptDivF:
	uLowHalf1 ← divResult,	GOTO[FptDivExit],	c3;


{divide by zero} {Restore the pair of non temporary R registers.}
FptDivZero:
	divCount ← uDivCount,				c3;

	divResult ← uDivResult,	GOTO[FPTrapsC2],	c1;



{Restore the pair of non temporary R registers.}
FptDivExit:
	divCount ← uDivCount,				c1;
	divResult ← uDivResult,				c2;
	uStickyBit ← 0,		GOTO[RePackC1],		c3;



{********************************************************************************

divide loop

	dividend in <T,Q>
	divisor in <divisorHigh, divisorLow>

	bit count in divCount, performs bitCOunt subtractions

	return point in L0

	will accumulate bits in divResult
	<T,Q> will hold the remainder


*********************************************************************************}


FptDivLoopC1:						c1;
FptDivLoopC2:						c2;
FptDivLoopC3:
	divResult ← 0,		GOTO[FptDivSubA],	c3;

{in this part of the loop the contents of <T,Q> are positive}
FptDivSub:	{delay}					c2;
	divResult ← LShift1 (divResult), SE ← 1,	c3;

FptDivSubA:
	Q ← Q-divisorLow, CarryBr,			c1;
	divCount ← divCount-1, ZeroBr, BRANCH[FptDivSub1,FptDivSub0], c2;
FptDivSub0:
	T ← T-divisorHigh, CarryBr, BRANCH[$,FptDivSubExit1],	c3;
{puts a 0 into Q.15}
	T ← DLShift1 T, SE ← 1,	BRANCH[FptDivAdd, FptDivSub],	c1;

FptDivSub1:
	T ← T-divisorHigh-1, CarryBr, BRANCH[$,FptDivSubExit2],	c3;
{puts a 0 into Q.15}
	T ← DLShift1 T, SE ← 1,	BRANCH[FptDivAdd,FptDivSub],	c1;


FptDivSubExit1:
			BRANCH[FptDivAddExit,FptDivSubExit],	c1;
FptDivSubExit2:
			BRANCH[FptDivAddExit,FptDivSubExit],	c1;

FptDivSubExit:
	divResult ← LShift1 (divResult), SE ← 1, GOTO[FptDivLoopExit],	c2;



{in this part of the loop the contents of <T,Q> are negative (in  2's complement)}

FptDivAdd:	{delay}					c2;
	divResult ← LShift1 (divResult), SE ← 0,	c3;
	
	Q ← Q+divisorLow, CarryBr,			c1;
	divCount ← divCount-1, ZeroBr,	BRANCH[FptDivAdd0,FptDivAdd1],	c2;
FptDivAdd0:
	T ← T+divisorHigh, CarryBr, BRANCH[$,FptDivAddExit1],	c3;
{puts a 0 into Q.15}
	T ← DLShift1 T, SE ← 1,	BRANCH[FptDivAdd,FptDivSub],	c1;

FptDivAdd1:
	T ← T+divisorHigh+1, CarryBr, BRANCH[$,FptDivAddExit2],	c3;
{puts a 0 into Q.15}
	T ← DLShift1 T, SE ← 1,	BRANCH[FptDivAdd, FptDivSub],	c1;


FptDivAddExit1:
	BRANCH[FptDivAddExit,FptDivSubExit],		c1;
FptDivAddExit2:
	BRANCH[FptDivAddExit, FptDivSubExit],		c1;

{we have subtracted one too many times, so add back in to get correct remainder}

FptDivAddExit:
	divResult ← LShift1 (divResult), SE ← 0,	c2;
	Q ← Q + divisorLow, CarryBr,			c3;

	{delay}		BRANCH[FptDivAX0, FptDivAX1],	c1;
FptDivAX1:
	T ← T + divisorHigh + 1, GOTO[FptDivLoopExit],	c2;
FptDivAX0:
	T ← T + divisorHigh, GOTO[FptDivLoopExit],	c2;

	

FptDivLoopExit:
	L0Disp,						c3;

				DISP4[FptDivLoopRets],	c1;


{*********************

issues remaining:

efficiency:   The choice of which where arguments are at unNormed is bad, by some juggling of arg1 and arg2 should be able to reduce some of the costs of the three de-norm cases.

*********************}



{********************************************************************************

sub code

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


returns:	
							
  TOS =		|  difH	|
					
  STK =		|  ~	|
	      -->	|  difL	|	
  


This procedure calls unpack2 to break the arguments up into components
	Sign1 Exp1  HighHalf1  LowHalf1
	Sign2 Exp2  HighHalf2  LowHalf2

	where the high halves have 16 bits and the lowhalves have 8 bits



*********************************************************************************}


@aFSUB:
{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack.}		uib ← TT, L0 ← L0.sub1,				c1, at[1,10,ESC4n];
	TT ← LRot1 TOS,  CALL[Unpack2],			c2;

	{the arguments are now unpacked}

	T ← uSign2,				c2, at[L0.sub1,10,UnpackRets];
	T ← T xor 1, {change sign}			c3;

	uSign2 ← T,GOTO[add1],				c1;


{********************************************************************************

add code

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


returns:	
							
  TOS =		|  sumH	|
					
  STK =		|  ~	|
	      -->	|  sumL	|	
  


This procedure calls unpack2 to break the arguments up into components
	Sign1 Exp1  HighHalf1  LowHalf1
	Sign2 Exp2  HighHalf2  LowHalf2

	where the high halves have 16 bits and the lowhalves have 8 bits



*********************************************************************************}

{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack.}	
@aFADD:
	uib ← TT, L0 ← L0.add1,				c1, at[0,10,ESC4n];
	TT ← LRot1 TOS,		CALL[Unpack2],		c2;

	{the arguments are now unpacked, subtract enters here}

add1:	T ← uExp1,				c2, at[L0.add1,10,UnpackRets];
	TT ← uExp2,					c3;

	TT ← T-TT, NegBr,				c1;
	 [] ← TT, ZeroBr, BRANCH[unNorm2, unNorm1],	c2;

{Exp2 > Exp1, so we have to shift fractional part of arg1 to the right, TT has negative of  shift count}

unNorm1:
	Q ← uLowHalf1,		CANCELBR[$],		c3;

	Rx ← uSign2,					c1;
	T ← uSign1,					c2;
	uSign2 ← T,					c3;

	uSign1 ← Rx,					c1;
	Rx ← uExp2,					c2;
	uExp1 ← Rx,					c3;

	T ← uHighHalf1,					c1;
	TT ← -TT,		GOTO[unNorm],		c2;

{Exp1 >= Exp2, so we may have to shift fract part of arg2, TT has shift count}

unNorm2:
	Q ← uHighHalf1,		BRANCH[$, unNormNeither],	c3;

	T ← uHighHalf2,					c1;
	uHighHalf2 ← Q,					c2;
	Rx ← uLowHalf1,					c3;

	Q ← uLowHalf2,					c1;
	uLowHalf2 ← Rx,		GOTO[unNorm],		c2;


unNormNeither:
	T ← uSign1,					c1;
	Q ← uSign2,					c2;
	uSign1 ← Q,					c3;

	uSign2 ← T,					c1;
	T ← uHighHalf1,					c2;
	Q ← uLowHalf1,		GOTO[unNormedC1],	c3;


{The fractional part 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 fractional part of the argument with the higher exponent is in <uHighHalf2, uLowhalf2>}

unNorm:	Rx ← 20'b,					c3;

	TT ← TT-Rx,  NegBr,				c1;
	[] ← TT- Rx , NegBr,	BRANCH[$,unNormLt20],	c2;
	[] ← T or Q, NZeroBr,	BRANCH[$,unNormLt40],	c3;

{total shift >= 40'b bits}

	T ← 0,			BRANCH[unNormZ,unNormNZ],c1;
unNormZ:
	Q ← 0, GOTO[unNormedC3],			c2;
unNormNZ:
	Q ← 1, GOTO[unNormedC3],			c2;


{40'b > total indicated shift >= 20'b, TT holds "indicated shift - 20'b"}

unNormLt40:
	[]  ← Q, NZeroBr, CANCELBR[$],			c1;
	BRANCH[unNormLt40A, unNormLt40B],		c2;
unNormLt40A:
	Q ← T , GOTO[unNormLt40C],			c3;
unNormLt40B:
	Q ← T or 1, GOTO[unNormLt40C],			c3;
unNormLt40C:
	T ← 0, L0 ← L0.add1,				c1;
	Q ← ~Q, CALL[DeNormC3],				c2;


{20'b > total indicated shift , TT holds "indicated shift -20'b", Rx contains 20'b}

unNormLt20:
	TT ← TT+Rx, CANCELBR[$],			c3;

	L0 ← L0.add1,					c1;
	Q ← ~Q,			CALL[DeNormC3],		c2;
	


{T,Q holds the shifted version of the argument  with the small exponent, <uHighHalf2, uLowHalf2> contains the other argument.  uSign1 contains sign of argument  in <uHighHalf2, uLowHalf2>  (the nominal sign), uExp1 contains nominal exponent, uSign2 contains other sign)}


unNormedC3: {delay}					c3;

unNormedC1: {delay}					c1;
unNormed:
	Rx ← uSign1,				c2, at[L0.add1,8,DeNormRets];
	TT ← uSign2,					c3;
	[] ← Rx xor TT, NZeroBr,			c1;
	TT ← uLowHalf2,	BRANCH[addUnNormed,subUnNormed],c2;

{equal signs, so add}

addUnNormed:
	Q ← TT+Q, CarryBr,				c3;
	TT ← uHighHalf2, BRANCH[addUnNormedA,addUnNormedB],c1;
addUnNormedA:
	T ← TT+T, CarryBr, GOTO[addUnNormedC],		c2;
addUnNormedB:
	T ← TT+T+1, CarryBr, GOTO[addUnNormedC],	c2;
addUnNormedC:
	[] ← Q and 1, NZeroBr,  BRANCH[$,addUnNormedD],	c3;
	uLowHalf1 ← Q, ZeroBr, CANCELBR[unNormedB],	c1;


{addition overflowed, so have to shift right and adjust exponents}

addUnNormedD:
	Q ← ~Q, BRANCH[addUnNormedE, addUnNormedF],	c1;
addUnNormedE:{Q ← Q or 0}	 GOTO[addUnNormedG],	c2;
addUnNormedF:
	Q ← Q and ~2, {Q ← Q or 22} GOTO[addUnNormedG],	c2;
addUnNormedG:
	T ← DRShift1 T, SE ← 1,				c3;

	Q ← ~Q,						c1;
	Rx ← uExp1,					c2;
	Rx ← Rx+1, 					c3;

	uExp1 ← Rx,					c1;
	{delay}						c2;
	{delay} GOTO[unNormedA],			c3;

{non equal signs, so subtract shifted fraction}

{carryBr seems to take on a subtraction if there is no borrow}

subUnNormed:
	Q ← TT-Q, CarryBr,				c3;
	TT ← uHighHalf2, BRANCH[subUnNormedB,subUnNormedA],c1;
subUnNormedA:
	T ← TT-T, CarryBr,	GOTO[subUnNormedC],	c2;
subUnNormedB:
	T ← TT-T-1, CarryBr,	GOTO[subUnNormedC],	c2;
subUnNormedC:{delay}		BRANCH[subUnNormedD,$],	c3;

	uLowHalf1 ← Q, ZeroBr, GOTO[unNormedB],		c1;

{last subtraction produced overflow, so use opposite sign (from uSign2), and subtract tentative result from 0 to produce a sign magnitude result}

subUnNormedD:
	Q ← 0 - Q, CarryBr,				c1;
	TT ← uSign2, BRANCH[subUnNormedD1,subUnNormedD0],c2;
subUnNormedD1:
	T ← 0 - T - 1,		GOTO[subUnNormedE],	c3;
subUnNormedD0:
	T ← 0 - T,		GOTO[subUnNormedE],	c3;
subUnNormedE:
	uSign1 ← TT,					c1;
	{delay}						c2;
	{delay}						c3;


unNormedA:
	uLowHalf1 ← Q, CANCELBR[$],			c1;
unNormedB:
	uHighHalf1 ← T, NZeroBr, BRANCH[$,unNormedC],	c2;
	uStickyBit ← 0, CANCELBR[RePackC1],		c3;

unNormedC:
	uStickyBit ← 0,		BRANCH[$, RePackC1],	c3;
	
{force positive on zero}
	uSign1 ← 0,		GOTO[RePackC2],		c1;


{*********************

issues remaining:

	most negative long integer
	most negative integer

*********************}


{****************************************************************************
fix to CARDINAL  code
****************************************************************************}


@aFixC:
{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack.}		uib ← TT, L0 ← L0.round5,			c1, at[08,10,ESC4n];
	TT ← LRot1 TOS,  CALL[Unpack1],			c2;



{****************************************************************************
round to CARDINAL  code
****************************************************************************}


@aRoundC:
{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack.}		uib ← TT, L0 ← L0.round5,			c1, at[0D,10,ESC4n];
	TT ← LRot1 TOS,		CALL[Unpack1],		c2;

{the arguments are now unpacked}
	Rx ← 143'd,				c2, at[L0.round5,10,UnpackRets];
	TT ← uExp1,					c3;

	Rx ← TT - Rx, NegBr,				c1;
			BRANCH[RoundCB, RoundCA],	c2;

{normal size number}
RoundCA:
	Rx ← 126'd,		GOTO[Round1],		c3;

{too big}
RoundCB:			GOTO[FPTrapsC1],	c3;
		



{********************************************************************************
fix to INTEGER  code
*********************************************************************************}


@aFixI:
{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack.}		uib ← TT, L0 ← L0.round4,			c1, at[07,10,ESC4n];
	TT ← LRot1 TOS,		CALL[Unpack1],		c2;



{********************************************************************************
round to INTEGER  code
*********************************************************************************}


{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack.}
@aRoundI:
	uib ← TT, L0 ← L0.round4,			c1, at[0C,10,ESC4n];
	TT ← LRot1 TOS,		CALL[Unpack1],		c2;

{the arguments are now unpacked}
	Rx ← 142'd,				c2, at[L0.round4,10,UnpackRets];
	TT ← uExp1,					c3;

	Rx ← TT - Rx, NegBr,				c1;
	[] ← Rx, ZeroBr,	BRANCH[$,RoundIA],	c2;
	BRANCH[RoundIC,RoundIB],			c3;

{normal size number}
RoundIA:
	Rx ← 126'd,	CANCELBR[Round1],		c3;

{might be largest negative number}
RoundIB:			GOTO[FPTrapsC2],	c1;

{too big}
RoundIC:			GOTO[FPTrapsC2],	c1;					


{********************************************************************************
fix to LONG INTEGER  code
*********************************************************************************}


@aFix:
{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack.}		uib ← TT, L0 ← L0.round1,			c1, at[05,10,ESC4n];
	TT ← LRot1 TOS,		CALL[Unpack1],		c2;


{********************************************************************************
round to LONG INTEGER  code
*********************************************************************************}


@aRound:
{Save TT (ib), and first  cycle of unpack code, while setting up call to unpack.}	

	uib ← TT, L0 ← L0.round1,			c1, at[0B,10,ESC4n];
	TT ← LRot1 TOS,  CALL[Unpack1],			c2;

	{the arguments are now unpacked}

	Rx ← 126'd, 				c2, at[L0.round1,10,UnpackRets];
	TT ← uExp1,					c3;

Round1:	Rx ← TT - Rx, NegBr,				c1;
	T ← 150'd, BRANCH[$,RoundLIA],			c2;
	T ← TT - T , NegBr, 				c3;

	Rx ← 158'd, BRANCH[$,RoundLIB],			c1;
	Rx← TT - Rx, NegBr,				c2;
	T ← 166'd, BRANCH[RoundLID,RoundLIC],		c3;

{too small, won't even round to zero, but have to watch out for inexact trap}

RoundLIA:
	TT ← 25'd, 					c3;

	{delay}						c1;
				GOTO[RoundLIE],		c2;


{rounding needed}

RoundLIB:
	TT ← -T,		GOTO[RoundLIE],		c2;


{no rounding needed}

RoundLIC:
	TT ← -Rx,					c1;
	T← uHighHalf1, L0 ← L0.round3,			c2;
	Q ← ~ uLowHalf1,	CALL[DeNormC1],		c3;


{too big}

RoundLID:			GOTO[FPTrapsC2],	c1;

	 
{shift to right, round, and do a final 8 bit shift}

RoundLIE:
	T ← uHighHalf1, L0 ← L0.round2,			c3;
	Q ← ~ uLowHalf1,	CALL[DeNormC2],		c1;

	Xbus ← uib, XDisp, {L0 ← L0.round2,} 	c2, at[L0.round2,8,DeNormRets];
	uStickyBit ← 0, DISP4[FixVsRound],		c3;

	CALL[Fix],					c1, at[05,10,FixVsRound];
	CALL[Fix],					c1, at[07,10,FixVsRound];
	CALL[Fix],					c1, at[08,10,FixVsRound];
	CALL[Round],					c1, at[0B,10,FixVsRound];
	CALL[Round],					c1, at[0C,10,FixVsRound];
	CALL[Round],					c1, at[0D,10,FixVsRound];


{next 8 bit shift could be done faster by other means}

	Q ← ~Q,					c1, at[L0.round2,8,RoundRets];
	TT ← 8, L0 ← L0.round3, 			c2;
	Q ← Q or 377'b,  CALL[DeNormC1],		c3;

	Xbus ← uib, XDisp,			c2, at[L0.round3,8,DeNormRets];
	DISP4[RoundFixTargets],				c3;


{********************************************************************************

round/fix to long integer exits

*********************************************************************************}

	TT ← uSign1,		GOTO[TargetLI],	c1, at[05,10,RoundFixTargets];
	TT ← uSign1,		GOTO[TargetLI],	c1, at[0B,10,RoundFixTargets];

TargetLI:	{delay}					c2;
	[]  ← TT, NZeroBr,				c3;

	STK ← Q,	BRANCH[RoundLIFc,RoundLIF],	c1;


{negative result}
RoundLIF:
	Q ← 0-Q, CarryBr,				c2;
	STK ← Q,	BRANCH[RoundLIFa, RoundLIFb],	c3;

RoundLIFa:
	T ← 0-T-1,		GOTO[RoundLIFc],	c1;
RoundLIFb:
	T ← 0-T,		GOTO[RoundLIFc],	c1;

RoundLIFc:						c2;
RoundLIFd:
	TOS ← T,		GOTO[VFptIBDisp1],	c3;

{********************************************************************************

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,		BRANCH[$, LargeCard],	c2;
	[] ← TT, NZeroBr,				c3;

TargetC1:
	T ← Q,			BRANCH[$, NegCard],	c1;
	pop,						c2;
	{delay}						c3;

				GOTO[RoundLIFc],	c1;

LargeCard: 			GOTO[FPTrapsC1],	c3;


{out of range, unless exact 0}
NegCard:	[] ← Q, ZeroBr,				c2;
				BRANCH[$,TargetC1],	c3;

				GOTO[FPTrapsC2],	c1;

{********************************************************************************

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,		BRANCH[$,IntLarge],	c2;
	[] ← TT, pop, NZeroBr,				c3;

				BRANCH[$, IntNeg],	c1;
	T ← Q,			GOTO[RoundLIFd],	c2;

IntNeg:	Q ← 0-Q,					c2;
	TOS ← Q,		GOTO[VFptIBDisp1],	c3;

{someday we will handle the most negative integer correctly}
IntLarge:			GOTO[FPTrapsC1],	c3;


{********************************************************************************

Fix sub routine

*********************************************************************************}


Fix:
	[] ← uStickyBit, NZeroBr,			c2;
	Rx ← 377'b,		BRANCH[FixA,FixB],	c3;

FixA:				GOTO[FixC],		c1;
FixB:	Q ← Q or 1,		GOTO[FixC],		c1;

FixC:	[] ← Q and Rx, ZeroBr,				c2;
				BRANCH[FixInexact,$],	c3;

				GOTO[FixExit2],		c1;

{in following we use TOS, which will eventually be restored}
FixInexact:
 	TOS ← uStickyReg,				c1;
	TOS ← TOS or 1, NegBr,				c2;
	uStickyReg ← TOS,	BRANCH[FixExit1,FixInexactTrap],c3;




FixExit1: 	{delay}					c1;
FixExit2:
	L0Disp,						c2;
FixExit:			DISP3[RoundRets],		c3;


FixInexactTrap:			GOTO[FPTrapsC2],	c1;


{*********************

issues remaining:

*********************}



{****************************************************************************}


{compare code

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


returns:	
							
  TOS =		|  comp	|
					
  STK =	     -->	|  ~	|
  


This procedure calls unpack2 to break the arguments up into components
	Sign1 Exp1  HighHalf1  LowHalf1
	Sign2 Exp2  HighHalf2  LowHalf2

	where the high halves have 16 bits and the lowhalves have 8 bits
}


@aFComp:
	{save TT (ib), and first  cycle of unpack code, while setting up call to unpack}	

	uib ← TT, L0 ← L0.comp1,				c1, at[4,10,ESC4n];
	TT ← LRot1 TOS,  CALL[Unpack2],			c2;

	{the arguments are now unpacked}

	Rx ← uSign2, 					c2, at[L0.comp1, 10, UnpackRets];
	TT ← uSign1,					c3;

	[] ← Rx xor TT, NZeroBr,			c1;
	TT ← uExp1, BRANCH[$, cmpNeSigns],		c2;
	T ← uExp2,					c3;
	
	T ← T-TT, CarryBr,				c1;
	[] ← T, NZeroBr, BRANCH[CmpAbs1High3, $],	c2;
	TT ← uHighHalf1, BRANCH[$, CmpAbs2High1],	c3;
	
	T ← uHighHalf2,					c1;
	T ← T - TT, CarryBr,				c2;
	[] ← T, NZeroBr, BRANCH[CmpAbs1High1, $],	c3;
	
	TT ← uLowHalf1, BRANCH[$, CmpAbs2High2],	c1;
	T ← uLowHalf2,					c2;
	T ← T - TT, CarryBr,				c3;
	
	[] ← T, NZeroBr, BRANCH[CmpAbs1High2, $],	c1;
	TOS ← 0, BRANCH[cmpExit3, CmpAbs2High3],	c2;
	

{signs are unequal, Rx contains uSign2}
cmpNeSigns:
	T ← uExp2,					c3;

	T ← T or TT,					c1;
	TT ← uHighHalf2,				c2;
	T ← T or TT,					c3;

	TT ← uHighHalf1,				c1;
	T ← T or TT,					c2;
	TT ← uLowHalf2,				c3;

	T ← T or TT,					c1;
	TT ← uLowHalf1,				c2;
	T ← T or TT, ZeroBr,				c3;

	BRANCH[$, CmpZeros],				c1;
	GOTO[CmpAbs2High3],				c2;

{un equal signs, but arguments are both zero}
CmpZeros: TOS ← 0, GOTO[cmpExit3],				c2;
	
	
		
	
CmpAbs1High1:	{delay} CANCELBR[$], 			c1;
		GOTO[CmpAbs1High3],			c2;
		      
CmpAbs1High2:	{delay} CANCELBR[$],			c2;
		[] ← Rx, NZeroBr, GOTO[CmpNEa],		c3;
		
CmpAbs1High3:	[] ← Rx, NZeroBr, CANCELBR[CmpNEb],	c3;

CmpAbs2High1: {delay}		 			c1;
CmpAbs2High2: {delay}					c2;
{next inst also covers unequal sign case, Rx holding usign2}
CmpAbs2High3: [] ← Rx, ZeroBr, GOTO[CmpNEa],		c3;

CmpNEa:	BRANCH[Cmp1High, Cmp2High],			c1;
CmpNEb:	BRANCH[Cmp1High, Cmp2High],			c1;

Cmp1High:	TOS ← 1, GOTO[cmpExit3],		c2;
Cmp2High:	TOS ← (~ TOS xor TOS), {TOS ← -1}
				GOTO[cmpExit3],		c2;	
	



cmpExit3:
	{delay}					c3;

{cmpExit1:}
       {pop,					c1;}
	pop,	 GOTO[VFptIBDisp2],		c1;
	
	
{VFptIBDisp2:
	IBDisp,					c2;
{VFptDisp:}
	DISPNI[OpTable],			c3;

VFptIBDisp1:		GOTO[VFptIBDisp2],	c1;
}

VFptIBDisp2:
        Noop,   				c2;
	GOTO[Bank1NxtInstc1],			c3;
{	Bank ← bank0,				c1;
	IBDisp,	GOTOBANK0[DISPNIonly],		c2;}
	
VFptIBDisp1:		GOTO[VFptIBDisp2],	c1;





{*****************************************************************

	Special Versatec Opcode to allow Unpacking of Fpt numbers
		

On Entry:  TOS= argHigh = [0..0]=s1, [1..8]=exp1, [9..15]=fracta
	   STK= argLow  = [0..7]=fractb, [8..15]=fractc 

On Exit:   TOS = fracHigh
	   STK = fracLow, exponent, details
}
	   
@Unpack1Op:
{changed when two banks were formed---
	T ← TOS LRot8{ swap bytes }			c1, at[1,10,ESCEn];}

	T ← TOS LRot8{ swap bytes},			c1, at[1,10,ESCEn];
	Q ← 7F, { exponent bias}			c2;	
	T ← T and 80, { islolate sign bit },		c3;

	T ← T LRot8, { put back in high byte }		c1;
	Rx ← TOS LRot1, { islolate exponent },		c2;	
	Rx ← Rx LRot8, { in low byte }			c3;
	
	Rx ← Rx and 0FF, { now we have exponent },	c1;
	Rx ← Rx - Q, { bias the exponent },		c2;
	TOS ← TOS and 0FF, { Mask fracta off},		c3;
	
	[] ← Rx + Q, ZeroBr, { DeNormalized? },		c1;	
	Q ← -Q, { Q ← -127. } BRANCH[$,DeNE],	c2;
	Q ← 80, { NaNExponent },			c3;
	
	[] ← Rx - Q, ZeroBr, { ? },			c1;	
	L0 ← L0.FixF0, BRANCH[$,NaNE],			c2;
	TOS ← TOS or 80, { force bit 1 } CALL[FixF],	c3;
	GOTO[EndUnp2],					c1,at[L0.FixF0,4,FixFRtn];

	
DeNE:	[] ← TOS or STK, ZeroBr,{ 0 ?} L0 ← L0.FixF1,	c3;
	TOS ← TOS and 7F,{force bit 0} BRANCH[$,Frac01],c1;	
	Rx ← Q + 1,{exp←ExpSingleMin (126)} CALL[FixF],	c2;
	
	
Frac01: T ← T or 1,{details.type ← zero},GOTO[EndUnp3],	c2;

NaNE:	[] ← TOS or STK,  ZeroBr, { all bits 0 ?}	c3;

	T ←T or 2,{details.type←infinity}BRANCH[EndUnp2,$],c1;
{Frac02:} T ←T or 3,{details.type ← nan} GOTO[EndUnp3],	c2;

{EndUnp1:Noop, 		c1;}{ Create Stack for Return }
EndUnp2:Noop, { TOS has high half }			c2;
EndUnp3:STK ← T, push, { Details }			c3,at[L0.FixF1,4,FixFRtn];
	
	STK ← Rx, push, { Exponent }			c1;
{
	STK ← TT, { low half }, IBDisp,			c2;

NextOp:	DISPNI[OpTable],				c3;}

	STK ← TT, { low half }, 			c2;
NextOp:	
	GOTO[Bank1NxtInstc1],			c3;
{       Bank ← bank0,   			c1;
	IBDisp,	GOTOBANK0[DISPNIonly],		c2;}



FixF:	{ 2 clicks. arrange fraction in TOS/TT }

	TT ← STK, { get lowhalf }			c*;
	TT ← TT LRot8, { swap bytes }			c*;
	TOS ← TOS LRot8, { swap bytes }			c*;
	Q ← TT and 0FF, { mask low byte }		c*;
	TOS ← TOS or Q, L0Disp,{ high half}		c*;
	TT ← TT and ~0FF,{ low half} DISP2[FixFRtn],	c*;



{*************************************************************************

	Special Veratec Opcode DeNormalize Esc E2

On Entry:  TOS = - # of times to shift right
	   STK = fracHigh, fracLow

On Exit:   TOS = fracHigh
	   STK = fracLow
}

{changed when two banks were formed---
@DeNorm:
	TT ← - TOS, L0 ← L0.denormop, { make count pos}	c1, at[2,10,ESCEn];}

	
	@DeNorm:
	TT ← - TOS, L0 ← L0.denormop, { make count pos},	c1, at[2,10,ESCEn];
	T ← STK, pop, { get high half }			c2;
	Q ← ~STK, { get not low half } CALL[DeNormC1],	c3;
	
{{DeNR:}	STK ← Q, { return fraclow }IBDisp,		c2, at[L0.denormop,8,DeNormRets];
	TOS ← T, { return frachigh }, DISPNI[OpTable],	c3;}
	
	STK ← Q, { return fraclow }		c2, at[L0.denormop,8,DeNormRets];
	TOS ← T, { return frachigh }, GOTO[Bank1NxtInstc1], c3;
{	Bank ← bank0,   			c1;
	IBDisp,	GOTOBANK0[DISPNIonly],		c2;}
	
	
{*******************************************************************

	Special Veratec Opcode UsualPack Esc E3
	
On Entry:  TOS = fracHigh
	   STK = fracLow, exponent, details

On Exit:   TOS = resultHigh
	   STK = resultLow
}

{changed when two banks were formed---	   
@UsualPack:
	T ← STK, pop, {fracLow}				c1, at[3,10,ESCEn];}
	
	
@UsualPack:
	T ← STK, pop, {fracLow},	c1, at[3,10,ESCEn];

	TT ← STK, pop, {exponent}			c2;
	Xbus ← STK, XDisp, { disp on details.type }	c3;
	DISP2[PackType],				c1;

{  Zero Result }

{PTzero:}	[] ← STK or 0, NegBr,				c2, at[0D,10,PackType];
	STK ← 0, BRANCH[posZ, negZ],			c3;
posZ:	TOS ← 0, GOTO[EndUPack2],			c1;
negZ:	TOS ← RRot1 1,GOTO[EndUPack2],			c1;
EndUPack2:
{	IBDisp, GOTO[NextOp],				c2;}
	GOTO[NextOp],					c2;


{ Infinite Result}

{PTinfin:}TOS ← RRot1 ~0FF, { TOS ← 7F10 }		c2, at[0E,10,PackType];
	[] ← STK or 0, NegBr,				c3;	
	STK ← 0, BRANCH[posInf, negInf],		c1;
{posInf:T ← 0, IBDisp, GOTO[PTi3],			c2;
negInf:	T ← RRot1 1, IBDisp, GOTO[PTi3],		c2;
PTi3:	TOS ← TOS or T,	 DISPNI[OpTable],		c3;}

posInf:	T ← 0, GOTO[PTi3],				c2;
negInf:	T ← RRot1 1,  GOTO[PTi3],			c2;
PTi3:	TOS ← TOS or T, GOTO[Bank1NxtInstc1],		c3;
{       Bank ← bank0,   				c1;
	IBDisp,	GOTOBANK0[DISPNIonly],			c2;}

{ NaN Result }
	
{PTnan:}	TT ← 80, {NaN Exponent } GOTO[FinishUP],	c2, at[0F,10,PackType];
	
	
{ Normal Result }

{PTnorm:}	T ← T and ~0FF, {mask fractc}			c2, at[0C,10,PackType];
	TOS ← TOS LRot8, { swap fracta, fractb}		c3;
	Q ← TOS and ~0FF { mask fractb },		c1;
	T ← T LRot8 or Q, {assemble fractb, fractc}	c2;
FinishUP:
	TOS ← TOS and 7F, {mask fracta }		c3;
	Rx ← 7F, {Exponent Bias },			c1;
	TT ← RRot1 (TT + Rx), { bias the exponent}	c2;
	TT ← TT LRot8, { arrange bits }			c3;
	TOS ← TOS or TT, {or in exponent}		c1;
	[] ← STK or 0, NegBr, { examine sign}		c2;
	Rx ← RRot1 1, BRANCH[noS,$],			c3;
	TOS ← TOS or Rx, GOTO[makeStk],			c1;
noS:	Noop,						c1;
{makeStk:STK ← T, IBDisp, GOTO[NextOp],			c2;}
makeStk:STK ← T, GOTO[NextOp],				c2;

{********************************************************************************

float a long integer

	TOS contains high order 16 bits
	STK contains low order 16 bits

*********************************************************************************}


@aFloat:
	uib ← TT,					c1, at[6,10,ESC4n];
	Q ← STK, fXpop, fZpop, push, {stack underflow?}	c2;
	T ← TOS, L1 ← L1.FpT1,				c3;

	Rx ← 158'd, {31'd + 127'd}			c1;
	TT ← 0, {in case it is positive}		c2;
	[] ← T, NegBr,					c3;

	uExp1 ← Rx,		BRANCH[floatPos,floatNeg],c1;

{note: following handles most negative number correctly by happenstance}
floatNeg:
	Q ← 0-Q, CarryBr,				c2;
	TT ← 1,			BRANCH[floatNeg1,floatNeg2],c3;

floatNeg1:
	T ← 0-T-1,		GOTO[floatPos],		c1;
floatNeg2:
	T ← 0-T,		GOTO[floatPos],		c1;

floatPos:
	uSign1 ← TT,					c2;
	uStickyBit ← 0,					c3;

	uLowHalf1 ← Q,					c1;
	uHighHalf1 ← T,		GOTO[RePackC3],		c2;


{********************************************************************************

scale a floating point number

	TOS contains integer scale
	STK and next in stack contain the floating point number

*********************************************************************************}

@aFScale:
	uib ← TT, L0 ← L0.FScale1,			c1, at[0F,10,ESC4n];
	uHighHalf2 ← TOS, {save away the integer}	c2;
	TOS ← STK, pop,					c3;

	TT ← LRot1 TOS, 				c1;
	Q ← 377'b, L1 ← L1.FpT1.5,			c2;
	CALL[Unpack1X],					c3;

	T ← uHighHalf2, {the integer}		c2, at[L0.FScale1,10,UnpackRets];
	
	Rx ← LShift1(200'd), {400'd}			c3;
	
	[] ← T+Rx, NegBr,				c1;
	[] ← T-Rx, NegBr,	BRANCH[$, FScaleOver3],	c2;
	TT ← uExp1,		BRANCH[FScaleOver1, $],	c3;

	T ← TT + T,					c1;
	uExp1 ← T,		GOTO[RePackC3],		c2;
 
 FScaleOver3:
 			CANCELBR[$],			c3;
 	[] ← T, NegBr,		GOTO[FScaleOverA],	c1;
 
 FScaleOver1:
 	[] ← T, NegBr,		GOTO[FScaleOverA],	c1;
 
 FScaleOverA:
 	Rx ← LShift1(Rx),	BRANCH[FScaleOverPl,FScaleOverMn],c2;
 FScaleOverPl:
 				GOTO[FScaleOverB],	c3;
 FScaleOverMn:
 	Rx ← -Rx,		GOTO[FScaleOverB],	c3;
 
 {if argument is non zero, force appropriate over or under flow}
 FScaleOverB:
 	uExp1 ← Rx,		GOTO[RePackC2],		c1;

			{END}