www.pudn.com > tp60src.zip > EXTARITH.ASM


	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