;-----------------------------------------------------------------
; Float.mu -- Microcode source for Alto running
;
XMesa and using microcode floating point.
; adapted from bcpl float microcode (Sproull, Maleson)
; Copywrite Xerox Corporation 1980
; Last modified by LStewart May 14, 1980 7:43 PM
;-----------------------------------------------------------------

#AltoConsts23.mu;

; Reserve 774-1003 for Ram Utility Area.
%7, 1777, 774, RU774, RU775, RU776, RU777, RU1000, RU1001, RU1002, RU1003;

; For the moment, just throw these locations away. This is done only
; to squelch the "unused predef" warnings that would otherwise occur.
; If we ever run short of Ram, assign these to real instructions
; somewhere in microcode executed only by the Emulator.

RU774:
NOP;
RU775:
NOP;
RU776:
NOP;
RU777:
NOP;
RU1000:
NOP;
RU1001:
NOP;
RU1002:
NOP;
RU1003:
NOP;

; Reserve 0-17 for Task startup locations.
%17, 1777, 0, L0, L1, L2, L3, L4, L5, L6, L7, L10, L11, L12, L13, L14, L15, L16, L17;

L0:
TASK, :L0;
L1:
TASK, :L1;
L2:
TASK, :L2;
L3:
TASK, :L3;
L4:
TASK, :L4;
L5:
TASK, :L5;
L6:
TASK, :L6;
L7:
TASK, :L7;
L10:
TASK, :L10;
L11:
TASK, :L11;
L12:
TASK, :L12;
L13:
TASK, :L13;
L14:
TASK, :L14;
L15:
TASK, :L15;
L16:
TASK, :L16;
L17:
TASK, :L17;

; Entry point for IME
%1,1777,500,IMEXfer;
pre-define IMEXfer entry point, 500B

; Entry points for FP
; Ram entry vector, for access via Mesa JRAM instruction.

%1,1777,540,ucFloat;
Float
%1,1777,541,ucFix;
Fix
%1,1777,542,ucMul;
Multiply
%1,1777,543,ucDiv;
Divide
%1,1777,544,ucAdd;
Add
%1,1777,545,ucSub;
Subtract
%1,1777,546,ucFixC;
Fix to CARDINAL
%1,1777,547,ucFixI;
Fix to INTEGER

; Microcode for griffin
%1,1777,550,HBlt;
HBlt is the entry point.
%1,1777,177,MULret;

; **** Overflow from ROM1 for XM Mesa ****


;
;
Now bring in Mesa overflow microcode
;

#XMesaRAM.mu;

;-----------------------------------------------------------------
; MISC - Miscellaneous instructions specified by alpha
;
alpha=11 => RCLK has been handled by ROM
;
T contains alpha on arrival at MISC in RAM
;-----------------------------------------------------------------

; Precisely one of the following lines must be commented out.

MISC:
L←0, SWMODE, :Setstkp;dummy MISC implementation

;#MesaMisc.mu;
real implementation

; Microcode for griffin
#HBlt.mu; -- entry point is 550B

;-----------------------------------------------------------------
; IMERAM.mu - microcode for IME in RAM
; Last modified by Birrell - April 26, 1979 1:52 PM
;-----------------------------------------------------------------
; Microcode for IME

; %1,1777,500,IMEXfer;
pre-define IMEXfer entry point, 500B

IMEXfer:
L←stk4,TASK;stack is: argL,argH,srce,sMDS,dest
mx←L;destination for Xfer
L←stk2;
my←L;source for Xfer
L←stkp-1,SWMODE;pop stack
stkp←L,:romXfer;jump into Xfer code in ROM
;-----------------------------------------------------------------

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

; routineAddr: CARDINAL = 400B; -- Ram address of microcode --
; CalluRoutine: PROCEDURE[x, y: REAL] RETURNS [z: REAL] =
; MACHINE CODE BEGIN
; Mopcodes.zLIW, routineAddr/256, routineAddr MOD 256;
; Mopcodes.zJRAM;
; END;

; []←CalluRoutine[a, b]; -- the call --

; All these routines assume they are called with a clean stack.
; Hence, an invocation such as "[]←CalluRoutine[a, b]" must be
; written as a complete statement, not as an embedded expression.
; If the routine returns a value, it must be called in a statement
; of the form "simpleVariable←Routine[args]".
; This permits the Ram subroutine to access fixed S-registers for
; arguments and return values. It must still adjust the stack
; pointer appropriately, however.

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


$LastL
$R40;M register

; 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
$SubRet
$R42;unused1
$S1
$R43;unused2 --sign
$Mxreg
$R44;alpha
$Arg2
$R50;unused3
$E1
$R55;ATPreg --exponent
$S2
$R56;OTPreg
$E2
$R57;XTPreg

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

;---------------------------------------------------------------
; returns control to emulator in Rom1
;---------------------------------------------------------------

retCom:
stkp←L;
SWMODE;Switch to Rom1
L←T←0,:romnextA;Mesa emulator entry point

;---------------------------------------------------------------
; pushes Arg0,,Arg1 and returns control to emulator in Rom1
;---------------------------------------------------------------
!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;
stk0←L,:LTpushCom;
LTpush1:
stk2←L,L←T;
stk1←L,:LTpushCom;
LTpush2:
stk3←L,L←T;
stk2←L,:LTpushCom;
LTpush3:
stk4←L,L←T;
stk3←L,:LTpushCom;
LTpush4:
stk5←L,L←T;
stk4←L,:LTpushCom;
LTpush5:
stk6←L,L←T;
stk5←L,:LTpushCom;
LTpush6:
stk7←L,L←T;
stk6←L,:LTpushCom;
LTpush7:
NOP,:RamStkErr;can’t happen!
LTpush8:
NOP,:RamStkErr;can’t happen!
LTpushCom:
T←2;
L←stkp+T,TASK,:retCom;

;---------------------------------------------------------------
; pushes Arg0 and returns control to emulator in Rom1
;---------------------------------------------------------------
!17,20,LUpush0,LUpush1,LUpush2,LUpush3,LUpush4,LUpush5,LUpush6,LUpush7,LUpush8,,,,,,,;
ShortRet:
SINK←stkp,BUS;
L←Arg0,:LUpush0;

LUpush0:
stk0←L,:LUpushCom;
LUpush1:
stk1←L,:LUpushCom;
LUpush2:
stk2←L,:LUpushCom;
LUpush3:
stk3←L,:LUpushCom;
LUpush4:
stk4←L,:LUpushCom;
LUpush5:
stk5←L,:LUpushCom;
LUpush6:
stk6←L,:LUpushCom;
LUpush7:
stk7←L,:LUpushCom;
LUpush8:
NOP,:RamStkErr;can’t happen!
LUpushCom:
L←stkp+1,TASK,:retCom;

;---------------------------------------------------------------
; Code to trap through SD in case of error
; Pushes signword and error code.
; Control gets to error handler with signword in next-to-TOS, code in TOS
;---------------------------------------------------------------

!17,20,LWpush0,LWpush1,LWpush2,LWpush3,LWpush4,LWpush5,LWpush6,LWpush7,LWpush8,,,,,,,;
$romKFCB$L005747,0,0;
secret definition
DoErrorReturn:
SINK←stkp,BUS;called with error code in L
T←S1,:LWpush0;

LWpush0:
stk1←L,L←T;
stk0←L,:LWpushCom;
LWpush1:
stk2←L,L←T;
stk1←L,:LWpushCom;
LWpush2:
stk3←L,L←T;
stk2←L,:LWpushCom;
LWpush3:
stk4←L,L←T;
stk3←L,:LWpushCom;
LWpush4:
stk5←L,L←T;
stk4←L,:LWpushCom;
LWpush5:
stk6←L,L←T;
stk5←L,:LWpushCom;
LWpush6:
stk7←L,L←T;
stk6←L,:LWpushCom;
LWpush7:
NOP,:RamStkErr;can’t happen!
LWpush8:
NOP,:RamStkErr;can’t happen!
LWpushCom:
T←2;
L←stkp+T,TASK;
stkp←L;
T←100;construct SD index of error handler
L←37+T,SWMODE;
ib←L,L←0,:romKFCB;KFCB 137B

RamStkErr:
L←2,TASK;KFCB 2
ib←L;
SWMODE;
L←0,:romKFCB;

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

!7,10,MulRet,MulRet1,MulRet2,MulRet3;
!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:
SubRet←L;
L←Arg2-1, BUS=0;
mSAD←L,L←0,:DOMUL;
DOMUL:
TASK,L←-10+1;
Mxreg←L;
MPYL:
L←Arg1,BUSODD;
T←Arg0,:NOADDIER;
NOADDIER:
Arg1←L MRSH 1,L←T,T←0,:NOSPILL;
ADDIER:
L←T←mSAD+INCT;
L←Arg1,ALUCY,:NOADDIER;
SPILL:
T←ONE;
NOSPILL:
Arg0←L MRSH 1;
L←Arg1,BUSODD;
T←Arg0,:NOADDX;
NOADDX:
Arg1←L MRSH 1,L←T,T←0,:NOSPILLX;
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;
NOMUL:
T←Arg0;
Arg0←L,L←T,TASK;
Arg1←L;
MPYA:
SINK←SubRet,BUS,TASK;
NOP,:MulRet;

;---------------------------------------------------------------
;divide subroutine
;---------------------------------------------------------------

!7,10,DivRet,DivRet1,DivRet2;
!1,2,DODIV,NODIV;
!1,2,DIVL,ENDDIV;
!1,2,NOOVF,OVF;
!1,2,DX0,DX1;
!1,2,NOSUB,DOSUB;

ramDIV:
SubRet←L;
T←Arg2;
L←Arg0-T;Do the divide only if Arg2>Arg0
ALUCY,TASK,mSAD←L,L←0+1;
:DODIV,mSAD←L LSH 1;mSAD←2, count the loop by shifting
NODIV:
SINK←SubRet,BUS,TASK;
DRET:
NOP,:DivRet;
DODIV:
L←Arg0,:DIV1;
DIVL:
L←Arg0;
DIV1:
SH<0,T←Arg1;will the left shift of the dividend overflow?
:NOOVF,Arg0←L MLSH 1,L←T←0+T;L←Arg1,T←0
OVF:
Arg1←L LSH 1,L←0+INCT,:NOV1;L←1: shift overflowed
NOOVF:
Arg1←L LSH 1,L←T;L←0: shift ok
NOV1:
T←Arg2,SH=0;
L←Arg0-T,:DX0;
DX1:
ALUCY;do the test only if the shift didn’t overflow. If it did, L is still correct
T←Arg1,:NOSUB;but the test would go the wrong way
DX0:
T←Arg1,:DOSUB;
DOSUB:
Arg0←L,L←0+INCT,TASK;do the subtract
Arg1←L;and put a 1 in the quotient
NOSUB:
L←mSAD,BUS=0,TASK;
mSAD←L LSH 1,:DIVL;
ENDDIV:
SINK←SubRet,BUS,TASK,:DRET;

;---------------------------------------------------------------
;UnPack: load up arguments into registers
;---------------------------------------------------------------
; Purpose is to unpack the two float numbers on mesa stack (there are
; assumed to be exactly two!) 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

!7,10,LoadRet,LoadRet1,LoadRet2,LoadRet3,LoadRet4,LoadRet5;
!17,20,LRpop,LRpop0,LRpop1,LRpop2,LRpop3,LRpop4,LRpop5,LRpop6,LRpop7,,,,,,,;
!1,2,PVbPos,PVbNeg;
!1,2,PVbLNZ,PVbLZ;
!1,2,PVbBias,PVbNoBias;

LoadArgs:
SubRet←L;save return address
T←2;
L←stkp-T,BUS,TASK;
stkp←L,:LRpop;

LRpop:
NOP,:RamStkErr;stkp=0!
LRpop0:
NOP,:RamStkErr;stkp=1!

LRpop1:
L←stk1;stkp=2
T←stk0,SH<0,:LRpopCom;
LRpop2:
L←stk2;
T←stk1,SH<0,:LRpopCom;
LRpop3:
L←stk3;
T←stk2,SH<0,:LRpopCom;
LRpop4:
L←stk4;
T←stk3,SH<0,:LRpopCom;
LRpop5:
L←stk5;
T←stk4,SH<0,:LRpopCom;
LRpop6:
L←stk6;
T←stk5,SH<0,:LRpopCom;
LRpop7:
L←stk7;
T←stk6,SH<0,:LRpopCom;
LRpopCom:
Arg0←L,L←T,:PVbPos;!1,2,PVbPos,PVbNeg;
PVbPos:
Arg1←L,L←0,TASK,:PVbSign;
PVbNeg:
L←0-T;negate double word, store S1=-1
Arg1←L,SH=0;
T←Arg0,:PVbLNZ;!1,2,PVbLNZ,PVbLZ;

PVbLNZ:
L←0-T-1,:PVbStore;complement
PVbLZ:
L←0-T,:PVbStore;negate if low word 0
PVbStore:
Arg0←L,L←0-1,TASK,:PVbSign;set sign=-1

PVbSign:
S2←L;
T←377;
L←Arg1 AND T;Low 8 bits of mantissa
N2←L LCY 8;Store in left half word
L←Arg1 AND NOT T;Middle 8 bits of mantissa
Arg1←L LCY 8;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;High 7 bits of mantissa
M2←L LCY 8;Store in left half word

T←100000;hidden bit
T←M2 OR T;high 7 bits of mantissa
L←Arg1 OR T,TASK;next 8 bits
M2←L;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
T←177600;exponent mask
L←Arg0 AND T;
Arg0←L LSH 1,SH=0;exponent left justified now
L←Arg0,:PVbBias;!1,2,PVbBias,PVbNoBias;
PVbBias:
Arg0←L LCY 8;exponent right justified now
T←200;
L←Arg0-T,TASK,:PVbCom;

PVbNoBias:
L←0;true zero
M2←L;
N2←L,TASK,:PVbCom;
PVbCom:
E2←L,:PackedVectora;

;---------------------------------------------------------------
; now unpack second argument
;---------------------------------------------------------------
!17,20,LSpop,LSpop0,LSpop1,LSpop2,LSpop3,LSpop4,LSpop5,LSpop6,LSpop7,,,,,,,;
!1,2,PVPos,PVNeg;
!1,2,PVLNZ,PVLZ;
!1,2,PVBias,PVNoBias;

PackedVectora:
T←2;
L←stkp-T,BUS,TASK;
stkp←L,:LSpop;

LSpop:
NOP,:RamStkErr;stkp=0!
LSpop0:
NOP,:RamStkErr;stkp=1!

LSpop1:
L←stk1;
T←stk0,SH<0,:LSpopCom;
LSpop2:
L←stk2;
T←stk1,SH<0,:LSpopCom;
LSpop3:
L←stk3;
T←stk2,SH<0,:LSpopCom;
LSpop4:
L←stk4;
T←stk3,SH<0,:LSpopCom;
LSpop5:
L←stk5;
T←stk4,SH<0,:LSpopCom;
LSpop6:
L←stk6;
T←stk5,SH<0,:LSpopCom;
LSpop7:
L←stk7;
T←stk6,SH<0,:LSpopCom;
LSpopCom:
Arg0←L,L←T,:PVPos;!1,2,PVPos,PVNeg;
PVPos:
Arg1←L,L←0,TASK,:PVSign;
PVNeg:
L←0-T;negate double word, store S1=-1
Arg1←L,SH=0;
T←Arg0,:PVLNZ;!1,2,PVLNZ,PVLZ;

PVLNZ:
L←0-T-1,:PVStore;complement
PVLZ:
L←0-T,:PVStore;negate if low word 0
PVStore:
Arg0←L,L←0-1,TASK,:PVSign;set sign=-1

PVSign:
S1←L;
T←377;
L←Arg1 AND T;Low 8 bits of mantissa
N1←L LCY 8;Store in left half word
L←Arg1 AND NOT T;Middle 8 bits of mantissa
Arg1←L LCY 8;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;High 7 bits of mantissa
M1←L LCY 8;Store in left half word

T←100000;hidden bit
T←M1 OR T;high 7 bits of mantissa
L←Arg1 OR T,TASK;next 8 bits
M1←L;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
T←177600;exponent mask
L←Arg0 AND T;
Arg0←L LSH 1,SH=0;exponent left justified now
L←Arg0,:PVBias;!1,2,PVBias,PVNoBias;
PVBias:
Arg0←L LCY 8;exponent right justified now
T←200;
L←Arg0-T,TASK,:LRET;

PVNoBias:
L←0;true zero
M1←L;
N1←L,TASK,:LRET;
LRET:
E1←L;
SINK←SubRet,BUS,TASK;;and, the big return
NOP,:LoadRet;[LoadRet,LoadRet1,LoadRet2,LoadRet3]

;--------------------------------------------------------------
;repack into Arg0,,Arg1, push and return [ERROR 2: exponent too large]
;--------------------------------------------------------------
!1,2,FSTNZero,FSTZero;
!1,2,FSTNoR,FSTR;
!1,2,FSTNoR2,FSTR2;
!1,2,FSTNoSh,FSTSh;
!1,2,FSTError,FSTOK;
!1,2,FSTRetZ,FSTSig;
!1,2,FSTNeg,FSTPos;
!1,2,FSTLNZ,FSTLZ;
!1,2,FixShift,FSTSgn;
Used by Fix

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;
FSTNZero:
T←N1.T;
L←177-T;Is remaining >= 1/2?
L←M1,SH<0,TASK;
NOP,:FSTNoR;!1,2,FSTNoR,FSTR;
FSTNoR:
NOP,:FSTNoSh;

FSTR:
T←400;
L←N1+T;
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←377;
L←M1 AND T;
Arg0←L;low 8 bits, r.j.
L←M1 AND NOT T;
M1←L LSH 1;high 7 bits, l.j.
L←N1 AND NOT T;
T←LastL;high 8 bits, l.j.
L←Arg0 OR T,TASK;
N1←L LCY 8;

T←200;
L←E1+T,TASK;
Arg0←L LCY 8;exp (8 bit) l.j.
;check low order 8 bits of M1 are 0, else ERROR=2
T←377;
L←Arg0 AND T;
L←M1,TASK,SH=0;M1 has high 7 bits, l.j.
M1←L LCY 8,:FSTError;!1,2,FSTError,FSTOK;
FSTOK:
T←Arg0;r.h. zero, so don’t mask
L←M1 OR T,TASK;
M1←L RSH 1,:FSTSgn;
; at this point, M1,,N1 has everything but sign

FSTError:
T←E1;
L←177-T;
NOP,SH<0,TASK;
NOP,:FSTRetZ;!1,2,FSTRetZ,FSTSig;
FSTRetZ:
L←0,:LowZero1;expo underflow
FSTSig:
L←2,:DoErrorReturn;expo overflow

; This is code common to the end of Fix (please note)
FSTSgn:
SINK←S1,BUS=0;
L←T←N1,:FSTNeg;!1,2,FSTNeg,FSTPos;

FSTPos:
Arg1←L;
L←M1,TASK,:FSTStore;
FSTNeg:
L←0-T;
Arg1←L,SH=0;negate the double word
T←M1,:FSTLNZ;!1,2,FSTLNZ,FSTLZ;

FSTLNZ:
L←0-T-1,TASK,:FSTStore;complement
FSTLZ:
L←0-T,TASK,:FSTStore;negate if low word 0
FSTStore:
Arg0←L,:FPdpush;

;---------------------------------------------------------------
;Float: a long integer is on the stack
;---------------------------------------------------------------
!17,20,LVpop,LVpop0,LVpop1,LVpop2,LVpop3,LVpop4,LVpop5,LVpop6,LVpop7,,,,,,,;
!1,2,FltPos,FltNeg;
!1,2,FltLNZ,FltLZ;
!1,2,FltHNZ,FltHZ;
!1,2,FltCont,FltAllZ;
!1,2,FltMore,FltNorm;

ucFloat:
T←2;
L←stkp-T,BUS,TASK;
stkp←L,:LVpop;

LVpop:
NOP,:RamStkErr;stkp=0!
LVpop0:
NOP,:RamStkErr;stkp=1!

LVpop1:
L←stk1;
T←stk0,SH<0,:LVpopCom;
LVpop2:
L←stk2;
T←stk1,SH<0,:LVpopCom;
LVpop3:
L←stk3;
T←stk2,SH<0,:LVpopCom;
LVpop4:
L←stk4;
T←stk3,SH<0,:LVpopCom;
LVpop5:
L←stk5;
T←stk4,SH<0,:LVpopCom;
LVpop6:
L←stk6;
T←stk5,SH<0,:LVpopCom;
LVpop7:
L←stk7;
T←stk6,SH<0,:LVpopCom;
LVpopCom:
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 S2=-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←40,TASK;
E1←L;32 decimal if already normalized

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

SINK←M1,BUS=0,TASK;
NOP,:FltHNZ;!1,2,FltHNZ,FltHZ;

FltHZ:
T←N1,BUS=0;
L←20,:FltCont;!1,2,FltCont,FltAllZ;
FltAllZ:
L←0,:LowZero1;
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;

;---------------------------------------------------------------
; Fix
;---------------------------------------------------------------
!1,2,FixEPlus,FixENeg;
!1,2,FixEOK,FixEOv;
;!1,2,FixShift,FSTSgn;
This occurs earlier

ucFix:
L←3,TASK;
SubRet←L,:PackedVectora;middle of unpack routine!
LoadRet3:
L←E1-1;
T←E1,SH<0;E1 must be positive
L←37-T,:FixEPlus;!1,2,FixEPlus,FixENeg;

FixEPlus:
E1←L,SH<0;E1 must be < 32 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,FSTSgn;
; Cleanup and return is done by the end of RePack

FixENeg:
L←0,:LowZero1;store 0 and return
FixEOv:
L←ONE,:DoErrorReturn;FixExponentOverflow (trap)

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

ucFixC:
L←4,TASK;
SubRet←L,:PackedVectora;middle of unpack routine!
LoadRet4:
SINK←S1,BUS=0;Value must be positive.
L←E1-1,:FixCVNeg;!1,2,FixCVNeg,FixCVOK;
FixCVOK:
T←E1,SH<0;E1 must be positive
L←20-T,:FixCEPlus;!1,2,FixCEPlus,FixCENeg;

FixCEPlus:
E1←L,SH<0;E1 must be < 17 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:
NOP;
L←M1,TASK;
FixCStore:
Arg0←L,:ShortRet;

FixCENeg:
L←0,TASK,:FixCStore;store 0 and return
FixCEOv:
L←4,:DoErrorReturn;FixCExponentOverflow (trap)
FixCVNeg:
L←5,:DoErrorReturn;FixCValueNegative (trap)

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

ucFixI:
L←5,TASK;
SubRet←L,:PackedVectora;middle of unpack routine!
LoadRet5:
L←E1-1;
T←E1,SH<0;E1 must be positive
L←17-T,:FixIEPlus;!1,2,FixIEPlus,FixIENeg;

FixIEPlus:
E1←L,SH<0;E1 must be < 16 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:
NOP;
SINK←S1,BUS=0;
L←T←M1,:FixINeg;!1,2,FixINeg,FixIPos;

FixIPos:
NOP,TASK,:FixIStore;
FixINeg:
L←0-T,TASK,:FixIStore;
FixIStore:
Arg0←L,:ShortRet;

FixIENeg:
L←0,TASK,:FixIStore;store 0 and return
; Overflow here is a little funny, IF the exponent was exactly 20B AND
; the number is negative, AND the Mantissa is 100000B THEN we return 100000B.
; Number<0 => S1=177777B;
; E1=20B => 17-E1=177777B;
FixIEOv:
NOP;
T←M1;
L←100000 XOR T;is M1=100000B?
T←S1,SH=0;
L←E1 XOR T,:FixIEOv1;!1,2,FixIEOv1,FixIPossF;
FixIPossF:
NOP,SH=0;
L←M1,TASK,:FixIEOv2;!1,2,FixIEOv2,FixIStore;
FixIEOv2:
NOP,:FixIEOv1;
FixIEOv1:
L←6,:DoErrorReturn;FixIExponentOverflow (trap)

;---------------------------------------------------------------
;Mul: floating point multiply
;---------------------------------------------------------------
!1,2,MulNZero,MulZero;
!1,2,MulNZero1,MulZero1;
!1,2,MulNoCry,MulCry;
!1,2,MulCry1,MulNoCry1;
!1,2,MulNorm,MulNoNorm;
!1,2,MulNZero2,MulZero2;

ucMul:
L←0,TASK,:LoadArgs;

LoadRet:
T←E1;add exponents, like in any multiply
L←E2+T,TASK;
E1←L;

T←S1;and xor signs
L←S2 XOR T,TASK;
S1←L;

L←M1;first multiply: high*low
Arg1←L,SH=0;
L←N2,:MulNZero;!1,2,MulNZero,MulZero;
MulZero:
L←0,:LowZero1;return 0
MulNZero:
Arg2←L;Arg2 is S reg so can’t combine
L←0;
Arg0←L,TASK,:ramMUL;L must be 0 for SubRet
MulRet:
L←Arg0,TASK;
; Here we will start using S2 to hold some temporary stuff
S2←L;

L←M2;second multiply: other high*other low
Arg1←L,SH=0;
L←N1,:MulNZero1;!1,2,MulNZero1,MulZero1;
MulZero1:
L←0,:LowZero1;
MulNZero1:
Arg2←L;
L←0;
Arg0←L,L←0+1,TASK,:ramMUL;L must have 1 for SubRet
MulRet1:
T←Arg0;
L←S2+T;add results, set carry if overflow
Arg0←L,ALUCY;
L←0,:MulNoCry;!1,2,MulNoCry,MulCry;
MulCry:
L←ONE,TASK;

; Now use S2 to hold carry bit
MulNoCry:
S2←L;

;last multiply: high*high (plus stuff left in Arg0)
L←M1,TASK;
Arg1←L;
L←M2,TASK;
Arg2←L;
L←2,TASK,:ramMUL;
MulRet2:
SINK←S2,BUS=0;
L←Arg0,:MulCry1;!1,2,MulCry1,MulNoCry1;
MulCry1:
L←Arg0+1;low+low resulted in a carry, add it now
MulNoCry1:
M1←L,SH<0;now, check normalization
T←Arg1,:MulNorm;7 instructions since last TASK
; !1,2,MulNorm,MulNoNorm;
MulNorm:
M1←L MLSH 1;8
L←Arg1,SH=0;9
N1←L LSH 1,:MulNZero2;10 !1,2,MulNZero2,MulZero2;
MulNZero2:
L←E1-1,TASK;decrement exponent to account for shift
E1←L,:RePack;

MulNoNorm:
L←Arg1,TASK;
N1←L,:RePack;
MulZero2:
L←0,:LowZero1;

;---------------------------------------------------------------
;FDV floating point divide
;---------------------------------------------------------------

!1,2,DivOK,DivErr;
!1,2,DivOK1,DIV0;
!1,2,DivC,D0;
!1,2,DivC2,D2;
!1,2,DivDec,DivNoDec;
!1,2,DivNorm,D1;

ucDiv:
L←ONE,TASK,:LoadArgs;
LoadRet1:
SINK←M2,BUS=0,TASK;check for /0
NOP,:DivOK;!1,2,DivOK,DivErr;

DivErr:
L←3,TASK,:DoErrorReturn;

DivOK:
T←E2;first, subtract exponents
L←E1-T,TASK;
E1←L;

T←S1;now, xor signs
L←S2 XOR T,TASK;
S1←L;

;first, (M1,N1)/M2
L←T←M1,BUS=0;check for zero dividend
Arg0←L,:DivOK1;!1,2,DivOK1,DIV0;
DIV0:
L←0,:LowZero1;store true zero
DivOK1:
L←ALLONES XOR T,TASK;NOT Arg0

; Use S2 as a temporary register (to hold data for compare)
S2←L;
L←N1,TASK;
Arg1←L;
L←T←M2;
Arg2←L;

;unsigned test for Arg0<Arg2: ADCZ# 0,2,SZC
L←S2+T;(NOT Arg0)+Arg2
NOP,ALUCY;

L←T←Arg0,:DivC;!1,2,DivC,D0;
DivC:
Arg0←L RSH 1;divide dividend by two (rshift)
L←Arg1,TASK;
Arg1←L MRSH 1;
L←E1+1,TASK;bump exponent
E1←L;
D0:
L←0,TASK,:ramDIV;
DivRet:
L←Arg1;
M1←L,L←0;save high order results
Arg1←L,L←0+1,TASK,:ramDIV;now AC0,1 have remainder,0
DivRet1:
L←Arg1;
N1←L,L←0,TASK;save low order result

;now, answer is "too big" because low order bits
;of divisor were not included.
;so, we form correction term (N2/M2)*HighAnswer
Arg0←L;
L←N2,TASK;
Arg1←L;low order divisor
L←M1,TASK;
Arg2←L;high order answer so far
L←3,TASK,:ramMUL;(N2*M1)
MulRet3:
T←Arg0;
L←ALLONES XOR T;NOT Arg0;
T←M2;ADCZ# 0,2,SZCcheck for divide overflow
L←LastL+T;JMP D2divide won’t overflow
L←M2,ALUCY;

Arg2←L,:DivC2;!1,2,DivC2,D2;
DivC2:
L←M1-1,TASK;
;decrement high order part of answer
;(because correction is to low order part)
M1←L;
T←M2;and subtract "one" from dividend
L←Arg0-T,TASK;
Arg0←L;
D2:
L←2,TASK,:ramDIV;(N2*M1)/M2
DivRet2:
T←Arg1;
L←N1-T;(uncorrected low order result)-(second correction)
N1←L,ALUCY;if zero carry, then decrease high order part too

L←M1,:DivDec;!1,2,DivDec,DivNoDec;
DivDec:
L←M1-1;
M1←L;
DivNoDec:
NOP,SH<0;get high order part of answer
; (could be unnormalized from either DSZ above)
T←N1,:DivNorm;!1,2,DivNorm,D1;
DivNorm:
M1←L MLSH 1;
L←E1-1,TASK;decrement exponent to account for shift
E1←L;
L←N1,TASK;
N1←L LSH 1,:RePack;

D1:
NOP,TASK;
NOP,:RePack;

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

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

ucAdd:
L←0,TASK,:StoreMode;
ucSub:
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;
N1←L MRSH 1;
L←ShiftCount-1;
ShiftCount←L,SH=0;
L←T←M1,:More;!1,2,More,Shifted;

Fix:
L←0;set both words of mantissa1 to 0
M1←L,TASK;
N1←L,:EndShift;

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;
N2←L MRSH 1;
L←ShiftCount+1;
ShiftCount←L,SH=0;
L←T←M2,:More1;!1,2,More1,Shifted1;

Fix1:
L←0;
M2←L,TASK;
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,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;
N1←L MRSH 1;
T←100000;
L←M1 OR T;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;
E1←L,:RePack;

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;

LowZero1:
Arg0←L,TASK;
Arg1←L,:FPdpush;