stmt.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.code	compiler_text

	public	CompoundStmt
	public	ProcessInline
	public	PutInline

Statement	proc	near
	mov	ax,GlobalOptions
	mov	CompilerOptions,ax
	Invoke	Number2Ident
	Invoke	GetSymbol
	lea	bx,@@3
	Invoke	ChooseToken
	jnz	@@2
	Invoke	GetLineNumber
	push	ax TempLocalsSize
	call	word ptr cs:[bx+1]
	pop	TempLocalsSize dx
	or	dx,dx
	jz	@@1
	xchg	ax,dx
	Invoke	PutLineNumber
	xchg	ax,dx
	Invoke	UseGoal
	Invoke	DoneGoal
@@1:	mov	bl,1
	ret
@@2:	xor	ax,ax
	xor	bx,bx
	ret
@@3	db	22,3
	db	t_Var
	dw	Assignment
	db	t_Proc
	dw	Assignment
	db	t_StdProc
	dw	ProcedureCall
	db	tBegin
	dw	CompoundStmt
	db	tIf
	dw	IfStatement
	db	tWhile
	dw	WhileStatement
	db	tRepeat
	dw	RepeatStatement
	db	tFor
	dw	ForStatement
	db	tCase
	dw	CaseStatement
	db	tWith
	dw	WithStatement
	db	tGoto
	dw	GotoStatement
	db	t_Label
	dw	_Label
	db	tAsm
	dw	AsmStatement
	db	tInline
	dw	InlineStatement
	db	t_New
	dw	ProcedureCall
	db	t_Type
	dw	Assignment
	db	tString
	dw	Assignment
	db	tFile
	dw	Assignment
	db	t_StdFun
	dw	Assignment
	db	tAt
	dw	Assignment
	db	t_Mem
	dw	Assignment
	db	t_Port
	dw	PortAssignment
Statement	endp

ProcedureCall	proc	near
	Chain	StdProcedure
ProcedureCall	endp

AsmStatement	proc	near
	Chain	AsmClause
AsmStatement	endp

_Label	proc	near
	Invoke	GetHash
	les	di,CurrentSymbol
	cmp	di,si
	jb	@@1
	cmp	es:[di].lsLink,0
	jne	@@2
	dec	es:[di].lsLink
	Invoke	GetToken
	mov	al,tColon
	Invoke	NeedToken
	push	es di
	call	Statement
	push	ax
	mov	ax,3
	Invoke	GetStmtMem
	mov	al,12
	stosb
	mov	bx,di
	pop	ax di es
	mov	es:[di],bx
	Invoke	UseGoal
	Chain	DoneGoal
@@1:	mov	ax,80
	Chain	CompileError
@@2:	mov	ax,81
	Chain	CompileError
_Label	endp

CompoundStmt	proc	near
	mov	ax,tBegin+tEnd*256
Closure	label	near
	Loc	FinToken,byte,1
	Loc	WasStmt,byte,1
	Loc	Buffer,word,64
	Entry
	mov	FinToken,ah
	Invoke	NeedToken
	mov	Buffer[0],0
@@1:	call	Statement
	mov	WasStmt,bl
	lea	bx,Buffer
	Invoke	AddGoal
	mov	al,CurrentToken
	cmp	al,FinToken
	je	@@2
	cmp	al,tSemicolon
	jne	@@3
	Invoke	GetToken
	jmp	@@1
@@2:	lea	bx,Buffer
	Invoke	FlushGoals
	Invoke	GetLineNumber
	Invoke	PutLineNumber
	Invoke	DoneGoal
	Invoke	GetToken
	Exit
@@3:	mov	ax,85
	cmp	WasStmt,0
	jne	@@4
	mov	ax,113
@@4:	Chain	CompileError
CompoundStmt	endp

IfStatement	proc	near
	Loc	Condition,byte,<size TExpr>
	Loc	ThenGoal,word,1
	Loc	ElseGoal,word,1
	Loc	EndLabel,word,1
	Entry
	Invoke	GetToken
	mov	ElseGoal,0
	mov	EndLabel,0
	lea	di,Condition
	Invoke	GetBooleanExpr
	mov	ax,tThen
	Invoke	NeedToken
	call	Statement
	mov	ThenGoal,ax
	mov	al,tElse
	Invoke	CheckToken
	jnz	@@1
	call	Statement
	mov	ElseGoal,ax
@@1:	cmp	Condition.exLocation,elImmediate
	jne	@@2
	mov	ax,ThenGoal
	cmp	Condition.exValue.B0,0
	jne	@@4
	mov	ax,ElseGoal
	jmp	short @@4
@@2:	mov	ax,Condition.exCode
	Invoke	UseGoal
	mov	ax,ThenGoal
	Invoke	UseGoal
	cmp	ElseGoal,0
	je	@@3
	mov	al,cdAlways
	lea	bx,EndLabel
	Invoke	PutJmp
@@3:	lea	bx,Condition.exChain2
	Invoke	PutLabel
	mov	ax,ElseGoal
	Invoke	UseGoal
	lea	bx,EndLabel
	Invoke	PutLabel
	Invoke	DoneGoal
@@4:	Exit
IfStatement	endp

WhileStatement	proc	near
	Loc	Condition,byte <size TExpr>
	Loc	EndLabel,word,1
	Entry
	Invoke	GetToken
	mov	EndLabel,0
	lea	di,Condition
	Invoke	GetBooleanExpr
	mov	ax,tDo
	Invoke	NeedToken
	call	Statement
	cmp	Condition.exLocation,elImmediate
	jne	@@2
	cmp	Condition.exValue.B0,0
	jne	@@1
	xor	ax,ax
	jmp	short @@3
@@1:	mov	Condition.exChain2,0
@@2:	Invoke	UseGoal
	mov	al,cdAlways
	lea	bx,EndLabel
	Invoke	PutJmp
	Invoke	DoneGoal
	push	ax
	lea	bx,EndLabel
	Invoke	PutLabel
	mov	ax,Condition.exCode
	Invoke	UseGoal
	pop	ax
	Invoke	UseGoal
	lea	bx,Condition.exChain2
	Invoke	PutLabel
	Invoke	DoneGoal
@@3:	Exit
WhileStatement	endp

RepeatStatement	proc	near
	Loc	Condition,byte,<size TExpr>
	Loc	Body,word,1
	Entry
	mov	ax,tRepeat+tUntil*256
	call	Closure
	mov	Body,ax
	lea	di,Condition
	Invoke	GetBooleanExpr
	cmp	Condition.exLocation,elImmediate
	jne	@@1
	mov	ax,Body
	cmp	Condition.exValue.B0,0
	jne	@@2
	mov	Condition.exChain2,0
	mov	al,cdAlways
	lea	bx,Condition.exChain2
	Invoke	PutJmp
	Invoke	DoneGoal
	mov	Condition.exCode,ax
@@1:	lea	bx,Condition.exChain2
	Invoke	PutLabel
	mov	ax,Body
	Invoke	UseGoal
	mov	ax,Condition.exCode
	Invoke	UseGoal
	Invoke	DoneGoal
@@2:	Exit
RepeatStatement	endp

ForStatement	proc	near
	Loc	ControlVar,byte,<size TExpr>
	Loc	LowerBound,byte,<size TExpr>
	Loc	UpperBound,byte,<size TExpr>
	Loc	X,byte,<size TExpr>
	Loc	Y,byte,<size TExpr>
	Loc	Z,byte,<size TExpr>
	Loc	Action,word,1
	Loc	Body,word,1
	Loc	SmartLabel,word,1
	Entry
	Invoke	GetToken
	mov	SmartLabel,0
	lea	di,ControlVar
	Invoke	GetReference
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttInteger
	jb	@@1
	test	[di].exMisc,efDS+efSS
	jz	@@1
	test	[di].exMisc,efDI
	jz	@@2
@@1:	mov	ax,97
	Chain	CompileError
@@2:	mov	ax,tAssign
	Invoke	NeedToken
	lea	di,LowerBound
	call	GetBound
	lea	bx,ToDownto
	Invoke	ChooseToken
	jz	@@3
	mov	ax,58
	Chain	CompileError
@@3:	mov	Action,bx
	Invoke	GetToken
	lea	di,UpperBound
	call	GetBound
	cmp	LowerBound.exLocation,elImmediate
	jne	@@4
	cmp	UpperBound.exLocation,elImmediate
	je	@@5
@@4:	lea	di,LowerBound
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	Invoke	DoneExpr
	cmp	UpperBound.exLocation,elImmediate
	je	@@5
	lea	di,UpperBound
	Invoke	CreateTempInt
	mov	[di].exRegsUsed,0
@@5:	mov	ax,tDo
	Invoke	NeedToken
	call	Statement
	mov	Body,ax
	lea	di,X
	lea	si,LowerBound
	call	CopyExpr
	lea	di,Z
	lea	si,UpperBound
	call	CopyExpr
	lea	di,X
	lea	si,Z
	mov	bx,Action
	mov	al,cs:[bx+1]
	call	Compare
	lea	di,Y
	lea	si,ControlVar
	call	CopyExpr
	lea	di,Z
	lea	si,UpperBound
	call	CopyExpr
	lea	di,Y
	lea	si,Z
	mov	al,opNotEqual
	call	Compare
	lea	di,Z
	lea	si,LowerBound
	call	CopyExpr
	lea	di,ControlVar
	lea	si,Z
	Invoke	Store
	cmp	X.exLocation,elImmediate
	jne	@@7
	cmp	X.exValue.B0,0
	je	@@6
	xor	ax,ax
	jmp	short @@8
@@6:	mov	X.exValue.W0,0
@@7:	mov	ax,UpperBound.exCode
	Invoke	UseGoal
	mov	ax,LowerBound.exCode
	Invoke	UseGoal
	mov	ax,X.exCode
	Invoke	UseGoal
	mov	ax,ControlVar.exCode
	Invoke	UseGoal
	mov	al,cdAlways
	lea	bx,SmartLabel
	Invoke	PutJmp
	lea	bx,Y.exChain1
	Invoke	PutLabel
	call	AdvanceVar
	lea	bx,SmartLabel
	Invoke	PutLabel
	mov	ax,Body
	Invoke	UseGoal
	mov	ax,Y.exCode
	Invoke	UseGoal
	lea	bx,X.exChain1
	Invoke	PutLabel
	Invoke	DoneGoal
@@8:	Exit

CopyExpr	proc	near
	mov	cx,size TExpr shr 1
	push	ds
	pop	es
	rep	movsw
	mov	[di-size TExpr].exCode,cx
	ret
CopyExpr	endp

GetBound	proc	near
	Invoke	GetExpr
	lea	si,ControlVar
	Invoke	TypeCompat
	Chain	CastOrdinal
GetBound	endp

Compare	proc	near
	Invoke	Operation
	cmp	[di].exLocation,elImmediate
	je	@@1
	Invoke	UseExpr
	mov	al,[di].exMisc
	lea	bx,[di].exChain1
	Invoke	PutJmp
	lea	bx,[di].exChain2
	Invoke	PutLabel
	Chain	DoneExpr
@@1:	ret
Compare	endp

AdvanceVar	proc	near
	lea	di,ControlVar
	mov	si,Action
	test	[di].exModifier,emXX
	jnz	@@1
	mov	dl,0feh
	mov	dh,cs:[si+2]
	Chain	PutRM
@@1:	mov	ax,1
	mov	dl,cs:[si+3]
	Invoke	PutArOpRMImm
	add	[di].exOffset,2
	xor	ax,ax
	mov	dl,cs:[si+4]
	Invoke	PutArOpRMImm
	sub	[di].exOffset,2
	ret
AdvanceVar	endp

ToDownto	db	2,5
		db	tTo
		db	opGreater
		db	0		; inc
		db	0		; add
		db	10h		; adc
		db	tDownTo
		db	opLess
		db	8		; dec
		db	28h		; sub
		db	18h		; sbb
ForStatement	endp

CaseStatement	proc	near
	Loc	CaseLabel,word,1
	Loc	NextLabel,word,1
	Loc	EndLabel,word,1
	Loc	BaseType,dword,1
	Loc	CaseExpr,byte,<size TExpr>
	Loc	CaseConst,byte,<size TExpr>
	Loc	Buffer,word,64
	Entry
	Invoke	GetToken
	xor	ax,ax
	mov	CaseLabel,ax
	mov	NextLabel,ax
	mov	EndLabel,ax
	mov	Buffer[0],ax
	lea	di,CaseExpr
	Invoke	GetOrdExpr
	mov	si,es:[bx].itBase.Offs
	mov	bx,es:[bx].itBase.Segm
	mov	es,es:[bx]
	mov	BaseType.Offs,si
	mov	BaseType.Segm,es
	test	[di].exModifier,emXX
	jz	@@1
	Invoke	CastInt
@@1:	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	Invoke	DoneGoal
	lea	bx,Buffer
	Invoke	AddGoal
	mov	al,tOf