opers.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.data?

Oper	db	?
Chain1	dw	?
Chain2	dw	?

	.code	compiler_text

	public	Operation
	public	SetValue
	public	_SetCondition
	public	StoreBoolean

Operation	proc	near
	mov	Oper,al
	Invoke	GetVarValue
	xchg	si,di
	Invoke	GetVarValue
	xchg	si,di
	Invoke	LoadPackedChar
	xchg	si,di
	Invoke	LoadPackedChar
	xchg	si,di
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	les	bx,[si].exType
	cmp	al,es:[bx].tdType
	jne	@@1
	mov	ah,Oper
	cmp	ax,ttInteger+opSlash*256
	je	@@2
	cmp	ax,ttChar+opPlus*256
	jne	@@5
@@1:	Invoke	ConvChar2String
	xchg	si,di
	Invoke	ConvChar2String
	xchg	si,di
@@2:	cmp	[di].exLocation,elImmediate
	jne	@@4
	cmp	[si].exLocation,elImmediate
	jne	@@4
@@3:	Invoke	ConvInt2Ext
	Invoke	ConvReal2Ext
	xchg	si,di
	Invoke	ConvInt2Ext
	Invoke	ConvReal2Ext
	xchg	si,di
	jmp	short @@5
@@4:	test	CompilerOptions,co8087
	jnz	@@3
	Invoke	ConvInt2Real
	Invoke	ConvExt2Real
	xchg	si,di
	Invoke	ConvInt2Real
	Invoke	ConvExt2Real
	xchg	si,di
@@5:	Invoke	TypeCompat
	les	bx,[di].exType
	mov	cl,es:[bx].tdType
	mov	ax,1
	shl	ax,cl
	mov	bl,Oper
	xor	bh,bh
	shl	bx,1
	test	ax,cs:@@8[bx]
	jz	@@7
	mov	bl,cl
	xor	bh,bh
	shl	bx,1
	shl	bx,1
	cmp	[di].exLocation,elImmediate
	jne	@@6
	cmp	[si].exLocation,elImmediate
	jne	@@6
	inc	bx
	inc	bx
@@6:	jmp	cs:@@9[bx]
@@7:	mov	ax,41
	Chain	CompileError
@@8	dw      tmSet+tmString+tm8087+tmReal+tmInteger+tmChar
	dw	tmSet+tmPointer+tm8087+tmReal+tmInteger
	dw	tmSet+tm8087+tmReal+tmInteger
	dw	tmInteger
	dw	tmInteger
	dw	tmInteger
	dw	tmInteger
	dw	tmInteger+tmBoolean
	dw	tmInteger+tmBoolean
	dw	tmInteger+tmBoolean
	dw	tmSet+tmPointer+tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum
	dw	tmSet+tmPointer+tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum
	dw	tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum
	dw	tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum
	dw	tmSet+tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum
	dw	tmSet+tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum
	dw	tm8087+tmReal+tmInteger
@@9	dw	0,0
	dw	0,0
	dw	0,0
	dw	0,0
	dw	0,0
	dw	0,0
	dw	0,0
	dw	SetOper,ISetOper
	dw	OrdinalOper,IOrdinalOper
	dw	StringOper,IStringOper
	dw	Oper8087,IOper8087
	dw	RealOper,RealOper
	dw	OrdinalOper,IOrdinalOper
	dw	BooleanOper,IOrdinalOper
	dw	OrdinalOper,IOrdinalOper
	dw	OrdinalOper,IOrdinalOper
Operation	endp

SetOper	proc	near
	cmp	Oper,opEqual
	jae	@@1
	Invoke	LoadSet
	jmp	short @@2
@@1:	Invoke	_LoadSet
@@2:	xchg	si,di
	Invoke	_LoadSet
	xchg	si,di
	cmp	Oper,opLEq
	jne	@@3
	xchg	si,di
@@3:	Invoke	Push2Addrs
	Invoke	Use2Exprs
	mov	cl,Oper
	cmp	cl,opLEq
	jne	@@4
	xchg	si,di
@@4:	mov	ax,_ZUnion
	cmp	cl,opPlus
	je	@@7
	mov	ax,_ZDifference
	cmp	cl,opMinus
	je	@@7
	mov	ax,_ZIntersect
	cmp	cl,opTimes
	je	@@7
	mov	ax,_ZEqual
	cmp	cl,opEqual
	je	@@5
	cmp	cl,opNotEqual
	je	@@5
	mov	ax,_ZRelation
@@5:	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	mov	al,cdEqual
	cmp	Oper,opNotEqual
	jne	@@6
	mov	al,cdNotEqual
@@6:	jmp	_SetCondition
@@7:	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	ret
SetOper	endp

ISetOper	proc	near
	push	si di
	mov	si,[si].exOffset
	mov	di,[di].exOffset
	push	ds
	pop	es
	mov	cx,16
	mov	al,Oper
	cmp	al,opPlus
	je	@@6
	cmp	al,opMinus
	je	@@7
	cmp	al,opTimes
	je	@@8
	cmp	al,opEqual
	je	@@2
	cmp	al,opNotEqual
	je	@@2
	cmp	al,opLEq
	jne	@@1
	xchg	si,di
@@1:	lodsw
	or	ax,[di]
	scasw
	jne	@@3
	loop	@@1
	jmp	short @@3
@@2:	rep	cmpsw
@@3:	mov	al,0
	jne	@@4
	mov	al,1
@@4:	cmp	Oper,opNotEqual
	jne	@@5
	xor	al,1
@@5:	pop	di si
	jmp	StoreBoolean
@@6:	lodsw
	or	ax,[di]
	stosw
	loop	@@6
	jmp	short @@9
@@7:	lodsw
	not	ax
	and	ax,[di]
	stosw
	loop	@@7
	jmp	short @@9
@@8:	lodsw
	and	ax,[di]
	stosw
	loop	@@8
@@9:	pop	di si
	ret
ISetOper	endp

StringOper	proc	near
	cmp	Oper,opPlus
	jne	@@1
	Invoke	LoadString
	xchg	si,di
	Invoke	PutImmedString
	xchg	si,di
	Invoke	Push2Addrs
	Invoke	Use2Exprs
	mov	ax,_SConcat
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	ret
@@1:	cmp	[si].exLocation,elImmediate
	jne	@@2
	mov	bx,[si].exOffset
	cmp	byte ptr [bx],0
	je	@@3
@@2:	cmp	[di].exLocation,elImmediate
	jne	@@4
	mov	bx,[di].exOffset
	cmp	byte ptr [bx],0
	jne	@@4
	call	SwapOperands
@@3:	Invoke	StringLength
	xor	ax,ax
	mov	[si].exModifier,al
	mov	[si].exValue.W0,ax
	mov	[si].exValue.W2,ax
	call	IntCompare
	Chain	DoneExpr
@@4:	Invoke	PutImmedString
	xchg	si,di
	Invoke	PutImmedString
	xchg	si,di
	Invoke	Push2Addrs
	Invoke	Use2Exprs
	mov	ax,_SCompare
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	lea	bx,UnsignedConds
	jmp	SetCondition
StringOper	endp

IStringOper	proc	near
	push	di si
	mov	di,[di].exOffset
	mov	si,[si].exOffset
	push	ds
	pop	es
	cmp	Oper,opPlus
	je	@@1
	xchg	si,di
	Invoke	CompareStrings
	pop	si di
	jmp	CheckCondition
@@1:	mov	al,[di]
	mov	dl,al
	add	al,[si]
	jnc	@@2
	mov	al,-1
@@2:	xor	ah,ah
	push	ax
	inc	ax
	Invoke	AllocTempBuf
	pop	ax
	push	bx si
	xor	ch,ch
	mov	si,di
	mov	di,bx
	stosb
	mov	cl,dl
	inc	si
	rep	movsb
	pop	si
	mov	cl,al
	sub	cl,dl
	inc	si
	rep	movsb
	pop	bx si di
	mov	[di].exOffset,bx
	ret
IStringOper	endp

Oper8087	proc	near
	Invoke	Put8087Const
	xchg	si,di
	Invoke	Put8087Const
	xchg	si,di
	mov	al,Oper
	mov	dh,30h			; fdiv
	cmp	al,opSlash
	je	@@1
	mov	dh,18h			; fcomp
	cmp	al,opEqual
	jae	@@1
	mov	dh,0			; fadd
	cmp	al,opPlus
	je	@@1
	mov	dh,20h			; fsub
	cmp	al,opMinus
	je	@@1
	mov	dh,8			; fmul
@@1:	cmp	[di].exLocation,elStack
	je	@@3
	cmp	[si].exLocation,elStack
	je	@@2
	test	[di].exModifier,emExtended
	jnz	@@3
	test	[si].exModifier,emExtended
	jz	@@3
@@2:	call	Swap8087
@@3:	test	[si].exModifier,emExtended
	jz	@@4
	call	Swap8087
	push	dx
	Invoke	PushExt
	xchg	si,di
	Invoke	PushExt
	Invoke	Use2Exprs
	xchg	si,di
	Invoke	PutEmulInt
	pop	ax
	or	ah,0c1h
	mov	al,3ah
	Invoke	PutWord
	jmp	short @@5
@@4:	push	dx
	Invoke	PushExt
	Invoke	Use2Exprs
	pop	dx
	mov	dl,0d8h
	or	dl,[si].exModifier
	xchg	si,di
	Invoke	PutFloatRM
	xchg	si,di
@@5:	mov	al,Oper
	cmp	al,opSlash
	je	@@6
	cmp	al,opEqual
	jb	@@6
	mov	ax,2
	Invoke	AllocStack
	push	ax
	mov	dx,3eddh		; fstsw	[bp-...]
	Invoke	FloatAddOffset
	Invoke	PutFwait
	pop	ax
	inc	ax
	mov	dx,268ah		; mov	ah,[bp-...]
	Invoke	AddOffset
	mov	al,9eh			; sahf
	Invoke	PutByte
	Invoke	DoneExpr
	mov	al,erAX
	or	al,[si].exRegsUsed
	or	[di].exRegsUsed,al
	lea	bx,UnsignedConds
	jmp	SetCondition
@@6:	mov	al,[si].exRegsUsed
	or	[di].exRegsUsed,al
	Chain	DoneExpr
Oper8087	endp

Swap8087	proc	near
	push	dx
	call	SwapOperands
	pop	dx
	test	dh,20h
	jz	@@1
	xor	dh,8
@@1:	ret
Swap8087	endp

IOper8087	proc	near
	lea	bx,[di].exValue
	lea	cx,[si].exValue
	mov	al,Oper
	cmp	al,opEqual
	jb	@@1
	cmp	al,opSlash
	je	@@1
	Invoke	CompareExtended
	jmp	CheckCondition
@@1:	Chain	ArithExtended
IOper8087	endp

RealOper	proc	near
	test	CompilerOptions,co8087
	jz	@@1
	Invoke	ConvReal2Ext
	xchg	si,di
	Invoke	ConvReal2Ext
	xchg	si,di
	jmp	Oper8087
@@1:	mov	al,Oper
	cmp	al,opSlash
	je	@@3
	cmp	al,opEqual
	jae	@@2
	cmp	al,opPlus
	je	@@2
	cmp	al,opTimes
	jne	@@3
@@2:	cmp	[si].exRegsUsed,0
	je	@@3
	cmp	[di].exRegsUsed,0
	jne	@@3
	call	SwapOperands
@@3:	cmp	[si].exRegsUsed,0
	jne	@@4
	Invoke	UseExpr
	mov	al,lrR1
	Invoke	LoadReal
	xchg	si,di
	Invoke	UseExpr
	mov	al,lrR2
	Invoke	LoadReal
	xchg	si,di
	jmp	short @@5
@@4:	xchg	si,di
	Invoke	UseExpr
	mov	al,lrR1
	Invoke	LoadReal
	xchg	si,di
	mov	ax,5352h		; push	dx	push	bx
	Invoke	PutWord
	mov	al,50h			; push	ax
	Invoke	PutByte
	Invoke	UseExpr
	mov	al,lrR1
	Invoke	LoadReal
	mov	ax,59h			; pop	cx
	Invoke	PutByte
	mov	ax,5f5eh		; pop	si	pop	di
	Invoke	PutWord
@@5:	mov	al,Oper
	cmp	al,opSlash
	je	@@6
	cmp	al,opEqual
	jb	@@6
	mov	ax,_RCmp
	Invoke	PutSystemCall
	Invoke	DoneExpr
	lea	bx,UnsignedConds
	jmp	SetCondition
@@6:	mov	dx,_RAdd
	cmp	al,opPlus
	je	@@7
	mov	dx,_RSub
	cmp	al,opMinus
	je	@@7
	mov	dx,_RMul
	cmp	al,opTimes
	je	@@7
	mov	dx,_RDiv
@@7:	mov	ax,dx
	Invoke	PutSystemCall
	Chain	DoneExpr
RealOper	endp

BooleanOper	proc	near
	test	CompilerOptions,coBooleanEval
	jnz	@@3
	cmp	Oper,opOr
	je	@@1
	cmp	Oper,opAnd
	jne	@@3
@@1:	Invoke	Number2Cond
	xchg	si,di
	Invoke	Number2Cond
	xchg	si,di
	Invoke	UseExpr
	mov	al,[di].exMisc
	lea	bx,[di].exChain1
	lea	cx,[di].exChain2
	cmp	Oper,opOr
	je	@@2
	xor	al,1
	xchg	bx,cx
@@2:	Invoke	PutJmp
	mov	bx,cx
	Invoke	PutLabel
	xchg	si,di
	Invoke	UseExpr
	xchg	si,di
	Invoke	DoneExpr
	mov	al,[si].exRegsUsed
	or	[di].exRegsUsed,al
	lea	bx,[di].exChain1
	mov	ax,[si].exChain1
	Invoke	AddToChain
	lea	bx,[di].exChain2
	mov	ax,[si].exChain2
	Invoke	AddToChain
	mov	al,[si].exMisc
	mov	[di].exMisc,al
	ret