stmt.asm

Turbo Pascal 6.0编译器源码

	Invoke	NeedToken
@@2:	call	Case
	Invoke	DoneGoal
	lea	bx,Buffer
	Invoke	AddGoal
	call	Statement
	lea	bx,Buffer
	Invoke	AddGoal
	mov	al,tSemicolon
	Invoke	CheckToken
	jnz	@@3
	cmp	CurrentToken,tEnd
	je	@@3
	cmp	CurrentToken,tElse
	je	@@3
	mov	al,cdAlways
	lea	bx,EndLabel
	Invoke	PutJmp
	lea	bx,NextLabel
	Invoke	PutLabel
	jmp	@@2
@@3:	mov	al,tElse
	Invoke	CheckToken
	jnz	@@5
	mov	al,cdAlways
	lea	bx,EndLabel
	Invoke	PutJmp
	lea	bx,NextLabel
	Invoke	PutLabel
	Invoke	DoneGoal
	lea	bx,Buffer
	Invoke	AddGoal
@@4:	call	Statement
	lea	bx,Buffer
	Invoke	AddGoal
	cmp	CurrentToken,tEnd
	je	@@5
	mov	al,tSemicolon
	Invoke	NeedToken
	jmp	@@4
@@5:	mov	al,tEnd
	Invoke	NeedToken
	lea	bx,Buffer
	Invoke	FlushGoals
	lea	bx,EndLabel
	mov	ax,NextLabel
	Invoke	AddToChain
	lea	bx,EndLabel
	Invoke	PutLabel
	Invoke	DoneGoal
	Exit

Case	proc	near
	Invoke	GetLineNumber
	Invoke	PutLineNumber
@@1:	call	CaseConstant
	mov	dl,cdEqual
	mov	al,tRange
	Invoke	CheckToken
	jnz	@@3
	mov	al,cdLess
	mov	dl,cdNotGreater
	test	CaseExpr.exModifier,emUnsigned
	jz	@@2
	mov	al,cdBelow
	mov	dl,cdNotAfter
@@2:	push	dx
	lea	bx,NextLabel
	Invoke	PutJmp
	call	CaseConstant
	pop	dx
@@3:	mov	al,tComma
	Invoke	CheckToken
	jnz	@@4
	mov	al,dl
	lea	bx,CaseLabel
	Invoke	PutJmp
	lea	bx,NextLabel
	Invoke	PutLabel
	jmp	@@1
@@4:	mov	al,dl
	xor	al,1
	lea	bx,NextLabel
	Invoke	PutJmp
	lea	bx,CaseLabel
	Invoke	PutLabel
	mov	al,tColon
	Chain	NeedToken
Case	endp

CaseConstant	proc	near
	lea	di,CaseConst
	Invoke	GetConstExpr
	cmp	bx,BaseType.Offs
	jnz	@@2
	mov	ax,es
	cmp	ax,BaseType.Segm
	jnz	@@2
	mov	al,CaseExpr.exModifier
	mov	ah,[di].exModifier
	Invoke	IntExtension
	cmp	al,CaseExpr.exModifier
	jne	@@3
	test	al,emX
	jz	@@1
	mov	al,3dh			; cmp	ax,
	Invoke	PutByte
	mov	ax,[di].exValue.W0
	Chain	PutWord
@@1:	mov	al,3ch			; cmp	al,
	mov	ah,[di].exValue.B0
	Chain	PutWord
@@2:	mov	ax,74
	Chain	CompileError
@@3:	mov	ax,112
	Chain	CompileError
CaseConstant	endp

CaseStatement	endp

WithStatement	proc	near
	Loc	SaveWithChain,word,1
	Loc	WithVar,byte,<size TExpr>
	Loc	Buffer,word,32
	Entry
	Invoke	GetToken
	mov	ax,WithChain
	mov	SaveWithChain,ax
	mov	Buffer[0],0
@@1:	lea	di,WithVar
	Invoke	GetReference
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttRecord
	je	@@2
	cmp	es:[bx].tdType,ttObject
	je	@@2
	mov	ax,75
	Chain	CompileError
@@2:	sub	sp,size TWithChain
	mov	si,sp
	mov	ax,WithChain
	mov	[si].wcNext,ax
	mov	WithChain,si
	mov	[si].wcOwner.Offs,bx
	mov	[si].wcOwner.Segm,es
	mov	al,[di].exMisc
	test	al,efDS+efSS
	jz	@@3
	test	al,efDI
	jnz	@@3
	mov	[si].wcType,wfNoTempVar
	mov	[si].wcFlags,al
	mov	ax,[di].exOffset
	mov	[si].wcOffset,ax
	mov	ax,[di].exMap
	mov	[si].wcMap,ax
	mov	ax,[di].exSegment
	mov	[si].wcSegment,ax
	jmp	short @@4
@@3:	mov	ax,4
	Invoke	AllocStack
	mov	[si].wcType,wfTempVar
	mov	[si].wcFlags,efSS+efBP
	mov	[si].wcOffset,ax
	xor	ax,ax
	mov	[si].wcMap,ax
	mov	[si].wcSegment,ax
	Invoke	UseExpr
	Invoke	LoadSegDI
	push	ax
	mov	dx,3e89h		; mov	[bp-...],di
	mov	ax,[si].wcOffset
	Invoke	AddOffset
	pop	ax
	mov	dx,68ch			; mov	[bp-...],es
	or	dh,al
	mov	ax,[si].wcOffset
	add	ax,2
	Invoke	AddOffset
	Invoke	DoneGoal
	lea	bx,Buffer
	Invoke	AddGoal
@@4:	mov	al,tComma
	Invoke	CheckToken
	jnz	@@5
	jmp	@@1
@@5:	mov	al,tDo
	Invoke	NeedToken
	call	Statement
	lea	bx,Buffer
	Invoke	AddGoal
	mov	ax,SaveWithChain
	mov	WithChain,ax
	lea	bx,Buffer
	Invoke	FlushGoals
	Invoke	DoneGoal
	Exit
WithStatement	endp

GotoStatement	proc	near
	Invoke	GetToken
	Invoke	Number2Ident
	Invoke	GetSymbol
	mov	al,t_Label
	Invoke	NeedToken
	Invoke	GetHash
	mov	dx,CurrentHash
	cmp	dx,si
	jb	@@1
	mov	ax,8
	Invoke	GetStmtMem
	push	di
	mov	ax,0eb08h
	stosw
	mov	ax,dx
	stosw
	pop	ax
	xchg	ax,LabelChain
	stosw
	Chain	DoneGoal
@@1:	mov	ax,80
	Chain	CompileError
GotoStatement	endp

InlineStatement	proc	near
	Invoke	GetToken
	push	Dictionary.Offs
	call	ProcessInline
	call	PutInline
	pop	Dictionary.Offs
	Chain	DoneGoal
InlineStatement	endp

ProcessInline	proc	near
	Loc	Temp,byte,<size TInlineRecord>
	Entry
	push	Dictionary.Offs
	mov	SlashToken,tInlineSlash
	mov	al,tOParen
	Invoke	NeedToken
@@1:	mov	al,tGreater
	Invoke	CheckToken
	mov	al,itWord
	jz	@@2
	mov	al,tLess
	Invoke	CheckToken
	mov	al,itByte
	jz	@@2
	mov	al,-1
@@2:	mov	Temp.irType,al
	Invoke	GetSymbol
	cmp	CurrentToken,t_Var
	jne	@@7
	les	di,CurrentSymbol
@@3:	test	es:[di].vsFlags,vfAlias
	jz	@@4
	mov	bx,es:[di].vsLink.Segm
	mov	di,es:[di].vsLink.Offs
	mov	es,es:[bx]
	jmp	@@3
@@4:	mov	al,es:[di].vsFlags
	test	al,vfLocal
	jnz	@@5
	cmp	Temp.irType,0
	je	@@6
	and	al,vfConst+vfLocal
	add	al,itDataFixup
	mov	Temp.irType,al
	mov	ax,es:[di].vsScope
	mov	Temp.irFixup.Offs,ax
	mov	dx,es
	Invoke	SearchUnit
	mov	Temp.irFixup.Segm,dx
@@5:	mov	ax,es:[di].vsOffset
	jmp	short @@8
@@6:	mov	ax,105
	Chain	CompileError
@@7:	cmp	CurrentToken,t_Proc
	jne	@@11
	Invoke	GetReturnVar
	jc	@@11
@@8:	mov	Temp.irValue,ax
	cmp	Temp.irType,0
	jge	@@9
	mov	Temp.irType,itWord
@@9:	Invoke	GetToken
	Invoke	GetPlusMinus
	or	al,al
	jz	@@12
	push	ax
	Invoke	GetIntConstExpr
	pop	cx
	cmp	cl,tMinus
	jne	@@10
	neg	ax
@@10:	add	Temp.irValue,ax
	jmp	short @@12
@@11:	Invoke	GetIntConstExpr
	mov	Temp.irValue,ax
@@12:	mov	al,Temp.irType
	cmp	al,-1
	jne	@@14
	mov	al,itByte
	cmp	Temp.irValue.B1,0
	je	@@13
	mov	al,itWord
@@13:	mov	Temp.irType,al
@@14:	mov	cl,al
	add	cl,2
	cmp	al,itDataFixup
	jb	@@15
	mov	cl,7
@@15:	xor	ch,ch
	mov	ax,cx
	Invoke	GetDictMem
	lea	si,Temp
	rep	movsb
	mov	al,tInlineSlash
	Invoke	CheckToken
	jnz	@@16
	jmp	@@1
@@16:	mov	SlashToken,tSlash
	mov	al,tCParen
	Invoke	NeedToken
	pop	di
	les	cx,Dictionary
	sub	cx,di
	Exit
ProcessInline	endp

PutInline	proc	near
	add	cx,di
	jmp	short @@6
@@1:	push	cx
	mov	al,es:[di].irType
	cmp	al,itByte
	je	@@4
	cmp	al,itWord
	je	@@3
	mov	cx,ffData+ffOffs
	cmp	al,itDataFixup
	je	@@2
	mov	cx,ffConst+ffOffs
@@2:	mov	bx,es:[di].irFixup.Segm
	mov	ax,es:[bx]
	mov	bx,es:[di].irFixup.Offs
	mov	dx,es:[di].irValue
	Invoke	PutFixup
	add	di,7
	jmp	short @@5
@@3:	mov	ax,es:[di].irValue
	Invoke	PutWord
	add	di,3
	jmp	short @@5
@@4:	mov	al,es:[di].irValue.B0
	Invoke	PutByte
	inc	di
	inc	di
@@5:	pop	cx
@@6:	cmp	di,cx
	jne	@@1
	ret
PutInline	endp

PortAssignment	proc	near
	Loc	Opcode,byte,2
	Loc	PortNum,byte,<size TExpr>
	Loc	Value,byte,<size TExpr>
	Entry
	Invoke	GetToken
	les	si,CurrentSymbol
	mov	al,0e6h			; out	...,al
	add	al,es:[si]
	mov	Opcode,al
	mov	al,tOBracket
	Invoke	NeedToken
	lea	di,PortNum
	Invoke	GetIntExpr
	Invoke	CastWord
	mov	al,tCBracket
	Invoke	NeedToken
	mov	al,tAssign
	Invoke	NeedToken
	lea	di,Value
	Invoke	GetIntExpr
	test	Opcode,1
	jz	@@1
	Invoke	CastWord
	jmp	short @@2
@@1:	Invoke	CastByte
@@2:	lea	si,PortNum
	cmp	[si].exLocation,elImmediate
	jne	@@3
	cmp	[si].exValue.B1,0
	jne	@@3
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	mov	al,Opcode
	mov	ah,[si].exValue.B0
	Invoke	PutWord
	jmp	short @@4
@@3:	Invoke	MakePtr
	mov	al,Opcode
	or	al,8
	Invoke	PutByte
@@4:	Invoke	DoneGoal
	Exit
PortAssignment	endp

Assignment	proc	near
	Loc	Left,byte,<size TExpr>
	Loc	Right,byte,<size TExpr>
	Entry
	lea	di,Left
	Invoke	GetLvalue
@@1:	les	bx,[di].exType
	cmp	es:[bx].tdType,ttProc
	jne	@@3
	cmp	[di].exLocation,elCall
	je	@@2
	cmp	CurrentToken,tAssign
	je	@@4
@@2:	Invoke	PutCall
	les	bx,[di].exType
	cmp	es:[bx].ptResult.Offs,0
	je	@@5
	Invoke	ReturnValue
	Invoke	Qualifier
	jz	@@1
	test	GlobalOptions,coExtSyntax
	jz	@@4
	cmp	CurrentToken,tAssign
	je	@@4
	Invoke	DiscardReturn
	jmp	short @@5
@@3:	Invoke	Qualifier
	jz	@@1
@@4:	cmp	[di].exLocation,elMemory
	jne	@@6
	test	[di].exMisc,efReadOnly
	jnz	@@6
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	cmp	al,ttVoid
	je	@@7
	cmp	al,ttFile
	je	@@7
	cmp	al,ttText
	je	@@7
	mov	al,tAssign
	Invoke	NeedToken
	lea	di,Right
	lea	si,Left
	Invoke	GetExpression
	lea	si,Left
	Invoke	AssignmentCast
	Invoke	TypeCompat
	Invoke	CastOrdinal
	xchg	si,di
	Invoke	Store
@@5:	mov	ax,[di].exCode
	Exit
@@6:	mov	ax,122
	Chain	CompileError
@@7:	mov	ax,43
	Chain	CompileError
Assignment	endp

	end