/ EAE MULT FOR FORTRAN (8K)
/ WRITTEN BY DON PARKER
/ DEPT. OF CHEMISTRY
/ CLARKSON COLLEGE OF TECHNOLOGY
/ POTSDAM, NEW YORK 13676  3/7/73
/ DECUS NO. 8-615
	LAP		/LEAVE AUTOMATIC PAGING
/ TEMP STORAGE ON PAGE ZERO OF CURRENT FIELD
	ABSYM AC1 100
	ABSYM AC2 101
	ABSYM AC3 102
	ABSYM ACEXP 103
	ABSYM ACSIGN 104
	ABSYM OP1 105
	ABSYM OP2 106
	ABSYM OP3 107
	ABSYM OPEXP 110
	ABSYM OPSIGN 111
	ABSYM HOLD1 112
	ABSYM HOLD2 113
	ABSYM HOLD3 114
	ABSYM HOLD4 115
	ABSYM MULT20 116
	ABSYM MULT00 117
	ABSYM MULT 120
/ ADD THESE SYMBOLS TO SABR
	OPDEF LSR 7417
	OPDEF MUY 7405
	OPDEF MQL 7421
	OPDEF MQA 7501
	OPDEF TADI 1400		/FAKE INDIRECT ADD
	OPDEF DCAI 3400
	OPDEF JMSI 4400
	OPDEF JMPI 5400
	OPDEF CDF10 6211	/=CDF 10
	OPDEF RIF 6224
C7,	7
M201,	-201
C377,	377
C6201,	6201
MUL00,	MULT0
XSET,	SETUP
MUL,	MULTA
ZERO,	DCA AC3
	DCA AC1
	DCA AC2
	JMPI MEXIT		/TO SAVE SPACE
MEXIT,	MUEXIT
IARG,	0			/TEMP STORAGE
	ENTRY FMP
FMP,	BLOCK 2
	TAD FMP			/GET FIELD
	DCA X1
X1,	HLT
	TADI FMP#		/ACCESS CALL IN FIELD
	DCA X2
	INC FMP#
	TADI FMP#		/GET ADDRESS OF ARG
	DCA IARG
	INC FMP#		/BUMP SUBROUTINE RETURN
X2,	HLT			/DATA FIELD OF ARG
	TADI IARG
	DCA OP1			/GET OP1
	INC IARG
	TADI IARG		/GET OP2
	DCA OP2
	INC IARG
	TADI IARG		/GET OP3
	DCA OP3
	JMSI XSET		/SET UP FLOATING AC
	RIF
	TAD C6201
	DCA X3			/CHANGE DATA FIELD TO CUR?
X3,	HLT
	TAD AC1			/UNPACK AC EXPONENT
	CLL RTR
	RAR
	AND C377
	DCA ACEXP
	TAD OP1			/UNPACK OP EXPONENT
	CLL RTR
	RAR
	AND C377
	TAD ACEXP		/FORM EXPONENT OF RESULT
	TAD M201
	DCA ACEXP
	CLL CLA CML RAR		/PUT 4000 IN AC
	AND AC1			/STRIP AC SIGN
	DCA ACSIGN
	CLL CLA CML RAR
	AND OP1			/STRIP OP SIGN
	TAD ACSIGN		/FORM SIGN OF RESULT
	DCA ACSIGN
	TAD AC1
	AND C7			/MASK MANTISSA
	SNA			/SEE IF MULT. BY ZERO
	JMP ZERO		/YES
	DCA AC1
	TAD OP1
	AND C7
	SNA			/CHECK AGAIN FOR ZERO
	JMP ZERO
	DCA OP1
	TAD MUL00		/SET UP ADDRESSES ON PAGE 0
	DCA MULT00
	TAD MUL
	DCA MULT
CONS,	CLA CLL			/START 27 BIT BY 27 BIT M?
	TAD OP3
	DCAI MULT00
	TAD AC2
	JMSI MULT		/LOW OPERAND BY MIDDLE AC
	CLA			/DISREGARD LOW BITS
	TAD MULT20
	DCA HOLD4
	TAD OP2
	DCAI MULT00
	TAD AC3
	JMSI MULT		/MIDDLE OPERAND BY LOW AC
	CLA
	TAD MULT20
	TAD HOLD4		/ADD TO PREVIOUS RESULT
	DCA HOLD4
	RAL
	DCA HOLD3		/STORE CARRY OVER
	TAD AC2
	DCAI MULT00
	TAD OP2
	JMSI MULT		/MIDDLE AC BY MIDDLE OP
	TAD HOLD4
	DCA HOLD4
	RAL
	TAD HOLD3
	DCA HOLD3
	TAD MULT200
	TAD HOLD3
	DCA HOLD3
	RAL
	DCA HOLD2
	TAD OP3
	DCAI MULT00
	TAD AC1
	JMSI MULT		/LOW OPERAND BY HIGH AC
	TAD HOLD4
	DCA HOLD 4
	RAL
	TAD MULT20
	TAD HOLD3
	DCA HOLD3
	RAL
	TAD HOLD2
	DCA HOLD2
	TAD OP1
	DCAI MULT00
	TAD AC3
	JMSI MULT		/HIGH OPERAND BY LOW AC
	TAD HOLD4
	DCA AC3			/THIRD WORD FORMED
NORUP,	RAL
	TAD MULT20
	TAD HOLD3
	DCA HOLD3
	RAL
	TAD HOLD2
	DCA HOLD2
	TAD OP2
	DCAI MULT00
	TAD AC1
	JMSI MULT		/MIDDLE OPERAND BY HIGH AC
	TAD HOLD3
	DCA HOLD3
	RAL
	TAD MULT20
	TAD HOLD2
	DCA HOLD2
	RAL
	DCA HOLD1
	TAD OP1
	DCAI MULT00
	TAD AC2
	JMSI MULT		/HIGH OPERAND BY MIDDLE AC
	TAD HOLD3
	DCA AC2			/SECOND WORD FORMED
	RAL
	TAD MULT20
	TAD HOLD2
	DCA HOLD2
	RAL
	TAD HOLD1
	DCA HOLD1
	TAD OP1
	DCAI MULT00
	TAD AC1
	JMSI MULT		/HIGH AC BY HIGH OPERAND
	TAD HOLD2
	DCA AC1
	TAD AC1			/NORMALIZE
	AND C0040		/IF THIS BIT IS SET ADD 1
				/TO ACEXP AND SHIFT RIGHT 3
	SZA CLA
	JMP NOR1
	CLA IAC
NOR,	DCA SHFT		/STORE # OF RIGHT SHIFTS -1
	MQL
	TAD AC1
	JMS ROT
	DCA AC1			/FIRST WORD NORMALIZED
	MQA MQL			/LOAD AC AND CLEAR MQ
	DCA HOLD2
	TAD AC2
	JMS ROT
	TAD HOLD2		/SECOND WORD
	DCA AC2
	MQA MQL
	DCA HOLD2
	TAD AC3
	JMS ROT
	TAD HOLD2
	DCA AC3			/THIRD WORD
	CLA IAC			/PUT 1 IN AC
	TAD AC3
	SZA CLA			/IF AC3=7777 SKIP
	JMS ROUND
	JMP UNDER
NORRET,	TAD ACEXP		/FORM WORD 1
	CLL RTL
	RAL
	TAD ACSIGN		/ADD SIGN
	TAD AC1
	DCA AC1
MUEXIT,	CDF10			/STORE RESULTS IN FLOATING ?
	TAD AC1
	DCAI A20
	TAD AC2
	DCAI A21
	TAD AC3
	DCAI A22
	RETRN FMP
MULTA,	0			/12 BY 12 BIT MULT.
	MQL MUY
MULT0,	0
	DCA MULT20
	MQA			/LEAVE MQ IN AC
	JMPI MULTA
NOR1,	ISZ ACEXP		/BUMP ACEXP
	CLL CLA IAC RAL		/PUT 2 IN AC
	JMP NOR
OVER,	TAD ACEXP		/CHECK FOR OVERFLOW
	TAD M400		/377 IS LARGEST EXP
	SPA CLA
	JMP NORRET
	JMS MERR
	CALL 0,EXIT
UNDER,	TAD ACEXP
	SMA CLA			/IF NEG. UNDERFLOW
	JMP OVER
	JMS MERR
	JMPI XZERO		/ZERO AC
MERR,	0
	CALL 1,ERROR
	ARG ERR
	JMPI MERR
XZERO,	ZERO
SETUP,	0
	CDF10			/ACCESS FIELD 1
	TADI A20
	DCA AC1
	TADI A21
	DCA AC2
	TADI A22
	DCA AC3
	JMPI SETUP
ROT,	0
	LSR
SHFT,	0
	JMPI ROT
A20,	20
A21,	21
A22,	22
C0040,	0040
M400,	-400
ROUND,	0			/CHECK FOR ROUNDING
	MQA
	SPA CLA			/ROUND UP IF AC IS NEG.
	ISZ AC3			/AC3 CANNOT OVERFLOW
	JMPI ROUND
ERR,	620			/FP
	522			/ER
	END
	DCAI A22
	RETRN FMP
MULTA,	0			/12 BY 12 BIT MULT.
	MQL MUY
MULT0,	0
	DCA MULT20
	MQA			/LEAVE MQ IN AC
	JMPI MULTA
NOR1,	ISZ ACEXP		/BUMP ACEXP
	CLL CLA IAC RAL		/PUT 2 IN AC
	JMP NOR
OVER,	TAD ACEXP		/CHECK FOR OVERFLOW
	TAD M400		/377 IS LARGEST EXP
	SPA CLA
	JMP NORRET
	JMS MERR
	CALL 0,EXIT
UNDER,	TAD ACEXP
	SMA CLA			/IF NEG. UNDERFLOW
	JMP OVER
	JMS MERR
	JMPI XZERO		/ZERO AC
MERR,	0
	CALL 1,ERROR
	ARG ERR
	JMPI MERR
XZERO,	ZERO
SETUP,	0
	CDF10			/ACCESS FIELD 1
	TADI A20
	DCA AC1
	TADI A21
	DCA AC2
	TADI A22
	DCA AC3
	JMPI SETUP
ROT,	0
	LSR
SHFT,	0
	JMPI ROT
A20,	20
A21,	21
A22,	22
C0040,	0040
M400,	-400
ROUND,	0			/CHECK FOR ROUNDING
	MQA
	SPA CLA			/ROUND UP IF AC IS NEG.
	ISZ AC3			/AC3 CANNOT OVERFLOW
	JMPI ROUND
ERR,	620			/FP
	522			/ER
	END