{File name:  LispFPTSpec.mc
Last edited by cal         27-Dec-83 17:06:07 
Last edited by Sturgis  15-Sep-83 16:40:30 
 Descrition: Floating point code for Lisp {modified from Cedar fpt code}
Created by H. Sturgis 
}

{********************************************************************
All LISP Floating Point Opcodes have two arguments,
so all the opcodes will flow through common code which
will verify the two arguments are Floating Point numbers,
and set up for the actual execution.
}

	{
	save TOS and TOSH
	before ReMap, set L1 _ L1.fixFV, set L3 _ L3.FloatArg2
	verify FloatpType
	fetch and unpack to Arg2 U registers
		{may page fault}
	set L3 _ L3.FloatArg1
	read [S] and [S - 1]
	verify FloatpType
	fetch and unpack to Arg1 U registers
		{may page fault}
	{Opcode dependent execution}
		{goto ufnZ if want to trap}
	pack result, box result
	return
	}


{	put the 32 bits into some fixed place
	find type and verify that it is a Fpt
	mapping the Fpt may fault -- be prepared!
	get the 32 bit value to a fixed place
	return
	}

@FPLUS2:	opcode[350'b],
	uTOS _ TT _ TOS, CALL[FptPrep],{L2 _ 10'b}	c1;

@FDIFFERENCE:	opcode[351'b],
	uTOS _ TT _ TOS, CALL[FptPrep],{L2 _ 11'b}	c1;

@FTIMES2:	opcode[352'b],
	uTOS _ TT _ TOS, CALL[FptPrep],{L2 _ 12'b}	c1;

@FQUOTIENT:	opcode[353'b],
	uTOS _ TT _ TOS, CALL[FptPrep],{L2 _ 13'b}	c1;

@FGREATERP:	opcode[362'b],
	uTOS _ TT _ TOS, CALL[FptPrep], L2 _ L2.FptCmp,	c1;

FptPrep:
	uTOSH _ Rx _ TOSH, L3 _ L3.FptArg2,	c2;

	CALL[FptUnpack],	c3;

	uExp2 _ Rx, ZeroBr,	c3, at[L3.FptArg2, 10, FptUnpackRet];

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

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

Unpack2A:
	TOS _ TOS LRot8,	c1;
	Q _ ~377'b,	c2;
	uLowHalf2 _ TOS and Q,	c3;

	TOS _ TOS and 377'b,	c1;
	TT _ (TT LRot8 ) and Q,	c2;
	Ybus _ Rx, ZeroBr, {test for zero exponent again}	c3;

	uHighHalf2 _ TOS or TT, BRANCH[UP2A, $],	c1;
	TOS _ TOS or TT,	c2;
	TOS _ TOS or uLowHalf2,	c3;

	Ybus _ TOS, NZeroBr,	c1;
UP2A:	BRANCH[$, FprepufnB3],	c2;
	,	c3;
	
	MAR _ [rhS, S + 0],	c1;
	L3 _ L3.FptArg1,	c2;
	TT _ MD,	c3;
	
	MAR _ [rhS, S - 1],	c1;
	CANCELBR[$, 2],	c2;
	Rx _ MD, CALL[FptUnpack],	c3;

	uExp1 _ Rx, ZeroBr,	c3, at[L3.FptArg1, 10, FptUnpackRet];

	Ybus _ Rx xor Q, ZeroBr, BRANCH[$, UP1ZeroE1],	c1;
	uSign1 _ TT, BRANCH[$, FprepufnC3],	c2;
	TT _ TOSH or 200'b, {implicit leading 1 bit} GOTO[Unpack1A],	c3;

UP1ZeroE1:
	uSign1 _ TT, CANCELBR[$],	c2;
	TT _ TOSH and 177'b, {force leading bit to be 0}	c3;

Unpack1A:
	TOS _ TOS LRot8,	c1;
	Q _ ~377'b,	c2;
	uLowHalf1 _ TOS and Q,	c3;

	TOS _ TOS and 377'b,	c1;
	TT _ (TT LRot8 ) and Q,	c2;
	Ybus _ Rx, ZeroBr, {test for zero exponent again}	c3;

	uHighHalf1 _ TOS or TT, BRANCH[UP1A, $],	c1;
	TOS _ TOS or TT,	c2;
	TOS _ TOS or uLowHalf1,	c3;

	Ybus _ TOS, NZeroBr,	c1;
UP1A:
	BRANCH[$, FprepufnD3],	c2;
	L2Disp,	c3;

	RET[FptPrepRet],	c1;

{	FptUnpack Subroutine	}
	{on entry:
	    Rx holds high
	    TT holds low
	 on exit:
	     TOSH holds high
	     TOS holds low
	     TT holds sign
	     Rx holds exponent
	     Q holds 0FF
	 will page fault if page holding Fpt value not resident
	 }

FptUnpack:
	MAR _ Q _ [TT, Rx + 0],	c1;{not mem ref, byte merge}
	rhTT _ Rx LRot0, 	c2;
	Rx _ Q, rhRx _ MDSTYPEspaceReal,	c3;

	Rx _ Rx LRot8,	c1;
	Rx _ Rx RShift1, SE_1, 	c2;
	,	c3;

	MAR _ [rhRx, Rx], Rx _ FloatpType + 0,	c1;
	,	c2;
	Q _ MD xor Rx,	c3;

	,	c1;
	Ybus _ Q - 1, PgCarryBr,	c2;
	Q _ 0FF, BRANCH[$, FptNotFpt],	c3;

	Map _ [rhTT,TT], L0 _ L0.xRedoFpt,	c1;
	L1 _ L1.fixFV, 	c2;
	Rx _ rhRx _ MD, XRefBr,	c3;

	MAR _ [rhRx, TT + 0], BRANCH[FptRemap, $],	c1, at[L0.xRedoFpt, 10, RxMapFixCaller];
	,	c2;
	TOSH _ MD,	c3;

	MAR _ [rhRx, TT + 1],	c1;
	TT _ LRot1 TOSH, CANCELBR[$, 2],	c2;
	TOS _ MD,	c3;

	Rx _ TT LRot8 and Q, {exponent}, L3Disp,	c1;
	TT _ TT and 1, {the sign bit} RET[FptUnpackRet],	c2;

FptRemap:
	CALL[RLxMapFix],	c2;



{****************************************************************************
 
  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 * 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>		
  
}

{****************************************************************************
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;
	Ybus _ 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;
	Ybus _ TT, NegBr,					c3;

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

NormLoop:
	Ybus _ 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;
	Ybus _ TT + Rx, NegBr,				c3;

	Rx _ 1,  BRANCH[$, VeryLowExp],			c1;
	Q _ ~Q, {to allow for complementing on right shifts}		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}

VeryLowExp: GOTO[FPTrapsC3],				c2;

{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;}
{*********************}

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

	TT _ TT - 3, {normed wants TT to hold nominal exponent - 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:	CANCELBR[$],	c3;

	,					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:
	Ybus _ uStickyBit, NZeroBr,	c2;
	Rx _ 377'b, BRANCH[RoundA, RoundB],	c3;

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

RoundC:	Ybus _ 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;
	Ybus _ Q and Rx, ZeroBr,	c3;

	Rx _ LShift1 200'b, SE _ 0, BRANCH[RoundExit2, $],	c1; 
	Q _ Q and ~ Rx {Q[7] _ 0}, GOTO[RoundExit],	c2;

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

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

RoundExit2A:  GOTO[RoundExit],	c2;

RoundExit1: 	{delay}	c1;
RoundExit2:	,	c2;
RoundExit: 	,	c3;


{now  we check for overflow  and underflow}

	TT _ TT+3,	c1;
	Rx _ 376'b,	c2;
	Ybus _ Rx-TT, NegBr, {branches if TT >= 377'b}			c3;

	Ybus _ TT, ZeroBr, BRANCH[$, FPTrapsC2], {overflow}		c1;
	BRANCH[finalPack, FPTrapsC3], {underflow}			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: {and prepare for entry to CCSubr }
	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;
	uNewValLo _ 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, L1 _ L1.fixFV,	c1;
	uNewValHi _ TOS, L3 _ L3.FptArg1{fpt},	c2;
	Q _ LS4FptType, GOTO[CCSubr],	c3;

{	return from compare: 
	TOS =    0  =>  args equal
	TOS = +KTval  =>  arg1 bigger
	TOS =   0  =>  arg2 bigger
}

cmpExit3: {result not Floating point, no need to create cell }
	TOSH _ 0,	c3;

	S _ S - 2, L2 _ L2.0,	c1;
	PC _ PC + PC16, IBDisp,	c2;
	DISPNI[OpTable], L2 _ L2.0,	c3;



FPTufn:	{early debugging exit}
	GOTO[ufnX3],	c2;

FptNotFpt:	{one or more non-FloatType arg}
	GOTO[ufnZ2],	c1;

FprepufnA3:
	GOTO[ufnZ1],	c3;

FprepufnB3:
	GOTO[ufnZ1],	c3;

FprepufnC3:
	GOTO[ufnZ1],	c3;

FprepufnD3:
	GOTO[ufnZ1],	c3;

inexactTrap: GOTO[FPTrapsC2],				c1;
	
FPTrapsC2:	CANCELBR[ufnZ3],	c2;

FPTrapsC3:	GOTO[ufnZ1],	c3;

	{ E N D }