Google
 

Trailing-Edge - PDP-10 Archives - klad_sources - klad.sources/dfmp.mac
There are no other files named dfmp.mac in the archive.
SUBTTL	DFMP	DOUBLE PRECISION FLOATING MULTIPLY

;*FOR KI10 SIMULATION/DIAGNOSTICS  13-OCT-71, J.R.KIRCHOFF
;*	7-DEC-69 /TWE, 12-MAY-70 /JRK
;*	DICK GRUEN: 9-SEP-67
;*	7-MAY-66 BEGOT 9-SEP-67  ( MACROX Q ERRORS )
;*THESE ROUTINES MULTIPLY TWO DOUBLE PRECISION FLOATING
;*NUMBERS.  EACH NUMBER HAS AN 8-BIT EXPONENT AND A
;*MANTISSA COMPOSED OF THE REMAINING 27 HI ORDER BITS AND
;*33 OF THE 35 LO ORDER ARITMETIC BITS.  THE ANSWER IS RE-
;*TURNED EITHER IN AC X OR IN MEMORY DEPENDING UPON THE
;*ENTRY USED.  THE "X" IS THE DOUBLE PRECISION AC USED AND
;*MAY BE 0,2,4, OR 6.  X IS ALSO SPECIFIED BY THE ENTRY
;*USED.  THE ROUTINE IS CALLED BY:

;*FMP:	MOVEI	Q,ARG2
;*	PUSHJ	P,DFM.X	;ARG1 IN AC X

;*	OR

;*FMPM:	MOVEI	Q,ARG2
;*	PUSHJ	P,DFMM.X	;ARG1 IN AC X

;*	NOTE THAT THE "X" AFTER THE "." IS A NUMBER, NOT
;*	A LETTER.

P==17
Q==16
AC2==10
T3==12
AC1==13
T4==15

BITNEG==1B18

	DEFINE	DM(A)<
DFMM.'A':	SKIPA	AC1,Q
DFM.'A':	MOVEI	AC1,A
	IFN A,<
	HRLI	Q,A
	JRST	DFMPX
>>
	DEFINE	GOODY(A)<
	DM	0
>

	GOODY
DFMPX:	PUSH	P,AC1		;ALL ROUTINES ENTER HERE
	SKIPN	T3,0(Q)		;HI ORDER OF ARG2
	JRST	2,@[XWD 0,D.ZERO]		;ZERO PRODUCT
	JUMPL	T3,NEG2A		;IF -, PICK UP COMPL
	MOVE	AC2,T3		;+, PLACE IN AC2
	MOVE	AC2+1,1(Q)	;...
NEG2RT:!MOVSS	Q		;GET ARG1
	SKIPN	AC1,0(Q)	;LOOK AT ARG1
	JRST	2,@[XWD 0,D.ZERO]		;ZERO PRODUCT
	XOR	T3,AC1		;GET ANSWER SIGN
	HLL	Q,T3		;SALT IT AWAY
	JUMPL	AC1,NEG1A	;IF -, PICK UP ARG1 COMPL
	MOVE	AC1+1,1(Q)	;PICK UP +
NEG1RT:!LDB	T4,DPAC.1	;GET EXPS
	LDB	T3,DPAC.2	;...
	ADDI	T4,-200(T3)	;GET PREDICTED EXP (EXCESS 200)
	ANDI T4,077777	;MASK EXPONENT TO 15 BITS
	TLNE	Q,400000	;IF RESULT SHOULD BE NEG, ...
	TRO	T4,BITNEG	;SET INDICATOR
	HRL	Q,T4		;SALT AWAY PROPOSED EXP
	TLZ	AC1,777000	;REMOVE EXPS
	TLZ	AC2,777000	;...
	ASHC	AC1,5		;MAKE SEMI-PRODUCTS MORE SIGNIFICANT
	ASHC	AC2,5		;...
	MUL	AC1+1,AC2	;FORM LO ORDER SEMI-PRODS
	MUL	AC2+1,AC1	;...
	MOVE	T3,AC1+1	;PROTECT FROM CREEPING SIGNIFICANCE
	MUL	AC1,AC2		;HI ORDER SEMI-PROD
	JCRY1	.+1		;CLEAR FLAG
	ADD	AC1+1,T3	;FIRST LO SEMI-PROD
	JCRY1	[AOJA AC1,A1RT]	;ADD IN CARRY
A1RT:!	ADD	AC1+1,AC2+1	;SECOND LO SEMI-PROD
	JCRY1	[AOJA AC1,A2RT]	;ADD IN CARRY
A2RT:!	TRNE	AC1+1,2		;PATCH FOR MORE PRECISION
	ADDI	AC1+1,2
	ASHC	AC1,-2
	HLRZ	T4,Q		;RECLAIM EXP
	JRST	D.MORM		;GO NORMALIZE AND RETURN

NEG2A:!	SETCM	AC2,T3		;TW0S COMPL ARG2
	MOVN	AC2+1,1(Q)	;...
	TDNN	AC2+1,DLOW.0	;...
	AOJA	AC2,NEG2RT	;...
	JRST	NEG2RT	;...

NEG1A:!	SETCM	AC1,AC1		;TWOS COMPL ARG2
	MOVN	AC1+1,1(Q)	;...
	TDNN	AC1+1,DLOW.0	;...
	AOJA	AC1,NEG1RT	;...
	JRST	NEG1RT		;...