arith.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	extrn	ExtAdd:far
	extrn	ExtSub:far
	extrn	ExtMul:far
	extrn	ExtDiv:far
	extrn	ExtCmp:far
	extrn	Ext2Double:far
	extrn	Ext2Single:far
	extrn	Double2Ext:far
	extrn	Single2Ext:far
	extrn	Ext2Comp:far
	extrn	Ext2Long:far
	extrn	Comp2Ext:far
	extrn	Long2Ext:far
	extrn	Ext2Real:far
	extrn	Real2Ext:far
	extrn	Str2Ext:far
	extrn	Ext2Str:far

	.code	compiler_text

	public	MulLong
	public	DivLong
	public	Str2Long
	public	Str2DecLong
	public	CheckFpu
	public	ArithExtended
	public	CompareExtended
	public	Str2Extended
	public	Extended2Str
	public	Long2Extended
	public	TruncExtended
	public	Real2Extended
	public	Extended2Real
	public	Float2Extended
	public	Extended2Float

MulLong	proc	near
	push	si di
	mov	si,ax
	mov	di,dx
	mul	cx
	push	ax dx
	mov	ax,si
	mul	bx
	mov	bx,ax
	mov	ax,di
	mul	cx
	mov	cx,ax
	pop	dx ax
	add	dx,bx
	add	dx,cx
	pop	di si
	ret
MulLong	endp

DivLong	proc	near
	push	si di bp
	mov	bp,cx
	or	bp,bx
	jz	@@8
	or	bx,bx
	pushf
	jns	@@1
	not	cx
	not	bx
	add	cx,1
	adc	bx,0
@@1:	or	dx,dx
	pushf
	jns	@@2
	not	ax
	not	dx
	add	ax,1
	adc	dx,0
@@2:	mov	si,cx
	mov	di,bx
	xor	cx,cx
	xor	bx,bx
	mov	bp,33
@@3:	rcl	cx,1
	rcl	bx,1
	sub	cx,si
	sbb	bx,di
	jnc	@@4
	add	cx,si
	adc	bx,di
@@4:	cmc
	rcl	ax,1
	rcl	dx,1
	dec	bp
	jnz	@@3
	popf
	jns	@@5
	not	cx
	not	bx
	add	cx,1
	adc	bx,0
	popf
	jns	@@6
	jmp	short @@7
@@5:	popf
	jns	@@7
@@6:	not	ax
	not	dx
	add	ax,1
	adc	dx,0
@@7:	pop	bp di si
	ret
@@8:	mov	ax,62
	Chain	CompileError
DivLong	endp

Str2Long	proc	near
	cmp	byte ptr [si],'$'
	jne	Str2DecLong
	inc	si
	jmp	Str2HexLong
Str2Long	endp

Str2DecLong	proc	near
	xor	ax,ax
	xor	dx,dx
	mov	bx,si
@@1:	mov	cl,[si]
	xor	ch,ch
	sub	cl,'0'+10
	add	cl,10
	jnc	@@2
	test	dx,0f000h
	jnz	@@3
	push	cx
	shl	ax,1
	rcl	dx,1
	push	dx
	push	ax
	shl	ax,1
	rcl	dx,1
	shl	ax,1
	rcl	dx,1
	pop	cx
	add	ax,cx
	pop	cx
	adc	dx,cx
	pop	cx
	add	ax,cx
	adc	dx,0
	js	@@3
	inc	si
	jmp	@@1
@@2:	cmp	si,bx
	ja	@@4
@@3:	stc
@@4:	ret
Str2DecLong	endp

Str2HexLong	proc	near
	xor	ax,ax
	xor	dx,dx
	mov	bx,si
@@1:	mov	cl,[si]
	cmp	cl,'a'
	jb	@@2
	sub	cl,'a'-'A'
@@2:	sub	cl,'0'+10
	add	cl,10
	jc	@@3
	sub	cl,'F'-'0'+1
	add	cl,'F'-'A'+1
	jnc	@@5
	add	cl,10
@@3:	mov	ch,4
@@4:	shl	ax,1
	rcl	dx,1
	jc	@@6
	dec	ch
	jnz	@@4
	or	al,cl
	inc	si
	jmp	@@1
@@5:	cmp	si,bx
	ja	@@7
@@6:	stc
@@7:	ret
Str2HexLong	endp

CheckFpu	proc	near
	noemul
	fninit
	push	bx
	xor	bx,bx
	push	bx
	mov	bx,sp
	fnstcw	[bx]
	mov	bx,20
@@1:	dec	bx
	jnz	@@1
	pop	bx
	and	bx,0f3fh
	cmp	bx,033fh
	pop	bx
	ret
CheckFpu	endp

ArithExtended	proc	near
	push	es bx ds bx ds cx
	cmp	al,opPlus
	je	@@1
	cmp	al,opMinus
	je	@@2
	cmp	al,opTimes
	je	@@3
	call	ExtDiv
	jmp	short @@4
@@1:	call	ExtAdd
	jmp	short @@4
@@2:	call	ExtSub
	jmp	short @@4
@@3:	call	ExtMul
@@4:	cld
	pop	bx es
	mov	ax,[bx].W8
	and	ax,7fffh
	cmp	ax,7fffh
	je	@@5
	ret
@@5:	mov	ax,140
	Chain	CompileError
ArithExtended	endp

CompareExtended	proc	near
	push	es ds bx ds cx
	call	ExtCmp
	cld
	pop	es
	add	al,80h
	cmp	al,80h
	ret
CompareExtended	endp

Str2Extended	proc	near
	push	es bx ds si ds bx
	call	Str2Ext
	cld
	pop	bx es
	add	si,ax
	mov	ax,[bx].W8
	and	ax,7fffh
	inc	ax
	shl	ax,1
	ret
Str2Extended	endp

Extended2Str	proc	near
	push	es bx dx
	mov	dx,sp
	push	ds bx ax ds dx ds si
	call	Ext2Str
	cld
	pop	dx bx es
	ret
Extended2Str	endp

Long2Extended	proc	near
	push	es bx
	push	dword ptr [bx]
	push	ds bx
	call	Long2Ext
	cld
	pop	bx es
	ret
Long2Extended	endp

TruncExtended	proc	near
	push	es
	or	al,al
	jz	@@3
	push	bx ds bx
	lea	ax,@@5
	push	cs ax
	test	[bx].B9,80h
	jz	@@1
	call	ExtSub
	jmp	short @@2
@@1:	call	ExtAdd
@@2:	pop	bx
@@3:	push	bx ds bx
	call	Ext2Long
	cld
	pop	bx
	mov	[bx].W0,ax
	mov	[bx].W2,dx
	shl	dx,1
	jnc	@@4
	or	ax,dx
	jnz	@@4
	mov	ax,76
	Chain	CompileError
@@4:	pop	es
	ret
@@5	dt	0.5
TruncExtended	endp

Real2Extended	proc	near
	push	es bx ds bx ds bx
	call	Real2Ext
	cld
	pop	bx es
	ret
Real2Extended	endp

Extended2Real	proc	near
	push	es bx ds bx ds bx
	call	Ext2Real
	cld
	pop	bx es
	mov	ax,[bx].W0
	and	ax,[bx].W2
	and	ax,[bx].W4
	inc	ax
	jz	@@1
	ret
@@1:	mov	ax,76
	Chain	CompileError
Extended2Real	endp

Float2Extended	proc	near
	cmp	al,emExtended
	je	@@4
	push	es bx ds bx ds bx
	cmp	al,emSingle
	je	@@1
	cmp	al,emDouble
	je	@@2
	call	Comp2Ext
	jmp	short @@3
@@1:	call	Single2Ext
	jmp	short @@3
@@2:	call	Double2Ext
@@3:	cld
	pop	bx es
@@4:	ret
Float2Extended	endp

Extended2Float	proc	near
	cmp	al,emExtended
	je	@@5
	push	es bx ds bx ds bx
	cmp	al,emSingle
	je	@@2
	cmp	al,emDouble
	je	@@3
	call	Ext2Comp
	cld
	pop	bx es
	mov	ax,[bx].W6
	shl	ax,1
	jnc	@@5
	or	ax,[bx].W0
	or	ax,[bx].W2
	or	ax,[bx].W4
	jnz	@@5
@@1:	mov	ax,76
	Chain	CompileError
@@2:	call	Ext2Single
	cld
	pop	bx es
	mov	ax,[bx].W2
	mov	dx,7f80h
	jmp	short @@4
@@3:	call	Ext2Double
	cld
	pop	bx es
	mov	ax,[bx].W6
	mov	dx,7ff0h
@@4:	and	ax,dx
	cmp	ax,dx
	je	@@1
@@5:	ret
Extended2Float	endp

	end