;-----------------------------------------------------------------
; Float.mu -- Microcode source for Alto running
;	Mesa6 and using microcode floating point.
; adapted from bcpl float microcode (Sproull, Maleson)
; Copywrite Xerox Corporation 1980
; Last modified by Stewart September 23, 1980  3:24 PM
; Last modified by Johnsson September 24, 1980  8:25 AM
;-----------------------------------------------------------------

; Entry points for FP
!17,20,FAdd,FSub,FMul,FDiv,FComp,FFix,FFloat,FFixI,FFixC,FSticky,FRem,FRound,FRoundI,FRoundC,,;

;Registers used internally to float microcode
;  these should all be available during execution of a mesa
;  bytecode

; R registers
$mSAD	$R1;	mx
$N2	$R2;	saveret
$M2	$R3;	newfield
$M1	$R5;	count

$Arg1	$R7;	taskhole

$N1	$R35;	temp

$Arg0	$R36;	temp2
$ShiftCount	$R36;	entry --used only in add/sub

; S registers
$Mode	$R41;	mask --used only in add/sub
$S1	$R43;	unused2  --sign
$Mxreg	$R44;	alpha
$Arg2	$R50;	unused3
$E1	$R55;	ATPreg   --exponent
$S2	$R73;	was OTPreg
$E2	$R57;	XTPreg

$Sticky	$R72;	Sticky flag
;  The sticky bit for inexact result is implemented as follows:  The sign
;  bit indicates whether trap on inexact result is enabled, the LSB is the
;  actual sticky bit.
;$OTPreg	$R56;	instruction (saveinst)
$savestkp	$R42;	spot to remember stkp (unused1)
$SubRet	$R74;	subroutine return address

$LastL	$R40;	M register

!1,2,MiscOK1,MiscSmall;
!1,2,MiscOK2,MiscBig;
$177757	$177757;	-21B

; Hopefully, Alpha is IN [20B..31B]  (the range for FP)
; There are other FP instructions, but they all trap
MISC:	L_T,TASK;
	OTPreg_L;	store T (Alpha) in saveinst (OTPreg)
	L_stkp,TASK;
	savestkp_L;	store stack pointer in savestkp
	T_177757;	T_-21B
	L_T_OTPreg+T+1;	L IN [0..11B] if FP instr.
	L_15-T,SH<0;
	L_T,SH<0,TASK,:MiscOK1;	!1,2,MiscOK1,MiscSmall;
MiscOK1:	Arg0_L,:MiscOK2;	!1,2,MiscOK2,MiscBig;
MiscOK2:	SINK_Arg0,BUS,TASK;
	NOP,:FAdd;	!17,20,xxx;

MiscSmall:	NOP,:MiscBig;	!1,1,MiscBig;
MiscBig:	NOP,TASK,:FPTrap;

;-----------------------------------------------------------------
; Microcode subroutines are defined and called from Mesa programs
; as shown in the following example:

; MiscAlpha: CARDINAL = 20B;  -- Alpha Byte of instruction --
; CalluRoutine: PROCEDURE[x, y: REAL] RETURNS [z: REAL] =
;   MACHINE CODE BEGIN
;   Mopcodes.zMISC, MiscAlpha;
;   END;

; []_CalluRoutine[a, b];  -- the call --


!1,2,LowNZero1,LowZero1;	define before use!
!1,1,FCRet;

;---------------------------------------------------------------
; returns control to emulator in Rom1 (or Ram1 on 3K machines).
; TASK in instruction calling retCom
;---------------------------------------------------------------

retCom:	stkp_L;
	SWMODE;	Switch to Rom1
	L_T_0,:romnext;	Mesa emulator entry point

;---------------------------------------------------------------
; pushes Arg0,,Arg1 and returns control to emulator in Rom1
; called with stkp correct
; Remember, in Mesa, the M.S. word (Arg0) is on top of stack
;---------------------------------------------------------------
!17,20,LTpush0,LTpush1,LTpush2,LTpush3,LTpush4,LTpush5,LTpush6,LTpush7,LTpush8,,,,,,,;
FPdpush:	L_Arg0;
	SINK_stkp,BUS;
	T_Arg1,:LTpush0;

LTpush0:	stk1_L,L_T,TASK;
	stk0_L,:LTpushCom;
LTpush1:	stk2_L,L_T,TASK;
	stk1_L,:LTpushCom;
LTpush2:	stk3_L,L_T,TASK;
	stk2_L,:LTpushCom;
LTpush3:	stk4_L,L_T,TASK;
	stk3_L,:LTpushCom;
LTpush4:	stk5_L,L_T,TASK;
	stk4_L,:LTpushCom;
LTpush5:	stk6_L,L_T,TASK;
	stk5_L,:LTpushCom;
LTpush6:	stk7_L,L_T,TASK;
	stk6_L,:LTpushCom;
LTpush7:	NOP,TASK,:RamStkErr;
LTpush8:	NOP,TASK,:RamStkErr;
LTpushCom:	T_2;
	L_stkp+T,TASK,:retCom;

;---------------------------------------------------------------
; pushes Arg0 and returns control to emulator in Rom1
; called with stkp correct
;---------------------------------------------------------------
!17,20,LUpush0,LUpush1,LUpush2,LUpush3,LUpush4,LUpush5,LUpush6,LUpush7,LUpush8,,,,,,,;

; cannot be a TASK in instruction coming here

ShortRet:	T_stkp+1,BUS;
	L_Arg0,:LUpush0;

LUpush0:	stk0_L,L_T,TASK,:retCom;
LUpush1:	stk1_L,L_T,TASK,:retCom;
LUpush2:	stk2_L,L_T,TASK,:retCom;
LUpush3:	stk3_L,L_T,TASK,:retCom;
LUpush4:	stk4_L,L_T,TASK,:retCom;
LUpush5:	stk5_L,L_T,TASK,:retCom;
LUpush6:	stk6_L,L_T,TASK,:retCom;
LUpush7:	stk6_L,L_T,TASK,:retCom;
LUpush8:	NOP,TASK,:RamStkErr;

;---------------------------------------------------------------
;  Code to trap through SD in case of error
;  Control gets to error handler with
;  whatever was on stack at start of faulted instr.
;  OTPreg is alpha byte of faulted instruction
;---------------------------------------------------------------

; The next line must change to track changes in Mesa emulator
$romOOR$L004405,0,0;	secret definition

; The way this works is to branch to OutOfRange in the bounds check
; code with the SD index - sBoundsCheck in T
; OTPreg is already loaded with the instruction


; TASK in instruction calling this one
FPTrap:	NOP;
	T_100;
	L_17 OR T,TASK;	T_137 (our SDIndex) (minus sBoundsFault)
ramKFC:	taskhole_L;
	L_savestkp,TASK;
	stkp_L;
	T_taskhole,SWMODE;
	L_0,:romOOR;	OutOfRange (cause KFC) 

; TASK in instruction coming here
RamStkErr:	NOP;
	T_sBoundsFaultm1+1;
	L_2-T,TASK,:ramKFC;	KFCB, 2 (minus sBoundsFault)

;---------------------------------------------------------------
;multiply subroutine
;---------------------------------------------------------------

!7,10,MulRet,MulRet1,MulRet2,MulRet3;
!7,1,ramMulA;	shake IR_ dispatch
!1,2,DOMUL,NOMUL;
!1,2,MPYL,MPYA;
!1,2,NOADDIER,ADDIER;
!1,2,NOSPILL,SPILL;
!1,2,NOADDX,ADDX;
!1,2,NOSPILLX,SPILLX;

ramMul:	L_Arg2-1, BUS=0;	!7,1,ramMulA;
ramMulA:	mSAD_L,L_0,:DOMUL;	!1,2,DOMUL,NOMUL;
DOMUL:	TASK,L_-10+1;
	Mxreg_L;
MPYL:	L_Arg1,BUSODD;
	T_Arg0,:NOADDIER;	!1,2,NOADDIER,ADDIER;
NOADDIER:
	Arg1_L MRSH 1,L_T,T_0,:NOSPILL;	!1,2,NOSPILL,SPILL;
ADDIER:	L_T_mSAD+INCT;
	L_Arg1,ALUCY,:NOADDIER;
SPILL:	T_ONE;
NOSPILL:	Arg0_L MRSH 1;
	L_Arg1,BUSODD;
	T_Arg0,:NOADDX;	!1,2,NOADDX,ADDX;
NOADDX:	Arg1_L MRSH 1,L_T,T_0,:NOSPILLX;	!1,2,NOSPILLX,SPILLX;
ADDX:	L_T_mSAD+INCT;
	L_Arg1,ALUCY,:NOADDX;
SPILLX:	T_ONE;
NOSPILLX:	Arg0_L MRSH 1;
	L_Mxreg+1,BUS=0,TASK;
	Mxreg_L,:MPYL;	!1,2,MPYL,MPYA;
NOMUL:	T_Arg0;
	Arg0_L,L_T,IDISP,TASK;
	Arg1_L,:MulRet;
MPYA:	IDISP,TASK;
	NOP,:MulRet;

;---------------------------------------------------------------
;DPopSub:  Pop TOS and NOS into L,T
;---------------------------------------------------------------

!7,10,DPopRet,DPopRet1,DPopRet2;
!7,1,DPopA;		shake IR_ dispatch
!17,20,LRpop0,LRpop1,LRpop2,LRpop3,LRpop4,LRpop5,LRpop6,LRpop7,LRpop8,,,,,,,;

; NO TASK in the instruction getting here
DPop:	T_2;	!7,1,DPopA;
DPopA:	L_stkp-T,BUS,TASK;
	stkp_L,:LRpop0;

LRpop0:	NOP,TASK,:RamStkErr;	stkp=0!
LRpop1:	NOP,TASK,:RamStkErr;	stkp=1!
LRpop2:	L_stk1;
	T_stk0,IDISP,:LRpopCom;
LRpop3:	L_stk2;
	T_stk1,IDISP,:LRpopCom;
LRpop4:	L_stk3;
	T_stk2,IDISP,:LRpopCom;
LRpop5:	L_stk4;
	T_stk3,IDISP,:LRpopCom;
LRpop6:	L_stk5;
	T_stk4,IDISP,:LRpopCom;
LRpop7:	L_stk6;
	T_stk5,IDISP,:LRpopCom;
LRpop8:	L_stk7;
	T_stk6,IDISP,:LRpopCom;
LRpopCom:	SH<0,:DPopRet;

;---------------------------------------------------------------
;UnPack:  load up arguments into registers
;---------------------------------------------------------------
; Purpose is to unpack the two float numbers on mesa stack
; and save them in S,E,M,N 1 and 2
; We unpack the b argument first, so Fix can jump into middle and
; just unpack a
; This code uses a threading idea.  Once IR has been set up with sr0
; or sr1, the IDISP return can be used with even 1 instruction subroutines.

!17,20,LoadRet,LoadRet1,LoadRet2,LoadRet3,LoadRet4,LoadRet5,LoadRet6,LoadRet7,LoadRet10,LoadRet11;
!1,2,UPPos,UPNeg;
!1,2,PVbSign,PVSign;
!1,2,UPR1b,UPR1;
!1,2,UPR2b,UPR2;
!1,2,UPR4b,UPR4;
!1,2,UPBias,UPNoBias;
!1,1,UPBias1;
!1,2,PVR6b,PVR6;
!1,2,PVbCom,PVbNaN;
!1,2,PVR5b,PVR5;
!1,2,UPDN,UPZeroT;
!1,2,PVR7b,PVR7;
!1,2,PVbDNb,PVbZero;

; TASK in the instruction getting here
LoadArgs:	SubRet_L;	save return address
	IR_sr0,:DPop;
DPopRet:	Arg0_L,L_T,IDISP,:UPPos;	!1,2,UPPos,UPNeg;

UPPos:	Arg1_L,L_0,TASK,:PVbSign;	!1,2,PVbSign,PVSign;
UPNeg:	Arg1_L,L_0-1,TASK,:PVbSign;	Store S=-1

PVbSign:	S2_L,:UPC1;	Unpack Common 1

UPC1:	T_377,IDISP;
	L_Arg1 AND T,:UPR1b;	Low 8 bits of mantissa
;		!1,2,UPR1b,UPR1;
UPR1b:	N2_L LCY 8,:UPC2;	Store in left half word

UPC2:	L_Arg1 AND NOT T;	Middle 8 bits of mantissa
	Arg1_L LCY 8,IDISP;	Store in right half word
	; Now here we are using 377 instead of 177, but it doesn't matter
	; because we will or in a one bit there anyway, later.
	L_Arg0 AND T,TASK,:UPR2b;	High 7 bits of mantissa
;		!1,2,UPR2b,UPR2;
UPR2b:	M2_L LCY 8;	Store in left half word
	T_100000;	hidden bit
	T_M2 OR T,IDISP,:UPC4;	high 7 bits of mantissa
UPC4:	L_Arg1 OR T,TASK,:UPR4b;	next 8 bits
;		!1,2,UPR4b,UPR4;
UPR4b:	M2_L,:UPC5;	mantissa finished

	; Here we use 177600 instead of 77600, but the left shift clears it.
	; The SH=0 test works because the test depends on L from the
	; previous microinstruction plus shifter operation during
	; current microinstruction
UPC5:	T_177600;	exponent mask
	L_Arg0 AND T;
	Arg0_L LSH 1,SH=0;	exponent left justified now
	L_Arg0,IDISP,:UPBias;	!1,2,UPBias,UPNoBias;
UPBias:	Arg0_L LCY 8,:UPBias1;	exponent right justified now
;		!1,1,UPBias1;
UPBias1:	T_377;
	L_Arg0-T,IDISP;	check for exp=377
	T_177,SH=0,:PVR6b;	!1,2,PVR6b,PVR6;
PVR6b:	L_Arg0-T,TASK,:PVbCom;	!1,2,PVbCom,PVbNaN;
PVbCom:	E2_L,:PackedVectora;

PVbNaN:	NOP,:FPTrap;	Instruction after TASK!

; Test if mantissa was zero, if so then true zero, else denormalized
UPNoBias:	T_100000,:PVR5b;	!1,2,PVR5b,PVR5;

PVR5b:	SINK_N2,BUS=0;
	L _ M2 XOR T,IDISP,:UPDN;	!1,2,UPDN,UPZeroT;

UPDN:	NOP,TASK,:PVbNaN;	; !1,1,PVbNaN;
UPZeroT:	NOP, SH=0,:PVR7b;	!1,2,PVR7b,PVR7;

PVR7b:	M2_L,:PVbDNb;	!1,2,PVbDNb,PVbZero;
PVbDNb:	NOP,TASK,:FPTrap;
PVbZero:	L_E2,TASK,:PVbCom;	don't diddle sign
;---------------------------------------------------------------
; now unpack TOS
;---------------------------------------------------------------
!1,2,LRET,PVNaN;
!1,2,PVDNb,PVZero;

; Cannot be TASK in instruction coming here
PackedVectora: IR_sr1,:DPop;
DPopRet1:	Arg0_L,L_T,IDISP,:UPPos;	; !1,2,UPPos,UPNeg;

PVSign:	S1_L,:UPC1;

UPR1:	N1_L LCY 8,:UPC2;	Store in left half word

UPR2:	M1_L LCY 8;	Store in left half word

	T_100000;	hidden bit
	T_M1 OR T,IDISP,:UPC4;	high 7 bits of mantissa

UPR4:	M1_L,:UPC5;	mantissa finished

PVR6:	L_Arg0-T,TASK,:LRET;	!1,2,LRET,PVNaN;

PVR5:	SINK_N1,BUS=0;
	L _ M1 XOR T,IDISP,:UPDN;	; !1,2,UPDN,UPZeroT;
PVR7:	M1_L,:PVDNb;	!1,2,PVDNb,PVZero;
PVDNb:	NOP,TASK,:FPTrap;	Denormalized number
PVZero:	L_E1,TASK,:LRET;	true zero

PVNaN:	NOP,:FPTrap;	Instruction after TASK!

LRET:	E1_L;
	SINK_SubRet,BUS,TASK;	;and, the big return
	NOP,:LoadRet;	[LoadRet,LoadRet1,LoadRet2,LoadRet3]

;--------------------------------------------------------------
;repack into Arg0,,Arg1, push and return
;--------------------------------------------------------------
!1,2,FSTNZero,FSTZero;
!1,2,Round,NoRound;
!1,2,PMRound,MidRound;
!1,1,MRnd1;
!1,2,MidRPlus1,MidRPlus0;
!1,2,RPlus0,RPlus1;
!1,2,FSTNoR2,FSTR2;
!1,2,FSTNoSh,FSTSh;
!1,2,IRNoTrap,IRTrap;
!1,1,NoRound1;
!1,2,NoExpUF,ExpUF;
!1,2,NoExpOV,ExpOV;
!1,2,FSTNeg,FSTPos;

RePack:	SINK_M1,BUS=0;	check for zero result
; do a form of rounding, by checking value in low N1 bits
	T_377,:FSTNZero;	!1,2,FSTNZero,FSTZero;
FSTZero: 	L_0,:LowZero1;	LowZero1 will set sign
FSTNZero:	L_T_N1.T;

;  after the subtract in the next instruction, SH=0 if the result is halfway
;  between representable numbers.  SH<0 if the result is larger in magnitude
;  than halfway

	L_200-T,SH=0;
	T_377,SH=0,:Round;	!1,2,Round,NoRound;
Round:	NOP,SH<0,:PMRound;	!1,2,PMRound,MidRound;

MidRound:	T_N1,:MRnd1;	NO pending branch because SH=0!
;		but to be safe !1,1,MRnd1;
MRnd1:	L_400 AND T;
	NOP,SH=0;
	T_377,:MidRPlus1;	!1,2,MidRPlus1,MidRPlus0;
MidRPlus0:	L_M1 AND T,TASK,:NoRound1;
MidRPlus1:	L_N1+T+1,:RoundPlus;

PMRound:	T_377,:RPlus0;	!1,2,RPlus0,RPlus1;
RPlus1:	L_N1+T+1,:RoundPlus;
RPlus0:	L_M1 AND T,TASK,:NoRound1;

FSTR:	T_400;
	L_N1+T;
RoundPlus:	N1_L,ALUCY;
	L_M1+1,:FSTNoR2;	!1,2,FSTNoR2,FSTR2;
FSTR2:	M1_L,ALUCY,TASK,:FSTNoR2;
FSTNoR2:	NOP,:FSTNoSh;	!1,2,FSTNoSh,FSTSh;
FSTSh:	L_T_M1;	low order
	M1_L RSH 1;
	L_N1,TASK;
	N1_L MRSH 1;
	L_E1+1,TASK;
	E1_L;
FSTNoSh:	T_0+1;	sticky bit for inexact result
	L_Sticky OR T;
	Sticky_L,SH<0;
	T_377,:IRNoTrap;	!1,2,IRNoTrap,IRTrap;
IRTrap:	NOP,TASK,:FPTrap;
IRNoTrap:	L_M1 AND T,TASK,:NoRound1;
NoRound:	L_M1 AND T,TASK,:NoRound1;	!1,1,NoRound1;
NoRound1:	Arg0_L;	low 8 bits, r.j. (middle mantissa)
	T _ 177400;
	L_M1 AND T;
	M1_L LSH 1;	high 7 bits, l.j. with h.b. shifted out
	T_N1.T;	high 8 bits, l.j.
	L_Arg0 OR T,TASK;
	Arg1_L LCY 8;	ready for FPdpush

	T_176;
	L_E1+T;
	L_E1+T+1,SH<0,TASK;
	Arg0_L LCY 8,:NoExpUF;	!1,2,NoExpUF,ExpUF;
; At this point, the exponent is in left half of Arg0, but not tested for OV yet
NoExpUF:	T_E1;
	L_177-T;
	L_M1,SH<0;	Swab M!, to r.j. mantissa
	M1_L LCY 8,:NoExpOV;	!1,2,NoExpOV,ExpOV;

ExpUF:	NOP,TASK,:FPTrap;
ExpOV:	NOP,TASK,:FPTrap;

; If we get herem, the exp in l.h. of Arg0 is in range
NoExpOV:	T_Arg0;	r.h. zero, so don't mask
	L_M1 OR T,TASK;
	Arg0_L RSH 1,:FSTSgn;	ready for FPdpush
; at this point, M1,,N1 has everything but sign

; Set sign bit

FSTSgn:	SINK_S1,BUS=0;
	L_T_Arg0,:FSTNeg;	!1,2,FSTNeg,FSTPos;
FSTNeg:	L_100000 OR T;
FSTPos:	Arg0 _ L,:FPdpush;

;---------------------------------------------------------------
;Float:  a long integer is on the stack
;---------------------------------------------------------------

!1,2,FltPos,FltNeg;
!1,2,FltLNZ,FltLZ;
!1,2,FltHNZ,FltHZ;
!1,2,FltCont,FltAllZ;
!1,2,FltMore,FltNorm;

FFloat:	IR_sr2,:DPop;
DPopRet2:	M1_L,L_T,:FltPos;	!1,2,FltPos,FltNeg;
FltPos:	N1_L,L_0,TASK,:FltSign;
FltNeg:	L_0-T;	negate the double word, store S1=-1
	N1_L,SH=0;
	T_M1,:FltLNZ;	!1,2,FltLNZ,FltLZ;

FltLNZ:	L_0-T-1,:FltStore;	complement
FltLZ:	L_0-T,:FltStore;	negate if low word 0
FltStore:	M1_L,L_0-1,TASK,:FltSign;	set sign=-1
FltSign:	S1_L;

	;now, double word LShift until normalized
	L_37,TASK;
	E1_L;	31 decimal if already normalized

; we will always shift at least once, so max exponent will be 30

	SINK_M1,BUS=0,TASK;
	NOP,:FltHNZ;	!1,2,FltHNZ,FltHZ;

FltHZ:	T_N1,BUS=0;
	L_17,:FltCont;	!1,2,FltCont,FltAllZ;
FltAllZ:	L_0,:LowZero1;	S1 known to be 0
FltCont:	E1_L,L_T;	16 shifts like wildfire
	M1_L,L_0,TASK;
	N1_L,:FltHNZ;

FltHNZ:	L_M1;
	T_N1,SH<0;
	M1_L MLSH 1,L_T,:FltMore;	!1,2,FltMore,FltNorm;
FltMore:	N1_L LSH 1;
	L_E1-1,TASK;
	E1_L,:FltHNZ;

	; We just shifted out the leading one, so put it back.
FltNorm:	L_M1;
	T_ONE,TASK;
	M1_L MRSH 1,:RePack;

;---------------------------------------------------------------
;  Remainder:  not implemented
;---------------------------------------------------------------

FRem:	NOP,TASK,:FPTrap;

;---------------------------------------------------------------
;  Round to Integer
;---------------------------------------------------------------
!1,2,FRIEPlus,FRIENeg;
!1,2,FRIEOK,FRIEOv;
!1,2,FRINStik,FRIStik;
!1,2,FRIShift,FRIDone;
!1,2,FRINE,FRIPlus1A;
!1,2,FRINPlus1,FRIPlus1;
!1,2,FRIPNOv,FRIPOv;
!1,2,FixINeg,FixIPos;

FRoundI:	L_7,TASK,:SavePVA;	(see Fix)
LoadRet7:	L_T_E1+1;
	L_20-T-1,SH<0;	E1 must be positive
	E1_L,SH<0,:FRIEPlus;	!1,2,FRIEPlus,FRIENeg;

FRIEPlus:	L_T_M1,TASK,:FRIEOK;	E1 must be < 15 decimal
FRIShift:	L_T_M1,TASK,:FRIEOK;	!1,2,FRIEOK,FRIEOv;
FRIEOK:	M1_L RSH 1;
	L_N1,TASK,BUSODD;
	N1_L MRSH1,:FRINStik;	!1,2,FRINStik,FRIStik;
FRINStik:	L_E1-1,BUS=0,TASK;
	E1_L,:FRIShift;	!1,2,FRIShift,FRIDone;

FRIStik:	T_0+1;
	L_N1 OR T,TASK;
	N1_L,:FRINStik;

;  IF N1=100000B then let Mesa handle it.  IF N1>100000B then add 1 to M1
FRIDone:	T_N1,BUS=0;
	L_100000-T,:FRINE;	!1,2,FRINE,FRIPlus1A;
FRINE:	NOP,SH<0;
	L_M1+1,SH=0,:FRINPlus1;	!1,2,FRINPlus1,FRIPlus1;

; 100000 bit may have been on, SH=0 will branch if so
FRINPlus1:	SINK_S1,BUS=0,:FRIPNOv;	!1,1,FRIPNOv,FRIPOv;

; complete the +1.  The pending SH=0 branch will not go
FRIPlus1:	M1_L,SH<0,:FRIPlus1A;	; !1,1,FRIPlus1A;
FRIPlus1A:	SINK_S1,BUS=0,:FRIPNOv;	; !1,2,FRIPNOv,FRIPOv;
FRIPNOv:	L_T_M1,:FixINeg;	!1,2,FixINeg,FixIPos;

FRIENeg:	L_0,TASK,:FCRet;	store 0 and return
		; !1,1,FCRet;
;  Overflow here is a little funny;
;  FixI of 100000B traps, but is really OK,  this shouldn't
;  happen very often, so the Mesa code can handle it
FRIEOv:	NOP,TASK,:FPTrap;	FixIExponentOverflow (trap)
FRIPOv:	NOP,:MiscBig;	; !1,1,MiscBig;

;---------------------------------------------------------------
;  Round to Long Integer
;---------------------------------------------------------------
!1,2,FRgem1,FRlsm1;
!1,2,FRls31,FRge31;
!1,2,FRle29,FR30;
!1,2,FRNext,FRDone;
!1,2,FRLoop,FRStik;
!3,4,FRD300,FRD301,FRD302,FRD303;
!1,2,FRDNoAdd,FRDAdd;
!1,2,FRDNoCy,FRDCy;
!1,2,FRDNOv,FRDOv;
!1,2,FixShift,FixSgn;	This occurs here first
!1,1,FixENeg1;	This occurs here first

FRound:	L_11,TASK,:SavePVA;
LoadRet11:	L_T_E1+1;
	L_177740+T,SH<0;
	L_LastL+1,ALUCY,:FRgem1;	!1,2,FRgem1,FRlsm1;
FRgem1:	L_37-T-1,SH=0,:FRls31;	!1,2,FRls31,FRge31;
FRls31:	S2_L,:FRle29;	!1,2,FRle29,FR30;

FRle29:	L_S2-1,BUS=0,TASK,:FRLoop1;
FRLoop:	L_S2-1,BUS=0,TASK;
FRLoop1:	S2_L,:FRNext;	!1,2,FRNext,FRDone;
FRNext:	L_T_M1;
	M1_L RSH 1;
	L_N1,TASK,BUSODD;
	N1_L MRSH 1,:FRLoop;	!1,2,FRLoop,FRStik;

FRStik:	T_0+1;
	L_N1 OR T,TASK;
	N1_L,:FRLoop;

FRDone:	T_3;
	L_N1 AND T;
	M2_L;
	L_T_M1;
	M1_L RSH 1;
	L_N1,TASK;
	N1_L MRSH 1,:FRLastSh;

FR30:	L_0,TASK;
	M2_L;
FRLastSh:	L_T_M1;
	M1_L RSH 1;
	L_N1,TASK;
	N1_L MRSH 1;
	SINK_M2,BUS;
	L_N1+1,:FRD300;	!3,4,FRD300,FRD301,FRD302,FRD303;
FRD300:	NOP,:FixSgn;
FRD301:	NOP,:FixSgn;
FRD302:	SINK_N1,BUSODD;
	L_N1+1,:FRDNoAdd;	!1,2,FRDNoAdd,FRDAdd;
FRDNoAdd:	NOP,:FixSgn;
FRDAdd:	N1_L,ALUCY,:FRD303a;

FRD303:	N1_L,ALUCY;
FRD303a:	L_M1+1,:FRDNoCy;	!1,2,FRDNoCy,FRDCy;
FRDNoCy:	NOP,:FixSgn;
FRDCy:	M1_L,SH<0,TASK;
	NOP,:FRDNOv;	!1,2,FRDNOv,FRDOv;
FRDNOv:	NOP,:FixSgn;

FRDOv:	NOP,TASK,:FPTrap;

FRlsm1:	L_0,:FixENeg1;	; !1,1,FixENeg1;
FRge31:	NOP,:MiscBig;	; !1,1,MiscBig;


;---------------------------------------------------------------
;  Round to Cardinal
;---------------------------------------------------------------
!1,2,FRCVNeg,FRCVOK;
!1,2,FRCShift,FRCENeg;
!1,2,FRCEOK,FRCEOv;
!1,2,FRCMore,FRCDone;
!1,2,FRCNStik,FRCStik;
!1,2,FRCNE,FRCPlus1A;
!1,2,FRCNPlus1,FRCPlus1;
!1,2,FRCPNOv,FRCPOv;

FRoundC:	L_10,TASK,:SavePVA;	(see Fix)
LoadRet10:	SINK_S1,BUS=0;	Value must be positive.
	L_T_E1+1,:FRCVNeg;	!1,2,FRCVNeg,FRCVOK;
FRCVOK:	L_20-T,SH<0;	E1 must be positive
	E1_L,SH<0,:FRCShift;	!1,2,FRCShift,FRCENeg;

;		E1 must be < 15 decimal
FRCShift:	L_E1-1,:FRCEOK;	!1,2,FRCEOK,FRCEOv;
FRCEOK:	E1_L,SH<0;
	L_T_M1,:FRCMore;	!1,2,FRCMore,FRCDone;
FRCMore:	M1_L RSH 1;
	L_N1,TASK,BUSODD;
	N1_L MRSH1,:FRCNStik;	!1,2,FRCNStik,FRCStik;
FRCNStik:	L_E1-1,:FRCEOK;

FRCStik:	T_0+1;
	L_N1 OR T,TASK;
	N1_L,:FRCNStik;

FRCDone:	T_N1,BUS=0;
	L_100000-T,:FRCNE;	!1,2,FRCNE,FRCPlus1A;
FRCNE:	NOP,SH<0;
	L_M1+1,SH=0,:FRCNPlus1;	!1,2,FRCNPlus1,FRCPlus1;

; 100000 bit might have been on, SH=0 will branch if so
FRCNPlus1:	L_M1,:FRCPNOv;	!1,2,FRCPNOv,FRCPOv;
; the ALUCY branch will branch on overflow
FRCPlus1:	M1_L,ALUCY,:FRCPlus1A;	!1,1,FRCPlus1A;
FRCPlus1A:	L_M1,:FRCPNOv;	; !1,2,FRCPNOv,FRCPOv;
FRCPNOv:	Arg0_L,:ShortRet;

FRCENeg:	L_0,TASK,:FCRet;	store 0 and return
		; !1,1,FCRet;

FRCVNeg:	NOP,TASK,:FPTrap;
FRCPOv:	NOP,:MiscBig;	!1,1,MiscBig;
FRCEOv:	NOP,TASK,:FPTrap;


;---------------------------------------------------------------
;  Fix
;---------------------------------------------------------------
!1,2,FixEPlus,FixENeg;
!1,2,FixEOK,FixEOv;
; !1,2,FixShift,FixSgn;	This occurs earlier
!1,2,FixNeg,FixPos;
!1,2,FixLNZ,FixLZ;
; !1,1,FixENeg1;	This occurs earlier

FFix:	L_3,TASK;
SavePVA:	SubRet_L,:PackedVectora;	middle of unpack routine!
LoadRet3:	L_T_E1;
	L_37-T-1,SH<0;	E1 must be positive
	E1_L,SH<0,:FixEPlus;	!1,2,FixEPlus,FixENeg;

FixEPlus:	L_T_M1,:FixEOK;	E1 must be < 31 decimal
FixShift:	L_T_M1,:FixEOK;	!1,2,FixEOK,FixEOv;
FixEOK:	M1_L RSH 1;
	L_N1,TASK;
	N1_L MRSH 1;
	L_E1-1,BUS=0;
	E1_L,:FixShift;	!1,2,FixShift,FixSgn;

FixSgn:	SINK_S1,BUS=0;
	L_T_N1,:FixNeg;	!1,2,FixNeg,FixPos;

FixPos:	Arg1_L;
	L_M1,TASK,:FixStore;
FixNeg:	L_0-T;
	Arg1_L,SH=0;	negate the double word
	T_M1,:FixLNZ;	!1,2,FixLNZ,FixLZ;

FixLNZ:	L_0-T-1,TASK,:FixStore;	complement
FixLZ:	L_0-T,TASK,:FixStore;	negate if low word 0
FixStore:	Arg0_L,:FPdpush;

FixENeg:	L_0;	!1,1,FixENeg1;
FixENeg1:	Arg1_L,TASK,:FixStore;	store 0 and return
FixEOv:	NOP,TASK,:FPTrap;	FixExponentOverflow (trap)

;---------------------------------------------------------------
;  FixC  Fix to CARDINAL
;---------------------------------------------------------------
!1,2,FixCVNeg,FixCVOK;
!1,2,FixCShift,FixCENeg;
!1,2,FixCEOK,FixCEOv;
!1,2,FixCMore,FixCDone;

FFixC:	L_4,TASK,:SavePVA;	(see FFix)
LoadRet4:	SINK_S1,BUS=0;	Value must be positive.
	L_T_E1,:FixCVNeg;	!1,2,FixCVNeg,FixCVOK;
FixCVOK:	L_17-T,SH<0;	E1 must be positive
	E1_L,SH<0,:FixCShift;	!1,2,FixCShift,FixCENeg;

;		E1 must be < 15 decimal
FixCShift:	L_E1-1,:FixCEOK;	!1,2,FixCEOK,FixCEOv;
FixCEOK:	E1_L,SH<0;
	L_M1,TASK,:FixCMore;	!1,2,FixCMore,FixCDone;
FixCMore:	M1_L RSH 1,:FixCShift;

; FixCDone called from FixI as well
FixCDone:	Arg0_L,:ShortRet;

FixCENeg:	L_0,TASK,:FCRet;	store 0 and return
		; !1,1,FCRet;
FixCEOv:	NOP,TASK,:FPTrap;	FixCExponentOverflow (trap)
FixCVNeg:	NOP,TASK,:FPTrap;	FixCValueNegative (trap)

;---------------------------------------------------------------
;  FixI  Fix to INTEGER
;---------------------------------------------------------------
!1,2,FixIEPlus,FixIENeg;
!1,2,FixIEOK,FixIEOv;
!1,2,FixIShift,FixIDone;
;!1,2,FixINeg,FixIPos;

FFixI:	L_5,TASK,:SavePVA;	(see FFix)
LoadRet5:	L_T_E1;
	L_17-T-1,SH<0;	E1 must be positive
	E1_L,SH<0,:FixIEPlus;	!1,2,FixIEPlus,FixIENeg;

FixIEPlus:	L_M1,TASK,:FixIEOK;	E1 must be < 15 decimal
FixIShift:	L_M1,TASK,:FixIEOK;	!1,2,FixIEOK,FixIEOv;
FixIEOK:	M1_L RSH 1;
	L_E1-1,BUS=0,TASK;
	E1_L,:FixIShift;	!1,2,FixIShift,FixIDone;

FixIDone:	SINK_S1,BUS=0;
	L_T_M1,:FixINeg;	!1,2,FixINeg,FixIPos;

FixIPos:	NOP,TASK,:FixCDone;
FixINeg:	L_0-T,TASK,:FixCDone;

FixIENeg:	L_0,TASK,:FCRet;	store 0 and return
		; !1,1,FCRet;

;  Overflow here is a little funny;
;  FixI of 100000B traps, but is really OK,  this shouldn't
;  happen very often, so the Mesa code can handle it
FixIEOv:	NOP,TASK,:FPTrap;	FixIExponentOverflow (trap)

;---------------------------------------------------------------
;Mul: floating point multiply
;---------------------------------------------------------------
!1,2,MulNZero,MulZero;
!1,2,MulNZero1,MulZero1;
!1,2,FMNoCy,FMCy;
!1,2,MulNoCry,MulCry;
!1,2,FMNoCy1,FMCy1;
!1,2,FMNoCy2,FMCy2;
!1,2,FMLL,FMNoLL;
!1,2,MulNorm,MulNoNorm;
!1,2,MulNZero2,MulZero2;

FMul:	L_0,TASK,:LoadArgs;

LoadRet:	T_E1;	add exponents, like in any multiply
	L_E2+T+1,TASK;
	E1_L;

	T_S1;	and xor signs
	L_S2 XOR T,TASK;
	S1_L;

; Putting the argument with zeros on the right wins because that loop is
; only four cycles per bit, (see ramMul code)

	L_M1,TASK,BUS=0;	first multiply: high*low
	Arg2_L,:MulNZero;	!1,2,MulNZero,MulZero;
MulNZero:	L_N2;
	Arg1_L,L_0,TASK,:MulZeroa;
MulZero:	L_0,:LowZero1;	return 0
MulZeroa:	Arg0_L; 
	IR_sr0,:ramMul;
MulRet:	L_Arg0,TASK;
; Here we will start using S2, and E2 to hold some temporary stuff
	S2_L;	high result
	L_Arg1,TASK;
	E2_L;	low result

	L_M2,TASK,BUS=0;	second multiply: other high*other low
	Arg2_L,:MulNZero1;	!1,2,MulNZero1,MulZero1;
MulNZero1:	L_N1;	second multiply: other high*other low
	Arg1_L,L_0,TASK,:MulZero1a;
MulZero1:	L_0,:LowZero1;
MulZero1a:	Arg0_L;
	IR_sr1,:ramMul;
MulRet1:	T_Arg1;
	L_E2+T;	add results, set carry if overflow
	E2_L,ALUCY;
	T_Arg0,:FMNoCy;	!1,2,FMNoCy,FMCy;
FMNoCy:	L_S2+T,:FMCyS;
FMCy:	L_S2+T+1,:FMCyS;
FMCyS:	S2_L,ALUCY;
	L_0,:MulNoCry;	!1,2,MulNoCry,MulCry;
MulCry:	L_ONE,TASK;

; Use SubRet to hold carry bit
MulNoCry:	SubRet_L;

	L_N1;	third multiply: low*low
	Arg1_L,L_0,TASK;
	Arg0_L;
	L_N2,TASK;
	Arg2_L;
	IR_sr2,:ramMul;
MulRet2:	T_Arg0;	Arg1=0 (low result)
	L_E2+T;
	E2_L,ALUCY;
	L_S2+1,:FMNoCy1;	!1,2,FMNoCy1,FMCy1;
FMCy1:	S2_L,ALUCY;
FMNoCy1:	L_SubRet+1,:FMNoCy2;	!1,2,FMNoCy2,FMCy2;
FMCy2:	SubRet_L;
FMNoCy2:	L_S2,TASK;
	Arg0_L;

	;last multiply: high*high (plus stuff left in Arg0)
	L_M1,TASK;
	Arg1_L;
	L_M2,TASK;
	Arg2_L;
	IR_sr3,:ramMul;
MulRet3:	SINK_E2,BUS=0;
	L_T_Arg1,:FMLL;	!1,2,FMLL,FMNoLL;
FMLL:	L_ONE OR T,TASK,:FMNoLL;	sticky bit if third word#0
FMNoLL:	N1_L;
	T_Arg0;
	L_SubRet+T;	add in possible carry
	M1_L,SH<0;	now, check normalization
	T_N1,:MulNorm;	7 instructions since last TASK
		;  !1,2,MulNorm,MulNoNorm;
MulNorm:	M1_L MLSH 1;	8
	L_N1,SH=0;	9
	N1_L LSH 1,:MulNZero2;	10  !1,2,MulNZero2,MulZero2;
MulNZero2:	L_E1-1,TASK;	decrement exponent to account for shift
MulDone:	E1_L,:RePack;

MulNoNorm:	L_E1,TASK,:MulDone;
MulZero2:	L_0,:LowZero1;

;---------------------------------------------------------------
; FDiv floating point divide
;---------------------------------------------------------------
!1,2,DivOK,DivErr;
!1,2,DivOK1,DivZero;
!1,2,DAddNoCy,DAddCy;
!1,2,DSubNoCy,DSubCy;
!1,2,DivRes0,DivRes1;
!1,2,DivMore,DivDone;
!1,2,DivAdd,DivSub;
!1,2,DivLoop,DivNorm;
!1,2,DivLast0,DivLast1;
!1,2,DivStik,DivNoStik;
!1,2,DivL0NoCy,DivL0Cy;
!1,2,DivS1,DivLC1;

FDiv:	L_ONE,TASK,:LoadArgs;
LoadRet1:	T_E2+1;
	T_-7+T+1;
	L_E1-T,TASK;
	E1_L;

	T_S2;
	L_S1 XOR T,TASK;
	S1_L;

; pre right-shift
	L_T_M2,BUS=0;
	M2_L RSH 1,:DivOK;	!1,2,DivOK,DivErr;
DivErr:	NOP,TASK,:FPTrap;
DivOK:	L_N2,TASK;
	N2_L MRSH 1;

	L_T_M1,BUS=0;
	Arg0_L RSH 1,:DivOK1;	!1,2,DivOK1,DivZero;
DivZero:	L_0,:LowZero1;
DivOK1:	L_N1;
	Arg1_L MRSH 1,L_0;
	N1_L;	will be msw result

	L_30+1,TASK;	set E2 to NumLoops-1
	E2_L;
	T_N2,:DivSub;

DivAdd:	L_Arg1+T;
	Arg1_L,ALUCY;
	T_M2,:DAddNoCy;	!1,2,DAddNoCy,DAddCy;
DAddNoCy:	L_Arg0+T,:DOpCom;
DAddCy:	L_Arg0+T+1,:DOpCom;

DivSub:	L_Arg1-T;
	Arg1_L,ALUCY;
	T_M2,:DSubNoCy;	!1,2,DSubNoCy,DSubCy;
DSubNoCy:	L_Arg0-T-1,:DOpCom;
DSubCy:	L_Arg0-T,:DOpCom;

; If the operation carries, then the next operation
;   should be a subtract and the result bit should be a one.
; If the operation does not carry, then the next operation
;   should be an add and the result bit should be a zero.

DOpCom:	Arg0_L,ALUCY;
	L_T_N1,:DivRes0;	!1,2,DivRes0,DivRes1;
DivRes1:	L_N1+T+1;
	N1_L,:DResCom;
DivRes0:	N1_L LSH 1,:DResCom;

DResCom:	L_M1,TASK;
	M1_L MLSH 1;

	L_E2-1,TASK,BUS=0;
	E2_L,:DivMore;	!1,2,DivMore,DivDone;

; Now double the a operand  the result sign bit will always be the same
DivMore:	L_T_Arg1;
	Arg1_L LSH 1;
	L_Arg0,TASK;
	Arg0_L MLSH 1;

; do double add or subtract according to previous bit of result
	SINK_N1,BUSODD;
	T_N2,:DivAdd;	!1,2,DivAdd,DivSub;

DivDone:	L_T_N1;
	S2_L,:DivDone2;
DivDone1:	L_T_N1;	normalize result
DivDone2:	N1_L LSH 1;
	L_M1;
	mSAD_L LSH 1,SH<0;
	M1_L MLSH 1,:DivLoop;	!1,2,DivLoop,DivNorm;
DivLoop:	L_E1-1,TASK;
	E1_L,:DivDone1;

; If the last bit of result was a 1 AND Arg0,,Arg1=0 Then EXACT
; If the last bit of result was a 0 AND Arg0,,Arg1=-M2,,N2 Then EXACT
DivNorm:	SINK_S2,BUSODD;
	T_Arg1,:DivLast0;	!1,2,DivLast0,DivLast1;
DivLast1:	L_Arg0 OR T;
	NOP,SH=0,:DivLC1;
DivLC1:	L_N1+1,TASK,:DivStik;	!1,2,DivStik,DivNoStik;
DivLast0:	L_N2+T;
	NOP,ALUCY;
	T_Arg0,:DivL0NoCy;	!1,2,DivL0NoCy,DivL0Cy;
DivL0NoCy:	L_M2+T,SH=0,:DivLCom;
DivL0Cy:	L_M2+T+1,SH=0,:DivLCom;
DivLCom:	L_N1+1,SH=0,:DivS1;	!1,2,DivS1,DivLC1;

DivStik:	N1_L,:RePack;
DivNoStik:	NOP,:RePack;
DivS1:	N1_L,TASK,:DivNoStik;	; !1,1,DivNoStik;

;----------------------------------------------------
;floating point add and subtract
;----------------------------------------------------

!1,2,Sh,NoShz;
!1,2,Sh1,NoSh;
!1,2,E1lsE2,E1grE2;
!1,2,NoFix,Fix;
!1,2,Sh1NStik,Sh1Stik;
!1,2,More,Shifted;
!1,2,ExpOK,ExpWrite;
!1,2,NoFix1,Fix1;
!1,2,Sh2NStik,Sh2Stik;
!1,2,More1,Shifted1;

FAdd:	L_0,TASK,:StoreMode;
FSub:	L_ALLONES,TASK;
StoreMode:	Mode_L;
	L_2,TASK,:LoadArgs;

	;Preshift arguments until they match
LoadRet2:	T_M1;	mantissa zero check
	L_M2 AND T;	one OR the other = 0
	SINK_LastL,BUS=0;

	T_E1,:Sh;	!1,2,Sh,NoShz;
Sh:	L_E2-T;	if exponents are the same, no shift either
	SINK_LastL,BUS=0;

	ShiftCount_L,:Sh1;	!1,2,Sh1,NoSh;
Sh1:	TASK,SH<0;
	NOP,:E1lsE2;	!1,2,E1lsE2,E1grE2;
E1lsE2:	L_E2,TASK;
	E1_L;	we'll shift until exp matches E2
	T_ShiftCount;
	L_37-T;
	TASK,SH<0;	37 is max number of shifts, if SH ge 0 then fix

	NOP,:NoFix;	!1,2,NoFix,Fix;
NoFix:	L_T_M1;
More:	M1_L RSH 1;
	L_N1,TASK,BUSODD;	sticky bits
	N1_L MRSH 1,:Sh1NStik;	!1,2,Sh1NStik,Sh1Stik;
Sh1NStik:	L_ShiftCount-1;
	ShiftCount_L,SH=0;
	L_T_M1,:More;	!1,2,More,Shifted;

Sh1Stik:	T_0+1;
	L_N1 OR T,TASK;
	N1_L,:Sh1NStik;

Fix:	L_0;	set both words of mantissa1 to 0
	M1_L,L_0+1,TASK;
	N1_L,:EndShift;	keep sticky bit set

Shifted:	NOP,:EndShift;
NoSh:	NOP,:EndShift;

NoShz:	SINK_M1,BUS=0;	if first arg is zero, then E1_E2
	L_E2,TASK,:ExpOK;	!1,2,ExpOK,ExpWrite;
ExpWrite:	E1_L;
ExpOK:	NOP,:EndShift;

E1grE2:	T_ShiftCount;	actually, negative shift count
	L_37+T;
	TASK,SH<0;

	NOP,:NoFix1;	!1,2,NoFix1,Fix1;
NoFix1:	L_T_M2;
More1:	M2_L RSH 1;
	L_N2,TASK,BUSODD;	sticky denormalize
	N2_L MRSH 1,:Sh2NStik;	!1,2,Sh2NStik,Sh2Stik;
Sh2NStik:	L_ShiftCount+1;
	ShiftCount_L,SH=0;
	L_T_M2,:More1;	!1,2,More1,Shifted1;

Sh2Stik:	T_0+1;
	L_N2 OR T,TASK;
	N2_L,:Sh2NStik;

Fix1:	L_0;
	M2_L,L_0+1,TASK;	keep sticky bit set
	N2_L,:EndShift;

Shifted1:	NOP,:EndShift;

;end of PRESHIFT
;now: ADD1 is Add(+ +), Add(- -), Sub(+ -), Sub(- +)
;and  ADD2 is Add(+ -), Add(- +), Sub(+ +), Sub(- -)
; so: ADD1 if ((S1 XOR S2) XOR MODE) eq 0, and ADD2 otherwise

!1,2,ADD1,ADD2;
!1,2,A1NoCry,A1Cry;
!1,2,A1xNoCry,A1xCry;
!1,2,A1NAddS,A1AddS;
!1,2,A2NoCry,A2Cry;
!1,2,A2Sign,A2NoSign;
!1,2,LowNZero,LowZero;
!1,2,HiNZero,HiZero;
!1,2,A2Norm,A2NoNorm;
!1,2,A2NoCryL,A2CryL;
;!1,2,LowNZero1,LowZero1;	defined above to avoid predef error

EndShift:	T_S1;
	L_S2 XOR T;	0 if same, -1 if different
	T_Mode;
	L_LastL XOR T;	0 if ADD1, -1 if ADD2
	TASK,SH<0;
	NOP,:ADD1;	!1,2,ADD1,ADD2;

ADD1:	T_N1;
	L_N2+T;
	N1_L,ALUCY;
	T_M1,:A1NoCry;	!1,2,A1NoCry,A1Cry;
A1Cry:	L_M2+T+1,:A1Store;
A1NoCry:	L_M2+T;
A1Store:	M1_L,ALUCY,TASK;
	NOP,:A1xNoCry;	!1,2,A1xNoCry,A1xCry;
A1xCry:	T_L_M1;	post shift
	M1_L RSH 1;
	L_N1,TASK,BUSODD;
	N1_L MRSH 1,:A1NAddS;	!1,2,A1NAddS,A1AddS;
A1AddS:	T_0+1;
	L_N1 OR T,TASK;
	N1_L;
A1NAddS:	T_100000;
	L_M1 OR T,TASK;	high order bit should have been shifted in
	M1_L;
	L_E1+1,TASK;
	E1_L,:RePack;
A1xNoCry:	NOP,:RePack;

ADD2:	T_N2;
	L_N1-T;
	N1_L,ALUCY;	low order result
	T_M2,:A2NoCry;	!1,2,A2NoCry,A2Cry;
A2NoCry:	L_M1-T-1,:A2C;	no carry, do one's complement subtract
A2Cry:	L_M1-T;	carry, do two's complement subtract
A2C:	M1_L,ALUCY,TASK;
	NOP,:A2Sign;	if no carry, sign changed!!!!
		;  !1,2,A2Sign,A2NoSign;
A2Sign:	T_N1,BUS=0;	double length negate starts here
	L_0-T,:LowNZero;	!1,2,LowNZero,LowZero;
LowNZero:	N1_L,T_0-1;
	L_M1 XOR T,:A2Cx;	complement
LowZero:	T_M1;
	L_0-T;	negate (note that N1 is already 0, so no need to update it)
A2Cx:	M1_L,T_0-1;
	L_S1 XOR T,TASK;	complement sign
	S1_L;

A2NoSign:	L_0,TASK;
	ShiftCount_L;
	L_M1,BUS=0;
	NOP,:HiNZero;	!1,2,HiNZero,HiZero;
HiNZero:	TASK,SH<0;
	NOP,:A2Norm;	!1,2,A2Norm,A2NoNorm;
A2Norm:	L_N1;
	NOP,SH<0;
	N1_L LSH 1,T_0,:A2NoCryL;	!1,2,A2NoCryL,A2CryL;
A2CryL:	T_ALLONES;
A2NoCryL:	L_M1;
	M1_L MLSH 1;
	L_ShiftCount+1,TASK;
	ShiftCount_L;
	L_M1,:HiNZero;

A2NoNorm:	T_ShiftCount;
	L_E1-T,TASK,:MulDone;

HiZero:	L_N1,BUS=0;

	M1_L,L_0,:LowNZero1;	!1,2,LowNZero1,LowZero1;
LowNZero1:	N1_L;	zero out low order
	L_20,TASK;
	ShiftCount_L;	16 shifts done like wildfire
	L_M1,:HiNZero;

!1,2,LNZNeg,LNZPos;

LowZero1:	SINK_S1,BUS=0;
	T_100000,:LNZNeg;	!1,2,LNZNeg,LNZPos;
LNZPos:	T_0,:LNZNeg;
LNZNeg:	Arg1_L,L_T,TASK;
	Arg0_L,:FPdpush;

;---------------------------------------------------------------
;  Compare
;---------------------------------------------------------------

!1,2,FCANZ,FCAZ;
!1,2,FCANZBNZ,FCANZBZ;
!1,2,FCSD,FCSS;
!1,2,FCEDiff,FCESame;
!1,2,FCSgnA,FCSgnB;
!1,1,FCESame1;
!1,2,FCMDiff,FCMSame;
!1,1,FCMSame1;
!1,2,FCNDiff,FCNSame;
;!1,1,FCRet;	used farther up
!1,2,FCAZBNZ,FCAZBZ;
!1,2,FCAlsB,FCAgrB;
!1,2,FCAgrB1,FCAlsB1;

FComp:	L_6,TASK,:LoadArgs;
LoadRet6:	SINK_M1,BUS=0;
	SINK_M2,BUS=0,TASK,:FCANZ;	!1,2,FCANZ,FCAZ;
FCANZ:	NOP,:FCANZBNZ;	!1,2,FCANZBNZ,FCANZBZ;
FCANZBZ:	SINK_S1,BUS=0,TASK,:FCAST;	Return according to sign of A
FCANZBNZ:	T_S1;	A and B not 0
	L_S2 XOR T;
	NOP,TASK,SH=0;
	NOP,:FCSD;	!1,2,FCSD,FCSS;
FCSD:	SINK_S1,BUS=0,TASK,:FCAST;	return according to sign of A
FCSS:	T_E2;
	L_E1-T;
	T_M1,SH=0;
	L_M2-T,SH<0,:FCEDiff;	!1,2,FCEDiff,FCESame;

FCEDiff:	NOP,:FCSgnA;	!1,2,FCSgnA,FCSgnB;
FCSgnA:	SINK_S1,BUS=0,TASK,:FCAST;
FCSgnB:	SINK_S2,BUS=0,TASK,:FCBST;

; In what follows, we do unsigned compares.  ALUCY will branch if
; a >= b on execution of a-b
FCESame:	T_N1,SH=0,:FCESame1;	!1,1,FCESame1;
FCESame1:	L_N2-T,ALUCY,:FCMDiff;	!1,2,FCMDiff,FCMSame;

FCMDiff:	NOP,:FCSgnA;	(!1,2,FCSgnA,FCSgnB;)

FCMSame:	NOP,SH=0,:FCMSame1;	!1,1,FCMSame1;
FCMSame1:	NOP,ALUCY,:FCNDiff;	!1,2,FCNDiff,FCNSame;
FCNDiff:	NOP,:FCSgnA;	(!1,2,FCSgnA,FCSgnB;)
FCNSame:	L_0,TASK,:FCRet;	!1,1,FCRet;

FCAZ:	NOP,:FCAZBNZ;	!1,2,FCAZBNZ,FCAZBZ;
FCAZBZ:	L_0,TASK,:FCRet;
FCAZBNZ:	SINK_S2,BUS=0,TASK,:FCBST;	return according to sign of B

; BUS=0 in instruction calling FCAST, will branch if op. 1 is plus
FCAST:	NOP,:FCAlsB;	!1,2,FCAlsB,FCAgrB;
FCAlsB:	L_0-1,TASK,:FCRet;
FCAgrB:	L_0+1,TASK,:FCRet;

; BUS=0 in instruction calling FCAST, will branch if op. 2 is plus
FCBST:	NOP,:FCAgrB1;	!1,2,FCAgrB1,FCAlsB1;
FCAgrB1:	L_0+1,TASK,:FCRet;
FCAlsB1:	L_0-1,TASK,:FCRet;

FCRet:	Arg0_L,:ShortRet;	called from FSticky also

;---------------------------------------------------------------
;  Sticky (microcode copy of sticky flags)
;---------------------------------------------------------------

!1,2,FSErr,FSOk;

FSticky:	L_stkp-1,TASK;
	stkp_L;
	T_Sticky;
	SINK_stkp,BUS=0;
	L_stk0,:FSErr;	!1,2,FSErr,FSOk;
FSOk:	Sticky_L,L_T,TASK,:FCRet;
FSErr:	NOP,TASK,:RamStkErr;


(0,5376)(1,11264)\f1