;-----------------------------------------------------------------
; 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;