convert.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.code	compiler_text

	public	AssignmentCast
	public	CheckInherit
	public	Cond2Number
	public	Number2Cond
	public	CreateTempInt
	public	ConvInt2Ext
	public	ConvInt2Real
	public	ConvReal2Ext
	public	ConvExt2Real
	public	Put8087Const
	public	PushExt
	public	LoadSet
	public	_LoadSet
	public	PutImmedString
	public	LoadString
	public	_LoadString
	public	StringLength
	public	ConvChar2String
	public	LoadPackedChar
	public	CheckPackedChar
	public	LoadAddress
	public	GetVarValue
	public	Push2Addrs
	public	PushAddr

AssignmentCast	proc	near
	les	bx,[si].exType
	mov	al,es:[bx].tdType
	cmp	al,ttString
	je	@@1
	cmp	al,tt8087
	je	@@2
	cmp	al,ttReal
	je	@@3
	cmp	al,ttObject
	je	@@4
	cmp	al,ttPointer
	je	@@5
	ret
@@1:	call	ConvChar2String
	jmp	LoadPackedChar
@@2:	call	ConvInt2Ext
	jmp	ConvReal2Ext
@@3:	call	ConvInt2Real
	jmp	ConvExt2Real
@@4:	mov	ax,bx
	mov	dx,es
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttObject
	je	@@6
	ret
@@5:	mov	ax,es:[bx].ptBase.Offs
	mov	bx,es:[bx].ptBase.Segm
	mov	es,es:[bx]
	mov	bx,ax
	cmp	es:[bx].tdType,ttObject
	jne	@@7
	mov	dx,es
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttPointer
	jne	@@7
	mov	cx,es:[bx].ptBase.Offs
	mov	bx,es:[bx].ptBase.Segm
	mov	es,es:[bx]
	mov	bx,cx
@@6:	call	CheckInherit
	jz	@@8
@@7:	ret
@@8:	mov	ax,[si].exType.Offs
	mov	[di].exType.Offs,ax
	mov	ax,[si].exType.Segm
	mov	[di].exType.Segm,ax
	ret
AssignmentCast	endp

CheckInherit	proc	near
	cmp	es:[bx].tdType,ttObject
	jne	@@3
@@1:	cmp	bx,ax
	jne	@@2
	mov	cx,es
	cmp	cx,dx
	je	@@3
@@2:	mov	cx,es:[bx].otParent.Offs
	mov	bx,es:[bx].otParent.Segm
	jcxz	@@3
	mov	es,es:[bx]
	mov	bx,cx
	jmp	@@1
@@3:	ret
CheckInherit	endp

Cond2Number	proc	near
	cmp	[di].exLocation,elCondition
	jne	@@3
	Invoke	UseExpr
	mov	ax,[di].exChain1
	or	ax,[di].exChain2
	jz	@@1
	mov	al,[di].exMisc
	lea	bx,[di].exChain1
	Invoke	PutJmp
	lea	bx,[di].exChain2
	Invoke	PutLabel
	mov	ax,0b0h			; mov	al,0
	Invoke	PutWord
	mov	ax,2ebh			; jmp	short $+4
	Invoke	PutWord
	lea	bx,[di].exChain1
	Invoke	PutLabel
	mov	ax,1b0h			; mov	al,1
	Invoke	PutWord
	jmp	short @@2
@@1:	mov	ax,0b0h			; mov	al,0
	Invoke	PutWord
	mov	al,[di].exMisc
	mov	ah,1
	xor	al,ah
	Invoke	PutWord
	mov	al,40h			; inc	ax
	Invoke	PutByte
@@2:	Invoke	DoneExpr
	mov	[di].exLocation,elRegister
	or	[di].exRegsUsed,erAX
	mov	[di].exMisc,lvAX
@@3:	ret
Cond2Number	endp

Number2Cond	proc	near
	cmp	[di].exLocation,elCondition
	je	@@4
	Invoke	UseExpr
	cmp	[di].exLocation,elMemory
	jne	@@1
	mov	dx,3880h		; cmp	...,0
	Invoke	AddReg
	xor	al,al
	Invoke	PutByte
	jmp	short @@3
@@1:	cmp	[di].exLocation,elRegister
	je	@@2
	mov	al,lvAX
	Invoke	LoadValue
@@2:	mov	ax,0c008h		; or	al,al
	Invoke	PutWord
@@3:	Invoke	DoneExpr
	mov	[di].exLocation,elCondition
	mov	[di].exMisc,cdNotEqual
	xor	ax,ax
	mov	[di].exChain1,ax
	mov	[di].exChain2,ax
@@4:	ret
Number2Cond	endp

CreateTempInt	proc	near
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	mov	ax,1
	test	[di].exModifier,emX
	jz	@@1
	inc	ax
	test	[di].exModifier,emXX
	jz	@@1
	inc	ax
	inc	ax
@@1:	Invoke	AllocStack
	mov	[di].exLocation,elMemory
	mov	[di].exMisc,efSS+efBP
	mov	[di].exValue.Offs,ax
	mov	al,lvAX
	Invoke	StoreValue
	Chain	DoneExpr
CreateTempInt	endp

ConvInt2Ext	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttInteger
	jne	@@6
	cmp	[di].exLocation,elImmediate
	jne	@@1
	lea	bx,[di].exValue
	Invoke	Long2Extended
	jmp	short @@5
@@1:	cmp	[di].exLocation,elMemory
	jne	@@2
	test	[di].exModifier,emXX
	jnz	@@3
	test	[di].exModifier,emX
	jz	@@2
	mov	dx,0dfh			; fild	word ptr
	test	[di].exModifier,emUnsigned
	jz	@@4
@@2:	mov	al,emLongint
	Invoke	ConvertOrdinal
	call	CreateTempInt
@@3:	mov	dx,0dbh			; fild	dword ptr
@@4:	Invoke	UseExpr
	Invoke	PutFloatRM
	Invoke	DoneExpr
	mov	[di].exLocation,elStack
@@5:	mov	[di].exModifier,emExtended
	Chain	CastExtended
@@6:	ret
ConvInt2Ext	endp

ConvInt2Real	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttInteger
	jne	@@3
	cmp	[di].exLocation,elImmediate
	jne	@@1
	lea	bx,[di].exValue
	Invoke	Long2Extended
	Invoke	Extended2Real
	jmp	short @@2
@@1:	mov	al,emLongint
	Invoke	ConvertOrdinal
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	mov	ax,_RFloat
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exLocation,elRegister
	mov	[di].exRegsUsed,erAll
@@2:	mov	[di].exModifier,emReal
	Chain	CastReal
@@3:	ret
ConvInt2Real	endp

ConvReal2Ext	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttReal
	jne	@@1
	Invoke	UseExpr
	mov	al,lrR1
	Invoke	LoadReal
	mov	ax,_FRealExt+fnNeed8087
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exLocation,elStack
	mov	[di].exModifier,emExtended
	mov	[di].exRegsUsed,erAll
	Chain	CastExtended
@@1:	ret
ConvReal2Ext	endp

ConvExt2Real	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,tt8087
	jne	@@3
	cmp	[di].exLocation,elImmediate
	jne	@@1
	lea	bx,[di].exValue
	Invoke	Extended2Real
	jmp	short @@2
@@1:	call	PushExt
	Invoke	UseExpr
	mov	ax,_FExtReal+fnNeed8087
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exLocation,elRegister
	mov	[di].exRegsUsed,erAll
@@2:	mov	[di].exModifier,emReal
	Chain	CastReal
@@3:	ret
ConvExt2Real	endp

Put8087Const	proc	near
	cmp	[di].exLocation,elImmediate
	jne	@@5
	lea	bx,[di].exValue
	mov	ax,[bx+8]
	and	ax,7fffh
	jz	@@1
	cmp	ax,3c01h
	jb	@@3
	cmp	ax,43feh
	ja	@@3
	test	word ptr [bx],7ffh
	jnz	@@3
	cmp	ax,3f81h
	jb	@@2
	cmp	ax,407eh
	ja	@@2
	cmp	word ptr [bx+1],0
	jne	@@2
	cmp	word ptr [bx+3],0
	jne	@@2
@@1:	mov	al,emSingle
	mov	cx,4
	jmp	short @@4
@@2:	mov	al,emDouble
	mov	cx,8
	jmp	short @@4
@@3:	mov	al,emExtended
	mov	cx,10
@@4:	mov	[di].exModifier,al
	push	cx
	Invoke	Extended2Float
	pop	ax
	Invoke	PutCodeConst
	mov	[di].exLocation,elMemory
	mov	[di].exMisc,efCS+efReadOnly
	mov	[di].exOffset,dx
	mov	[di].exMap,bx
	mov	[di].exSegment,ax
@@5:	ret
Put8087Const	endp

PushExt	proc	near
	cmp	[di].exLocation,elStack
	je	@@2
	call	Put8087Const
	Invoke	UseExpr
	mov	dx,0d9h			; fld
	test	[di].exModifier,emExtended
	jz	@@1
	mov	dh,28h			; fld	tbyte ptr
@@1:	or	dl,[di].exModifier
	Invoke	PutFloatRM
	Invoke	DoneExpr
	mov	[di].exLocation,elStack
	mov	[di].exModifier,emExtended
@@2:	ret
PushExt	endp

LoadSet	proc	near
	xor	ax,ax
	cmp	[di].exLocation,elImmediate
	jne	@@2
	mov	bx,[di].exOffset
	mov	cx,16
	xor	dx,dx
@@1:	or	dx,[bx]
	inc	bx
	inc	bx
	loop	@@1
	or	dx,dx
	jnz	@@2
	mov	ax,32
	Invoke	CreateLocalVar
	mov	ax,_ZClear
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	ret
_LoadSet	label	near
	mov	ax,32
@@2:	cmp	[di].exLocation,elImmediate
	jne	@@3
	push	ax
	mov	ax,32
	mov	bx,[di].exOffset
	Invoke	PutCodeConst
	mov	[di].exLocation,elMemory
	mov	[di].exMisc,efCS+efReadOnly
	mov	[di].exOffset,dx
	mov	[di].exMap,bx
	mov	[di].exSegment,ax
	pop	ax
@@3:	cmp	[di].exLocation,elMemory
	jne	@@4
	les	bx,[di].exType
	cmp	ax,es:[bx].tdSizeOf
	je	@@4
	call	PushAddr
	mov	ax,32
	Invoke	CreateLocalVar
	Invoke	UseExpr
	les	bx,[di].exType
	Invoke	PushSetAddr
	mov	ax,_ZLoad
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
@@4:	ret
LoadSet	endp

PutImmedString	proc	near
	mov	ax,256
	cmp	[di].exLocation,elImmediate
	jne	@@1
	mov	bx,[di].exOffset
	mov	al,[bx]
	xor	ah,ah
	inc	ax
	push	ax
	Invoke	PutCodeConst
	mov	[di].exLocation,elMemory
	mov	[di].exMisc,efCS+efReadOnly
	mov	[di].exOffset,dx
	mov	[di].exMap,bx
	mov	[di].exSegment,ax
	pop	ax
@@1:	ret
PutImmedString	endp

LoadString	proc	near
	mov	ax,256
_LoadString	label	near
	cmp	[di].exLocation,elStack
	je	@@1
	push	ax
	call	PutImmedString
	call	PushAddr
	pop	ax
	Invoke	CreateLocalVar
	Invoke	UseExpr
	mov	ax,_SLoad
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
@@1:	ret
LoadString	endp

StringLength	proc	near
	cmp	[di].exLocation,elMemory
	je	@@2
	cmp	[di].exLocation,elImmediate
	jne	@@1
	mov	bx,[di].exOffset
	mov	al,[bx]
	xor	ah,ah
	xor	dx,dx
	Invoke	SetValue
	Chain	CastLongint
@@1:	Invoke	UseExpr
	mov	ax,75fh			; pop	di	pop	es
	Invoke	PutWord
	Invoke	DoneExpr
	mov	[di].exLocation,elMemory
	mov	[di].exMisc,efES+efDI
	mov	[di].exOffset,0
@@2:	mov	[di].exModifier,emByte
	Chain	CastLongint
StringLength	endp

ConvChar2String	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttChar
	jne	@@2
	cmp	[di].exLocation,elImmediate
	jne	@@1
	mov	ax,2
	Invoke	AllocTempBuf
	mov	al,1
	mov	ah,[di].exValue.B0
	mov	[bx],ax
	mov	[di].exOffset,bx
	mov	[di].exModifier,emBoolean
	Chain	CastString
@@1:	Invoke	PushValue
	mov	ax,256
	Invoke	CreateLocalVar
	Invoke	UseExpr
	mov	ax,_SChar
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	Chain	CastString
@@2:	ret
ConvChar2String	endp

LoadPackedChar	proc	near
	call	CheckPackedChar
	jnz	@@1
	push	ax
	call	PushAddr
	mov	ax,256
	Invoke	CreateLocalVar
	Invoke	UseExpr
	pop	ax
	Invoke	PushWord
	mov	ax,_SPacked
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	Chain	CastString
@@1:	ret
LoadPackedChar	endp

CheckPackedChar	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttArray
	jne	@@1
	mov	ax,es:[bx].atBase.Offs
	mov	bx,es:[bx].atBase.Segm
	mov	es,es:[bx]
	mov	bx,ax
	cmp	es:[bx].tdType,ttChar
	jne	@@1
	les	bx,[di].exType
	mov	ax,es:[bx].tdSizeOf
	cmp	ax,255
	ja	@@1
	cmp	ax,ax
@@1:	ret
CheckPackedChar	endp

LoadAddress	proc	near
	cmp	[di].exLocation,elAddress
	je	@@1
	ret
@@1:	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	Chain	DoneExpr
LoadAddress	endp

GetVarValue	proc	near
	test	CompilerFlags.B0,cfDebugging
	jnz	@@2
@@1:	ret
@@2:	cmp	[di].exLocation,elMemory
	jne	@@1
	mov	[di].exLocation,elImmediate
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	cmp	al,ttInteger
	jb	@@3
	call	CopyValue
	mov	al,[di].exModifier
	Chain	ConvertOrdinal
@@3:	cmp	al,ttPointer
	jne	@@4
	jmp	CopyValue
@@4:	cmp	al,ttReal
	jne	@@5
	call	CopyValue
	lea	bx,[di].exValue
	Invoke	Real2Extended
	Chain	CastExtended
@@5:	cmp	al,tt8087
	jne	@@6
	call	CopyValue
	mov	al,[di].exModifier
	lea	bx,[di].exValue
	Invoke	Float2Extended
	Chain	CastExtended
@@6:	cmp	al,ttString
	jne	@@7
	les	bx,dword ptr [di].exValue
	mov	al,es:[bx]
	xor	ah,ah
	inc	ax
	mov	cx,ax
	Invoke	AllocTempBuf
	call	_CopyValue
	mov	[di].exOffset,bx
	ret
@@7:	cmp	al,ttSet
	jne	@@8
	Invoke	SetBaseAndSize
	mov	dx,ax
	mov	ax,32
	Invoke	AllocTempBuf
	push	si di ds ds
	pop	es
	lds	si,dword ptr [di].exValue
	mov	di,bx
	mov	cl,dh
	xor	ch,ch
	xor	al,al
	rep	stosb
	mov	cl,dl
	rep	movsb
	mov	cl,32
	sub	cl,dl
	sub	cl,dh
	rep	stosb
	pop	ds di si
	mov	[di].exOffset,bx
	ret
@@8:	cmp	al,ttArray
	jne	@@9
	call	CheckPackedChar
	jnz	@@9
	mov	cx,ax
	inc	ax
	Invoke	AllocTempBuf
	mov	[bx],cl
	inc	bx
	call	_CopyValue
	dec	bx
	mov	[di].exOffset,bx
	Chain	CastString
@@9:	mov	ax,137
	Chain	CompileError
GetVarValue	endp

CopyValue	proc	near
	les	bx,[di].exType
	mov	cx,es:[bx].tdSizeOf
	lea	bx,[di].exValue
_CopyValue	label	near
	push	si di ds ds
	pop	es
	lds	si,dword ptr [di].exValue
	mov	di,bx
	rep	movsb
	pop	ds di si
	ret
CopyValue	endp

Push2Addrs	proc	near
	call	PushAddr
	xchg	si,di
	call	PushAddr
	xchg	si,di
	ret
Push2Addrs	endp

PushAddr	proc	near
	cmp	[di].exLocation,elMemory
	jne	@@1
	mov	[di].exLocation,elAddress
	mov	[di].exModifier,emLongint
	and	[di].exMisc,not efReadOnly
	Chain	PushValue
@@1:	ret
PushAddr	endp

	end