www.pudn.com > tp60src.zip > CONVERT.ASM

	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