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