convert2.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.code	compiler_text

	public	GetReturnVar
	public	Store
	public	PutCall
	public	ReturnValue
	public	DiscardReturn
	public	TypeCompat
	public	ProcCompat
	public	CastOrdinal
	public	CastByte
	public	CastInt
	public	CastWord
	public	CastLong

GetReturnVar	proc	near
	les	si,CurrentSymbol
	mov	ax,es
	cmp	ax,Dictionary.Segm
	jne	@@2
	cmp	es:[si].psType.ptResult.Offs,0
	je	@@2
	mov	bx,es:[si].psProcMap
	push	ds
	mov	ds,ProcMap.Segm
	cmp	[bx].pmCodeMap,-2
	pop	ds
	jne	@@2
	xor	ax,ax
	mov	bx,es:[si].psType.ptResult.Offs
	mov	si,es:[si].psType.ptResult.Segm
	mov	es,es:[si]
	sub	ax,es:[bx].tdSizeOf
	cmp	es:[bx].tdType,ttString
	jne	@@1
	push	es di bx
	les	di,CurrentSymbol
	Invoke	StackRequired
	pop	bx di es
	mov	ax,dx
@@1:	clc
	ret
@@2:	stc
	ret
GetReturnVar	endp

Store	proc	near
	les	bx,[di].exType
	mov	bl,es:[bx].tdType
	xor	bh,bh
	shl	bx,1
	jmp	cs:@@1[bx]
@@1	dw	StoreCompound
	dw	StoreCompound
	dw	StoreCompound
	dw	StoreObject
	dw	StoreCompound
	dw	StoreCompound
	dw	StoreOrdinal
	dw	StoreSet
	dw	StoreOrdinal
	dw	StoreString
	dw	Store8087
	dw	StoreReal
	dw	StoreOrdinal
	dw	StoreOrdinal
	dw	StoreOrdinal
	dw	StoreOrdinal
Store	endp

StoreObject	proc	near
	les	bx,[di].exType
	mov	ax,_CopyObject
	mov	dx,es:[bx].otVMTOffset
	cmp	es:[bx].otVMTSize,0
	jne	@@1
StoreCompound	label	near
	xchg	si,di
	call	ShortRecord
	xchg	si,di
	call	ShortRecord
	jz	StoreOrdinal
	les	bx,[di].exType
	mov	ax,_BlockMove
	mov	dx,es:[bx].tdSizeOf
@@1:	push	ax dx
	xchg	si,di
	Invoke	Push2Addrs
	Invoke	Use2Exprs
	xchg	si,di
	pop	ax
	Invoke	PushWord
	pop	ax
	Invoke	PutSystemCall
	Chain	DoneExpr
StoreObject	endp

StoreOrdinal	proc	near
	cmp	[si].exLocation,elImmediate
	jne	@@4
	mov	ax,[si].exValue.W0
	or	ax,[si].exValue.W2
	jnz	@@2
	test	[di].exModifier,emX
	jz	@@2
	Invoke	UseExpr
	mov	ax,0c031h		; xor	ax,ax
	Invoke	PutWord
	mov	al,lvAX
	Invoke	StoreReg
	test	[di].exModifier,emXX
	jz	@@1
	add	[di].exOffset,2
	mov	al,lvAX
	Invoke	StoreReg
	sub	[di].exOffset,2
@@1:	or	[di].exRegsUsed,erAX
	Chain	DoneExpr
@@2:	Invoke	UseExpr
	mov	ax,[si].exValue.W0
	Invoke	PutMovRMImm
	test	[di].exModifier,emXX
	jz	@@3
	add	[di].exOffset,2
	mov	ax,[si].exValue.W2
	Invoke	PutMovRMImm
	sub	[di].exOffset,2
@@3:	Chain	DoneExpr
@@4:	xchg	si,di
	Invoke	UseExpr
	mov	al,[si].exRegsUsed
	Invoke	FindEmptyReg
	xchg	si,di
	Invoke	UseExpr
	xchg	si,di
	xor	al,al
	Invoke	PopValue
	xchg	si,di
	mov	al,[si].exMisc
	Invoke	StoreValue
	Chain	DoneExpr
StoreOrdinal	endp

StoreSet	proc	near
	xchg	si,di
	Invoke	_LoadSet
	Invoke	Push2Addrs
	Invoke	Use2Exprs
	xchg	si,di
	les	bx,[di].exType
	Invoke	PushSetAddr
	mov	ax,_ZStore
	Invoke	PutSystemCall
	Chain	DoneExpr
StoreSet	endp

StoreString	proc	near
	cmp	[si].exLocation,elImmediate
	jne	@@1
	mov	bx,[si].exOffset
	cmp	[bx].B0,0
	jne	@@1
	Invoke	UseExpr
	mov	dx,0c6h			; mov	[...],0
	Invoke	AddReg
	xor	al,al
	Invoke	PutByte
	Chain	DoneExpr
@@1:	xchg	si,di
	Invoke	PutImmedString
	Invoke	Push2Addrs
	Invoke	Use2Exprs
	xchg	si,di
	les	bx,[di].exType
	mov	ax,es:[bx].tdSizeOf
	dec	ax
	Invoke	PushWord
	mov	ax,_SStore
	Invoke	PutSystemCall
	Chain	DoneExpr
StoreString	endp

Store8087	proc	near
	xchg	si,di
	Invoke	PushExt
	Invoke	Use2Exprs
	xchg	si,di
	mov	dx,18d9h		; fstp
	test	[di].exModifier,emExtended
	jz	@@1
	mov	dh,38h
@@1:	or	dl,[di].exModifier
	Invoke	PutFloatRM
	Invoke	PutFwait
	Chain	DoneExpr
Store8087	endp

StoreReal	proc	near
	cmp	[si].exLocation,elImmediate
	jne	@@1
	Invoke	UseExpr
	mov	ax,[si].exValue.W0
	Invoke	PutMovRMImm
	add	[di].exOffset,2
	mov	ax,[si].exValue.W2
	Invoke	PutMovRMImm
	add	[di].exOffset,2
	mov	ax,[si].exValue.W4
	Invoke	PutMovRMImm
	jmp	short @@4
@@1:	xchg	si,di
	Invoke	UseExpr
	mov	al,lrR1
	Invoke	LoadReal
	xchg	si,di
	cmp	[di].exRegsUsed,0
	je	@@2
	mov	ax,5352h		; push	dx	push	bx
	Invoke	PutWord
	mov	al,50h			; push	ax
	Invoke	PutByte
@@2:	Invoke	UseExpr
	cmp	[di].exRegsUsed,0
	je	@@3
	mov	al,58h			; pop	ax
	Invoke	PutByte
	mov	ax,5a5bh		; pop	bx	pop	dx
	Invoke	PutWord
@@3:	mov	al,lvAX
	Invoke	StoreReg
	add	[di].exOffset,2
	mov	al,lvBX
	Invoke	StoreReg
	add	[di].exOffset,2
	mov	al,lvDX
	Invoke	StoreReg
@@4:	sub	[di].exOffset,4
	Chain	DoneExpr
StoreReal	endp

ShortRecord	proc	near
	les	bx,[di].exType
	mov	ax,es:[bx].tdSizeOf
	cmp	ax,1
	je	@@1
	cmp	ax,2
	je	@@2
	cmp	ax,4
	je	@@3
	ret
@@1:	mov	[di].exModifier,0
	ret
@@2:	mov	[di].exModifier,emX
	ret
@@3:	mov	[di].exModifier,emX+emXX
	ret
ShortRecord	endp

PutCall	proc	near
	cmp	[di].exLocation,elMemory
	je	@@2
	test	[di].exModifier,emNotVirtual
	jnz	@@3
	les	bx,[di].exType
	cmp	es:[bx-psType].psOwner,0
	je	@@3
	call	GetActualParams
	les	si,[di].exType
	call	HiddenParams
	and	[di].exMisc,efDS+efSS+efCS
	or	[di].exMisc,efES
	Invoke	PutPrefix
	mov	si,es:[si-psType].psScope
	mov	ax,es:[si].otVMTOffset
	mov	dx,3d8bh		; mov	di,[di+...]
	Invoke	AddOffset
	test	CompilerOptions,coRangeChk
	jz	@@1
	mov	ax,_MethodCheck
	Invoke	PutSystemCall
@@1:	les	si,[di].exType
	mov	ax,es:[si-psType].psOwner
	mov	dx,1dffh		; call	[di+...]
	Invoke	AddOffset
	Chain	DoneExpr
@@2:	call	GetActualParams
	Invoke	UseExpr
	mov	dx,18ffh		; call	[...]
	Invoke	AddReg
	Chain	DoneExpr
@@3:	call	GetActualParams
	mov	bx,si
	les	si,[di].exType
	test	es:[si-psType].psFlags,pfInterrupt
	jnz	@@4
	test	es:[si-psType].psFlags,pfInline
	jz	@@5
	mov	cx,es:[si-psType].psInlineLen
	push	di
	mov	di,bx
	Invoke	PutInline
	pop	di
	jmp	short @@11
@@4:	mov	ax,114
	Chain	CompileError
@@5:	test	es:[si-psType].psFlags,pfMethod
	jz	@@6
	call	HiddenParams
	jmp	short @@8
@@6:	mov	dx,es:[si-psType].psScope
	or	dx,dx
	jz	@@8
	cmp	dx,CurScope
	jne	@@7
	mov	al,55h			; push	bp
	Invoke	PutByte
	jmp	short @@8
@@7:	mov	cx,76ffh		; push	[bp+...]
	Invoke	GetNestedRef
@@8:	test	es:[si-psType].psFlags,pfFar
	jz	@@10
	mov	ax,es
	cmp	ax,Dictionary.Segm
	je	@@9
	mov	al,9ah			; call
	Invoke	PutByte
	mov	ax,es
	mov	bx,es:[si-psType].psProcMap
	mov	cx,ffProc+ffPtr
	xor	dx,dx
	Invoke	PutFixup
	jmp	short @@11
@@9:	mov	al,0eh			; push	cs
	Invoke	PutByte
@@10:	mov	al,0e8h			; call
	Invoke	PutByte
	mov	ax,es
	mov	bx,es:[si-psType].psProcMap
	mov	cx,ffProc
	xor	dx,dx
	Invoke	PutFixup
@@11:	Chain	DoneExpr
PutCall	endp

HiddenParams	proc	near
	test	es:[si-psType].psFlags,pfConstructor
	jz	@@1
	test	[di].exModifier,emNotVirtual
	jnz	@@2
	push	es
	mov	al,0b8h			; mov	ax,
	Invoke	PutByte
	les	bx,[di].exOwner
	mov	ax,es
	mov	bx,es:[bx].otVMTAddr
	mov	cx,ffConst+ffOffs
	xor	dx,dx
	Invoke	PutFixup
	pop	es
	jmp	short @@4
@@1:	test	es:[si-psType].psFlags,pfDestructor
	jz	@@5
	mov	ax,0ffb0h		; mov	al,0ffh
	test	[di].exModifier,emDisposeDestr
	jnz	@@3
@@2:	mov	ax,0c031h		; xor	ax,ax
@@3:	Invoke	PutWord
@@4:	mov	al,50h			; push	ax
	Invoke	PutByte
@@5:	test	[di].exModifier,emNotVirtual
	jnz	@@7
	test	[di].exModifier,emNewConstruct
	jnz	@@6
	Invoke	UseExpr
	Invoke	LoadSegDI
	or	al,6
	mov	ah,57h			; push	?s	push	di
	Chain	PutWord
@@6:	mov	ax,0c031h		; xor	ax,ax
	Invoke	PutWord
	mov	ax,5050h		; push	ax	push	ax
	Chain	PutWord
@@7:	push	es si
	Invoke	GetTopScope
	jz	@@8
	mov	bx,es:[si].psScope
	mov	ax,[di].exOwner.Offs
	mov	dx,[di].exOwner.Segm
	Invoke	CheckInherit
	jnz	@@8
	pop	si es
	mov	cx,7ec4h		; les	di,[bp+...]
	xor	dx,dx
	Invoke	GetNestedRef
	mov	[di].exMisc,efES+efDI
	mov	[di].exOffset,0
	mov	ax,5706h		; push	es	push	di
	Chain	PutWord
@@8:	mov	ax,143
	Chain	CompileError
HiddenParams	endp

ReturnValue	proc	near
	les	bx,[di].exType
	mov	si,es:[bx].ptResult.Segm
	mov	bx,es:[bx].ptResult.Offs
	mov	es,es:[si]
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	mov	[di].exRegsUsed,erAll
	cmp	es:[bx].tdType,ttInteger
	jae	@@1
	cmp	es:[bx].tdType,ttPointer
	je	@@1
	cmp	es:[bx].tdType,ttReal
	jne	@@2
@@1:	mov	al,es:[bx].tdModifier
	mov	[di].exLocation,elRegister
	mov	[di].exModifier,al
	mov	[di].exMisc,lvAX
	ret
@@2:	cmp	es:[bx].tdType,tt8087
	jne	@@3