;#altoconsts23.mu;	get definitions,constant allocations

; last modified by Butterfield, March 6, 1980  11:34 AM
; - add PCgetsLret tag for MainMc - 3/6
; - commented out unused rett - 3/6/80

;Dispatch definitions:

;!20,1,START;	return address for emulator restart
;!37,1,TRAP1;
!645,1,TRAP;	for microcode 13
;!120,1,MUL;	!124,20,BLT,BLKS,,,,,,,,,,MUL,DIV,,BITBLOT;

;REGISTERS USED BY NOVA EMULATOR
$AC0	$R3;   ac's are backwards because the hardware supplies
		;   the complement address when addressing from ir
$AC1	$R2;
$AC2	$R1;
$AC3	$R0;
$NWW	$R4;
$SAD	$R5;
$PC	$R6;
$XREG	$R7;
$LastL	$R40; not a real S register, but rather L gated to the bus
;Clock (in refresh task) R11,R37
;Ethernet R12,R13
;Display controller: R20-R30
;Disk Controller: R31-R34

;Available: R5,R10,R14-17,R35-36
$Arg0	$R10;
$Arg1	$R12;	WATCH OUT! EtherNet location
$Arg2	$R17;
$M1	$R15;
$N1	$R16;
$M2	$R35;
$N2	$R36;

$S1	$R41;	sign
$E1	$R42;	exponent

$S2	$R43;
$E2	$R44;

$maxAC	$R45;
$EOffset	$R46;
$MOffset	$R47;
$NOffset	$R50;

$ErrorAddress$R51;
$FPwork	$R52;
$Temp		$R53;
$CRY		$R54;

$Mode		$R55;	0 for add, -1 for subtract
$ShiftCount	$R56;
$SubRet	$R57;

;rett:	TASK;	most general return (Return&TASK)
retn:	NOP;	return, do nop first (prev inst has task)
ret:	SWMODE;
	:START;	back to ROM

!37,40,Routine0,Routine1,Routine2,Routine3,Routine4,Routine5,Routine6,Routine7,Routine10,Routine11,Routine12,Routine13,,Routine15,Routine16,Routine17,,,,Routine23;
TRAP:		SINK_DISP,BUS,:dispatch;
TRAP1: 	SINK_DISP,BUS;	"or" low-order 8 bits of IR into "NEXT"
dispatch:	NOP,:Routine0;

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

MUL:	SubRet_L;
	L_Arg2-1, BUS=0;
MPYX:	XREG_L,L_0,:DOMUL;
DOMUL:	TASK,L_-10+1;
	SAD_L;
MPYL:	L_Arg1,BUSODD;
	T_Arg0,:NOADDIER;
NOADDIER:	Arg1_L MRSH 1,L_T,T_0,:NOSPILL;
ADDIER:	L_T_XREG+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_XREG+INCT;
	L_Arg1,ALUCY,:NOADDX;
SPILLX:	T_ONE;
NOSPILLX:	Arg0_L MRSH 1;
	L_SAD+1,BUS=0,TASK;
	SAD_L,:MPYL;
NOMUL:	T_Arg0;
	Arg0_L,L_T,TASK;
	Arg1_L;
MPYA: SINK_SubRet,BUS;
	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;

DIV:	SubRet_L;
	T_Arg2;
DIVX:	L_Arg0-T;	Do the divide only if Arg2>Arg0
	ALUCY,TASK,SAD_L,L_0+1;
	:DODIV,SAD_L LSH 1;	SAD_2, count the loop by shifting
NODIV:	SINK_SubRet,BUS;
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;	do the subtract
	Arg1_L;	and put a 1 in the quotient
NOSUB:	L_SAD,BUS=0,TASK;
	SAD_L LSH 1,:DIVL;
ENDDIV:	SINK_SubRet,BUS,:DRET;

;---------------------------------------------------------------
;load up arguments (in AC0,AC1) into registers
;---------------------------------------------------------------

!7,10,LoadRet,LoadRet1,LoadRet2,,PackedVectorRet;
!1,2,Acc,PackedVector;
!1,2,ACOK,ACER;
!1,2,ACpos,ACneg;
!1,2,ACpos1,ACneg1;

LoadArgs: SubRet_L;
	L_T_AC0;
	L_maxAC-T,SH<0;	make sure AC is in range
	MAR_L_FPwork+T,SH<0,:ACpos;	!1,2,ACpos,ACneg;
ACpos:	Temp_L,:ACOK;	!1,2,ACOK,ACER;
ACOK:	T_EOffset;
	L_MD;
	MAR_Temp+T;
	S1_L;
	L_MD;
	T_MOffset;

	MAR_Temp+T;
	E1_L;
	T_NOffset;
	L_MD;

	MAR_Temp+T;
	M1_L;

	L_T_AC1;
	L_maxAC-T,SH<0;
	L_MD,SH<0,TASK,:ACpos1;	!1,2,ACpos1,ACneg1;
ACneg1: N1_L,:PackedVector;	
ACpos1:	N1_L,:Acc;	!1,2,Acc,PackedVector;

ACneg: L_3,:DoErrorReturn;	an AC must be positive
ACER:	L_3,:DoErrorReturn;

	;and now, argument two
Acc:	T_AC1;
	MAR_L_FPwork+T;
	Temp_L;
	T_EOffset;
	L_MD;

	MAR_Temp+T;
	S2_L;
	L_MD;
	T_MOffset;

	MAR_Temp+T;
	E2_L;
	T_NOffset;
	L_MD;

	MAR_Temp+T;
	M2_L;
	L_MD,TASK;
	N2_L,:LRET;

	;and, the big return
LRET:	SINK_SubRet,BUS;
	NOP,:LoadRet;

!1,2,PVPos,PVNeg;
!1,2,PVLowNonZero,PVLowZero;
!1,2,PVExpBias,PVNoExpBias;

PackedVector:		;load M2 from packed vector (addr in AC1), return via SubReg and LoadRet
	MAR_AC1;
	NOP;
	L_MD;

	MAR_AC1+1;
	Arg0_L;		first word
	L_MD,TASK;
	Arg1_L;		second word

	L_Arg0;	check for sign
	NOP,SH<0;
	T_Arg1,:PVPos;

PVNeg:	L_0-T;	negate the double word, store S2=-1
		Arg1_L,SH=0;
		T_Arg0,:PVLowNonZero;	!1,2,PVLowNonZero,PVLowZero;
PVLowNonZero:	L_ALLONES XOR T,:PVStore;	complement
PVLowZero:		L_0-T,:PVStore;			negate if low word 0
PVStore:	Arg0_L,L_0-1,TASK,:PVSign;	set sign=-1
PVPos:		L_0,TASK;
PVSign:	S2_L;

	;now, double word LShift 1, for 8-bit addressing ease
	L_T_Arg1;	low order
	Arg1_L LSH 1;
	L_Arg0,TASK;
	Arg0_L MLSH 1;

	;flip the args around, to be [M2a,E2][N2,M2b]
	L_Arg0,TASK;
	Arg0_L LCY 8;
	L_Arg1,TASK;
	Arg1_L LCY 8;

	;now, place the right halves
	T_377;
	L_Arg0 AND T;		E2
	E2_L;
	L_Arg1 AND T,TASK;	M2b
	M2_L;

	;and the right halves
	T_177400;
	L_Arg1 AND T;		N2
	N2_L;
	L_Arg0 AND T;		M2a
	T_M2;
	L_LastL OR T;		M2a,M2b=M2
	M2_L,SH=0;
	T_200,:PVExpBias;	exponent is exponent+200, unless exponent=0
PVExpBias:	L_E2-T,TASK;
	E2_L,:LRET;
PVNoExpBias:NOP,:LRET;
	
;---------------------------------------------------------------
;FLDI	load floating point accumulator with integer value
;---------------------------------------------------------------
!1,2,Pos,Neg;
!1,2,LdNonZero,LdZero;
!1,2,LowNonZero1,LowZero1;

Routine10: L_T_AC1;
	M1_L,SH<0;
	L_20,:Pos;
Pos:	SINK_M1,BUS=0;
	E1_L,:LdNonZero;
LdNonZero:	L_0,:Store;
Neg:	E1_L;
	L_0-T;	negate number
	M1_L,L_0-1;
Store:	S1_L;
	L_0,TASK;
	N1_L;

	;now, normalize
NormI:	L_M1;
	NOP,SH<0;

!1,2,NormICont,StoreAndReturn;

	NOP,:NormICont;
NormICont:	M1_L LSH 1;
	L_E1-1,TASK;
	E1_L,:NormI;

LdZero:	L_0,:LowZero1;

;---------------------------------------------------------------
;Put result back into FP in AC0, and do subroutine return
;---------------------------------------------------------------
!1,2,ACOK2,ACER2;
!1,2,ACpos2,ACneg2;

StoreAndReturn: L_T_AC0;
	L_maxAC-T,SH<0;	make sure AC is in range
	MAR_L_FPwork+T,SH<0,:ACpos2;		!1,2,ACpos2,ACneg2;
ACpos2:	Temp_L,:ACOK2;
ACOK2:	T_EOffset;
	MD_S1;

	MAR_Temp+T;
	NOP,TASK;
	MD_E1;
	T_MOffset;

	MAR_Temp+T;
	T_NOffset;
	MD_M1;

	MAR_Temp+T;
	NOP,TASK;
	MD_N1,:ret;

ACER2:	L_3,:DoErrorReturn;
ACneg2:	L_3,:DoErrorReturn;

;---------------------------------------------------------------
;Load register pointed to by Arg0
;---------------------------------------------------------------

!7,10,LoadOneRet,LoadOneRet1,LoadOneRet2,LoadOneRet3,LoadOneRet4,LoadOneRet5,LoadOneRet6;
!1,2,ACOK1,ACER1;
!1,2,ACpos3,ACneg3;

LoadRegOne: SubRet_L;
	L_T_Arg0;
	L_maxAC-T,SH<0;
	MAR_L_FPwork+T,SH<0,:ACpos3;		!1,2,ACpos3,ACneg3;
ACpos3:	Temp_L,:ACOK1;
ACOK1:	T_EOffset;
	L_MD;

	MAR_Temp+T;
	S1_L;
	L_MD;
	T_MOffset;

	MAR_Temp+T;
	E1_L;
	T_NOffset;
	L_MD;

	MAR_Temp+T;
	M1_L;
	L_MD,TASK;
	N1_L;

	;and, the big return
	SINK_SubRet,BUS;
	NOP,:LoadOneRet;

ACneg3:L_3,:DoErrorReturn;
ACER1:L_3,:DoErrorReturn;

;--------------------------------------------------------------------------------
;FST	store floating point accumulator into packed vector [ERROR 1: exponent too large]
;--------------------------------------------------------------------------------
!1,2,FSTNonZero,FSTZero;
!1,2,FSTWrite,FSTNeg;
!1,2,FSTError,FSTOK;
!1,2,FSTDPNeg,FSTDPPos;
!1,2,FSTDPLowNonZero,FSTDPLowZero;

Routine15:	L_AC0;
		Arg0_L;
		L_5,:LoadRegOne;
LoadOneRet5:	L_M1,BUS=0;			a,b
		Arg0_L LCY 8,:FSTNonZero;	b,a
FSTZero: 	NOP,:FSTDPPos;

FSTNonZero:	L_N1;					c,d
		Arg1_L LCY 8;			d,c
		T_377;
		L_Arg1 AND T,TASK;
		Arg1_L;		0,c
		T_177400;
		T_Arg0.T;		b,0
		L_Arg1 OR T,TASK;
		Arg1_L;		b,c
		T_377;
		L_Arg0 AND T,TASK;
		Arg0_L;		0,a

		T_200;
		L_E1+T,TASK;
		M1_L LCY 8;
	;check low order 8 bits of M1 are 0, else ERROR=1
		T_M1;
		L_377 AND T;
		L_Arg0 OR T,SH=0;	e,a
		Arg0_L,:FSTError;
FSTError:	L_ONE,:DoErrorReturn;

	;and double shift right
FSTOK:	L_T_Arg0;
		M1_L RSH 1;
		L_Arg1,TASK;
		N1_L MRSH 1;

 		L_S1;
		T_N1,SH<0;
		L_0-T,:FSTWrite;
FSTWrite:	NOP,:FSTDPPos;

;--------------------------------------------------------------------------------;FTR return truncated floating point ac (integer value) [ERROR=0: exponent too large]
;--------------------------------------------------------------------------------
!1,2,TrExpOK,TrExpZero;
!1,2,TrExpOvfl,TrExpOK1;
!1,2,TrLoop,TrLoopDone;
!1,2,TrNeg,TrPos;

Routine11:	L_AC0,TASK;
		Arg0_L;
		L_2,:LoadRegOne;
LoadOneRet2:	L_E1-1;		test for exponent <= 0, ifso, return 0
		T_20,SH<0;
		L_0,:TrExpOK;	!1,2,TrExpOK,TrExpZero;

TrExpOK:	L_E1-T;		test for exp ge 16, if so, ERROR 0
		E1_L,SH<0;		this will be the shift counter, Exponent-16
		NOP,:TrExpOvfl;	!1,2,TrExpOvfl,TrExpOK1;

TrExpOK1:	L_E1+1,BUS=0;
		E1_L,:TrLoop;	!1,2,TrLoop,TrLoopDone
TrLoop:	L_M1;
		M1_L RSH 1,:TrExpOK1;

TrLoopDone:	SINK_S1,BUS=0;
		T_M1,:TrNeg;

TrNeg:		L_0-T,:TrExpZero;

TrPos:		L_M1,:TrExpZero;

TrExpOvfl:	L_0,:DoErrorReturn;
TrExpZero:	AC0_L,TASK,:retn;

;---------------------------------------------------------------
;FNEG negate floating point ac
;---------------------------------------------------------------
!1,2,NegOK,NegZero;

Routine12:	L_AC0;
		Arg0_L;
		L_3,:LoadRegOne;
LoadOneRet3:	SINK_M1,BUS=0;
		T_ALLONES,:NegOK;
NegOK:	L_S1 XOR T,TASK;
		S1_L,:StoreAndReturn;
NegZero:	TASK,:retn;

;---------------------------------------------------------------
;FSN return -1,0,1 according to sign
;---------------------------------------------------------------
!1,2,SnCont,SnZero;
!1,2,SnPos,SnNeg;

Routine13:	L_AC0,TASK;
		Arg0_L;
		L_4,:LoadRegOne;
LoadOneRet4:	SINK_M1,BUS=0;
		L_S1,:SnCont;
SnCont:	L_ONE,SH<0;
		NOP,:SnPos;
SnNeg:	L_ALLONES,:SnPos;
SnZero:	L_0;
SnPos:		AC0_L,TASK,:retn;
		
;---------------------------------------------------------------
;FLD floating point load register from register
;---------------------------------------------------------------
!1,2,FLDAcc,FLDPackedV;
!1,2,ACpos4,ACneg4;

Routine5:	L_T_AC1;
		L_maxAC-T,SH<0;	check for Packed vector or AC
		L_AC1,SH<0,TASK,:ACpos4;		!1,2,ACpos4,ACneg4;
ACpos4:	Arg0_L,:FLDAcc;	
ACneg4:	Arg0_L,:FLDPackedV;

FLDAcc:	L_0,:LoadRegOne;
LoadOneRet:	NOP,:StoreAndReturn;

FLDPackedV:	L_4;
		SubRet_L,:PackedVector;	stuff Packed vector into [S2,E2,M2,N2]
PackedVectorRet:	L_S2,TASK;
	S1_L;
	L_E2,TASK;
	E1_L;
	L_M2,TASK;
	M1_L;
	L_N2,:StoreN1AndReturn;

;---------------------------------------------------------------
;FLDV floating point load from unpacked vector
;---------------------------------------------------------------
Routine6:MAR_AC1;
	NOP;
	L_MD;

	MAR_AC1+1;
	S1_L;
	L_AC1+1;
	AC1_L;
	L_MD,TASK;
	E1_L;

	MAR_L_AC1+1;
	AC1_L;
	L_MD;

	MAR_AC1+1;
	M1_L;
	L_MD,TASK;
StoreN1AndReturn:	N1_L,:StoreAndReturn;

;---------------------------------------------------------------
;FSTV floating point store unpacked into vector
;---------------------------------------------------------------
Routine7:L_AC0;
	Arg0_L,L_0+1,:LoadRegOne;
LoadOneRet1:	MAR_AC1;
	NOP,TASK;
	MD_S1;

	MAR_L_AC1+1;
	L_LastL+1;
	AC1_L,TASK;
	MD_E1,:FSTDPPos;
;--------------------------------------------------------------------------------;initialization: AC0 has floating point AC work area start, AC1 has Error routine address
;--------------------------------------------------------------------------------
Routine0: MAR_AC0;
	L_AC0+1;
	FPwork_L;
	L_MD;
	EOffset_L;
	L_EOffset-1,TASK;
	maxAC_L;
	T_EOffset;
	L_EOffset+T;
	MOffset_L;
	L_MOffset+T;
	NOffset_L;

	L_AC1,TASK;
	ErrorAddress_L,:ret;

DoErrorReturn: AC0_L;	called with error code in L
	L_ErrorAddress,TASK;
PCgetsLret: PC_L,:ret;

;---------------------------------------------------------------
;FMP floating point multiply
;---------------------------------------------------------------

!1,2,FMPNonZero,FMPZero;
!1,2,FMPNonZero1,FMPZero1;

Routine1: L_0,:LoadArgs;

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

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

	;first multiply: high*low
	L_M1;
	Arg1_L,SH=0;
	L_N2,:FMPNonZero;
FMPZero:	L_0,:LowZero1;	return 0
FMPNonZero:	Arg2_L,L_0;
	Arg0_L,:MUL;	L must be 0 for SubRet
MulRet: L_Arg0,TASK;
	Temp_L;

	;second multiply: other high*other low
	L_M2;
	Arg1_L,SH=0;
	L_N1,:FMPNonZero1;
FMPZero1:	L_0,:LowZero1;
FMPNonZero1:	Arg2_L,L_0;
	Arg0_L,L_0+1,:MUL;	L must have 1 for Subroutine Return
MulRet1: T_Arg0;
	
!1,2,NoCarry,Carry;

	;add results, set carry if overflow
	L_Temp+T;
	Arg0_L,ALUCY;
	L_0,:NoCarry;
Carry:	L_ONE;
NoCarry:	CRY_L;

!1,2,Carry1,NoCarry1;

	;last multiply: high*high (plus stuff left in Arg0)
	L_M1,TASK;
	Arg1_L;
	L_M2;
	Arg2_L;
	L_2,:MUL;
MulRet2: SINK_CRY,BUS=0;
	L_Arg0,:Carry1;	!1,2,Carry1,NoCarry1
Carry1:	L_Arg0+1;	low+low resulted in a carry, add it now
NoCarry1:	M1_L,SH<0;		now, check normalization

!1,2,Normalize,NoNormalize;
!1,2,NonZero,Zero;

		T_Arg1,:Normalize;		7 instructions since last TASK
Normalize:	M1_L MLSH 1;	8
		L_Arg1,SH=0;		9
		N1_L LSH 1,:NonZero;		10
NonZero:	L_E1-1,TASK;	decrement exponent to account for shift
		E1_L,:StoreAndReturn;

NoNormalize:	L_Arg1,TASK;
		N1_L,:StoreAndReturn;
Zero:	L_0,:LowZero1;

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

Routine2: L_ONE,:LoadArgs;

!1,2,DivOK,DivErr;
!1,2,DivOK1,DIV0;

LoadRet1: SINK_M2,BUS=0;
	NOP,:DivOK;

DivErr:	L_2,:DoErrorReturn;

	;first, subtract exponents
DivOK:	T_E2;
	L_E1-T,TASK;
	E1_L;

	;now, xor signs
	T_S1;
	L_S2 XOR T;
	S1_L;

	;first, (M1,N1)/M2
	L_T_M1,BUS=0;	check for zero dividend
	Arg0_L,:DivOK1;
DIV0:	TASK,:retn;	dividend is already 0, just return
DivOK1:	L_ALLONES XOR T,TASK;	NOT Arg0
	Temp_L;
	L_N1,TASK;
	Arg1_L;
	L_T_M2;
	Arg2_L;

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

!1,2,DivC,D0;

	L_T_Arg0,:DivC;
DivC:	Arg0_L RSH 1;	divide dividend by two (rshift)
	L_Arg1;
	Arg1_L MRSH 1;
	L_E1+1,TASK;	bump exponent
	E1_L;
D0:	L_0,:DIV;
DivRet:	L_Arg1;
	M1_L,L_0;	save high order results
	Arg1_L,L_0+1,:DIV;	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,:MUL;	(N2*M1)
MulRet3:	T_Arg0;
	L_ALLONES XOR T;	NOT Arg0;
	T_M2;				ADCZ# 0,2,SZC	check for divide overflow
	L_LastL+T;			JMP D2	divide won't overflow
	L_M2,ALUCY;

!1,2,DivC2,D2;
	Arg2_L,:DivC2;
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,:DIV;(N2*M1)/M2
DivRet2:	T_Arg1;
	L_N1-T;	(uncorrected low order result)-(second correction)
	Arg0_L,ALUCY;5		if zero carry, then decrease high order part too

!1,2,Dec,NoDec;
!1,2,Norm,D1;

	L_M1,:Dec;6
Dec:	L_M1-1;7
	M1_L;8
NoDec:	NOP,SH<0;9	get high order part of answer (could be unnormalized from either DSZ above)
	T_Arg0,:Norm;10	!1,2,Norm,D1;
Norm:	M1_L MLSH 1;11
	L_E1-1,TASK;	decrement exponent to account for shift
	E1_L;
	L_Arg0,TASK;
	N1_L LSH 1,:StoreAndReturn;

D1:	L_Arg0,TASK;
	N1_L,:StoreAndReturn;

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

Routine3:	L_0,TASK,:StoreMode;
Routine4:	L_ALLONES,TASK;
StoreMode:	Mode_L;

	L_2,:LoadArgs;

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

!1,2,Sh,NoShz;

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

!1,2,Sh1,NoSh;
!1,2,E1lsE2,E1grE2;
	ShiftCount_L,:Sh1;
Sh1:	TASK,SH<0;

	NOP,:E1lsE2;
	
E1lsE2:	L_E2,TASK;
	E1_L;	we'll shift until exponent matches E2
	T_ShiftCount;
	L_37-T;
	TASK,SH<0;	37 is max number of shifts, if SH ge 0 then fix

!1,2,NoFix,Fix;
!1,2,More,Shifted;

	NOP,:NoFix;
NoFix:	L_T_M1;
More:	M1_L RSH 1;
	L_N1;
	N1_L MRSH 1;
	L_ShiftCount-1;
	ShiftCount_L,SH=0;
	L_T_M1,:More;

Fix:	L_0;	set both words of mantissa1 to 0
	M1_L,TASK;
	N1_L,:EndShift;

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

!1,2,ExpOK,ExpWrite;

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

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

!1,2,NoFix1,Fix1;
!1,2,More1,Shifted1;

	NOP,:NoFix1;
NoFix1:	L_T_M2;
More1:	M2_L RSH 1;
	L_N2;
	N2_L MRSH 1;
	L_ShiftCount+1;
	ShiftCount_L,SH=0;
	L_T_M2,:More1;

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

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;

!1,2,ADD1,ADD2;

	NOP,:ADD1;

ADD1:	T_N1;
	L_N2+T;
	N1_L,ALUCY;
!1,2,A1NoCarry,A1Carry;
	T_M1,:A1NoCarry;
A1Carry:	L_M2+T+1,:A1Store;
A1NoCarry:	L_M2+T;
A1Store:	M1_L,ALUCY,TASK;
!1,2,A1xNoCarry,A1xCarry;
	NOP,:A1xNoCarry;
A1xCarry:	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,:StoreAndReturn;
A1xNoCarry:	NOP,:StoreAndReturn;

ADD2:	T_N2;
	L_N1-T;
	N1_L,ALUCY;	low order result

!1,2,Add2NoCarry,Add2Carry;

	T_M2,:Add2NoCarry;
Add2NoCarry:	T_ALLONES;
	L_M2 XOR T;	COM M2
	T_M1;	
	L_LastL+T,:Add2C;	no carry, do one's complement subtract
Add2Carry:	L_M1-T;		carry, do two's complement subtract
Add2C:	M1_L,ALUCY;

!1,2,Add2Sign,Add2NoSign;
!1,2,LowNonZero,LowZero;

	L_0,:Add2Sign;	if no carry, sign changed!!!!

Add2Sign:	T_N1,BUS=0;	double length negate starts here
	L_0-T,:LowNonZero;
LowNonZero:N1_L,T_0-1;
	L_M1 XOR T,:Add2Cx;	complement
LowZero:	T_M1;
	L_0-T;	negate (note that N1 is already 0, so no need to update it)
Add2Cx:	M1_L,T_0-1;
	L_S1 XOR T,TASK;	complement sign
	S1_L;
	L_0;

Add2NoSign:	ShiftCount_L;
	L_M1,BUS=0;

!1,2,HiNonZero,HiZero;

	NOP,:HiNonZero;

HiNonZero:	TASK,SH<0;

!1,2,Add2Norm,Add2NoNorm;

	NOP,:Add2Norm;
Add2Norm:	L_N1;
	NOP,SH<0;
!1,2,Add2NoCarryL,Add2CarryL;
	N1_L LSH 1,T_0,:Add2NoCarryL;
Add2CarryL:	T_ALLONES;
Add2NoCarryL:	L_M1;
	M1_L MLSH 1;
	L_ShiftCount+1,TASK;
	ShiftCount_L;
	L_M1,:HiNonZero;

Add2NoNorm:T_ShiftCount;
	L_E1-T,TASK;
	E1_L,:StoreAndReturn;

HiZero:	L_N1,BUS=0;

;!1,2,LowNonZero1,LowZero1;	defined above

	M1_L,L_0,:LowNonZero1;
LowNonZero1:	N1_L;	zero out low order
	L_20,TASK;
	ShiftCount_L;	16 shifts done like wildfire
	L_M1,:HiNonZero;

LowZero1:E1_L;
	S1_L;
	M1_L,TASK;
	N1_L,:StoreAndReturn;

;----------------------------------------------------------------------
; FLDDP
;----------------------------------------------------------------------
!1,2,FLDDPPos,FLDDPNeg;
!1,2,FLDDPLowNonZero,FLDDPLowZero;
!1,2,FLDDPHiNonZero,FLDDPHiZero;
!1,2,FLDDPCont,FLDDPAllZero;
!1,2,FLDDPShift,FLDDPNormalized;

Routine16:		;load M2 from packed vector (addr in AC1), return via SubReg and LoadRet
	MAR_AC1;
	NOP;
	L_MD;

	MAR_AC1+1;
	Arg0_L;		first word (high order)
	L_MD,TASK;
	Arg1_L;		second word (low order)

	L_Arg0;	check for sign
	NOP,SH<0;
	T_Arg1,:FLDDPPos;

FLDDPNeg:	L_0-T;	negate the double word, store S2=-1
		Arg1_L,SH=0;
		T_Arg0,:FLDDPLowNonZero;	!1,2,FLDDPLowNonZero,FLDDPLowZero;
FLDDPLowNonZero:	L_ALLONES XOR T,:FLDDPStore;	complement
FLDDPLowZero:		L_0-T,:FLDDPStore;			negate if low word 0
FLDDPStore:	Arg0_L,L_0-1,TASK,:FLDDPSign;	set sign=-1
FLDDPPos:		L_0,TASK;
FLDDPSign:	S1_L;

	;now, double word LShift until normalized
	L_20;
	E1_L;	16 decimal if already normalized

	SINK_Arg0,BUS=0;
	NOP,:FLDDPHiNonZero;	!1,2,HiNonZero,HiZero

FLDDPHiZero: SINK_Arg1,BUS=0;
	L_0,:FLDDPCont;	!1,2,FLDDPCont,FLDDPAllZero;
FLDDPCont: E1_L;	16 shifts like wildfire
	L_Arg1;
	Arg0_L,L_0;
	Arg1_L,:FLDDPHiNonZero;
FLDDPAllZero: L_0,:LowZero1;

FLDDPHiNonZero: L_Arg0;
	NOP,SH<0;
	NOP,:FLDDPShift;	!1,2,FLDDPShift,FLDDPNormalized

FLDDPShift:	L_T_Arg1;	low order
	Arg1_L LSH 1;
	L_Arg0,TASK;
	Arg0_L MLSH 1;
	L_E1-1;
	E1_L,:FLDDPHiNonZero;

FLDDPNormalized: L_Arg0;
	M1_L;
	L_Arg1;
	N1_L,:StoreAndReturn;

;----------------------------------------------------------------------
; FSTDP
;----------------------------------------------------------------------
!1,2,FSTDPE1OK,FSTDPE1Overflow;
!1,2,FSTDPShift,FSTDPNormalized;

Routine17: L_AC0;
	Arg0_L;
	L_6,:LoadRegOne;
LoadOneRet6: T_E1;
	L_17-T;	E1 must be < 16 decimal
	E1_L,SH<0;
	NOP,:FSTDPE1OK;	!1,2,FSTDPE1OK,FSTDPE1Overflow

FSTDPE1Overflow: L_4,:DoErrorReturn;

FSTDPShift: L_T_M1,:FSTDPSh1;
FSTDPE1OK: L_T_M1;	high order
FSTDPSh1:	M1_L RSH 1;
	L_N1,TASK;
	N1_L MRSH 1;
	L_E1-1,BUS=0;
	E1_L,:FSTDPShift;	FSTDPShift,FSTDPNormalized;

FSTDPNormalized: SINK_S1,BUS=0;
	T_N1,:FSTDPNeg;	!1,2,FSTDPNeg,FSTDPPos;

FSTDPNeg:	L_0-T;	negate the double word, store S2=-1
FSTNeg:	N1_L,SH=0;
		T_M1,:FSTDPLowNonZero;	!1,2,FSTDPLowNonZero,FSTDPLowZero;
FSTDPLowNonZero:	L_ALLONES XOR T,:FSTDPStore;	complement
FSTDPLowZero:		L_0-T,:FSTDPStore;			negate if low word 0
FSTDPStore:	M1_L;

FSTDPPos:	MAR_AC1;
	TASK;
	MD_M1;
	MAR_AC1+1;
	TASK;
	MD_N1,:ret;
(1270)\8912v2V336v3V13v3V7v2V