expr.asm

Turbo Pascal 6.0编译器源码

	Invoke	GetTypeName
	mov	bx,di
	pop	di
	cmp	es:[bx].tdType,ttObject
	jne	@@1
	mov	al,tPoint
	Invoke	CheckToken
	jz	@@7
@@1:	push	es bx
	mov	al,tOParen
	Invoke	NeedToken
	call	GetExpr
	mov	al,tCParen
	Invoke	NeedToken
	mov	al,es:[bx].tdType
	mov	dx,es:[bx].tdSizeOf
	pop	bx es
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	cmp	[di].exLocation,elMemory
	jne	@@3
	test	[di].exMisc,efReadOnly
	jnz	@@3
	or	dx,dx
	jz	@@2
	cmp	dx,es:[bx].tdSizeOf
	jne	@@3
@@2:	mov	al,es:[bx].tdModifier
	mov	[di].exModifier,al
	ret
@@3:	cmp	al,ttInteger
	jae	@@4
	cmp	al,ttPointer
	jne	@@6
@@4:	cmp	es:[bx].tdType,ttInteger
	jae	@@5
	cmp	es:[bx].tdType,ttPointer
	jne	@@6
@@5:	mov	al,es:[bx].tdModifier
	push	ax
	Invoke	GetVarValue
	pop	ax
	Chain	ConvertOrdinal
@@6:	mov	ax,61
	Chain	CompileError
@@7:	mov	[di].exCode,0
	mov	[di].exRegsUsed,0
	mov	ax,emNotVirtual+pfMethod*256
	mov	dx,150
_GetMethod	label	near
	cmp	CurrentToken,t_Ident
	jne	@@8
	push	ax dx di
	mov	si,bx
	Invoke	SearchField
	mov	cl,al
	mov	si,di
	pop	di dx ax
	jnz	@@8
	cmp	cl,t_Proc
	jne	@@8
	test	es:[si].psFlags,ah
	jz	@@8
	jmp	_ProcessProc
@@8:	mov	ax,dx
	Chain	CompileError
ProcessType	endp

ProcessSet	proc	near
	Loc	BaseType,dword,1
	Loc	Temp1,byte,<size TExpr>
	Loc	Temp2,byte,<size TExpr>
	Loc	Value,byte,32
	Loc	Buffer,word,64
	Entry
	Invoke	GetToken
	push	di
	xor	ax,ax
	mov	BaseType.Offs,ax
	mov	BaseType.Segm,ax
	mov	Buffer[0],ax
	lea	di,Value
	push	ds
	pop	es
	mov	cx,16
	rep	stosw
	mov	al,tCBracket
	Invoke	CheckToken
	jnz	@@1
	mov	ax,SystemUnit
	mov	BaseType.Offs,_EmptySet
	mov	BaseType.Segm,ax
	jmp	@@10
@@1:	lea	di,Temp1
	call	GetComponent
	mov	al,tRange
	Invoke	CheckToken
	jnz	@@3
	lea	di,Temp2
	call	GetComponent
	cmp	Temp1.exLocation,elImmediate
	jne	@@2
	cmp	Temp2.exLocation,elImmediate
	jne	@@2
	mov	ax,Temp1.exValue.W0
	mov	dx,Temp2.exValue.W0
	jmp	short @@4
@@2:	lea	di,Temp1
	Invoke	UseExpr
	Invoke	PutPush
	lea	di,Temp2
	Invoke	UseExpr
	Invoke	PutPush
	mov	ax,_ZAddRange
	jmp	short @@7
@@3:	cmp	Temp1.exLocation,elImmediate
	jne	@@6
	mov	ax,Temp1.exValue.W0
	mov	dx,ax
@@4:	sub	dx,ax
	jc	@@8
	mov	si,ax
	mov	cl,3
	shr	si,cl
	mov	cl,al
	and	cl,7
	mov	al,1
	shl	al,cl
@@5:	or	Value[si],al
	rol	al,1
	adc	si,0
	dec	dx
	jns	@@5
	jmp	short @@8
@@6:	lea	di,Temp1
	Invoke	UseExpr
	Invoke	PutPush
	mov	ax,_ZAddComp
@@7:	Invoke	PutSystemCall
	Invoke	DoneGoal
	lea	bx,Buffer
	Invoke	AddGoal
@@8:	mov	al,tComma
	Invoke	CheckToken
	jnz	@@9
	jmp	@@1
@@9:	mov	al,tCBracket
	Invoke	NeedToken
@@10:	mov	ax,32
	mov	cx,ax
	Invoke	AllocTempBuf
	lea	si,Value
	mov	di,bx
	push	ds
	pop	es
	rep	movsb
	pop	di
	les	si,BaseType
	mov	[di].exType.Offs,si
	mov	[di].exType.Segm,es
	mov	[di].exCode,0
	mov	[di].exLocation,elImmediate
	mov	[di].exRegsUsed,0
	mov	[di].exOffset,bx
	cmp	Buffer[0],0
	je	@@11
	Invoke	LoadSet
	Invoke	UseExpr
	lea	bx,Buffer
	Invoke	FlushGoals
	Invoke	DoneExpr
@@11:	Exit

GetComponent	proc	near
	Invoke	GetOrdExpr
	Invoke	GetVarValue
	cmp	BaseType.Offs,0
	jne	@@1
	les	bx,[di].exType
	mov	ax,es:[bx].itBase.Offs
	mov	bx,es:[bx].itBase.Segm
	mov	bx,es:[bx]
	add	ax,etSet
	mov	BaseType.Offs,ax
	mov	BaseType.Segm,bx
@@1:	les	bx,[di].exType
	mov	ax,es:[bx].itBase.Offs
	mov	bx,es:[bx].itBase.Segm
	mov	bx,es:[bx]
	add	ax,etSet
	cmp	ax,BaseType.Offs
	jne	@@2
	cmp	bx,BaseType.Segm
	jne	@@2
	Chain	CastByte
@@2:	mov	ax,26
	Chain	CompileError
GetComponent	endp

ProcessSet	endp

ProcessAt	proc	near
	Invoke	GetToken
	call	GetRef
	xor	cx,cx
	call	GetAddress
	Chain	CastPointer
ProcessAt	endp

GetAddress	proc	near
	les	si,[di].exType
	cmp	[di].exLocation,elCall
	je	@@2
	cmp	es:[si].tdType,ttProc
	je	@@1
	mov	[di].exLocation,elAddress
	mov	[di].exModifier,emLongint
	and	[di].exMisc,not efReadOnly
	test	CompilerFlags.B0,cfDebugging
	jz	@@1
	mov	[di].exLocation,elImmediate
@@1:	ret
@@2:	test	CompilerFlags.B0,cfDebugging
	jnz	@@6
	mov	al,es:[si-psType].psFlags
	test	al,pfInline
	jnz	@@5
	test	al,pfMethod
	jz	@@3
	test	[di].exModifier,emNotVirtual
	jz	@@5
@@3:	or	ch,ch
	jz	@@4
	test	al,pfInterrupt+pfMethod
	jnz	@@5
	test	al,pfFar
	jz	@@5
	cmp	es:[si-psType].psScope,0
	jne	@@5
@@4:	xor	ax,ax
	mov	bx,es:[si-psType].psProcMap
	mov	[di].exLocation,elAddress
	mov	[di].exModifier,emLongint
	mov	[di].exRegsUsed,al
	mov	[di].exMisc,efConst
	mov	[di].exOffset,ax
	mov	[di].exMap,bx
	mov	[di].exSegment,es
	ret
@@5:	mov	ax,143
	Chain	CompileError
@@6:	call	CheckProgLoaded
	test	[di].exModifier,emNotVirtual
	jnz	@@7
	mov	bx,es:[si-psType].psOwner
	or	bx,bx
	jz	@@7
	mov	si,es:[si-psType].psScope
	mov	ax,es:[si].otVMTOffset
	les	si,dword ptr [di].exValue
	add	si,ax
	mov	si,es:[si]
	mov	ax,ProgramSegment
	add	ax,DataStart
	mov	es,ax
	mov	ax,es:[bx+si].Offs
	mov	dx,es:[bx+si].Segm
	jmp	short @@8
@@7:	test	es:[si-psType].psFlags,pfInline
	jnz	@@9
	mov	si,es:[si-psType].psProcMap
	add	si,es:uhProcMap
	mov	ax,es:[si].pmEntryPoint
	mov	si,es:[si].pmCodeMap
	add	si,es:uhCodeMap
	mov	dx,es:[si].smAddr
	cmp	dx,-1
	je	@@9
	add	ax,dx
	mov	dx,ProgramSegment
	add	dx,es:uhCodeStart
@@8:	mov	[di].exLocation,elImmediate
	mov	[di].exModifier,emLongint
	mov	[di].exValue.Offs,ax
	mov	[di].exValue.Segm,dx
	ret
@@9:	mov	ax,139
	Chain	CompileError
GetAddress	endp

ProcessMem	proc	near
	Loc	Temp1,byte,<size TExpr>
	Loc	Temp2,byte,<size TExpr>
	Entry
	Invoke	GetToken
	les	si,CurrentSymbol
	mov	bx,es:[si].Offs
	mov	si,es:[si].Segm
	mov	es,es:[si]
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	mov	al,es:[bx].tdModifier
	mov	[di].exModifier,al
	push	di
	mov	al,tOBracket
	Invoke	NeedToken
	lea	di,Temp1
	Invoke	GetIntExpr
	Invoke	GetVarValue
	Invoke	CastWord
	mov	al,tColon
	Invoke	NeedToken
	lea	di,Temp2
	Invoke	GetIntExpr
	Invoke	GetVarValue
	Invoke	CastWord
	mov	al,tCBracket
	Invoke	NeedToken
	test	CompilerFlags.B0,cfDebugging
	jnz	@@1
	lea	di,Temp1
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	mov	al,50h			; push	ax
	Invoke	PutByte
	lea	di,Temp2
	Invoke	UseExpr
	mov	al,lvDI
	Invoke	LoadValue
	mov	al,7			; pop	es
	Invoke	PutByte
	pop	di
	Invoke	DoneExpr
	mov	al,Temp1.exRegsUsed
	or	al,Temp2.exRegsUsed
	and	al,erAll
	mov	[di].exRegsUsed,al
	mov	[di].exMisc,efES+efDI
	xor	ax,ax
	mov	[di].exOffset,ax
	mov	[di].exMap,ax
	mov	[di].exSegment,ax
	jmp	short @@2
@@1:	pop	di
	xor	ax,ax
	mov	[di].exCode,ax
	mov	[di].exMisc,al
	mov	ax,Temp2.exValue.W0
	mov	[di].exValue.Offs,ax
	mov	ax,Temp1.exValue.W0
	mov	[di].exValue.Segm,ax
@@2:	mov	[di].exLocation,elMemory
	Exit
ProcessMem	endp

ProcessPort	proc	near
	Loc	Opcode,byte,2
	Entry
	call	CheckDebugging
	Invoke	GetToken
	les	si,CurrentSymbol
	mov	al,0e4h			; in	al,...
	add	al,es:[si]
	mov	Opcode,al
	mov	al,tOBracket
	Invoke	NeedToken
	Invoke	GetIntExpr
	Invoke	CastWord
	mov	al,tCBracket
	Invoke	NeedToken
	cmp	[di].exLocation,elImmediate
	jne	@@1
	mov	ax,[di].exValue.W0
	or	ah,ah
	jnz	@@1
	mov	ah,al
	mov	al,Opcode
	Invoke	PutWord
	jmp	short @@2
@@1:	Invoke	UseExpr
	mov	al,lvDX
	Invoke	LoadValue
	mov	al,Opcode
	or	al,8
	Invoke	PutByte
@@2:	Invoke	DoneExpr
	mov	[di].exModifier,emByte
	test	Opcode,1
	jz	@@3
	mov	[di].exModifier,emWord
@@3:	mov	[di].exLocation,elRegister
	or	[di].exRegsUsed,erAX
	mov	[di].exMisc,0
	Exit
ProcessPort	endp

ProcessReg	proc	near
	Invoke	GetToken
	les	si,CurrentSymbol
	mov	dl,es:[si]
	mov	bx,_Byte
	or	dl,dl
	js	@@1
	mov	bx,_Word
@@1:	mov	es,SystemUnit
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	xor	ax,ax
	mov	[di].exCode,ax
	mov	[di].exLocation,elMemory
	mov	cl,es:[bx].tdModifier
	mov	[di].exModifier,cl
	mov	[di].exRegsUsed,al
	mov	[di].exMisc,al
	and	dx,7fh
	add	dx,offset Rg
	mov	[di].exValue.Offs,dx
	mov	[di].exValue.Segm,ds
	ret
ProcessReg	endp

CheckDebugging	proc	near
	test	CompilerFlags.B0,cfDebugging
	jnz	@@1
	ret
@@1:	mov	ax,133
	Chain	CompileError
CheckDebugging	endp

CheckProgLoaded	proc	near
	cmp	ProgramSegment,0
	je	@@1
	ret
@@1:	mov	ax,139
	Chain	CompileError
CheckProgLoaded	endp

GetReference	proc	near
	call	LValue
@@1:	cmp	[di].exLocation,elCall
	jne	@@2
	test	CompilerFlags.B0,cfDebugging
	jnz	@@4
	les	bx,[di].exType
	cmp	es:[bx].ptResult.Offs,0
	je	@@3
	Invoke	PutCall
	Invoke	ReturnValue
@@2:	call	Qualifier
	jz	@@1
	cmp	[di].exLocation,elMemory
	jne	@@4
	test	[di].exMisc,efReadOnly
	jnz	@@4
	ret
@@3:	mov	ax,143
	Chain	CompileError
@@4:	mov	ax,122
	Chain	CompileError
GetReference	endp

GetRef	proc	near
	call	LValue
@@1:	les	bx,[di].exType
	cmp	es:[bx].tdType,ttProc
	je	@@2
	call	Qualifier
	jz	@@1
	cmp	[di].exLocation,elMemory
	jne	@@3
	test	[di].exMisc,efReadOnly
	jnz	@@3
@@2:	ret
@@3:	mov	ax,122
	Chain	CompileError
GetRef	endp

GetLvalue	proc	near
	cmp	CurrentToken,t_Proc
	jne	LValue
	Invoke	GetReturnVar
	jc	LValue
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	mov	[di].exOffset,ax
	mov	al,es:[bx].tdModifier
	mov	[di].exModifier,al
	mov	[di].exLocation,elMemory
	mov	[di].exRegsUsed,0
	mov	dx,CurrentHash
	call	GetLocalRef
	cmp	[di].exOffset,0
	jl	@@1
	mov	dx,38c4h		; les	di,
	Invoke	AddReg
	mov	[di].exMisc,efES+efDI
	mov	[di].exOffset,0
@@1:	Invoke	DoneExpr
	Chain	GetToken
GetLvalue	endp

LValue	proc	near
	Invoke	GetSymbol
	lea	bx,@@2
	Invoke	ChooseToken
	jnz	@@1
	jmp	word ptr cs:[bx+1]
@@1:	mov	ax,20
	Chain	CompileError
@@2	db	8,3
	db	t_Var
	dw	ProcessVar
	db	t_Proc
	dw	ProcessProc
	db	t_Type
	dw	ProcessType
	db	tString
	dw	ProcessType
	db	tFile
	dw	ProcessType
	db	t_StdFun
	dw	ProcessStdFun
	db	t_Mem
	dw	ProcessMem
	db	tAt
	dw	ProcessAt
LValue	endp

Qualifier	proc	near
	mov	al,CurrentToken
	lea	bx,ProcessIndex
	cmp	al,tOBracket
	je	@@1
	lea	bx,ProcessField
	cmp	al,tPoint
	je	@@1
	lea	bx,ProcessPointer
	cmp	al,tCaret
	je	@@1
	ret
@@1:	call	bx
	xor	ax,ax
	ret
Qualifier	endp

ProcessIndex	proc	near
	Loc	Temp,byte,<size TExpr>
	Loc	LowerBound,word,1
	Loc	ElementSize,word,1
	Loc	BaseType,dword,1
	Entry
@@1:	les	bx,[di].exType
	mov	al,es:[bx].tdType
	cmp	al,ttArray
	je	@@3
	cmp	al,ttString
	je	@@3
@@2:	mov	ax,121
	Chain	CompileError
@@3:	cmp	[di].exLocation,elMemory
	jne	@@2
	test	[di].exMisc,efReadOnly
	jnz	@@2
	mov	ax,es:[bx].atBounds.Offs
	mov	bx,es:[bx].atBounds.Segm
	mov	es,es:[bx]
	mov	bx,ax
	Invoke	GetToken
	mov	ax,es:[bx].itLowerBound.W0
	mov	LowerBound,ax
	mov	BaseType.Offs,bx
	mov	BaseType.Segm,es
	push	di
	lea	di,Temp
	call	GetExpr
	Invoke	LoadAddress
	Invoke	GetVarValue
	lea	si,BaseType
	Invoke	TypeCompat
	mov	IndexModifier,emX
	Invoke	CastOrdinal
	mov	IndexModifier,0
	mov	si,di
	pop	di
	les	bx,[di].exType
	mov	ax,es:[bx].atBase.Offs
	mov	bx,es:[bx].atBase.Segm
	mov	es,es:[bx]
	mov	bx,ax
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	mov	al,es:[bx].tdModifier
	mov	[di].exModifier,al
	mov	ax,es:[bx].tdSizeOf
	mov	ElementSize,ax
	cmp	[si].exLocation,elImmediate
	jne	@@4
	mov	ax,[si].exValue.W0
	sub	ax,LowerBound
	mul	ElementSize
	add	[di].exOffset,ax
	jmp	short @@7
@@4:	mov	ax,LowerBound
	mul	ElementSize
	sub	[di].exOffset,ax
	xchg	si,di
	Invoke	UseExpr
	mov	cx,ElementSize
	test	[si].exMisc,efDI
	jnz	@@5
	mov	al,lvDI
	Invoke	Scale
	mov	al,lvDI
	Invoke	LoadValue
	xchg	si,di
	Invoke	UseExpr
	jmp	short @@6
@@5:	mov	al,lvAX
	Invoke	Scale
	mov	al,[si].exRegsUsed
	Invoke	FindEmptyReg
	xchg	si,di
	Invoke	UseExpr
	xchg	si,di
	mov	al,lvAX
	Invoke	PopValue
	mov	ax,0f803h		; add	di,
	or	ah,[di].exMisc
	Invoke	PutWord
	xchg	si,di
@@6:	Invoke	DoneExpr
	mov	al,[si].exRegsUsed
	and	al,erAll
	or	[di].exRegsUsed,al
	or	[di].exMisc,efDI
@@7:	cmp	CurrentToken,tComma
	jne	@@8
	jmp	@@1
@@8:	mov	al,tCBracket
	Invoke	NeedToken
	Exit
ProcessIndex	endp

ProcessField	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttRecord
	je	@@1
	cmp	es:[bx].tdType,ttObject
	jne	@@3
@@1:	Invoke	GetToken
	cmp	CurrentToken,t_Ident
	jne	@@4
	push	di
	mov	si,bx
	Invoke	SearchField
	mov	si,di
	pop	di
	jnz	@@4
	cmp	al,t_Var
	jne	@@2
	mov	ax,es:[si].vsOffset
	add	[di].exOffset,ax
	mov	bx,es:[si].vsType.Offs
	mov	si,es:[si].vsType.Segm
	mov	es,es:[si]
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	mov	al,es:[bx].tdModifier
	mov	[di].exModifier,al
	Chain	GetToken
@@2:	mov	al,0
	jmp	_ProcessProc
@@3:	mov	ax,121
	Chain	CompileError
@@4:	mov	ax,44
	Chain	CompileError
ProcessField	endp

ProcessPointer	proc	near
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttPointer
	je	@@1
	mov	ax,121
	Chain	CompileError
@@1:	Invoke	GetToken
	mov	si,es:[bx].ptBase.Segm
	mov	bx,es:[bx].ptBase.Offs
	mov	es,es:[si]
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	mov	al,es:[bx].tdModifier
	mov	[di].exModifier,al
LoadPtr	label	near
	test	CompilerFlags.B0,cfDebugging
	jnz	@@6
	cmp	[di].exLocation,elAddress
	je	@@5
	cmp	[di].exLocation,elImmediate
	jne	@@2
	mov	[di].exMisc,0
	jmp	short @@5
@@2:	Invoke	UseExpr
	cmp	[di].exLocation,elMemory
	jne	@@3
	mov	dx,38c4h		; les	di,
	Invoke	AddReg
	jmp	short @@4
@@3:	mov	ax,0c789h		; mov	di,ax
	Invoke	PutWord
	mov	ax,0c28eh		; mov	es,dx
	Invoke	PutWord
@@4:	Invoke	DoneExpr
	mov	[di].exMisc,efES+efDI
	mov	[di].exOffset,0
@@5:	mov	[di].exLocation,elMemory
	ret
@@6:	cmp	[di].exLocation,elImmediate
	je	@@7
	les	bx,dword ptr [di].exValue
	les	bx,es:[bx]
	mov	[di].exValue.Offs,bx
	mov	[di].exValue.Segm,es
@@7:	mov	[di].exLocation,elMemory
	mov	[di].exMisc,0
	ret
ProcessPointer	endp

	end