extarith.asm

Turbo Pascal 6.0编译器源码

	model	large extend_text,pascal
	include	extend.inc

	.code	Extend_Text

Break	proc	far
	uses	si,di
	push	ss
	pop	es
	sub	dx,dx
	cld
	mov	cx,4
	rep	movsw
	lodsw
	shl	ax,1
	rcl	dx,1
	shr	ax,1
	stosw
	xchg	ax,dx
	stosw
	ret
Break	endp

CheckNan	proc	near Num:dword
	les	bx,Num
	cmp	word ptr es:[bx+8],7fffh
	jne	@@2
	les	bx,Num
	cmp	word ptr es:[bx+6],8000h
	jne	@@1
	les	bx,Num
	cmp	word ptr es:[bx],0
	jne	@@1
	les	bx,Num
	cmp	word ptr es:[bx+2],0
	jne	@@1
	les	bx,Num
	cmp	word ptr es:[bx+4],0
	je	@@2
@@1:	mov	ax,1
	jmp	short @@3
@@2:	xor	ax,ax
@@3:	jmp	short @@4
@@4:	ret
CheckNan	endp

	Argm	Flag,byte,1
	Argm	A,dword,1
	Argm	B,dword,1
	Loc	Temp2,word,6
	Loc	Temp1,word,6
	Loc	J,byte,1
	Loc	I,byte,1
	Entry	AddSub
	push	si di
	push	ds
	lds	si,A
	lea	di,Temp1
	call	Break
	lds	si,B
	lea	di,Temp2
	call	Break
	pop	ds
	lea	si,Temp1
	lea	di,Temp2
	mov	al,byte ptr Flag
	xor	al,byte ptr Temp2[10]
	mov	byte ptr Temp2[10],al
	xor	al,byte ptr Temp1[10]
	mov	byte ptr Flag,al
	mov	ax,Temp1[8]
	mov	bx,Temp2[8]
	cmp	ax,7fffh
	jae	@@3
	cmp	bx,7fffh
	jae	@@2
	cmp	ax,bx
	jae	@@1
	mov	cl,byte ptr Temp2[10]
	mov	byte ptr Temp1[10],cl
	mov	Temp1[8],bx
	xchg	ax,bx
	xchg	si,di
@@1:	or	bx,bx
	ja	@@5
	jmp	short @@4
@@2:	mov	si,di
	mov	ax,Temp2[8]
	mov	Temp1[8],ax
	mov	ax,Temp2[10]
	mov	Temp1[10],ax
@@3:	mov	ax,Temp1[8]
	cmp	ax,Temp2[8]
	jne	@@4
	mov	ax,Temp1[10]
	cmp	ax,Temp2[10]
	je	@@4
	mov	Temp1[10],0
	mov	ax,0
	mov	bx,0
	mov	cx,0
	mov	dx,0c000h
	jmp	@@16
@@4:	mov	ax,ss:[si]
	mov	bx,ss:[si+2]
	mov	cx,ss:[si+4]
	mov	dx,ss:[si+6]
	jmp	@@16
@@5:	sub	ax,bx
	cmp	ax,64
	jg	@@4
	mov	I,al
	mov	ax,ss:[di]
	mov	bx,ss:[di+2]
	mov	cx,ss:[di+4]
	mov	dx,ss:[di+6]
	mov	J,0
	sub	I,8
	jl	@@7
@@6:	mov	J,al
	mov	al,ah
	mov	ah,bl
	mov	bl,bh
	mov	bh,cl
	mov	cl,ch
	mov	ch,dl
	mov	dl,dh
	mov	dh,0
	sub	I,8
	jge	@@6
@@7:	and	I,7
	jz	@@9
@@8:	shr	dx,1
	rcr	cx,1
	rcr	bx,1
	rcr	ax,1
	rcr	J,1
	dec	I
	jnz	@@8
@@9:	sub	di,di
	cmp	Flag,0
	jne	@@10
	add	ax,ss:[si]
	adc	bx,ss:[si+2]
	adc	cx,ss:[si+4]
	adc	dx,ss:[si+6]
	jnc	@@14
	rcr	dx,1
	rcr	cx,1
	rcr	bx,1
	rcr	ax,1
	rcr	J,1
	inc	Temp1[8]
	jmp	short @@14
@@10:	xor	byte ptr Temp1[10],1
	sub	ax,ss:[si]
	sbb	bx,ss:[si+2]
	sbb	cx,ss:[si+4]
	sbb	dx,ss:[si+6]
	jnc	@@11
	xor	byte ptr Temp1[10],1
	not	dx
	not	cx
	not	bx
	not	ax
	neg	J
	cmc
	adc	ax,di
	adc	bx,di
	adc	cx,di
	adc	dx,di
@@11:	mov	si,64
	or	dh,dh
	js	@@14
@@12:	dec	si
	jz	@@13
	shl	J,1
	rcl	ax,1
	rcl	bx,1
	rcl	cx,1
	adc	dx,dx
	jns	@@12
	sub	si,64
	add	Temp1[8],si
	jmp	@@14
@@13:	mov	Temp1[8],0
	mov	byte ptr Temp1[10],0
	jmp	short @@16
@@14:	shl	J,1
	adc	ax,di
	adc	bx,di
	adc	cx,di
	adc	dx,di
	jnc	@@15
	rcr	dx,1
	inc	Temp1[8]
@@15:	cmp	Temp1[8],7fffh
	jae	@@17
	cmp	Temp1[8],0
	je	@@18
@@16:	les	di,A
	cld
	stosw
	xchg	ax,bx
	stosw
	xchg	ax,cx
	stosw
	xchg	ax,dx
	stosw
	mov	ax,Temp1[8]
	shl	ax,1
	or	al,byte ptr Temp1[10]
	ror	ax,1
	stosw
	jmp	short @@20
@@17:	mov	Temp1[8],7fffh
	jmp	short @@19
@@18:	mov	Temp1[8],0
@@19:	sub	ax,ax
	mov	bx,ax
	mov	cx,ax
	mov	dx,ax
	jmp	@@16
@@20:	pop	di si
	Exit

	Argm	A,dword,1
	Argm	B,dword,1
	Entry	ExtAdd
	mov	al,0
	push	ax
	push	A
	push	B
	call	AddSub
	Exit

	Argm	A,dword,1
	Argm	B,dword,1
	Entry	ExtSub
	mov	al,1
	push	ax
	push	A
	push	B
	call	AddSub
	Exit

	Argm	A,dword,1
	Argm	B,dword,1
	Loc	Temp2,word,6
	Loc	Temp1,word,6
	Entry	ExtMul
	push	si di
	push	ds
	lds	si,A
	lea	di,Temp1
	call	Break
	lds	si,B
	lea	di,Temp2
	call	Break
	pop	ds
	mov	cl,byte ptr Temp2[10]
	xor	byte ptr Temp1[10],cl
	mov	bx,Temp2[8]
	mov	ax,Temp1[8]
	cmp	ax,7fffh
	jae	@@5
	cmp	bx,7fffh
	jae	@@9
	cmp	ax,bx
	jb	@@1
	xchg	ax,bx
@@1:	or	ax,ax
	jz	@@3
	add	ax,bx
	sub	ax,3ffeh
	jb	@@3
	jmp	@@13
@@2:	mov	di,7fffh
	mov	dx,8000h
	jmp	short @@4
@@3:	sub	di,di
	mov	dx,0
@@4:	sub	ax,ax
	mov	bx,ax
	mov	cx,ax
	jmp	@@22
@@5:	cmp	Temp2[8],0
	je	@@6
	push	ss
	lea	ax,Temp1
	push	ax
	call	CheckNan
	or	ax,ax
	jz	@@7
@@6:	jmp	short @@12
@@7:	les	bx,A
	and	word ptr es:[bx+8],7fffh
	test	Temp1[10],0ffh
	jz	@@8
	les	bx,A
	xor	word ptr es:[bx+8],8000h
@@8:	jmp	@@23
@@9:	cmp	Temp1[8],0
	je	@@10
	push	ss
	lea	ax,Temp2
	push	ax
	call	CheckNan
	or	ax,ax
	jz	@@11
@@10:	jmp	short @@12
@@11:	mov	di,7fffh
	mov	ax,Temp2[0]
	mov	bx,Temp2[2]
	mov	cx,Temp2[4]
	mov	dx,Temp2[6]
	jmp	@@22
@@12:	mov	dx,0c000h
	mov	di,7fffh
	jmp	@@4
@@13:	mov	Temp1[8],ax
	sub	di,di
	mov	cx,di
	mov	si,di
	test	byte ptr Temp2[3],80h
	jz	@@14
	mov	cx,Temp1[0]
	mov	si,Temp1[2]
@@14:	test	byte ptr Temp1[3],80h
	jz	@@15
	add	cx,Temp2[0]
	adc	si,Temp2[2]
	adc	di,di
	test	byte ptr Temp2[3],80h
	jz	@@15
	dec	di
@@15:	sub	bx,bx
	mov	ax,Temp2[0]
	mul	Temp1[4]
	add	cx,ax
	adc	si,dx
	adc	di,0
	mov	ax,Temp2[4]
	or	ax,ax
	jz	@@16
	mul	Temp1[0]
	add	cx,ax
	adc	si,dx
	adc	di,0
	mov	ax,Temp2[4]
	mul	Temp1[2]
	add	si,ax
	adc	di,dx
	adc	bx,0
@@16:	mov	ax,Temp2[0]
	mul	Temp1[6]
	add	si,ax
	adc	di,dx
	adc	bx,0
	mov	ax,Temp2[2]
	mul	Temp1[4]
	add	si,ax
	adc	di,dx
	adc	bx,0
	mov	ax,Temp2[6]
	or	ax,ax
	jz	@@17
	mul	Temp1[0]
	add	si,ax
	adc	di,dx
	adc	bx,0
@@17:	sub	cx,cx
	push	si
	mov	si,cx
	mov	ax,Temp2[2]
	mul	Temp1[6]
	add	di,ax
	adc	bx,dx
	adc	cx,0
	mov	ax,Temp2[4]
	or	ax,ax
	jz	@@18
	mul	Temp1[4]
	add	di,ax
	adc	bx,dx
	adc	cx,0
	mov	ax,Temp2[4]
	mul	Temp1[6]
	add	bx,ax
	adc	cx,dx
	adc	si,0
@@18:	mov	ax,Temp2[6]
	or	ax,ax
	jz	@@19
	mul	Temp1[2]
	add	di,ax
	adc	bx,dx
	adc	cx,0
	adc	si,0
	mov	ax,Temp2[6]
	mul	Temp1[4]
	add	bx,ax
	adc	cx,dx
	adc	si,0
	mov	ax,Temp2[6]
	mul	Temp1[6]
	add	cx,ax
	adc	si,dx
@@19:	mov	dx,si
	xchg	ax,di
	pop	si
	mov	di,Temp1[8]
	or	dx,dx
	js	@@20
	dec	di
	shl	si,1
	rcl	ax,1
	rcl	bx,1
	rcl	cx,1
	rcl	dx,1
@@20:	shl	si,1
	adc	ax,0
	adc	bx,0
	adc	cx,0
	adc	dx,0
	jnc	@@21
	rcr	dx,1
	inc	di
@@21:	cmp	di,7fffh
	jb	@@22
	jmp	@@2
@@22:	mov	si,di
	les	di,A
	cld
	stosw
	xchg	ax,bx
	stosw
	xchg	ax,cx
	stosw
	xchg	ax,dx
	stosw
	xchg	ax,si
	shl	ax,1
	or	al,byte ptr Temp1[10]
	ror	ax,1
	stosw
@@23:	pop	di si
	Exit

	Argm	A,dword,1
	Argm	B,dword,1
	Loc	M,byte,1
	Loc	N,byte,1
	Loc	K,word,1
	Loc	Q,word,1
	Loc	P,word,1
	Loc	Acc,word,4
	Loc	Temp2,word,6
	Loc	Temp1,word,6
	Entry	ExtDiv
	push	si di
	mov	K,0
	push	ds
	lds	si,A
	lea	di,Temp1
	call	Break
	lds	si,B
	lea	di,Temp2
	call	Break
	pop	ds
	mov	al,byte ptr Temp1[10]
	xor	al,byte ptr Temp2[10]
	mov	byte ptr Q,al
	mov	si,Temp2[8]
	mov	ax,Temp1[8]
	cmp	si,7fffh
	jae	@@3
	cmp	ax,7fffh
	jae	@@5
	or	si,si
	jz	@@1
	or	ax,ax
	jz	@@5
	add	ax,3ffeh
	sub	ax,si
	jb	@@3
	jmp	@@7
@@1:	mov	dx,7fffh
	mov	si,8000h
	or	ax,ax
	jnz	@@4
@@2:	mov	dx,7fffh
	mov	si,0c000h
	jmp	short @@4
@@3:	sub	dx,dx
	sub	si,si
	cmp	ax,7fffh
	je	@@2
@@4:	sub	ax,ax
	mov	bx,ax
	mov	cx,ax
	jmp	@@20
@@5:	les	bx,A
	and	word ptr es:[bx+8],7fffh
	test	Q,0ffh
	jz	@@6
	les	bx,A
	xor	word ptr es:[bx+8],8000h
@@6:	jmp	@@21
@@7:	mov	P,ax
	sub	cx,cx
	mov	dx,Temp1[6]
	mov	si,Temp2[6]
	cmp	si,dx
	ja	@@8
	sub	dx,si
	inc	cx
@@8:	mov	ax,Temp1[4]
	div	si
	adc	ax,1
	adc	cl,ch
	mov	M,cl
	mov	Acc[6],ax
	push	ax
	mov	ax,Temp2[0]
	mov	bx,Temp2[2]
	jcxz	@@10
	mov	dx,Temp2[4]
@@9:	sub	Temp1[0],ax
	sbb	Temp1[2],bx
	sbb	Temp1[4],dx
	sbb	Temp1[6],si
	loop	@@9
@@10:	pop	si
	mul	si
	mov	K,ax
	xchg	ax,dx
	xchg	ax,bx
	mul	si
	add	bx,ax
	adc	cx,dx
	mov	ax,Temp2[4]
	mul	si
	add	cx,ax
	adc	dx,0
	xchg	ax,dx
	xchg	ax,si
	mul	Temp2[6]
	add	ax,si
	adc	dx,0
	sub	bx,Temp1[0]
	sbb	cx,Temp1[2]
	sbb	ax,Temp1[4]
	sbb	dx,Temp1[6]
	mov	Temp1[0],bx
	mov	Temp1[2],cx
	mov	Temp1[4],ax
	mov	si,Temp2[6]
	div	si
	xchg	ax,cx
	div	si
	sub	dx,dx
	stc
	adc	ax,dx
	adc	cx,dx
	sub	dx,ax
	mov	Acc[4],dx
	sbb	Acc[6],cx
	sbb	M,0
	push	ax
	mov	ax,Temp2[0]
	mov	bx,Temp2[2]
	jcxz	@@12
	mov	dx,Temp2[4]
@@11:	sub	K,ax
	sbb	Temp1[0],bx
	sbb	Temp1[2],dx
	sbb	Temp1[4],si
	loop	@@11
@@12:	pop	si
	mul	si
	xchg	ax,dx
	xchg	ax,bx
	mul	si
	add	bx,ax
	adc	cx,dx
	mov	ax,Temp2[4]
	mul	si
	add	cx,ax
	adc	dx,0
	xchg	ax,dx
	xchg	ax,si
	mul	Temp2[6]
	add	ax,si
	adc	dx,0
	sub	bx,K
	sbb	cx,Temp1[0]
	sbb	ax,Temp1[2]
	sbb	dx,Temp1[4]
	mov	K,bx
	mov	Temp1[0],cx
	mov	Temp1[2],ax
	mov	si,Temp2[6]
	div	si
	xchg	ax,cx
	div	si
	sub	dx,dx
	stc
	adc	ax,dx
	adc	cx,dx
	mov	Acc[2],ax
	add	Acc[4],cx
	adc	Acc[6],dx
	adc	M,dl
	xchg	ax,si
	mov	dx,Temp2[2]
	xchg	ax,dx
	mov	bx,Temp2[4]
	jcxz	@@14
@@13:	sub	K,ax
	sbb	Temp1[0],bx
	sbb	Temp1[2],dx
	loop	@@13
@@14:	mul	si
	xchg	ax,dx
	xchg	ax,bx
	mul	si
	add	bx,ax
	adc	cx,dx
	mov	ax,Temp2[6]
	mul	si
	add	ax,cx
	adc	dx,0
	sub	bx,K
	sbb	ax,Temp1[0]
	sbb	dx,Temp1[2]
	mov	K,bx
	mov	Temp1[0],ax
	mov	si,Temp2[4]
	add	si,si
	mov	si,Temp2[6]
	adc	si,0
	jnc	@@15
	xchg	bx,dx
	jmp	short @@16
@@15:	shl	bx,1
	rcl	ax,1
	rcl	dx,1
	div	si
	xchg	ax,bx
	div	si
	shr	bx,1
	rcr	ax,1
	rcr	dh,1
@@16:	mov	cx,-1
	mov	si,cx
	mov	dl,cl
	not	bx
	not	ax
	neg	dh
	cmc
	adc	ax,0
	adc	bx,Acc[2]
	adc	cx,Acc[4]
	adc	si,Acc[6]
	adc	dl,M
	shr	dl,1
	jnc	@@17
	rcr	si,1
	rcr	cx,1
	rcr	bx,1
	rcr	ax,1
	rcr	dh,1
	inc	P
@@17:	sub	di,di
	add	dh,dh
	adc	ax,di
	adc	bx,di
	adc	cx,di
	adc	si,di
	adc	dl,0
	mov	dx,P
	jz	@@18
	mov	si,8000h
	inc	dx
@@18:	cmp	dx,7fffh
	jb	@@19
	jmp	@@1
@@19:	cmp	dx,7fffh
	jb	@@20
	jmp	@@1
@@20:	les	di,A
	cld
	stosw
	xchg	ax,bx
	stosw
	xchg	ax,cx
	stosw
	xchg	ax,si
	stosw
	xchg	ax,dx
	shl	ax,1
	or	al,byte ptr Q
	ror	ax,1
	stosw
@@21:	pop	di si
	Exit

	Argm	A,dword,1
	Argm	B,dword,1
	Entry	ExtCmp
	push	si di
	push	ds
	lds	si,A
	les	di,B
	mov	ax,[si+8]
	mov	dx,es:[di+8]
	sub	bx,bx
	shl	ax,1
	rcr	bl,1
	shl	dx,1
	rcr	bh,1
	mov	cx,ax
	or	cx,dx
	jcxz	@@1
	cmp	bl,bh
	jg	@@6
	jl	@@4
	cmp	ax,dx
	jb	@@3
	ja	@@5
	mov	ax,[si+6]
	cmp	ax,es:[di+6]
	jne	@@2
	mov	ax,[si+4]
	cmp	ax,es:[di+4]
	jne	@@2
	mov	ax,[si+2]
	cmp	ax,es:[di+2]
	jne	@@2
	mov	ax,[si]
	cmp	ax,es:[di]
	jne	@@2
@@1:	sub	ax,ax
	jmp	short @@7
@@2:	ja	@@5
@@3:	or	bl,bl
	jnz	@@6
@@4:	mov	ax,-1
	jmp	short @@7
@@5:	or	bl,bl
	jnz	@@4
@@6:	mov	ax,1
@@7:	or	ax,ax
	pop	ds
	jmp	short @@8
@@8:	pop	di si
	Exit

	end