:TITLE[MesaFP];	*DO MESA FLOATING POINT by Jim Boyce

%Edit by Ed Fiala 20 March 1981: put in Pilot conditionals; bum 2
registers.
%

%Floating point numbers are represented in two different formats.  Arguments
on the stack are IEEE single precision reals with the following format:
	bit 0	sign (1 means negative)
	1:8	exponent biased by 127
		(exponent of 0 with a fraction of 0 is true 0;
		 exponent of 0 with non-0 fraction is denormalized;
		 exponent of 377 with a fraction of 0 is infinity;
		 exponent of 377 with non-0 fraction is Not-A-Number)
	9:31	fraction
		(implicitly preceded by '1.' if non-0 and normalized.)
These numbers appear on the stack with the word holding bits 0-15 nearer to
the top of stack.  Most operations unpack the operands into a format that is
easier to work with.  This format uses four words interpreted as follows:
	Sign	bit 0 is the sign, bits 1-15 are undefined.
	Exp	exponent (Biased by 127)
	Frac	The fraction.  When unpacked, the leading one appears in
		Frac[1]; when about to be packed again, the leading bit is in
		Frac[0],  Frac[37] is always a StickyBit (the inclusive or of
		all the remaining bits).  
	FracH	16 high order bits of Frac.
	FracL	16 low order bits of Frac.

Twelve registers hold three floating point numbers in unpacked form.  Two of
the numbers hold arguments and have registers names with 1's or 2's in them.
The other is a number called Temp.  Numbers are usually referred to by index
(SB or DB).  Arg1 has index 2, Arg2 - 3, and Temp - 0.
%

:IF[AltoMode]; ********************************************
*xfMY is available; could make xfOTPReg available by using MNBR the
*way the Pilot conditionals use it.
RV[Sign,IP[zBuf]];	RV[Exp,IP[xBuf]];	RV[FracH,IP[yBuf]];	RV[FracL,64];
RV[TSign,IP[zBuf]];	RV[TExp,IP[xBuf]];	RV[TFracH,IP[yBuf]];	RV[TFracL,64];
RV[Sign1,IP[zBuf2]];	RV[Exp1,IP[xBuf2]];	RV[Frac1H,IP[yBuf2]];	RV[Frac1L,66];
RV[Sign2,IP[zBuf3]];	RV[Exp2,IP[xBuf3]];	RV[Frac2H,IP[yBuf3]];	RV[Frac2L,67];

RV[FracLL,IP[xfMX]];		*Low order word in fraction, Used by Unnorm,
				*(RoundCard), and Multiply.
RV[Sticky,75];			*Bit 0 InexactResultTrapEnable
				*Bit 15 'Has InexactResult happened?'.
RV[FlCode,IP[xfXTPreg]];	*Used to control program flow ('computed GoTos')
RV[CCTemp1,IP[yBuf1]];
RV[CCTemp2,IP[xBuf1]];		*Used only in Unnorm.
RV[LoopCount,IP[yBuf1]];	*Used by Multiply and Divide.
RV[FPTemp1,IP[zBuf1]];		*Used to control Unnorm.
RV[FPTemp2,IP[xBuf1]];		*Used to set DB, SB, and StkP, throughout.

*431b mi including the two Misc alpha-byte dispatch locations overwritten
*in MesaX.  Placement is primarily on page 16 (reserving 23 locations for the
*kernel code which might be present) with the rest on page 17.
Set[FlPage0,16];	*357b mi (not pages 4 to 7)
  Loca[UnnormDisp,FlPage0,40];
  Loca[UnpackRet,FlPage0,60];
  Loca[RoundDisp,FlPage0,100];
  Loca[FixDisp,FlPage0,120];
  Loca[UnnormRet,FlPage0,140];
Set[FlPage3,17];	*  4b mi
Set[FlPage4,17];	* 25b mi
Set[FlPage5,16];	* 12b mi
Set[FlPage6,16];	*  3b mi
Set[FlPage7,17];	*  2b mi
:ELSE; ****************************************************
RV[Sign,70];	RV[Exp,44];	RV[FracH,50];	RV[FracL,64];
RV[TSign,70];	RV[TExp,44];	RV[TFracH,50];	RV[TFracL,64];
RV[Sign1,72];	RV[Exp1,46];	RV[Frac1H,52];	RV[Frac1L,66];
RV[Sign2,73];	RV[Exp2,47];	RV[Frac2H,53];	RV[Frac2L,67];

RV[FracLL,56];		*Low order word in fraction, Used by Unnorm,
			*(RoundCard), and Multiply.
RV[Sticky,65];		*Bit0 InexactResultTrapEnable
			*Bit15 'Has InexactResult happened?'.
RV[FlCode,57];		*Used to control 'computed GoTos'
RV[CCTemp1,71];		*Used only in Unnorm.
RV[CCTemp2,17];		*Used only in Unnorm.
RV[LoopCount,71];	*Used by Multiply and Divide.
RV[FPTemp1,45];		*Used to control Unnorm.
RV[FPTemp2,17];		*Used to set DB, SB, and StkP, throughout.

*433b mi placed primarily on page 1 with the rest on page 4.
Set[FlPage0,1];		*361b mi (not pages 4 to 7)
  Loca[UnnormDisp,FlPage0,40];
  Loca[UnpackRet,FlPage0,60];
  Loca[RoundDisp,FlPage0,100];
  Loca[FixDisp,FlPage0,120];
  Loca[UnnormRet,FlPage0,140];
Set[FlPage3,13];	*  4b mi
Set[FlPage4,13];	* 25b mi
Set[FlPage5,1];		* 12b mi
Set[FlPage6,1];		*  3b mi
Set[FlPage7,1];		*  2b mi
:ENDIF; ***************************************************

%Coding conventions.

Misc bytecodes with alpha in [20b to 37b] are floating point
operations.  The 1st mi below is the Misc dispatch table entry for
alpha in this range.  For Alto Mesa, alpha is saved in xfOTPReg,
where it is the trap parameter if the FP operation traps; for Cedar
MNBR holds alpha and 400b+alpha determines the trap dispatch.  T is
loaded with 30b, which will be stored in SALUF as the A + A + Cy0
ALU operation.

Two different subroutine linkages are used in this code.  Call[] and Return
is used for bottom level subroutines.  The other linkage, GoTo[] and
Dispatch[FlCode,,], where FlCode holds an 8-bit number encoding various
return addresses, is used for several long routines.  The return mi appears
where one would expect it, with an At[] to place it properly in RAM.
%

:IF[AltoMode]; ********************************************
*Overwrite the two MISC dispatch mi to setup the branch to this code.
Set[FlPntLoc,Add[MiscDisp0,17]];
	xfOTPReg _ T, LoadPage[FlPage0], At[MiscDisp0,1];
	Dispatch[RTemp,14,4], At[FlPntLoc];
OnPage[FlPage0];
:ELSE; ****************************************************
	LoadPage[FlPage0], At[MiscDisp0,1];
	MNBR _ RTemp;	*MNBR not smashed by BBFB
OnPage[FlPage0];
	Dispatch[RTemp,14,4];
:ENDIF; ***************************************************
	T _ 30C, Disp[.+1];

	FlCode _  0C, GoTo[Unpack], DispTable[20];	*FAdd
	FlCode _ 76C, GoTo[Unpack];			*FSub
	FlCode _ 2C, GoTo[Unpack];			*FMul
	FlCode _ 4C, GoTo[Unpack];			*FDiv
	FlCode _ 14C, GoTo[Unpack];			*FComp
	FlCode _ 31000C, GoTo[FixA];			*Fix
	SALUF _ T, GoTo[Float];				*Float
	FlCode _ 32400C, GoTo[FixA];			*FixI
	FlCode _ 35000C, GoTo[FixA];			*FixC
	T _ Sticky, LoadPage[FlPage4], GoTo[FSticky];	*FSticky
	T _ SStkP, GoTo[FloatTrp1];			*FRem not implemented
	FlCode _ 21000C, GoTo[FixA];			*Round
	FlCode _ 22400C, GoTo[FixA];			*RoundI
	FlCode _ 25000C, GoTo[FixA];			*RoundC
	T _ SStkP, GoTo[FloatTrp1];			*SetS not implemented
	T _ SStkP, GoTo[FloatTrp1];			*Not implemented

*One mi subroutines

SetSALUF:
	SALUF _ T, Return;

SetSB:	SB _ FPTemp2;
	BBFBX, Return;

SetSBSign:
	SB[Sign] _ T,  Return;

SetSBFracH:
	SB[FracH] _ T, Return;

SetSBFracL:
	SB[FracL] _ T, Return;

SetSBExp:
	SB[Exp] _ T, Return;

%Floating Point number conversions.

Entries are Unpack, Pack0, Pack0A, and Renorm.

Unpack pops arguments off of the stack and unpacks them into Arg1 and Arg2.
The argument at the top of the stack is put in Arg1.  (Note that the single
argument of a monadic operation is put in Arg2 (!?).)  FlCode is used to
distinguish between single- and double-argument operations.  Unpack acts as a
filter, traping to MesaCode on arguments that the microcode cannot handle--
Unnormalized numbers, Infinities, and NotANumbers.

Pack0 pushes a Zero of the appropriate sign onto the stack.

Renorm Rightshifts the fraction SB[FracH],,SB[FracL] until SB[FracH][0] is a
onebit.  It subtracts the number of positions shifted from SB[Exp].  Then it
performs range checks and pushes a number onto the stack.
%
OnPage[FlPage0];

Unpack:	FPTemp2 _ 60C, Call[SetSALUF];	*Select arg 2
UnpackA:
	T _ Stack, Call[SetSB];
	SB[FracH] _ 40000C, Call[SetSBSign];
	T _ LdF[Stack,1,10];
	SB[Exp] _ T;
	T _ LSh[Stack&-1,7], GoTo[Non0,ALU#0];
	  T _ (Stack&-1) or T;
	  SB[FracH] _ T, GoTo[DenormTrap,ALU#0];
	  SB[FracL] _ T, GoTo[UnpackB];
Non0:	LU _ (SB[Exp]) xor (377C);
	T _ (RSh[Stack,11]) or T, GoTo[NaNTrap,ALU=0];
	SB[FracH] _ (SB[FracH]) or T;
	SB[FracH] _ (SB[FracH]) and not (100000C);
	T _ LSh[Stack&-1,7], Call[SetSBFracL];
UnpackB:
	FlCode _ (FlCode) + 1, Skip[R Odd];
	  FPTemp2 _ (FPTemp2) - 1, GoTo[UnpackA];	*Select arg 1
	Dispatch[FlCode,14,3];
	T _ SB[FracH], Disp[@UnpackRet];


Pack0:	T _ (SB[Sign]) and (100000C), GoToP[.+1];
OnPage[FlPage4];
	Stack&+1 _ 0C, GoTo[PackA];

OnPage[FlPage0];
NormStep:
	SB[Exp] _ (SB[Exp]) - 1;
	SB[FracL] _ (SB[FracL]) SALUFOp T, Task;
	SB[FracH] _ (SB[FracH]) SALUFOp T, UseCoutAsCin;
ReNorm:	SB[FracH], GoTo[NormStep,R>=0];
	Call[NoRound];			***This is a noop for tasking
*Pack non-0 begins here
	LU _ (SB[FracL]) and (177C), Call[RoundFrac];
	LU _ (SB[Exp]) - 1;
	LU _ (SB[Exp]) - (377C), GoTo[UnderFlowTrap,ALU<0];
	T _ RSh[SB[FracL],10], GoTo[OverFlowTrap,ALU>=0];
	T _ (LSh[SB[FracH],10]) or T;
	Stack&+1 _ T, LoadPage[FlPage4];
	T _ LdF[SB[FracH],1,7];
OnPage[FlPage4];
	T _ (LSh[SB[Exp],7]) or T;
	LU _ SB[Sign];
PackA:	Stack&+1 _ T, LoadPageExternal[opPage3], Skip[ALU>=0];
	  Stack _ (Stack) or (100000C), GoToExternal[P7TailLoc];
NormRetx:
	GoToExternal[P7TailLoc];

%Shifting Fractions.

Entry is Unnorm.

Unnorm leftshifts the fraction DB[FracH],,DB[FracL],,FracLL by FPTemp1
positions.  FracLL[15] is treated as a StickyBit.  FracLL is assumed to be
Zero on entry.  The first part of the code reaches a point from which the
result can be reached by swapping words without any more shifts.  Then the
swaps are performed.
%

OnPage[FlPage0];
GetCC1:	CycleControl _ CCTemp1, Return;
GetCC2:	CycleControl _ CCTemp2, Return;

Unnorm:	T _ (LdF[FPTemp1,14,4]) - 1, Call[NoRound];
	CCTemp1 _ T, BBFBX;
	CCTemp1 _ (CCTemp1) and (17C), Skip[ALU>=0];
	  FracLL _ 0C, Goto[Unnorm0];
	CCTemp2 _ 16C;
	CCTemp2 _ (CCTemp2) - T, Call[GetCC1];
	T _ WFA[DB[FracL]];
	FracLL _ T, Call[GetCC2];
	DB[FracL] _ RF[DB[FracL]], Call[GetCC1];
	T _ WFA[DB[FracH]];
	DB[FracL] _ (DB[FracL]) or T, Call[GetCC2];
	DB[FracH] _ RF[DB[FracH]];
Unnorm0:
	LU _ LdF[FPTemp1,10,2];
	Dispatch[FPTemp1,12,2], Skip[ALU#0];
	  T _ DB[FracL], Disp[@UnnormDisp];
	FracLL _ 1C, GoTo[UnnormL];

	LU _ FracLL, LoadPage[FlPage6], At[UnnormDisp,1];	*Shift 1 word
	FracLL _ T, SkipP[ALU=0];
OnPage[FlPage6];
	  FracLL _ (FracLL) or (1C);
	T _ DB[FracH], LoadPage[FlPage0];
	DB[FracL] _ T, GoToP[UnnormH];

	LU _ (FracLL) or T, At[UnnormDisp,2];	*Shift 2 words
	T _ DB[FracH], FreezeResult;
	FracLL _ T, GoTo[UnnormL,ALU=0];
	FracLL _ (FracLL) or (1C), GoTo[UnnormL];

UnnormLL:
	FracLL _ 1C, At[UnnormDisp,3];		*Shift more than 2 words
UnnormL:
	DB[FracL] _ 0C;
UnnormH:
	DB[FracH] _ 0C, CallX[CNoRound], At[UnnormDisp,17];
@UnnormDisp:
	Dispatch[FlCode,12,2], At[UnnormDisp,0];	*No more shifting
	T _ FracLL, Disp[@UnnormRet];

%Rounding, Negation, and FloatTrap.

Rounding happens at a particular position using the following bits to
determine the direction of rounding.  If the rounding bits are all Zero, then
the result is exact, and no rounding takes place.  Otherwise, round to the
nearer representable number.  If the rounding bits put the number exactly
halfway between two possible results, round to the one with a Zero in the
rounding position.

RoundFrac rounds SB[FracH],,SB[FracL] at SB[FracL][7] using SB[FracL][10:17]
as rounding bits.  (The actual add occurs at SB[FracL][10] to simplify the
tests.)

RoundCard rounds SB[FracH],,SB[FracL] at SB[FracL][17] using FracLL[0:17] as
rounding bits.

NegFrac performs a 2's complement negation on SB[FracH],,SB[FracL].

Entries are RoundFrac, RoundCard, NegFrac, and CNoRound.
%
OnPage[FlPage0];
RoundFrac:
	Dispatch[SB[FracL],7,3], GoTo[FRoundUp,ALU#0];
	T _ SB[Sign], Disp[NoRound];
NoRound:
	Return, At[RoundDisp,0];
FRoundUp:
	T _ SB[Sign];
	SB[FracL] _ (SB[FracL]) + (200C), At[RoundDisp,6];
RoundUp1:
	SB[FracH] _ (SB[FracH]) + 1, UseCoutAsCin;
	SB[Exp] _ (SB[Exp]) + 1, UseCoutAsCin, Skip[Carry'];
	  SB[FracH] _ 100000C;
	Sticky, DblGoTo[InexactTrap,InexactNoTrap,R<0], At[RoundDisp,2];
	Return, At[RoundDisp,4];
CRoundUp:
	SB[FracL] _ (SB[FracL]) + 1, GoTo[RoundUp1];
CRoundDown:
	Sticky, DblGoTo[InexactTrap,InexactNoTrap,R<0];
InexactNoTrap:
	Sticky _ (Sticky) or (1C), GoTo[SetSBSign];

RoundCard:
	LU _ (FracLL) and not (100000C), GoTo[CNoRound,ALU=0];
	T _ SB[Sign], Skip[ALU=0];
	  FracLL, DblGoTo[CRoundUp,CRoundDown,R<0];
	SB[FracL], DblGoTo[CRoundUp,CRoundDown,R Odd];

NegFrac:
	SB[FracL] _ (SB[FracL]) xnor (0C);
	SB[FracH] _ (SB[FracH]) xnor (0C);
	SB[FracL] _ (SB[FracL]) + 1;
CNoRound:
	SB[FracH] _ (SB[FracH]) + 1, UseCoutAsCin, Return;

%For Alto Mesa, FloatTrap et al. store alpha in OTPReg, set T to
sFloatingPoint, and go to Kfcr which traps to MesaCode to try again
on this operation.  For Cedar Mesa, the parameter is 400 + alpha.
%
OnPage[FlPage0];
UnderFlowTrap:
	T _ SStkP, GoTo[FloatTrp1];
OverFlowTrap:
	T _ SStkP, GoTo[FloatTrp1];
InexactTrap:
	T _ SStkP, GoTo[FloatTrp1];
FixTrapA:
	T _ SStkP, GoTo[FloatTrp1];
FixTrapB:
	T _ SStkP, GoTo[FloatTrp1];
FixTrap:
	T _ SStkP, GoTo[FloatTrp1];
NaNTrap:
	T _ SStkP, GoTo[FloatTrp1];
DenormTrap:
	T _ SStkP, GoTo[FloatTrp1];
FloatTrap:
	T _ SStkP;
FloatTrp1:
	FPTemp2 _ T, Task;
	StkP _ FPTemp2;
:IF[AltoMode]; ********************************************
	LoadPageExternal[opPage3];
	T _ sFloatingPoint, GoToExternal[kfcrLoc];
:ELSE; ****************************************************
	T _ MNBR;
	RTemp _ T, LoadPage[opPage0];
	RTemp _ (RTemp) + (400C), GoToP[UndefTrap];	*400 + alpha
:ENDIF; ***************************************************

%Addition and subtraction are almost the same.  
 1) Unpack the arguments, Negate Arg2 if subtract, Check for Zero arguments.
 2) Determine which (if either) argument to shift.  Set DB gets that and SB
gets the other.
 3) Unnormalize the DB fraction.
 4) Add or subtract magnitudes, depending on the signs.
 5) Renormalize the result, push it on the stack and go on to the next operation.
%
@UnpackRet:
	Sign2 _ (Sign2) xor (100000C), At[UnpackRet,0];
	LU _ (Frac2H) and T, LoadPage[FlPage7], At[UnpackRet,1];
	T _  Exp2, LoadPage[FlPage3], GoToP[Add0,ALU=0];
OnPage[FlPage7];
	T _ (Exp1) - T, LoadPage[FlPage0];
OnPage[FlPage3];
	FPTemp1 _ T, GoToP[.+3,ALU<0];
OnPage[FlPage0];
	  FPTemp2 _ (SB _ FPTemp2) + 1;
	  DB _ FPTemp2, GoTo[Unnorm];
	FPTemp2 _ (DB _ FPTemp2) + 1, Call[SetSB];
	FPTemp1 _ (Zero) - T, GoTo[Unnorm];


@UnnormRet:
	T _ SB[Sign], Skip[ALU=0], At[UnnormRet,0];
	  DB[FracL] _ (DB[FracL]) or (1C);
	SB[Exp] _ (SB[Exp]) + 1;
	LU _ (DB[Sign]) xor T;
	T _ DB[FracL], DblGoToP[SubFrac,AddFrac,ALU<0];

*The signs are equal;  add the fractions.  DB[FracL] is in T.
AddFrac:
	SB[FracL] _ (SB[FracL]) + T;
	T _ DB[FracH], FreezeResult;
	SB[FracH] _ (SB[FracH]) + T, UseCoutAsCin, GoTo[Renorm];

*The signs are different;  subtract the fractions.  DB[FracL] is in T.
SubFrac:
	SB[FracL] _ (SB[FracL]) - T;
	T _ DB[FracH], FreezeResult;
	SB[FracH] _ T _ (SB[FracH]) - T, UseCoutAsCin;
	LU _ (SB[FracL]) or T, GoTo[SubNeg,ALU<0];
SubNonNeg:
	GoTo[Sub0,ALU=0];
	GoTo[Renorm];

SubNeg:	SB[Sign] _ (SB[Sign]) xnor (0C), Call[NegFrac];
  	GoTo[ReNorm];

Sub0:	SB[Sign] _ T, LoadPage[FlPage4], GoTo[Pack0];

%Floating multiply.

 1) Unpack arguments, and check for Zero arguments.
 2) Set sign and exponent of the result.
 3) Shift arguments into position for a shift and add loop.
 4) Perform the shift and add loop.
 5) Renormalize and push result.
%
@FMul:	LU _ (Frac2H) and T, At[UnpackRet,2];
Mul0Test:
	T _ Sign2, GoTo[Mul0,ALU=0];
	FPTemp2 _ 0C, Call[SetSB];
	T _ (Sign1) xor T, Call[SetSBSign];
	T _ LSh[Frac2H,11];
	Frac2L _ (RSh[Frac2L,7]) or T;
	FracLL _ T _ 0C, Call[SetSBFracH];
	Frac2H _ RSh[Frac2H,7], Call[SetSBFracL];
	T _ Exp2;
	T _ (Exp1) + T;
	LoopCount _ 16C, Call[SetSBExp];
	SB[Exp] _ (SB[Exp]) - (176C), GoTo[MulLoop];

MulRet:	LU _ LHMask[SB[FracH]];
	T _ Frac1L, GoTo[MulDone,ALU#0];
	LoopCount _ 7C;
	Frac1H _ T, GoTo[MShift];

MulDone:
	LU _ FracLL;
MulDone1:
	GoToP[Renorm,ALU=0];
	SB[FracL] _ (SB[FracL]) or (1C), GoTo[Renorm];

MAdd:	T _ Frac2L;
	FracLL _ (FracLL) + T;
	T _ Frac2H, FreezeResult;
	TFracL _ (TFracL) + T, UseCoutAsCin, Task;
	TFracH _ (TFracH) + 1, UseCoutAsCin;
MulTest:
	LoopCount _ (LoopCount) - 1, GoTo[MulRet,R<0];
MShift:	FracLL _ (FracLL) SALUFOp T;
	TFracL  _ (TFracL)  SALUFOp T, UseCoutAsCin, Task;
	TFracH  _ (TFracH)  SALUFOp T, UseCoutAsCin;
MulLoop:
	Frac1H _ (Frac1H) SALUFOp T, DblGoTo[MAdd,MulTest,R<0];

%Floating point division.

 1) Unpack arguments, and check for Zero arguments.
 2) Set sign and exponent of the result.
 3) Shift arguments into position for a shift and subtract loop.
 4) Perform the shift and subtract loop.
 5) Renormalize and push result.
%
@FDiv:	LU _ (Frac2H) and T, At[UnpackRet,3];
	T _ Sign2, GoTo[Div0,ALU=0];
	FPTemp2 _ 0C, Call[SetSB];
	T _ (Sign1) xor T, Call[SetSBSign];
	SB[FracL] _ T _ 1C, Call[SetSBFracH];
	T _ (Exp2) - (177C);
	T _ (Exp1) - T;
	LoopCount _ 16C, Call[SetSBExp];
*Loop here
	LU _ (SB[FracL]) and (1C);
	T _ Frac2L, DblGoTo[DivSub,DivAdd,ALU#0];

DivSub:	Frac1L _ (Frac1L) - T, LoadPage[FlPage5];
	T _ Frac2H, FreezeResult;
OnPage[FlPage5];
	Frac1H _ (Frac1H) - T, UseCoutAsCin, GoTo[DivAnsBit];

OnPage[FlPage0];
DivAdd:	Frac1L _ (Frac1L) + T, LoadPage[FlPage5];
	T _ Frac2H, FreezeResult;
OnPage[FlPage5];
	Frac1H _ (Frac1H) + T, UseCoutAsCin;
DivAnsBit:
	SB[FracL] _ (SB[FracL]) SALUFOp T, UseCoutAsCin;
	LoopCount _ (LoopCount) - 1, GoTo[DivShift,R>=0];
	  LU _ LHMask[SB[FracH]];
	  T _ SB[FracL], LoadPage[FlPage0], GoTo[DivFinish,ALU#0];
	  SB[FracH] _ T, LoadPage[FlPage5];
OnPage[FlPage0];
	  LoopCount _ 10C;
OnPage[FlPage5];
DivShift:
	Frac1L _ (Frac1L) SALUFOp T;
	Frac1H _ (Frac1H) SALUFOp T, UseCoutAsCin, Return;

DivFinish:
	SB[FracL] _ LSh[SB[FracL],6], SkipP[R Even];
OnPage[FlPage0];
	  T _ Frac1H, GoTo[DivMore1];
	T _ Frac2L;
	Frac1L _ (Frac1L) + T;
	T _ Frac2H, FreezeResult, Task;
	T _ (Frac1H) + T, UseCoutAsCin;
DivMore1:
	LU _ (Frac1L) or T, GoTo[MulDone1];

%Arithmetic with Zeroes.

Add (subtract).  If one argument is 0, return the other.  If both are 0,
return 0 (negative 0 if both arguments are negative 0.)

Divide.  If denominator is 0, trap to MesaCode.

Multiply.  Return 0 of the appropriate sign.

Otherwise, do as with multiply.
%

OnPage[FlPage7];
Add0:	LU _ Frac1H, GoToP[.+1];
OnPage[FlPage3];
	LU _ Frac2H, LoadPage[FlPage4], Skip[ALU=0];
	  Stack&+2, GoToP[NormReturn];
	T _ Sign2, LoadPage[FlPage0], SkipP[ALU#0];
OnPage[FlPage4];
	  Sign1 _ (Sign1) and T, LoadPage[FlPage4], GoToP[Pack0];
AddArg10:
	FPTemp2 _ 60C, GoToP[.+1];
OnPage[FlPage0];
	SB _ FPTemp2;
	Exp2 _ (Exp2) + 1, BBFBX, GoTo[Renorm];

Div0:	LU _ (Frac2H) and (40000C);
	T _ 0C, DblGoTo[FloatTrap,Mul0Test,ALU=0];

Mul0:	Sign1 _ (Sign1) xor T, LoadPage[FlPage4], GoTo[Pack0];

%Floating Comparison.
Returns INTEGER -1 if arg1<arg2, 0 if arg1=arg2, and 1 if arg1>arg2
%
@FComp:	T _ Sign1, Task, At[UnpackRet,7];
	Stack&+3;
	LU _ (Sign2) xor T;
	T _ Stack&-2, LoadPage[FlPage4], GoTo[CompDiffSign,ALU<0];
	LU _ (Stack&+3) - T;
OnPage[FlPage4];
	T _ Stack&-2, FreezeResult;
	T _ (Stack&-1) - T, UseCoutAsCin, GoTo[CompNon0Test,ALU#0];
Comp0Test:
	Stack _ T, FreezeResult, Skip[ALU#0];
NormReturn:
	  LoadPageExternal[opPage3], GoTo[NormRetx];
	Sign2 _ (Sign2) xnor (0C), DblGoTo[.+3,.+2,Carry'];
CompNon0Test:
	Sign2 _ (Sign2) xnor (0C), Skip[Carry'];
	  Sign1, LoadPageExternal[opPage3], DblGoTo[CompL,CompG,R<0];
	  Sign2, LoadPageExternal[opPage3], DblGoTo[CompL,CompG,R<0];

CompG:	Stack _ 1C, GoToExternal[P7TailLoc];
CompL:	Stack _ (Stack) or not (0C), GoToExternal[P7TailLoc];

OnPage[FlPage0];
CompDiffSign:
	  T _ Frac1H, GoToP[.+1];
OnPage[FlPage4];
	  T _ (Frac2H) or T, GoTo[Comp0Test];


%Float LONG INTEGER to REAL
 1) Copy the argument into Frac1
 2) Check for Zero.
 3) Check sign, and negate Frac1 if negative.
 4) Set exponent and Renormalize.
%
OnPage[FlPage0];
Float:	T _ Stack&-1;
	FPTemp2 _ 40C, Call[SetSB];
	SB[FracH] _ T, Call[SetSBSign];
	T _ Stack&-1;
	LU _ (SB[FracH]) or T;
	SB[FracL] _ T, Skip[ALU#0];
	  LoadPage[FlPage4], GoTo[Pack0];
	LU _ (SB[Sign]) xnor (0C);
	SB[Exp] _ 236C, Skip[ALU<0];
	  Call[NegFrac];
	GoTo[ReNorm];

%Fix or Round from REAL to LONG INTEGER, INTEGER, or CARDINAL.
 1) Unpack the argument.
 2) Copy Frac1 into TempFrac and unnormalize TempFrac.
 3) Round, if appropriate (controlled by FlCode)
 4) Several things depending on the result type	(controlled by FlCode)
	LONG INTEGER		INTEGER			CARDINAL
	Negate Frac1, if	Check that Frac1H and	Negate Frac1, if
	Sign1 is negative.	Frac1L[0] are all 0.	Sign1 is negative.

				Negate Frac1, if	Check that Frac1H is 0.
				Sign1 is negative.
 5) Return result of the appropriate size (controlled by FlCode)
%

OnPage[FlPage0];
FixA:	FlCode _ (FlCode) or (11C), GoTo[Unpack];
	T _ SB[Exp], At[UnpackRet,5];
	FPTemp1 _ 235C;
	FPTemp1 _ (FPTemp1) - T;
	T _ SB[FracH], GoTo[FixTrap,ALU<0];
	SB[Sign] _ (SB[Sign]) xor (100000C), Skip[ALU#0];
	  FlCode _ LCy[FlCode,10], GoTo[Fix0];
	DB _ FPTemp2;
	FlCode _ LCy[FlCode,10], GoTo[Unnorm];

	LU _ FracLL, Call[RoundCard], At[UnnormRet,2];
	FlCode, DblGoTo[FixTest015,FixTestSign,R Odd], At[UnnormRet,3];

FixTestSignA:
	SB[Sign], DblGoTo[.+3,.+2,R<0];
FixTestSign:
	SB[Sign], Skip[R<0];
	  Call[NegFrac];
Fix0:	Dispatch[FlCode,14,3];
	T _ SB[FracL], Disp[FixDoneShort];
FixTest015:
	LU _ SB[FracH], At[FixDisp,5];
	T _ SB[FracL], GoTo[FixTrapB,ALU#0];
	FlCode, DblGoTo[FixTest16,FixDoneShort,R Odd];

FixTest16:
	SB[FracL], DblGoTo[FixTrapA,FixTestSignA,R<0];

FixDoneShort:
	LoadPageExternal[opPage3], GoTo[EndFix], At[FixDisp,2];

	Stack&+1 _ T, At[FixDisp,1];
	T _ SB[FracH], LoadPageExternal[opPage3];
EndFix:	Stack&+1 _ T, GoToExternal[P7TailLoc];


%FSticky is used to read and set the InexactResultTrapEnable and the
InexactResult Bit.  It swaps Stack and Sticky.
%
OnPage[FlPage0];
FSticky:
	MNBR _ Stack, Stack _ T, NoRegILockOK, GotoP[.+1];
OnPage[FlPage4];
	T _ MNBR;
	Sticky _ T, LoadPageExternal[opPage3], GoTo[NormRetx];

:END[MesaFP];