convert2.asm

Turbo Pascal 6.0编译器源码

	mov	[di].exLocation,elStack
	mov	[di].exModifier,emExtended
	ret
@@3:	mov	ax,256
	Invoke	CreateLocalVar
	Invoke	UseExpr
	Chain	DoneExpr
ReturnValue	endp

DiscardReturn	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttString
	je	@@1
	cmp	es:[bx].tdType,tt8087
	je	@@2
	ret
@@1:	Invoke	UseExpr
	mov	ax,0c483h		; add	sp,4
	Invoke	PutWord
	mov	al,4
	Invoke	PutByte
	Chain	DoneExpr
@@2:	Invoke	UseExpr
	Invoke	PutEmulInt
	mov	ax,0d835h		; fstp	st(0)
	Invoke	PutWord
	Chain	DoneExpr
DiscardReturn	endp

GetActualParams	proc	near
	Loc	ParamType,dword,1
	Loc	Param,byte,<size TExpr>
	Loc	Buffer,word,64
	Entry
	les	si,[di].exType
	mov	cx,es:[si].ptParamCount
	add	si,ptParams
	jcxz	@@3
	mov	Buffer[0],0
	mov	al,tOParen
	Invoke	NeedToken
	push	di
@@1:	push	cx si es
	call	GetActualParam
	pop	es si cx
	add	si,size TProcParam
	dec	cx
	jz	@@2
	mov	al,tComma
	Invoke	NeedToken
	jmp	@@1
@@2:	pop	di
	mov	al,tCParen
	Invoke	NeedToken
	lea	bx,Buffer
	Invoke	FlushGoals
@@3:	Exit

GetActualParam	proc	near
	mov	al,es:[si].ppFlags
	mov	bx,es:[si].ppType.Segm
	mov	si,es:[si].ppType.Offs
	mov	es,es:[bx]
	mov	ParamType.offs,si
	mov	ParamType.segm,es
	lea	di,Param
	test	al,vfAddress
	jnz	@@6
	lea	si,ParamType
	Invoke	GetExpression
	lea	si,ParamType
	Invoke	AssignmentCast
	call	TypeCompat
	call	CastOrdinal
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	cmp	al,ttInteger
	jae	@@1
	cmp	al,ttPointer
	je	@@1
	cmp	al,ttProc
	je	@@1
	cmp	al,ttSet
	je	@@2
	cmp	al,ttString
	je	@@3
	cmp	al,tt8087
	je	@@4
	cmp	al,ttReal
	je	@@5
	call	ShortRecord
	jnz	@@10
@@1:	Invoke	PushValue
	jmp	short @@11
@@2:	Invoke	_LoadSet
	call	NeedCopyParam
	jz	@@10
	Invoke	LoadSet
	jmp	short @@10
@@3:	Invoke	PutImmedString
	call	NeedCopyParam
	jz	@@10
	Invoke	_LoadString
	jmp	short @@10
@@4:	Invoke	PushFloat
	jmp	short @@11
@@5:	Invoke	PushReal
	jmp	short @@11
@@6:	Invoke	GetReference
	les	bx,ParamType
	mov	al,es:[bx].tdType
	cmp	al,ttVoid
	je	@@10
	cmp	al,ttString
	je	@@7
	cmp	al,ttObject
	jne	@@9
	mov	ax,bx
	mov	dx,es
	les	bx,[di].exType
	Invoke	CheckInherit
	jz	@@10
	jmp	short @@8
@@7:	test	CompilerOptions,coVarStringChk
	jnz	@@9
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttString
	je	@@10
@@8:	mov	ax,26
	Chain	CompileError
@@9:	cmp	bx,[di].exType.Offs
	jne	@@8
	mov	ax,es
	cmp	ax,[di].exType.Segm
	jnz	@@8
@@10:	Invoke	PushAddr
@@11:	mov	ax,[di].exCode
	lea	bx,Buffer
	Chain	AddGoal
GetActualParam	endp

GetActualParams	endp

NeedCopyParam	proc	near
	test	CompilerOptions,coOverlayCode
	jz	@@1
	cmp	[di].exLocation,elStack
	je	@@1
	test	[di].exMisc,efCS
@@1:	ret
NeedCopyParam	endp

TypeCompat	proc	near
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	les	bx,[si].exType
	cmp	al,es:[bx].tdType
	jne	@@1
	mov	bl,al
	xor	bh,bh
	shl	bx,1
	call	cs:@@2[bx]
	jnz	@@1
	ret
@@1:	mov	ax,26
	Chain	CompileError
@@2	dw	StrictCompat
	dw	StrictCompat
	dw	StrictCompat
	dw	StrictCompat
	dw	StrictCompat
	dw	StrictCompat
	dw	ProcCompat
	dw	SetCompat
	dw	PointerCompat
	dw	AnyCompat
	dw	AnyCompat
	dw	AnyCompat
	dw	AnyCompat
	dw	AnyCompat
	dw	AnyCompat
	dw	EnumCompat
TypeCompat	endp

AnyCompat	proc	near
	xor	ax,ax
	ret
AnyCompat	endp

StrictCompat	proc	near
	mov	ax,[di].exType.Offs
	cmp	ax,[si].exType.Offs
	jne	@@1
	mov	ax,[di].exType.Segm
	cmp	ax,[si].exType.Segm
@@1:	ret
StrictCompat	endp

ProcCompat	proc	near
	push	si di ds
	les	di,[di].exType
	lds	si,[si].exType
	cmpsw
	jne	@@2
	cmpsw
	jne	@@2
	cmpsw
	call	ParamCompat
	jnz	@@2
	lodsw
	scasw
	jne	@@2
	xchg	ax,cx
	jcxz	@@2
@@1:	call	ParamCompat
	jnz	@@2
	cmpsb
	jne	@@2
	loop	@@1
@@2:	pop	ds di si
	ret
ProcCompat	endp

ParamCompat	proc	near
	cmpsw
	jne	@@1
	lodsw
	mov	bx,es:[di]
	inc	di
	inc	di
	or	ax,ax
	jz	@@1
	mov	bx,es:[bx]
	xchg	ax,bx
	cmp	ax,[bx]
@@1:	ret
ParamCompat	endp

SetCompat	proc	near
	les	bx,[di].exType
	cmp	es:[bx].stBase.Offs,0
	je	@@2
	mov	cx,es:[bx].stBase.Offs
	mov	bx,es:[bx].stBase.Segm
	mov	es,es:[bx]
	mov	bx,cx
	mov	ax,es:[bx].itBase.Offs
	mov	bx,es:[bx].itBase.Segm
	mov	dx,es:[bx]
	les	bx,[si].exType
	cmp	es:[bx].stBase.Offs,0
	je	@@1
	mov	cx,es:[bx].stBase.Offs
	mov	bx,es:[bx].stBase.Segm
	mov	es,es:[bx]
	mov	bx,cx
	cmp	ax,es:[bx].itBase.Offs
	jne	@@1
	mov	bx,es:[bx].itBase.Segm
	cmp	dx,es:[bx]
@@1:	ret
@@2:	mov	ax,[si].exType.Offs
	mov	[di].exType.Offs,ax
	mov	ax,[si].exType.Segm
	mov	[di].exType.Segm,ax
	ret
SetCompat	endp

PointerCompat	proc	near
	call	StrictCompat
	jz	@@1
	les	bx,[si].exType
	mov	ax,es:[bx].ptBase.Offs
	mov	bx,es:[bx].ptBase.Segm
	mov	es,es:[bx]
	mov	bx,ax
	cmp	es:[bx].tdSizeOf,0
	je	@@1
	mov	dx,es
	les	bx,[di].exType
	mov	cx,es:[bx].ptBase.Offs
	mov	bx,es:[bx].ptBase.Segm
	mov	es,es:[bx]
	mov	bx,cx
	cmp	es:[bx].tdSizeOf,0
	jne	@@1
	mov	ax,[si].exType.Offs
	mov	[di].exType.Offs,ax
	mov	ax,[si].exType.Segm
	mov	[di].exType.Segm,ax
@@1:	ret
PointerCompat	endp

EnumCompat	proc	near
	les	bx,[di].exType
	mov	ax,es:[bx].itBase.Offs
	mov	bx,es:[bx].itBase.Segm
	mov	dx,es:[bx]
	les	bx,[si].exType
	cmp	ax,es:[bx].itBase.Offs
	jne	@@1
	mov	bx,es:[bx].itBase.Segm
	cmp	dx,es:[bx]
@@1:	ret
EnumCompat	endp

CastOrdinal	proc	near
	les	bx,[si].exType
	cmp	es:[bx].tdType,ttInteger
	jae	_Cast
	ret
CastOrdinal	endp

CastByte	proc	near
	mov	bx,_Byte
	mov	es,SystemUnit
	jmp	short _Cast
CastByte	endp

CastInt	proc	near
	mov	bx,_Integer
	mov	es,SystemUnit
	jmp	short _Cast
CastInt	endp

CastWord	proc	near
	mov	bx,_Word
	mov	es,SystemUnit
	jmp	short _Cast
CastWord	endp

CastLong	proc	near
	mov	bx,_Longint
	mov	es,SystemUnit
_Cast	label	near
	cmp	[di].exLocation,elImmediate
	jne	@@2
	mov	ax,[di].itUpperBound.W0
	mov	dx,[di].itUpperBound.W2
	call	ImmedRangeCheck
	jc	@@1
	mov	al,es:[bx].tdModifier
	or	al,IndexModifier
	mov	[di].exModifier,al
	ret
@@1:	mov	ax,76
	Chain	CompileError
@@2:	test	CompilerOptions,coRangeChk
	jnz	@@4
@@3:	mov	al,es:[bx].tdModifier
	or	al,IndexModifier
	Chain	ConvertOrdinal
@@4:	xor	ax,ax
	mov	dx,ax
	test	[di].exModifier,emSigned
	jz	@@5
	mov	ax,-128
	dec	dx
	test	[di].exModifier,emX
	jz	@@5
	mov	ax,-32768
	test	[di].exModifier,emXX
	jz	@@5
	xchg	ax,dx
	inc	ax
@@5:	call	ImmedRangeCheck
	jc	@@8
	mov	ax,127
	xor	dx,dx
	test	[di].exModifier,emUnsigned
	jz	@@6
	mov	al,255
@@6:	test	[di].exModifier,emX
	jz	@@7
	mov	ah,al
	mov	al,255
	test	[di].exModifier,emXX
	jz	@@7
	mov	dx,ax
	mov	ax,65535
@@7:	call	ImmedRangeCheck
	jnc	@@3
@@8:	push	es bx
	push	es:[bx].itUpperBound
	push	es:[bx].itLowerBound
	mov	bx,sp
	mov	ax,8
	Invoke	PutCodeConst
	push	ax bx dx
	mov	al,emLongint
	Invoke	ConvertOrdinal
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	mov	al,0bfh			; mov	ax,
	Invoke	PutByte
	pop	dx bx ax
	mov	cx,ffCode+ffOffs
	Invoke	PutFixup
	mov	ax,_RangeCheck
	Invoke	PutSystemCall
	Invoke	DoneExpr
	add	sp,8
	pop	bx es
	jmp	@@3
CastLong	endp

ImmedRangeCheck	proc	near
	cmp	dx,es:[bx].itLowerBound.W2
	jg	@@1
	jl	@@3
	cmp	ax,es:[bx].itLowerBound.W0
	jb	@@3
@@1:	cmp	dx,es:[bx].itUpperBound.W2
	jl	@@2
	jg	@@3
	cmp	ax,es:[bx].itUpperBound.W0
	ja	@@3
@@2:	clc
	ret
@@3:	stc
	ret
ImmedRangeCheck	endp

	end