float.s

TCP-IP红宝书源代码

	moveml	sp@+,#0xC		|pop d2,d3
	unlk	a6
	rts

|
|add, subtract, compare two floating point numbers
|d0,d1 return result of fadd,fsub operations
|result of afadd,afaddf,afsub,afsubf stored
|fcmp sets condition codes upon return
|
	.globl	fsub
	.globl	fadd
	.globl	fcmp
	.globl	afadd
	.globl	afsub
	.globl	afaddf
	.globl	afsubf
	.text
fadd:
	link	a6,#0
	clrw	d0			|flag to getargs
	jsr	getargs			|get arguments
	jsr	add			|perform addition
	unlk	a6
	rts
fsub:
	link	a6,#0
	clrw	d0			|flag to getargs
	jsr	getargs			|get arguments
	eorw	#1,a1@			|reverse sign of b-arg
	jsr	add			|perform addition
	unlk	a6
	rts
fcmp:
	link	a6,#0
	clrw	d0			|flag to getargs
	jsr	getargs			|get arguments
	eorw	#1,a1@			|reverse sign of b-arg
	jsr	add			|perform compare
	tstl	d0			|set condition code
	unlk	a6
	rts
afadd:
	link	a6,#0
	moveq	#1,d0			|flag to getargs
	jsr	getargs			|get arguments
	jsr	add			|perform addition
	movl	a6@(8),a0		|a0 points to where
	movl	d0,a0@+			|  to store result
	movl	d1,a0@			|  of operation
	unlk	a6
	rts
afsub:
	link	a6,#0
	moveq	#1,d0			|flag to getargs
	jsr	getargs			|get arguments
	eorw	#1,a1@			|reverse sign of b-arg
	jsr	add			|perform addition
	movl	a6@(8),a0		|a0 points to where
	movl	d0,a0@+			|  to store result
	movl	d1,a0@			|  of operation
	unlk	a6
	rts
afaddf:
	link	a6,#0
	moveq	#1,d0			|flag to getargs
	jsr	getargs			|get arguments
	clrl	a0@(MANL)		|clear lower part of a-arg
	jsr	add			|perform addition
	movl	a6@(8),a0		|a0 points to where
	movl	d0,a0@			|  to store result
	unlk	a6
	rts
afsubf:
	link	a6,#0
	moveq	#1,d0			|flag to getargs
	jsr	getargs			|get arguments
	clrl	a0@(MANL)		|clear lower part of a-arg
	eorw	#1,a1@			|reverse sign of b-arg
	jsr	add			|perform addition
	movl	a6@(8),a0		|a0 points to where
	movl	d0,a0@			|  to store result
	unlk	a6
	rts
add:
	moveml	#0x3000,sp@-		|save d2,d3
	movw	a0@(EXPT),d0		|compare
	movw	a1@(EXPT),d1		|  exponents
	subw	d1,d0			|  of a and b
	bmi	1$			|a_expt < b_expt
	movl	a1,a0			|switch a0 to point to bfloat
	jsr	shift			|shift mantissa of bfloat
	movl	#afloat,a1		|switch a1 to point to afloat
	addw	d0,a0@(EXPT)		|adjust b_expt accordingly
	bra	2$
1$:	negw	d0			|make the shift count positive
	jsr	shift			|shift mantissa of afloat
	addw	d0,a0@(EXPT)		|adjust a_expt accordingly
2$:	tstw	a0@
	beq	3$			|a-arg is negative so
	negl	d3			|  negate mantissa
	negxl	d2			|  for addition
3$:	movl	a1@(MANH),d0
	movl	a1@(MANL),d1
	tstw	a1@
	beq	4$			|b-arg is negative so
	negl	d1			|  negate mantissa
	negxl	d0			|  for addition
4$:	addl	d1,d3			|perform addition of
	addxl	d0,d2			|  mantissas
	tstl	d2			|check sign of result
	bge	5$
	negl	d3			|result is negative so
	negxl	d2			|  negate mantissa
	orw	#1,a0@			|  and set sign
	bra	adde
5$:	andw	#0,a0@			|result positive

adde:	movl	d2,a0@(MANH)		|store result
	movl	d3,a0@(MANL)		|  of computation
	jsr	normal			|normalize result
	jsr	itoe			|convert to external form
	moveml	sp@+,#0xC		|pop d2,d3
	rts

|
|negate a floating number
|argument on stack
|d0,d1 return result
|
	.globl	fneg
	.text
fneg:
	link	a6,#0
	movl	a6@(12),d1		|d1 = low part of float
	movl	a6@(8),d0		|d0 = high part of float
	bmi	1$			
	orl	#0x80000000,d0		|turn high order bit on
	bra	2$
1$:	andl	#0x7FFFFFFF,d0		|turn high order bit off
2$:	unlk	a6
	rts	

|
|multiply two floating numbers
|d0,d1 return result for fmul
|result for afmul,afmulf stored
|
	.globl	fmul
	.globl	afmul
	.globl	afmulf
	.text
fmul:
	link	a6,#0
	clrw	d0			|flag to getargs
	jsr	getargs			|get arguments
	jsr	mult			|multiply arguments
	unlk	a6
	rts
afmul:
	link	a6,#0
	moveq	#1,d0			|flag to getargs
	jsr	getargs			|get arguments
	jsr	mult			|perform multiply
	movl	a6@(8),a0		|a0 points to where
	movl	d0,a0@+			|  to store result
	movl	d1,a0@			|  of operation
	unlk	a6
	rts
afmulf:
	link	a6,#0
	moveq	#1,d0			|flag to getargs
	jsr	getargs			|get arguments
	jsr	mult			|perform multiply
	movl	a6@(8),a0		|a0 points to where
	movl	d0,a0@			|  to store result
	unlk	a6
	rts
mult:
	moveml	#0x3C20,sp@-		|save d2-d5,a2
	movw	a1@+,d0			|d0 = sign of b-arg
	eorw	d0,a0@+			|a_sign gets resultant sign
	movw	a1@+,d0 		|d0 = exponent of b-arg
	addw	d0,a0@+			|a_expt gets sum of exponents

	clrl	d2			|clear
	clrl	d3			|  summation registers
	clrl	d5			|  for multiply
	moveq	#4,d4			|loop count
	addql	#8,a1			|adjust a1 pointer
	movl	#lsum,a2		|adjust a2 pointer
l1$:	movw	a0@+,d0			|high to low words of afloat
	movw	a1@-,d1			|low to high words of bfloat
	mulu	d0,d1			|perform multiply
	addl	d1,d3
	addxl	d5,d2	
	subqw	#1,d4
	bne	l1$
	movl	d4,a2@+
	movl	d2,a2@+
	movl	d3,a2@

	clrl	d2
	clrl	d3
	moveq	#3,d4			|loop count
	subql	#2,a0			|adjust a0 pointer
	addql	#2,a2			|adjust a2 pointer
l2$:	movw	a0@-,d0			|low to high of afloat
	movw	a1@+,d1			|high to low of bfloat
	mulu	d0,d1			|perform multiply
	addl	d1,d3
	addxl	d5,d2
	subqw	#1,d4
	bne	l2$
	movl	a2@-,d1
	movl	a2@-,d0
	addl	d1,d3
	addxl	d0,d2
	movl	d2,a2@+
	movl	d3,a2@	
	
	clrl	d2
	clrl	d3
	moveq	#2,d4			|loop count
	subql	#2,a1			|adjust a1 pointer
	addql	#2,a2			|adjust a2 pointer
l3$:	movw	a0@+,d0			|high to low of afloat
	movw	a1@-,d1			|low to high of bfloat
	mulu	d0,d1
	addl	d1,d3
	addxl	d5,d2
	subqw	#1,d4
	bne	l3$
	movl	a2@-,d1
	movl	a2@-,d0
	addl	d1,d3
	addxl	d0,d2
	movl	d2,a2@+
	movl	d3,a2@

	subql	#2,a0			|adjust a0 pointer
	addql	#2,a2			|adjust a2 pointer
	movw	a0@-,d0
	movw	a1@+,d1
	mulu	d0,d1
	addl	d1,a2@-

multe:	addql	#1,a2			|adjust a2 pointer
	movb	a2@+,a0@+		|move result
	movb	a2@+,a0@+		|  to afloat
	movb	a2@+,a0@+
	movb	a2@+,a0@+
	movb	a2@+,a0@+
	movb	a2@+,a0@+
	movb	a2@+,a0@+
	movb	a2@+,a0@+
	subql	#8,a0			|align a0 to point
	subql	#4,a0			|  to afloat
	jsr	normal			|normalize result
	jsr	itoe			|convert to external form
	moveml	sp@+,#0x43C		|pop registers
	rts

|
|divide two floating numbers
|
	.globl	fdiv
	.globl	afdiv
	.globl	afdivf
	.text
fdiv:
	link	a6,#0
	clrl	d0			|flag to getargs
	jsr	getargs			|get arguments
	jsr	div			|divide arguments
	unlk	a6
	rts
afdiv:
	link	a6,#0
	moveq	#1,d0			|flag to getargs
	jsr	getargs			|get arguments
	jsr	div			|divide arguments
	movl	a6@(8),a0		|a0 points to where
	movl	d0,a0@+			|  to store result
	movl	d1,a0@			|  of operation
	unlk	a6
	rts
afdivf:
	link	a6,#0
	moveq	#1,d0			|flag to getargs
	jsr	getargs			|get arguments
	jsr	div			|divide arguments
	movl	a6@(8),a0		|a0 points to where
	movl	d0,a0@			|  to store result
	unlk	a6
	rts
div:
	moveml	#0x3E00,sp@-		|save d2-d6
	movw	a1@+,d0			|d0 = sign of b-arg
	eorw	d0,a0@+			|a-sign gets resultant sign
	movw	a1@+,d0			|d0 = exponent of b-arg
	subw	d0,a0@+			|a-expt gets diff of exponents
	movl	a1@+,d0			|d0 = divisor high
	bne	ok			|if divisor = 0
	divu	d0,d1			|  cause trap and core dump

ok:	movl	a1@,d1			|d1 = divisor low
	movl	a0@+,d2 		|d2 = dividend high
	movl	a0@,d3			|d3 = dividend low
	clrl	d4			|clear quotient
	clrl	d5			|  register set
	moveq	#58,d6			|setup shift count
	bra	2$

1$:	subqw	#1,d6			|exit computation when
	beq	dive			|  loop count = 0
	movw	#0x10,cc		|set x-bit in ccr
	roxll	#1,d5			|shift 1 into quotient
	roxll	#1,d4			|  accumulator registers
	roxll	#1,d3			|continue shift into
	roxll	#1,d2			|  into remainder registers
2$:	subl	d1,d3			|subtract divisor from
	subxl	d0,d2			|  remainder
	bge	1$

3$:	subqw	#1,d6			|exit computation when
	beq	dive			|  loop count = 0
	asll	#1,d5			|shift 0 into quotient
	roxll	#1,d4			|  accumulator registers
	roxll	#1,d3			|continue shift into
	roxll	#1,d2			|  remainder registers
	addl	d1,d3			|add divisor to
	addxl	d0,d2			|  remainder
	bge	1$			|positive -> shift 1
	bra	3$			|negative -> shift 0

dive:	subql	#4,a0			|align a0 to mantissa
	movl	d4,a0@+			|store quotient
	movl	d5,a0@			|  into afloat mantissa
	subql	#8,a0			|align a0 to afloat
	jsr	normal			|normalize mantissa
	jsr	itoe			|convert to external float
	moveml	sp@+,#0x7C		|pop d2-d6
	rts