expr.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.data

	extrn	Rg:word

	.code	compiler_text

	public	GetExpression
	public	GetExpr
	public	GetBooleanExpr
	public	GetNestedRef
	public	GetTopScope
	public	_GetMethod
	public	GetAddress
	public	CheckProgLoaded
	public	GetReference
	public	GetRef
	public	GetLvalue
	public	Qualifier
	public	LoadPtr

GetExpression	proc	near
	les	bx,[si].exType
	cmp	es:[bx].tdType,ttProc
	je	@@3
	xchg	si,di
	Invoke	CheckPackedChar
	xchg	si,di
	jz	@@1
GetExpr	label	near
	call	Expression
	Invoke	Cond2Number
	les	bx,[di].exType
	ret
@@1:	push	si
	call	GetExpr
	pop	si
	cmp	es:[bx].tdType,ttString
	jne	@@2
	cmp	[di].exLocation,elImmediate
	jne	@@2
	mov	bx,SymbolValue.W0
	les	si,[si].exType
	mov	ax,es:[si].tdSizeOf
	cmp	al,[bx]
	jne	@@2
	mov	dl,es:[si].tdModifier
	mov	[di].exType.Offs,si
	mov	[di].exType.Segm,es
	mov	[di].exModifier,dl
	inc	bx
	Invoke	PutConst
	mov	[di].exCode,0
	mov	[di].exLocation,elMemory
	mov	[di].exRegsUsed,0
	mov	[di].exMisc,efDS+efConst
	mov	[di].exOffset,dx
	mov	[di].exMap,bx
	mov	[di].exSegment,ax
@@2:	ret
@@3:	call	GetRef
	mov	ch,-1
	jmp	GetAddress
GetExpression	endp

GetBooleanExpr	proc	near
	call	Expression
	Invoke	GetVarValue
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttBoolean
	jne	@@2
	cmp	[di].exLocation,elImmediate
	je	@@1
	Invoke	Number2Cond
	Invoke	UseExpr
	mov	al,[di].exMisc
	xor	al,1
	lea	bx,[di].exChain2
	Invoke	PutJmp
	lea	bx,[di].exChain1
	Invoke	PutLabel
	Chain	DoneExpr
@@1:	ret
@@2:	mov	ax,40
	Chain	CompileError
GetBooleanExpr	endp

Expression	proc	near
	call	Expr1
	lea	bx,@@7
	Invoke	ChooseToken
	jnz	@@4
	Invoke	GetToken
	mov	al,cs:[bx+1]
	sub	sp,size TExpr
	mov	si,sp
	push	ax di
	mov	di,si
	call	Expr1
	mov	si,di
	pop	di ax
	Invoke	Operation
	add	sp,size TExpr
@@1:	ret
@@2:	mov	ax,41
	Chain	CompileError
@@3:	mov	ax,26
	Chain	CompileError
@@4:	mov	al,tIn
	Invoke	CheckToken
	jnz	@@1
	sub	sp,size TExpr
	mov	si,sp
	push	di
	mov	di,si
	call	Expr1
	Invoke	GetVarValue
	mov	si,di
	pop	di
	les	bx,[si].exType
	cmp	es:[bx].tdType,ttSet
	jne	@@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,[di].exType
	cmp	ax,es:[bx].itBase.Offs
	jne	@@3
	mov	bx,es:[bx].itBase.Segm
	cmp	dx,es:[bx]
	jne	@@3
	Invoke	GetVarValue
	Invoke	Cond2Number
	Invoke	CastByte
	cmp	[di].exLocation,elImmediate
	jne	@@5
	cmp	[si].exLocation,elImmediate
	jne	@@5
	mov	bx,[di].exValue.W0
	mov	cl,3
	shr	bx,cl
	add	bx,[si].exOffset
	mov	al,[bx]
	mov	cl,[di].exValue.B0
	and	cl,7
	shr	al,cl
	and	al,1
	Invoke	StoreBoolean
	jmp	short @@6
@@5:	Invoke	PushValue
	xchg	si,di
	Invoke	_LoadSet
	Invoke	PushAddr
	xchg	si,di
	Invoke	Use2Exprs
	mov	ax,_ZInTest
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	mov	al,cdNotEqual
	Invoke	_SetCondition
@@6:	add	sp,size TExpr
	ret
@@7	db	6,2
	db	tEqual,opEqual
	db	tNotEqual,opNotEqual
	db	tGreater,opGreater
	db	tLess,opLess
	db	tGEq,opGEq
	db	tLEq,opLEq
Expression	endp

Expr1	proc	near
	call	Expr2
@@1:	lea	bx,@@3
	Invoke	ChooseToken
	jnz	@@2
	Invoke	GetToken
	mov	al,cs:[bx+1]
	sub	sp,size TExpr
	mov	si,sp
	push	ax di
	mov	di,si
	call	Expr2
	mov	si,di
	pop	di ax
	Invoke	Operation
	add	sp,size TExpr
	jmp	@@1
@@2:	ret
@@3	db	4,2
	db	tPlus,opPlus
	db	tMinus,opMinus
	db	tOr,opOr
	db	tXor,opXor
Expr1	endp

Expr2	proc	near
	call	Primary
@@1:	lea	bx,@@3
	Invoke	ChooseToken
	jnz	@@2
	Invoke	GetToken
	mov	al,cs:[bx+1]
	sub	sp,size TExpr
	mov	si,sp
	push	ax di
	mov	di,si
	call	Primary
	mov	si,di
	pop	di ax
	Invoke	Operation
	add	sp,size TExpr
	jmp	@@1
@@2:	ret
@@3	db	7,2
	db	tTimes,opTimes
	db	tSlash,opSlash
	db	tDiv,opDiv
	db	tMod,opMod
	db	tAnd,opAnd
	db	tShl,opShl
	db	tShr,opShr
Expr2	endp

Primary	proc	near
	Invoke	ProcessCaret
	Invoke	GetSymbol
	lea	bx,@@7
	Invoke	ChooseToken
	jnz	@@5
	call	cs:[bx+1]
@@1:	les	bx,[di].exType
	cmp	es:[bx].tdType,ttProc
	jne	@@2
	test	CompilerFlags.B0,cfDebugging
	jnz	@@4
	cmp	es:[bx].ptResult.Offs,0
	je	@@3
	Invoke	PutCall
	Invoke	ReturnValue
@@2:	call	Qualifier
	jz	@@1
	ret
@@3:	cmp	[di].exLocation,elCall
	jne	@@6
	test	es:[bx-psType].psFlags,pfConstructor
	jz	@@6
	Invoke	PutCall
	Invoke	UseExpr
	mov	ax,0d009h		; or	ax,dx
	Invoke	PutWord
	Invoke	DoneExpr
	mov	[di].exRegsUsed,erAll
	mov	al,cdNotEqual
	Chain	_SetCondition
@@4:	xor	cx,cx
	call	GetAddress
	Chain	CastPointer
@@5:	mov	ax,42
	Chain	CompileError
@@6:	mov	ax,143
	Chain	CompileError
@@7	db	19,3
	db	t_Var
	dw	ProcessVar
	db	t_Constant
	dw	ProcessConst
	db	t_Proc
	dw	ProcessProc
	db	t_StdFun
	dw	ProcessStdFun
	db	tOParen
	dw	ProcessParens
	db	t_Const
	dw	ProcessConst
	db	tMinus
	dw	ProcessMinus
	db	tPlus
	dw	ProcessMinus
	db	tNot
	dw	ProcessNot
	db	tNil
	dw	ProcessNil
	db	t_Type
	dw	ProcessType
	db	tString
	dw	ProcessType
	db	tFile
	dw	ProcessType
	db	tOBracket
	dw	ProcessSet
	db	t_New
	dw	ProcessStdFun
	db	tAt
	dw	ProcessAt
	db	t_Mem
	dw	ProcessMem
	db	t_Port
	dw	ProcessPort
	db	t_Reg
	dw	ProcessReg
Primary	endp

ProcessStdFun	proc	near
	Chain	StdFunction
ProcessStdFun	endp

ProcessVar	proc	near
	Invoke	GetToken
	les	si,CurrentSymbol
	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
	mov	[di].exLocation,elMemory
	mov	[di].exRegsUsed,0
	les	si,CurrentSymbol
@@1:	mov	al,es:[si]
	test	al,vfAlias
	jz	@@2
	mov	bx,es:[si].vsLink.Segm
	mov	si,es:[si].vsLink.Offs
	mov	es,es:[bx]
	jmp	@@1
@@2:	test	al,vfField
	jz	@@3
	call	GetRecordRef
	mov	ax,es:[si].vsOffset
	add	[di].exOffset,ax
	ret
@@3:	test	CompilerFlags.B0,cfDebugging
	jnz	@@10
	mov	dx,es:[si].vsOffset
	mov	[di].exOffset,dx
	and	al,vfType
	cmp	al,vfVar
	je	@@6
	cmp	al,vfConst
	je	@@5
	cmp	al,vfLocal
	je	@@4
	mov	ax,es:[si].vsAddress.Segm
	mov	[di].exValue.Segm,ax
	mov	[di].exMisc,0
	jmp	short @@8
@@4:	mov	dx,es:[si].vsScope
	call	GetLocalRef
	jmp	short @@8
@@5:	mov	[di].exMisc,efDS+efConst
	jmp	short @@7
@@6:	mov	[di].exMisc,efDS
@@7:	mov	ax,es:[si].vsMap
	mov	[di].exMap,ax
	mov	[di].exSegment,es
@@8:	test	es:[si].vsFlags,vfAddress
	jz	@@9
	mov	dx,38c4h		; les	di,
	Invoke	AddReg
	mov	[di].exMisc,efES+efDI
	mov	[di].exOffset,0
@@9:	Chain	DoneExpr
@@10:	call	CheckProgLoaded
	mov	cl,al
	and	al,vfType
	cmp	al,vfVar
	je	@@12
	cmp	al,vfConst
	je	@@11
	cmp	al,vfLocal
	je	@@14
	les	bx,es:[si].vsAddress
	jmp	short @@15
@@11:	mov	bx,uhConstMap
	jmp	short @@13
@@12:	mov	bx,uhDataMap
@@13:	mov	ax,es:[si].vsOffset
	mov	si,es:[si].vsMap
	add	si,es:[bx]
	mov	bx,es:[si].smAddr
	cmp	bx,-1
	je	@@17
	add	bx,ax
	mov	ax,ProgramSegment
	add	ax,DataStart
	mov	es,ax
	jmp	short @@15
@@14:	mov	ax,es:[si].vsOffset
	push	ax cx
	mov	si,es:[si].vsScope
	mov	bl,es:[si].seName.B0
	mov	bh,0
	lea	si,[si+size TSymbol+bx]
	Invoke	GetStackFrame
	pop	cx ax
	add	bx,ax
@@15:	test	cl,vfAddress
	jz	@@16
	les	bx,es:[bx]
@@16:	xor	ax,ax
	mov	[di].exCode,ax
	mov	[di].exMisc,al
	mov	[di].exValue.Offs,bx
	mov	[di].exValue.Segm,es
	ret
@@17:	mov	ax,139
	Chain	CompileError
ProcessVar	endp

GetRecordRef	proc	near
	test	CompilerFlags.B0,cfDebugging
	jnz	@@4
	mov	bx,CurrentWith
	or	bx,bx
	jnz	@@1
	mov	cx,7ec4h		; les	di,[bp-...]
	xor	dx,dx
	call	GetNestedRef
	jmp	short @@2
@@1:	mov	[di].exLocation,elMemory
	mov	al,[bx].wcFlags
	mov	[di].exMisc,al
	mov	ax,[bx].wcOffset
	mov	[di].exOffset,ax
	mov	ax,[bx].wcMap
	mov	[di].exMap,ax
	mov	ax,[bx].wcSegment
	mov	[di].exSegment,ax
	cmp	[bx].wcType,wfNoTempVar
	je	@@3
	mov	dx,38c4h		; les	di,
	Invoke	AddReg
@@2:	mov	[di].exMisc,efES+efDI
	mov	[di].exOffset,0
@@3:	Chain	DoneExpr
@@4:	call	CheckProgLoaded
	push	es si
	call	GetTopScope
	Invoke	GetStackFrame
	les	bx,es:[bx+6]
	mov	[di].exValue.Offs,bx
	mov	[di].exValue.Segm,es
	pop	si es
	ret
GetRecordRef	endp

GetLocalRef	proc	near
	mov	[di].exMisc,efSS+efBP
	cmp	dx,CurScope
	jne	@@1
	ret
@@1:	mov	[di].exMisc,efSS+efDI
	mov	cx,7e8bh		; mov	di,[bp-...]
GetNestedRef	label	near
	push	es si
	mov	es,Dictionary.segm
	mov	si,CurProc
	test	es:[si].psFlags,pfMethod
	jnz	@@3
	cmp	dx,es:[si].psScope
	je	@@3
	dec	ch
	mov	ax,7e8bh		; mov	di,[bp+...]
	call	GetParentScope
@@2:	mov	si,es:[si].psScope
	mov	bl,es:[si].seName.B0
	mov	bh,0
	lea	si,[si+size TSymbol+bx]
	mov	al,36h			; ss:
	Invoke	PutByte
	test	es:[si].psFlags,pfMethod
	jnz	@@3
	cmp	dx,es:[si].psScope
	je	@@3
	mov	ax,7d8bh		; mov	di,[di+...]
	call	GetParentScope
	jmp	@@2
@@3:	mov	ax,cx
	call	GetParentScope
	pop	si es
	ret
GetLocalRef	endp

GetParentScope	proc	near
	Invoke	PutWord
	mov	al,4
	test	es:[si].psFlags,pfFar
	jz	@@1
	mov	al,6
@@1:	Chain	PutByte
GetParentScope	endp

GetTopScope	proc	near
	mov	es,Dictionary.segm
	mov	si,CurScope
	jmp	short @@2
@@1:	mov	bl,es:[si].seName.B0
	xor	bh,bh
	lea	si,[si+size TSymbol+bx]
	test	es:[si].psFlags,pfMethod
	jnz	@@3
	mov	si,es:[si].psScope
@@2:	or	si,si
	jnz	@@1
@@3:	ret
GetTopScope	endp

ProcessConst	proc	near
	cmp	CurrentToken,t_Constant
	je	@@3
	les	si,CurrentSymbol
	mov	bx,es:[si].csType.Offs
	mov	si,es:[si].csType.Segm
	mov	es,es:[si]
	mov	SymbolType.Offs,bx
	mov	SymbolType.Segm,es
	mov	al,es:[bx].tdType
	les	si,CurrentSymbol
	add	si,csValue
	cmp	al,ttString
	je	@@1
	cmp	al,ttSet
	jne	@@4
	mov	cx,32
	jmp	short @@2
@@1:	mov	cl,es:[si]
	xor	ch,ch
	inc	cx
@@2:	mov	ax,cx
	Invoke	AllocTempBuf
	mov	SymbolValue.W0,bx
	push	di
	mov	di,bx
	push	ds es
	pop	ds es
	rep	movsb
	push	es
	pop	ds di
@@3:	lea	si,SymbolValue
	push	ds
	pop	es
@@4:	push	di
	add	di,exValue
	push	ds es
	pop	ds es
	mov	cx,5
	rep	movsw
	push	es
	pop	ds di
	les	bx,SymbolType
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	mov	[di].exCode,0
	mov	[di].exLocation,elImmediate
	mov	[di].exRegsUsed,0
	mov	al,es:[bx].tdModifier
	cmp	es:[bx].tdType,ttInteger
	jb	@@5
	mov	ax,[di].exValue.W0
	mov	dx,[di].exValue.W2
	Invoke	FitConstType
@@5:	mov	[di].exModifier,al
	Chain	GetToken
ProcessConst	endp

ProcessProc	proc	near
	mov	[di].exCode,0
	mov	[di].exRegsUsed,0
	les	si,CurrentSymbol
	test	es:[si].psFlags,pfMethod
	jz	@@1
	call	GetRecordRef
@@1:	mov	al,0
_ProcessProc	label	near
	add	si,psType
	mov	[di].exType.Offs,si
	mov	[di].exType.Segm,es
	mov	[di].exLocation,elCall
	mov	[di].exModifier,al
	mov	ax,CurrentOwner.Offs
	mov	[di].exOwner.Offs,ax
	mov	ax,CurrentOwner.Segm
	mov	[di].exOwner.Segm,ax
	Chain	GetToken
ProcessProc	endp

ProcessParens	proc	near
	mov	al,tOParen
	Invoke	NeedToken
	call	Expression
	mov	al,tCParen
	Chain	NeedToken
ProcessParens	endp

ProcessMinus	proc	near
	Invoke	GetPlusMinus
	push	ax
	call	Primary
	pop	ax
	cmp	al,tMinus
	je	@@1
	ret
@@1:	Invoke	GetVarValue
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	cmp	al,ttInteger
	jne	@@4
	cmp	[di].exLocation,elImmediate
	je	@@3
	mov	al,emInteger
	mov	ah,[di].exModifier
	Invoke	IntExtension
	Invoke	ConvertOrdinal
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	mov	ax,0d8f7h		; neg	ax
	Invoke	PutWord
	test	[di].exModifier,emXX
	jz	@@2
	mov	ax,0d283h		; adc	dx,0
	Invoke	PutWord
	mov	al,0
	Invoke	PutByte
	mov	ax,0daf7h		; neg	dx
	Invoke	PutWord
@@2:	Chain	DoneExpr
@@3:	xor	ax,ax
	xor	dx,dx
	sub	ax,[di].exValue.W0
	sbb	dx,[di].exValue.W2
	Chain	SetValue
@@4:	cmp	al,tt8087
	jne	@@8
	cmp	[di].exLocation,elImmediate
	je	@@6
@@5:	Invoke	ConvReal2Ext
	Invoke	PushExt
	Invoke	UseExpr
	Invoke	PutEmulInt
	mov	ax,0e035h		; fchs
	Invoke	PutWord
	Chain	DoneExpr
@@6:	cmp	[di].exValue.W8,0
	je	@@7
	xor	[di].exValue.B9,80h
@@7:	ret
@@8:	cmp	al,ttReal
	jne	@@9
	test	CompilerOptions,co8087
	jnz	@@5
	Invoke	UseExpr
	mov	al,lrR1
	Invoke	LoadReal
	mov	ax,0c008h		; or	al,al
	Invoke	PutWord
	mov	ax,374h			; jz	$+5
	Invoke	PutWord
	mov	ax,0f680h		; xor	dh,80h
	Invoke	PutWord
	mov	al,80h
	Invoke	PutByte
	Chain	DoneExpr
@@9:	mov	ax,41
	Chain	CompileError
ProcessMinus	endp

ProcessNot	proc	near
	Invoke	GetToken
	call	Primary
	Invoke	GetVarValue
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttBoolean
	je	@@1
	cmp	es:[bx].tdType,ttInteger
	je	@@3
	mov	ax,41
	Chain	CompileError
@@1:	cmp	[di].exLocation,elImmediate
	je	@@2
	Invoke	Number2Cond
	xor	[di].exMisc,1
	mov	ax,[di].exChain1
	xchg	ax,[di].exChain2
	mov	[di].exChain1,ax
	ret
@@2:	xor	[di].exValue.W0,1
	ret
@@3:	cmp	[di].exLocation,elImmediate
	je	@@5
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	mov	ax,0d0f6h		; not	al
	test	[di].exModifier,emX
	jz	@@4
	mov	ax,0d0f7h		; not	ax
	test	[di].exModifier,emXX
	jz	@@4
	Invoke	PutWord
	mov	ax,0d2f7h		; not	dx
@@4:	Invoke	PutWord
	Chain	DoneExpr
@@5:	not	[di].exValue.W0
	not	[di].exValue.W2
	ret
ProcessNot	endp

ProcessNil	proc	near
	Invoke	GetToken
	mov	[di].exLocation,elImmediate
	xor	ax,ax
	mov	[di].exCode,ax
	mov	[di].exModifier,emLongint
	mov	[di].exRegsUsed,al
	mov	[di].exValue.Offs,ax
	mov	[di].exValue.Segm,ax
	Chain	CastPointer
ProcessNil	endp

ProcessType	proc	near
	push	di